From: Bill Joy Date: Sun, 16 Nov 1980 09:24:39 +0000 (-0800) Subject: BSD 4 release X-Git-Tag: BSD-4 X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/commitdiff_plain/refs/tags/BSD-4 BSD 4 release Snapshot of the completed development branch Synthesized-from: CSRG//cd1/4.0 --- 31cef89cb428866f787983e68246030321893df4 diff --cc usr/lib/lisp/auxfns0.l index 0000000000,0000000000,0000000000..ff269b9ec4 new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/auxfns0.l @@@@ -1,0 -1,0 -1,0 +1,2205 @@@@ +++(setq SCCS-auxfns0 "@(#)auxfns0.l 1.10 11/7/80") +++(setsyntax '\; 'splicing 'zapline) +++ +++;---------------- auxfns0 --------------- +++; this file contains the definitions of the most common functions. +++; It should only be loaded in Opus 30 Franz Lisp. +++; These functions should be loaded into every lisp. +++; +++;------------------------------------------------ +++; preliminaries: +++ +++(eval-when (eval load) +++ (cond ((null (getd 'back=quotify)) +++ (cond ((atom (errset (fasl '/usr/lib/lisp/backquote))) +++ (load 'backquote)))))) +++ +++(eval-when (compile) +++ (setq macros t)) +++ +++ +++;---- Table of Contents. +++; +++; I. Functions required to be defined right away +++; declare append concatl max +++; memq +++; +++; II. Macros +++; catch throw defmacro (defmacrosrch,defmcroopption) +++; defun desetq let (de-compose) +++; let* listify sassoc unwind-protect +++; +++; III. Interrupt functions +++; FPEINT INT +++; +++; IV. garbage collection functions +++; prtpagesused gcafter +++; +++; V. the functions +++; append1 assoc bigp +++; comment copy copysymbol cvttomaclisp +++; defprop delete delq evenp +++; ex (exvi) exec exl explode +++; explodec exploden expt ffasl +++; filepos fixp +++; flatsize floatp getchar getcharn +++; getl help hunk +++; last include includef +++; length macroexpand makhunk member +++; min +++; nconc nreverse oddp plusp +++; prog1 +++; reverse shell sload +++; sort (sorthelp,exchange2) sortcar (sortcarhelp) +++; sublis (sublishelp) subst vi +++; vil xcons +++; +++; VI. array functions +++; array [macro] arracfun *array +++; arraycall [macro] (ev-arraycall) +++; arrcomputeint +++; store [macro] (storeintern) arracfcnsimp +++; arraydims fillarray +++; +++; VII. equivalences +++; abs add chrct diff +++; numbp princ remainder terpri +++; typep symeval +++; < = > - +++; / + - *diff +++; \ 1+ 1+$ 1- +++; 1-$ * *$ /$ +++; +$ -$ +++; +++ +++ +++ +++;--- Section I - functions which must be declared immediately +++ +++;--- declare - ignore whatever is given, this is for the compiler +++; +++(def declare (nlambda (x) nil)) +++ +++ +++;--- append - x : list +++; - y : list +++; +++(declare (localf append2args)) +++ +++(def append2args +++ (lambda (x y) +++ (prog (l l*) +++ (cond ((null x) (return y)) +++ ((atom x) (err (list '"Non-list to append:" x)))) +++ (setq l* (setq l (cons (car x) nil))) +++ loop (cond ((atom x) (err (list '"Non-list to append:" x))) +++ ((setq x (cdr x)) +++ (setq l* (cdr (rplacd l* (cons (car x) nil)))) +++ (go loop))) +++ (rplacd l* y) +++ (return l)))) +++ +++(def append +++ (lexpr (nargs) +++ (cond ((eq nargs 2) (append2args (arg 1) (arg 2))) +++ ((zerop nargs) nil) +++ (t (do ((i (1- nargs) (1- i)) +++ (res (arg nargs))) +++ ((zerop i) res) +++ (setq res (append2args (arg i) res))))))) +++ +++ +++ +++;--- concatl - l : list of atoms +++; returns the list of atoms concatentated +++; +++(def concatl +++ (lambda (x) (apply 'concat x))) +++ +++ +++;--- max - arg1 arg2 ... : sequence of numbe +++; returns the maximum +++; +++(def max +++ (lexpr (nargs) +++ (do ((i nargs (1- i)) +++ (max (arg 1))) +++ ((lessp i 2) max) +++ (cond ((greaterp (arg i) max) (setq max (arg i))))))) +++ +++ +++;--- memq - arg : (probably a symbol) +++; - lis : list +++; returns part of lis beginning with arg if arg is in lis +++; +++(def memq +++ (lambda ($a$ $l$) +++ (do ((ll $l$ (cdr ll))) +++ ((null ll) nil) +++ (cond ((eq $a$ (car ll)) (return ll)))))) +++ +++; ---Section II - macros +++; +++ +++;--- catch form [tag] +++; catch is now a macro which translates to (*catch 'tag form) +++; +++(def catch +++ (macro (l) +++ `(*catch ',(caddr l) ,(cadr l)))) +++;--- throw form [tag] +++; throw isnow a macro +++; +++(def throw +++ (macro (l) +++ `(*throw ',(caddr l) ,(cadr l)))) +++ +++ +++; defmacro for franz, written 20sep79 by jkf +++ +++(declare (special defmacrooptlist protect-list protect-evform)) +++ +++;--- defmacro - name - name of macro being defined +++; - pattrn - formal arguments plus other fun stuff +++; - body - body of the macro +++; This is an intellegent macro creator. The pattern may contain +++; symbols which are formal paramters, lists which show how the +++; actual paramters will appear in the args, and these key words +++; &rest name - the rest of the args (or nil if there are no other args) +++; is bound to name +++; &optional name - bind the next arg to name if it exists, otherwise +++; bind it to nil +++; &optional (name init) - bind the next arg to name if it exists, otherwise +++; bind it to init evaluted. (the evaluation is done left +++; to right for optional forms) +++; &optional (name init given) - bind the next arg to name and given to t +++; if the arg exists, else bind name to the value of +++; init and given to nil. +++; &aux name +++; &aux (name init) +++; +++; Method of operation: +++; the list returned from defmcrosrc has the form ((cxxr name) ...) +++; where cxxr is the loc of the macro arg and name is it formal name +++; defmcrooptlist has the form ((initv cxxr name) ...) +++; which is use for &optional args with an initial value. +++; here cxxr looks like cdd..dr which will test of the arg exists. +++; +++; the variable defmacro-for-compiling determines if the defmacro forms +++; will be compiled. If it is t, then we return (progn 'compile (def xx..)) +++; to insure that it is compiled +++; +++(cond ((null (boundp 'defmacro-for-compiling)) ; insure it has a value +++ (setq defmacro-for-compiling nil))) +++ +++(def defmacro +++ (macro (args) +++ ((lambda +++ (tmp tmp2 defmacrooptlist body protect-evform protect-list) +++ (setq tmp (defmcrosrch (caddr args) '(d r) nil) +++ body +++ `(def ,(cadr args) +++ (macro (defmacroarg) +++ ((lambda ,(mapcar 'cdr tmp) +++ ,@(mapcar +++ '(lambda (arg) +++ `(cond ((setq ,(caddr arg) +++ (,(cadr arg) +++ defmacroarg)) +++ ,@(cond ((setq tmp2 (cadddr arg)) +++ `((setq ,tmp2 t)))) +++ (setq ,(caddr arg) +++ (car ,(caddr arg)))) +++ (t (setq ,(caddr arg) +++ ,(car arg))))) +++ defmacrooptlist) +++ ,@(cond (protect-evform +++ (setq gutz +++ (eval `((lambda ,(mapcar 'cdr tmp) +++ ,@(cdddr args)) +++ ,@(mapcar +++ '(lambda (x) `',(cdr x)) +++ tmp)))) +++ (ncons +++ `(cond (,protect-evform +++ `((lambda ,',(mapcar 'cdr tmp) +++ ,',gutz) +++ ,,@(mapcar 'cdr tmp))) +++ (t ,@(cdddr args))))) +++ (t (cdddr args)))) +++ ,@(mapcar '(lambda (arg) +++ (cond ((dtpr (car arg)) +++ (caar arg)) +++ ((car arg) +++ `(,(car arg) defmacroarg)))) +++ tmp))))) +++ (cond (defmacro-for-compiling `(progn 'compile ,body)) +++ (t body))) +++ +++ nil nil nil nil nil nil))) +++ +++(def defmcrosrch +++ (lambda (pat form sofar) +++ (cond ((null pat) sofar) +++ ((atom pat) (cons (cons (concatl `(c ,@form)) pat) +++ sofar)) +++ ((eq (car pat) '&rest) +++ (append (defmcrosrch (cadr pat) form nil) +++ (defmcrosrch (cddr pat) form sofar))) +++ ((eq (car pat) '&optional) +++ (defmcrooption (cdr pat) form sofar)) +++ ((eq (car pat) '&protect) +++ (setq protect-list (cond ((atom (cadr pat)) +++ (ncons (cadr pat))) +++ (t (cadr pat))) +++ protect-evform (cons 'or (mapcar '(lambda (x) +++ `(dtpr ,x)) +++ protect-list))) +++ (defmcrosrch (cddr pat) form sofar)) +++ ((eq (car pat) '&aux) +++ (mapcar '(lambda (frm) +++ (cond ((atom frm) `((nil) . ,frm)) +++ (t `((,(cadr frm)) . ,(car frm))))) +++ (cdr pat))) +++ (t (append (defmcrosrch (car pat) (cons 'a form) nil) +++ (defmcrosrch (cdr pat) (cons 'd form) sofar)))))) +++ +++(def defmcrooption +++ (lambda (pat form sofar) +++ ((lambda (tmp tmp2) +++ (cond ((null pat) sofar) +++ ((eq (car pat) '&rest) +++ (defmcrosrch (cadr pat) form sofar)) +++ (t (cond ((atom (car pat)) +++ (setq tmp (car pat))) +++ (t (setq tmp (caar pat)) +++ (setq defmacrooptlist +++ `((,(cadar pat) +++ ,(concatl `(c ,@form)) +++ ,tmp +++ ,(setq tmp2 (caddar pat))) +++ . ,defmacrooptlist)))) +++ (defmcrooption +++ (cdr pat) +++ (cons 'd form) +++ `( (,(concatl `(ca ,@form)) . ,tmp) +++ ,@(cond (tmp2 `((nil . ,tmp2)))) +++ . ,sofar))))) +++ nil nil))) +++ +++ +++ +++;--- defun - standard maclisp function definition form. +++; +++(def defun +++ (macro (l) +++ (prog (name type arglist body specind specnam) +++ (setq name (cadr l) l (cddr l)) +++ (cond ((dtpr name) +++ (cond ((memq (cadr name) '(macro expr fexpr lexpr)) +++ (setq l (cons (cadr name) l) +++ name (car name))) +++ (t (setq specnam (car name) +++ specind (cadr name) +++ name (concat (gensym) "::" specnam)))))) +++ (cond ((null (car l)) (setq type 'lambda)) +++ ((eq 'fexpr (car l)) (setq type 'nlambda l (cdr l))) +++ ((eq 'expr (car l)) (setq type 'lambda l (cdr l))) +++ ((eq 'macro (car l)) (setq type 'macro l (cdr l))) +++ ((atom (car l)) (setq type 'lexpr +++ l `((,(car l)) ,@(cdr l)))) +++ (t (setq type 'lambda))) +++ (cond ((and (eq 'lambda type) (or (memq '&aux (car l)) +++ (memq '&optional (car l)) +++ (memq '&rest (car l)))) +++ (setq l (lambdacvt l) +++ type (car l) +++ l (cdr l)))) +++ (setq body `(def ,name +++ (,type ,@l))) +++ (cond (specnam +++ (return `(progn 'compile +++ ,body +++ (putprop ',specnam +++ (getd ',name) +++ ',specind)))) +++ (t (return body)))))) +++ +++ +++ +++ +++;--- lambdacvt +++; converts a lambda expression with &optional, &rest and &aux forms in +++; the argument list into a lexpr which will do the desired function. +++; method of operation +++; the argument list is examined and the following lists are made: +++; vbs - list of variables to be lambda bound +++; opl - list of optional forms +++; vals - list of values to be assigned to the vbs +++; +++(def lambdacvt +++ (lambda (exp) +++ (prog (arg vbs vals opl rest opflg restflg narg narg2 narg3 auxflg +++ avbs) +++ (do ((ll (car exp) (cdr ll)) +++ (count 1 (1+ count))) +++ ((null ll)) +++ (cond ((eq '&rest (car ll)) +++ (setq restflg t opflg nil count (1- count))) +++ ((eq '&optional (car ll)) +++ (setq opflg t count (1- count))) +++ ((eq '&aux (car ll)) +++ (setq auxflg t +++ opflg nil +++ restflg nil +++ count (1- count))) +++ (opflg +++ (cond ((atom (setq arg (car ll))) +++ (setq opl (cons (cons (ncons arg) count) opl) +++ vbs (cons arg vbs) +++ vals (cons nil vals))) +++ ((cddr arg) +++ (setq vbs (cons (car arg) +++ (cons (caddr arg) +++ vbs)) +++ vals (cons nil +++ (cons nil vals)) +++ opl (cons (cons arg count) opl))) +++ (t (setq vbs (cons (car arg) vbs) +++ vals (cons nil vals) +++ opl (cons (cons arg count) opl))))) +++ (restflg +++ (setq vbs (cons (car ll) vbs) +++ vals (cons nil vals) +++ rest (cons (car ll) count))) +++ (auxflg +++ (setq count (1- count)) +++ (cond ((atom (setq arg (car ll))) +++ (setq avbs (cons (ncons arg) avbs))) +++ (t (setq avbs (cons arg avbs))))) +++ (t (setq vbs (cons (car ll) vbs) +++ vals (cons `(arg ,count) vals))))) +++ (setq narg (gensym)) +++ +++ (return +++ `(lexpr (,narg) +++ ((lambda ,(nreverse vbs) +++ ,@(mapcar +++ '(lambda (arg) +++ `(cond ((greaterp ,(cdr arg) +++ ,narg) +++ ,@(cond ((cadar arg) +++ `((setq ,(caar arg) +++ ,(cadar arg)))))) +++ (t (setq ,(caar arg) (arg ,(cdr arg))) +++ ,@(cond ((cddar arg) +++ `((setq ,(caddar arg) +++ t))))))) +++ (nreverse opl)) +++ ,@(cond (rest (setq narg2 (gensym) +++ narg3 (gensym)) +++ `((do ((,narg2 ,narg (1- ,narg2)) +++ (,narg3 nil (cons (arg ,narg2) +++ ,narg3))) +++ ((lessp ,narg2 ,(cdr rest)) +++ (setq ,(car rest) ,narg3)))))) +++ ,@(cond (auxflg `((let* ,(nreverse avbs) +++ ,@(cdr exp)))) +++ (t (cdr exp)))) +++ ,@(nreverse vals))))))) +++ +++;--- desetq +++; - pattern - pattern containing vrbl names +++; - expr - expression to be evaluated +++; +++(defmacro desetq (&rest forms &aux newgen destrs) +++ (do ((xx forms (cddr xx)) +++ (res) +++ (patt) +++ (expr)) +++ ((null xx) (cond ((null (cdr res)) (car res)) +++ (t (cons 'progn (nreverse res))))) +++ (setq patt (car xx) expr (cadr xx)) +++ (setq res +++ (cons (cond ((atom patt) `(setq ,patt ,expr)) ;trivial case +++ (t (setq newgen (gensym) +++ destrs (de-compose patt '(r))) +++ `((lambda (,newgen) +++ ,@(mapcar '(lambda (frm) +++ `(setq ,(cdr frm) +++ (,(car frm) ,newgen))) +++ destrs)) +++ ,expr))) +++ res)))) +++ +++; let for franz (with destructuring) +++;--- let +++; - binds - binding forms +++; - . body - forms to execute +++; the binding forms may have these forms +++; a local variable a, initially nil +++; (a x) local variable a, x is evaled and a gets its value initially +++; ((a . (b . c)) x) three local variables, a,b and c which are given +++; values corresponding to the location in the value +++; of x. Any structure is allowed here. +++; +++(defmacro let (binds &rest body &aux vrbls vals destrs newgen) +++ (mapc '(lambda (form) +++ (cond ((atom form) +++ (setq vrbls (cons form vrbls) +++ vals (cons nil vals))) +++ ((atom (car form)) +++ (setq vrbls (cons (car form) vrbls) +++ vals (cons (cadr form) vals))) +++ (t (setq newgen (gensym) +++ destrs `((,newgen ,@(de-compose (car form) '(r))) +++ ,@destrs) +++ vrbls (cons newgen vrbls) +++ vals (cons (cadr form) vals))))) +++ binds) +++ +++ (mapc '(lambda (frm) +++ (do ((ll (cdr frm) (cdr ll))) +++ ((null ll)) +++ (setq vrbls (cons (cdar ll) vrbls) +++ vals (cons nil vals)))) +++ destrs) +++ +++ (setq vals (nreverse vals) +++ vrbls (nreverse vrbls) +++ destrs (nreverse destrs)) +++ `((lambda ,vrbls +++ ,@(mapcan '(lambda (frm) +++ (mapcar '(lambda (vrb) +++ `(setq ,(cdr vrb) (,(car vrb) +++ ,(car frm)))) +++ (cdr frm))) +++ destrs) +++ ,@body) +++ ,@vals)) +++ +++;--- de-compose +++; form - pattern to de-compose +++; sofar - the sequence of cxxr's needed to get to this part +++; of the pattern +++; de-compose returns a list of this form +++; +++; ((cxxr . a) (cyyr . b) ... ) +++; which tells how to get to the value for a and b ..etc.. +++; +++(def de-compose +++ (lambda (form sofar) +++ (cond ((null form ) nil) +++ ((atom form) (ncons (cons (apply 'concat (cons 'c sofar)) +++ form))) +++ (t (nconc (de-compose (car form) (cons 'a sofar)) +++ (de-compose (cdr form) (cons 'd sofar))))))) +++ +++ +++;--- let* +++; - binds - binding forms (like let) +++; - body - forms to eval (like let) +++; this is the same as let, except forms are done in a left to right manner +++; in fact, all we do is generate nested lets +++; +++(defmacro let* (binds &rest body) +++ (do ((ll (reverse binds) (cdr ll))) +++ ((null ll) (car body)) +++ (setq body `((let (,(car ll)) ,@body))))) +++ +++ +++ +++;--- listify : n - integer +++; returns a list of the first n args to the enclosing lexpr if +++; n is positive, else returns the last -n args to the lexpr if n is +++; negative. +++; +++(def listify +++ (macro (lis) +++ `(let ((n ,(cadr lis))) +++ (cond ((minusp n) +++ (do ((i (arg nil) (1- i)) +++ (result nil (cons (arg i) result))) +++ ((< i (+ (arg nil) n 1)) result) )) +++ (t (do ((i n (1- i)) +++ (result nil (cons (arg i) result))) +++ ((< i 1) result) )))))) +++;--- sassoc +++; - x : form +++; - y : assoc list +++; - fcn : function or lambda expression +++; If (assoc x y) is non nil, then we apply the function fcn to nil. +++; This must be written as a macro if we expect to handle the case of +++; a lambda expression as fcn in the compiler. +++; +++(defmacro sassoc (x y fcn) +++ (cond ((or (atom fcn) (not (eq 'quote (car fcn)))) +++ `(or (assoc ,x ,y) +++ (apply ,fcn nil))) +++ (t `(or (assoc ,x ,y) +++ (,(cadr fcn) nil))))) +++ +++;--- sassq +++; - x : form +++; - y : assoc list +++; - fcn : function or lambda expression +++; like sassoc above except it uses assq instead of assoc. +++; +++(defmacro sassq (x y fcn) +++ (cond ((or (atom fcn) (not (eq 'quote (car fcn)))) +++ `(or (assq ,x ,y) +++ (apply ,fcn nil))) +++ (t `(or (assq ,x ,y) +++ (,(cadr fcn) nil))))) +++ +++ +++ +++;--- signp - test - unevaluated atom +++; - value - evaluated value +++; test can be l, le, e, n, ge or g with the obvious meaning +++; we return t if value compares to 0 by test +++'(def signp +++ (macro (l) +++ `(signphelpfcn ',(cadr l) ,(caddr l)))) +++ +++(defmacro signp (tst val) +++ (setq tst (cond ((eq 'l tst) `(minusp signp-arg)) +++ ((eq 'le tst) `(not (greaterp signp-arg 0))) +++ ((eq 'e tst) `(any-zerop signp-arg)) +++ ((eq 'n tst) `(not (any-zerop signp-arg))) +++ ((eq 'ge tst) `(not (minusp signp-arg))) +++ ((eq 'g tst) `(greaterp signp-arg 0)) +++ (t (error |bad arg to signp | tst)))) +++ (cond ((atom val) `(and (numberp ,val) ,(subst val 'signp-arg tst))) +++ (t `((lambda (signp-arg) (and (numberp signp-arg) ,tst)) +++ ,val)))) +++;-- signphelpfcn +++; not needed for new code anymore +++(def signphelpfcn +++ (lambda (tst val) +++ (cond ((eq 'l tst) (minusp val)) +++ ((eq 'le tst) (or (zerop val) (minusp val))) +++ ((eq 'e tst) (zerop val)) +++ ((eq 'n tst) (not (zerop val))) +++ ((eq 'ge tst) (not (minusp val))) +++ ((eq 'g tst) (greaterp val 0))))) +++ +++ +++;--- unwind-protect +++; The form of a call to unwind-protect is +++; (unwind-protect pform +++; form1 form2 ...) +++; and it works as follows: +++; pform is evaluated, if nothing unusual happens, form1 form2 etc are +++; then evaluated and unwind-protect returns the value of pform. +++; if while evaluating pform, a throw or error caught by an errset which +++; would cause control to pass through the unwind-protect, then +++; form1 form2 etc are evaluated and then the error or throw continues. +++; Thus, no matter what happens, form1, form2 etc will be evaluated. +++; +++(defmacro unwind-protect (protected &rest conseq &aux (localv (gensym 'G))) +++ `((lambda (,localv) +++ (setq ,localv (*catch 'ER%unwind-protect ,protected)) +++ ,@conseq +++ (cond ((and (dtpr ,localv) (eq 'ER%unwind-protect (car ,localv))) +++ (I-throw-err (cdr ,localv))) +++ (t ,localv))) +++ nil)) +++ +++ +++ +++ +++ +++;----Section III -- Interrupt handlers +++; +++ +++(def FPEINT +++ (lambda (x$) (error "Floating Exception "))) +++ +++(def INT +++ (lambda (dummy) (patom '"Interrupt: ") (drain poport) (break))) +++ +++ +++(signal 8 'FPEINT) +++(signal 2 'INT) +++ +++ +++;---- Section IV - interrupt handlers +++; +++(cond ((null (boundp '$gcprint)) +++ (setq $gcprint nil))) ; dont print gc stats by default +++ +++(cond ((null (boundp '$gccount$)) +++ (setq $gccount$ 0))) +++ +++;--- prtpagesused - [arg] : type of page allocated last time. +++; prints a summary of pages used for certain selected types +++; of pages. If arg is given we put a star beside that type +++; of page. This is normally called after a gc. +++; +++(def prtpagesused +++ (nlambda (arg) +++ (patom '"[") +++ (do ((curtypl (cond ((memq (car arg) '(list fixnum )) +++ '(list fixnum)) +++ (t (cons (car arg) '(list fixnum)))) +++ (cdr curtypl)) +++ (temp)) +++ ((null curtypl) (patom '"]") (terpr poport)) +++ (setq temp (car curtypl)) +++ (cond ((greaterp (cadr (opval temp)) 0) +++ (cond ((eq (car arg) temp) +++ (patom '*))) +++ (patom temp) +++ (patom '":") +++ (print (cadr (opval temp))) +++ (patom '"{") +++ (print (fix (quotient +++ (times 100.0 +++ (car (opval temp))) +++ (* (cadr (opval temp)) +++ (caddr (opval temp)))))) +++ (patom '"%}") +++ (patom '"; ")))))) +++ +++(declare (special gcafter-panic-mode)) +++(setq gcafter-panic-mode nil) +++ +++;--- gcafter - [s] : type of item which ran out forcing garbage collection. +++; This is called after each gc. +++; the form of an opval element is (number_of_items_in_use +++; number_of_pages_allocated +++; number_of_items_per_page) +++; +++; +++(def gcafter +++ (nlambda (s) +++ (prog (x pct amt-to-allocate) +++ (cond ((null s) (return))) +++ (cond ((null (boundp '$gccount$)) (setq $gccount$ 0))) +++ (setq $gccount$ (1+ $gccount$)) +++ (setq x (opval (car s))) +++ ; pct is the percentage of space used +++ (setq pct (quotient (car x) +++ (max .00001 (times 1.0 (cadr x) (caddr x))))) +++ (setq amt-to-allocate +++ (cond (gcafter-panic-mode +++ (cond ((greaterp pct .95) +++ (patom "[Storage space totally exausted]") +++ (terpr) +++ (error "Space exausted when allocating " +++ (car s))) +++ (t 0))) +++ ((greaterp pct .80) +++ (max 15 (fix (times .10 (cadr x))))) +++ ((and (greaterp pct .30) (lessp (cadr x) 100)) +++ 15) +++ (t 10))) +++ (cond ((null gcafter-panic-mode) +++ (cond ((atom (errset (allocate (car s) amt-to-allocate))) +++ (cond ($gcprint +++ (patom "[Now in storage allocation panic mode]") +++ (terpr))) +++ (setq gcafter-panic-mode t))))) +++ +++ (cond ($gcprint (apply 'prtpagesused s) +++ (comment (cond ((and (getd 'gcstat) +++ (eq $gcprint '$all)) +++ (print (gcstat)) +++ (terpr))))))))) +++ +++;----Section V - the functions +++; +++ +++;--- append - x : list +++; - y : list +++; [ must appear at the beginning to allow backquote to work ] +++ +++ +++ +++;--- append1 - x : list +++; - y : lispval +++; puts y at the end of list x +++; +++(def append1 (lambda (x y) (append x (list y)))) +++ +++ +++;--- assoc - x : lispval +++; - l : list +++; l is a list of lists. The list is examined and the first +++; sublist whose car equals x is returned. +++; +++(def assoc +++ (lambda (val alist) +++ (do ((al alist (cdr al))) +++ ((null al) nil) +++ (cond ((null (car al))) +++ ((not (dtpr (car al))) +++ (error "bad arg to assoc" al)) +++ ((equal val (caar al)) (return (car al))))))) +++ +++ +++ +++;--- bigp - x : lispval +++; returns t if x is a bignum +++; +++(def bigp (lambda (arg) (equal (type arg) 'bignum))) +++ +++;--- comment - any +++; ignores the rest of the things in the list +++(def comment +++ (nlambda (x) 'comment)) +++ +++;--- concatl - l : list of atoms +++; returns the list of atoms concatentated +++; [ must appear at top to allow defmacro to work ] +++ +++ +++ +++;--- copy - l : list (will work if atom but will have no effect) +++; makes a copy of the list. +++; FIX THIS UP TO REMOVE RECURSION ON TAIL +++; +++(def copy +++ (lambda (l) +++ (cond ((atom l) l) +++ (t (cons (copy (car l)) (copy (cdr l))))))) +++ +++ +++;--- copysymbol - sym : symbol to copy +++; - flag : t or nil +++; generates an uninterned symbol with the same name as sym. If flag is t +++; then the value, function binding and property list of sym are placed +++; in the uninterned symbol. +++; +++(def copysymbol +++ (lambda (sym flag) +++ ((lambda (newsym) +++ (cond (flag (cond ((boundp sym) (set newsym (eval sym)))) +++ (putd newsym (getd sym)) +++ (setplist newsym (plist sym)))) +++ +++ newsym) +++ (uconcat sym)))) +++ +++ +++;--- cvttointlisp -- convert reader syntax to conform to interlisp +++; +++(def cvttointlisp +++ (lambda nil +++ (setsyntax '\% 143.) ; escape character +++ (setsyntax '\\ 2.) ; normal character +++ (setsyntax '\` 2.) ; normal character +++ (setsyntax '\, 2.) ; normal character +++ (sstatus uctolc t) ; one case +++ )) +++ +++ +++;--- cvttomaclisp - converts the readtable to a maclisp character syntax +++; +++(def cvttomaclisp +++ (lambda nil +++ (setsyntax '\| 138.) ; double quoting char +++ (setsyntax '\/ 143.) ; escape +++ (setsyntax '\\ 2) ; normal char +++ ; not needed in new lisp (setsyntax '\" 2) ; normal char +++ (setsyntax '\[ 2) ; normal char +++ (setsyntax '\] 2) ; normal char +++ (sstatus uctolc t))) +++ +++ +++;--- cvttoucilisp - converts the readtable to a ucilisp character syntax +++; +++(def cvttoucilisp +++ (lambda nil +++ (sstatus uctolc t) ; upper case to lower case +++ ; change backquote character. +++ ; to ` and ! and !@ from ` , and ,@ +++ ; undo comma. +++ (cond ((eq (status syntax \,) 205) +++ (setsyntax '\! 'splicing (get '\, 'macro)))) +++ (setsyntax '\, 2) +++ ; +++ ; ~ as comment character, not ; and / instead of \ for escape +++ (setsyntax '\~ 'splicing 'zapline) +++ (setsyntax '\; 2) +++ (setsyntax '\/ 143) +++ (setsyntax '\\ 2))) +++ +++ +++;--- defprop - like putprop except args are not evaled +++; +++(def defprop +++ (nlambda (argl) +++ (putprop (car argl) (cadr argl) (caddr argl) ))) +++ +++;--- delete +++; - val - lispval +++; - lst - list +++; - n - Optional arg, number of occurances to delete +++; removes up to n occurances of val from the top level of lst. +++; if n is not given, all occurances will be removed. +++; +++(def delete +++ (lexpr (nargs) +++ (prog (val lst cur ret nmb) +++ (cond ((< nargs 2) (error " too few args to delete " nargs)) +++ ((= nargs 3) +++ (setq nmb (arg 3)) +++ (cond ((not (greaterp nmb 0)) (return (arg 2)))))) +++ (setq val (arg 1) lst (arg 2)) +++ (cond ((and (atom lst) (not (null lst))) +++ (error " non list arg to delete " lst))) +++ (setq cur (cons nil lst) +++ ret cur) +++ loop +++ (cond ((null lst) (return (cdr ret))) +++ ((equal val (car lst)) +++ (rplacd cur (cdr lst)) +++ (cond ((and nmb (zerop (setq nmb (1- nmb)))) +++ (return (cdr ret))))) +++ (t (setq cur (cdr cur)))) +++ (setq lst (cdr lst)) +++ (go loop)))) +++ +++ +++;--- delq +++; same as delete except eq is used for testing. +++; +++(def delq +++ (lexpr (nargs) +++ (prog (val lst cur ret nmb) +++ (cond ((< nargs 2) (error " too few args to delete " nargs)) +++ ((= nargs 3) +++ (setq nmb (arg 3)) +++ (cond ((not (greaterp nmb 0)) (return (arg 2)))))) +++ (setq val (arg 1) lst (arg 2)) +++ (cond ((and (atom lst) (not (null lst))) +++ (error " non list arg to delete " lst))) +++ (setq cur (cons nil lst) +++ ret cur) +++ loop +++ (cond ((null lst) (return (cdr ret))) +++ ((eq val (car lst)) +++ (rplacd cur (cdr lst)) +++ (cond ((and nmb (zerop (setq nmb (1- nmb)))) +++ (return (cdr ret))))) +++ (t (setq cur (cdr cur)))) +++ (setq lst (cdr lst)) +++ (go loop)))) +++ +++;--- delete - val - s-expression +++; - list - list to delete fromm +++; -[n] optional count , if not specified, it is infinity +++; delete removes every thing in the top level of list which equals val +++; the list structure is modified +++; +++;(def delete +++; (lexpr (nargs) +++; ((lambda (val list n) +++; (cond ((or (null list) (zerop n)) list) +++; ((atom list) (error "Bad arg to delete " list)) +++; ((equal val (car list)) +++; (delete val (cdr list) (1- n))) +++; (t (rplacd list (delete val (cdr list) n))))) +++; (arg 1) +++; (arg 2) +++; (cond ((equal nargs 3) (arg 3)) +++; (t 99999999))))) +++; +++; +++;--- delq - val - s-expression +++; - list - list to delete fromm +++; -[n] optional count , if not specified, it is infinity +++; delq removes every thing in the top level of list which eq's val +++; the list structure is modified +++; +++;(def delq +++; (lexpr (nargs) +++; ((lambda (val list n) +++; (cond ((or (atom list) (zerop n)) list) +++; ((eq val (car list)) +++; (delq val (cdr list) (1- n))) +++; (t (rplacd list (delq val (cdr list) n))))) +++; (arg 1) +++; (arg 2) +++; (cond ((equal nargs 3) (arg 3)) +++; (t -1))))) +++; +++;--- evenp : num - return +++; +++; +++(def evenp +++ (lambda (n) +++ (cond ((not (zerop (boole 4 1 n))) t)))) +++ +++;--- ex [name] : unevaluated name of file to edit. +++; the ex editor is forked to edit the given file, if no +++; name is given the previous name is used +++; +++(def ex (nlambda (x) (exvi 'ex x nil))) +++ +++(def exvi +++ (lambda (cmd x doload) +++ (prog (handy handyport bigname) +++ (cond ((null x) (setq x (list edit_file))) +++ (t (setq edit_file (car x)))) +++ (setq bigname (concat (car x) '".l")) +++ (cond ((setq handyport (car (errset (infile bigname) nil))) +++ (close handyport) +++ (setq handy bigname)) +++ (t (setq handy (car x)))) +++ (setq handy (concat cmd '" " handy)) +++ (setq handy (list 'process handy)) +++ (eval handy) +++ (cond (doload (load edit_file)))))) +++ +++;--- exec - arg1 [arg2 [arg3 ...] ] unevaluated atoms +++; A string of all the args concatenated together seperated by +++; blanks is forked as a process. +++; +++(def exec +++ (nlambda ($list) +++ (prog ($handy) +++ (setq $handy (quote "")) +++ loop (cond ((null $list) +++ (return (eval (list (quote process) $handy)))) +++ (t (setq $handy +++ (concat (concat $handy (car $list)) +++ (quote " "))) +++ (setq $list (cdr $list)) +++ (go loop)))))) +++ +++ +++;--- exl - [name] : unevaluated name of file to edit and load. +++; If name is not given the last file edited will be used. +++; After the file is edited it will be `load'ed into lisp. +++; +++(def exl (nlambda (x) (exvi 'ex x t))) +++ +++;----- explode functions ------- +++; These functions, explode , explodec and exploden, implement the +++; maclisp explode functions completely. +++; They have a similar structure and are written with efficiency, not +++; beauty in mind (and as a result they are quite ugly) +++; The basic idea in all of them is to keep a pointer to the last +++; thing added to the list, and rplacd the last cons cell of it each time. +++; +++;--- explode - arg : lispval +++; explode returns a list of characters which print would use to +++; print out arg. Slashification is included. +++; +++(def explode +++ (lambda (arg) +++ (cond ((atom arg) (aexplode arg)) +++ (t (do ((ll (cdr arg) (cdr ll)) +++ (sofar (setq arg (cons '"(" (explode (car arg))))) +++ (xx)) +++ ((cond ((null ll) (rplacd (last sofar) (ncons '")" )) +++ t) +++ ((atom ll) (rplacd (last sofar) +++ `(" " "." " " ,@(explode ll) +++ ,@(ncons '")"))) +++ t)) +++ arg) +++ (setq xx (last sofar) +++ sofar (cons '" " (explode (car ll)))) +++ (rplacd xx sofar)))))) +++ +++;--- explodec - arg : lispval +++; returns the list of character which would be use to print arg assuming that +++; patom were used to print all atoms. +++; that is, no slashification would be used. +++; +++(def explodec +++ (lambda (arg) +++ (cond ((atom arg) (aexplodec arg)) +++ (t (do ((ll (cdr arg) (cdr ll)) +++ (sofar (setq arg (cons '"(" (explodec (car arg))))) +++ (xx)) +++ ((cond ((null ll) (rplacd (last sofar) (ncons '")" )) +++ t) +++ ((atom ll) (rplacd (last sofar) +++ `(" " "." " " ,@(explodec ll) +++ ,@(ncons '")"))) +++ t)) +++ arg) +++ (setq xx (last sofar) +++ sofar (cons '" " (explodec (car ll)))) +++ (rplacd xx sofar)))))) +++ +++;--- exploden - arg : lispval +++; returns a list just like explodec, except we return fixnums instead +++; of characters. +++; +++(def exploden +++ (lambda (arg) +++ (cond ((atom arg) (aexploden arg)) +++ (t (do ((ll (cdr arg) (cdr ll)) +++ (sofar (setq arg (cons 40. (exploden (car arg))))) +++ (xx)) +++ ((cond ((null ll) (rplacd (last sofar) (ncons 41.)) +++ t) +++ ((atom ll) (rplacd (last sofar) +++ `(32. 46. 32. ,@(exploden ll) +++ ,@(ncons 41.))) +++ t)) +++ arg) +++ (setq xx (last sofar) +++ sofar (cons 32. (exploden (car ll)))) +++ (rplacd xx sofar)))))) +++ +++;-- expt - x +++; - y +++; +++; y +++; returns x +++; +++(defun expt (x y) +++ (cond ((equal x 1) x) +++ ((zerop x) x) ; Maclisp does this +++ ((lessp y 0) (quotient 1.0 (expt x (times -1 y)))) +++ ((floatp y) +++ (exp (times y (log x)))) ; bomb out for (-3)^4 or (-3)^4.0 or 0^y. +++ (t ; y is integer, y>= 0 +++ (prog (res) +++ (setq res 1) +++ loop +++ (cond ((equal y 0) (return res)) +++ ((oddp y)(setq res (times res x) y (1- y))) +++ (t (setq x (times x x) y (/ y 2)))) +++ (go loop))))) +++ +++ +++;--- expt +++; old +++'(defun expt(x y) +++ (prog (res) +++ (setq res 1) +++ loop (cond ((equal y 0) (return res)) +++ (t (setq res (times x res) +++ y (1- y)))) +++ (go loop))) +++ +++;--- ffasl :: fasl in a fortran file +++; arg # +++; 1 - fnam : file name +++; 2 - entry : entry point name +++; 3 - fcn : entry name +++; 4 - disc : optional discipline +++ +++(defun ffasl (fnam entry fcn &optional (disc 'subroutine)) +++ (cfasl fnam entry fcn disc "-lI77 -lF77 -lm")) +++ +++ +++; +++; filepos function (maclisp compatibility) +++; +++(defun filepos n +++ (cond ((zerop n) nil) +++ ((onep n) +++ (fseek (arg 1) 0 1)) +++ ((equal n 2) +++ (fseek (arg 1) (arg 2) 0)))) +++ +++;--- fixp - l : lispval +++; returns t if l is a fixnum or bignum +++; +++(defun fixp (x) (or (equal (type x) 'fixnum) +++ (equal (type x) 'bignum))) +++ +++ +++ +++;--- flatsize - l : lispval +++; the second arg should be: +++; - n : limit for what we care about +++; but we dont care about this at present, since we have +++; to explode the whole thing anyway. +++; returns the number of characters which print would +++; use to print l +++; +++(defun flatsize n +++ (length (explode (arg 1)))) +++ +++ +++;--- floatp - l : lispval +++; returns t if l is a flonum +++; +++(defun floatp (x) (equal 'flonum (type x))) +++ +++ +++;--- getchar,getcharn - x : atom +++; - n : fixnum +++; returns the n'th character of x's pname (the first corresponds to n=1) +++; if n is negative then it counts from the end of the pname +++; if n is out of bounds, nil is returned +++ +++(def getchar +++ (lambda (x n) +++ (concat (substring x n 1)))) +++ +++ +++(def getcharn +++ (lambda (x n) +++ (substringn x n 0))) +++ +++ +++(def getl +++ (lambda (atm lis) +++ (do ((ll (cond ((atom atm) (plist atm)) +++ (t (cdr atm))) +++ (cddr ll))) +++ ((null ll) nil) +++ (cond ((memq (car ll) lis) (return ll)))))) +++ +++ +++;--- help +++; retrive selected portions of the Franz Lisp manual. +++; There are four types of help offered: +++; (help) prints a description of the other three options +++; (help tc) prints a table of contents. +++; (help n) {where n is a number or b or c} prints the whole chapter. +++; (help fcn) prints info on function fcn +++; +++; An index to the functions is kept in the documentation directory. +++; The index has entries like (append ch2.r). +++; When asked to print info on a function, it locates the chapter +++; using the index then asks more to locate the definition. +++; +++(declare (localf locatefunction)) +++ +++(defun help fexpr (lis) +++ (cond ((null lis) +++ (patom "type (help fnc) for info on function fnc")(terpr) +++ (patom "type (help n) to see chapter n")(terpr) +++ (patom "type (help tc) for a table of contents")(terpr)) +++ (t (do ((ll lis (cdr ll)) +++ (fcn)) +++ ((null ll)) +++ (cond ((not (atom (setq fcn (car ll)))) +++ (patom "Bad option to help ")(print fcn)(terpr)) +++ ((and (stringp fcn) (setq fcn (concat fcn)) nil)) +++ ((eq fcn 'tc) +++ (patom "Table of contents")(terpr) +++ (patom "1 - intro; 2 - data structure; 3 - arithmetic; 4 - special")(terpr) +++ (patom "5 - i/o; 6 - system; 7 - reader; 8 - functions; 9 - arrays")(terpr) +++ (patom "10 - exceptions; 11 - trace package; 12 - Liszt;")(terpr) +++ (patom "b - special symbols; c - gc & debugging & top level ")(terpr)) +++ ((or (and (numberp fcn) (lessp fcn 13) (greaterp fcn -1)) +++ (memq fcn '(b c))) +++ (apply 'process +++ (ncons (concat '|/usr/ucb/more /usr/lib/lisp/manual/ch| +++ fcn '|.r|)))) +++ ((locatefunction fcn)) +++ (t (patom "Unknown function: ")(print fcn)(terpr))))))) +++ +++(declare (special readtable)) +++ +++(defun locatefunction (fc) +++ (let (x inf ) +++ (cond ((null (get 'append 'helplocation)) +++ (patom "[Reading help index]")(drain) +++ (setq inf (infile "/usr/lib/lisp/manual/helpindex")) +++ (do ((readtable (makereadtable t)) +++ (x (read inf) (read inf))) +++ ((null x) (close inf) (terpr)) +++ (cond ((null (cddr x)) +++ (putprop (car x) (cadr x) 'helplocation)) +++ (t (putprop (concat (car x) " " (cadr x)) +++ (caddr x) +++ 'helplocation)))))) +++ (cond ((setq x (get fc 'helplocation)) +++ (apply 'process (ncons (concat '|/usr/ucb/more "+/(| fc +++ '|" /usr/lib/lisp/manual/| x))) +++ t)))) +++ +++; +++; (hunk 'g_arg1 [...'g_argn]) +++; +++; This function makes a hunk. The hunk is preinitialized to the +++; arguments present. The size of the hunk is determined by the +++; number of arguments present. +++; +++(defun hunk n +++ (prog (size) +++ (setq size -1) +++ (cond ((greaterp n 128) (error "hunk: size is too big" n)) +++ (t (setq size (1- (haulong n))))) +++ (cond ((minusp size) (return nil))) ;Hunk of zero length +++ (setq size (*makhunk size)) +++ (do +++ ((argnum 1)) +++ ((greaterp argnum n)) +++ (*rplacx (1- argnum) size (arg argnum)) +++ (setq argnum (1+ argnum))) +++ (return size))) +++ +++ +++;--- last - l : list +++; returns the last cons cell of the list, NOT the last element +++; +++(def last +++ (lambda (a) +++ (do ((ll a (cdr ll))) +++ ((null (cdr ll)) ll)))) +++ +++;---- load +++ +++(declare (localf load-a-file)) +++(defun load (filename &rest fasl-args) +++ (cond ((not (or (symbolp filename) (stringp filename))) +++ (error "load: illegal filename " filename))) +++ (let ( load-only fasl-only no-ext len search-path name pred) +++ +++ (setq len (flatc filename)) +++ (cond ((> len 2) +++ (cond ((eq (getchar filename (1- len)) '|.|) +++ (cond ((eq (getchar filename len) '|o|) +++ (setq fasl-only t)) +++ (t (setq load-only t)))) +++ (t (setq no-ext t)))) +++ (t (setq no-ext t))) +++ +++ (cond ((and (> len 0) (eq (getchar filename 1) '/)) +++ (setq search-path '(||))) +++ (t (setq search-path (status load-search-path)))) +++ (do ((xx search-path (cdr xx))) +++ ((null xx) (error "load: file not found " filename)) +++ (setq pred (cond ((memq (car xx) '(|| |.|)) '||) +++ (t (concat (car xx) "/")))) +++ (cond (no-ext +++ (cond ((probef (setq name (concat pred +++ filename +++ ".o"))) +++ (return (fasl name (car fasl-args) +++ (cadr fasl-args)))) +++ ((probef (setq name (concat pred filename ".l"))) +++ (return (load-a-file name))) +++ ((probef (setq name (concat pred filename))) +++ (return (load-a-file name))))) +++ (fasl-only +++ (cond ((probef (setq name (concat pred filename))) +++ (return (fasl name (car fasl-args) +++ (cadr fasl-args)))))) +++ (load-only +++ (cond ((probef (setq name (concat pred filename))) +++ (return (load-a-file name))))))))) +++ +++(defun load-a-file (name) +++ (let ((piport (infile name)) +++ (eof (list nil))) +++ (do ((form (read piport eof) (read piport eof))) +++ ((eq eof form) (close piport) t) +++ (eval form)))) +++ +++(sstatus load-search-path (|.| /usr/lib/lisp)) +++;--- include - read in the file name given, the name not evaluated +++; +++(def include (nlambda (l) (load (car l)))) +++ +++;--- includef - read in the file name given and eval the first arg +++; +++(def includef (lambda (l) (load l))) +++ +++;--- length - l : list +++; returns the number of elements in the list. +++; +++(def length +++ (lambda ($l$) +++ (cond ((null $l$) 0) +++ (t (do ((ll (cdr $l$) (cdr ll)) +++ (i 1 (1+ i))) +++ ((null ll) i)))))) +++ +++ +++ +++;--- macroexpand - form +++; expands out all macros it can +++; +++(def macroexpand +++ (lambda (form) +++ (prog nil +++ top (cond ((atom form) (return form)) +++ ((atom (car form)) +++ (return +++ (let ((nam (car form)) def disc) +++ (setq def (getd nam)) +++ (setq disc (cond ((bcdp def) (getdisc def)) +++ (t (car def)))) +++ (cond ((memq disc '(nlambda lambda lexpr nil)) +++ (cons nam (mapcar 'macroexpand (cdr form)))) +++ ((eq disc 'macro) +++ (setq form (apply nam form)) +++ (go top)))))) +++ (t (return (cons (macroexpand (car form)) +++ (mapcar 'macroexpand (cdr form))))))))) +++ +++ +++ +++ +++; +++; (makhunk 'n) +++; +++; This function is similar to hunk, except that: +++; +++; n can be a fixnum, which specifies the length of the hunk. +++; The hunk is preinitialized to nil's +++; n can be a list which is used to preinitialize the hunk. +++; +++(defun makhunk (n) +++ (prog (size Hunk) +++ (setq size -1) +++ (cond ((numberp n) +++; +++; If n is a number then build a nil hunk of the right size +++; +++ (cond ((greaterp n 128) (error "makhunk: size is too big" n)) +++ (t (setq size (1- (haulong n))))) +++ (cond ((minusp size) (return nil))) +++ (setq Hunk (*makhunk size)) +++ (do +++ ((i 0 (1+ i))) +++ ((equal i n)) +++ (*rplacx i Hunk nil)) +++ (return Hunk)) +++; +++; If it isn't a number, then try hunk on it +++; +++ (t (apply 'hunk n))))) +++ +++;--- member - VAL : lispval +++; - LIS : list +++; returns that portion of LIS beginning with the first occurance +++; of VAL if VAL is found at the top level of list LIS. +++; uses equal for comparisons. +++; +++(def member +++ (lambda ($a$ $l$) +++ (do ((ll $l$ (cdr ll))) +++ ((null ll) nil) +++ (cond ((equal $a$ (car ll)) (return ll)))))) +++ +++;--- memq - arg : (probably a symbol) +++; - lis : list +++; returns part of lis beginning with arg if arg is in lis +++; +++; [ defintion moved to top of file to allow backquote macro to work ] +++ +++;--- min - arg1 ... numbers +++; +++; returns minimum of n numbers. +++; +++ +++(def min +++ (lexpr (nargs) +++ (do ((i nargs (1- i)) +++ (min (arg 1))) +++ ((lessp i 2) min) +++ (cond ((lessp (arg i) min) (setq min (arg i))))))) +++ +++;--- nconc - x1 x2 ...: lists +++; The cdr of the last cons cell of xi is set to xi+1. This is the +++; structure modification version of append +++; +++ +++(def nconc +++ (lexpr (nargs) +++ (cond ((eq nargs '2) +++ (cond ((null (arg 1)) (arg 2)) +++ (t (do ((tmp (arg 1) (cdr tmp))) +++ ((null (cdr tmp)) +++ (rplacd tmp (arg 2)) +++ (arg 1)))))) +++ ((zerop nargs) nil) +++ (t (do ((i 1 nxt) +++ (nxt 2 (1+ nxt)) +++ (res (cons nil (arg 1)))) +++ ((eq i nargs) (cdr res)) +++ (cond ((arg i) (rplacd (last (arg i)) (arg nxt))) +++ (t (rplacd (last res) (arg nxt))))))))) +++ +++ +++ +++;--- nreverse - l : list +++; reverse the list in place +++; +++ +++(defun nreverse (x) +++ (cond ((null x) x) +++ (t (prog (back nxt) +++ loop +++ (setq nxt (cdr x)) +++ (rplacd x back) +++ (setq back x) +++ (cond (nxt (setq x nxt) (go loop))) +++ (return x))))) +++ +++; +++(def oddp +++ (lambda (n) +++ (cond ((not (zerop (boole 1 1 n))) t)))) +++ +++;--- plusp : x - number +++; returns t iff x is greater than zero +++ +++(def plusp +++ (lambda (x) +++ (greaterp x 0))) +++ +++ +++;--- princ : l - any s-expression +++; [p] - port to write to +++; prints using patom for atoms (unslashified) +++; +++(def princ +++ (lexpr (n) +++ (prog (port val) +++ (cond ((eq n 2) (setq port (arg 2)))) +++ (cond ((dtpr (setq val (arg 1))) +++ (cond ((and (eq 'quote (car val)) +++ (dtpr (cdr val)) +++ (null (cddr val))) +++ (patom "'") +++ (princ (cadr val))) +++ (t +++ (patom "(" port) +++ (do ((xx val)) +++ ((null xx) (patom ")" port)) +++ (princ (car xx) port) +++ (cond ((null (setq xx (cdr xx)))) +++ ((not (dtpr xx)) +++ (patom " . " port) +++ (princ xx port) +++ (setq xx nil)) +++ (t (patom " " port))))))) +++ (t (patom val port))) +++ (return t)))) +++ +++;--- prog1 : return the first value computed in a list of forms +++; +++(def prog1 +++ (lexpr (n) +++ (arg 1))) +++ +++;--- reverse : l - list +++; returns the list reversed using cons to create new list cells. +++; +++(def reverse +++ (lambda (x) +++ (cond ((null x) nil) +++ (t (do ((cur (cons (car x) nil) +++ (cons (car res) cur)) +++ (res (cdr x) (cdr res))) +++ ((null res) cur)))))) +++ +++;--- shell - invoke a new c shell +++; +++(def shell +++ (lambda nil +++ ((lambda (shellname) +++ (cond ((lessp (flatc shellname) 1) (setq shellname 'csh))) +++ (apply 'process (ncons shellname))) +++ (getenv 'SHELL)))) +++ +++ +++;--- sload : fn - file name (must include the .l) +++; loads in the file printing each result as it is seen +++; +++(def sload +++ (lambda (fn) +++ (prog (por) +++ (cond ((setq por (infile fn))) +++ (t (patom '"bad file name")(terpr)(return nil))) +++ (do ((x (read por) (read por))) +++ ((eq 'eof x)) +++ (print x) +++ (eval x))))) +++ +++; these is the old sort functions +++(comment +++(defun sort(a fun) +++ (prog (n) +++ (cond ((null a) (return nil)) ;no elements +++ (t +++ (setq n (length a)) +++ (do i 1 (1+ i) (greaterp i n)(sorthelp a fun)) +++ (return a) )))) +++ +++(defun sorthelp (a fun) +++ (do ((ii a (cdr ii))) +++ ((null (cdr ii))) +++ (cond ((funcall fun (cadr ii) (car ii)) +++ (exchange2 ii))))) +++ +++) +++ +++;---- bubble merge sort +++; it recursively splits the list to sort until the list is small. At that +++; point it uses a bubble sort. Finally the sorted lists are merged. +++ +++(declare (special sort-function)) +++ +++;--- sort :: sort a lisp list +++; args: lst - list of items +++; fcn - function to compare two items. +++; returns: the list with such that for each pair of adjacent elements, +++; either the elements are equal, or fcn applied to the two +++; args returns a non nil value. +++; +++(defun sort (lst fcn) +++ (setq sort-function fcn) ; store function name in global cell +++ ; (setq sort-compares 0) ; count number of comparisons +++ (sortmerge lst (length lst))) +++ +++ +++;--- sortmerge :: utility routine to sort +++; args: lst - list of items to sort +++; nitems - a rough idea of how many items are in the list +++; +++; result - sorted list (see the result of sort above) +++; +++(defun sortmerge (lst nitems) +++ (prog (tmp tmp2) +++ (cond ((greaterp nitems 7) +++ ; do a split and merge +++ (setq tmp (splitlist lst (setq tmp2 (quotient nitems 2)))) +++ (return (mergelists (sortmerge (car tmp) tmp2) +++ (sortmerge (cdr tmp) tmp2)))) +++ (t ; do a bubble sort +++ (do ((l lst (cdr l)) +++ (fin)) +++ ((null l)) +++ (do ((ll lst (cdr ll))) +++ ((eq fin (cdr ll)) (setq fin ll)) +++ ;(setq sort-compares (1+ sort-compares)) +++ (cond ((not (funcall sort-function (car ll) (cadr ll))) +++ (rplaca ll (prog1 (cadr ll) +++ (rplaca (cdr ll) +++ (car ll)))))))) +++ (return lst))))) +++ +++;--- splitlist :: utility routine to split a list +++; args : lst - list to split +++; spliton - number of items to put in the first list +++; +++; returns: a cons cell whose car is the first part of the list +++; and whose cdr is the second part. +++; +++(defun splitlist (lst spliton) +++ (prog (second) +++ (do ((i spliton (sub1 i)) +++ (l lst)) +++ ((or (null (cdr l)) (zerop i)) +++ (setq second (cdr l)) +++ (rplacd l nil)) +++ (setq l (cdr l))) +++ (return (cons lst second)))) +++ +++ +++;--- mergelists ::utility routine to merge two lists based on predicate function +++; args: ls1 - lisp list +++; ls2 - lisp list +++; sort-function (global) - compares items of the lists +++; +++; returns: a sorted list containing the elements of the two lists. +++; +++(defun mergelists (ls1 ls2) +++ (prog (result current) +++ ; initialize +++ (setq current (setq result (cons nil nil))) +++loop (cond ((null ls1) +++ (rplacd current ls2) +++ (return (cdr result))) +++ ((null ls2) +++ (rplacd current ls1) +++ (return (cdr result))) +++ ((funcall sort-function (car ls1) (car ls2)) +++ ;(setq sort-compares (1+ sort-compares)) +++ (rplacd current ls1) +++ (setq current ls1 +++ ls1 (cdr ls1))) +++ (t ;(setq sort-compares (1+ sort-compares)) +++ (rplacd current ls2) +++ (setq current ls2 +++ ls2 (cdr ls2)))) +++ (go loop))) +++ +++;--- end bubble merge sort +++ +++ +++(defun sortcar (a fun) +++ (prog (n) +++ (cond ((null a) (return nil)) ;no elements +++ (t +++ (setq n (length a)) +++ (do i 1 (1+ i) (greaterp i n)(sortcarhelp a fun)) +++ (return a) )))) +++ +++(defun sortcarhelp (a fun) +++ (cond ((null (cdr a)) a) +++ ((funcall fun (caadr a) (caar a)) +++ (exchange2 a) +++ (sortcarhelp (cdr a) fun)) +++ (t (sortcarhelp (cdr a) fun)))) +++ +++ +++(defun exchange2 (a) +++ (prog (temp) +++ (setq temp (cadr a)) +++ (rplaca (cdr a) (car a)) +++ (rplaca a temp))) +++ +++;--- sublis: alst - assoc list ((a . val) (b . val2) ...) +++; exp - s-expression +++; for each atom in exp which corresponds to a key in alst, the associated +++; value from alst is substituted. The substitution is done by adding +++; list cells, no struture mangling is done. Only the minimum number +++; of list cells will be created. +++; +++(def sublis +++ (lambda (alst exp) +++ (let (tmp) +++ (cond ((atom exp) +++ (cond ((setq tmp (assoc exp alst)) +++ (cdr tmp)) +++ (t exp))) +++ ((setq tmp (sublishelp alst exp)) +++ (car tmp)) +++ (t exp))))) +++ +++;--- sublishelp : alst - assoc list +++; exp - s-expression +++; this function helps sublis work. it is different from sublis in that +++; it return nil if no change need be made to exp, or returns a list of +++; one element which is the changed exp. +++; +++(def sublishelp +++ (lambda (alst exp) +++ (let (carp cdrp) +++ (cond ((atom exp) +++ (cond ((setq carp (assoc exp alst)) +++ (list (cdr carp))) +++ (t nil))) +++ (t (setq carp (sublishelp alst (car exp)) +++ cdrp (sublishelp alst (cdr exp))) +++ (cond ((not (or carp cdrp)) nil) ; no change +++ ((and carp (not cdrp)) ; car change +++ (list (cons (car carp) (cdr exp)))) +++ ((and (not carp) cdrp) ; cdr change +++ (list (cons (car exp) (car cdrp)))) +++ (t ; both change +++ (list (cons (car carp) (car cdrp)))))))))) +++ +++ +++;--- subst : new - sexp +++; old - sexp +++; pat - sexp +++; substitutes in patrn all occurrences equal to old with new and returns the +++; result +++; MUST be put in the manual +++ +++(declare (special new old)) +++ +++(def subst +++ (lambda (new old pat) +++ (cond ((symbolp old) (substeq pat)) +++ (t (substequal pat))))) +++ +++;use this function for substituting for symbols +++(def substeq +++ (lambda (pat) +++ (cond ((eq old pat) new) +++ ((atom pat) pat) +++ (t (cons (substeq (car pat))(substeq (cdr pat))))))) +++ +++(def substequal +++ (lambda (pat) +++ (cond ((equal old pat) new) +++ ((atom pat) pat) +++ (t (cons (substequal (car pat)) +++ ; in interlisp, the next line would be +++ ;(substeq (cdr pat)) +++ ; for maclisp compatibility, we do this. +++ (substequal (cdr pat))))))) +++ +++(declare (unspecial new old)) +++;--- vi: arg is unevaluated name of function to run vi on +++; +++(def vi (nlambda (x) (exvi 'vi x nil))) +++ +++;--- vil : arg is unevaluated, edits file and then loads it +++; +++(def vil (nlambda (x) (exvi 'vi x t))) +++ +++;--- xcons : a - sexp +++; b - sexp +++; returns (b . a) that is, it is an exchanged cons +++; +++(def xcons (lambda (a b) (cons b a))) +++ +++ +++;--- Section VI - ARRAY functions . +++; +++(def array +++ (macro ($lis$) +++ `(*array ',(cadr $lis$) ',(caddr $lis$) ,@(cdddr $lis$)))) +++ +++ +++ +++;--OLD array stuff. new stuff to follow +++; array access function +++; +++; (def arracfun +++; (lambda (actlst ardisc) +++; (prog (diml ind val) +++; +++; (setq actlst (mapcar 'eval actlst) +++; diml (getaux ardisc)) +++; +++; (cond ((null (equal (length actlst) +++; (length (cdr diml)))) +++; (break '"Wrong number of indexes to array ref")) +++; +++; (t (setq ind (arrcomputeind (cdr actlst) +++; (cddr diml) +++; (car actlst)) +++; val (arrayref ardisc ind)) +++; (cond ((or (eq (car diml) t) +++; (eq (car diml) 'unmarked_array)) +++; (setq val (eval val))) +++; (t (setq val (cpy1 val)))) +++; (return val)))))) +++; +++; +++; +++; +++;(def *array +++; (lexpr (nargs) +++; (prog (name type rtype dims size tname) +++; +++; (setq name (arg 1) +++; type (arg 2) +++; rtype (cond ((null type) (setq type 'unmarked_array) +++; 'value) +++; ((equal type t) +++; 'value) +++; (t type)) +++; dims (do ((i 3 (1+ i)) +++; (res nil (cons (arg i) res))) +++; ((greaterp i nargs) (nreverse res))) +++; size (apply 'times dims)) +++; +++; (setq tname (marray (segment rtype size) +++; (getd 'arracfun) +++; (cons type dims) +++; size +++; (sizeof rtype))) +++; (cond (name (set name tname) +++; (putd name tname))) +++; '(fillarray tname (cond ((eq type 'fixnum) '(0)) +++; ((eq type 'flonum) '(0.0)) +++; (t '(nil)))) +++; (return tname)))) +++; +++;(defmacro arraycall (type name &rest indexs) +++; `(ev-arraycall ',type ,name (list ,@ indexs))) +++; +++; +++;(def ev-arraycall +++; (lambda (type ardisc indexs) +++; ; form (arraycall type name sub1 sub2 ... subn) +++; (cond ((or (not (equal (car (getaux ardisc)) type)) +++; (and (eq (car (getaux ardisc)) 'unmarked_array) +++; type)) +++; +++; (patom '" Type given arraycall:") +++; (patom type) +++; (patom '" doesn't match array type:") +++; (patom (car (getaux ardisc))) +++; (break nil))) +++; (apply (getaccess ardisc) +++; (list indexs ardisc)))) +++; +++; +++; +++; +++;; function to compute the raw array index +++; +++;(def arrcomputeind +++; (lambda (indl diml res) +++; (cond ((null diml) res) +++; (t (arrcomputeind (cdr indl) +++; (cdr diml) +++; (+ (* res (car diml)) +++; (car indl))))))) +++; +++;; store +++;; we make store a macro to insure that all parts are evaluated at the +++;; right time even if it is compiled. +++;; (store (foo 34 i) (plus r f)) +++;; gets translated to +++;; (storeintern foo (plus r f) (list 34 i)) +++;; and storeintern is a lambda, so when foo is evaluated it will pass the +++;; array descriptor to storeintern, so storeintern can look at the +++;; aux part to determine the type of array. +++;; +++;(defmacro store ( (arrname . indexes) value) +++; (prog nil +++; +++; loop +++; (cond +++; ((eq 'funcall arrname) +++; (setq arrname `(getd ,(car indexes)) +++; indexes (cdr indexes))) +++; ((eq 'arraycall arrname) +++; (setq arrname (cadr indexes) +++; indexes (cddr indexes))) +++; ((and ((lambda (fnd) +++; (cond ((or (and (dtpr fnd) (eq 'macro (car fnd))) +++; (and (bcdp fnd) (eq 'macro (getdisc fnd)))) +++; (setq fnd (apply arrname (cons arrname indexes))) +++; (setq arrname (car fnd) +++; indexes (cdr fnd))))) +++; (getd arrname)) +++; (go loop))) +++; (t (setq arrname `(getd ',arrname)))) +++; (return `(storeintern ,arrname ,value (list ,@indexes))))) +++; +++;;-- storeintern - internal store function +++;; - arrnam : array descriptor +++;; - vl : value to store +++;; - actlst : list of actual variable values +++;; +++;(def storeintern +++; (lambda (arrnam vl actlst) +++; (prog (loc) +++; (cond ((or (eq t (car (getaux arrnam))) +++; (eq 'unmarked_array (car (getaux arrnam)))) +++; (setq loc (arracfcnsimp actlst arrnam)) +++; (set loc vl)) +++; +++; (t (replace (arracfcnsimp actlst arrnam) vl))) +++; (return vl)))) +++; +++; +++;(def arracfcnsimp +++; (lambda (indexes adisc) +++; (prog (dims) +++; (setq dims (cdr (getaux adisc))) +++; (cond ((null (equal (length indexes) +++; (length dims))) +++; (break '"wrong number of indexes to array")) +++; (t (setq dims (arrcomputeind (cdr indexes) +++; (cdr dims) +++; (car indexes))))) +++; (return (arrayref adisc dims))))) +++; +++; +++ +++ +++;; new array package (jkf 9/24/80) +++; features of the new package: +++; Most array will be notype arrays. This is because they are the most +++; efficient in Franz. What used to be fixnum and flonums arrays are +++; now fixnum-block and flonum-block arrays. +++; The array access functions are more specialized and much faster now. +++; The array access functions have different semantics. Now they are +++; responsible for both accessing and storing in an array. +++; When an access function is asked to access a value, it will be given +++; the subscripts already evaluated and the array object. These will +++; be stacked, so the array access function should be a lexpr to read them. +++; When an access function is asked to store a value that value will be +++; the first argument, the subscripts will follow and finally there will +++; be the array object. +++; It is up to the access function to determine if it is being asked to +++; store or retrieve a value, and this determination will probably +++; be made by looking at the number of arguments. +++ +++(declare (special gcdisable)) +++ +++(def *array +++ (lexpr (nargs) +++ (prog (name type rtype dims size tname numdims) +++ +++ (cond ((lessp (setq numdims (- nargs 2)) 1) +++ (error "no bounds to array declaration "))) +++ +++ (setq name (arg 1) +++ type (arg 2) +++ rtype (cond ((memq type '(t nil fixnum flonum)) +++ 'value) +++ ((eq type 'fixnum-block) +++ 'fixnum) +++ ((eq type 'flonum-block) +++ 'flonum) +++ (t (error "array: bad type: " type))) +++ dims (do ((i nargs (1- i)) +++ (res nil (cons (arg i) res))) +++ ((eq i 2) res)) +++ +++ size (apply 'times dims)) +++ +++ (cond ((null type) (setq type 'unmarked_array))) +++ +++ ; we disable gc during the next calculation since +++ ; the data returned from small-segment is unprotected +++ ; and a gc would cause its data to be put on the +++ ; free list. +++ (let ((gcdisable t)) +++ (setq tname +++ (marray (small-segment rtype size) +++ (cond ((eq rtype 'value) +++ (cond ((eq numdims 1) +++ (getd 'arrac-oneD)) +++ ((eq numdims 2) +++ (getd 'arrac-twoD)) +++ (t (getd 'arrac-nD)))) +++ (t (getd 'arrac-nD))) +++ (cons type dims) +++ size +++ (sizeof rtype)))) +++ ; if type is fixnum or flonum +++ ; we must intialize to 0 or 0.0 +++ (cond ((or (and (eq 'fixnum type) +++ (setq rtype 0)) +++ (and (eq 'flonum type) +++ (setq rtype 0.0))) +++ (do ((i size)) +++ ((zerop i)) +++ (set (arrayref tname (setq i (1- i))) rtype)))) +++ +++ (cond (name (putd name tname))) +++ (return tname)))) +++ +++(defmacro arraycall (type array &rest indexes) +++ `(funcall ,array ,@indexes)) +++ +++; this is used by the old array scheme. Keep this around until +++; everything is recompiled +++ +++(defun ev-arraycall (type array indexes) +++ (apply array indexes)) +++ +++ +++;;;---- array access functions. +++ +++; we first define a macro to evaluate a value cell. In compiled code cdr +++; is the fastest way to do this, in interpreted code the type checker +++; would not let us use cdr so we have to use eval. +++(eval-when (compile) +++ (defmacro value-eval (x) `(cdr ,x))) ; one level of indirection +++ +++(eval-when (eval) +++ (defun value-eval (x) (eval x))) +++ +++;- one dimensional +++(defun arrac-oneD n +++ (cond ((eq n 2) (value-eval (arrayref (arg 2) (arg 1)))) +++ ((eq n 3) (set (arrayref (arg 3) (arg 2)) (arg 1))) +++ (t (error " wrong number of subscripts to array: " (arg n))))) +++ +++(defun arrac-twoD n +++ (let ((aux (getaux (arg n)))) +++ (cond ((eq n 3) +++ (value-eval (arrayref (arg n) (+ (* (arg 1) (caddr aux)) (arg 2))))) +++ ((eq n 4) +++ (set (arrayref (arg n) (+ (* (arg 2) (caddr aux)) (arg 3))) +++ (arg 1))) +++ (t (error " wrong number of subscripts to array: " (arg n)))))) +++ +++;-- n dimensional array access function. +++(defun arrac-nD n +++ (let ((aux (getaux (arg n))) +++ firstsub subs +++ store +++ (index 0)) +++ +++ (setq subs (length (cdr aux))) +++ (cond ((eq n (1+ subs)) +++ (setq firstsub 1)) +++ ((eq n (+ 2 subs)) +++ (setq firstsub 2 store t)) +++ (t (error "wrong number of subscripts to array: " (arg n)))) +++ +++ (setq index (arg firstsub)) +++ (do ((bounds (cddr aux) (cdr bounds)) +++ (i firstsub)) +++ ((null bounds)) +++ (setq index (+ (* index (car bounds)) (arg (setq i (1+ i)))))) +++ +++ (setq subs (arrayref (arg n) index)) ; get cell requested +++ (cond ((memq (car aux) '(fixnum-block flonum-block)) +++ (cond (store (replace subs (arg 1))) +++ (t (cpy1 subs)))) +++ (t (cond (store (set subs (arg 1))) +++ (t (value-eval subs))))))) +++ +++ +++(defmacro store ( (arrname . indexes) value) +++ (prog (defered) +++ loop +++ (cond +++ ((eq 'funcall arrname) +++ (setq arrname (car indexes) +++ indexes (cdr indexes) +++ defered t)) +++ ((eq 'arraycall arrname) +++ (setq arrname (cadr indexes) +++ indexes (cddr indexes) +++ defered t)) +++ ((and ((lambda (fnd) +++ (cond ((or (and (dtpr fnd) (eq 'macro (car fnd))) +++ (and (bcdp fnd) (eq 'macro (getdisc fnd)))) +++ (setq fnd (apply arrname (cons arrname indexes))) +++ (setq arrname (car fnd) +++ indexes (cdr fnd))))) +++ (getd arrname)) +++ (go loop)))) +++ (return (cond (defered `(funcall ,arrname ,value . ,indexes)) +++ (t `(,arrname ,value . ,indexes)))))) +++ +++;-- storeintern - there may be residual calls to storeintern from +++; old code, we handle it here. this routine can be eliminated when +++; code is recompiled +++ +++(defun storeintern (arrnam value indexes) +++ (apply arrnam (cons value indexes))) +++ +++;--- small segment storage allocators. +++ +++; this function allocates segments of storage and attempt to use the whole +++; block instead of throwing away what isnt used +++; +++ +++(declare (special gcdisable)) +++ +++(defun small-segment (type n) +++ (prog (lastseg retv elementsize itemsperpage-1 gcdisable tmp) +++ (setq gcdisable t) ; its not a good idea to gc while we are +++ ; handling pointers to things segment returns. +++ (desetq (elementsize . itemsperpage-1) (get 'segment-sizes type)) +++ (cond ((null elementsize) (error "small-segment: bad type " type))) +++ (setq lastseg (get 'segment-types type)) +++ (cond ((and lastseg (not (lessp (car lastseg) n)))) +++ (t ; must allocate a block of storage, want to the least number of +++ ; pages which includes n elements +++ ; there are elementsize elements per page, and +++ ; itemsperpage-1 is the number of elements on a page minus 1 +++ (setq retv (boole 4 +++ (+ n itemsperpage-1) +++ itemsperpage-1)) ; 4 is x & ~y +++ (setq lastseg (cons retv (maknum (segment type retv)))))) +++ (setq retv (cdr lastseg)) +++ (rplaca lastseg (- (car lastseg) n)) +++ (rplacd lastseg (+ (cdr lastseg) (* elementsize n))) +++ (cond ((greaterp (car lastseg) 0) +++ (putprop 'segment-types lastseg type) +++ (cond ((null (setq tmp (get 'segment-arrays type))) +++ (putprop 'segment-arrays +++ (setq tmp (marray nil nil nil nil nil)) +++ type))) +++ (putdata tmp (fake (cdr lastseg))) +++ (putlength tmp (car lastseg)) +++ (putdelta tmp elementsize)) +++ (t ; remove all counters since we no longer have any space +++ ; left and we can't have a zero length array +++ (remprop 'segment-types type) +++ (remprop 'segment-arrays type))) +++ (return (fake retv)))) +++ +++; data base for small-segment +++(putprop 'segment-sizes '( 4 . 127) 'value) +++(putprop 'segment-sizes '( 4 . 127) 'fixnum) +++(putprop 'segment-sizes '( 8 . 63) 'flonum) +++ +++ +++(def arraydims (lambda (arg) (cond ((symbolp arg) (getaux (getd arg))) +++ ((arrayp arg) (getaux arg)) +++ (t (break '"non array arg to arraydims"))))) +++ +++; fill array from list or array +++ +++(def fillarray +++ (lambda (arr lis) +++ (prog (maxv typept) +++ (cond ((symbolp arr) (setq arr (getd arr)))) +++ +++ (cond ((symbolp lis) +++ (setq lis (getd lis)) +++ (return (fillarrayarray arr lis))) +++ +++ ((arrayp lis) (return (fillarrayarray arr lis)))) +++ +++ (setq maxv (1- (getlength arr)) +++ typept (cond ((memq (car (getaux arr)) +++ '(t fixnum flonum unmarked_array)) +++ t) +++ (t nil))) +++ (do ((ls lis) +++ (i 0 (1+ i))) +++ ((greaterp i maxv)) +++ +++ (cond (typept (set (arrayref arr i) (car ls))) +++ (t (replace (arrayref arr i) (car ls)))) +++ +++ (cond ((cdr ls) (setq ls (cdr ls)))))))) +++ +++(def fillarrayarray +++ (lambda (arrto arrfrom) +++ (prog (maxv) +++ (setq maxv (1- (min (getlength arrto) +++ (getlength arrfrom)))) +++ (do ((i 0 (1+ i))) +++ ((greaterp i maxv)) +++ (replace (arrayref arrto i) (arrayref arrfrom i)))))) +++ +++(def listarray +++ (lexpr (n) +++ (prog (arr size typ ret) +++ (setq arr (arg 1)) +++ (cond ((and (symbolp arr) (arrayp (setq arr (getd arr))))) +++ (t (error "Non array to listarray " arr))) +++ (setq size (cond ((eq n 2) (arg 2)) +++ (t (apply '* (cdr (arraydims arr)))))) +++ (setq typ (car (getaux arr))) +++ (cond ((memq typ '(t fixnum flonum unmarked_array)) +++ (setq typ t)) +++ (t (setq typ nil))) +++ (do ((i (1- size) (1- i))) +++ ((lessp i 0)) +++ (setq newv (arrayref arr i)) +++ (setq ret (cons (cond (typ (eval newv)) +++ (t (cpy1 newv))) +++ ret))) +++ (return ret)))) +++ +++ +++;---Section VII - equivalances------------------- +++; +++ +++(putd 'abs (getd 'absval)) +++(putd 'add (getd 'sum)) +++(putd 'chrct (getd 'charcnt)) +++(putd 'diff (getd 'difference)) +++(putd 'numbp (getd 'numberp)) +++(putd 'remainder (getd 'mod)) +++(putd 'terpri (getd 'terpr)) +++(putd 'typep (getd 'type)) +++(putd 'symeval (getd 'eval)) +++(putd '< (getd 'lessp)) +++(putd '= (getd 'equal)) +++(putd '> (getd 'greaterp)) +++(putd '- (getd 'difference)) +++(putd '\/ (getd 'quotient)) +++(putd '\+ (getd 'add)) +++(putd '*dif (getd 'difference)) +++(putd '\\ (getd 'mod)) +++(putd '\1+ (getd 'add1)) +++(putd '\1+$ (getd 'add1)) +++(putd '\1- (getd 'sub1)) +++(putd '\1-$ (getd 'sub1)) +++(putd '* (getd 'times)) +++(putd '*$ (getd 'times)) +++(putd '/$ (getd 'quotient)) +++(putd '+$ (getd 'add)) +++(putd '-$ (getd 'difference)) diff --cc usr/lib/lisp/auxfns1.l index 0000000000,0000000000,0000000000..7c59547ace new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/auxfns1.l @@@@ -1,0 -1,0 -1,0 +1,354 @@@@ +++(setq SCCS-auxfns1 "@(#)auxfns1.l 1.1 10/2/80") +++ +++ +++;--- msg - arg1 ... arguments of the form described below +++; B - print out a blank +++; N - print out a newline (terpr) +++; (B n) - print out n blanks +++; (P p) - henceforth print on port p +++; atom - patom this exactly (no evaluation) +++; other - evaluate and patom this expression. +++; +++(def msg +++ (macro (lis) +++ `(progn ,@(msgmake (cdr lis) 'nil)))) +++ +++(eval-when (eval compile load) +++ (def msgmake +++ (lambda (forms outport) +++ ((lambda (thisform) +++ +++ (cond ((null forms) `((drain ,@outport))) +++ ((and (eq 'B thisform) (setq thisform '" ") nil)) +++ ((eq 'N thisform) (cons `(terpr ,@outport) +++ (msgmake (cdr forms) outport))) +++ ((atom thisform) (cons `(patom ',thisform +++ ,@outport) +++ (msgmake (cdr forms) outport))) +++ ((eq 'P (car thisform)) (msgmake (cdr forms) +++ `(,@(cdr thisform)))) +++ +++ ((eq 'B (car thisform)) (cons `(printblanks ,@(cdr thisform) +++ ,outport) +++ (msgmake (cdr forms) outport))) +++ (t (cons `(patom ,thisform ,@outport) +++ (msgmake (cdr forms) outport))))) +++ (car forms))))) +++ +++(def printblanks +++ (lambda (n prt) +++ (do ((i n (1- i))) +++ ((lessp i 1)) +++ (patom '" " prt)))) +++ +++ +++ +++ +++; ============================================== +++; +++; (linelength [numb]) +++; +++; sets the linelength (actually just varib linel) to the +++; number given: numb +++; if numb is not given, the current line length is returned +++; ================================================= +++ +++(setq linel 80) +++(def linelength +++ (nlambda (form) +++ (cond ((null form) linel ) +++ ((numberp (car form)) (setq linel (car form))) +++ (t linel)))) +++ +++; ======================================== +++; +++; (charcnt port) +++; returns the number of characters left on the current line +++; on the given port +++; +++; ======================================= +++ +++ +++(def charcnt +++ (lambda (port) (- linel (nwritn port)))) +++ +++(def nthcdr +++ (lambda (n x) +++ (cond ((zerop n) x) +++ ((lessp n 0) (cons nil x)) +++ (t (nthcdr (1- n) (cdr x) ))))) +++ +++(def nth +++ (lambda (n x) +++ (car (nthcdr n x)))) +++ +++;r lambda: (nthrest numb list) +++;- args: numb - integer +++;- list - list +++;- returns:the rest of the list beginning at the numb'th element. +++;- for convience, (nthrest 0 list) equals (nthrest 1 list) +++;- equals list. This is designed to be similar to nthelem +++;- which returns the nth element of a list. +++ +++(def nthrest +++ (lambda (number list) +++ (cond ((lessp number 2) list) +++ (t (nthrest (1- number) (cdr list)))))) +++ +++ +++;;============================== +++; (assqr val alist) +++; acts much like assq, it looks for val in the cdr of elements of +++; the alist and returns the element if found. +++; fix this when the compiler works +++(eval-when nil (def assqr +++ (lambda (val alist) +++ (do ((al alist (cdr al))) +++ ((null al) nil) +++ (cond ((eq val (cdar al)) (return (car al)))))))) +++ +++ +++; ==================== +++; (listp 'x) is t if x is a non-atom or nil +++; ==================== +++(def listp (lambda (val) (or (dtpr val) (null val)))) +++ +++ +++ +++;--- memcar - VAL : lispval +++; - LIS : list +++; returns t if VAL found as the car of a top level element. +++;temporarily turn this off till the compiler can handle it. +++(eval-when nil (def memcar +++ (lambda (a l) +++ (do ((ll l (cdr ll))) +++ ((null ll) nil) +++ (cond ((equal (caar ll) a) (return (cdar ll)))))))) +++ +++; ================================= +++; +++; (memcdr 'val 'listl) +++; +++; the list listl is searched for a list +++; with cdr equal to val. if found, the +++; car of that list is returned. +++; ================================== +++;fix this when compiler works ok +++(eval-when nil (def memcdr +++ (lambda (a l) +++ (do ((ll l (cdr ll))) +++ ((null ll) nil) +++ (cond ((equal (cdar ll) a) (return (caar l)))))))) +++ +++ +++;this looks like funcall, so we will just use it +++'(def apply* +++ (nlambda ($x$) +++ (eval (cons (eval (car $x$)) (cdr $x$))))) +++ +++(putd 'apply* (getd 'funcall)) +++ +++ +++ +++ +++; ======================================= +++; pretty printer top level routine pp +++; +++; calling form- (pp arg1 arg2 ... argn) +++; the args may be names of functions, atoms with associated values +++; or output descriptors. +++; if argi is: +++; an atom - it is assumed to be a function name, if there is no +++; function property associated with it,then it is assumed +++; to be an atom with a value +++; (P port)- port is the output port where the results of the +++; pretty printing will be sent. +++; poport is the default if no (P port) is given. +++; (F fname)- fname is a file name to write the results in +++; (A atmname) - means, treat this as an atom with a value, dont +++; check if it is the name of a function. +++; +++(declare (special $outport$ $fileopen$ )) +++ +++; printret is like print yet it returns the value printed, this is used +++; by pp +++(def printret +++ (macro ($l$) +++ `(progn (print ,@(cdr $l$)) ,(cadr $l$)))) +++ +++(def pp +++ (nlambda ($xlist$) +++ (prog ($outport$ $cur$ $fileopen$ $prl$ $atm$ funcdef) +++ +++ (setq $outport$ poport) ; default port +++ ; check if more to do, if not close output file if it is +++ ; open and leave +++ +++ +++ toploop (cond ((null (setq $cur$ (car $xlist$))) +++ (condclosefile) +++ (return t))) +++ +++ (cond ((dtpr $cur$) +++ (cond ((equal 'P (car $cur$)) ; specifying a port +++ (condclosefile) ; close file if open +++ (setq $outport$ (eval (cadr $cur$)))) +++ +++ ((equal 'F (car $cur$)) ; specifying a file +++ (condclosefile) ; close file if open +++ (setq $outport$ (outfile (cadr $cur$)) +++ $fileopen$ t)) +++ +++ ((equal 'A (car $cur$)) ; declaring atomness +++ (setq $atm$ t) +++ (setq $cur$ (cadr $cur$)) +++ (go midstuff)) +++ +++ ((eq 'V (car $cur$)) ; print value only +++ (setq $atm$ 'value) +++ (setq $cur$ (cadr $cur$)) +++ (go midstuff)) +++ +++ (t (msg N "bad arg to pp: " (or $cur$)))) +++ (go botloop))) +++ midstuff ; process the atom or function +++ +++ (cond ((eq 'value $atm$) +++ (setq $prl$ (eval $cur$))) +++ +++ ((or $atm$ (null (getd $cur$))) ; check if is atom +++ (cond ((boundp $cur$) ; yes, see if bound +++ (setq $prl$ (list 'setq $cur$ (list 'quote +++ (eval $cur$))))) +++ (t (msg N "pp: atom " (or $cur$) " is unbound") +++ (go botloop)))) +++ +++ ((bcdp (setq funcdef (getd $cur$))) ; is a fcn, see if bcd +++ (msg N "pp: function " (or $cur$) " is machine coded (bcd) ") +++ (go botloop)) +++ +++ ((and (dtpr funcdef) +++ (dtpr (cadr funcdef)) +++ (memq (caadr funcdef) +++ '(T-nargs T-arglist)) +++ (setq $prl$ (list 'def $cur$ (get $cur$ 'original))))) +++ (t (setq $prl$ (list 'def $cur$ funcdef)))) +++ +++ ; now print it +++ +++ ($prpr $prl$) +++ (terpr $outport$) +++ (setq $atm$ nil) ; clear flag +++ +++ botloop (setq $xlist$ (cdr $xlist$)) +++ +++ (go toploop)))) +++ +++ +++ +++(def condclosefile +++ (lambda nil +++ (cond ($fileopen$ +++ (terpr $outport$) +++ (close $outport$) +++ (setq $fileopen$ nil))))) +++ +++; +++; these routines are meant to be used by pp but since +++; some people insist on using them we will set $outport$ to nil +++; as the default +++(setq $outport$ nil) +++ +++ +++(def $prpr +++ (lambda (x) +++ (cond ((not (boundp '$outport$)) (setq $outport$ poport))) +++ (terpr $outport$) +++ ($prdf x 0 0))) +++ +++ +++(declare (special m)) +++ +++(def $prdf +++ (lambda (l n m) +++ (prog () +++ ($tocolumn n) +++ a (cond ((or (atom l) +++ (lessp (+ m (flatc l (charcnt $outport$))) +++ (charcnt $outport$))) +++ (return (printret l $outport$))) +++ ((and ($patom1 lpar) +++ (lessp 2 (length l)) +++ (atom (car l))) +++ (prog (c f g h) +++ (setq g +++ (cond ((member (car l) '(lambda nlambda)) +++ -7) +++ (t +++ 0))) +++ (setq f (equal (printret (car l) $outport$) 'prog)) +++ ($patom1 ' " ") +++ (setq c ($dinc)) +++ a ($prd1 +++ (cdr l) +++ (+ +++ c +++ (cond ((setq h (and f +++ (cadr l) +++ (atom (cadr l)))) +++ -5) +++ (t g)))) +++ (cond ((cdr (setq l (cdr l))) +++ (cond ((or (null h) (atom (cadr l))) +++ (terpr $outport$))) +++ (go a))))) +++ ((prog (c) +++ (setq c ($dinc)) +++ a ($prd1 l c) +++ (cond ((setq l (cdr l)) +++ (terpr $outport$) +++ (go a)))))) +++ b ($patom1 rpar)))) +++ +++ +++ +++(def $prd1 +++ (lambda (l n) +++ (prog () +++ ($prdf (car l) +++ n +++ (cond ((null (setq l (cdr l))) (1+ m)) +++ ((atom l) (setq n nil) (plus 4 m (pntlen l))) +++ (t m))) +++ (cond ((null n) +++ ($patom1 ' " . ") +++ (return (printret l $outport$))))))) +++ +++ +++ +++ +++ +++(def $dinc (lambda () (- (linelength $outport$) (charcnt $outport$)))) +++ +++ +++(def $tocolumn +++ (lambda (n) +++ (cond ((greaterp (setq n (- n (nwritn $outport$))) 0) +++ (do ((i 0 (1+ i))) +++ ((eq i n)) +++ (patom '" " $outport$)))))) +++ +++; ======================================== +++; +++; (charcnt port) +++; returns the number of characters left on the current line +++; on the given port +++; +++; ======================================= +++ +++ +++(def charcnt +++ (lambda (port) (- linel (nwritn port)))) +++ +++ +++(def $patom1 (lambda (x) (patom x $outport$))) diff --cc usr/lib/lisp/backquote.l index 0000000000,0000000000,0000000000..881bf82bdf new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/backquote.l @@@@ -1,0 -1,0 -1,0 +1,150 @@@@ +++(setq SCCS-backquote "@(#)backquote.l 1.2 10/22/80") +++ +++(setsyntax '\; 'splicing 'zapline) +++ +++;---- This file contains the definitions of the backquote and sharpsign +++; character macros. [The backquote macro actually uses two characters, +++; ` and ,] +++ +++(setq **backquote** 1) +++ +++(eval-when (eval) (cond ((null (getd 'declare)) +++ (def declare (nlambda (l) nil))))) +++ +++(declare (special **backquote**)) +++ +++(def back-quote-ch-macro +++ (lambda nil +++ (back=quotify ((lambda (**backquote**) (read)) +++ (1+ **backquote**))))) +++ +++(def back-quote-comma-macro +++ (lambda nil +++ ((lambda (**backquote**) +++ (cond ((zerop **backquote**) +++ (break "comma not inside a backquote.")) +++ ((eq (tyipeek) 64) +++ (tyi) +++ (cons '\,@ (read))) +++ ((eq (tyipeek) 46) +++ (tyi) +++ (cons '\,\. (read))) +++ (t (cons '\, (read))))) +++ (1- **backquote**)))) +++ +++(def back=quotify +++ (lambda (x) +++ ((lambda (a d aa ad dqp) +++ (cond ((atom x) (list 'quote x)) +++ ((eq (car x) '\,) (cdr x)) +++ ((or (atom (car x)) +++ (not (memq (caar x) '( \,@ \,\.)))) +++ (setq a (back=quotify (car x)) d (back=quotify (cdr x)) +++ ad (atom d) aa (atom a) +++ dqp (and (not ad) (eq (car d) 'quote))) +++ (cond ((and dqp (not (atom a)) (eq (car a) 'quote)) +++ (list 'quote (cons (cadr a) (cadr d)))) +++ ((and dqp (null (cadr d))) +++ (list 'list a)) +++ ((and (not ad) (eq (car d) 'list)) +++ (cons 'list (cons a (cdr d)))) +++ (t (list 'cons a d)))) +++ ((eq (caar x) '\,@) +++ (list 'append (cdar x) (back=quotify (cdr x)))) +++ ((eq (caar x) '\,\.) +++ (list 'nconc (cdar x)(back=quotify (cdr x)))) +++ )) +++ nil nil nil nil nil))) +++ +++(putd '1+ (getd 'add1)) +++(putd '1- (getd 'sub1)) +++ +++(setsyntax '\` 'macro 'back-quote-ch-macro) +++(setsyntax '\, 'macro 'back-quote-comma-macro) +++ +++ +++;------- sharpsign macro, used for conditional assembly +++ +++;#O or #o reads sexp with ibase bound to 8. +++;#+ makes exist if (STATUS FEATURE ) is T +++;#- makes exist if (STATUS FEATURE ) is NIL +++;#+(OR F1 F2 ...) makes exist of any one of F1,F2,... are in +++; the (STATUS FEATURES) list. +++;#+(AND F1 F2 ...) works similarly except all must be present in the list. +++;#+(NOT ) is the same as #-. +++;#/CHAR returns the numerical character code of CHAR. +++;#\SYMBOL gets the numerical character code of non-printing characters. +++;#' is to FUNCTION as ' is to QUOTE. +++;#. evaluates at read time and leaves the result. +++;#, evaluates at load time. Here it is the same as "#.". +++ +++(declare (special franz-symbolic-character-names)) +++ +++(setsyntax '\# 'splicing 'sharp-sign-macro) +++ +++(def sharp-sign-macro +++ (lambda () +++ ((lambda (char frob) +++ (setq char (tyi)) +++ (cond ((or (eq char 79.) ;O +++ (eq char 105.)) ;o +++ ((lambda (ibase) (list (read))) 8.)) +++ +++ ((eq char 43.) ;+ +++ (setq frob (read)) +++ (cond ((not (feature-present frob)) (read))) +++ nil) +++ ((eq char 45.) ;- +++ (setq frob (read)) +++ (cond ((feature-present frob) (read))) +++ nil) +++ +++ ((eq char 47.) ;/ +++ (list (tyi))) ;return numeric value of CHAR +++ ;list because splicing +++ +++ ((eq char 94.) ; ^ returns following char +++ (list (boole 1 31. (tyi)))) ; made into a control char +++ +++ ((eq char 39.) ;' +++ (list (list 'function (read)))) +++ +++ ((or (eq char 44.) (eq char 46.)) ;, or . +++ (list (eval (read)))) +++ +++ ((eq char 92.) ;\ +++ (setq frob (read)) ;get symbolic name of character +++ (setq char +++ (cdr (assq frob franz-symbolic-character-names))) +++ (or char (error '|Illegal character name in #\\| frob)) +++ (list char)) +++ +++ (t (error '|Bad character after #| (ascii char))))) +++ nil nil))) +++ +++(defun feature-present (feature) +++ (cond ((atom feature) +++ (memq feature (status features))) ;damn fsubrs +++ ((eq (car feature) 'not) +++ (not (feature-present (cadr feature)))) +++ ((eq (car feature) 'and) +++ (do ((list (cdr feature) (cdr list))) +++ ((null list) t) +++ (cond ((not (feature-present (car list))) +++ (return nil))))) +++ ((eq (car feature) 'or) +++ (do ((list (cdr feature) (cdr list))) +++ ((null list) nil) +++ (cond ((feature-present (car list)) +++ (return t))))) +++ (t (error '|Unknown form after #+ or #-| feature)))) +++ +++(setq franz-symbolic-character-names +++ '((eof . -1) (bs . 8.) (backspace . 8.) +++ (tab . 9.) (lf . 10.) (linefeed . 10.) +++ (ff . 12.) (form . 12.) (return . 13.) (cr . 13.) +++ (newline . 10.) (vt . 9.) +++ (alt . 27.) (esc . 27.) +++ (sp . 32.) (space . 32.) +++ (rubout . 127.))) +++ diff --cc usr/lib/lisp/editor.l index 0000000000,0000000000,0000000000..bb19fe6cd1 new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/editor.l @@@@ -1,0 -1,0 -1,0 +1,605 @@@@ +++(setq SCCS-editor "@(#)editor.l 1.1 10/2/80") +++ +++; editor from bbn-lisp c. 1968 +++; (transcribed by R. Fateman for UNIX LISP, Oct., 1977) +++; (modified and enhanced by P. Pifer, May, 1978) +++; (corrected again by R. Fateman for VAX Unix Lisp, Dec., 1978) +++; (cleaned up, commented and compiled by J. Foderaro, Aug., 1979) +++; ( ... fixed bug in ^ command) +++; +++(declare (special edok em pf pl l)) +++ +++ +++ (setq printflag t) +++; print on by default +++ +++ (setq printlevel 3) +++ +++ (setq maxlevel 100) +++ +++ (setq findflag nil) +++ +++(setq supereditflg t)(setq printflag t)(setq edrptcnt nil) +++ +++ +++;--- remedit - removes all traces of the editor from the oblist. +++; Note that if the editor is compiled, the code space +++; will not be reclaimed +++; +++(def remedit +++ (lambda nil +++ (prog nil +++ (mapc (function (lambda (x) (set x nil))) +++ '(editmacros findflag supereditflg edrptcnt +++ printflag printlevel maxlevel)) +++ (mapc (function (lambda (x) (putd x nil))) +++ '(editf editv tconc eprint eprint1 printlevel dsubst +++ editcoms edit1f edit2f edit2af edit4e +++ editqf edit4e edit4f edit4f1 editnth bpnt +++ bpnt0 subpair subpr ri ro li lo bi bo +++ ldiff nthcdr attach edite editcom editdefault +++ remedit)) +++ (return 'gone)))) +++ +++;--- subst - a - newval +++; - b : oldvall +++; - c : string +++; substitute a for b in c +++; +++(def subst +++ (lambda (a b c) +++ (cond ((equal b c) a) +++ ((atom c) c) +++ (t (cons (subst a b (car c)) (subst a b (cdr c))))))) +++ +++(def tconc +++ (lambda (x p) +++ (cond ((null (car p)) +++ (rplacd p (car (rplaca p (list x))))) +++ (t (rplacd p (cdr (rplacd (cdr p) (list x)))))))) +++ +++;--- printlevel - x : new value +++; set the printlevel to x and return the old value +++; [change this to prog1 ] +++; +++(def printlevel +++ (lambda (x) +++ (prog (a) +++ (setq a printlevel) +++ (setq printlevel x) +++ (return a)))) +++ +++;--- editf - funcname : name of function to edit +++; - [cmds] : commands to apply right away +++; This is the starting point in the editor. You specify the +++; file you wish to edit and perhaps some initial commands to +++; the editor. If the function is not machine coded you +++; enter the editor. +++; +++(def editf +++ (nlambda (x) +++ (prog (a c) +++ (setq a (getd (car x))) +++ (cond ((or (null a) (bcdp a)) +++ (return '(not editable)))) +++ (putd (car x) (car (edite a (cdr x) nil))) +++ (return (car x))))) +++ +++'(def dsubst +++ (lambda (x y z) +++ (prog nil +++ (cond ((null z) (return z)) +++ ((equal y (car z)) (rplaca z x) (go l))) +++ (cond ((null (atom (car z))) (dsubst x y (car z)))) +++ l (dsubst x y (cdr z)) +++ (return z)))) +++ +++;--- dsubst - x : oldval +++; - y : newval +++; - z : form +++; directly substitutes all occurances of x in form z with y. +++; It uses rplaca and does not copy the structure. +++; +++(def dsubst +++ (lambda (x y z) +++ (cond ((dptr z) +++ (cond ((equal y (car z)) +++ (rplaca (car z) x)) +++ (t (dsubst x y (car z))))) +++ (t z)) +++ (dsubst x y (cdr z)) +++ z)) +++ +++ +++(def editcoms (lambda (c) (mapc (function editcom) c))) +++ +++(def edit1f +++ (lambda (c l) +++ (cond ((equal c 0) +++ (cond ((null (cdr l)) (err nil)) +++ (t (cdr l)))) +++ ((greaterp c 0) +++ (cond ((greaterp c (length (car l))) (err nil)) +++ (t (cons (car (nthcdr (sub1 c) (car l) )) l)))) +++ ((greaterp (times c -1) (length (car l))) +++ (err nil)) +++ (t (cons (car (nthcdr (plus (length (car l)) c) (car l) )) +++ l))))) +++ +++(def edit2f +++ (lambda (c) +++ (cond ((greaterp (car c) 0) +++ (cond ((greaterp (car c) (length (car l))) +++ (err nil)) +++ (t (rplaca l (edit2af (sub1 (car c)) +++ (car l) +++ (cdr c) +++ nil))))) +++ ((or (equal (car c) 0) +++ (null (cdr c)) +++ (greaterp (times -1 (car c)) (length (car l)))) +++ (err nil)) +++ (t (rplaca l (edit2af (sub1 (times -1 (car c))) +++ (car l) +++ (cdr c) +++ t)))))) +++ +++ (def edit2af +++ (lambda (n x r d) +++ (prog nil +++ (cond ((null (equal n 0)) +++ (rplacd (nthcdr (sub1 n) x) +++ (nconc r +++ (cond (d (nthcdr n x)) +++ (t (nthcdr (add1 n) x )))))) +++ (d (attach (car r) x) +++ (rplacd x (nconc (cdr r) (cdr x)))) +++ (r (rplaca x (car r)) +++ (rplacd x (nconc (cdr r) (cdr x)))) +++ (t (print (list 'aha x)) +++ (rplaca x (cadr x)) +++ (rplacd x (cddr x)))) +++ (return x)))) +++ +++(def edit4e +++ (lambda (x y) +++ (cond ((equal x y) t) +++ ((atom x) (eq x '&)) +++ ((atom y) nil) +++ ((edit4e (car x) (car y)) +++ (or (eq (cadr x) '-) +++ (edit4e (cdr x) (cdr y))))))) +++ +++(def editqf +++ (lambda (s) +++ (prog (q1) +++ (return (cond ((setq q1 (member s (cdar l))) +++ (setq l (cons q1 l))) +++ (t (edit4f s 'n) +++ (cond ((not (atom s)) +++ (setq l (cons (caar l) l)))))))))) +++ +++(def edit4f +++ (lambda (s n) +++ (prog (ff ll x) +++ (setq ll (cond ((eq n 'n) (cons (caar l) l)) +++ (t l))) +++ (setq x (car ll)) +++ (setq ff (cons nil nil)) +++ (cond ((and n (not (numberp n))) (setq n 1))) +++ lp (cond ((edit4f1 s x maxlevel) +++ (setq l (nconc (car ff) ll)) +++ (return (car l))) +++ ((null n) (err nil))) +++ lp1 (setq x (car ll)) +++ (cond ((null (setq ll (cdr ll))) (err nil)) +++ ((and (setq x (member x (car ll))) +++ (null (atom (setq x (cdr x))))) +++ (go lp))) +++ (go lp1)))) +++ +++(def edit4f1 +++ (lambda (s a lvl) +++ (prog nil +++ (cond ((null (greaterp lvl 0)) (return nil))) +++ lp (cond ((atom a) (return nil)) +++ ((and (edit4e s (car a)) +++ (or (null n) +++ (equal 0 (setq n (sub1 n))))) +++ (return (tconc a ff))) +++ ((and s +++ (equal s (cdr a)) +++ (or (null n) +++ (equal 0 (setq n (sub1 n))))) +++ (return (tconc a ff))) +++ ((and n +++ (edit4f1 s (car a) (sub1 lvl)) +++ (equal 0 n)) +++ (return (tconc (car a) ff)))) +++ (setq a (cdr a)) +++ (go lp)))) +++ +++(def editnth +++ (lambda (x n) +++ (cond ((null (setq n (cond ((or (null (lessp n 0)) +++ (greaterp (setq n +++ (plus (length x) +++ n +++ 1)) +++ 0)) +++ (nthcdr (sub1 n) x))))) +++ (err nil)) +++ (t n)))) +++ +++(def bpnt +++ (lambda (x) +++ (prog (y n) +++ (cond ((equal 0 (car x)) (setq y (car l))) +++ (t (setq y (car (editnth (car l) (car x)))))) +++ (cond ((null (cdr x)) (setq n 3)) +++ ((null (numberp (cadr x))) (go b1)) +++ ((lessp (cadr x) 0) +++ (setq n (plus (cadr x) 2))) +++ (t (setq n (cadr x)))) +++ (return (bpnt0 y 1 n)) +++ b1 (err nil)))) +++ +++(def bpnt0 +++ (lambda (l n d) +++ (prog (oldl) +++ (setq oldl (printlevel (difference d n))) +++ (cond ((atom (errset (eprint l) t)) +++ (terpri) +++ (terpri))) +++ (printlevel oldl) +++ (return nil)))) +++ +++ +++(def ro +++ (lambda (n x) +++ (prog (a) +++ (setq a (editnth x n)) +++ (cond ((or (null a) (atom (car a))) (err nil))) +++ (rplacd (last (car a)) (cdr a)) +++ (rplacd a nil)))) +++ +++(def ri +++ (lambda (m n x) +++ (prog (a b) +++ (setq a (editnth x m)) +++ (setq b (editnth (car a) n)) +++ (cond ((or (null a) (null b)) (err nil))) +++ (rplacd a (nconc (cdr b) (cdr a))) +++ (rplacd b nil)))) +++ +++(def li +++ (lambda (n x) +++ (prog (a) +++ (setq a (editnth x n)) +++ (cond ((null a) (err nil))) +++ (rplaca a (cons (car a) (cdr a))) +++ (rplacd a nil)))) +++ +++(def lo +++ (lambda (n x) +++ (prog (a) +++ (setq a (editnth x n)) +++ (cond ((or (null a) (atom (car a))) (err nil))) +++ (rplacd a (cdar a)) +++ (rplaca a (caar a))))) +++ +++(def bi +++ (lambda (m n x) +++ (prog (a b) +++ (setq b (cdr (setq a (editnth x n)))) +++ (setq x (editnth x m)) +++ (cond ((and a (null (greaterp (length a) (length x)))) +++ (rplacd a nil) +++ (rplaca x (cons (car x) (cdr x))) +++ (rplacd x b)) +++ (t (err nil)))))) +++ +++(def bo +++ (lambda (n x) +++ (prog nil +++ (setq x (editnth x n)) +++ (cond ((atom (car x)) (err nil))) +++ (rplacd x (nconc (cdar x) (cdr x))) +++ (return (rplaca x (caar x)))))) +++ +++(def subpair +++ (lambda (x y z fl) +++ (cond (fl (subpr x y (copy z))) +++ ((subpr x y z))))) +++ +++ (def subpr +++ (lambda (x y z) +++ (prog (c d) +++ (setq c x) +++ (setq d y) +++ loop (cond ((or (null c) (null d)) (return z)) +++ (t (dsubst (car d) (car c) z) +++ (setq c (cdr c)) +++ (setq d (cdr d)) +++ (go loop)))))) +++ +++(def ldiff +++ (lambda (x y) +++ (prog (a b) +++ (setq a x) +++ (setq b nil) +++ loop (cond ((equal a y) (return (reverse b))) +++ ((null a) (return (err nil))) +++ (t (setq b (cons (car a) b)) +++ (setq a (cdr a)) +++ (go loop)))))) +++ +++(def editv +++ (nlambda (editvx) +++ (prog nil +++ (set (car editvx) +++ (car (edite (eval (car editvx)) +++ (cdr editvx) +++ nil))) +++ (return (car editvx))))) +++ +++(def nthcdr +++ (lambda (n x) +++ (cond ((equal n 0) x) +++ ((lessp n 0) (cons nil x)) +++ (t (nthcdr (sub1 n)(cdr x)))))) +++ +++(def attach +++ (lambda (x y) +++ (prog (a) +++ (setq a (cons (car y) (cdr y))) +++ (rplaca y x) +++ (rplacd y a) +++ (return y)))) +++ +++ (def eprint (lambda (x) (print (eprint1 x printlevel)))) +++ +++(def edite +++ (lambda (x ops l) +++ (prog (c m em edok copied pf pl) +++ (cond ((null l) (setq l (list x)))) +++ (setq em editmacros) +++ (setq pf printflag) +++ (setq pl 3) +++ (cond (ops (cond ((dtpr (errset (mapc +++ (function +++ (lambda (x) +++ (editcom (setq c x)))) +++ ops) +++ t)) +++ (return (car (last l)))) +++ (t (go b))))) +++ (print 'edit) +++ (cond (pf (terpri) (editcom 'p))) +++ (setq pf printflag) +++ ct (setq findflag nil) +++ a (cond (edok (return (cdr edok)))) +++ (terpri) +++ (patom '*) +++ (drain) +++ (cond ((atom (errset (setq c (read)) t)) (go ct))) +++ (cond ((dtpr (errset (editcom c) t)) +++ (cond (pf (editcom 'p))) +++ (setq pf printflag) +++ (go a))) +++ b (terpri) +++ (print c) +++ (patom '?) +++ (terpri) +++ (go ct)))) +++ +++(def editdefault +++ (lambda (x) (editcom (list 'f x 't)))) +++ +++(def editcom +++ (lambda (c) +++ (prog (cc c2 c3 cl) +++ a (cond (findflag (setq findflag nil) (editqf c)) +++ ((numberp c) (setq l (edit1f c l))) +++ ((atom c) +++ (cond ((eq c 'ok) +++ (setq ersetflg t) +++ (setq edok (cons t (last l))) +++ (return (setq pf nil))) +++ ((eq c 'e) +++ (setq ersetflg t) +++ (print (eval (read))) +++ (terpri)) +++ ((eq c 'p) +++ (setq pf nil) +++ (bpnt0 (car l) 1 pl)) +++ ((eq c 'pp) +++ (setq pf nil) +++ (terpri) +++ (errset ($prpr (car l)) t) +++ (terpri)) +++ ((eq c 'mark) +++ (setq m (cons l m))) +++ ((eq c '^) +++ (setq l (list (last l)))) +++ ((eq c 'copy) (setq copied (copy l))) +++ ((eq c 'restore) (setq l copied)) +++ ((eq c '<) +++ (cond (m (setq l (car m))) +++ (t (err '"no marks")))) +++ ((eq c '<<) +++ (cond (m (setq l (car m)) +++ (setq m (cdr m))) +++ (t (err '"no marks")))) +++ ((eq c 'poff) +++ (setq pf nil) +++ (setq printflag nil)) +++ ((eq c 'pon) +++ (setq pf t) +++ (setq printflag t)) +++ (t (cond ((and (setq cc +++ (cond ((null +++ (setq cc +++ (assoc c em))) +++ nil) +++ ((cdr cc)))) +++ (null (car cc))) +++ (editcoms (copy cc))) +++ (t (return (editdefault c))))))) +++ ((numberp (setq cc (car c))) (edit2f c)) +++ (t (setq c2 (cadr c)) +++ (setq c3 +++ (cond ((null (cddr c)) nil) +++ ((car (cddr c))))) +++ (setq cl (car l)) +++ (cond ((eq cc 's) +++ (set c2 +++ (car (cond ((null (setq c c3)) l) +++ ((equal c 0) l) +++ (t (editnth cl c)))))) +++ ((eq cc 'r) +++ (dsubst c3 c2 cl)) +++ ((eq cc 'e) +++ (setq cc (eval c2)) +++ (cond ((null (cddr c)) +++ (print cc) +++ (terpri))) +++ (return cc)) +++ ((eq cc 'i) +++ (setq c +++ (cons (cond ((atom c2) c2) +++ (t (eval c2))) +++ (mapcar (function eval) +++ (cddr c)))) +++ (go a)) +++ ((eq cc 'n) +++ (nconc cl (cdr c))) +++ ((eq cc 'p) +++ (bpnt (cdr c)) +++ (setq pf nil)) +++ ((eq cc 'f) +++ (edit4f c2 c3)) +++ ((eq cc 'nth) +++ (setq l (cons (editnth cl c2) l))) +++ ((member cc +++ '(ri ro li lo bi bo)) +++ (apply1 cc (append (cdr c) (list cl)))) +++ ((member cc '(m d)) +++ (setq cc (cond ((atom (setq cc c2)) +++ (cons cc +++ (cons nil +++ (cddr c)))) +++ (t (cons (car cc) (cddr c))))) +++ (setq em (cons cc em)) +++ (cond ((eq (car c) 'm) +++ (setq editmacros +++ (cons cc editmacros))))) +++ ((eq cc 'pl) +++ (cond ((lessp c2 1) (err nil)) +++ (t (setq pl (add 1 c2))))) +++ (t (cond ((or (null +++ (setq cc +++ (cond ((null +++ (setq cc +++ (assoc cc em))) +++ nil) +++ (t (cdr cc))))) +++ (null (cond ((null cc) nil) +++ (t (car cc))))) +++ (return (editdefault c))) +++ ((atom (car cc)) +++ (editcoms +++ (subst (cond ((null c) nil) +++ ((cdr c))) +++ (car cc) +++ (cdr cc)))) +++ (t (editcoms +++ (subpair (car cc) +++ (cdr c) +++ (cdr cc) +++ t)))))))) +++ (return (car l))))) +++ +++(def eprint1 +++ (lambda (x lev) +++ (cond ((atom x) x) +++ ((equal 0 lev) '&) +++ ((and (atom (cdr x)) (cdr x)) x) +++ (t (mapcar (function (lambda (y) (eprint1 y (sub1 lev)))) +++ x))))) +++ +++(def assoc +++ (lambda (e l) +++ (cond ((null l) nil) +++ ((equal e (caar l)) (car l)) +++ (t (assoc e (cdr l)))))) +++ +++ (def apply1 +++ (lambda (f l) +++ (eval (cons f (mapcar '(lambda (z) (list 'quote z)) +++ l))))) +++ +++ +++ +++ +++(def editp +++ (nlambda (x) +++ (prog (a b) +++ (setq a (car x)) +++ (edite (caar x)) +++ (return a)))) +++ +++(def makefile +++ (nlambda (x) +++ (prog (poport n f ff l df) +++ (setq l (cons nil (cadr x))) +++ (setq ff (eval (car x))) +++ (setq poport +++ (outfile (setq n (concatp 'mkfl)))) +++ l1 (cond ((null (setq l (cdr l))) (go e1))) +++ (setq f (car l)) +++ (cond ((null f) (go l1)) +++ ((null (setq df (getd f))) (go l1)) +++ (t (setq df (list 'def f df)) +++ ($prpr df) +++ (terpri) +++ (go l1))) +++ e1 (close poport) +++ (null (eval (cons 'exec (cons '/bin/mv (cons n (cons ff nil))))))))) +++ +++(def appfile +++ (nlambda (x) +++ (prog (i poport n f ff l df) +++ (setq l (cons nil (cadr x))) +++ (setq ff (eval (car x))) +++ (setq i (infile ff)) +++ (setq poport +++ (outfile (setq n (concatp 'apfl)))) +++ l1 (cond ((eq (setq f (read i poport)) 'eof) +++ (go l2)) +++ (t ($prpr f) (terpri))) +++ (go l1) +++ l2 (cond ((null (setq l (cdr l))) (go e1))) +++ (setq f (car l)) +++ (cond ((null f) (go l2)) +++ ((null (setq df (getd f))) (go l2)) +++ (t (setq df (list 'def f df)) +++ ($prpr df) +++ (terpri) +++ (go l2))) +++ e1 (close poport) +++ (null (eval (cons 'exec (cons '/bin/mv (cons n (cons ff nil))))))))) +++ +++(def exec +++ (nlambda ($list) +++ (prog ($handy) +++ (setq $handy '"") +++ loop (cond ((null $list) +++ (return (eval (list 'process $handy)))) +++ (t (setq $handy +++ (concat (concat $handy (car $list)) +++ '" ")) +++ (setq $list (cdr $list)) +++ (go loop)))))) +++ +++(setq editmacros nil) diff --cc usr/lib/lisp/fix.l index 0000000000,0000000000,0000000000..068f304d75 new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/fix.l @@@@ -1,0 -1,0 -1,0 +1,565 @@@@ +++(setq SCCS-fix "@(#)fix.l 1.1 10/2/80") +++ +++(dv fixfns +++ ((*** This is FIXIT written by David Touretzky and adapted to Franz by Don +++ Cohen) +++ (declare (special framelist rframelist interrupt-handlers handler-labels) +++ (special prinlevel prinlength evalhook-switch traced-stuff) +++ (special lastword piport hush-debug) +++ (*fexpr editf step type)) +++ (sstatus feature fixit) +++ (*rset t) +++ ER%tpl +++ fixit +++ debug +++ debug-iter +++ debug1 +++ debug-bktrace +++ debug-print +++ debug-print1 +++ debug-findcall +++ debug-scanflist +++ debug-scanstk +++ debug-getframes +++ debug-nextframe +++ debug-upframe +++ debug-dnframe +++ debug-upfn +++ debug-dnfn +++ debug-showvar +++ debug-nedit +++ debug-insidep +++ debug-findusrfn +++ debug-findexpr +++ debug-pop +++ debug-where +++ debug-sysp +++ interrupt-handlers +++ handler-labels +++ (or (boundp 'traced-stuff) (setq traced-stuff nil)) +++ (or (boundp 'evalhook-switch) (setq evalhook-switch nil)) +++ (setq hush-debug nil))) +++ +++(*** This is FIXIT written by David Touretzky and adapted to Franz by Don Cohen) +++ +++(declare (special framelist rframelist interrupt-handlers handler-labels) +++ (special prinlevel prinlength evalhook-switch traced-stuff) +++ (special lastword piport hush-debug) +++ (*fexpr editf step type)) +++ +++(sstatus feature fixit) +++ +++(*rset t) +++ +++(dv ER%tpl fixit) +++ +++(def fixit +++ (nlambda (l) +++ (prog (piport) +++ (while t (eval (cons 'debug l)))))) +++ +++(def debug +++ (nlambda (params) +++ (prog (cmd frame framelist rframelist nframe val infile) +++ (setq infile t) +++ (and evalhook-switch (step nil)) +++ (setq rframelist +++ (reverse +++ (setq framelist +++ (or (debug-getframes) +++ (list +++ (debug-scanstk '(nil) '(debug))))))) +++ (setq frame (debug-findexpr (car framelist))) +++ (tab 0) +++ (cond +++ ((and (car params) (not (eq (car params) 'edit))) +++ (terpri) +++ (princ '|;debug |) +++ (princ params) +++ (terpri) +++ (go loop))) +++ (debug-print1 frame nil) +++ (terpri) +++ (cond (hush-debug (setq hush-debug nil) (go loop)) +++ ((not (memq 'edit params)) (go loop))) +++ (drain nil) +++ (princ '|type e to edit, to debug: |) +++ (setq val (tyi)) +++ (cond ((or (= val 69) (= val 101)) +++ (and (errset (debug-nedit frame)) +++ (setq cmd '(ok)) +++ (go cmdr))) +++ ((or (= val 78) (= val 110)) (terpri) (debug-pop))) +++ loop (terpri) +++ (princ ':) +++ (cond ((null (setq cmd (lineread))) (reset))) +++ cmdr (cond +++ ((dtpr (car cmd)) +++ (setq val (eval (car cmd) (cadddr frame))) +++ ($prin1 val) +++ (terpri) +++ (go loop))) +++ (setq nframe (debug1 cmd frame)) +++ (and (not (atom nframe)) (setq frame nframe) (go loop)) +++ ($prin1 (or nframe (car cmd))) +++ (princ '" Huh? - type h for help") +++ (go loop)))) +++ +++(def debug-iter +++ (macro (x) +++ (cons 'prog +++ (cons 'nil +++ (cons 'loop +++ (cons (list 'setq 'nframe (cadr x)) +++ '((setq cnt (|1-| cnt)) +++ (and (or (null nframe) (zerop cnt)) +++ (return nframe)) +++ (setq frame nframe) +++ (go loop)))))))) +++ +++(def debug1 +++ (lambda (cmd frame) +++ (prog (nframe val topframe cnt item) +++ (setq topframe (car framelist)) +++ (or (eq (typep (car cmd)) 'symbol) (return nil)) +++ (and (eq (getchar (car cmd) 1) 'b) +++ (eq (getchar (car cmd) 2) 'k) +++ (return (debug-bktrace cmd frame))) +++ (setq cnt +++ (cond ((fixp (cadr cmd)) (cadr cmd)) +++ ((fixp (caddr cmd)) (caddr cmd)) +++ (t 1))) +++ (and (< cnt 1) (setq cnt 1)) +++ (setq item +++ (cond ((symbolp (cadr cmd)) (cadr cmd)) +++ ((symbolp (caddr cmd)) (caddr cmd)))) +++ (and item +++ (cond ((memq (car cmd) '(u up)) +++ (setq cmd (cons 'ups (cdr cmd)))) +++ ((memq (car cmd) '(d dn)) +++ (setq cmd (cons 'dns (cdr cmd)))))) +++ (selectq (car cmd) +++ (top (debug-print1 (setq frame topframe) nil)) +++ (bot (debug-print1 (setq frame (car rframelist)) nil)) +++ (p (debug-print1 frame nil)) +++ (pp ($prpr (caddr frame))) +++ (where (debug-where frame)) +++ (help +++ (cond ((cdr cmd) (eval cmd)) +++ (t (ty |/usr/lisp/doc/fixit.ref|)))) +++ ((? h) (ty |/usr/lisp/doc/fixit.ref|)) +++ ((go ok) +++ (setq frame (debug-findexpr topframe)) +++ (cond ((eq (caaddr frame) 'debug) +++ (freturn (cadr frame) t)) +++ (t (fretry (cadr frame) frame)))) +++ (pop (debug-pop)) +++ (step (setq frame (debug-findexpr frame)) +++ (step t) +++ (fretry (cadr (debug-dnframe frame)) frame)) +++ (redo (and item +++ (setq frame +++ (debug-findcall item frame framelist))) +++ (and frame (fretry (cadr frame) frame))) +++ (return (setq val (eval (cadr cmd))) +++ (freturn (cadr frame) val)) +++ (edit (debug-nedit frame)) +++ (editf +++ (cond ((null item) +++ (setq frame +++ (or (debug-findusrfn (debug-nedit frame)) +++ (car rframelist)))) +++ ((dtpr (getd item)) +++ (errset (funcall 'editf (list item)))) +++ (t (setq frame nil)))) +++ (u (debug-iter (debug-upframe frame)) +++ (cond +++ ((null nframe) (terpri) (princ '||))) +++ (debug-print1 (setq frame (or nframe frame)) nil)) +++ (d (setq nframe +++ (or (debug-iter (debug-dnframe frame)) frame)) +++ (debug-print1 nframe nil) +++ (cond ((eq frame nframe) +++ (terpri) +++ (princ '||)) +++ (t (setq frame nframe)))) +++ (up (setq nframe (debug-iter (debug-upfn frame))) +++ (cond +++ ((null nframe) (terpri) (princ '|top of stack|))) +++ (setq frame (or nframe topframe)) +++ (debug-print1 frame nil)) +++ (dn (setq frame +++ (or (debug-iter (debug-dnfn frame)) +++ (car rframelist))) +++ (debug-print1 frame nil) +++ (cond +++ ((not (eq frame nframe)) +++ (terpri) +++ (princ '||)))) +++ (ups (setq frame +++ (debug-iter +++ (debug-findcall item frame rframelist))) +++ (and frame (debug-print1 frame nil))) +++ (dns (setq frame +++ (debug-iter +++ (debug-findcall item frame framelist))) +++ (and frame (debug-print1 frame nil))) +++ (cond ((not (dtpr (car cmd))) +++ (*** should there also be a boundp test here) +++ (debug-showvar (car cmd) frame)) +++ (t (setq frame (car cmd))))) +++ (return (or frame item))))) +++ +++(def debug-bktrace +++ (lambda (cmd oframe) +++ (prog (sel cnt item frame nframe) +++ (mapc '(lambda (x) +++ (setq sel +++ (cons (selectq x +++ (f 'fns) +++ (a 'sysp) +++ (v 'bind) +++ (e 'expr) +++ (c 'current) +++ 'bogus) +++ sel))) +++ (cddr (explodec (car cmd)))) +++ (setq item +++ (cond ((eq (typep (cadr cmd)) 'symbol) (cadr cmd)) +++ ((eq (typep (caddr cmd)) 'symbol) (caddr cmd)))) +++ (cond ((debug-sysp item) (setq sel (cons 'sysp sel))) +++ ((not (memq 'sysp sel)) +++ (setq sel (cons 'user sel)))) +++ (setq cnt +++ (cond ((fixp (cadr cmd)) (cadr cmd)) +++ ((fixp (caddr cmd)) (caddr cmd)) +++ (item 1))) +++ (cond ((null cnt) +++ (setq frame +++ (cond ((memq 'current sel) oframe) +++ (t (car rframelist)))) +++ (go dbpr)) +++ ((null item) +++ (setq frame (car framelist)) +++ (and (or (not (memq 'user sel)) +++ (atom (caddr (car framelist))) +++ (not (debug-sysp (caaddr (car framelist))))) +++ (setq cnt (|1-| cnt))) +++ (setq frame +++ (cond ((zerop cnt) frame) +++ ((memq 'user sel) +++ (debug-iter (debug-dnfn frame))) +++ (t (debug-iter (debug-dnframe frame))))) +++ (setq frame (or frame (car rframelist))) +++ (go dbpr)) +++ (t (setq frame (car framelist)))) +++ (setq frame +++ (cond ((and (= cnt 1) +++ (not (atom (caddr (car framelist)))) +++ (eq item (caaddr (car framelist)))) +++ (car framelist)) +++ ((debug-iter (debug-findcall item frame framelist))) +++ (t (car rframelist)))) +++ dbpr (debug-print frame sel oframe) +++ (cond ((eq frame (car rframelist)) +++ (terpri) +++ (princ '||) +++ (terpri)) +++ (t (terpri))) +++ (cond +++ ((memq 'bogus sel) +++ (terpri) +++ (princ (car cmd)) +++ (princ '| contains an invalid bk modifier|))) +++ (return oframe)))) +++ +++(def debug-print +++ (lambda (frame sel ptr) +++ (prog (curframe) +++ (setq curframe (car framelist)) +++ loop (cond ((not +++ (and (memq 'user sel) +++ (not (atom (caddr curframe))) +++ (debug-sysp (caaddr curframe)))) +++ (debug-print1 curframe sel) +++ (and (eq curframe ptr) (princ '| <--- you are here|))) +++ ((eq curframe ptr) +++ (terpri) +++ (princ '| <--- you are somewhere in here|))) +++ (and (eq curframe frame) (return frame)) +++ (setq curframe (debug-dnframe curframe)) +++ (or curframe (return frame)) +++ (go loop)))) +++ +++(def debug-print1 +++ (lambda (frame sel) +++ (prog (prinlevel prinlength varlist) +++ (and (not (memq 'expr sel)) +++ (setq prinlevel 2) +++ (setq prinlength 5)) +++ (cond +++ ((atom (caddr frame)) +++ (terpri) +++ (princ '| |) +++ ($prin1 (caddr frame)) +++ (princ '| <- eval error|) +++ (return t))) +++ (and (memq 'bind sel) +++ (cond ((memq (caaddr frame) '(prog lambda)) +++ (setq varlist (cadr (caddr frame)))) +++ ((and (atom (caaddr frame)) (dtpr (getd (caaddr frame)))) +++ (setq varlist (cadr (getd (caaddr frame)))))) +++ (mapc (function +++ (lambda (v) +++ (debug-showvar v +++ (or (debug-upframe frame) +++ frame)))) +++ (cond ((and varlist (atom varlist)) (ncons varlist)) +++ (t varlist)))) +++ (and (memq 'user sel) +++ (debug-sysp (caaddr frame)) +++ (return nil)) +++ (cond ((memq (caaddr frame) interrupt-handlers) +++ (terpri) +++ (princ '<------------) +++ ($prin1 (cadr (assq (caaddr frame) handler-labels))) +++ (princ '-->)) +++ ((eq (caaddr frame) 'debug) +++ (terpri) +++ (princ '<------debug------>)) +++ ((memq 'fns sel) +++ (terpri) +++ (and (debug-sysp (caaddr frame)) (princ '| |)) +++ ($prin1 (caaddr frame))) +++ (t (terpri) +++ ($prin1 +++ (cond ((eq (car frame) 'eval) (caddr frame)) +++ (t (cons (caaddr frame) (cadr (caddr frame)))))))) +++ (or (not (symbolp (caaddr frame))) +++ (eq (caaddr frame) (concat (caaddr frame))) +++ (princ '| |)) +++ (return t)))) +++ +++(def debug-findcall +++ (lambda (fn frame flist) +++ (prog nil +++ loop (setq frame (debug-nextframe frame flist nil)) +++ (or frame (return nil)) +++ (cond ((atom (caddr frame)) +++ (cond ((eq (caddr frame) fn) (return frame)) (t (go loop)))) +++ ((eq (caaddr frame) fn) (return frame)) +++ (t (go loop)))))) +++ +++(def debug-scanflist +++ (lambda (frame fnset) +++ (prog nil +++ loop (or frame (return nil)) +++ (and (not (atom (caddr frame))) +++ (memq (caaddr frame) fnset) +++ (return frame)) +++ (setq frame (debug-dnframe frame)) +++ (go loop)))) +++ +++(def debug-scanstk +++ (lambda (frame fnset) +++ (prog nil +++ loop (or frame (return nil)) +++ (and (not (atom (caddr frame))) +++ (memq (caaddr frame) fnset) +++ (return frame)) +++ (setq frame (evalframe (cadr frame))) +++ (go loop)))) +++ +++(def debug-getframes +++ (lambda nil +++ (prog (flist fnew) +++ (setq fnew +++ (debug-scanstk '(nil) +++ (cons 'debug interrupt-handlers))) +++ loop (and (not (atom (caddr fnew))) +++ (eq (caaddr fnew) 'debug) +++ (eq (car (evalframe (cadr fnew))) 'apply) +++ (memq (caaddr (evalframe (cadr fnew))) interrupt-handlers) +++ (setq fnew (evalframe (cadr fnew)))) +++ (and (null flist) +++ (eq (car fnew) 'apply) +++ (memq (caaddr fnew) interrupt-handlers) +++ (setq fnew (evalframe (cadr fnew)))) +++ (and (eq (car fnew) 'apply) +++ (eq (typep (caaddr fnew)) 'symbol) +++ (not (eq (caaddr fnew) (concat (caaddr fnew)))) +++ (setq fnew (evalframe (cadr fnew))) +++ (setq fnew (evalframe (cadr fnew))) +++ (setq fnew (evalframe (cadr fnew))) +++ (setq fnew (evalframe (cadr fnew))) +++ (go loop)) +++ (and (not (atom (caddr fnew))) +++ (memq (caaddr fnew) '(evalhook* evalhook)) +++ (setq fnew (evalframe (cadr fnew))) +++ (go loop)) +++ (and (eq (car fnew) 'apply) +++ (eq (caaddr fnew) 'eval) +++ (cadadr (caddr fnew)) +++ (or (not (fixp (cadadr (caddr fnew)))) +++ (= (cadadr (caddr fnew)) -1)) +++ (setq fnew (evalframe (cadr fnew))) +++ (go loop)) +++ (and fnew +++ (setq flist (cons fnew flist)) +++ (setq fnew (evalframe (cadr fnew))) +++ (go loop)) +++ (return (nreverse flist))))) +++ +++(def debug-nextframe +++ (lambda (frame flist sel) +++ (prog nil +++ (setq flist (cdr (memq frame flist))) +++ (and (not (memq 'user sel)) (return (car flist))) +++ loop (or flist (return nil)) +++ (cond +++ ((or (atom (caddr (car flist))) +++ (not (debug-sysp (caaddr (car flist))))) +++ (return (car flist)))) +++ (setq flist (cdr flist)) +++ (go loop)))) +++ +++(def debug-upframe +++ (lambda (frame) +++ (debug-nextframe frame rframelist nil))) +++ +++(def debug-dnframe +++ (lambda (frame) +++ (debug-nextframe frame framelist nil))) +++ +++(def debug-upfn +++ (lambda (frame) +++ (debug-nextframe frame rframelist '(user)))) +++ +++(def debug-dnfn +++ (lambda (frame) +++ (debug-nextframe frame framelist '(user)))) +++ +++(def debug-showvar +++ (lambda (var frame) +++ (terpri) +++ (princ '| |) +++ (princ var) +++ (princ '| = |) +++ ($prin1 +++ ((lambda (val) (cond ((atom val) '?) (t (car val)))) +++ (errset (eval var (cadddr frame)) nil))))) +++ +++(def debug-nedit +++ (lambda (frame) +++ (prog (val body elem nframe) +++ (setq elem (caddr frame)) +++ (setq val frame) +++ scan (setq val (debug-findusrfn val)) +++ (or val (go nofn)) +++ (setq body (getd (caaddr val))) +++ (cond ((debug-insidep elem body) +++ (princ '=) +++ ($prin1 (caaddr val)) +++ (edite body +++ (list 'f (cons '== elem) 'tty:) +++ (caaddr val)) +++ (return frame)) +++ ((or (eq elem (caddr val)) (debug-insidep elem (caddr val))) +++ (setq val (debug-dnframe val)) +++ (go scan))) +++ nofn (setq nframe (debug-dnframe frame)) +++ (or nframe (go doit)) +++ (and (debug-insidep elem (caddr nframe)) +++ (setq frame nframe) +++ (go nofn)) +++ doit (edite (caddr frame) +++ (and (debug-insidep elem (caddr frame)) +++ (list 'f (cons '== elem) 'tty:)) +++ nil) +++ (return frame)))) +++ +++(def debug-insidep +++ (lambda (elem expr) +++ (car (errset (edite expr (list 'f (cons '== elem)) nil))))) +++ +++(def debug-findusrfn +++ (lambda (frame) +++ (cond ((null frame) nil) +++ ((and (dtpr (caddr frame)) +++ (symbolp (caaddr frame)) +++ (dtpr (getd (caaddr frame)))) +++ frame) +++ (t (debug-findusrfn (debug-dnframe frame)))))) +++ +++(def debug-findexpr +++ (lambda (frame) +++ (cond ((null frame) nil) +++ ((and (eq (car frame) 'eval) (not (atom (caddr frame)))) +++ frame) +++ (t (debug-findexpr (debug-dnframe frame)))))) +++ +++(def debug-pop +++ (lambda nil +++ (prog (frame) +++ (setq frame (car framelist)) +++ l (cond ((null (setq frame (evalframe (cadr frame))))(reset))) +++ (cond ((and (dtpr (caddr frame))(eq (caaddr frame) 'debug)) +++ (freturn (cadr frame) nil))) +++ (go l)))) +++ +++(def debug-where +++ (lambda (frame) +++ (prog (lev diff nframe) +++ (setq lev (- (length framelist) (length (memq frame rframelist)))) +++ (setq diff (- (length framelist) lev 1)) +++ (debug-print1 frame nil) +++ (terpri) +++ (cond ((zerop diff) (princ '|you are at top of stack.|)) +++ ((zerop lev) (princ '|you are at bottom of stack.|)) +++ (t (princ '|you are |) +++ (princ diff) +++ (cond ((= diff 1) (princ '| frame from the top.|)) +++ (t (princ '| frames from the top.|))))) +++ (terpri) +++ (and (or (atom (caddr frame)) (not (eq (car frame) 'eval))) +++ (return nil)) +++ (setq lev 0) +++ (setq nframe frame) +++ lp (and (setq nframe (debug-findcall (caaddr nframe) nframe framelist)) +++ (setq lev (|1+| lev)) +++ (go lp)) +++ (princ '|there are |) +++ (princ lev) +++ (princ '| |) +++ (princ (caaddr frame)) +++ (princ '|'s below.|) +++ (terpri)))) +++ +++(def debug-sysp +++ (lambda (x) +++ (and (sysp x) (symbolp x) (not (dtpr (getd x)))))) +++ +++(dv interrupt-handlers (fixit)) +++ +++(dv handler-labels +++ ((fixit error) +++ (debug-ubv-handler ubv) +++ (debug-udf-handler udf) +++ (debug-fac-handler fac) +++ (debug-ugt-handler ugt) +++ (debug-wta-handler wta) +++ (debug-wna-handler wna) +++ (debug-iol-handler iol) +++ (debug-*rset-handler rst) +++ (debug-mer-handler mer) +++ (debug-gcd-handler gcd) +++ (debug-gcl-handler gcl) +++ (debug-gco-handler gco) +++ (debug-pdl-handler pdl))) +++ +++(or (boundp 'traced-stuff) (setq traced-stuff nil)) +++ +++(or (boundp 'evalhook-switch) (setq evalhook-switch nil)) +++ +++(setq hush-debug nil) +++ diff --cc usr/lib/lisp/jkfmacs.l index 0000000000,0000000000,0000000000..fb40d77cad new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/jkfmacs.l @@@@ -1,0 -1,0 -1,0 +1,100 @@@@ +++(setq SCCS-jkfmacs "@(#)jkfmacs.l 1.2 10/13/80") +++ +++;------ jkfmacs :: common and useful macros +++; +++(declare (macros t)) +++ +++; contents: +++; If macro +++; +++ +++ +++;--- super if macro +++; This macro allow the following forms: +++; (If a then b) ==> (cond (a b)) +++; (If a thenret) ==> (cond (a)) +++; (If a then b else c) ==> (cond (a b) (t c)) +++; (If a then b b2 ==> (cond (a b b2) (c d d2) (t e)) +++; elseif c then d d2 +++; else e) +++; +++; +++(defun If macro (lis) +++ (prog (majlis minlis revl) +++ (do ((revl (reverse lis) (cdr revl))) +++ ((null revl)) +++ (cond ((eq (car revl) 'else) +++ (setq majlis `((t ,@minlis) ,@majlis) +++ minlis nil)) +++ ((or (eq (car revl) 'then) (eq (car revl) 'thenret)) +++ (setq revl (cdr revl) +++ majlis `((,(car revl) ,@minlis) ,@majlis) +++ minlis nil)) +++ ((eq (car revl) 'elseif)) +++ ((eq (car revl) 'If) +++ (setq majlis `(cond ,@majlis))) +++ (t (setq minlis `( ,(car revl) ,@minlis))))) +++ ; we displace the previous macro, that is we actually replace +++ ; the if list structure with the corresponding cond, meaning +++ ; that the expansion is done only once +++ (rplaca lis (car majlis)) +++ (rplacd lis (cdr majlis)) +++ (return majlis))) +++ +++;--- msg : print a message consisting of strings and values +++; arguments are: +++; N - print a newline +++; (N foo) - print foo newlines (foo is evaluated) +++; B - print a blank +++; (B foo) - print foo blanks (foo is evaluated) +++; (P foo) - print following args to port foo (foo is evaluated) +++; other - evaluate a princ the result (remember strings eval to themselves) +++ +++(defmacro msg (&rest msglist) +++ (do ((ll msglist (cdr ll)) +++ (result) +++ (cur nil nil) +++ (curport nil) +++ (current)) +++ ((null ll) `(progn ,@(nreverse result))) +++ (setq current (car ll)) +++ (If (dtpr current) +++ then (If (eq (car current) 'N) +++ then (setq cur `(msg-tyo-char 10 ,(cadr current))) +++ elseif (eq (car current) 'B) +++ then (setq cur `(msg-tyo-char 32 ,(cadr current))) +++ elseif (eq (car current) 'P) +++ then (setq curport (cadr current)) +++ else (setq cur `(princ ,current))) +++ elseif (eq current 'N) +++ then (setq cur (list 'tyo 10)) ; (can't use backquote +++ elseif (eq current 'B) ; since must have new +++ then (setq cur (list 'tyo 32)) ; dtpr cell at end) +++ else (setq cur `(princ ,current))) +++ (If cur +++ then (setq result (cons (If curport then (nconc cur (ncons curport)) +++ else cur) +++ result))))) +++ +++(defun msg-tyo-char (ch n) +++ (do ((i n (1- n))) +++ ((< n 1)) +++ (tyo ch))) +++ +++ +++ +++;--- standard push, unpush and pop macros +++; +++(defmacro push (stack value) +++ `(setq ,stack (cons ,value ,stack))) +++ +++(defmacro unpush (stack) +++ `(setq ,stack (cdr ,stack))) +++ +++(defmacro pop (stack) +++ `(prog1 (car stack) (setq ,stack (cdr ,stack)))) +++ +++ +++ +++(putprop 'jkfmacs 1 'version) +++ diff --cc usr/lib/lisp/loop.l index 0000000000,0000000000,0000000000..f4f2b0adfc new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/loop.l @@@@ -1,0 -1,0 -1,0 +1,966 @@@@ +++(setq |SCCS-loop| "@(#)loop.l 1.1 10/2/80") +++;-*- Mode:LISP; Package:System-Internals; Base:8; Lowercase:T -*- +++ +++;The master copy of this file is on ML:LSB1;LOOP > +++;The current Lisp machine copy is on AI:LISPM2;LOOP > +++;The FASL and QFASL should also be accessible from LIBLSP; on all machines. +++ +++; Bugs/complaints/suggestions/solicitations-for-documentation to BUG-LOOP +++; at any ITS site. +++ +++;; the file was franzified by JKF. +++; +++ +++;;;; LOOP Iteration Macro +++ +++ +++; Hack up the stuff for data-types. DATA-TYPE? will always be a macro +++; so that it will not require the data-type package at run time if +++; all uses of the other routines are conditionalized upon that value. +++(defmacro data-type? (x) `(get ,x ':data-type)) +++ +++(declare +++ (*lexpr variable-declarations) +++ (*expr initial-value form-wrapper)) +++ +++ +++;Loop macro +++ +++(eval-when (eval compile) +++ (defun lexpr-funcall macro (x) +++ `(apply ,(cadr x) (list* . ,(cddr x))))) +++ +++ +++(defun loop-displace (x y) +++ ((lambda (val) (rplaca x (car val)) (rplacd x (cdr val)) x) +++ (cond ((atom y) (list 'progn y)) (t y)))) +++ +++ +++(defmacro loop-finish () +++ '(go end-loop)) +++ +++(defun neq macro (x) `(not (eq . ,(cdr x)))) +++ +++ +++(defun loop-make-psetq (frobs) +++ (loop-make-setq +++ (car frobs) +++ (cond ((null (cddr frobs)) (cadr frobs)) +++ (t `(prog1 ,(cadr frobs) ,(loop-make-psetq (cddr frobs))))))) +++ +++(defmacro loop-psetq (&rest frobs) +++ (loop-make-psetq frobs)) +++ +++ +++ +++ +++(defvar loop-keyword-alist ;clause introducers +++ '( (initially loop-do-initially) +++ (finally loop-do-finally) +++ (do loop-do-do) +++ (doing loop-do-do) +++ (return loop-do-return) +++ (collect loop-do-collect list) +++ (collecting loop-do-collect list) +++ (append loop-do-collect append) +++ (appending loop-do-collect append) +++ (nconc loop-do-collect nconc) +++ (nconcing loop-do-collect nconc) +++ (count loop-do-collect count) +++ (counting loop-do-collect count) +++ (sum loop-do-collect sum) +++ (summing loop-do-collect sum) +++ (maximize loop-do-collect max) +++ (minimize loop-do-collect min) +++ (always loop-do-always t) +++ (never loop-do-always nil) +++ (thereis loop-do-thereis) +++ (while loop-do-while or) +++ (until loop-do-while and) +++ (when loop-do-when nil) +++ (unless loop-do-when t) +++ (with loop-do-with) +++ (for loop-do-for) +++ (as loop-do-for))) +++ +++(defvar loop-for-keyword-alist ;Types of FOR +++ '( (= loop-for-equals) +++ (in loop-for-in) +++ (on loop-for-on) +++ (from loop-for-arithmetic nil) +++ (downfrom loop-for-arithmetic down) +++ (upfrom loop-for-arithmetic up) +++ (being loop-for-being))) +++ +++(defvar loop-path-keyword-alist nil) ; PATH functions +++(defvar loop-variables) ;Variables local to the loop +++(defvar loop-declarations) ; Local dcls for above +++(defvar loop-variable-stack) +++(defvar loop-declaration-stack) +++(defvar loop-prologue) ;List of forms in reverse order +++(defvar loop-body) ;.. +++(defvar loop-after-body) ;.. for FOR steppers +++(defvar loop-epilogue) ;.. +++(defvar loop-after-epilogue) ;So COLLECT's RETURN comes after FINALLY +++(defvar loop-conditionals) ;If non-NIL, condition for next form in body +++ ;The above is actually a list of entries of the form +++ ;(condition forms...) +++ ;When it is output, each successive condition will get +++ ;nested inside the previous one, but it is not built up +++ ;that way because you wouldn't be able to tell a WHEN-generated +++ ;COND from a user-generated COND. +++ +++(defvar loop-when-it-variable) ;See LOOP-DO-WHEN +++(defvar loop-collect-cruft) ; for multiple COLLECTs (etc) +++(defvar loop-source-code) +++(defvar loop-attachment-transformer ; see attachment definition +++ (cond ((status feature lms) 'progn) (t nil))) +++ +++(defun loop-lookup-keyword macro (x) +++ +++ `(assq . ,(cdr x))) +++ +++ +++(defun loop-add-keyword (cruft alist-name) +++ (let ((val (symeval alist-name)) (known?)) +++ (and (setq known? (loop-lookup-keyword (car cruft) val)) +++ (set alist-name (delq known? val))) +++ (set alist-name (cons cruft val)))) +++ +++ +++(defmacro define-loop-macro (keyword) +++ (or (eq keyword 'loop) +++ (loop-lookup-keyword keyword loop-keyword-alist) +++ (error "lisp: Not a loop keyword -- " keyword)) +++ `(eval-when (compile load eval) +++ (putd ',keyword '(macro (macroarg) (loop-translate macroarg))))) +++ +++(define-loop-macro loop) +++ +++(defun loop-translate (x) +++ (loop-displace x (loop-translate-1 x))) +++ +++ +++(defun loop-translate-1 (loop-source-code) +++ (and (eq (car loop-source-code) 'loop) +++ (setq loop-source-code (cdr loop-source-code))) +++ (do ((loop-variables nil) +++ (loop-declarations nil) +++ (loop-variable-stack nil) +++ (loop-declaration-stack nil) +++ (loop-prologue nil) +++ (loop-body nil) +++ (loop-after-body nil) +++ (loop-epilogue nil) +++ (loop-after-epilogue nil) +++ (loop-conditionals nil) +++ (loop-when-it-variable nil) +++ (loop-collect-cruft nil) +++ (keyword) +++ (tem)) +++ ((null loop-source-code) +++ (and loop-conditionals +++ (error "lisp: hanging conditional in loop macro -- " +++ (caar loop-conditionals))) +++ (cond (loop-variables +++ (push loop-variables loop-variable-stack) +++ (push loop-declarations loop-declaration-stack))) +++ (setq tem `(prog () +++ ,@(nreverse loop-prologue) +++ next-loop +++ ,@(nreverse loop-body) +++ ,@(nreverse loop-after-body) +++ (go next-loop) +++ end-loop +++ ,@(nreverse loop-epilogue) +++ ,@(nreverse loop-after-epilogue))) +++ (do ((vars) (dcls)) ((null loop-variable-stack)) +++ (setq vars (pop loop-variable-stack) +++ dcls (pop loop-declaration-stack)) +++ (and dcls (setq dcls `((declare . ,(nreverse dcls))))) +++ (setq tem `(,@dcls ,tem)) +++ (cond ((do ((l vars (cdr l))) ((null l) nil) +++ (and (not (atom (car l))) +++ (not (atom (caar l))) +++ (return t))) +++ (setq tem `(let ,(nreverse vars) ,.tem))) +++ (t (let ((lambda-vars nil) (lambda-vals nil)) +++ (do ((l vars (cdr l)) (v)) ((null l)) +++ (cond ((atom (setq v (car l))) +++ (push v lambda-vars) +++ (push nil lambda-vals)) +++ (t (push (car v) lambda-vars) +++ (push (cadr v) lambda-vals)))) +++ (setq tem `((lambda ,(nreverse lambda-vars) ,.tem) +++ ,.(nreverse lambda-vals)))))) +++ ) +++ tem) +++ (if (symbolp (setq keyword (pop loop-source-code))) +++ (if (setq tem (loop-lookup-keyword keyword loop-keyword-alist)) +++ (apply (cadr tem) (cddr tem)) +++ (error "lisp: unknown keyword in loop macro -- " +++ keyword)) +++ (error "lisp: loop found object where keyword expected -- " +++ keyword)))) +++ +++ +++(defun loop-bind-block () +++ (cond ((not (null loop-variables)) +++ (push loop-variables loop-variable-stack) +++ (push loop-declarations loop-declaration-stack) +++ (setq loop-variables nil loop-declarations nil)) +++ (loop-declarations (break barf)))) +++ +++ +++;Get FORM argument to a keyword. Read up to atom. PROGNify if necessary. +++(defun loop-get-form () +++ (do ((forms (list (pop loop-source-code)) (cons (pop loop-source-code) forms)) +++ (nextform (car loop-source-code) (car loop-source-code))) +++ ((atom nextform) +++ (if (null (cdr forms)) (car forms) +++ (cons 'progn (nreverse forms)))))) +++ +++ +++(defun loop-make-setq (var-or-pattern value) +++ +++ (list (if (atom var-or-pattern) 'setq 'desetq) var-or-pattern value)) +++ +++ +++(defun loop-imply-type (expression type +++ &aux (frob (and (data-type? type) +++ (form-wrapper type expression)))) +++ (cond ((not (null frob)) frob) +++ (t expression))) +++ +++(defun loop-make-variable (name initialization dtype) +++ (cond ((null name) +++ (and initialization +++ (push (list nil +++ initialization) +++ loop-variables))) +++ ((atom name) +++ (cond ((data-type? dtype) +++ (setq loop-declarations +++ (append (variable-declarations dtype name) +++ loop-declarations)) +++ (or initialization +++ (setq initialization (initial-value dtype)))) +++ ((memq dtype '(fixnum flonum number)) +++ (or initialization +++ (setq initialization (if (eq dtype 'flonum) 0.0 0))))) +++ (push (if initialization (list name initialization) name) +++ loop-variables)) +++ (initialization +++ (push (list name initialization) loop-variables) +++ (loop-declare-variable name dtype)) +++ (t (let ((tcar) (tcdr)) +++ (cond ((atom dtype) (setq tcar (setq tcdr dtype))) +++ (t (setq tcar (car dtype) tcdr (cdr dtype)))) +++ (loop-make-variable (car name) nil tcar) +++ (loop-make-variable (cdr name) nil tcdr)))) +++ name) +++ +++(defun loop-declare-variable (name dtype) +++ (cond ((or (null name) (null dtype)) nil) +++ ((atom name) +++ (cond ((data-type? dtype) +++ (setq loop-declarations +++ (append (variable-declarations dtype name) +++ loop-declarations))) +++ )) +++ ((atom dtype) +++ (loop-declare-variable (car name) dtype) +++ (loop-declare-variable (cdr name) dtype)) +++ (t (loop-declare-variable (car name) (car dtype)) +++ (loop-declare-variable (cdr name) (cdr dtype))))) +++ +++ +++(defun loop-maybe-bind-form (form data-type?) +++ (cond ((or (numberp form) (memq form '(t nil)) +++ (and (not (atom form)) (eq (car form) 'quote))) +++ form) +++ (t (loop-make-variable (gensym) form data-type?)))) +++ +++ +++(defun loop-optional-type () +++ (let ((token (car loop-source-code))) +++ (and (not (null token)) +++ (or (not (atom token)) +++ (data-type? token) +++ (memq token '(fixnum flonum number))) +++ (pop loop-source-code)))) +++ +++ +++;Compare two "tokens". The first is the frob out of LOOP-SOURCE-CODE, +++;the second a string (lispm) or symbol (maclisp) to check against. +++(defmacro loop-tequal (x1 x2) `(eq ,x1 ,x2)) +++ +++;Incorporates conditional if necessary +++(defun loop-emit-body (form) +++ (cond (loop-conditionals +++ (rplacd (last (car (last loop-conditionals))) +++ (cond ((and (not (atom form)) ;Make into list of forms +++ (eq (car form) 'progn)) +++ (append (cdr form) nil)) +++ (t (list form)))) +++ (cond ((loop-tequal (car loop-source-code) "and") +++ (pop loop-source-code)) +++ (t ;Nest up the conditionals and output them +++ (do ((prev (car loop-conditionals) (car l)) +++ (l (cdr loop-conditionals) (cdr l))) +++ ((null l)) +++ (rplacd (last prev) `((cond ,(car l))))) +++ (push `(cond ,(car loop-conditionals)) loop-body) +++ (setq loop-conditionals nil)))) +++ (t (push form loop-body)))) +++ +++(defun loop-do-initially () +++ (push (loop-get-form) loop-prologue)) +++ +++(defun loop-do-finally () +++ (push (loop-get-form) loop-epilogue)) +++ +++(defun loop-do-do () +++ (loop-emit-body (loop-get-form))) +++ +++(defun loop-do-return () +++ (loop-emit-body `(return ,(loop-get-form)))) +++ +++ +++(defun loop-do-collect (type) +++ (let ((var) (form) (tem) (tail) (dtype) (cruft) (rvar) +++ (ctype (cond ((memq type '(max min)) 'maxmin) +++ ((memq type '(nconc list append)) 'list) +++ ((memq type '(count sum)) 'sum) +++ (t +++ (error +++ "lisp: unrecognized loop collecting keyword -- " +++ type))))) +++ (setq form (loop-get-form) dtype (loop-optional-type)) +++ (cond ((loop-tequal (car loop-source-code) 'into) +++ (pop loop-source-code) +++ (setq rvar (setq var (pop loop-source-code))))) +++ ; CRUFT will be (varname ctype dtype var tail (optional tem)) +++ (cond ((setq cruft (assq var loop-collect-cruft)) +++ (cond ((not (eq ctype (car (setq cruft (cdr cruft))))) +++ (error "lisp: incompatible loop collections -- " +++ (list ctype (car cruft)))) +++ ((and dtype (not (eq dtype (cadr cruft)))) +++ (error +++ "lisp: loop found unequal types in collector -- " +++ (list type (list dtype (cadr cruft)))))) +++ (setq dtype (car (setq cruft (cdr cruft))) +++ var (car (setq cruft (cdr cruft))) +++ tail (car (setq cruft (cdr cruft))) +++ tem (cadr cruft)) +++ (and (eq ctype 'maxmin) +++ (not (atom form)) (null tem) +++ (rplaca (cdr cruft) (setq tem (loop-make-variable +++ (gensym) nil dtype))))) +++ (t (and (null dtype) +++ (setq dtype (cond ((eq type 'count) 'fixnum) +++ ((memq type '(min max sum)) 'number)))) +++ (or var (push `(return ,(setq var (gensym))) +++ loop-after-epilogue)) +++ (loop-make-variable var nil dtype) +++ (setq tail +++ (cond ((eq ctype 'list) +++ (setq tem (loop-make-variable (gensym) nil nil)) +++ (loop-make-variable (gensym) nil nil)) +++ ((eq ctype 'maxmin) +++ (or (atom form) +++ (setq tem (loop-make-variable +++ (gensym) nil dtype))) +++ (loop-make-variable (gensym) nil nil)))) +++ (push (list rvar ctype dtype var tail tem) +++ loop-collect-cruft))) +++ (loop-emit-body +++ (selectq type +++ (count (setq tem `(setq ,var (1+ ,var))) +++ (cond ((eq form t) tem) (t `(and ,form ,tem)))) +++ (sum `(setq ,var (plus ,(loop-imply-type form dtype) ,var))) +++ ((max min) +++ `(setq ,@(and tem (prog1 `(,tem ,form) (setq form tem))) +++ ,var (cond (,tail (,type ,(loop-imply-type form dtype) +++ ,var)) +++ (t (setq ,tail t) ,form)))) +++ (list `(setq ,tem (ncons ,form) +++ ,tail (cond (,tail (cdr (rplacd ,tail ,tem))) +++ ((setq ,var ,tem)))) +++ ) +++ (nconc `(setq ,tem ,form +++ ,tail (last (cond (,tail (rplacd ,tail ,tem)) +++ ((setq ,var ,tem)))))) +++ (append `(setq ,tem (append ,form nil) +++ ,tail (last (cond (,tail (rplacd ,tail ,tem)) +++ ((setq ,var ,tem)))))))))) +++ +++ +++(defun loop-do-while (cond) +++ (loop-emit-body `(,cond ,(loop-get-form) (go end-loop)))) +++ +++(defun loop-do-when (negate?) +++ (let ((form (loop-get-form)) (cond)) +++ (cond ((loop-tequal (cadr loop-source-code) 'it) +++ ;WHEN foo RETURN IT and the like +++ (or loop-when-it-variable +++ (setq loop-when-it-variable +++ (loop-make-variable (gensym) nil nil))) +++ (setq cond `(setq ,loop-when-it-variable ,form)) +++ (setq loop-source-code ;Plug in variable for IT +++ (list* (car loop-source-code) +++ loop-when-it-variable +++ (cddr loop-source-code)))) +++ (t (setq cond form))) +++ (and negate? (setq cond `(not ,cond))) +++ (setq loop-conditionals (nconc loop-conditionals (ncons (list cond)))))) +++ +++ +++(defun loop-do-with () +++ (do ((var) (equals) (val) (dtype)) (nil) +++ (setq var (pop loop-source-code) equals (car loop-source-code)) +++ (cond ((loop-tequal equals '=) +++ (pop loop-source-code) +++ (setq val (pop loop-source-code) dtype nil)) +++ ((or (loop-tequal equals 'and) +++ (loop-lookup-keyword equals loop-keyword-alist)) +++ (setq val nil dtype nil)) +++ (t (setq dtype (pop loop-source-code) +++ equals (car loop-source-code)) +++ (cond ((loop-tequal equals '=) +++ (pop loop-source-code) +++ (setq val (pop loop-source-code))) +++ ((and (not (null loop-source-code)) +++ (not (loop-lookup-keyword equals loop-keyword-alist)) +++ (not (loop-tequal equals 'and))) +++ (error "lisp: loop was expecting = but found " +++ equals)) +++ (t (setq val nil))))) +++ (loop-make-variable var val dtype) +++ (cond ((not (loop-tequal (car loop-source-code) 'and)) (return nil)) +++ ((pop loop-source-code)))) +++ (loop-bind-block)) +++ +++(defun loop-do-always (true) +++ (let ((form (loop-get-form))) +++ (or true (setq form `(not ,form))) +++ (loop-emit-body `(or ,form (return nil))) +++ (push '(return t) loop-after-epilogue))) +++ +++;THEREIS expression +++;If expression evaluates non-nil, return that value. +++(defun loop-do-thereis () +++ (let ((var (loop-make-variable (gensym) nil nil)) +++ (expr (loop-get-form))) +++ (loop-emit-body `(and (setq ,var ,expr) (return ,var))))) +++ +++;FOR variable keyword ..args.. {AND more-clauses} +++;For now AND only allowed with the = keyword +++(defun loop-do-for () +++ (and loop-conditionals +++ (error "lisp: loop for or as starting inside of conditional")) +++ (do ((var) (data-type?) (keyword) (first-arg) +++ (tem) (pretests) (posttests) (inits) (steps)) +++ (nil) +++ (setq var (pop loop-source-code) data-type? (loop-optional-type) +++ keyword (pop loop-source-code) first-arg (pop loop-source-code)) +++ (and (or (not (symbolp keyword)) +++ (null (setq tem (loop-lookup-keyword +++ keyword +++ loop-for-keyword-alist)))) +++ (error "lisp: unknown keyword in for or as loop clause -- " +++ keyword)) +++ (setq tem (lexpr-funcall (cadr tem) var first-arg data-type? (cddr tem))) +++ (and (car tem) (push (car tem) pretests)) +++ (setq inits (nconc inits (append (car (setq tem (cdr tem))) nil))) +++ (and (car (setq tem (cdr tem))) (push (car tem) posttests)) +++ (setq steps (nconc steps (append (car (setq tem (cdr tem))) nil))) +++ (cond ((not (loop-tequal (car loop-source-code) 'and)) +++ (cond ((cdr (setq pretests (nreverse pretests))) +++ (push 'or pretests)) +++ (t (setq pretests (car pretests)))) +++ (cond ((cdr (setq posttests (nreverse posttests))) +++ (push 'or posttests)) +++ (t (setq posttests (car posttests)))) +++ (and pretests (push `(and ,pretests (go end-loop)) loop-body)) +++ (and inits (push (loop-make-psetq inits) loop-body)) +++ (and posttests (push `(and ,posttests (go end-loop)) +++ loop-after-body)) +++ (and steps (push (loop-make-psetq steps) loop-after-body)) +++ (loop-bind-block) +++ (return nil)) +++ (t (pop loop-source-code))))) +++ +++(defun loop-for-equals (var val data-type?) +++ (cond ((loop-tequal (car loop-source-code) 'then) +++ ;FOR var = first THEN next +++ (pop loop-source-code) +++ (loop-make-variable var val data-type?) +++ (list nil nil nil `(,var ,(loop-get-form)))) +++ (t (loop-make-variable var nil data-type?) +++ (list nil `(,var ,val) nil nil)))) +++ +++ +++(defun loop-for-on (var val data-type?) +++ (let ((step (if (loop-tequal (car loop-source-code) 'by) +++ (progn (pop loop-source-code) (pop loop-source-code)) +++ '(function cdr))) +++ (var1 (cond ((not (atom var)) +++ ; Destructuring? Then we can't use VAR as the +++ ; iteration variable. +++ (loop-make-variable var nil nil) +++ (loop-make-variable (gensym) val nil)) +++ (t (loop-make-variable var val nil) +++ var)))) +++ (setq step (cond ((or (atom step) +++ (not (memq (car step) '(quote function)))) +++ `(funcall ,(loop-make-variable (gensym) step nil) +++ ,var1)) +++ (t (list (cadr step) var1)))) +++ (list `(null ,var1) (and (not (eq var var1)) `(,var ,var1)) +++ nil `(,var1 ,step)))) +++ +++ +++(defun loop-for-in (var val data-type?) +++ (let ((var1 (gensym)) ;VAR1 is list, VAR is element +++ (step (if (loop-tequal (car loop-source-code) 'by) +++ (progn (pop loop-source-code) (pop loop-source-code)) +++ '(function cdr)))) +++ (loop-make-variable var1 val nil) +++ (loop-make-variable var nil data-type?) +++ (setq step (cond ((or (atom step) +++ (not (memq (car step) '(quote function)))) +++ `(funcall (loop-make-variable (gensym) step nil) +++ var1)) +++ (t (list (cadr step) var1)))) +++ (list `(null ,var1) `(,var (car ,var1)) nil `(,var1 ,step)))) +++ +++ +++(defun loop-for-arithmetic (var val data-type? forced-direction) +++ (let ((limit) (step 1) (test) (direction) (eval-to-first t) (inclusive)) +++ (do () (nil) +++ (cond ((not (symbolp (car loop-source-code))) (return nil)) +++ ((loop-tequal (car loop-source-code) 'by) +++ (pop loop-source-code) +++ (setq step (loop-get-form) eval-to-first t)) +++ ((loop-tequal (car loop-source-code) 'to) +++ (pop loop-source-code) +++ (setq limit (loop-get-form) inclusive t eval-to-first nil)) +++ ((loop-tequal (car loop-source-code) 'downto) +++ (pop loop-source-code) +++ (setq limit (loop-get-form) inclusive t +++ eval-to-first nil direction 'down)) +++ ((loop-tequal (car loop-source-code) 'below) +++ (pop loop-source-code) +++ (setq limit (loop-get-form) direction 'up eval-to-first nil)) +++ ((loop-tequal (car loop-source-code) 'above) +++ (pop loop-source-code) +++ (setq limit (loop-get-form) direction 'down eval-to-first nil)) +++ (t (return nil)))) +++ (cond ((null direction) (setq direction (or forced-direction 'up))) +++ ((and forced-direction (not (eq forced-direction direction))) +++ (error "lisp: loop variable stepping lossage with " var))) +++ (or data-type? (setq data-type? 'fixnum)) +++ (and (eq data-type? 'flonum) (fixp step) (setq step (float step))) +++ (loop-make-variable var val data-type?) +++ (cond ((and limit eval-to-first) +++ (setq limit (loop-maybe-bind-form limit data-type?)))) +++ (setq step (loop-maybe-bind-form step data-type?)) +++ (cond ((and limit (not eval-to-first)) +++ (setq limit (loop-maybe-bind-form limit data-type?)))) +++ (cond ((not (null limit)) +++ (let ((z (list var limit))) +++ (setq test (cond ((eq direction 'up) +++ (cond (inclusive `(greaterp . ,z)) +++ (t `(not (lessp . ,z))))) +++ (t (cond (inclusive `(lessp . ,z)) +++ (t `(not (greaterp . ,z)))))))))) +++ (setq step (cond ((eq direction 'up) +++ (cond ((equal step 1) `(add1 ,var)) +++ (t `(plus ,var ,step)))) +++ ((equal step 1) `(sub1 ,var)) +++ (t `(difference ,var ,step)))) +++ ;; The object of the following crock is to get the INTERPRETER to +++ ;; do error checking. This is only correct for data-type of FIXNUM, +++ ;; since floating-point arithmetic is contagious. +++ #M (and (eq data-type? 'fixnum) +++ (rplaca step (cdr (assq (car step) '((sub1 . 1-) (add1 . 1+) +++ (plus . +) +++ (difference . -)))))) +++ (list test nil nil `(,var ,step)))) +++ +++ +++(defun loop-for-being (var val data-type?) +++ ; FOR var BEING something ... - var = VAR, something = VAL. +++ ; If what passes syntactically for a pathname isn't, then +++ ; we trap to the ATTACHMENTS path; the expression which looked like +++ ; a path is given as an argument to the IN preposition. If +++ ; LOOP-ATTACHMENT-TRANSFORMER is not NIL, then we call that on the +++ ; "form" to get the actual form; otherwise, we quote it. Thus, +++ ; by default, FOR var BEING EACH expr OF expr-2 +++ ; ==> FOR var BEING ATTACHMENTS IN 'expr OF expr-2. +++ (let ((tem) (inclusive?) (ipps) (each?) (attachment)) +++ (cond ((loop-tequal val "each") +++ (setq each? t val (car loop-source-code))) +++ (t (push val loop-source-code))) +++ (cond ((and (setq tem (loop-lookup-keyword val loop-path-keyword-alist)) +++ (or each? (not (loop-tequal (cadr loop-source-code) 'and)))) +++ ;; FOR var BEING {each} path {prep expr}..., but NOT +++ ;; FOR var BEING var-which-looks-like-path AND {ITS} ... +++ (pop loop-source-code)) +++ (t (setq val (loop-get-form)) +++ (cond ((loop-tequal (car loop-source-code) 'and) +++ ;; FOR var BEING value AND ITS path-or-ar +++ (or (null each?) +++ (error "lisp: malformed being clause in loop of var " +++ var)) +++ (setq ipps `((of ,val)) inclusive? t) +++ (pop loop-source-code) +++ (or (loop-tequal (setq tem (pop loop-source-code)) +++ 'its) +++ (loop-tequal tem 'his) +++ (loop-tequal tem 'her) +++ (loop-tequal tem 'their) +++ (loop-tequal tem 'each) +++ (error "lisp: loop expected its or each but found " +++ tem)) +++ (cond ((setq tem (loop-lookup-keyword +++ (car loop-source-code) +++ loop-path-keyword-alist)) +++ (pop loop-source-code)) +++ (t (push (setq attachment `(in ,(loop-get-form))) +++ ipps)))) +++ ((not (setq tem (loop-lookup-keyword +++ (car loop-source-code) +++ loop-path-keyword-alist))) +++ ; FOR var BEING {each} a-r ... +++ (setq ipps (list (setq attachment (list 'in val))))) +++ (t ; FOR var BEING {each} pathname ... +++ ; Here, VAL should be just PATHNAME. +++ (pop loop-source-code))))) +++ (cond ((not (null tem))) +++ ((not (setq tem (loop-lookup-keyword 'attachments +++ loop-path-keyword-alist))) +++ (error "lisp: loop trapped to attachments path illegally")) +++ (t (or attachment (break barf)) +++ (rplaca (cdr attachment) +++ (cond (loop-attachment-transformer +++ (funcall loop-attachment-transformer +++ (cadr attachment))) +++ (t (list 'quote (cadr attachment))))))) +++ (setq tem (funcall (cadr tem) (car tem) var data-type? +++ (nreconc ipps (loop-gather-preps (caddr tem))) +++ inclusive? (caddr tem) (cdddr tem))) +++ ;; TEM is now (bindings prologue-forms endtest setups steps) +++ (mapc '(lambda (x) +++ (let (var val dtype) +++ (cond ((atom x) (setq var x)) +++ (t (setq var (car x) val (cadr x) dtype (caddr x)))) +++ (loop-make-variable var val dtype))) +++ (car tem)) +++ (setq loop-prologue (nconc (reverse (cadr tem)) loop-prologue)) +++ (cddr tem))) +++ +++ +++(defun loop-gather-preps (preps-allowed) +++ (do ((list nil (cons (list (pop loop-source-code) (loop-get-form)) list)) +++ (token (car loop-source-code) (car loop-source-code))) +++ ((not (memq token preps-allowed)) +++ (nreverse list)))) +++ +++ +++(defun loop-add-path (name data) +++ (loop-add-keyword (cons name data) 'loop-path-keyword-alist)) +++ +++ +++(defmacro define-loop-path (names &rest cruft +++ &aux forms) +++ (setq forms (mapcar +++ '(lambda (name) +++ `(loop-add-path +++ ',name ',cruft)) +++ (cond ((atom names) (list names)) +++ (t names)))) +++ `(eval-when (eval load compile) ,@forms)) +++ +++ +++(defun loop-path-carcdr (name var dtype pps inclusive? preps data) +++ preps dtype ;Prevent unused arguments error +++ (let ((vars) (step) (endtest `(,(cadr data) ,var)) (tem)) +++ (or (setq tem (loop-lookup-keyword 'of pps)) +++ (error "lisp: loop path has no initialization -- " name)) +++ (setq vars `((,var ,(cond (inclusive? (cadr tem)) +++ (t `(,(car data) ,(cadr tem)))) +++ ,dtype))) +++ (setq step `(,var (,(car data) ,var))) +++ (list vars nil nil nil endtest step))) +++ +++ +++(defun loop-interned-symbols-path (path variable data-type prep-phrases +++ inclusive? allowed-preps data) +++ path data-type allowed-preps data ; unused vars +++ ; data-type should maybe be error-checked..... +++ (let ((bindings) (presteps) (pretest) (poststeps) (posttest) +++ (prologue) (indexv) (listv) (ob) +++ (test) (step)) +++ (push variable bindings) +++ (and (not (null prep-phrases)) +++ (or (cdr prep-phrases) +++ (and (not (loop-tequal (caar prep-phrases) 'in)) +++ (not (loop-tequal (caar prep-phrases) 'of)))) +++ (error +++ "Illegal prep phrase(s) in interned-symbols path --" +++ (list* variable 'being path prep-phrases))) +++ (push (list (setq ob (gensym)) +++ (cond ((null prep-phrases) 'obarray ) +++ (t (cadar prep-phrases)))) +++ bindings) +++ ; Multics lisp does not store single-char-obs in the obarray buckets. +++ ; Thus, we need to iterate over the portion of the obarray +++ ; containing them also. (511. = (ascii 0)) +++ (push `(,(setq indexv (gensym)) +++ #+Multics 639. #+(and Maclisp (not Multics)) 511. #Q 0 +++ fixnum) +++ bindings) +++ #M (push `(,(setq listv (gensym)) nil) bindings) +++ #Q (push `(setq ,indexv (array-dimension-n 2 ,ob)) prologue) +++ (setq test +++ `(and #-Multics (null ,listv) +++ #+Multics (or (> ,indexv 510.) (null ,listv)) +++ (prog () +++ lp (cond ((< (setq ,indexv (1- ,indexv)) 0) (return t)) +++ ((setq ,listv (arraycall #+Multics obarray +++ #-Multics t ,ob ,indexv)) +++ (return nil)) +++ (t (go lp))))) +++ ) +++ (setq step +++ `(,variable +++ #+Multics (cond ((> ,indexv 510.) ,listv) +++ (t (prog2 nil (car ,listv) +++ (setq ,listv (cdr ,listv))))) +++ #+(and Maclisp (not Multics)) (car ,listv) +++ #+Lispm (ar-2 ,ob 1 ,indexv))) +++ (cond (inclusive? (setq posttest test poststeps step +++ prologue `((setq ,variable ,ob)))) +++ (t (setq pretest test presteps step))) +++ #+(and Maclisp (not Multics)) +++ (setq poststeps `(,@poststeps ,listv (cdr ,listv))) +++ (list bindings prologue pretest presteps posttest poststeps))) +++ +++ +++; We don't want these defined in the compilation environment because +++; the appropriate environment hasn't been set up. So, we just bootstrap +++; them up. +++(mapc '(lambda (x) +++ (mapc '(lambda (y) (loop-add-path y (cdr x))) (car x))) +++ '(((car cars) loop-path-carcdr (of) car atom) +++ ((cdr cdrs) loop-path-carcdr (of) cdr atom) +++ ((cddr cddrs) loop-path-carcdr (of) cddr null) +++ ((interned-symbols interned-symbol) +++ loop-interned-symbols-path (in)) +++ )) +++ +++(or (status feature loop) (sstatus feature loop)) +++ +++;Loop macro blathering. +++; +++; This doc is totally wrong. Complete documentation (nice looking +++; hardcopy) is available from GSB, or from ML:LSBDOC;LPDOC (which +++; needs to be run through BOLIO). +++; +++;This is intended to be a cleaned-up version of PSZ's FOR package +++;which is a cleaned-up version of the Interlisp CLisp FOR package. +++;Note that unlike those crocks, the order of evaluation is the +++;same as the textual order of the code, always. +++; +++;The form is introduced by the word LOOP followed by a series of clauses, +++;each of which is introduced by a keyword which however need not be +++;in any particular package. Certain keywords may be made "major" +++;which means they are global and macros themselves, so you could put +++;them at the front of the form and omit the initial "LOOP". +++; +++;Each clause can generate: +++; +++; Variables local to the loop. +++; +++; Prologue Code. +++; +++; Main Code. +++; +++; Epilogue Code. +++; +++;Within each of the three code sections, code is always executed strictly +++;in the order that the clauses were written by the user. For parallel assignments +++;and such there are special syntaxes within a clause. The prologue is executed +++;once to set up. The main code is executed several times as the loop. The epilogue +++;is executed once after the loop terminates. +++; +++;The term expression means any Lisp form. The term expression(s) means any number +++;of Lisp forms, where only the first may be atomic. It stops at the first atom +++;after the first form. +++; +++;The following clauses exist: +++; +++;Prologue: +++; INITIALLY expression(s) +++; This explicitly inserts code into the prologue. More commonly +++; code comes from variable initializations. +++; +++;Epilogue: +++; FINALLY expression(s) +++; This is the only way to explicitly insert code into the epilogue. +++; +++;Side effects: +++; DO expression(s) +++; The expressions are evaluated. This is how you make a "body". +++; DOING is synonymous with DO. +++; +++;Return values: +++; RETURN expression(s) +++; The last expression is returned immediately as the value of the form. +++; This is equivalent to DO (RETURN expression) which you will +++; need to use if you want to return multiple values. +++; COLLECT expression(s) +++; The return value of the form will be a list (unless over-ridden +++; with a RETURN). The list is formed out of the values of the +++; last expression. +++; COLLECTING is synonymous with COLLECT. +++; APPEND (or APPENDING) and NCONC (or NCONCING) can be used +++; in place of COLLECT, forming the list in the appropriate ways. +++; COUNT expression(s) +++; The return value of the form will be the number of times the +++; value of the last expression was non-NIL. +++; SUM expression(s) +++; The return value of the form will be the arithmetic sum of +++; the values of the last expression. +++; The following are a bit wierd syntactically, but Interlisp has them +++; so they must be good. +++; ALWAYS expression(s) +++; The return value will be T if the last expression is true on +++; every iteration, NIL otherwise. +++; NEVER expressions(s) +++; The return value will be T if the last expression is false on +++; every iteration, NIL otherwise. +++; THEREIS expression(s) +++; This is wierd, I'm not sure what it really does. +++ +++ +++; You probably want WHEN (NUMBERP X) RETURN X +++; or maybe WHEN expression RETURN IT +++; +++;Conditionals: (these all affect only the main code) +++; +++; WHILE expression +++; The loop terminates at this point if expression is false. +++; UNTIL expression +++; The loop terminates at this point if expression is true. +++; WHEN expression clause +++; Clause is performed only if expression is true. +++; This affects only the main-code portion of a clause +++; such as COLLECT. Use with FOR is a little unclear. +++; IF is synonymous with WHEN. +++; WHEN expression RETURN IT (also COLLECT IT, COUNT IT, SUM IT) +++; This is a special case, the value of expression is returned if non-NIL. +++; This works by generating a temporary variable to hold +++; the value of the expression. +++; UNLESS expression clause +++; Clause is performed only if expression is false. +++; +++;Variables and iterations: (this is the hairy part) +++; +++; WITH variable = expression {AND variable = expression}... +++; The variable is set to the expression in the prologue. +++; If several variables are chained together with AND +++; the setq's happen in parallel. Note that all variables +++; are bound before any expressions are evaluated (unlike DO). +++; +++; FOR variable = expression {AND variable = expression}... +++; At this point in the main code the variable is set to the expression. +++; Equivalent to DO (PSETQ variable expression variable expression...) +++; except that the variables are bound local to the loop. +++; +++; FOR variable FROM expression TO expression {BY expression} +++; Numeric iteration. BY defaults to 1. +++; BY and TO may be in either order. +++; If you say DOWNTO instead of TO, BY defaults to -1 and +++; the end-test is reversed. +++; If you say BELOW instead of TO or ABOVE instead of DOWNTO +++; the iteration stops before the end-value instead of after. +++; The expressions are evaluated in the prologue then the +++; variable takes on its next value at this point in the loop; +++; hair is required to win the first time around if this FOR is +++; not the first thing in the main code. +++; FOR variable IN expression +++; Iteration down members of a list. +++; FOR variable ON expression +++; Iteration down tails of a list. +++; FOR variable IN/ON expression BY expression +++; This is an Interlisp crock which looks useful. +++; FOR var ON list BY expression[var] +++; is the same as FOR var = list THEN expression[var] +++; FOR var IN list BY expression[var] +++; is similar except that var gets tails of the list +++; and, kludgiferously, the internal tail-variable +++; is substituted for var in expression. +++; FOR variable = expression THEN expression +++; General DO-type iteration. +++; Note that all the different types of FOR clauses can be tied together +++; with AND to achieve parallel assignment. Is this worthwhile? +++; [It's only implemented for = mode.] +++; AS is synonymous with FOR. +++; +++; FOR variable BEING expression(s) AND ITS pathname +++; FOR variable BEING expression(s) AND ITS a-r +++; FOR variable BEING {EACH} pathname {OF expression(s)} +++; FOR variable BEING {EACH} a-r {OF expression(s)} +++; Programmable iteration facility. Each pathname has a +++; function associated with it, on LOOP-PATH-KEYWORD-ALIST; the +++; alist has entries of the form (pathname function prep-list). +++; prep-list is a list of allowed prepositions; after either of +++; the above formats is parsed, then pairs of (preposition expression) +++; are collected, while preposition is in prep-list. The expression +++; may be a progn if there are multiple prepositions before the next +++; keyword. The function is then called with arguments of: +++; pathnname variable prep-phrases inclusive? prep-list +++; Prep-phrases is the list of pairs collected, in order. Inclusive? +++; is T for the first format, NIL otherwise; it says that the init +++; value of the form takes on expression. For the first format, the +++; list (OF expression) is pushed onto the fromt of the prep-phrases. +++; In the above examples, a-r is a form to be evaluated to get an +++; attachment-relationship. In this case, the pathname is taken as +++; being ATTACHMENTS, and a-r is passed in by being treated as if it +++; had been used with the preposition IN. The function should return +++; a list of the form (bindings init-form step-form end-test); bindings +++; are stuffed onto loop-variables, init-form is initialization code, +++; step-form is step-code, and end-test tells whether or not to exit. +++; +++;Declarations? Not needed by Lisp machine. For Maclisp these will be done +++;by a reserved word in front of the variable name as in PSZ's macro. +++; +++;The implementation is as a PROG. No initial values are given for the +++;PROG-variables. PROG1 is used for parallel assignment. +++; +++;The iterating forms of FOR present a special problem. The problem is that +++;you must do everything in the order that it was written by the user, but the +++;FOR-variable gets its value in a different way in the first iteration than +++;in the subsequent iterations. Note that the end-tests created by FOR have +++;to be done in the appropriate order, since otherwise the next clause might get +++;an error. +++; +++;The most general way is to introduce a flag, !FIRST-TIME, and compile the +++;clause "FOR var = first TO last" as "INITIALLY (SETQ var first) +++;WHEN (NOT !FIRST-TIME) DO (SETQ var (1+ var)) WHILE (<= var last)". +++;However we try to optimize this by recognizing a special case: +++;The special case is recognized where all FOR clauses are at the front of +++;the main code; in this case if there is only one its stepping and +++;endtest are moved to the end, and a jump to the endtest put at the +++;front. If there are more than one their stepping and endtests are moved +++;to the end, with duplicate endtests at the front except for the last +++;which doesn't need a duplicate endtest. If FORs are embedded in the +++;main code it can only be implemented by either a first-time flag or +++;starting the iteration variable at a special value (initial minus step +++;in the numeric iteration case). This could probably just be regarded as +++;an error. The important thing is that it never does anything out of +++;order. +++ diff --cc usr/lib/lisp/machacks.l index 0000000000,0000000000,0000000000..eb4c9fb3da new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/machacks.l @@@@ -1,0 -1,0 -1,0 +1,305 @@@@ +++(setq |SCCS-machacks| "@(#)machacks.l 1.2 11/7/80") +++ +++;; machacks - maclisp compatibility package. +++;; When this file is fasl'ed into a lisp, it will change the syntax to +++;; maclisp's syntax and will define functions know to the standard maclisp. +++; +++; this file will be fasled whenever the -m switch is set for compilation. +++; +++ +++(declare (macros t)) +++ +++;-- macsyma-env +++; This really isn't part of the maclisp compatibility package but we put +++; it here to allow us to bootstrap the macsyma macro packages. +++; +++(def macsyma-env ; put at the beginning of each macsyma file +++ (macro (l) `(include |libmax//prelud.l|))) +++ +++(def coutput +++ (lambda (msg) +++ (print msg) ; should go to unfasl port +++ (terpr))) +++ +++;--- displace +++; This is useful after a macro has been expanded and you want to save the +++; interpreter the trouble of expanding the macro again. +++; [This is really only useful for interpretation] +++(defun displace (old-form new-form) +++ (cond ((atom old-form) +++ (error '|Not able to displace this form| old-form)) +++ ((atom new-form) +++ (rplaca old-form 'progn) +++ (rplacd old-form (list new-form))) +++ (t (rplaca old-form (car new-form)) +++ (rplacd old-form (cdr new-form))))) +++ +++;--- caseq +++; use is +++; (caseq expr +++; (match1 do1) +++; (match2 do2) +++; (t doifallelsefails)) +++(def caseq +++ (macro (form) +++ ((lambda (x) +++ `((lambda (,x) +++ (cond +++ ,@(mapcar '(lambda (ff) +++ (cond ((eq (car ff) 't) +++ `(t ,(cadr ff))) +++ (t `((eq ,x ',(car ff)) +++ ,(cadr ff))))) +++ (cddr form)))) +++ ,(cadr form))) +++ (gensym 'Z)))) +++ +++ +++ +++;A winning macro to store things anywhere: (stolen from AI:ALAN;LSPENV) +++;(SETF (CADR X) 3) --> (RPLACA (CDR X) 3) +++ +++(DEFMACRO SETF (EXPR VAL) +++ (COND ((ATOM EXPR) +++ (OR (SYMBOLP EXPR) (ERROR '|-- SETF can't handle this.| EXPR)) +++ `(SETQ ,EXPR ,VAL)) +++ (T +++ (DO ((Y)) (()) +++ (OR (SYMBOLP (CAR EXPR)) +++ (ERROR '|-- SETF can't handle this.| EXPR)) +++ (AND (SETQ Y (GET (CAR EXPR) 'SETF-EXPAND)) +++ (RETURN (FUNCALL Y EXPR VAL))) +++ (OR (SETQ Y (GET (CAR EXPR) 'MACRO)) +++ (ERROR '|-- SETF can't handle this.| EXPR)) +++ (SETQ EXPR (FUNCALL Y EXPR)))))) +++ +++(DEFMACRO DEFSETF (NAME VARS &REST BODY) +++ `(DEFPROP ,NAME (LAMBDA ,VARS . ,BODY) SETF-EXPAND)) +++ +++(DEFSETF CAR (E V) `(RPLACA ,(CADR E) ,V)) +++(DEFSETF CAAR (E V) `(RPLACA (CAR ,(CADR E)) ,V)) +++(DEFSETF CADR (E V) `(RPLACA (CDR ,(CADR E)) ,V)) +++(DEFSETF CAAAR (E V) `(RPLACA (CAAR ,(CADR E)) ,V)) +++(DEFSETF CADAR (E V) `(RPLACA (CDAR ,(CADR E)) ,V)) +++(DEFSETF CAADR (E V) `(RPLACA (CADR ,(CADR E)) ,V)) +++(DEFSETF CADDR (E V) `(RPLACA (CDDR ,(CADR E)) ,V)) +++(DEFSETF CAAAAR (E V) `(RPLACA (CAAAR ,(CADR E)) ,V)) +++(DEFSETF CADAAR (E V) `(RPLACA (CDAAR ,(CADR E)) ,V)) +++(DEFSETF CAADAR (E V) `(RPLACA (CADAR ,(CADR E)) ,V)) +++(DEFSETF CADDAR (E V) `(RPLACA (CDDAR ,(CADR E)) ,V)) +++(DEFSETF CAAADR (E V) `(RPLACA (CAADR ,(CADR E)) ,V)) +++(DEFSETF CADADR (E V) `(RPLACA (CDADR ,(CADR E)) ,V)) +++(DEFSETF CAADDR (E V) `(RPLACA (CADDR ,(CADR E)) ,V)) +++(DEFSETF CADDDR (E V) `(RPLACA (CDDDR ,(CADR E)) ,V)) +++(DEFSETF CDR (E V) `(RPLACD ,(CADR E) ,V)) +++(DEFSETF CDAR (E V) `(RPLACD (CAR ,(CADR E)) ,V)) +++(DEFSETF CDDR (E V) `(RPLACD (CDR ,(CADR E)) ,V)) +++(DEFSETF CDAAR (E V) `(RPLACD (CAAR ,(CADR E)) ,V)) +++(DEFSETF CDDAR (E V) `(RPLACD (CDAR ,(CADR E)) ,V)) +++(DEFSETF CDADR (E V) `(RPLACD (CADR ,(CADR E)) ,V)) +++(DEFSETF CDDDR (E V) `(RPLACD (CDDR ,(CADR E)) ,V)) +++(DEFSETF CDAAAR (E V) `(RPLACD (CAAAR ,(CADR E)) ,V)) +++(DEFSETF CDDAAR (E V) `(RPLACD (CDAAR ,(CADR E)) ,V)) +++(DEFSETF CDADAR (E V) `(RPLACD (CADAR ,(CADR E)) ,V)) +++(DEFSETF CDDDAR (E V) `(RPLACD (CDDAR ,(CADR E)) ,V)) +++(DEFSETF CDAADR (E V) `(RPLACD (CAADR ,(CADR E)) ,V)) +++(DEFSETF CDDADR (E V) `(RPLACD (CDADR ,(CADR E)) ,V)) +++(DEFSETF CDADDR (E V) `(RPLACD (CADDR ,(CADR E)) ,V)) +++(DEFSETF CDDDDR (E V) `(RPLACD (CDDDR ,(CADR E)) ,V)) +++ +++(DEFSETF CXR (E V) `(RPLACX ,(CADR E) ,(CADDR E) ,V)) +++ +++(DEFSETF NTH (E V) `(RPLACA (NTHCDR ,(CADR E) ,(CADDR E)) ,V)) +++ +++(DEFSETF ARRAYCALL (E V) `(STORE ,E ,V)) +++ +++(DEFSETF GET (E V) `(PUTPROP ,(CADR E) ,V ,(CADDR E))) +++ +++(DEFSETF PLIST (E V) `(SETPLIST ,(CADR E) ,V)) +++ +++(DEFSETF SYMEVAL (E V) `(SET ,(CADR E) ,V)) +++ +++(DEFSETF ARG (E V) `(SETARG ,(CADR E) ,V)) +++ +++(DEFSETF ARGS (E V) `(ARGS ,(CADR E) ,V)) +++ +++(DEFSETF SFA-GET (E V) `(SFA-STORE ,(CADR E) ,(CADDR E) ,V)) +++ +++(DEFSETF EXAMINE (E V) `(DEPOSIT ,(CADR E) ,V)) +++ +++ +++(defmacro list* (&rest forms) +++ (cond ((null forms) nil) +++ ((null (cdr forms)) (car forms)) +++ (t (construct-list* forms)))) +++(defmacro ttf (&rest l) `(list* . , l)) +++ +++ +++(defun construct-list* (forms) +++ (setq forms (reverse forms)) +++ (do ((forms (cddr forms) (cdr forms)) +++ (return-form `(cons ,(cadr forms) ,(car forms)) +++ `(cons ,(car forms) ,return-form))) +++ ((null forms) return-form))) +++ +++;; lexpr-funcall is a cross between apply and funcall. The last arguments +++;; is a list of the rest of the arguments +++(defmacro lexpr-funcall (func &rest args) +++ `(apply ,func (list* ,@args))) +++ +++; contents of the file libmax;macros all of these functions are +++; (by default) in maclisp +++;; (IF X P Q1 Q2 ...) --> (COND (X P) (T Q1 Q2 ...)) +++;; It is important that (IF NIL
) returns NIL as Macsyma code depends +++;; upon this in places. See also IFN in LIBMAX;MAXMAC. +++ +++(DEFMACRO IF (PREDICATE THEN &REST ELSE) +++ (COND ((NULL ELSE) `(COND (,PREDICATE ,THEN))) +++ (T `(COND (,PREDICATE ,THEN) (T . ,ELSE))))) +++ +++;; LET, LET*, LIST* are now a part of Multics Lisp. Nobody should miss +++;; the code commented out below. +++;; (LET ((A 3) (B) C) STUFF) --> ((LAMBDA (A B C) STUFF) 3 NIL NIL) +++;; (LET* ((A 3) (B 4)) STUFF) --> ((LAMBDA (A) ((LAMBDA (B) STUFF) 4)) 3) +++ +++;; (PUSH X S) --> (SETQ S (CONS X S)) +++ +++(DEFMACRO PUSH (OBJECT LIST) `(SETF ,LIST (CONS ,OBJECT ,LIST))) +++ +++;; (POP S) --> (PROG1 (CAR S) (SETF S (CDR S))) +++;; (POP S V) --> (PROG1 (SETF V (CAR S)) (SETF S (CDR S))) +++;; This relies on the fact that SETF returns the value stored. +++ +++(DEFMACRO POP (LIST &OPTIONAL (INTO NIL INTO-P)) +++ (COND (INTO-P `(PROG1 (SETF ,INTO (CAR ,LIST)) +++ (SETF ,LIST (CDR ,LIST)))) +++ (T `(PROG1 (CAR ,LIST) +++ (SETF ,LIST (CDR ,LIST)))))) +++ +++;; (FOR I m n . BODY) will evaluate BODY with I bound to m,m+1,...,n-1 +++;; sequentially. (FOR I 0 n . BODY) --> (DOTIMES (I n) . BODY) +++ +++(DEFMACRO FOR (VAR START STOP . BODY) +++ `(DO ,VAR ,START (1+ ,VAR) (= ,VAR ,STOP) ,@BODY)) +++ +++(DEFMACRO EVENP (X) `(NOT (ODDP ,X))) +++ +++; these were grabbed from lspsrc;umlmac.5 +++(DEFMACRO WHEN (P . C) `(COND (,P . ,C))) +++(DEFMACRO UNLESS (P . C) `(COND ((NOT ,P) . ,C))) +++(defmacro DOLIST ((var form index) &rest body &aux (dummy (gensym)) decls) +++ (setq decls (cond ((and body +++ (not (atom (car body))) +++ (eq (caar body) 'DECLARE)) +++ (prog2 () (cdar body) (pop body))))) +++ (cond (index (setq index (ncons `(,INDEX 0 (1+ ,INDEX)) )) +++ (push `(FIXNUM ,INDEX) decls))) +++ (and decls (setq decls (ncons `(DECLARE ,.decls)))) +++ `(DO ((,DUMMY ,FORM (CDR ,DUMMY)) (,VAR) ,.index ) +++ ((NULL ,DUMMY)) +++ ,@decls +++ (SETQ ,VAR (CAR ,DUMMY)) ,.BODY)) +++ +++;Repeat a number of times. evaluates to the number of times, +++;and is executed with bound to 0, 1, ... +++;Don't generate dummy variable if is an integer. We could also do this +++;if were a symbol, but the symbol may get clobbered inside the body, +++;so the behavior of the macro would change. +++ +++(DEFMACRO DOTIMES (SPEC &REST BODY) +++ (LET (VAR COUNT DUMMY DECLS) +++ (SETQ DECLS `(DECLARE +++ (FIXNUM ,var ) ;LOOP VARIABLE TO BE FILLED IN HERE +++ ,.(cond ((and body +++ (not (atom (car body))) +++ (eq (caar body) 'DECLARE)) +++ (prog2 () (cdar body) (pop body)))))) +++ (COND ((ATOM SPEC) (SETQ VAR (GENSYM) COUNT SPEC)) +++ ('T (DESETQ (VAR COUNT) SPEC) +++ (COND ((NULL VAR) (SETQ VAR (GENSYM)))) +++ (COND ((NOT (FIXP COUNT)) +++ (SETQ DUMMY `((,(gensym) ,count)) +++ COUNT (CAAR DUMMY)))))) +++ (SETF (CADADR DECLS) VAR) +++ `(DO ((,var 0 (1+ ,var)) ,.dummy) +++ ((NOT (< ,var ,count))) +++ ,decls +++ ,.body))) +++ +++ +++;; The following is NOT courtesy AI: LISPM2; LMMAC 118 +++;; Theirs is buggy! +++;; PSETQ looks like SETQ but does its work in parallel. +++(DEFMACRO PSETQ (&REST REST) +++ (COND ((CDDR REST) +++ `(SETQ ,(CAR REST) +++ (PROG1 ,(CADR REST) (PSETQ . ,(CDDR REST))))) +++ ;; The last pair. Keep it simple; no superfluous +++ ;; (PROG1 (SETQ...) (PSETQ)). +++ ((CDR REST) `(SETQ . ,REST)) +++ (T (error '|Odd number of args to PSETQ| rest 'wrng-no-args)))) +++ +++ +++(defmacro if-for-maclisp-else-lispm (&rest ll) (car ll)) +++ +++(PROGN 'COMPILE +++ (DEFMACRO LOGAND (&REST FORMS) `(BOOLE 1 . ,FORMS)) +++ (DEFMACRO LOGIOR (&REST FORMS) `(BOOLE 7 . ,FORMS)) +++ (DEFMACRO LOGXOR (&REST FORMS) `(BOOLE 6 . ,FORMS)) +++ ) +++ +++(DEFMACRO DEFVAR (VARIABLE &OPTIONAL (INITIAL-VALUE NIL IV-P) DOCUMENTATION) +++ DOCUMENTATION ;; Ignored for now. +++ (IF IV-P `(PROGN 'COMPILE +++ (DECLARE (SPECIAL ,VARIABLE)) +++ (OR (BOUNDP ',VARIABLE) (SETQ ,VARIABLE ,INITIAL-VALUE))) +++ `(DECLARE (SPECIAL ,VARIABLE)))) +++ +++(DEFMACRO PSETQ (VAR VALUE . REST) +++ (COND (REST `(SETQ ,VAR (PROG1 ,VALUE (PSETQ . ,REST)))) +++ (T `(SETQ ,VAR ,VALUE)))) +++ +++ +++;; (DOTIMES (I N) BODY) evaluates BODY N times, with I bound to 0, 1, ..., N-1. +++;; (DOLIST (X L) BODY) successively binds X to the elements of L, and evaluates +++;; BODY each time. +++ +++;; Things to beware of: +++;; [1] This won't work for COUNT being a bignum. +++;; [2] If COUNT is a symbol, somebody could clobber its value inside the body. +++;; [3] Somebody inside of BODY could reference **COUNT**. +++ +++(DEFMACRO DOTIMES ((VAR COUNT) . BODY) +++ (IF (OR (FIXP COUNT) (SYMBOLP COUNT)) +++ `(DO ((,VAR 0 (1+ ,VAR))) +++ ((>= ,VAR ,COUNT)) +++ (DECLARE (FIXNUM ,VAR)) +++ . ,BODY) +++ `(DO ((,VAR 0 (1+ ,VAR)) +++ (**COUNT** ,COUNT)) +++ ((>= ,VAR **COUNT**)) +++ (DECLARE (FIXNUM ,VAR **COUNT**)) +++ . ,BODY))) +++ +++(DEFMACRO DOLIST ((VAR LIST) . BODY) +++ `(DO ((**LIST** ,LIST (CDR **LIST**)) +++ (,VAR)) +++ ((NULL **LIST**)) +++ (SETQ ,VAR (CAR **LIST**)) +++ . ,BODY)) +++ +++;; CASE is apparently missing from ITS MacLisp. +++;; (DEFMACRO SELECT (KEY . FORMS) +++;; (SETQ FORMS +++;; (MAPCAR #'(LAMBDA (FORM) (IF (EQ (CAR FORM) 'OTHERWISE) +++;; (CONS T (CDR FORM)) FORM)) +++;; FORMS)) +++;; `(CASE ,KEY . ,FORMS)) +++ +++(DEFMACRO SELECTQ (KEY . FORMS) +++ (SETQ FORMS +++ (MAPCAR '(LAMBDA (FORM) (IF (EQ (CAR FORM) 'OTHERWISE) +++ (CONS T (CDR FORM)) FORM)) +++ FORMS)) +++ `(CASEQ ,KEY . ,FORMS)) +++ diff --cc usr/lib/lisp/mystify.l index 0000000000,0000000000,0000000000..8e99939437 new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/mystify.l @@@@ -1,0 -1,0 -1,0 +1,13 @@@@ +++(setq SCCS-mystify "@(#)mystify.l 1.1 10/2/80") +++(setsyntax '\; 'splicing 'zapline) +++; +++; listify takes a bignum and turns it into a list of fixnums +++; mystify is its inverse function +++ +++(def mystify +++ (lambda (x) (cond (x (scons (car x) (mystify (cdr x)))) +++ (t nil] +++ +++(def listify +++ (lambda (x) (cond (x (cons (car x) (listify (cdr x)))) +++ (t nil] diff --cc usr/lib/lisp/step.l index 0000000000,0000000000,0000000000..137b048383 new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/step.l @@@@ -1,0 -1,0 -1,0 +1,158 @@@@ +++(setq SCCS-step "@(#)step.l 1.2 10/22/80") +++ +++(dv stepfns (trim $prin1 evalhook* step print* |7bit| skip st sn)) +++ +++(def trim +++ (lambda (arg depth length) +++ (cond ((not (dtpr arg)) arg) +++ ((zerop depth) '&) +++ ((zerop length) '()) +++ (t +++ (cons (trim (car arg) (sub1 depth) length) +++ (trim (cdr arg) depth (sub1 length))))))) +++ +++(def $prin1 +++ (lambda (arg) +++ (print (trim arg (cond (prinlevel) (t -1)) (cond (prinlength) (t -1)))))) +++ +++(def evalhook* +++ (lambda (form) +++ (cond (evalhook* (and (not (atom form)) +++ (not (eq evalhook* t)) +++ (memq (car form) evalhook*) +++ (setq evalhook* t)) +++ (cond ((eq evalhook* t) +++ (and (= evalhook\# 0) (drain piport)) +++ (print*) +++ (cond ((atom form) +++ (cond ((not +++ (or (numberp form) +++ (null form) +++ (eq form t))) +++ (princ '" = ") +++ ((lambda (prinlevel prinlength) +++ (setq form +++ (evalhook form nil)) +++ ($prin1 form)) +++ 3 +++ 5)) +++ (t)) +++ (terpri)) +++ (t +++ (prog (cmd hookfn) +++ cmdlp(setq cmd (tyi piport)) +++ (cond ((eq cmd 10) +++ (cond +++; <<<<< start back on the left <<<<< +++ (nil (and (not (atom form)) +++ (eq (car +++ (getl (car form) +++ '(expr fexpr lexpr subr fsubr lsubr macro))) +++ 'macro)) +++ (setq form (funcall (get (car form) 'macro) form)) +++ (print*) +++ (go cmdlp)) +++; >>>>> continue on the right >>>>> +++ +++ (t +++ (setq hookfn +++ 'evalhook*)))) +++ ((memq cmd '(83 115)) +++ (drain piport) +++ (setq evalhook +++ 'skip)) +++ ((memq cmd '(80 112)) +++ (drain piport) +++ (print form) +++ (go cmdlp)) +++ ((memq cmd '(71 103)) +++ (drain piport) +++ (setq evalhook* +++ nil +++ hookfn +++ nil)) +++ ((memq cmd '(67 99)) +++ (drain piport) +++ (setq hookfn nil)) +++ ((memq cmd '(68 100)) +++ (setq evalhook-switch nil) +++ (sstatus evalhook nil) +++ (debug) +++ (setq evalhook-switch t) +++ (sstatus evalhook t) +++ (go cmdlp)) +++ ((memq cmd '(77 109)) +++ (drain piport) +++ (setq hookfn +++ 'evalhook*)) +++ ((memq cmd '(66 98)) +++ (drain piport) +++ (break step) +++ (print*) +++ (go cmdlp)) +++ ((memq cmd '(81 113)) +++ (step nil) +++ (reset)) +++ ((memq cmd +++ '(72 104 63)) +++ (ty |/usr/lisp/doc/step.ref|) +++ (drain piport) +++ (go cmdlp)) +++ (t (princ +++ '"Try one of ?BCDGMPQ or ") +++ (drain piport) +++ (go cmdlp))) +++ ((lambda (evalhook\#) +++ (setq form +++ (evalhook form +++ hookfn))) +++ (|1+| evalhook\#)) +++ (cond +++ ((and evalhook* +++ (not (zerop evalhook\#))) +++ (print*) +++ (terpri)))))) +++ form) +++ (t (evalhook form 'evalhook*)))) +++ (t (evalhook form 'evalhook*))))) +++ +++(dv evalhook* nil) +++ +++(def step +++ (nlambda (arg) +++ (cond ((or (null arg) (car arg)) +++ (*rset t) +++ (setq evalhook-switch t) +++ (setq evalhook\# 0) +++ (setq evalhook nil) +++ (setq evalhook* (cond ((null arg) nil) ((eq (car arg) t)) (arg))) +++ (setq evalhook 'evalhook*) +++ (sstatus evalhook t)) +++ (t (setq evalhook* nil) +++ (setq evalhook nil) +++ (setq evalhook-switch nil) +++ (sstatus evalhook nil))))) +++ +++(def print* +++ (macro (s) +++ '(do ((i 1 (|1+| i)) (indent (* 2 evalhook\#)) (prinlevel 3) (prinlength 5)) +++ ((> i indent) ($prin1 form)) +++ (tyo 32)))) +++ +++(def 7bit +++ (macro (s) +++ (list '= (list 'boole 1 127 (cadr s)) (caddr s)))) +++ +++(def skip +++ (lambda (x) +++ nil)) +++ +++(def st +++ (lambda nil +++ (step t))) +++ +++(def sn +++ (lambda nil +++ (step nil))) +++ +++ diff --cc usr/lib/lisp/toplevel.l index 0000000000,0000000000,0000000000..6b5d3be66d new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/toplevel.l @@@@ -1,0 -1,0 -1,0 +1,309 @@@@ +++(setq SCCS-toplevel "@(#)toplevel.l 1.2 10/29/80") +++ +++; special atoms: +++(declare (special debug-level-count break-level-count +++ errlist tpl-errlist user-top-level +++ franz-not-virgin piport ER%tpl ER%all +++ top-level-eof * ** *** + ++ +++ ^w) +++ (macros t)) +++ +++(setq top-level-eof (gensym 'Q) +++ tpl-errlist nil +++ errlist nil +++ user-top-level nil ) +++ +++;------------------------------------------------------ +++; Top level function for franz jkf, march 1980 +++; +++; The following function contains the top-level read, eval, print +++; loop. With the help of the error handling functions, +++; break-err-handler and debug-err-handler, franz-top-level provides +++; a reasonable enviroment for working with franz lisp. +++; +++ +++(def franz-top-level +++ (lambda nil +++ (cond ((or (not (boundp 'franz-not-virgin)) +++ (null franz-not-virgin)) +++ (patom (status version)) +++ (setq franz-not-virgin t +++ + nil ++ nil +++ nil +++ * nil ** nil *** nil) +++ (setq ER%tpl 'break-err-handler) +++ (putd 'reset (getd 'franz-reset)) +++ (terpr) +++ (read-in-lisprc-file))) +++ +++ ; loop forever +++ (do ((+*) (-) (retval)) +++ (nil) +++ (setq retval +++ (*catch +++ '(top-level-catch break-catch) +++ ; begin or return to top level +++ (progn +++ (setq debug-level-count 0 break-level-count 0) +++ (cond (tpl-errlist (mapc 'eval tpl-errlist))) +++ (do ((^w nil nil)) +++ (nil) +++ (cond (user-top-level (funcall user-top-level)) +++ (t (patom "-> ") +++ (cond ((eq top-level-eof +++ (setq - +++ (car (errset (read nil +++ top-level-eof))))) +++ (cond ((not (status isatty)) +++ (exit))) +++ (cond ((null (status ignoreeof)) +++ (terpr) +++ (print 'Goodbye) +++ (terpr) +++ (exit)) +++ (t (terpr) +++ (setq - ''EOF))))) +++ (setq +* (eval -)) +++ (updateplusses -) +++ (updatestars +*) +++ (print +*) +++ (terpr))))))) +++ (terpr) +++ (patom "[Return to top level]") +++ (terpr) +++ (cond ((eq 'reset retval) (old-reset-function)))))) +++ +++(def updateplusses +++ (lambda (val) +++ (let ((o+ +) (o++ ++)) +++ (setq + val +++ ++ o+ +++ +++ o++)))) +++ +++(def updatestars +++ (lambda (val) +++ (let ((o* *) (o** **)) +++ (setq * val +++ ** o* +++ *** o**)))) +++ +++ +++ +++ +++; debug-err-handler is the clb of ER%all when we are doing debugging +++; and we want to catch all errors. +++; It is just a read eval print loop with errset. +++; the only way to leave is: +++; (reset) just back to top level +++; (return x) return the value to the error checker. +++; if nil is returned then we will continue as if the error +++; didn't occur. Otherwise if the returned value is a list, +++; then if the error is continuable, the car of that list +++; will be returned to recontinue computation. +++; ^D continue as if this handler wasn't called. +++; the form of errmsgs is: +++; (error_type unique_id continuable message_string other_args ...) +++; +++(def debug-err-handler +++ (lexpr (n) +++ ((lambda (message debug-level-count retval ^w) +++ (cond ((greaterp n 0) +++ (print 'Error:) +++ (mapc '(lambda (a) (patom " ") (patom a) ) +++ (cdddr (arg 1))) +++ (terpr))) +++ (setq ER%all 'debug-err-handler) +++ (do (retval) (nil) +++ (cond ((dtpr +++ (setq retval +++ (errset +++ (do ((form)) (nil) +++ (patom "D<") +++ (patom debug-level-count) +++ (patom ">: ") +++ (cond ((eq top-level-eof +++ (setq form +++ (read nil top-level-eof))) +++ (cond ((null (status isatty)) +++ (exit))) +++ (return nil)) +++ ((and (dtpr form) +++ (eq 'return (car form))) +++ (return (eval (cadr form)))) +++ (t (print (eval form)) +++ (terpr))))))) +++ (return (car retval)))))) +++ nil +++ (add1 debug-level-count) +++ nil +++ nil))) +++ +++; this is the break handler, it should be tied to +++; ER%tpl always. +++; it is entered if there is an error which no one wants to handle. +++; We loop forever, printing out our error level until someone +++; types a ^D which goes to the next break level above us (or the +++; top-level if there are no break levels above us. +++; a (return n) will return that value to the error message +++; which called us, if that is possible (that is if the error is +++; continuable) +++; +++(def break-err-handler +++ (lexpr (n) +++ ((lambda (message break-level-count retval rettype ^w) +++ (setq piport nil) +++ (cond ((greaterp n 0) +++ (print 'Error:) +++ (mapc '(lambda (a) (patom " ") (patom a) ) +++ (cdddr (arg 1))) +++ (terpr) +++ (cond ((caddr (arg 1)) (setq rettype 'contuab)) +++ (t (setq rettype nil)))) +++ (t (setq rettype 'localcall))) +++ +++ (do nil (nil) +++ (cond ((dtpr +++ (setq retval +++ (*catch 'break-catch +++ (do ((form)) (nil) +++ (patom "<") +++ (patom break-level-count) +++ (patom ">: ") +++ (cond ((eq top-level-eof +++ (setq form (read nil top-level-eof))) +++ (cond ((null (status isatty)) +++ (exit))) +++ (eval 1) ; force interrupt check +++ (return (sub1 break-level-count))) +++ ((and (dtpr form) (eq 'return (car form))) +++ (cond ((or (eq rettype 'contuab) +++ (eq rettype 'localcall)) +++ (return (ncons (eval (cadr form))))) +++ (t (patom "Can't continue from this error") +++ (terpr)))) +++ ((and (dtpr form) (eq 'retbrk (car form))) +++ (cond ((numberp (setq form (eval (cadr form)))) +++ (return form)) +++ (t (return (sub1 break-level-count))))) +++ (t (print (eval form)) +++ (terpr))))))) +++ (return (cond ((eq rettype 'localcall) +++ (car retval)) +++ (t retval)))) +++ ((lessp retval break-level-count) +++ (setq tpl-errlist errlist) +++ (*throw 'break-catch retval)) +++ (t (terpr))))) +++ nil +++ (add1 break-level-count) +++ nil +++ nil +++ nil))) +++ +++(def debugging +++ (lambda (val) +++ (cond (val (setq ER%all 'debug-err-handler)) +++ (t (setq ER%all nil))))) +++ +++ +++; the problem with this definition for break is that we are +++; forced to put an errset around the break-err-handler. This means +++; that we will never get break errors, since all errors will be +++; caught by our errset (better ours than one higher up though). +++; perhaps the solution is to automatically turn debugmode on. +++; +++(defmacro break (message &optional (pred t)) +++ `(*break ,pred ',message)) +++ +++(def *break +++ (lambda (pred message) +++ (let ((^w nil)) +++ (cond ((not (boundp 'break-level-count)) (setq break-level-count 1))) +++ (cond (pred (terpr) +++ (patom "Break ") +++ (patom message) +++ (terpr) +++ (do ((form)) +++ (nil) +++ (cond ((dtpr (setq form (errset (break-err-handler)))) +++ (return (car form)))))))))) +++ +++ +++; this reset function is designed to work with the franz-top-level. +++; When franz-top-level begins, it makes franz-reset be reset. +++; when a reset occurs now, we set the global variable tpl-errlist to +++; the current value of errlist and throw to top level. At top level, +++; then tpl-errlist will be evaluated. +++; +++(def franz-reset +++ (lambda nil +++ (setq tpl-errlist errlist) +++ (errset (*throw 'top-level-catch 'reset) +++ nil) +++ (old-reset-function))) +++ +++ +++; this definition will have to do until we have the ability to +++; cause and error on any channel in franz +++(def error +++ (lexpr (n) +++ (cond ((greaterp n 0) +++ (patom (arg 1)) +++ +++ (cond ((greaterp n 1) +++ (patom " ") +++ (patom (arg 2)))) +++ (terpr))) +++ (err))) +++ +++ +++; this file is read in just before dumplisping if you want .lisprc +++; from your home directory read in before the lisp begins. +++(def read-in-lisprc-file +++ (lambda nil +++ ((lambda (hom prt) +++ (setq break-level-count 0 ; do this in case break +++ debug-level-count 0) ; occurs during readin +++ (*catch '(break-catch top-level-catch) +++ (cond (hom +++ (cond ((and +++ (errset +++ (progn +++ (setq prt (infile (concat hom '"/.lisprc"))) +++ (close prt)) +++ nil) +++ (null (errset +++ (load (concat hom '"/.lisprc"))))) +++ (patom '"Error in .lisprc file detected") +++ (terpr))))))) +++ (getenv 'HOME) nil))) +++ +++(putd 'top-level (getd 'franz-top-level)) +++ +++; if this is the first time this file has been read in, then +++; make franz-reset be the reset function, but remember the original +++; reset function as old-reset-function. We need the old reset function +++; if we are going to allow the user to change top-levels, for in +++; order to do that we really have to jump all the way up to the top. +++(cond ((null (getd 'old-reset-function)) +++ (putd 'old-reset-function (getd 'reset)))) +++ +++ +++;---- autoloader functions +++ +++(def undef-func-handler +++ (lambda (args) +++ (prog (funcnam file) +++ (setq funcnam (caddddr args)) +++ (cond ((symbolp funcnam) +++ (cond ((setq file (get funcnam 'autoload)) +++ (patom "[autoload ") (patom file)(patom "]")(terpr) +++ (load file)) +++ (t (return nil))) +++ (cond ((getd funcnam) (return (ncons funcnam))) +++ (t (patom "Autoload file does not contain func ") +++ (return nil)))))))) +++ +++(setq ER%undef 'undef-func-handler) +++ +++;-- default autoloader properties +++ +++(putprop 'trace '/usr/lib/lisp/trace 'autoload) diff --cc usr/lib/lisp/trace.l index 0000000000,0000000000,0000000000..82b7928a3a new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/trace.l @@@@ -1,0 -1,0 -1,0 +1,396 @@@@ +++(setq SCCS-trace "@(#)trace.l 1.5 11/7/80") +++ +++;---- The Joseph Lister Trace Package, v1 +++; John Foderaro, Sept 1979 +++;------------------------------------------------------------------; +++; Copyright (c) 1979 The Regents of the University of California ; +++; All rights reserved. ; +++;------------------------------------------------------------------; +++(eval-when (eval) +++ (setq old-read-table-trace readtable) +++ (setq readtable (makereadtable t)) +++ (setq old-uctolc-value (status uctolc)) +++ (sstatus uctolc nil) ; turn off case conversion +++ (load 'backquote) +++ ) +++ +++(declare (nlambda T-status T-sstatus) +++ (special piport +++ if ifnot evalin evalout +++ printargs printres evfcn +++ traceenter traceexit +++ prinlevel prinlength +++ $$functions-in-trace$$ ; active functions +++ $$funcargs-in-trace$$ ; arguments to active functions. +++ )) +++ +++ +++(cond ((null (boundp '$$traced-functions$$)) (setq $$traced-functions$$ nil))) +++(cond ((null (boundp '$$functions-in-trace$$)) (setq $$functions-in-trace$$ nil))) +++(cond ((null (boundp '$$funcargs-in-trace$$)) (setq $$funcargs-in-trace$$ nil))) +++ +++;----> It is important that the trace package not use traced functions +++; thus we give the functions the trace package uses different +++; names and make them equivalent at this time to their +++; traceable counterparts. +++ +++(do ((i '( (add1 T-add1)(append T-append) +++ (and T-and) (apply T-apply) +++ (cond T-cond) (cons T-cons) (delq T-delq) +++ (def T-def) (do T-do) (drain T-drain) +++ (dtpr T-dtpr) (eval T-eval)(funcall T-funcall) +++ (get T-get) (getd T-getd)(getdisc T-getdisc) +++ (greaterp T-greaterp)(lessp T-lessp) +++ (mapc T-mapc) (not T-not) +++ (patom T-patom) (print T-print) (prog T-prog) +++ (patom T-patom)(putd T-putd) +++ (putprop T-putprop) +++ (read T-read)(remprop T-remprop) (reverse T-reverse) +++ (return T-return) +++ (set T-set) (setq T-setq) +++ (status T-status) (sstatus T-sstatus) +++ (sub1 T-sub1) (terpr T-terpr) +++ (zerop T-zerop)) +++ (cdr i))) +++ ((null i)) +++ (putd (cadar i) (getd (caar i))) +++ (putprop (cadar i) t 'Untraceable)) +++ +++(putprop 'quote t 'Untraceable) ; this prevents the common error +++ ; of (trace 'foo) from causing big +++ ; problems. +++ +++;--- trace - arg1,arg2, ... names of functions to trace +++; This is the main user callable trace routine. +++; work in progress, documentation incomplete since im not sure exactly +++; where this is going. +++; +++(def trace +++ (nlambda (argl) +++ (prog (if ifnot evalin evalout funnm +++ funcd did break printargs printres evfcn traceenter traceexit) +++ +++ ; turn off transfer table linkages if they are on +++ (cond ((T-status translink) (T-sstatus translink nil))) +++ +++ ; process each argument +++ +++ (do ((ll argl (cdr ll)) +++ (funnm) +++ (funcd)) +++ ((null ll)) +++ (setq funnm (car ll) +++ if t +++ break nil +++ ifnot nil +++ evalin nil +++ evalout nil +++ printargs nil +++ printres nil +++ evfcn nil +++ traceenter 'T-traceenter +++ traceexit 'T-traceexit) +++ +++ ; a list as an argument means that the user is specifying +++ ; conditions on the trace +++ (cond ((not (atom funnm)) +++ (cond ((not (atom (setq funnm (car funnm)))) +++ (T-print (car funnm)) +++ (T-patom '" is non an function name") +++ (go botloop))) +++ (do ((rr (cdar ll) (cdr rr))) +++ ((null rr)) +++ (cond ((memq (car rr) '(if ifnot evalin evalout +++ printargs printres evfcn +++ traceenter traceexit)) +++ (T-set (car rr) (cadr rr)) +++ (setq rr (cdr rr))) +++ ((eq (car rr) 'evalinout) +++ (setq evalin (setq evalout (cadr rr)) +++ rr (cdr rr))) +++ ((eq (car rr) 'break) +++ (setq break t)) +++ ((eq (car rr) 'lprint) +++ (setq printargs 'T-levprint +++ printres 'T-levprint)) +++ (t (T-patom '"bad request: ") +++ (T-print (car rr)) +++ (T-terpr)))))) +++ +++ ; if function is untraceable, print error message and skip +++ (cond ((get funnm 'Untraceable) +++ (setq did (cons `(,funnm untraceable) did)) +++ (go botloop))) +++ +++ +++ ; if function is already traced, untrace it first +++ (cond ((get funnm 'original) +++ (apply 'untrace `(,funnm)) +++ (setq did (cons `(,funnm untraced) did)))) +++ +++ ; store the names of the arg printing routines if they are +++ ; different than print +++ +++ (cond (printargs (T-putprop funnm printargs 'trace-printargs))) +++ (cond (printres (T-putprop funnm printres 'trace-printres))) +++ +++ ; we must determine the type of function being traced +++ ; in order to create the correct replacement function +++ +++ (cond ((setq funcd (T-getd funnm)) +++ (cond ((bcdp funcd) ; machine code +++ (cond ((or (eq 'lambda (T-getdisc funcd)) +++ (eq 'nlambda (T-getdisc funcd)) +++ (eq 'macro (T-getdisc funcd))) +++ (setq typ (T-getdisc funcd))) +++ ((stringp (T-getdisc funcd)) ; foreign func +++ (setq typ 'lambda)) ; close enough +++ (t (T-patom '"Unknown type of compiled function") +++ (T-print funnm) +++ (setq typ nil)))) +++ +++ ((dtpr funcd) ; lisp coded +++ (cond ((or (eq 'lambda (car funcd)) +++ (eq 'lexpr (car funcd))) +++ (setq typ 'lambda)) +++ ((or (eq 'nlambda (car funcd)) +++ (eq 'macro (car funcd))) +++ (setq typ (car funcd))) +++ (t (T-patom '"Bad function definition: ") +++ (T-print funnm) +++ (setq typ nil)))) +++ ((arrayp funcd) ; array +++ (setq typ 'lambda)) +++ (t (T-patom '"Bad function defintion: ") +++ (T-print funnm))) +++ +++ ; now that the arguments have been examined for this +++ ; function, do the tracing stuff. +++ ; First save the old function on the property list +++ +++ (T-putprop funnm funcd 'original) +++ +++ ; now build a replacement +++ +++ (cond ((eq typ 'lambda) +++ (T-eval +++ `(T-def ,funnm +++ (lexpr (T-nargs) +++ ((lambda (T-arglst T-res T-rslt +++ $$functions-in-trace$$ +++ $$funcargs-in-trace$$) +++ (T-do ((i T-nargs (T-sub1 i))) +++ ((T-zerop i)) +++ (T-setq T-arglst +++ (T-cons (arg i) T-arglst))) +++ (T-setq $$funcargs-in-trace$$ +++ (T-cons T-arglst +++ $$funcargs-in-trace$$)) +++ (T-cond ((T-setq T-res +++ (T-and ,if +++ (T-not ,ifnot))) +++ (,traceenter ',funnm T-arglst) +++ ,evalin +++ (T-cond (,break (trace-break))))) +++ (T-setq T-rslt +++ ,(cond +++ (evfcn) +++ (t `(T-apply ',funcd T-arglst)))) +++ (T-cond (T-res +++ ,evalout +++ (,traceexit ',funnm T-rslt))) +++ T-rslt) +++ nil nil nil +++ (cons ',funnm $$functions-in-trace$$) +++ $$funcargs-in-trace$$)))) +++ (setq did (cons funnm did) +++ $$traced-functions$$ (cons funnm +++ $$traced-functions$$))) +++ +++ ((or (eq typ 'nlambda) +++ (eq typ 'macro)) +++ (T-eval +++ `(T-def ,funnm +++ (,typ (T-arglst) +++ ((lambda (T-res T-rslt $$functions-in-trace$$ +++ $$funcargs-in-trace$$) +++ (T-setq $$funcargs-in-trace$$ +++ (T-cons T-arglst +++ $$funcargs-in-trace$$)) +++ (T-cond ((T-setq T-res +++ (T-and ,if +++ (not ,ifnot))) +++ (,traceenter ',funnm T-arglst) +++ ,evalin +++ (T-cond (,break (trace-break))))) +++ (T-setq T-rslt +++ ,(cond +++ (evfcn `(,evfcn ',funcd T-arglst)) +++ (t `(T-apply ',funcd T-arglst)))) +++ (T-cond (T-res +++ ,evalout +++ (,traceexit ',funnm T-rslt))) +++ T-rslt) +++ nil nil +++ (cons ',funnm $$functions-in-trace$$) +++ $$funcargs-in-trace$$)))) +++ (setq did (cons funnm did) +++ $$traced-functions$$ (cons funnm +++ $$traced-functions$$))) +++ +++ (t (T-patom '"No such function as: ") +++ (T-print funnm) +++ (T-terpr))))) +++ botloop ) +++ (return (nreverse did))))) +++ +++;--- untrace +++; (untrace foo bar baz) +++; untraces foo, bar and baz. +++; (untrace) +++; untraces all functions being traced. +++; +++ +++(def untrace +++ (nlambda (argl) +++ (cond ((null argl) (setq argl $$traced-functions$$))) +++ +++ (do ((i argl (cdr i)) +++ (curf) +++ (res)) +++ ((null i) +++ (cond ((null $$traced-functions$$) +++ (setq $$functions-in-trace$$ nil) +++ (setq $$funcargs-in-trace$$ nil))) +++ res) +++ (cond ((setq tmp (T-get (setq curf (car i)) 'original)) +++ ; we only want to restore the original definition +++ ; if this function has not been redefined! +++ ; we can check if it has been redefined by seeing +++ ; if its current definition is one the trace package +++ ; would generate. +++ (let ((funcdef (T-getd curf))) +++ (cond ((and (dtpr funcdef) +++ (dtpr (cadr funcdef)) +++ (memq (caadr funcdef) +++ '(T-nargs T-arglst))) +++ (T-putd curf tmp)))) +++ (T-remprop curf 'original) +++ (T-remprop curf 'entercount) +++ (setq $$traced-functions$$ +++ (T-delq curf $$traced-functions$$)) +++ (setq res (cons curf res))) +++ (t (setq res (cons `(,curf not traced) res))))))) +++ +++;--- tracedump :: dump the currently active trace frames +++; +++(def tracedump +++ (lambda nil +++ (T-tracedump-recursive $$functions-in-trace$$ $$funcargs-in-trace$$))) +++ +++ +++;--- T-tracedump-recursive +++; since the lists of functions being traced and arguments are in the reverse +++; of the order we want to print them, we recurse down the lists and on the +++; way back we print the information. +++; +++(def T-tracedump-recursive +++ (lambda ($$functions-in-trace$$ $$funcargs-in-trace$$) +++ (cond ((null $$functions-in-trace$$)) +++ (t (T-tracedump-recursive (cdr $$functions-in-trace$$) +++ (cdr $$funcargs-in-trace$$)) +++ (T-traceenter (car $$functions-in-trace$$) +++ (car $$funcargs-in-trace$$)))))) +++ +++ +++ +++;--- T-traceenter - funnm : name of function just entered +++; - count : count to print out +++; This routine is called to print the entry banner for a +++; traced function. +++; +++(def T-traceenter +++ (lambda (name args) +++ (prog (count indent) +++ (setq count 0 indent 0) +++ (do ((ll $$functions-in-trace$$ (cdr ll))) +++ ((null ll)) +++ (cond ((eq (car ll) name) (setq count (1+ count)))) +++ (setq indent (1+ indent))) +++ +++ (T-traceindent indent) +++ (T-print count) +++ (T-patom '" ") +++ (T-print name) +++ (T-patom '" ") +++ (cond ((setq count (T-get name 'trace-printargs)) +++ (T-funcall count args)) +++ (t (T-print args))) +++ (T-terpr)))) +++ +++(def T-traceexit +++ (lambda (name res) +++ (prog (count indent) +++ (setq count 0 indent 0) +++ (do ((ll $$functions-in-trace$$ (cdr ll))) +++ ((null ll)) +++ (cond ((eq (car ll) name) (setq count (1+ count)))) +++ (setq indent (1+ indent))) +++ +++ +++ (T-traceindent indent) +++ (T-print count) +++ (T-patom " ") +++ (T-print name) +++ (T-patom " ") +++ +++ (cond ((setq count (T-get name 'trace-printres)) +++ (T-funcall count res)) +++ (t (T-print res))) +++ +++ (T-terpr)))) +++ +++ +++ +++; T-traceindent +++; - n : indent to column n +++ +++(def T-traceindent +++ (lambda (col) +++ (do ((i col (1- i)) +++ (char '| |)) +++ ((< i 2)) +++ (T-patom (cond ((eq char '| |) (setq char '\|)) +++ (t (setq char '| |))))))) +++ +++ +++ +++; trace-break - this is the trace break loop +++(def trace-break +++ (lambda nil +++ (prog (tracevalread piport) +++ (T-terpr) (T-patom '"[tracebreak]") +++ loop (T-terpr) +++ (T-patom '"T>") +++ (T-drain) +++ (cond ((or (eq ' (setq tracevalread +++ (car +++ (errset (T-read nil '))))) +++ (and (dtpr tracevalread) +++ (eq 'tracereturn (car tracevalread)))) +++ (T-terpr) +++ (return nil))) +++ (T-print (car (errset (T-eval tracevalread)))) +++ (go loop)))) +++ +++(def T-levprint +++ (lambda (x) +++ ((lambda (prinlevel prinlength) +++ (print x)) +++ 3 10))) +++ +++ +++(eval-when (eval) +++ (apply 'sstatus `(uctolc ,old-uctolc-value)) +++ (setq readtable old-read-table-trace) +++ ) diff --cc usr/lib/lisp/ucifnc.l index 0000000000,0000000000,0000000000..e5ffdc2ce9 new file mode 100644 --- /dev/null +++ b/usr/lib/lisp/ucifnc.l @@@@ -1,0 -1,0 -1,0 +1,455 @@@@ +++(setq SCCS-ucifnc "@(#)ucifnc.l 1.2 10/22/80") +++ +++(eval-when (eval compile load) +++ +++ (defun de macro (l) +++ `(eval-when (load eval compile) +++ ,(append (list +++ 'defun (cadr l) (caddr l)) +++ (cdddr l)))) +++ +++ (defun df macro (l) +++ `(eval-when (load eval compile) +++ ,(append (list +++ 'defun (cadr l) 'fexpr (caddr l)) +++ (cdddr l)))) +++ +++ (defun dm macro (l) +++ `(eval-when (load eval compile) +++ ,(append (list +++ 'defun (cadr l) 'macro (caddr l)) +++ (cdddr l)))) +++ +++ +++ (defun let1 (*l* *vars* *vals* *body*) +++ (cond ((null *l*) +++ (cons (cons 'lambda (cons *vars* *body*)) *vals*)) +++ (t +++ (let1 (cddr *l*) +++ (cons (car *l*) *vars*) +++ (cons (cadr *l*) *vals*) *body*)))) +++ +++ (defun let macro (l) +++ (let1 (cadr l) nil nil (cddr l))) +++ +++ (dm nconc1 (l) (list 'nconc (cadr l) (list 'list (caddr l)))) +++ +++ (declare (special vars)) +++ (declare (special *vars*)) +++ (declare (special *l*)) +++ +++ (putd 'expandmacro (getd 'macroexpand)) +++ +++ (def selectq +++ (macro (form) +++ ((lambda (x) +++ `((lambda (,x) +++ (cond +++ ,@(maplist +++ '(lambda (ff) +++ (cond ((null (cdr ff)) +++ `(t ,(car ff))) +++ ((atom (caar ff)) +++ `((eq ,x ',(caar ff)) +++ . ,(cdar ff))) +++ (t +++ `((memq ,x ',(caar ff)) +++ . ,(cdar ff))))) +++ (cddr form)))) +++ ,(cadr form))) +++ (gensym 'Z)))) +++ +++ (dm dsm (l) +++ `(eval-when (compile load eval) +++ ,(list 'setsyntax (list 'quote (cadr l)) +++ (list 'quote 'splicing) +++ (list 'quote (caddr l))))) +++ +++ (dm drm (l) +++ `(eval-when (compile load eval) +++ ,(list 'setsyntax (list 'quote (cadr l)) +++ (list 'quote 'macro) +++ (list 'quote (caddr l))))) +++ +++ (dm := (expression) +++ (let (lft (macroexpand (cadr expression)) rgt (caddr expression)) +++ (cond ((atom lft) (list 'setq lft (subst lft '*-* rgt))) +++ ((get (car lft) 'set-program) +++ (cons (get (car lft) 'set-program) +++ (append (cdr lft) (list (subst lft '*-* rgt)))))))) +++ +++ (declare (special car)) +++ (declare (special cdr)) +++ (declare (special cadr)) +++ (declare (special cddr)) +++ (declare (special caddr)) +++ (declare (special cadddr)) +++ (declare (special get)) +++ +++ (defprop car rplaca set-program) +++ (defprop cdr rplacd set-program) +++ (defprop cadr rplacad set-program) +++ (defprop cddr rplacdd set-program) +++ (defprop caddr rplacadd set-program) +++ (defprop cadddr rplacaddd set-program) +++ (defprop get get-set-program set-program) +++ (de get-set-program (atm prop val) (putprop atm val prop)) +++ (de rplacad (exp1 exp2) (rplaca (cdr exp1) exp2)) +++ (de rplacdd (exp1 exp2) (rplacd (cdr exp1) exp2)) +++ (de rplacadd (exp1 exp2) (rplaca (cddr exp1) exp2)) +++ (de rplacaddd (exp1 exp2) (rplaca (cdddr exp1) exp2)) +++ +++ (declare (special *type*)) +++ +++ (dm record-type (l) +++ (let (*type* (cadr l) *flag* (caddr l) slots (car (last l))) +++ (list 'progn ''compile +++ (list 'de *type* (slot-funs-extract slots (and *flag* '(d))) +++ (cond ((null *flag*) (struc-cons-form slots)) +++ (t (append (list 'cons (list 'quote *flag*)) +++ (list (struc-cons-form slots)))))) +++ (cond (*flag* +++ (cond ((dtpr *flag*) (setq *flag* *type*))) +++ (list 'dm +++ (readlist +++ (cons 'i +++ (cons 's +++ (cons '- +++ (append (explode *type*) nil))))) +++ '(l) +++ (list 'list ''and '(list 'dtpr (cadr l)) +++ (list 'list ''eq '(list 'car (cadr l)) +++ (list 'quote (list 'quote *flag*)))))))))) +++ +++ (de slot-funs-extract (slots path) +++ (cond ((null slots) nil) +++ ((atom slots) +++ (eval (list 'dm (readlist (append (explode slots) +++ (cons ': +++ (append +++ (explode *type*) nil)))) +++ '(l) +++ (cons 'list +++ (cons (list 'quote +++ (readlist +++ (cons 'c (append path '(r))))) +++ '((cadr l)))))) +++ (list slots)) +++ ((nconc (slot-funs-extract (car slots) (cons 'a path)) +++ (slot-funs-extract (cdr slots) (cons 'd path)))))) +++ +++ (de struc-cons-form (struc) +++ (cond ((null struc) nil) +++ ((atom struc) struc) +++ ((list 'cons +++ (struc-cons-form (car struc)) +++ (struc-cons-form (cdr struc)))))) +++ +++ (dm for (*l*) +++ (let (vars (vars:for *l*) +++ args (args:for *l*) +++ test (test:for *l*) +++ type (type:for *l*) +++ body (body:for *l*)) +++ (cons (make-mapfn vars test type body) +++ (cons (list 'quote +++ (make-lambda +++ vars (add-test test +++ (make-body vars test type body)))) +++ args)))) +++ +++ (de type:for (*l*) +++ (let (item (item:for '(do save splice filter) *l*)) +++ (cond (item (car item)) +++ ((error '"No body in for loop"))))) +++ +++ (de error (l x) +++ (cond (x (terpri) (patom l) (terpri) (drain) (break) l) +++ (t l))) +++ +++ (de vars:for (*m*) +++ (mapcan '(lambda (x) (cond ((is-var-form x) (list (var:var-form x))))) *m*)) +++ +++ (de args:for (*n*) +++ (mapcan '(lambda (x) (cond ((is-var-form x) (list (args:var-form x))))) *n*)) +++ (de is-var-form (x) (and (eq (length x) 3) (eq (cadr x) 'in))) +++ +++ (de var:var-form (x) (car x)) +++ (de args:var-form (x) (caddr x)) +++ +++ (de test:for (*o*) +++ (let (item (item:for '(when) *o*)) +++ (cond (item (cadr item))))) +++ +++ (de body:for (*p*) +++ (let (item (item:for '(do save splice filter) *p*)) +++ (cond ((not item) (error '"NO body in for loop")) +++ ((eq (length (cdr item)) 1) (cadr item)) +++ ((cons 'progn (cdr item)))))) +++ +++ (declare (special *l*)) +++ (declare (special keywords)) +++ (declare (special item)) +++ +++ (de item:for (keywords *l*) +++ (let (item nil) +++ (some '(lambda (key) (setq item (assoc key (cdr *l*)))) +++ keywords) +++ item)) +++ +++ (de make-mapfn (vars test type body) +++ (cond ((equal type 'do) 'mapc) +++ ((not (equal type 'save)) 'mapcan) +++ ((null test) 'mapcar) +++ ((subset-test vars body) 'subset) +++ ('mapcan))) +++ +++ (de subset-test (vars body) +++ (and (equal (length vars) 1) (equal (car vars) body))) +++ +++ (de make-body (vars test type body) +++ (cond ((equal type 'filter) +++ (list 'let (list 'x body) '(cond (x (list x))))) +++ ((or (not (equal type 'save)) (null test)) body) +++ ((subset-test vars body) nil) +++ ((list 'list body)))) +++ +++ (de add-test (test body) +++ (cond ((null test) body) +++ ((null body) test) +++ (t (list 'cond (cond ((eq (car body) 'progn) (cons test (cdr body))) +++ ((list test body))))))) +++ +++ (de make-lambda (var body) +++ (cond ((equal var (cdr body)) (car body)) +++ ((eq (car body) 'progn) (cons 'lambda (cons vars (cdr body)))) +++ ((list 'lambda vars body)))) +++ +++ (dm pop (*q*) +++ (list 'prog '(*q*) +++ (list 'setq '*q* (list 'car (cadr *q*))) +++ (list 'setq (cadr *q*) (list 'cdr (cadr *q*))) +++ '(return *q*))) +++ +++ (de length (*u*) +++ (cond ((null *u*) 0) +++ ((atom *u*) 0) +++ ((add1 (length (cdr *u*)))))) +++ +++ (declare (special $f)) +++ (declare (special $l)) +++ +++ (de some ($f $l) +++ (cond ((null $l) nil) +++ ((funcall $f (car $l)) +++ $l) +++ ((some $f (cdr $l))))) +++ +++ (declare (special l)) +++ +++ (dm every (l) +++ (list 'prog '($$k) +++ (list 'setq '$$k (cons 'list (cddr l))) +++ 'loop +++ (append (list 'and +++ (list 'apply (cadr l) '(mapcar (quote car) $$k))) +++ '((setq $$k (mapcar (quote cdr) $$k)) +++ (cond ((memq nil $$k) (setq $$k nil)) +++ (t)) +++ (go loop))) +++ '(or $$k (return t)))) +++ +++ (df timer (request) +++ (prog (timein timeout result cpu garbage) +++ (setq timein (ptime)) +++ (prog () +++ loop (setq result (eval (car request))) +++ (setq request (cdr request)) +++ (cond ((null request) (return result)) +++ ((go loop)))) +++ (setq timeout (ptime)) +++ (setq cpu (/ (- (car timeout) (car timein)) 60.0)) +++ (setq cpu (/ (float (fix (* 1000.0 cpu))) 1000.0)) +++ (setq garbage (/ (- (cadr timeout) (cadr timein)) 60.0)) +++ (setq garbage (/ (float (fix (* 1000.0 garbage))) 1000.0)) +++ (terpri) +++ ($prpr (cons cpu garbage)) +++ (terpri) +++ (return result))) +++ +++ (de addprop (id value prop) +++ (putprop id (enter value (get id prop)) prop)) +++ +++ (de enter (v l) +++ (cond ((member v l) l) +++ (t (cons v l)))) +++ +++ (declare (special fun)) +++ (declare (special lis)) +++ +++ (defmacro subset (fun lis) +++ `(mapcan '(lambda (ele) +++ (cond ((funcall ,fun ele) (ncons ele)))) +++ ,lis)) +++ +++ (dm push (varval) +++ (list 'setq (caddr varval) (list 'cons (cadr varval) (caddr varval)))) +++ +++ (putd 'consp (getd 'dtpr)) +++ +++ (de prelist (a b) +++ (cond ((null a) nil) +++ ((eq b 0 ) nil) +++ ((cons (car a) (prelist (cdr a) (sub1 b)))))) +++ +++ (de suflist (a b) +++ (cond ((null a) nil) +++ ((eq b 0) a) +++ ((suflist (cdr a) (sub1 b))))) +++ +++ (declare (special **l$)) +++ +++ (defun loop macro (**l$) +++ (append (list 'prog (var-list (get-keyword 'initial **l$))) +++ (subset (function caddr) (setq-steps (get-keyword 'initial **l$))) +++ '(loop) +++ (apply (function append) (mapcar (function do-clause) (cdr **l$))) +++ (list '(go loop) +++ 'exit (cons 'return (get-keyword 'result **l$))))) +++ +++ (defun do-clause (clause) +++ (cond ((memq (car clause) '(initial result)) nil) +++ ((eq (car clause) 'while) +++ (list (list 'or (cadr clause) '(go exit)))) +++ ((eq (car clause) 'do) (cdr clause)) +++ ((eq (car clause) 'next) (setq-steps (cdr clause))) +++ ((eq (car clause) 'until) +++ (list (list 'and (cadr clause) '(go exit)))) +++ (t (terpri) (patom '"unknown keyword clause")))) +++ +++ +++ (defun get-keyword (key l) +++ (cdr (assoc key (cdr l)))) +++ +++ (defun var-list (*r*) +++ (and *r* (cons (car *r*) (var-list (cddr *r*))))) +++ +++ (defun setq-steps (*s*) +++ (and *s* (cons (list 'setq (car *s*) (cadr *s*)) +++ (setq-steps (cddr *s*))))) +++ +++ (defun gtblk macro (p) +++ `(*array nil t (cadr p))) +++ ; here comes syntax changes to ucilisp +++ ; +++ ; upper case to lower case +++ (putd 'readch (getd 'readc)) +++ +++ (declare (macros t)) +++ +++ (defmacro msg ( &rest body) +++ `(progn ,@(mapcar '(lambda (form) +++ (cond ((eq form t) '(line-feed 1)) +++ ((numberp form) +++ (cond ((greaterp form 0) `(msg-space ,form)) +++ (t `(line-feed ,(minus form))))) +++ ((atom form) `(patom ',form)) +++ ((eq (car form) t) '(patom '/ )) +++ ((eq (car form) 'e) +++ `(patom ,(cadr form))) +++ (t `(patom ,form)))) +++ body))) +++ +++ (defmacro msg-space (n) +++ (cond ((eq 1 n) '(patom '" ")) +++ (t `(do i ,n (sub1 i) (lessp i 1) (patom '/ ))))) +++ +++ (defmacro line-feed (n) +++ (cond ((eq 1 n) '(terpr)) +++ (t `(do i ,n (sub1 i) (lessp i 1) (terpr))))) +++ +++ (defmacro prog1 ( first &rest rest &aux (foo (gensym))) +++ `((lambda (,foo) ,@rest ,foo) ,first)) +++ +++ (de append1 (l x) (append l (list x))) +++ +++ ; compatability functions: functions required by uci lisp but not +++ ; present in franz +++ +++ (def union +++ (lexpr (n) +++ (do ((res (arg n)) +++ (i (sub1 n) (sub1 i))) +++ ((zerop i) res) +++ (mapc '(lambda (arg) +++ (cond ((not (member arg res)) +++ (setq res (cons arg res))))) +++ (arg i))))) +++ +++ +++ (putd 'newsym (getd 'gensym)) ; this is probably correct +++ (putd 'remove (getd 'delete)) +++ +++; ignore column count +++ (def sprint +++ (lambda (form column) +++ ($prpr form))) +++ +++ (def save (lambda (f) (putprop f (getd f) 'olddef))) +++ +++ (def unsave +++ (lambda (f) +++ (putd f (get f 'olddef)))) +++ +++ (putd 'atcat (getd 'concat)) +++ (putd 'consp (getd 'dtpr)) +++ +++ (defun neq macro (x) +++ `(not (eq ,@(cdr x)))) +++ +++ (putd 'gt (getd '>)) +++ (putd 'lt (getd '<)) +++ +++ (defun le macro (x) +++ `(not (> ,@(cdr x)))) +++ +++ (defun ge macro (x) +++ `(not (< ,@(cdr x)))) +++ +++ (defun litatom macro (x) +++ `(and (atom ,@(cdr x)) +++ (not (numberp ,@(cdr x))))) +++ +++ (putd 'apply\# (getd 'apply)) +++ +++ (defun tconc (ptr x) +++ (cond ((null ptr) +++ (prog (temp) +++ (setq temp (list x)) +++ (return (setq ptr (cons temp (last temp)))))) +++ (t (prog (temp) +++ (setq temp (cdr ptr)) +++ (rplacd (cdr ptr) (list x)) +++ (rplacd ptr (cdr temp)) +++ (return ptr))))) +++ +++ ; +++ ; unbound - (setq x (unbound)) will unbind x. +++ ; "this [code] is sick" - jkf. +++ ; +++ (defun unbound macro (l) +++ `(fake -4)) +++ +++ (sstatus uctolc t) +++ (setsyntax '\, 2) +++ (setsyntax '\! 2) +++ (setsyntax '\` 2) +++ ; +++ ; ~ as comment character, not ; and / instead of \ for escape +++ (setsyntax '\~ 'splicing (get '\; 'macro)) +++ (setsyntax '\; 2) +++ (setsyntax '\/ 143) +++ (setsyntax '\\ 2) +++ (setsyntax '\@ 201) +++ +++ ) diff --cc usr/lib/me/acm.me index 0000000000,0000000000,0000000000..1dde6281e3 new file mode 100644 --- /dev/null +++ b/usr/lib/me/acm.me @@@@ -1,0 -1,0 -1,0 +1,55 @@@@ +++.nr _0 \n(c. +++.\" @(#)acm.me 2.1 8/18/80 +++.\" This version has had comments stripped; an unstripped version is available. +++.de ac +++.ll 8.9i +++.nr $s 0.5i +++.if !\\n($T \ +++. po 1.0i +++.ie "\\$2"*" \ +++\{\ +++. nr hm 0.375i +++. nr tm 1.125i +++. pl 14.25i +++. nr bm 1.5i +++. de $h .. +++. tl ''%'' +++... +++. rm $f +++.\} +++.el \ +++\{\ +++. nr hm 0 +++. nr tm 0 +++. pl 15i +++. nr bm 3i +++. nr fm 0.9i +++. de $f .. +++. ti 0 +++\h'|0.5i'\\\\n%\h'|1.25i'\\$2\h'|3i'\\$1 +++. br +++... +++. rm $h +++.\} +++.bp +++.rs +++.sp 0.75i +++.rm ac +++.. +++.if t .tm Line \n(c. -- macro .ac will not work in TROFF -- request ignored. +++.if t .rm ac +++.de +c +++.if \\n(?A \ +++\{\ +++. nr ch 0 1 +++. pn 1 +++. ep +++. af % 1 +++. bp +++.\} +++.nr ?A 0 +++.sp 1i +++.if \\n(.$ \ +++. $c "\\$1" +++.. +++.nr c. \n(_0 diff --cc usr/lib/me/chars.me index 0000000000,0000000000,0000000000..2b0add6fca new file mode 100644 --- /dev/null +++ b/usr/lib/me/chars.me @@@@ -1,0 -1,0 -1,0 +1,53 @@@@ +++.nr _0 \n(c. +++.\" @(#)chars.me 2.2 8/29/80 +++.\" This version has had comments stripped; an unstripped version is available. +++.if n \ +++\{\ +++. ds #[ \f1 +++. ds #] \fP +++. ds #h 0 +++. ds #v 0.8m +++. ds #f 0.3m +++.\} +++.if t \ +++\{\ +++. ds #[ \& +++. ds #] \& +++. ds #h ((1u-(\\\\n(.fu%2u))*0.13m) +++. ds #v 0.6m +++. ds #f 0 +++.\} +++.ds ' \k_\h'-(\\n(.wu*8/10-\*(#h)'\*(#[\(aa\h'|\\n_u'\*(#] +++.ds ` \k_\h'-(\\n(.wu*7/10-\*(#h)'\*(#[\(ga\h'|\\n_u'\*(#] +++.ds : \k_\h'-(\\n(.wu*8/10-\*(#h+0.1m+\*(#f)'\v'-\*(#v'\*(#[\z.\h'0.2m+\*(#f'.\h'|\\n_u'\v'\*(#v'\*(#] +++.ds ^ \k_\h'-(\\n(.wu-\*(#h-0.05m)'\*(#[^\h'|\\n_u'\*(#] +++.ds ~ \k_\h'-(\\n(.wu-\*(#h-0.05m)'\*(#[~\h'|\\n_u'\*(#] +++.ds , \k_\h'-(\\n(.wu)'\*(#[,\h'|\\n_u'\*(#] +++.ds v \k_\h'-(\\n(.wu*9/10-\*(#h)'\v'-\*(#v'\*(#[\s-4v\s0\v'\*(#v'\h'|\\n_u'\*(#] +++.ds o \k_\h'-(\\n(.wu+\w'\(de'u-\*(#h)/2u'\v'-0.4n'\*(#[\z\(de\v'0.4n'\h'|\\n_u'\*(#] +++.ds qe \*(#[\v'0.5m'\z\(em\v'-0.65m'\z\(em\v'-0.65m'\z\(em\v'0.8m'\h'0.3m'|\h'-0.3m'\*(#] +++.ds qa \*(#[\h'-0.24m'\z\e\h'0.48m'\z\(sl\h'-0.24m'\v'-0.15m'\(em\v'0.15m'\*(#] +++.if t \ +++\{\ +++. ds qe \s-2\v'0.45m'\z\(em\v'-0.625m'\z\(em\v'-0.625m'\(em\v'0.8m'\s0\h'-0.1m'\v'-0.05m'\(br\v'0.05m'\h'0.1m' +++. ds qa \z\e\h'0.35m'\z\(sl\h'-0.33m'\v'-0.3m'\s-4\(em\s0\v'0.3m'\h'0.15m' +++.\} +++.if \n($T \ +++\{\ +++. ds ' \*(#[\h'-1'\(aa\*(#] +++. ds ` \*(#[\h'-1'\(ga\*(#] +++. ds : \& +++. ds ^ \*(#[\h'-1'^\*(#] +++. ds ~ \*(#[\h'-1'~\*(#] +++. ds , \*(#[\h'-1',\*(#] +++. ds v \& +++. ds o \& +++. ds qe EXISTS +++. ds qa FORALL +++.\} +++.rm #[ +++.rm #] +++.rm #h +++.rm #v +++.rm #f +++.nr c. \n(_0 diff --cc usr/lib/me/deltext.me index 0000000000,922a0e522f,0000000000..1291449a2d mode 000000,100644,000000..100644 --- a/usr/lib/me/deltext.me +++ b/usr/lib/me/deltext.me @@@@ -1,0 -1,19 -1,0 +1,20 @@@@ + +.nr _0 \n(c. +++.\" @(#)deltext.me 2.1 8/18/80 + +.\" This version has had comments stripped; an unstripped version is available. + +.de (d + +.am |d )d + +.sp \\n(bsu + +.. + +.de )d + +.if \\n# \ + +. nr $d +1 + +.ds # [\\n($d]\k# + +.rr # + +.. + +.de pd + +.|d + +.rm |d + +.nr $d 1 1 + +.ds # [1]\k# + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/eqn.me index 0000000000,0000000000,0000000000..28b689ee7f new file mode 100644 --- /dev/null +++ b/usr/lib/me/eqn.me @@@@ -1,0 -1,0 -1,0 +1,77 @@@@ +++.nr _0 \n(c. +++.\" @(#)eqn.me 2.1 8/18/80 +++.\" This version has had comments stripped; an unstripped version is available. +++.de EQ +++.ec +++.if !\\n(?e \ +++\{\ +++. if "\\n(.z"|e" .tm Line \\n(c. -- Nested .EQ request +++. @D 1 "\\$1" "\\$2" +++. @C 2 +++. di |e +++.\} +++.ls 1 +++.in 0 +++.nf +++.. +++.de EN +++.br +++.ie "\\$1"C" \ +++\{\ +++. nr ?e 1 +++. sp \\n(esu +++.\} +++.el \ +++\{\ +++. nr ?e 0 +++. di +++. if \\n(dn \ +++. @q +++. rm |e +++. rm 10 +++. rm 11 +++. rm 12 +++. rm 13 +++. rm 14 +++. rm 15 +++. rm 16 +++. rm 17 +++. rm 18 +++. rm 19 +++. rm 20 +++. rm 21 +++. rm 22 +++. rm 23 +++. ev +++.\} +++.. +++.de @q +++.nr _Q \\n(dnu +++.ev +++.sp \\n(esu +++.@C 2 +++.ie \\n(_d=1 \ +++. in (\\n(.lu+\\n($iu-\\n(dlu)/2u +++.el .ie \\n(_d=2 \ +++. in \\n($iu +++.el .ie \\n(_d=3 \ +++. in \\n(biu+\\n($iu +++.el .if \\n(_d=4 \ +++. in 0 +++.if !"\\n(.z"" \!.ne \\n(_Qu +++.ne \\n(_Qu+\n(.Vu +++.mk _q +++.if !"\\*(|p"" \ +++\{\ +++. rs +++. sp (\\n(_Qu-\\n(.vu)/2u +++. tl """\\*(|p" +++. rt \\n(_qu +++.\} +++.|e +++.sp |\\n(_qu+\\n(_Qu +++.sp \\n(esu+\\n(.Lv-1v +++.rr _q +++.rr _Q +++.. +++.nr c. \n(_0 diff --cc usr/lib/me/float.me index 0000000000,49595d632b,0000000000..86a701c453 mode 000000,100644,000000..100644 --- a/usr/lib/me/float.me +++ b/usr/lib/me/float.me @@@@ -1,0 -1,57 -1,0 +1,63 @@@@ + +.nr _0 \n(c. +++.\" @(#)float.me 2.1 8/18/80 + +.\" This version has had comments stripped; an unstripped version is available. + +.de (z + +.@D 4 \\$1 \\$2 + +.@( + +.nr ?T 0 + +.. + +.de )z + +.sp \\n(zsu + +.@) + +.rr _0 + +.if !\\n(?b \ + +. nr dn +(\\n(ppu*\\n($ru)/2u+\\n(zsu - .ie ((\\n(dn+\n(.V)>=\\n(.t):(\\n(?a) \ +++.nr dl -\n(.H +++.ie ((\\n(dn+\n(.V)>=\\n(.t):(\\n(?a):((\\n(dl>\\n($l)&(\\n($c>1)) \ + +\{\ + +. nr ?a 1 +++. if (\\n(dl>\\n($l)&(\\n($m>1) \ +++. nr ?w 1 + +. ds |x |t + +.\} + +.el \ + +\{\ + +. nr ?b 1 +++. if (\\n(dl>\\n($l)&(\\n($m>1) \ +++. nr ?W 1 + +. nr _b +\\n(dnu + +. ch @f -\\n(_bu + +. ds |x |b + +.\} + +.da \\*(|x + +.nf + +.ls 1 + +.nr ?k 1 + +\!.if \\\\n(nl>(\\\\n(tm+2v) .ne \\n(dnu-\\n(zsu + +.eo + +.cc @ + +@|k + +@cc + +.ec + +.nr ?k 0 + +.rm |k + +.da + +.in 0 + +.ls 1 + +.xl \\n($lu + +.ev + +.. + +.de @k + +.ev 1 + +.nf + +.ls 1 + +.in 0 + +.sp \\n(zsu + +.\\$1 + +.ec + +.br + +.rm \\$1 + +.ev + +.nr ?T 0 + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/footnote.me index 0000000000,0000000000,0000000000..38607b2b1a new file mode 100644 --- /dev/null +++ b/usr/lib/me/footnote.me @@@@ -1,0 -1,0 -1,0 +1,83 @@@@ +++.nr _0 \n(c. +++.\" @(#)footnote.me 2.4 9/23/80 +++.\" This version has had comments stripped; an unstripped version is available. +++.de (f +++.ec +++.if "\\n(.z"|f" .tm Line \\n(c. -- Illegal footnote nesting +++.ie "\\n(.z"" \ +++\{\ +++. nr _D \\n(dn +++. nr _0 1v+\\n(nlu +++. ev 2 +++. da |f +++. in 0 +++. xl \\n($lu-\\n(fuu +++. @F \\n(ff +++. sz \\n(fpu +++. vs \\n(.su*\\n($Ru +++. if !\\n(?f \ +++\{\ +++. nr _b +2u*\n(.Vu +++. $s +++. \} +++. br +++. if \\n(.p-\\n(_b-\\n(_0-\\n(.h-1v-\\n(fs<0 \ +++\{\ +++. da\" +++. bc +++. if !\\n(?f \ +++. rm |f +++. da |f +++. in 0 +++. xl \\n($lu-\\n(fuu +++. @F \\n(ff +++. sz \\n(fpu +++. vs \\n(.su*\\n($Ru +++. if !\\n(?f \ +++. $s +++. br +++. \} +++. rr _0 +++. sp \\n(fsu +++. nr ?f 1 +++. fi +++. if !"\\$1"_" \ +++. ti \\n(fiu +++.\} +++.el \ +++\{\ +++. ev 2 +++\!.(f \\$1 +++.\} +++.. +++.de )f +++.ie "\\n(.z"|f" \ +++\{\ +++. if \\n* \ +++. nr $f +1 +++. ds * \\*[\\n($f\\*]\k* +++. rr * +++. in 0 +++. da +++. ev +++. if \\n(_w<\\n(dl \ +++. nr _w \\n(dl +++. nr _b +\\n(dn +++. ch @f -\\n(_bu +++. if \\n(.p-\\n(_b<=\\n(nl \ +++. ch @f \\n(nlu+\n(.Vu +++. nr dn _D +++. rr _D +++.\} +++.el \ +++\{\ +++. br +++\!.)f +++. ev +++.\} +++.. +++.if \n(ff<=0 \ +++. nr ff 1 +++.if \n(fp<=0 \ +++. nr fp 8 +++.nr c. \n(_0 diff --cc usr/lib/me/index.me index 0000000000,0000000000,0000000000..fe33cd158b new file mode 100644 --- /dev/null +++ b/usr/lib/me/index.me @@@@ -1,0 -1,0 -1,0 +1,70 @@@@ +++.nr _0 \n(c. +++.\" @(#)index.me 2.5 9/24/80 +++.\" This version has had comments stripped; an unstripped version is available. +++.de (x +++.ie !"\\n(.z"" \ +++\{\ +++. ev 2 +++\!.(x \\$1 +++.\} +++.el \ +++\{\ +++. ds |X x +++. if \\n(.$ \ +++. ds |X \\$1 +++. am %\\*(|X )x +++. sp \\n(xsu +++.\} +++.. +++.de )x +++.ie "\\n(.z"" \ +++\{\ +++. ds |x \\n% +++. if \\n(.$ \ +++. ds |x \\$1 +++. if "\\*(|x"_" \ +++. ig .. +++. am %\\*(|X .. +++. if \w"\\$2">(\\n(.l-\\n(.i-\\n(.k) \ +++. ti +\\n(xuu +++\\\\a\\\\t\\$2\\*(|x +++... +++. rm |x +++. rm |X +++.\} +++.el \ +++\{\ +++. br +++\!.)x \\$1 \\$2 +++. ev +++.\} +++.. +++.de xp +++.br +++.@C 2 +++.ls 1 +++.vs \\n(.su*\\n($Ru +++.fi +++.ds |X x +++.if \\n(.$ \ +++. ds |X \\$1 +++.xl -(\\n(xuu+\w'...'u) +++.di |x +++.%\\*(|X +++.br +++.di +++.rm %\\*(|X +++.xl \\n($lu +++.rm |X +++.ev +++.nf +++.in 0 +++.ta \\n(.lu-\\n(xuuR \\n(.luR +++.|x +++.fi +++.in +++.rm |x +++.. +++.if \n(xu<=0 \ +++. nr xu 0.5i +++.nr c. \n(_0 diff --cc usr/lib/me/local.me index 0000000000,1cf787de4c,0000000000..80c72bf470 mode 000000,100644,000000..100644 --- a/usr/lib/me/local.me +++ b/usr/lib/me/local.me @@@@ -1,0 -1,9 -1,0 +1,10 @@@@ + +.nr _0 \n(c. + +.\" this file may contain local macros, which are initialized with + +.\" the ".lo" request. All macros and number registers in this file + +.\" should be named ".*X", where X is any letter (upper or lower case) + +.\" or digit, to avoid naming conflicts. + +.\" +++.\" @(#)local.me 2.1 8/18/80 + +.\" This version has had comments stripped; an unstripped version is available. + +. \" *** insert new definitions before this line *** + +.nr c. \n(_0 diff --cc usr/lib/me/null.me index 0000000000,0000000000,0000000000..ad6083fd74 new file mode 100644 --- /dev/null +++ b/usr/lib/me/null.me @@@@ -1,0 -1,0 -1,0 +1,3 @@@@ +++.\" @(#)null.me 2.1 8/18/80 +++.\" This version has had comments stripped; an unstripped version is available. +++.cc . diff --cc usr/lib/me/sh.me index 0000000000,0000000000,0000000000..403cec4334 new file mode 100644 --- /dev/null +++ b/usr/lib/me/sh.me @@@@ -1,0 -1,0 -1,0 +1,108 @@@@ +++.nr _0 \n(c. +++.\" @(#)sh.me 2.1 8/18/80 +++.\" This version has had comments stripped; an unstripped version is available. +++.de sh +++.if (\\n(si>0)&(\\n(si<1n) \ +++. nr si \\n(sin +++.ce 0 +++.@d "\\$1" +1 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 +++.if !"\\$2"_" \ +++\{\ +++. ds |x \&\\$2 +++. $p "\\*(|x" "\\*($n" \\n($0 +++. $0 "\\*(|x" "\\*($n" \\n($0 +++. rm |x +++.\} +++.nr $p 0 1 +++.. +++.de @d +++.if !""\\$1" \ +++. nr $0 \\$1 +++.if \\n($0&(\\n(.$>1) \ +++. nr $\\n($0 \\$2 +++.ds $n \&\" +++.ie \\n($0>=1 \ +++\{\ +++. if \\n($1=0 \ +++. nr $1 1 +++. if (\\n(.$>=3) .if !"\\$3"-" \ +++. nr $1 \\$3 +++. as $n \\n($1 +++.\} +++.el \ +++. nr $1 0 +++.ie \\n($0>=2 \ +++\{\ +++. if \\n($2=0 \ +++. nr $2 1 +++. if (\\n(.$>=4) .if !"\\$4"-" \ +++. nr $2 \\$4 +++. as $n .\\n($2 +++.\} +++.el \ +++. nr $2 0 +++.ie \\n($0>=3 \ +++\{\ +++. if \\n($3=0 \ +++. nr $3 1 +++. if (\\n(.$>=5) .if !"\\$5"-" \ +++. nr $3 \\$5 +++. as $n .\\n($3 +++.\} +++.el \ +++. nr $3 0 +++.ie \\n($0>=4 \ +++\{\ +++. if \\n($4=0 \ +++. nr $4 1 +++. if (\\n(.$>=6) .if !"\\$6"-" \ +++. nr $4 \\$6 +++. as $n .\\n($4 +++.\} +++.el \ +++. nr $4 0 +++.ie \\n($0>=5 \ +++\{\ +++. if \\n($5=0 \ +++. nr $5 1 +++. if (\\n(.$>=7) .if !"\\$7"-" \ +++. nr $5 \\$7 +++. as $n .\\n($5 +++.\} +++.el \ +++. nr $5 0 +++.ie \\n($0>=6 \ +++\{\ +++. if \\n($6=0 \ +++. nr $6 1 +++. if (\\n(.$>=8) .if !"\\$8"-" \ +++. nr $6 \\$8 +++. as $n .\\n($6 +++.\} +++.el \ +++. nr $6 0 +++.. +++.de sx +++.ce 0 +++.ul 0 +++.nr _0 \\n($0-1 +++.if \\n(.$ .nr _0 +1 +++.if \\n(.$ .nr _0 \\$1 +++.@d \\n(_0 +++.rr _0 +++.$p "" "" \\n($0 +++.nr $p 0 1 +++.. +++.de uh +++.$p "\\$1" +++.$0 "\\$1" +++.. +++.if \n(sf<=0 \ +++. nr sf 8 +++.if \n(sp<=0 \ +++. nr sp 10 +++.if \n(ss<=0 \ +++. nr ss 12p +++.if \n(si<=0 \ +++. nr si 0 +++.nr c. \n(_0 diff --cc usr/lib/me/src/acm.me index 0000000000,df713a9a97,0000000000..a4ffc64981 mode 000000,100644,000000..100644 --- a/usr/lib/me/src/acm.me +++ b/usr/lib/me/src/acm.me @@@@ -1,0 -1,54 -1,0 +1,55 @@@@ + +.nr _0 \n(c. - .\" This version has had comments stripped; an unstripped version is available. +++.\" @(#)acm.me 2.1 8/18/80 +++.\" %beginstrip% + +.de ac + +.ll 8.9i + +.nr $s 0.5i + +.if !\\n($T \ + +. po 1.0i + +.ie "\\$2"*" \ + +\{\ + +. nr hm 0.375i + +. nr tm 1.125i + +. pl 14.25i + +. nr bm 1.5i + +. de $h .. + +. tl ''%'' + +... + +. rm $f + +.\} + +.el \ + +\{\ + +. nr hm 0 + +. nr tm 0 + +. pl 15i + +. nr bm 3i + +. nr fm 0.9i + +. de $f .. + +. ti 0 + +\h'|0.5i'\\\\n%\h'|1.25i'\\$2\h'|3i'\\$1 + +. br + +... + +. rm $h + +.\} + +.bp + +.rs + +.sp 0.75i + +.rm ac + +.. + +.if t .tm Line \n(c. -- macro .ac will not work in TROFF -- request ignored. + +.if t .rm ac - .de +c +++.de +c \" *** begin chapter + +.if \\n(?A \ + +\{\ + +. nr ch 0 1 + +. pn 1 + +. ep + +. af % 1 + +. bp + +.\} + +.nr ?A 0 + +.sp 1i + +.if \\n(.$ \ + +. $c "\\$1" + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/src/chars.me index 0000000000,262dfb40b3,0000000000..8182f44aba mode 000000,100644,000000..100644 --- a/usr/lib/me/src/chars.me +++ b/usr/lib/me/src/chars.me @@@@ -1,0 -1,52 -1,0 +1,61 @@@@ + +.nr _0 \n(c. - .\" This version has had comments stripped; an unstripped version is available. +++.\" @(#)chars.me 2.2 8/29/80 +++.\" %beginstrip% +++.\" *** special characters *** +++.\" this file uses temp strings of the form #x. + +.if n \ + +\{\ + +. ds #[ \f1 + +. ds #] \fP + +. ds #h 0 + +. ds #v 0.8m - . ds #f +0.3m +++. ds #f 0.3m + +.\} + +.if t \ + +\{\ + +. ds #[ \& + +. ds #] \& + +. ds #h ((1u-(\\\\n(.fu%2u))*0.13m) + +. ds #v 0.6m - . ds #f "\" +++. ds #f 0 + +.\} +++.\" \" accents + +.ds ' \k_\h'-(\\n(.wu*8/10-\*(#h)'\*(#[\(aa\h'|\\n_u'\*(#] + +.ds ` \k_\h'-(\\n(.wu*7/10-\*(#h)'\*(#[\(ga\h'|\\n_u'\*(#] - .ds : \k_\h'-(\\n(.wu*8/10-\*(#h+0.1m\*(#f)'\v'-\*(#v'\*(#[\z.\h'0.2m\*(#f'.\h'|\\n_u'\v'\*(#v'\*(#] +++.\" \" umlaut +++.ds : \k_\h'-(\\n(.wu*8/10-\*(#h+0.1m+\*(#f)'\v'-\*(#v'\*(#[\z.\h'0.2m+\*(#f'.\h'|\\n_u'\v'\*(#v'\*(#] +++.\" \" circumflex and tilde + +.ds ^ \k_\h'-(\\n(.wu-\*(#h-0.05m)'\*(#[^\h'|\\n_u'\*(#] + +.ds ~ \k_\h'-(\\n(.wu-\*(#h-0.05m)'\*(#[~\h'|\\n_u'\*(#] +++.\" \" cedilla and czech + +.ds , \k_\h'-(\\n(.wu)'\*(#[,\h'|\\n_u'\*(#] + +.ds v \k_\h'-(\\n(.wu*9/10-\*(#h)'\v'-\*(#v'\*(#[\s-4v\s0\v'\*(#v'\h'|\\n_u'\*(#] +++.\" \" Norwegian A or angstrom + +.ds o \k_\h'-(\\n(.wu+\w'\(de'u-\*(#h)/2u'\v'-0.4n'\*(#[\z\(de\v'0.4n'\h'|\\n_u'\*(#] +++.\" \" there exists, for all + +.ds qe \*(#[\v'0.5m'\z\(em\v'-0.65m'\z\(em\v'-0.65m'\z\(em\v'0.8m'\h'0.3m'|\h'-0.3m'\*(#] + +.ds qa \*(#[\h'-0.24m'\z\e\h'0.48m'\z\(sl\h'-0.24m'\v'-0.15m'\(em\v'0.15m'\*(#] + +.if t \ + +\{\ + +. ds qe \s-2\v'0.45m'\z\(em\v'-0.625m'\z\(em\v'-0.625m'\(em\v'0.8m'\s0\h'-0.1m'\v'-0.05m'\(br\v'0.05m'\h'0.1m' + +. ds qa \z\e\h'0.35m'\z\(sl\h'-0.33m'\v'-0.3m'\s-4\(em\s0\v'0.3m'\h'0.15m' + +.\} + +.if \n($T \ + +\{\ + +. ds ' \*(#[\h'-1'\(aa\*(#] + +. ds ` \*(#[\h'-1'\(ga\*(#] + +. ds : \& + +. ds ^ \*(#[\h'-1'^\*(#] + +. ds ~ \*(#[\h'-1'~\*(#] + +. ds , \*(#[\h'-1',\*(#] + +. ds v \& + +. ds o \& + +. ds qe EXISTS + +. ds qa FORALL + +.\} + +.rm #[ + +.rm #] + +.rm #h + +.rm #v + +.rm #f + +.nr c. \n(_0 diff --cc usr/lib/me/src/deltext.me index 0000000000,1ceaee06fb,0000000000..1daa6251d1 mode 000000,100644,000000..100644 --- a/usr/lib/me/src/deltext.me +++ b/usr/lib/me/src/deltext.me @@@@ -1,0 -1,18 -1,0 +1,20 @@@@ + +.nr _0 \n(c. +++.\" @(#)deltext.me 2.1 8/18/80 +++.\" %beginstrip% + +.de (d \" *** begin delayed text + +.am |d )d + +.sp \\n(bsu + +.. + +.de )d \" *** end delayed text + +.if \\n# \ + +. nr $d +1 + +.ds # [\\n($d]\k# + +.rr # + +.. + +.de pd \" *** print delayed text + +.|d + +.rm |d + +.nr $d 1 1 + +.ds # [1]\k# + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/src/eqn.me index 0000000000,0794e2cf2b,0000000000..5fcb3c3df4 mode 000000,100644,000000..100644 --- a/usr/lib/me/src/eqn.me +++ b/usr/lib/me/src/eqn.me @@@@ -1,0 -1,76 -1,0 +1,78 @@@@ + +.nr _0 \n(c. - .\" This version has had comments stripped; an unstripped version is available. - .de EQ +++.\" @(#)eqn.me 2.1 8/18/80 +++.\" %beginstrip% +++.de EQ \" *** equation start + +.ec + +.if !\\n(?e \ + +\{\ + +. if "\\n(.z"|e" .tm Line \\n(c. -- Nested .EQ request + +. @D 1 "\\$1" "\\$2" + +. @C 2 + +. di |e + +.\} + +.ls 1 + +.in 0 + +.nf + +.. - .de EN +++.de EN \" *** equation end + +.br + +.ie "\\$1"C" \ + +\{\ + +. nr ?e 1 + +. sp \\n(esu + +.\} + +.el \ + +\{\ + +. nr ?e 0 + +. di + +. if \\n(dn \ - . @q +++. @q \" actual equation output + +. rm |e + +. rm 10 + +. rm 11 + +. rm 12 + +. rm 13 + +. rm 14 + +. rm 15 + +. rm 16 + +. rm 17 + +. rm 18 + +. rm 19 + +. rm 20 + +. rm 21 + +. rm 22 + +. rm 23 + +. ev + +.\} + +.. - .de @q +++.de @q \" --- equation output + +.nr _Q \\n(dnu + +.ev - .sp \\n(esu - .@C 2 +++.sp \\n(esu \" output rest of preceeding text +++.@C 2 \" .ev 2 may be jumbled from header + +.ie \\n(_d=1 \ + +. in (\\n(.lu+\\n($iu-\\n(dlu)/2u + +.el .ie \\n(_d=2 \ + +. in \\n($iu + +.el .ie \\n(_d=3 \ + +. in \\n(biu+\\n($iu + +.el .if \\n(_d=4 \ + +. in 0 + +.if !"\\n(.z"" \!.ne \\n(_Qu - .ne \\n(_Qu+\n(.Vu +++.ne \\n(_Qu+\n(.Vu \" keep it on one page + +.mk _q +++.if \n@>1 .tm --@e: _Q=\\n(_Q _q=\\n(_q nl=\\n(nl |p=\\*(|p + +.if !"\\*(|p"" \ + +\{\ + +. rs + +. sp (\\n(_Qu-\\n(.vu)/2u + +. tl """\\*(|p" + +. rt \\n(_qu + +.\} + +.|e + +.sp |\\n(_qu+\\n(_Qu + +.sp \\n(esu+\\n(.Lv-1v + +.rr _q + +.rr _Q + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/src/float.me index 0000000000,0dbade2c57,0000000000..196b5ea116 mode 000000,100644,000000..100644 --- a/usr/lib/me/src/float.me +++ b/usr/lib/me/src/float.me @@@@ -1,0 -1,56 -1,0 +1,63 @@@@ + +.nr _0 \n(c. +++.\" @(#)float.me 2.1 8/18/80 +++.\" %beginstrip% + +.de (z \" *** begin floating keep + +.@D 4 \\$1 \\$2 + +.@( + +.nr ?T 0 + +.. + +.de )z \" *** end floating keep + +.sp \\n(zsu + +.@) + +.rr _0 + +.if !\\n(?b \ + +. nr dn +(\\n(ppu*\\n($ru)/2u+\\n(zsu - .ie ((\\n(dn+\n(.V)>=\\n(.t):(\\n(?a) \ +++.nr dl -\n(.H \" fudge factor necessary to make it work +++.ie ((\\n(dn+\n(.V)>=\\n(.t):(\\n(?a):((\\n(dl>\\n($l)&(\\n($c>1)) \ + +\{\ + +. nr ?a 1 +++. if (\\n(dl>\\n($l)&(\\n($m>1) \ +++. nr ?w 1 \" mark wider than one column (top) + +. ds |x |t + +.\} + +.el \ + +\{\ + +. nr ?b 1 +++. if (\\n(dl>\\n($l)&(\\n($m>1) \ +++. nr ?W 1 \" mark wider than one column (bottom) + +. nr _b +\\n(dnu + +. ch @f -\\n(_bu + +. ds |x |b + +.\} + +.da \\*(|x \" copy to save macro + +.nf + +.ls 1 + +.nr ?k 1 + +\!.if \\\\n(nl>(\\\\n(tm+2v) .ne \\n(dnu-\\n(zsu + +.eo + +.cc @ + +@|k \" and the body + +@cc + +.ec + +.nr ?k 0 + +.rm |k \" remove the temp macro + +.da + +.in 0 + +.ls 1 + +.xl \\n($lu + +.ev + +.. + +.de @k \" --- output floating keep + +.ev 1 + +.nf + +.ls 1 + +.in 0 + +.sp \\n(zsu + +.\\$1 + +.ec + +.br + +.rm \\$1 + +.ev + +.nr ?T 0 + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/src/footnote.me index 0000000000,e992ef2c2e,0000000000..b60593e81e mode 000000,100644,000000..100644 --- a/usr/lib/me/src/footnote.me +++ b/usr/lib/me/src/footnote.me @@@@ -1,0 -1,70 -1,0 +1,85 @@@@ + +.nr _0 \n(c. - .\" This version has had comments stripped; an unstripped version is available. - .de (f +++.\" @(#)footnote.me 2.4 9/23/80 +++.\" %beginstrip% +++.de (f \" *** begin footnote + +.ec + +.if "\\n(.z"|f" .tm Line \\n(c. -- Illegal footnote nesting - .nr _D \\n(dn - .nr _0 1v+\\n(nlu - .ev 2 - .da |f - .in 0 - .xl \\n($lu-\\n(fuu - .@F \\n(ff - .sz \\n(fpu - .vs \\n(.su*\\n($Ru - .if !\\n(?f \ +++.ie "\\n(.z"" \ + +\{\ - . nr _b +2u*\n(.Vu - . $s - .\} - .br - .if \\n(.p-\\n(_b-\\n(_0-\\n(.h-1v-\\n(fs<0 \ - \{\ - . da\" - . bc - . if !\\n(?f \ - . rm |f +++. nr _D \\n(dn +++. nr _0 1v+\\n(nlu +++. ev 2 + +. da |f + +. in 0 + +. xl \\n($lu-\\n(fuu + +. @F \\n(ff + +. sz \\n(fpu + +. vs \\n(.su*\\n($Ru + +. if !\\n(?f \ +++\{\ +++. nr _b +2u*\n(.Vu \" fudge factor + +. $s +++. \} + +. br +++. if \\n(.p-\\n(_b-\\n(_0-\\n(.h-1v-\\n(fs<0 \ +++\{\ +++. da\" \" won't fit on page at all +++. bc +++. if !\\n(?f \ +++. rm |f +++. da |f +++.\" next five lines could be dropped if headers had their own environment +++. in 0 \" reset everything from .bc +++. xl \\n($lu-\\n(fuu +++. @F \\n(ff +++. sz \\n(fpu +++. vs \\n(.su*\\n($Ru +++. if !\\n(?f \ +++. $s +++. br +++. \} +++. rr _0 +++. sp \\n(fsu +++. nr ?f 1 +++. fi +++. if !"\\$1"_" \ +++. ti \\n(fiu +++. if \n@>2 .tm << (f $f=\\n($f +++.\} +++.el \ +++\{\ +++. ev 2 +++\!.(f \\$1 + +.\} - .rr _0 - .sp \\n(fsu - .nr ?f 1 - .fi - .if !"\\$1"_" \ - . ti \\n(fiu + +.. - .de )f - .if \\n* \ - . nr $f +1 - .ds * \\*[\\n($f\\*]\k* - .rr * - .in 0 - .da - .ev - .if \\n(_w<\\n(dl \ - . nr _w \\n(dl - .nr _b +\\n(dn - .ch @f -\\n(_bu - .if \\n(.p-\\n(_b<=\\n(nl \ - . ch @f \\n(nlu+\n(.Vu - .nr dn _D - .rr _D +++.de )f \" *** end footnote +++.ie "\\n(.z"|f" \ +++\{\ +++. if \\n* \ +++. nr $f +1 +++. ds * \\*[\\n($f\\*]\k* +++. rr * +++. in 0 +++. da +++. ev +++. if \\n(_w<\\n(dl \ +++. nr _w \\n(dl \" compute maximum fn width +++. nr _b +\\n(dn +++. ch @f -\\n(_bu +++. if \\n(.p-\\n(_b<=\\n(nl \ +++. ch @f \\n(nlu+\n(.Vu +++. nr dn _D +++. rr _D +++.\} +++.el \ +++\{\ +++. br +++\!.)f +++. ev +++.\} + +.. + +.if \n(ff<=0 \ - . nr ff 1 +++. nr ff 1 \" footnote font: Times Roman + +.if \n(fp<=0 \ - . nr fp 8 - .if \n(fi<=0 \ - \{\ - . if n .nr fi 3n - . if t .nr fi 0.3i - .\} +++. nr fp 8 \" footnote pointsize + +.nr c. \n(_0 diff --cc usr/lib/me/src/index.me index 0000000000,fddcb2f227,0000000000..35273a8fce mode 000000,100644,000000..100644 --- a/usr/lib/me/src/index.me +++ b/usr/lib/me/src/index.me @@@@ -1,0 -1,52 -1,0 +1,71 @@@@ + +.nr _0 \n(c. - .\" This version has had comments stripped; an unstripped version is available. - .de (x - .ds |X x - .if \\n(.$ \ - . ds |X \\$1 - .am %\\*(|X )x - .sp \\n(xsu +++.\" @(#)index.me 2.5 9/24/80 +++.\" %beginstrip% +++.de (x \" *** begin index entry +++.\" please note these cases MUST be in this order +++.ie !"\\n(.z"" \ +++\{\ +++. ev 2 \" if in a diversion, save & process later +++\!.(x \\$1 +++.\} +++.el \ +++\{\ +++. ds |X x +++. if \\n(.$ \ +++. ds |X \\$1 +++. am %\\*(|X )x +++. sp \\n(xsu +++.\} + +.. - .de )x - .ds |x \\n% - .if \\n(.$ \ - . ds |x \\$1 - .if "\\*(|x"_" \ - . ig .. - .am %\\*(|X .. - .if \w"\\$2">(\\n(.l-\\n(.i-\\n(.k) \ - . ti +\\n(xuu +++.de )x \" *** end index entry +++.ie "\\n(.z"" \ +++\{\ +++. ds |x \\n% +++. if \\n(.$ \ +++. ds |x \\$1 +++. if "\\*(|x"_" \ +++. ig .. +++. am %\\*(|X .. +++. if \w"\\$2">(\\n(.l-\\n(.i-\\n(.k) \ +++. ti +\\n(xuu + +\\\\a\\\\t\\$2\\*(|x + +... - .rm |x - .rm |X +++. rm |x +++. rm |X +++.\} +++.el \ +++\{\ +++. br \" if in a diversion, save & process later +++\!.)x \\$1 \\$2 +++. ev +++.\} + +.. - .de xp +++.de xp \" *** print the index + +.br + +.@C 2 + +.ls 1 + +.vs \\n(.su*\\n($Ru + +.fi + +.ds |X x + +.if \\n(.$ \ + +. ds |X \\$1 + +.xl -(\\n(xuu+\w'...'u) + +.di |x + +.%\\*(|X + +.br + +.di + +.rm %\\*(|X + +.xl \\n($lu + +.rm |X + +.ev + +.nf + +.in 0 + +.ta \\n(.lu-\\n(xuuR \\n(.luR + +.|x + +.fi + +.in + +.rm |x + +.. + +.if \n(xu<=0 \ - . nr xu 0.5i +++. nr xu 0.5i \" index undent + +.nr c. \n(_0 diff --cc usr/lib/me/src/local.me index 0000000000,718e1d61f8,0000000000..799b728ceb mode 000000,100644,000000..100644 --- a/usr/lib/me/src/local.me +++ b/usr/lib/me/src/local.me @@@@ -1,0 -1,9 -1,0 +1,10 @@@@ + +.nr _0 \n(c. + +.\" this file may contain local macros, which are initialized with + +.\" the ".lo" request. All macros and number registers in this file + +.\" should be named ".*X", where X is any letter (upper or lower case) + +.\" or digit, to avoid naming conflicts. + +.\" - .\" %beginstrip% +++.\" @(#)local.me 2.1 8/18/80 +++.\" %beginstrip% + +. \" *** insert new definitions before this line *** + +.nr c. \n(_0 diff --cc usr/lib/me/src/null.me index 0000000000,bd0c9cf330,0000000000..2c2bb94aff mode 000000,100644,000000..100644 --- a/usr/lib/me/src/null.me +++ b/usr/lib/me/src/null.me @@@@ -1,0 -1,3 -1,0 +1,6 @@@@ +++.\" @(#)null.me 2.1 8/18/80 +++.\" %beginstrip% + +.\" This file should be null -- it is called when tmac.e is sourced - .\" This version has had comments stripped; an unstripped version is available. +++.\" for the second... time. Of course, you could give an error +++.\" message..... + +.cc . diff --cc usr/lib/me/src/sh.me index 0000000000,91e9d36e60,0000000000..177d5fe925 mode 000000,100644,000000..100644 --- a/usr/lib/me/src/sh.me +++ b/usr/lib/me/src/sh.me @@@@ -1,0 -1,107 -1,0 +1,108 @@@@ + +.nr _0 \n(c. - .\" This version has had comments stripped; an unstripped version is available. - .de sh +++.\" @(#)sh.me 2.1 8/18/80 +++.\" %beginstrip% +++.de sh \" *** section heading + +.if (\\n(si>0)&(\\n(si<1n) \ + +. nr si \\n(sin + +.ce 0 + +.@d "\\$1" +1 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 + +.if !"\\$2"_" \ + +\{\ + +. ds |x \&\\$2 + +. $p "\\*(|x" "\\*($n" \\n($0 + +. $0 "\\*(|x" "\\*($n" \\n($0 + +. rm |x + +.\} - .nr $p 0 1 +++.nr $p 0 1 \" reset .np count + +.. - .de @d +++.de @d \" --- change section depth + +.if !""\\$1" \ + +. nr $0 \\$1 + +.if \\n($0&(\\n(.$>1) \ + +. nr $\\n($0 \\$2 + +.ds $n \&\" + +.ie \\n($0>=1 \ + +\{\ + +. if \\n($1=0 \ + +. nr $1 1 + +. if (\\n(.$>=3) .if !"\\$3"-" \ + +. nr $1 \\$3 + +. as $n \\n($1 + +.\} + +.el \ + +. nr $1 0 + +.ie \\n($0>=2 \ + +\{\ + +. if \\n($2=0 \ + +. nr $2 1 + +. if (\\n(.$>=4) .if !"\\$4"-" \ + +. nr $2 \\$4 + +. as $n .\\n($2 + +.\} + +.el \ + +. nr $2 0 + +.ie \\n($0>=3 \ + +\{\ + +. if \\n($3=0 \ + +. nr $3 1 + +. if (\\n(.$>=5) .if !"\\$5"-" \ + +. nr $3 \\$5 + +. as $n .\\n($3 + +.\} + +.el \ + +. nr $3 0 + +.ie \\n($0>=4 \ + +\{\ + +. if \\n($4=0 \ + +. nr $4 1 + +. if (\\n(.$>=6) .if !"\\$6"-" \ + +. nr $4 \\$6 + +. as $n .\\n($4 + +.\} + +.el \ + +. nr $4 0 + +.ie \\n($0>=5 \ + +\{\ + +. if \\n($5=0 \ + +. nr $5 1 + +. if (\\n(.$>=7) .if !"\\$7"-" \ + +. nr $5 \\$7 + +. as $n .\\n($5 + +.\} + +.el \ + +. nr $5 0 + +.ie \\n($0>=6 \ + +\{\ + +. if \\n($6=0 \ + +. nr $6 1 + +. if (\\n(.$>=8) .if !"\\$8"-" \ + +. nr $6 \\$8 + +. as $n .\\n($6 + +.\} + +.el \ + +. nr $6 0 + +.. - .de sx +++.de sx \" *** heading up, no increment (2.1.1 -> 2.1) + +.ce 0 + +.ul 0 + +.nr _0 \\n($0-1 + +.if \\n(.$ .nr _0 +1 + +.if \\n(.$ .nr _0 \\$1 + +.@d \\n(_0 + +.rr _0 + +.$p "" "" \\n($0 - .nr $p 0 1 +++.nr $p 0 1 \" reset .np count + +.. - .de uh +++.de uh \" *** unnumbered section heading + +.$p "\\$1" + +.$0 "\\$1" + +.. + +.if \n(sf<=0 \ - . nr sf 8 +++. nr sf 8 \" section font -- Times Bold + +.if \n(sp<=0 \ - . nr sp 10 +++. nr sp 10 \" section title pointsize + +.if \n(ss<=0 \ - . nr ss 12p +++. nr ss 12p \" section prespacing + +.if \n(si<=0 \ - . nr si 0 +++. nr si 0 \" section indent + +.nr c. \n(_0 diff --cc usr/lib/me/src/tbl.me index 0000000000,586b309808,0000000000..6b496b66db mode 000000,100644,000000..100644 --- a/usr/lib/me/src/tbl.me +++ b/usr/lib/me/src/tbl.me @@@@ -1,0 -1,107 -1,0 +1,109 @@@@ + +.nr _0 \n(c. +++.\" @(#)tbl.me 2.1 8/18/80 +++.\" %beginstrip% + +.de TS \" *** table start + +.sp \\n(bsu + +.@C 1 + +.if "\\$1"H" \ + +\{\ + +. di |h \" save header part + +. nr ?T 1 + +.\} + +.ls 1 + +.ch @f -(\\n(_bu+1v) \" set pseudo-trap for bottom line + +.. + +.de TH \" *** end header part of table + +.nr T. 0 + +.T# 0 + +.di + +.nr _i \\n(.i + +.in 0 + +.|h \" put in the initial header + +.in \\n(_iu + +.rr _i + +.mk #T + +.. + +.de TE \" *** table end + +.nr ?T 0 + +.ch @f -\\n(_bu \" reset pseudo-trap + +.ev + +.sp \\n(bsu+\\n(.Lv-1v + +.re + +.rr 31 + +.rr 32 + +.rr 33 + +.rr 34 + +.rr 35 + +.rr 36 + +.rr 37 + +.rr 38 + +.rr 39 + +.rr 40 + +.rr 41 + +.rr 42 + +.rr 43 + +.rr 44 + +.rr 45 + +.rr 46 + +.rr 47 + +.rr 48 + +.rr 49 + +.rr 50 + +.rr 51 + +.rr 52 + +.rr 53 + +.rr 54 + +.rr 55 + +.rr 56 + +.rr 57 + +.rr 58 + +.rr 59 + +.rr 60 + +.rr 61 + +.rr 62 + +.rr 63 + +.rr 64 + +.rr 65 + +.rr 66 + +.rr 67 + +.rr 68 + +.rr 69 + +.rr 70 + +.rr 71 + +.rr 72 + +.rr 73 + +.rr 74 + +.rr 75 + +.rr 76 + +.rr 77 + +.rr 78 + +.rr 79 + +.rr 80 + +.rr 81 + +.rr 82 + +.rr 83 + +.rr 84 + +.rr 85 + +.rr 86 + +.rr 87 + +.rr 88 + +.rr 89 + +.rr 90 + +.rr 91 + +.rr 92 + +.rr 93 + +.rr 94 + +.rr 95 + +.rr 96 + +.rr 97 + +.rr 98 + +.rr 99 + +.rr #I + +.rr #T + +.rr #a + +.rr ## + +.rr #- + +.rr #^ + +.rr T. + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/src/thesis.me index 0000000000,01eff785ab,0000000000..11d5fd4e31 mode 000000,100644,000000..100644 --- a/usr/lib/me/src/thesis.me +++ b/usr/lib/me/src/thesis.me @@@@ -1,0 -1,18 -1,0 +1,19 @@@@ + +.nr _0 \n(c. + +.\" Setup for thesis. + +.\" This file should be modified to keep up with the standard + +.\" for a doctoral thesis at Berkeley. Other macros which may + +.\" be useful for a thesis are defined here. - .\" %beginstrip% +++.\" @(#)thesis.me 2.1 8/18/80 +++.\" %beginstrip% + +.nr tf 1 \" set titles in Roman + +.he '''%' + +.if n .if \n(_o \ + +. po 1.5i + +.if t .po 1.125i \" + .5 inch (off 8i paper roll) = 1.5i + +.ll 5.75i \" allow 1/4 inch fudge + +.if n .if 1n=0.1i \ + +. ll 5.8i \" make it even character amount + +.m1 1i + +.nr ?t 1 + +.ls 2 + +.nr c. \n(_0 diff --cc usr/lib/me/src/tmac.e index 0000000000,30e187b78a,0000000000..df83710e47 mode 000000,100644,000000..100644 --- a/usr/lib/me/src/tmac.e +++ b/usr/lib/me/src/tmac.e @@@@ -1,0 -1,1028 -1,0 +1,1042 @@@@ + +.nr _0 \n(.c + +.\"********************************************************************** + +.\"* * + +.\"* ****** - M E N R O F F / T R O F F M A C R O S ****** * + +.\"* * + +.\"* Produced for your edification and enjoyment by: * + +.\"* Eric Allman * + +.\"* Electronics Research Laboratory * + +.\"* U.C. Berkeley. * + +.\"* * - .\"* VERSION 1.1 First Release: 11 Sept 1978 * +++.\"* VERSION 2.8 First Release: 11 Sept 1978 * + +.\"* See file \*(||/revisions for revision history * + +.\"* * + +.\"* Documentation is available. * + +.\"* * + +.\"********************************************************************** - .\" %beginstrip% +++.\" +++.\" @(#)tmac.e 2.8 11/10/80 +++.\" %beginstrip% + +.\" + +.\" Code on .de commands: + +.\" *** a user interface macro. + +.\" &&& a user interface macro which is redefined + +.\" when used to be the real thing. + +.\" $$$ a macro which may be redefined by the user + +.\" to provide variant functions. + +.\" --- an internal macro. + +.\" + +.if !\n(.V .tm You are using the wrong version of NROFF/TROFF!! + +.if !\n(.V .tm This macro package works only on the version seven + +.if !\n(.V .tm release of NROFF and TROFF. + +.if !\n(.V .ex + +.if \n(pf \ + +. nx \*(||/null.me + +.\" *** INTERNAL GP MACROS *** + +.de @C \" --- change ev's, taking info with us + +.nr _S \\n(.s + +.nr _V \\n(.v + +.nr _F \\n(.f + +.nr _I \\n(.i + +.ev \\$1 + +.ps \\n(_Su + +.vs \\n(_Vu + +.ft \\n(_F + +'in \\n(_Iu + +.xl \\n($lu + +.lt \\n($lu + +.rr _S + +.rr _V + +.rr _F + +.rr _I + +.ls 1 + +'ce 0 + +.. + +.de @D \" --- determine display type (Indent, Left, Center) + +.ds |p "\\$3 + +.nr _d \\$1 + +.ie "\\$2"C" \ + +. nr _d 1 + +.el .ie "\\$2"L" \ + +. nr _d 2 + +.el .ie "\\$2"I" \ + +. nr _d 3 + +.el .ie "\\$2"M" \ + +. nr _d 4 + +.el \ + +. ds |p "\\$2 + +.. + +.de @z \" --- end macro + +.if !"\\n(.z"" \ + +\{\ + +. tm Line \\n(c. -- Unclosed block, footnote, or other diversion (\\n(.z) + +. di + +. ex + +.\} + +.if \\n(?a \ + +. bp \" force out final table + +.rm bp + +.rm @b \" don't start another page + +.if t \ + +. wh -1p @m + +.br + +.. + +.de @I \" --- initialize processor + +.rm th + +.rm ac + +.rm lo + +.rm sc + +.rm @I + +.. + +.\" *** STANDARD HEADERS AND FOOTERS *** + +.de he \" *** define header + +.ie !\\n(.$ \ + +\{\ + +. rm |4 + +. rm |5 + +.\} + +.el \ + +\{\ + +. ds |4 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +. ds |5 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.\} + +.. + +.de eh \" *** define even header + +.ie !\\n(.$ \ + +. rm |4 + +.el \ + +. ds |4 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de oh \" *** define odd header + +.ie !\\n(.$ \ + +. rm |5 + +.el \ + +. ds |5 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de fo \" *** define footer + +.ie !\\n(.$ \ + +\{\ + +. rm |6 + +. rm |7 + +.\} + +.el \ + +\{\ + +. ds |6 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +. ds |7 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.\} + +.. + +.de ef \" *** define even foot + +.ie !\\n(.$ \ + +. rm |6 + +.el \ + +. ds |6 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de of \" *** define odd footer + +.ie !\\n(.$ \ + +. rm |7 + +.el \ + +. ds |7 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de ep \" *** end page (must always be followed by a .bp) + +.if \\n(nl>0 \ + +\{\ + +. wh 0 + +. rs + +. @b + +.\} + +.. + +.\" *** INTERNAL HEADER AND FOOTER MACROS *** + +.de @h \" --- header - .if \n@>0 .tm >> @h %=\\n% ?a=\\n(?a ?b=\\n(?b +++.if \n@>0 .tm >> @h %=\\n% ?a=\\n(?a ?b=\\n(?b ?w=\\n(?w + +.if (\\n(.i+\\n(.o)>=\\n(.l \ + +. tm Line \\n(c. -- Offset + indent exceeds line length + +.if t .if (\\n(.l+\\n(.o)>7.75i \ + +. tm Line \\n(c. -- Offset + line length exceeds paper width + +.\" initialize a pile of junk + +.nr ?h \\n(?H \" transfer "next page" to "this page" + +.rr ?H + +.nr ?c \\n(?C + +.rr ?C + +.rn |4 |0 + +.rn |5 |1 + +.rn |6 |2 + +.rn |7 |3 + +.nr _w 0 \" reset max footnote width +++.nr ?W 0 \" no wide floats this page (yet) + +.nr ?I 1 + +.\" begin actual header stuff + +.ev 2 + +.rs + +.if t .@m \" output cut mark + +.if \\n(hm>0 \ + +. sp |\\n(hmu \" move to header position + +.if \\n($T=2 \\!. + +.@t $h \" output header title + +.if \\n(tm<=0 \ + +. nr tm \n(.Vu + +.sp |\\n(tmu \" move to top of text + +.ev + +.mk _k \" for columned output + +.if \\n(?n .nm 1 \" restore line numbering if n1 mode + +.nr $c 1 \" set first column + +.if \n@>4 .tm -- @h >> .ns nl=\\n(nl %=\\n% _k=\\n(_k tm=\\n(tm + +.ie \\n(?s \ + +\{\ + +. rr ?s + +. rs + +' @b + +.\} + +.el \ + +. @n \" begin the column + +.if \n@>1 .tm << @h + +.. + +.de @m \" --- output cut mark + +.@O 0 + +.lt 7.5i + +.tl '\(rn''\(rn' + +.@O + +.lt + +.. + +.de @n \" --- new column or page + +.if \n@>3 .tm >> @n nl=\\n(nl %=\\n% ?f=\\n(?f ?o=\\n(?o + +.if \\n(bm<=0 \ + +. nr bm \\n(.Vu - .if \\n(_w<=\\n($l \ +++.if (\\n(_w<=\\n($l)&(\\n(?W=0) \ + +\{\ + +. nr _b (\\n(ppu*\\n($ru)/2u \" compute fudge factor (must be < 1P) + +. if \\n(_bu>((\\n(bmu-\\n(fmu-(\\n(tpu*\\n($ru))/2u) \ + +. nr _b (\\n(ppu*\\n($ru)-\n(.Vu + +. nr _b +\\n(bmu + +.\} + +.nr _B \\n(_bu + +.ch @f + +.wh -\\n(_bu @f + +.nr ?f 0 \" reset footnote flag + +.if \\n(?o \ + +\{\ + +. (f _ \" reprocess footnotes which run off page + +. nf + +. |o + +. fi + +. )f + +. rm |o + +.\} + +.nr ?o 0 + +.if \\n(?T \ + +\{\ + +. nr _i \\n(.i + +. in \\n($iu + +. |h \" output the table header + +. in \\n(_iu + +. rr _i + +. mk #T \" for tbl commands + +. ns + +.\} - .if \\n(?a \ +++.if (\\n(?a)&((\\n($c<2):(\\n(?w=0)) \ + +\{\ + +. nr ?a 0 \" output floating keep + +. @k |t +++. if \\n(?w \ +++. mk _k \" don't overstrike wide keeps +++. nr ?w 0 + +.\} + +.os + +.$H \" special column header macro + +.ns + +.. + +.de @f \" --- footer + +.if \n@>0 .tm >> @f %=\\n% nl=\\n(nl ?a=\\n(?a ?b=\\n(?b + +.ec + +.if \\n(?T \ + +\{\ + +. nr T. 1 \" for tbl commands (to output bottom line) + +. T# 1 \" output the sides and bottom lines + +. br + +.\} + +.ev 2 + +.ce 0 + +.if \\n(?b \ + +\{\ + +. nr ?b 0 + +. @k |b \" output bottom of page tables + +.\} + +.if \\n(?f \ + +. @o \" output footnote if present + +.ie \\n($c<\\n($m \ + +. @c \" handle new column + +.el \ + +. @e \" new page + +.ev + +.if \n@>2 .tm << @f + +.. + +.de @o \" --- output footnote + +.nf + +.ls 1 + +.in 0 + +.wh -\\n(_Bu @r + +.|f + +.fi + +.if \\n(?o \ + +. di \" just in case triggered @r + +. if \\n(dn=0 \ + +\{\ + +. rm |o + +. nr ?o 0 + +. \} + +. nr dn \\n(_D + +. rr _D + +.\} + +.rm |f + +.ch @r + +.. + +.de @c \" --- new column + +.if \n@>2 .tm >> @c %=\\n% + +.rs + +.sp |\\n(_ku + +.@O +\\n($lu+\\n($su + +.nr $c +1 + +.@n + +.. + +.de @e \" --- end page + +.if \n@>2 .tm >> @e + +.@O \\n(_ou + +.rs + +.sp |\\n(.pu-\\n(fmu-(\\n(tpu*\\n($ru) \" move to footer position + +.@t $f \" output footer title + +.nr ?h 0 + +.bp + +.. + +.de @t \" --- output header or footer title + +.if !\\n(?h \ + +\{\ + +. sz \\n(tp \" set header/footer type fonts, etc. + +. @F \\n(tf + +. lt \\n(_Lu \" make title span entire page + +. nf + +. \\$1 + +. br + +.\} + +.. + +.de $h \" $$$ print header + +.rm |z + +.if !\\n(?c \ + +\{\ + +. if e .ds |z "\\*(|0 + +. if o .ds |z "\\*(|1 + +.\} + +.if !\(ts\\*(|z\(ts\(ts \ + +' tl \\*(|z + +.rm |z + +.. + +.de $f \" $$$ print footer + +.rm |z + +.if \\n(?c \ + +\{\ + +. if e .ds |z "\\*(|0 + +. if o .ds |z "\\*(|1 + +.\} + +.if \(ts\\*(|z\(ts\(ts \ + +\{\ + +. if e .ds |z "\\*(|2 + +. if o .ds |z "\\*(|3 + +.\} + +.if !\(ts\\*(|z\(ts\(ts \ + +' tl \\*(|z + +.rm |z + +.. + +.de @r \" --- reprocess overflow footnotes + +.if \n@>3 .tm >> @r .z=\\n(.z ?f=\\n(?f ?a=\\n(?a ?b=\\n(?b _b=\\n(_b + +.di |o \" save overflow footnote + +.nr ?o 1 + +.nr _D \\n(dn + +.ns + +.. + +.\" *** COMMANDS WITH VARIANT DEFINITIONS *** + +.rn bp @b \" --- begin page + +.de bp \" *** begin new page (overrides columns) + +.nr $c \\n($m \" force new page, not new column + +.ie \\n(nl>0 \ + +. @b \\$1 + +.el \ + +\{\ + +. if \\n(.$>0 \ + +. pn \\$1 + +. if \\n(?I \ + +. @h \" 'spring' the header trap + +.\} + +.br + +.wh 0 @h \" reset header + +.. + +.rn ll xl \" *** special line length (local) + +.de ll \" *** line length (global to environments) + +.xl \\$1 + +.lt \\$1 + +.nr $l \\n(.l + +.if (\\n($m<=1):(\\n($l>\\n(_L) \ + +. nr _L \\n(.l + +.. + +.rn po @O \" --- local page offset + +.de po \" *** page offset + +.@O \\$1 + +.nr _o \\n(.o + +.. + +.\" *** MISCELLANEOUS ROFF COMMANDS *** + +.de hx \" *** suppress headers and footers next page + +.nr ?H 1 + +.. + +.de ix \" *** indent, no break + +'in \\$1 + +.. + +.de bl \" *** contiguous blank lines + +.br + +.ne \\$1 + +.rs + +.sp \\$1 + +.. + +.de n1 \" *** line numbering 1 + +.nm 1 + +.xl -\w'0000'u + +.nr ?n 1 + +.. + +.de n2 \" *** line numbering 2 + +.nm \\$1 + +.ie \\n(.$ \ + +. xl -\w'0000'u + +.el \ + +. xl \\n($lu + +.. + +.de pa \" *** new page + +.bp \\$1 + +.. + +.de ro \" *** roman page numbers + +.af % i + +.. + +.de ar \" *** arabic page numbers + +.af % 1 + +.. + +.de m1 \" *** position one space + +.nr _0 \\n(hmu + +.nr hm \\$1v + +.nr tm +\\n(hmu-\\n(_0u + +.rr _0 + +.. + +.de m2 \" *** position two space + +.nr tm \\n(hmu+\\n(tpp+\\$1v + +.. + +.de m3 \" *** position three space + +.nr bm \\n(fmu+\\n(tpp+\\$1v + +.. + +.de m4 \" *** position four space + +.nr _0 \\n(fmu + +.nr fm \\$1v + +.nr bm +\\n(fmu-\\n(_0u + +.. + +.de sk \" *** leave a blank page (next page) + +.if \\n(.$>0 \ + +. tm Line \\n(c. -- I cannot skip multiple pages + +.nr ?s 1 + +.. + +.\" *** MISCELLANEOUS USER SUPPORT COMMANDS *** + +.de re \" *** reset tabs (TROFF defines 15 stops default) + +.ta 0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i + +.. + +.if t .ig + +.de re \" *** reset tabs (NROFF version) + +.ta 0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i + +.. + +.de ba \" *** set base indent + +.ie \\n(.$ \ + +. nr $i \\$1n + +.el \ + +. nr $i \\n(siu*\\n($0u + +.. + +.de hl \" *** draw horizontal line + +.br + +\l'\\n(.lu-\\n(.iu' + +.sp + +.. + +.\" *** PARAGRAPHING *** + +.de pp \" *** paragraph + +.lp \\n(piu + +.. + +.de lp \" *** left aligned paragraph + +.@p + +.if \\n(.$ \ + +. ti +\\$1 + +.nr $p 0 1 + +.. + +.de ip \" *** indented paragraph w/ optional tag + +.if (\\n(ii>0)&(\\n(ii<1n) \ + +. nr ii \\n(iin + +.nr _0 \\n(ii + +.if \\n(.$>1 \ + +. nr _0 \\$2n + +.@p \\n(_0u + +.if \\w"\\$1" \ + +\{\ + +. ti -\\n(_0u + +. ie \\w"\\$1">=\\n(_0 \ + +\{\ + +\&\\$1 + +. br + +. \} + +. el \&\\$1\h'|\\n(_0u'\c + +.\} + +.rr _0 + +.. + +.de np \" *** numbered paragraph + +.nr $p +1 + +.ip (\\n($p) + +.. + +.de @p \" --- initialize for paragraph + +.@I \" initialize macro processor + +.if "\\n(.z"|e" .tm Line \\n(c. -- Unmatched continued equation + +.in \\n($iu+\\n(pou + +.if \\n(.$ \ + +. in +\\$1n + +.ce 0 + +.fi + +.@F \\n(pf + +.sz \\n(ppu + +.sp \\n(psu + +.ne \\n(.Lv+\\n(.Vu + +.ns + +.. + +.\" *** SECTION HEADINGS *** + +.de sh \" &&& section heading + +.rn sh @T + +.so \\*(||/sh.me + +.sh "\\$1" "\\$2" \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 + +.rm @T + +.. + +.de $p \" $$$ print section heading + +.if (\\n(si>0)&(\\n(.$>2) \ + +. nr $i \\$3*\\n(si + +.in \\n($iu + +.ie !"\\$1\\$2"" \ + +\{\ + +. sp \\n(ssu \" one of them is non-null + +. ne \\n(.Lv+\\n(.Vu+\\n(psu+(\\n(spu*\\n($ru*\\n(.Lu) + +. ie \\n(.$>2 \ + +. ti -(\\n(siu-\\n(sou) + +. el \ + +. ti +\\n(sou + +. @F \\n(sf + +. sz \\n(spu + +. if \\$3>0 \ + +. $\\$3 + +. if \w"\\$2">0 \\$2. + +. if \w"\\$1">0 \\$1\f1\ \ \" + +.\} + +.el \ + +. sp \\n(psu + +.@F \\n(pf + +.sz \\n(ppu + +.. + +.de uh \" *** unnumbered section heading + +.rn uh @T + +.so \\*(||/sh.me + +.uh "\\$1" + +.rm @T + +.. + +.\" *** COLUMNNED OUTPUT *** + +.de 2c \" *** double columned output + +.br + +.if \\n($m>1 \ + +. 1c \" revert to 1c if already 2c + +.nr $c 1 + +.nr $m 2 + +.if \\n(.$>1 \ + +. nr $m \\$2 + +.if \\n(.$>0 \ + +. nr $s \\$1n \" param 1: column seperation + +.nr $l (\\n(.l-((\\n($m-1)*\\n($s))/\\n($m + +.xl \\n($lu + +.mk _k + +.ns + +.. + +.de 1c \" *** single columned output + +.br + +.nr $c 1 + +.nr $m 1 + +.ll \\n(_Lu \" return to normal output + +.sp |\\n(.hu + +.@O \\n(_ou + +.. + +.de bc \" *** begin column + +.sp 24i + +.. + +.\" *** FLOATING TABLES AND NONFLOATING BLOCKS *** + +.de (z \" &&& begin floating keep - .rn (z @T +++.rn (z @V + +.so \\*(||/float.me + +.(z \\$1 \\$2 - .rm @T +++.rm @V + +.. + +.de )z \" &&& end floating keep + +.tm Line \\n(c. -- unmatched .)z + +.. + +.de (t \" XXX temp ref to (z + +.(z \\$1 \\$2 + +.. + +.de )t \" XXX temp ref to )t + +.)z \\$1 \\$2 + +.. + +.de (b \" *** begin block + +.br + +.@D 3 \\$1 \\$2 + +.sp \\n(bsu + +.@( + +.. + +.de )b \" *** end block + +.br + +.@) + +.if (\\n(bt=0):(\\n(.t<\\n(bt) \ + +. ne \\n(dnu \" make it all on one page + +.ls 1 + +.nf + +.|k + +.ec + +.fi + +.in 0 + +.xl \\n($lu + +.ev + +.rm |k + +.sp \\n(bsu+\\n(.Lv-1v + +.. + +.de @( \" --- begin keep + +.if !"\\n(.z"" .tm Line \\n(c. -- Illegal nested keep \\n(.z + +.@M + +.di |k + +\!'rs + +.. + +.de @M \" --- set modes for display + +.nr ?k 1 + +.@C 1 + +.@F \\n(df + +.vs \\n(.su*\\n($Ru + +.nf + +.if "\\*(|p"F" \ + +. fi \" set fill mode if "F" parameter + +.if \\n(_d=4 \ + +. in 0 + +.if \\n(_d=3 \ + +\{\ + +. in +\\n(biu + +. xl -\\n(biu + +.\} + +.if \\n(_d=1 \ + +. ce 10000 + +.. + +.de @) \" --- end keep + +.br + +.if !"\\n(.z"|k" .tm Line \\n(c. -- Close of a keep which has never been opened + +.nr ?k 0 + +.di + +.in 0 + +.ce 0 + +.. + +.de (c \" *** begin block centered text + +.if "\\n(.z"|c" .tm Line \\n(c. -- Nested .(c requests + +.di |c + +.. + +.de )c \" *** end block centered text + +.if !"\\n(.z"|c" .tm Line \\n(c. -- Unmatched .)c +++.br \" force out final line + +.di + +.if \n@>4 .tm >> .)c .l=\\n(.l .i=\\n(.i $i=\\n($i dl=\\n(dl + +.ev 1 + +.ls 1 + +.in (\\n(.lu-\\n(.iu-\\n(dlu)/2u + +.if \n@>4 .tm -- .)c << .in .l=\\n(.l .i=\\n(.i dl=\\n(dl + +.nf + +.|c + +.ec + +.in + +.ls + +.ev + +.rm |c + +.. + +.\" *** BLOCK QUOTES (OR WHATEVER) AND LISTS *** + +.de (q \" *** begin block quote + +.br + +.@C 1 + +.fi + +.sp \\n(qsu + +.in +\\n(qiu + +.xl -\\n(qiu + +.sz \\n(qp + +.. + +.de )q \" *** end block quote + +.br + +.ev + +.sp \\n(qsu+\\n(.Lv-1v + +.nr ?k 0 + +.. + +.de (l \" *** begin list + +.br + +.sp \\n(bsu + +.@D 3 \\$1 \\$2 + +.@M + +.. + +.de )l \" *** end list + +.br + +.ev + +.sp \\n(bsu+\\n(.Lv-1v + +.nr ?k 0 + +.. + +.\" *** PREPROCESSOR SUPPORT *** + +.de EQ \" &&& begin equation + +.rn EQ @T + +.so \\*(||/eqn.me + +.EQ \\$1 \\$2 + +.rm @T + +.. + +.de TS \" &&& begin table - .rn TS @T +++.rn TS @W + +.so \\*(||/tbl.me + +.TS \\$1 \\$2 - .rm @T +++.rm @W + +.. + +.\" *** FONT AIDS *** + +.de sz \" *** set point size and vertical spacing + +.ps \\$1 + +.vs \\n(.su*\\n($ru \" default vs at pointsize + 20% + +.bd S B \\n(.su/3u + +.. + +.de r \" *** enter roman font + +.nr _F \\n(.f + +.ul 0 + +.ft 1 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.rr _F + +.. + +.de i \" *** enter italic + +.nr _F \\n(.f + +.ul 0 + +.ft 2 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.rr _F + +.. + +.de b \" *** enter boldface (underline in NROFF) + +.nr _F \\n(.f + +.ul 0 + +.ie t \ + +. ft 3 + +.el \ + +. ul 10000 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.if \\n(.$ \ + +. ul 0 + +.rr _F + +.. + +.de rb \" *** enter real boldface (not underlined in NROFF) + +.nr _F \\n(.f + +.ul 0 + +.ft 3 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.rr _F + +.. + +.de u \" *** enter underlined word + +\&\\$1\l'|0\(ul'\\$2 + +.. + +.de q \" *** enter quoted word + +\&\\*(lq\\$1\\*(rq\\$2 + +.. + +.de bi \" *** enter word in bold italics + +.ft 2 + +.ie t \&\k~\\$1\h'|\\n~u+(\\n(.su/3u)'\\$1\fP\\$2 + +.el \&\\$1\fP\\$2 + +.. + +.de bx \" *** enter boxed word + +.ie \\n($T \&\f2\\$1\fP\\$2 + +.el \k~\(br\|\\$1\|\(br\l'|\\n~u\(rn'\l'|\\n~u\(ul'\^\\$2 + +.. + +.de @F \" --- change font (8 -> underlined, 0 -> no change) + +.nr ~ \\$1 + +.if \\n~>0 \ + +\{\ + +. ul 0 + +. ie \\n~>4 \ + +\{\ + +. if n .ul 10000 + +. if t .ft 3 + +. \} + +. el \ + +. ft \\n~ + +.\} + +.rr ~ + +.. + +.\" *** FOOTNOTING *** + +.de (f \" &&& begin footnote - .rn (f @T +++.rn (f @U + +.so \\*(||/footnote.me + +.(f \\$1 \\$2 - .rm @T +++.rm @U + +.. + +.de )f \" &&& end footnote + +.tm Line \\n(c. -- unmatched .)f + +.. + +.de $s \" $$$ footnote separator + +\l'2i' + +.if n \ + +. sp 0.3 + +.. + +.\" *** DELAYED TEXT *** + +.de (d \" &&& begin delayed text - .rn (d @T +++.rn (d @U + +.so \\*(||/deltext.me + +.(d \\$1 \\$2 - .rm @T +++.rm @U + +.. + +.de )d \" &&& end delayed text + +.tm Line \\n(c. -- unmatched .)d + +.. + +.\" *** INDEXES (TABLE OF CONTENTS) *** + +.de (x \" &&& begin index - .rn (x @T +++.rn (x @U + +.so \\*(||/index.me + +.(x \\$1 \\$2 - .rm @T +++.rm @U + +.. + +.de )x \" &&& end index entry + +.tm Line \\n(c. -- unmatched .)x + +.. + +.\" *** STUFF FOR "STANDARD" PAPERS *** + +.de th \" *** set "thesis" mode + +.so \\*(||/thesis.me + +.rm th + +.. + +.de +c \" *** begin chapter + +.ep \" force out footnotes + +.if \\n(?o:\\n(?a \ + +\{\ + +. bp \" force out a table or more footnote + +. rs + +. ep + +.\} + +.nr ?C 1 + +.nr $f 1 1 + +.ds * \\*[1\\*]\k* + +.if \\n(?R \ + +. pn 1 + +.bp + +.in \\n($iu \" reset the indent + +.rs + +.ie \\n(.$ \ + +. $c "\\$1" + +.el \ + +. sp 3 + +.. + +.de ++ \" *** declare chapter type + +.nr _0 0 + +.if "\\$1"C" \ + +. nr _0 1 \" chapter + +.if "\\$1"RC" \ + +. nr _0 11 \" renumbered chapter + +.if "\\$1"A" \ + +. nr _0 2 \" appendix + +.if "\\$1"RA" \ + +. nr _0 12 \" renumbered appendix + +.if "\\$1"P" \ + +. nr _0 3 \" preliminary material + +.if "\\$1"B" \ + +. nr _0 4 \" bibliographic material + +.if "\\$1"AB" \ + +. nr _0 5 \" abstract + +.if \\n(_0=0 \ + +. tm Line \\n(c. -- Bad mode to .++ + +.nr ?R 0 + +.if \\n(_0>10 \ + +.\{ + +. nr ?R 1 + +. nr _0 -10 + +.\} + +.nr ch 0 1 + +.if (\\n(_0=3):(\\n(_0=5) \ + +. pn 1 \" must do before .ep + +.ep \" end page for correct page number types + +.if \\n(_0=1 \ + +\{\ + +. af ch 1 + +. af % 1 + +.\} + +.if \\n(_0=2 \ + +\{\ + +. af ch A + +. af % 1 + +.\} + +.if \\n(_0=3 \ + +. af % i + +.if \\n(_0=4 \ + +. af % 1 + +.if \\n(_0=5 \ + +. af % 1 + +.if \\n(.$>1 \ + +. he \\$2 + +.if !\\n(_0=\\n(_M .if \\n(_M=3 \ + +. pn 1 + +.nr _M \\n(_0 + +.rr _0 + +.. + +.de $c \" $$$ print chapter title + +.sz 12 + +.ft B + +.ce 1000 + +.if \\n(_M<3 \ + +. nr ch +1 + +.ie \\n(_M=1 CHAPTER\ \ \\n(ch + +.el .if \\n(_M=2 APPENDIX\ \ \\n(ch + +.if \w"\\$1" .sp 3-\\n(.L + +.if \w"\\$1" \\$1 + +.if (\\n(_M<3):(\w"\\$1") \ + +. sp 4-\\n(.L + +.ce 0 + +.ft + +.sz + +.ie \\n(_M=1 \ + +. $C Chapter \\n(ch "\\$1" + +.el .if \\n(_M=2 \ + +. $C Appendix \\n(ch "\\$1" + +.. + +.de tp \" *** title page + +.hx + +.bp + +.br + +.rs + +.pn \\n% + +.. + +.de ac \" *** setup for ACM photo-ready paper + +.rn ac @T + +.so \\*(||/acm.me + +.ac "\\$1" "\\$2" + +.rm @T + +.. + +.de lo \" *** pull in the set of local macros + +.\" all these macros should be named "*X", where X is any letter + +.so \\*(||/local.me + +.rm lo + +.. + +.\" *** DATES *** + +.if \n(mo=1 .ds mo January + +.if \n(mo=2 .ds mo February + +.if \n(mo=3 .ds mo March + +.if \n(mo=4 .ds mo April + +.if \n(mo=5 .ds mo May + +.if \n(mo=6 .ds mo June + +.if \n(mo=7 .ds mo July + +.if \n(mo=8 .ds mo August + +.if \n(mo=9 .ds mo September + +.if \n(mo=10 .ds mo October + +.if \n(mo=11 .ds mo November + +.if \n(mo=12 .ds mo December + +.if \n(dw=1 .ds dw Sunday + +.if \n(dw=2 .ds dw Monday + +.if \n(dw=3 .ds dw Tuesday + +.if \n(dw=4 .ds dw Wednesday + +.if \n(dw=5 .ds dw Thursday + +.if \n(dw=6 .ds dw Friday + +.if \n(dw=7 .ds dw Saturday + +.ds td \*(mo \n(dy, 19\n(yr + +.\" *** PARAMETRIC INITIALIZATIONS *** + +.if (1m<0.1i)&(\nx!=0) \ + +. vs 9p \" for 12-pitch DTC terminals + +.rr x + +.nr $r \n(.v/\n(.s \" ratio of vs to ps for .sz request + +.nr $R \n($r \" ratio for displays & footnotes + +.nr hm 4v \" header margin + +.nr tm 7v \" top margin + +.nr bm 6v \" bottom margin + +.nr fm 3v \" footer margin + +.nr tf 3 \" title font: (real) Times Bold + +.nr tp 10 \" title point size + +.hy 14 + +.nr bi 4n \" indent for blocks + +.nr pi 5n \" indent for paragraphs + +.nr pf 1 \" normal text font + +.nr pp 10 \" normal text point size + +.nr qi 4n \" indent for quotes + +.nr qp -1 \" down one point + +.nr ii 5n \" indent for .ip's and .np's + +.nr $m 1 \" max number of columns + +.nr $s 4n \" column separation + +.ds || /usr/lib/me + +.if \n@>0 .ds || . + +.bd S B 3 + +.\" *** OTHER INITIALIZATION *** + +.ds [ \u\x'-0.25v' + +.ds ] \d + +.ds < \d\x'0.25v' + +.ds > \u + +.ds - -- + +.if t \ + +\{\ + +. ds [ \v'-0.4m'\x'-0.2m'\s-3 + +. ds ] \s0\v'0.4m' + +. ds < \v'0.4m'\x'0.2m'\s-3 + +. ds > \s0\v'-0.4m' + +. ds - \- +++. nr fi 0.3i +++.\} +++.if n \ +++\{\ +++. nr fi 3n + +.\} + +.nr _o \n(.o + +.if n .po 1i + +.if \n(.V=1v \ + +. nr $T 2 + +.if \n(.T=0 \ + +. nr $T 1 + +.if t \ + +\{\ + +. nr $T 0 + +. po -0.5i \" make ugly line on LHS + +.\} +++.if \nv \ +++. po 1i \" for vtroff + +.if \n($T \ + +\{\ + +. if \n($T=1 \ + +. po 0 + +. ds [ [ + +. ds ] ] + +. ds < < + +. ds > > + +.\} + +.nr ps 0.5v \" paragraph pre/post spacing + +.if \n($T \ + +. nr ps 1v + +.if t .nr ps 0.35v + +.nr bs \n(ps \" block pre/post spacing + +.nr qs \n(ps \" quote pre/post spacing + +.nr zs 1v \" float-block pre/postspacing + +.nr xs 0.2v \" index prespacing + +.nr fs 0.2v \" footnote prespacing + +.if \n($T \ + +. nr fs 0 + +.if n .nr es 1v \" equation pre/postspacing + +.if t .nr es 0.5v + +.wh 0 @h \" set header + +.nr $l \n(.lu \" line length + +.nr _L \n(.lu \" line length of page + +.nr $c 1 \" current column number + +.nr $f 1 1 \" footnote number + +.ds * \*[1\*]\k*\" \" footnote "name" + +.nr $d 1 1 \" delayed text number + +.ds # [1]\k#\" \" delayed text "name" + +.nr _M 1 \" chapter mode is chapter + +.ds lq \&"\" \" left quote + +.ds rq \&"\" \" right quote + +.if t \ + +. ds lq `` + +.if t \ + +. ds rq '' + +.em @z + +.\" *** FOREIGN LETTERS AND SPECIAL CHARACTERS *** + +.de sc \" *** define special characters + +.so \\*(||/chars.me + +.rm sc + +.. + +.ll 6.0i + +.lt 6.0i diff --cc usr/lib/me/tbl.me index 0000000000,d145fbe5c6,0000000000..3f037c4e97 mode 000000,100644,000000..100644 --- a/usr/lib/me/tbl.me +++ b/usr/lib/me/tbl.me @@@@ -1,0 -1,108 -1,0 +1,109 @@@@ + +.nr _0 \n(c. +++.\" @(#)tbl.me 2.1 8/18/80 + +.\" This version has had comments stripped; an unstripped version is available. + +.de TS + +.sp \\n(bsu + +.@C 1 + +.if "\\$1"H" \ + +\{\ + +. di |h + +. nr ?T 1 + +.\} + +.ls 1 + +.ch @f -(\\n(_bu+1v) + +.. + +.de TH + +.nr T. 0 + +.T# 0 + +.di + +.nr _i \\n(.i + +.in 0 + +.|h + +.in \\n(_iu + +.rr _i + +.mk #T + +.. + +.de TE + +.nr ?T 0 + +.ch @f -\\n(_bu + +.ev + +.sp \\n(bsu+\\n(.Lv-1v + +.re + +.rr 31 + +.rr 32 + +.rr 33 + +.rr 34 + +.rr 35 + +.rr 36 + +.rr 37 + +.rr 38 + +.rr 39 + +.rr 40 + +.rr 41 + +.rr 42 + +.rr 43 + +.rr 44 + +.rr 45 + +.rr 46 + +.rr 47 + +.rr 48 + +.rr 49 + +.rr 50 + +.rr 51 + +.rr 52 + +.rr 53 + +.rr 54 + +.rr 55 + +.rr 56 + +.rr 57 + +.rr 58 + +.rr 59 + +.rr 60 + +.rr 61 + +.rr 62 + +.rr 63 + +.rr 64 + +.rr 65 + +.rr 66 + +.rr 67 + +.rr 68 + +.rr 69 + +.rr 70 + +.rr 71 + +.rr 72 + +.rr 73 + +.rr 74 + +.rr 75 + +.rr 76 + +.rr 77 + +.rr 78 + +.rr 79 + +.rr 80 + +.rr 81 + +.rr 82 + +.rr 83 + +.rr 84 + +.rr 85 + +.rr 86 + +.rr 87 + +.rr 88 + +.rr 89 + +.rr 90 + +.rr 91 + +.rr 92 + +.rr 93 + +.rr 94 + +.rr 95 + +.rr 96 + +.rr 97 + +.rr 98 + +.rr 99 + +.rr #I + +.rr #T + +.rr #a + +.rr ## + +.rr #- + +.rr #^ + +.rr T. + +.. + +.nr c. \n(_0 diff --cc usr/lib/me/thesis.me index 0000000000,8566972b29,0000000000..68cc45b7c5 mode 000000,100644,000000..100644 --- a/usr/lib/me/thesis.me +++ b/usr/lib/me/thesis.me @@@@ -1,0 -1,18 -1,0 +1,19 @@@@ + +.nr _0 \n(c. + +.\" Setup for thesis. + +.\" This file should be modified to keep up with the standard + +.\" for a doctoral thesis at Berkeley. Other macros which may + +.\" be useful for a thesis are defined here. +++.\" @(#)thesis.me 2.1 8/18/80 + +.\" This version has had comments stripped; an unstripped version is available. + +.nr tf 1 + +.he '''%' + +.if n .if \n(_o \ + +. po 1.5i + +.if t .po 1.125i + +.ll 5.75i + +.if n .if 1n=0.1i \ + +. ll 5.8i + +.m1 1i + +.nr ?t 1 + +.ls 2 + +.nr c. \n(_0 diff --cc usr/lib/tmac/tmac.e index 0000000000,e9e619994a,0000000000..2531cbc5da mode 000000,100644,000000..100644 --- a/usr/lib/tmac/tmac.e +++ b/usr/lib/tmac/tmac.e @@@@ -1,0 -1,983 -1,0 +1,997 @@@@ + +.nr _0 \n(.c + +.\"********************************************************************** + +.\"* * + +.\"* ****** - M E N R O F F / T R O F F M A C R O S ****** * + +.\"* * + +.\"* Produced for your edification and enjoyment by: * + +.\"* Eric Allman * + +.\"* Electronics Research Laboratory * + +.\"* U.C. Berkeley. * + +.\"* * - .\"* VERSION 1.1 First Release: 11 Sept 1978 * +++.\"* VERSION 2.8 First Release: 11 Sept 1978 * + +.\"* See file \*(||/revisions for revision history * + +.\"* * + +.\"* Documentation is available. * + +.\"* * + +.\"********************************************************************** +++.\" +++.\" @(#)tmac.e 2.8 11/10/80 + +.\" This version has had comments stripped; an unstripped version is available. + +.if !\n(.V .tm You are using the wrong version of NROFF/TROFF!! + +.if !\n(.V .tm This macro package works only on the version seven + +.if !\n(.V .tm release of NROFF and TROFF. + +.if !\n(.V .ex + +.if \n(pf \ + +. nx \*(||/null.me + +.de @C + +.nr _S \\n(.s + +.nr _V \\n(.v + +.nr _F \\n(.f + +.nr _I \\n(.i + +.ev \\$1 + +.ps \\n(_Su + +.vs \\n(_Vu + +.ft \\n(_F + +'in \\n(_Iu + +.xl \\n($lu + +.lt \\n($lu + +.rr _S + +.rr _V + +.rr _F + +.rr _I + +.ls 1 + +'ce 0 + +.. + +.de @D + +.ds |p "\\$3 + +.nr _d \\$1 + +.ie "\\$2"C" \ + +. nr _d 1 + +.el .ie "\\$2"L" \ + +. nr _d 2 + +.el .ie "\\$2"I" \ + +. nr _d 3 + +.el .ie "\\$2"M" \ + +. nr _d 4 + +.el \ + +. ds |p "\\$2 + +.. + +.de @z + +.if !"\\n(.z"" \ + +\{\ + +. tm Line \\n(c. -- Unclosed block, footnote, or other diversion (\\n(.z) + +. di + +. ex + +.\} + +.if \\n(?a \ + +. bp + +.rm bp + +.rm @b + +.if t \ + +. wh -1p @m + +.br + +.. + +.de @I + +.rm th + +.rm ac + +.rm lo + +.rm sc + +.rm @I + +.. + +.de he + +.ie !\\n(.$ \ + +\{\ + +. rm |4 + +. rm |5 + +.\} + +.el \ + +\{\ + +. ds |4 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +. ds |5 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.\} + +.. + +.de eh + +.ie !\\n(.$ \ + +. rm |4 + +.el \ + +. ds |4 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de oh + +.ie !\\n(.$ \ + +. rm |5 + +.el \ + +. ds |5 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de fo + +.ie !\\n(.$ \ + +\{\ + +. rm |6 + +. rm |7 + +.\} + +.el \ + +\{\ + +. ds |6 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +. ds |7 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.\} + +.. + +.de ef + +.ie !\\n(.$ \ + +. rm |6 + +.el \ + +. ds |6 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de of + +.ie !\\n(.$ \ + +. rm |7 + +.el \ + +. ds |7 "\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + +.. + +.de ep + +.if \\n(nl>0 \ + +\{\ + +. wh 0 + +. rs + +. @b + +.\} + +.. + +.de @h + +.if (\\n(.i+\\n(.o)>=\\n(.l \ + +. tm Line \\n(c. -- Offset + indent exceeds line length + +.if t .if (\\n(.l+\\n(.o)>7.75i \ + +. tm Line \\n(c. -- Offset + line length exceeds paper width + +.nr ?h \\n(?H + +.rr ?H + +.nr ?c \\n(?C + +.rr ?C + +.rn |4 |0 + +.rn |5 |1 + +.rn |6 |2 + +.rn |7 |3 + +.nr _w 0 +++.nr ?W 0 + +.nr ?I 1 + +.ev 2 + +.rs + +.if t .@m + +.if \\n(hm>0 \ + +. sp |\\n(hmu + +.if \\n($T=2 \\!. + +.@t $h + +.if \\n(tm<=0 \ + +. nr tm \n(.Vu + +.sp |\\n(tmu + +.ev + +.mk _k + +.if \\n(?n .nm 1 + +.nr $c 1 + +.ie \\n(?s \ + +\{\ + +. rr ?s + +. rs + +' @b + +.\} + +.el \ + +. @n + +.. + +.de @m + +.@O 0 + +.lt 7.5i + +.tl '\(rn''\(rn' + +.@O + +.lt + +.. + +.de @n + +.if \\n(bm<=0 \ + +. nr bm \\n(.Vu - .if \\n(_w<=\\n($l \ +++.if (\\n(_w<=\\n($l)&(\\n(?W=0) \ + +\{\ + +. nr _b (\\n(ppu*\\n($ru)/2u + +. if \\n(_bu>((\\n(bmu-\\n(fmu-(\\n(tpu*\\n($ru))/2u) \ + +. nr _b (\\n(ppu*\\n($ru)-\n(.Vu + +. nr _b +\\n(bmu + +.\} + +.nr _B \\n(_bu + +.ch @f + +.wh -\\n(_bu @f + +.nr ?f 0 + +.if \\n(?o \ + +\{\ + +. (f _ + +. nf + +. |o + +. fi + +. )f + +. rm |o + +.\} + +.nr ?o 0 + +.if \\n(?T \ + +\{\ + +. nr _i \\n(.i + +. in \\n($iu + +. |h + +. in \\n(_iu + +. rr _i + +. mk #T + +. ns + +.\} - .if \\n(?a \ +++.if (\\n(?a)&((\\n($c<2):(\\n(?w=0)) \ + +\{\ + +. nr ?a 0 + +. @k |t +++. if \\n(?w \ +++. mk _k +++. nr ?w 0 + +.\} + +.os + +.$H + +.ns + +.. + +.de @f + +.ec + +.if \\n(?T \ + +\{\ + +. nr T. 1 + +. T# 1 + +. br + +.\} + +.ev 2 + +.ce 0 + +.if \\n(?b \ + +\{\ + +. nr ?b 0 + +. @k |b + +.\} + +.if \\n(?f \ + +. @o + +.ie \\n($c<\\n($m \ + +. @c + +.el \ + +. @e + +.ev + +.. + +.de @o + +.nf + +.ls 1 + +.in 0 + +.wh -\\n(_Bu @r + +.|f + +.fi + +.if \\n(?o \ + +. di + +. if \\n(dn=0 \ + +\{\ + +. rm |o + +. nr ?o 0 + +. \} + +. nr dn \\n(_D + +. rr _D + +.\} + +.rm |f + +.ch @r + +.. + +.de @c + +.rs + +.sp |\\n(_ku + +.@O +\\n($lu+\\n($su + +.nr $c +1 + +.@n + +.. + +.de @e + +.@O \\n(_ou + +.rs + +.sp |\\n(.pu-\\n(fmu-(\\n(tpu*\\n($ru) + +.@t $f + +.nr ?h 0 + +.bp + +.. + +.de @t + +.if !\\n(?h \ + +\{\ + +. sz \\n(tp + +. @F \\n(tf + +. lt \\n(_Lu + +. nf + +. \\$1 + +. br + +.\} + +.. + +.de $h + +.rm |z + +.if !\\n(?c \ + +\{\ + +. if e .ds |z "\\*(|0 + +. if o .ds |z "\\*(|1 + +.\} + +.if !\(ts\\*(|z\(ts\(ts \ + +' tl \\*(|z + +.rm |z + +.. + +.de $f + +.rm |z + +.if \\n(?c \ + +\{\ + +. if e .ds |z "\\*(|0 + +. if o .ds |z "\\*(|1 + +.\} + +.if \(ts\\*(|z\(ts\(ts \ + +\{\ + +. if e .ds |z "\\*(|2 + +. if o .ds |z "\\*(|3 + +.\} + +.if !\(ts\\*(|z\(ts\(ts \ + +' tl \\*(|z + +.rm |z + +.. + +.de @r + +.di |o + +.nr ?o 1 + +.nr _D \\n(dn + +.ns + +.. + +.rn bp @b + +.de bp + +.nr $c \\n($m + +.ie \\n(nl>0 \ + +. @b \\$1 + +.el \ + +\{\ + +. if \\n(.$>0 \ + +. pn \\$1 + +. if \\n(?I \ + +. @h + +.\} + +.br + +.wh 0 @h + +.. + +.rn ll xl + +.de ll + +.xl \\$1 + +.lt \\$1 + +.nr $l \\n(.l + +.if (\\n($m<=1):(\\n($l>\\n(_L) \ + +. nr _L \\n(.l + +.. + +.rn po @O + +.de po + +.@O \\$1 + +.nr _o \\n(.o + +.. + +.de hx + +.nr ?H 1 + +.. + +.de ix + +'in \\$1 + +.. + +.de bl + +.br + +.ne \\$1 + +.rs + +.sp \\$1 + +.. + +.de n1 + +.nm 1 + +.xl -\w'0000'u + +.nr ?n 1 + +.. + +.de n2 + +.nm \\$1 + +.ie \\n(.$ \ + +. xl -\w'0000'u + +.el \ + +. xl \\n($lu + +.. + +.de pa + +.bp \\$1 + +.. + +.de ro + +.af % i + +.. + +.de ar + +.af % 1 + +.. + +.de m1 + +.nr _0 \\n(hmu + +.nr hm \\$1v + +.nr tm +\\n(hmu-\\n(_0u + +.rr _0 + +.. + +.de m2 + +.nr tm \\n(hmu+\\n(tpp+\\$1v + +.. + +.de m3 + +.nr bm \\n(fmu+\\n(tpp+\\$1v + +.. + +.de m4 + +.nr _0 \\n(fmu + +.nr fm \\$1v + +.nr bm +\\n(fmu-\\n(_0u + +.. + +.de sk + +.if \\n(.$>0 \ + +. tm Line \\n(c. -- I cannot skip multiple pages + +.nr ?s 1 + +.. + +.de re + +.ta 0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i +0.5i + +.. + +.if t .ig + +.de re + +.ta 0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i +0.8i + +.. + +.de ba + +.ie \\n(.$ \ + +. nr $i \\$1n + +.el \ + +. nr $i \\n(siu*\\n($0u + +.. + +.de hl + +.br + +\l'\\n(.lu-\\n(.iu' + +.sp + +.. + +.de pp + +.lp \\n(piu + +.. + +.de lp + +.@p + +.if \\n(.$ \ + +. ti +\\$1 + +.nr $p 0 1 + +.. + +.de ip + +.if (\\n(ii>0)&(\\n(ii<1n) \ + +. nr ii \\n(iin + +.nr _0 \\n(ii + +.if \\n(.$>1 \ + +. nr _0 \\$2n + +.@p \\n(_0u + +.if \\w"\\$1" \ + +\{\ + +. ti -\\n(_0u + +. ie \\w"\\$1">=\\n(_0 \ + +\{\ + +\&\\$1 + +. br + +. \} + +. el \&\\$1\h'|\\n(_0u'\c + +.\} + +.rr _0 + +.. + +.de np + +.nr $p +1 + +.ip (\\n($p) + +.. + +.de @p + +.@I + +.if "\\n(.z"|e" .tm Line \\n(c. -- Unmatched continued equation + +.in \\n($iu+\\n(pou + +.if \\n(.$ \ + +. in +\\$1n + +.ce 0 + +.fi + +.@F \\n(pf + +.sz \\n(ppu + +.sp \\n(psu + +.ne \\n(.Lv+\\n(.Vu + +.ns + +.. + +.de sh + +.rn sh @T + +.so \\*(||/sh.me + +.sh "\\$1" "\\$2" \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 + +.rm @T + +.. + +.de $p + +.if (\\n(si>0)&(\\n(.$>2) \ + +. nr $i \\$3*\\n(si + +.in \\n($iu + +.ie !"\\$1\\$2"" \ + +\{\ + +. sp \\n(ssu + +. ne \\n(.Lv+\\n(.Vu+\\n(psu+(\\n(spu*\\n($ru*\\n(.Lu) + +. ie \\n(.$>2 \ + +. ti -(\\n(siu-\\n(sou) + +. el \ + +. ti +\\n(sou + +. @F \\n(sf + +. sz \\n(spu + +. if \\$3>0 \ + +. $\\$3 + +. if \w"\\$2">0 \\$2. + +. if \w"\\$1">0 \\$1\f1\ \ \" + +.\} + +.el \ + +. sp \\n(psu + +.@F \\n(pf + +.sz \\n(ppu + +.. + +.de uh + +.rn uh @T + +.so \\*(||/sh.me + +.uh "\\$1" + +.rm @T + +.. + +.de 2c + +.br + +.if \\n($m>1 \ + +. 1c + +.nr $c 1 + +.nr $m 2 + +.if \\n(.$>1 \ + +. nr $m \\$2 + +.if \\n(.$>0 \ + +. nr $s \\$1n + +.nr $l (\\n(.l-((\\n($m-1)*\\n($s))/\\n($m + +.xl \\n($lu + +.mk _k + +.ns + +.. + +.de 1c + +.br + +.nr $c 1 + +.nr $m 1 + +.ll \\n(_Lu + +.sp |\\n(.hu + +.@O \\n(_ou + +.. + +.de bc + +.sp 24i + +.. + +.de (z - .rn (z @T +++.rn (z @V + +.so \\*(||/float.me + +.(z \\$1 \\$2 - .rm @T +++.rm @V + +.. + +.de )z + +.tm Line \\n(c. -- unmatched .)z + +.. + +.de (t + +.(z \\$1 \\$2 + +.. + +.de )t + +.)z \\$1 \\$2 + +.. + +.de (b + +.br + +.@D 3 \\$1 \\$2 + +.sp \\n(bsu + +.@( + +.. + +.de )b + +.br + +.@) + +.if (\\n(bt=0):(\\n(.t<\\n(bt) \ + +. ne \\n(dnu + +.ls 1 + +.nf + +.|k + +.ec + +.fi + +.in 0 + +.xl \\n($lu + +.ev + +.rm |k + +.sp \\n(bsu+\\n(.Lv-1v + +.. + +.de @( + +.if !"\\n(.z"" .tm Line \\n(c. -- Illegal nested keep \\n(.z + +.@M + +.di |k + +\!'rs + +.. + +.de @M + +.nr ?k 1 + +.@C 1 + +.@F \\n(df + +.vs \\n(.su*\\n($Ru + +.nf + +.if "\\*(|p"F" \ + +. fi + +.if \\n(_d=4 \ + +. in 0 + +.if \\n(_d=3 \ + +\{\ + +. in +\\n(biu + +. xl -\\n(biu + +.\} + +.if \\n(_d=1 \ + +. ce 10000 + +.. + +.de @) + +.br + +.if !"\\n(.z"|k" .tm Line \\n(c. -- Close of a keep which has never been opened + +.nr ?k 0 + +.di + +.in 0 + +.ce 0 + +.. + +.de (c + +.if "\\n(.z"|c" .tm Line \\n(c. -- Nested .(c requests + +.di |c + +.. + +.de )c + +.if !"\\n(.z"|c" .tm Line \\n(c. -- Unmatched .)c +++.br + +.di + +.ev 1 + +.ls 1 + +.in (\\n(.lu-\\n(.iu-\\n(dlu)/2u + +.nf + +.|c + +.ec + +.in + +.ls + +.ev + +.rm |c + +.. + +.de (q + +.br + +.@C 1 + +.fi + +.sp \\n(qsu + +.in +\\n(qiu + +.xl -\\n(qiu + +.sz \\n(qp + +.. + +.de )q + +.br + +.ev + +.sp \\n(qsu+\\n(.Lv-1v + +.nr ?k 0 + +.. + +.de (l + +.br + +.sp \\n(bsu + +.@D 3 \\$1 \\$2 + +.@M + +.. + +.de )l + +.br + +.ev + +.sp \\n(bsu+\\n(.Lv-1v + +.nr ?k 0 + +.. + +.de EQ + +.rn EQ @T + +.so \\*(||/eqn.me + +.EQ \\$1 \\$2 + +.rm @T + +.. + +.de TS - .rn TS @T +++.rn TS @W + +.so \\*(||/tbl.me + +.TS \\$1 \\$2 - .rm @T +++.rm @W + +.. + +.de sz + +.ps \\$1 + +.vs \\n(.su*\\n($ru + +.bd S B \\n(.su/3u + +.. + +.de r + +.nr _F \\n(.f + +.ul 0 + +.ft 1 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.rr _F + +.. + +.de i + +.nr _F \\n(.f + +.ul 0 + +.ft 2 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.rr _F + +.. + +.de b + +.nr _F \\n(.f + +.ul 0 + +.ie t \ + +. ft 3 + +.el \ + +. ul 10000 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.if \\n(.$ \ + +. ul 0 + +.rr _F + +.. + +.de rb + +.nr _F \\n(.f + +.ul 0 + +.ft 3 + +.if \\n(.$ \&\\$1\f\\n(_F\\$2 + +.rr _F + +.. + +.de u + +\&\\$1\l'|0\(ul'\\$2 + +.. + +.de q + +\&\\*(lq\\$1\\*(rq\\$2 + +.. + +.de bi + +.ft 2 + +.ie t \&\k~\\$1\h'|\\n~u+(\\n(.su/3u)'\\$1\fP\\$2 + +.el \&\\$1\fP\\$2 + +.. + +.de bx + +.ie \\n($T \&\f2\\$1\fP\\$2 + +.el \k~\(br\|\\$1\|\(br\l'|\\n~u\(rn'\l'|\\n~u\(ul'\^\\$2 + +.. + +.de @F + +.nr ~ \\$1 + +.if \\n~>0 \ + +\{\ + +. ul 0 + +. ie \\n~>4 \ + +\{\ + +. if n .ul 10000 + +. if t .ft 3 + +. \} + +. el \ + +. ft \\n~ + +.\} + +.rr ~ + +.. + +.de (f - .rn (f @T +++.rn (f @U + +.so \\*(||/footnote.me + +.(f \\$1 \\$2 - .rm @T +++.rm @U + +.. + +.de )f + +.tm Line \\n(c. -- unmatched .)f + +.. + +.de $s + +\l'2i' + +.if n \ + +. sp 0.3 + +.. + +.de (d - .rn (d @T +++.rn (d @U + +.so \\*(||/deltext.me + +.(d \\$1 \\$2 - .rm @T +++.rm @U + +.. + +.de )d + +.tm Line \\n(c. -- unmatched .)d + +.. + +.de (x - .rn (x @T +++.rn (x @U + +.so \\*(||/index.me + +.(x \\$1 \\$2 - .rm @T +++.rm @U + +.. + +.de )x + +.tm Line \\n(c. -- unmatched .)x + +.. + +.de th + +.so \\*(||/thesis.me + +.rm th + +.. + +.de +c + +.ep + +.if \\n(?o:\\n(?a \ + +\{\ + +. bp + +. rs + +. ep + +.\} + +.nr ?C 1 + +.nr $f 1 1 + +.ds * \\*[1\\*]\k* + +.if \\n(?R \ + +. pn 1 + +.bp + +.in \\n($iu + +.rs + +.ie \\n(.$ \ + +. $c "\\$1" + +.el \ + +. sp 3 + +.. + +.de ++ + +.nr _0 0 + +.if "\\$1"C" \ + +. nr _0 1 + +.if "\\$1"RC" \ + +. nr _0 11 + +.if "\\$1"A" \ + +. nr _0 2 + +.if "\\$1"RA" \ + +. nr _0 12 + +.if "\\$1"P" \ + +. nr _0 3 + +.if "\\$1"B" \ + +. nr _0 4 + +.if "\\$1"AB" \ + +. nr _0 5 + +.if \\n(_0=0 \ + +. tm Line \\n(c. -- Bad mode to .++ + +.nr ?R 0 + +.if \\n(_0>10 \ + +.\{ + +. nr ?R 1 + +. nr _0 -10 + +.\} + +.nr ch 0 1 + +.if (\\n(_0=3):(\\n(_0=5) \ + +. pn 1 + +.ep + +.if \\n(_0=1 \ + +\{\ + +. af ch 1 + +. af % 1 + +.\} + +.if \\n(_0=2 \ + +\{\ + +. af ch A + +. af % 1 + +.\} + +.if \\n(_0=3 \ + +. af % i + +.if \\n(_0=4 \ + +. af % 1 + +.if \\n(_0=5 \ + +. af % 1 + +.if \\n(.$>1 \ + +. he \\$2 + +.if !\\n(_0=\\n(_M .if \\n(_M=3 \ + +. pn 1 + +.nr _M \\n(_0 + +.rr _0 + +.. + +.de $c + +.sz 12 + +.ft B + +.ce 1000 + +.if \\n(_M<3 \ + +. nr ch +1 + +.ie \\n(_M=1 CHAPTER\ \ \\n(ch + +.el .if \\n(_M=2 APPENDIX\ \ \\n(ch + +.if \w"\\$1" .sp 3-\\n(.L + +.if \w"\\$1" \\$1 + +.if (\\n(_M<3):(\w"\\$1") \ + +. sp 4-\\n(.L + +.ce 0 + +.ft + +.sz + +.ie \\n(_M=1 \ + +. $C Chapter \\n(ch "\\$1" + +.el .if \\n(_M=2 \ + +. $C Appendix \\n(ch "\\$1" + +.. + +.de tp + +.hx + +.bp + +.br + +.rs + +.pn \\n% + +.. + +.de ac + +.rn ac @T + +.so \\*(||/acm.me + +.ac "\\$1" "\\$2" + +.rm @T + +.. + +.de lo + +.so \\*(||/local.me + +.rm lo + +.. + +.if \n(mo=1 .ds mo January + +.if \n(mo=2 .ds mo February + +.if \n(mo=3 .ds mo March + +.if \n(mo=4 .ds mo April + +.if \n(mo=5 .ds mo May + +.if \n(mo=6 .ds mo June + +.if \n(mo=7 .ds mo July + +.if \n(mo=8 .ds mo August + +.if \n(mo=9 .ds mo September + +.if \n(mo=10 .ds mo October + +.if \n(mo=11 .ds mo November + +.if \n(mo=12 .ds mo December + +.if \n(dw=1 .ds dw Sunday + +.if \n(dw=2 .ds dw Monday + +.if \n(dw=3 .ds dw Tuesday + +.if \n(dw=4 .ds dw Wednesday + +.if \n(dw=5 .ds dw Thursday + +.if \n(dw=6 .ds dw Friday + +.if \n(dw=7 .ds dw Saturday + +.ds td \*(mo \n(dy, 19\n(yr + +.if (1m<0.1i)&(\nx!=0) \ + +. vs 9p + +.rr x + +.nr $r \n(.v/\n(.s + +.nr $R \n($r + +.nr hm 4v + +.nr tm 7v + +.nr bm 6v + +.nr fm 3v + +.nr tf 3 + +.nr tp 10 + +.hy 14 + +.nr bi 4n + +.nr pi 5n + +.nr pf 1 + +.nr pp 10 + +.nr qi 4n + +.nr qp -1 + +.nr ii 5n + +.nr $m 1 + +.nr $s 4n + +.ds || /usr/lib/me + +.bd S B 3 + +.ds [ \u\x'-0.25v' + +.ds ] \d + +.ds < \d\x'0.25v' + +.ds > \u + +.ds - -- + +.if t \ + +\{\ + +. ds [ \v'-0.4m'\x'-0.2m'\s-3 + +. ds ] \s0\v'0.4m' + +. ds < \v'0.4m'\x'0.2m'\s-3 + +. ds > \s0\v'-0.4m' + +. ds - \- +++. nr fi 0.3i +++.\} +++.if n \ +++\{\ +++. nr fi 3n + +.\} + +.nr _o \n(.o + +.if n .po 1i + +.if \n(.V=1v \ + +. nr $T 2 + +.if \n(.T=0 \ + +. nr $T 1 + +.if t \ + +\{\ + +. nr $T 0 + +. po -0.5i + +.\} +++.if \nv \ +++. po 1i + +.if \n($T \ + +\{\ + +. if \n($T=1 \ + +. po 0 + +. ds [ [ + +. ds ] ] + +. ds < < + +. ds > > + +.\} + +.nr ps 0.5v + +.if \n($T \ + +. nr ps 1v + +.if t .nr ps 0.35v + +.nr bs \n(ps + +.nr qs \n(ps + +.nr zs 1v + +.nr xs 0.2v + +.nr fs 0.2v + +.if \n($T \ + +. nr fs 0 + +.if n .nr es 1v + +.if t .nr es 0.5v + +.wh 0 @h + +.nr $l \n(.lu + +.nr _L \n(.lu + +.nr $c 1 + +.nr $f 1 1 + +.ds * \*[1\*]\k*\" + +.nr $d 1 1 + +.ds # [1]\k#\" + +.nr _M 1 + +.ds lq \&"\" + +.ds rq \&"\" + +.if t \ + +. ds lq `` + +.if t \ + +. ds rq '' + +.em @z + +.de sc + +.so \\*(||/chars.me + +.rm sc + +.. + +.ll 6.0i + +.lt 6.0i diff --cc usr/man/man1/what.1 index 0000000000,0000000000,0000000000..f3bd3aa581 new file mode 100644 --- /dev/null +++ b/usr/man/man1/what.1 @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++.TH WHAT 1 +++.UC 4 +++.SH NAME +++what \- show what versions of object modules were used to construct a file +++.SH SYNOPSIS +++.B what +++name ... +++.SH DESCRIPTION +++.I What +++reads each file and searches for sequences of the form ``@(#)'' +++as inserted by the source code control system. It then prints the remainder +++of the string after this marker, up to a null character, newline, double +++quote, or ``>'' character. +++.SH BUGS +++As SCCS is not licensed with UNIX/32V, this is a rewrite of the +++.I what +++command which is part of SCCS, and may not behave exactly the same as that +++command does. diff --cc usr/src/cmd/1kfix.c index 0000000000,c70873c95d,0000000000..64a471ca8b mode 000000,100644,000000..100644 --- a/usr/src/cmd/1kfix.c +++ b/usr/src/cmd/1kfix.c @@@@ -1,0 -1,113 -1,0 +1,114 @@@@ +++static char *sccsid = "@(#)1kfix.c 4.1 (Berkeley) 10/15/80"; + +#include + +#include + +#include + +#include + +char *malloc(); + + + +#define round(a,b) (((a)+((b)-1))&~(b-1)) + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + char *tp, *dp, *sp; + + struct exec x, y; + + int io; + + char zeroes[NBPG]; + + + + --argc; + + ++argv; + + if (argc == 0) { + + fprintf(stderr, "usage: 1kfix file ...\n"); + + exit(1); + + } + + do { + + io = open(argv[0], 2); + + if (io < 0) { + + perror(argv[0]); + + argc--, argv++; + + continue; + + } + + if (read(io, &x, sizeof x) != sizeof x) + + goto format; + + + + switch (x.a_magic) { + + - case 0407: - case 0410: +++ case OMAGIC: +++ case NMAGIC: + + if ((round(x.a_text,NBPG) & CLOFSET) == 0) { + + fprintf(stderr, "%s: wins as is\n", argv[0]); + + goto skip; + + } + + break; + + - case 0413: +++ case ZMAGIC: + + lseek(io, NBPG, 0); + + break; + + + + default: + +format: + + printf("%s: not object file\n", argv[0]); + + goto skip; + + } + + + + tp = malloc(x.a_text); + + dp = malloc(x.a_data); + + sp = malloc(x.a_syms); + + if (read(io, tp, x.a_text) != x.a_text || + + read(io, dp, x.a_data) != x.a_data || + + read(io, sp, x.a_syms) != x.a_syms) { + + fprintf(stderr, "%s: short read\n", argv[0]); + + goto skip; + + } + + close(io); + + io = creat(argv[0], 0755); + + if (io < 0) { + + perror(argv[0]); + + goto skip; + + } + + + + y = x; + + switch (x.a_magic) { + + - case 0413: { +++ case ZMAGIC: { + + int i; + + for (i = 0; i < 512; i++) + + if (tp[i] != 0) + + break; + + if (i == 512) + + printf("%s: already fixed\n", argv[0]); + + if (x.a_text & CLOFSET) { + + y.a_text -= NBPG; + + y.a_data += NBPG; + + } + + } + + break; + + - case 0407: - case 0410: +++ case OMAGIC: +++ case NMAGIC: + + y.a_text = round(x.a_text, NBPG) - NBPG; + + y.a_data += NBPG; + + if (y.a_text == 0) { + + fprintf(stderr, "%s: text size would be 0\n", argv[0]); + + goto skip; + + } + + } + + y.a_trsize = y.a_drsize = 0; + + write(io, (char *)&y, sizeof y); - if (x.a_magic == 0413) +++ if (x.a_magic == ZMAGIC) + + lseek(io, BSIZE, 0); + + write(io, tp, x.a_text); - if (x.a_magic != 0413) +++ if (x.a_magic != ZMAGIC) + + write(io, zeroes, round(x.a_text, NBPG) - x.a_text); + + write(io, dp, x.a_data); + + write(io, sp, x.a_syms); + + free(tp); + + free(dp); + + free(sp); + +skip: + + argc--, argv++; + + close(io); + + } while (argc > 0); + + exit(0); + +} diff --cc usr/src/cmd/512restor.c index 0000000000,79f856ad24,0000000000..59e7c9e16a mode 000000,100644,000000..100644 --- a/usr/src/cmd/512restor.c +++ b/usr/src/cmd/512restor.c @@@@ -1,0 -1,1192 -1,0 +1,1193 @@@@ +++static char *sccsid = "@(#)512restor.c 4.2 (Berkeley) 11/15/80"; + +#define MAXINO 3000 + +#define BITS 8 + +#define MAXXTR 60 + +#define NCACHE 3 + + + +#ifndef STANDALONE + +#include + +#include + +#endif + +#include + +#include + +#include + +#include + +#include + +#include + + + +#define OBSIZE 512 + + + +/* from old */ + + + +#define OINOPB 8 /* 8 inodes per block */ + + + +/* old */ + +#define NTREC 20 + +#define MLEN 16 + +#define MSIZ 4096 + + + +#define TS_TAPE 1 + +#define TS_INODE 2 + +#define TS_BITS 3 + +#define TS_ADDR 4 + +#define TS_END 5 + +#define TS_CLRI 6 + +#define MAGIC (int)60011 + +#define CHECKSUM (int)84446 + +struct spcl + +{ + + int c_type; + + time_t c_date; + + time_t c_ddate; + + int c_volume; + + daddr_t c_tapea; + + ino_t c_inumber; + + int c_magic; + + int c_checksum; + + struct dinode c_dinode; + + int c_count; + + char c_addr[OBSIZE]; + +} spcl; + + + +struct idates + +{ + + char id_name[16]; + + char id_incno; + + time_t id_ddate; + +}; + + + +/* end of old */ + + + +#define MWORD(m,i) (m[(unsigned)(i-1)/MLEN]) + +#define MBIT(i) (1<<((unsigned)(i-1)%MLEN)) + +#define BIS(i,w) (MWORD(w,i) |= MBIT(i)) + +#define BIC(i,w) (MWORD(w,i) &= ~MBIT(i)) + +#define BIT(i,w) (MWORD(w,i) & MBIT(i)) + + + +struct filsys sblock; + + + +int fi; + +ino_t ino, maxi, curino; + + + +int mt; - char tapename[] = "/dev/rmt1"; +++char tapename[] = "/dev/rmt8"; + +char *magtape = tapename; + +#ifdef STANDALONE + +char mbuf[50]; + +#endif + + + +#ifndef STANDALONE + +daddr_t seekpt; + +int df, ofile; + +char dirfile[] = "rstXXXXXX"; + + + +struct { + + ino_t t_ino; + + daddr_t t_seekpt; + +} inotab[MAXINO]; + +int ipos; + + + +#define ONTAPE 1 + +#define XTRACTD 2 + +#define XINUSE 4 + +struct xtrlist { + + ino_t x_ino; + + char x_flags; + +} xtrlist[MAXXTR]; + + + +char name[12]; + + + +char drblock[BSIZE]; + +int bpt; + +#endif + + + +int eflag; + + + +int volno = 1; + + + +struct dinode tino, dino; + +daddr_t taddr[NADDR]; + + + +daddr_t curbno; + + + +short dumpmap[MSIZ]; + +short clrimap[MSIZ]; + + + + + +int bct = NTREC+1; + +char tbf[NTREC*OBSIZE]; + + + +struct cache { + + daddr_t c_bno; + + int c_time; + + char c_block[BSIZE]; + +} cache[NCACHE]; + +int curcache; + + + +main(argc, argv) + +char *argv[]; + +{ + + register char *cp; + + char command; + + int done(); + + + +#ifndef STANDALONE + + mktemp(dirfile); + + if (argc < 2) { + +usage: + + printf("Usage: oldrestor x file file..., oldrestor r filesys, or oldrestor t\n"); + + exit(1); + + } + + argv++; + + argc -= 2; + + for (cp = *argv++; *cp; cp++) { + + switch (*cp) { + + case '-': + + break; + + case 'f': + + magtape = *argv++; + + argc--; + + break; + + case 'r': + + case 'R': + + case 't': + + case 'x': + + command = *cp; + + break; + + default: + + printf("Bad key character %c\n", *cp); + + goto usage; + + } + + } + + if (command == 'x') { + + if (signal(SIGINT, done) == SIG_IGN) + + signal(SIGINT, SIG_IGN); + + if (signal(SIGTERM, done) == SIG_IGN) + + signal(SIGTERM, SIG_IGN); + + + + df = creat(dirfile, 0666); + + if (df < 0) { + + printf("restor: %s - cannot create directory temporary\n", dirfile); + + exit(1); + + } + + close(df); + + df = open(dirfile, 2); + + } + + doit(command, argc, argv); + + if (command == 'x') + + unlink(dirfile); + + exit(0); + +#else + + magtape = "tape"; + + doit('r', 1, 0); + +#endif + +} + + + +doit(command, argc, argv) + +char command; + +int argc; + +char *argv[]; + +{ + + extern char *ctime(); + + register i, k; + + ino_t d; + +#ifndef STANDALONE + + int xtrfile(), skip(); + +#endif + + int rstrfile(), rstrskip(); + + struct dinode *ip, *ip1; + + + +#ifndef STANDALONE + + if ((mt = open(magtape, 0)) < 0) { + + printf("%s: cannot open tape\n", magtape); + + exit(1); + + } + +#else + + do { + + printf("Tape? "); + + gets(mbuf); + + mt = open(mbuf, 0); + + } while (mt == -1); + + magtape = mbuf; + +#endif + + switch(command) { + +#ifndef STANDALONE + + case 't': + + if (readhdr(&spcl) == 0) { + + printf("Tape is not a dump tape\n"); + + exit(1); + + } + + printf("Dump date: %s", ctime(&spcl.c_date)); + + printf("Dumped from: %s", ctime(&spcl.c_ddate)); + + return; + + case 'x': + + if (readhdr(&spcl) == 0) { + + printf("Tape is not a dump tape\n"); + + exit(1); + + } + + if (checkvol(&spcl, 1) == 0) { + + printf("Tape is not volume 1 of the dump\n"); + + exit(1); + + } + + pass1(); /* This sets the various maps on the way by */ + + i = 0; + + while (i < MAXXTR-1 && argc--) { + + if ((d = psearch(*argv)) == 0 || BIT(d, dumpmap) == 0) { + + printf("%s: not on the tape\n", *argv++); + + continue; + + } + + xtrlist[i].x_ino = d; + + xtrlist[i].x_flags |= XINUSE; + + printf("%s: inode %u\n", *argv, d); + + argv++; + + i++; + + } + +newvol: + + flsht(); + + close(mt); + +getvol: + + printf("Mount desired tape volume: Specify volume #: "); + + if (gets(tbf) == NULL) + + return; + + volno = atoi(tbf); + + if (volno <= 0) { + + printf("Volume numbers are positive numerics\n"); + + goto getvol; + + } + + mt = open(magtape, 0); + + if (readhdr(&spcl) == 0) { + + printf("tape is not dump tape\n"); + + goto newvol; + + } + + if (checkvol(&spcl, volno) == 0) { + + printf("Wrong volume (%d)\n", spcl.c_volume); + + goto newvol; + + } + +rbits: + + while (gethead(&spcl) == 0) + + ; + + if (checktype(&spcl, TS_INODE) == 1) { + + printf("Can't find inode mask!\n"); + + goto newvol; + + } + + if (checktype(&spcl, TS_BITS) == 0) + + goto rbits; + + readbits(dumpmap); + + i = 0; + + for (k = 0; xtrlist[k].x_flags; k++) { + + if (BIT(xtrlist[k].x_ino, dumpmap)) { + + xtrlist[k].x_flags |= ONTAPE; + + i++; + + } + + } + + while (i > 0) { + +again: + + if (ishead(&spcl) == 0) + + while(gethead(&spcl) == 0) + + ; + + if (checktype(&spcl, TS_END) == 1) { + + printf("end of tape\n"); + +checkdone: + + for (k = 0; xtrlist[k].x_flags; k++) + + if ((xtrlist[k].x_flags&XTRACTD) == 0) + + goto newvol; + + return; + + } + + if (checktype(&spcl, TS_INODE) == 0) { + + gethead(&spcl); + + goto again; + + } + + d = spcl.c_inumber; + + for (k = 0; xtrlist[k].x_flags; k++) { + + if (d == xtrlist[k].x_ino) { + + printf("extract file %u\n", xtrlist[k].x_ino); + + sprintf(name, "%u", xtrlist[k].x_ino); + + if ((ofile = creat(name, 0666)) < 0) { + + printf("%s: cannot create file\n", name); + + i--; + + continue; + + } + + chown(name, spcl.c_dinode.di_uid, spcl.c_dinode.di_gid); + + getfile(ino, xtrfile, skip, spcl.c_dinode.di_size); + + i--; + + xtrlist[k].x_flags |= XTRACTD; + + close(ofile); + + goto done; + + } + + } + + gethead(&spcl); + +done: + + ; + + } + + goto checkdone; + +#endif + + case 'r': + + case 'R': + +#ifndef STANDALONE + + if ((fi = open(*argv, 2)) < 0) { + + printf("%s: cannot open\n", *argv); + + exit(1); + + } + +#else + + do { + + char charbuf[50]; + + + + printf("Disk? "); + + gets(charbuf); + + fi = open(charbuf, 2); + + } while (fi == -1); + +#endif + +#ifndef STANDALONE + + if (command == 'R') { + + printf("Enter starting volume number: "); + + if (gets(tbf) == EOF) { + + volno = 1; + + printf("\n"); + + } + + else + + volno = atoi(tbf); + + } + + else + +#endif + + volno = 1; + + printf("Last chance before scribbling on %s. ", + +#ifdef STANDALONE + + "disk"); + +#else + + *argv); + +#endif + + while (getchar() != '\n'); + + dread((daddr_t)1, (char *)&sblock, sizeof(sblock)); + + maxi = (sblock.s_isize-2)*INOPB; + + if (readhdr(&spcl) == 0) { + + printf("Missing volume record\n"); + + exit(1); + + } + + if (checkvol(&spcl, volno) == 0) { + + printf("Tape is not volume %d\n", volno); + + exit(1); + + } + + gethead(&spcl); + + for (;;) { + +ragain: + + if (ishead(&spcl) == 0) { + + printf("Missing header block\n"); + + while (gethead(&spcl) == 0) + + ; + + eflag++; + + } + + if (checktype(&spcl, TS_END) == 1) { + + printf("End of tape\n"); + + close(mt); + + dwrite( (daddr_t) 1, (char *) &sblock); + + return; + + } + + if (checktype(&spcl, TS_CLRI) == 1) { + + readbits(clrimap); + + for (ino = 1; ino <= maxi; ino++) + + if (BIT(ino, clrimap) == 0) { + + getdino(ino, &tino); + + if (tino.di_mode == 0) + + continue; + + itrunc(&tino); + + clri(&tino); + + putdino(ino, &tino); + + } + + dwrite( (daddr_t) 1, (char *) &sblock); + + goto ragain; + + } + + if (checktype(&spcl, TS_BITS) == 1) { + + readbits(dumpmap); + + goto ragain; + + } + + if (checktype(&spcl, TS_INODE) == 0) { + + printf("Unknown header type\n"); + + eflag++; + + gethead(&spcl); + + goto ragain; + + } + + ino = spcl.c_inumber; + + if (eflag) + + printf("Resynced at inode %u\n", ino); + + eflag = 0; + + if (ino > maxi) { + + printf("%u: ilist too small\n", ino); + + gethead(&spcl); + + goto ragain; + + } + + dino = spcl.c_dinode; + + getdino(ino, &tino); + + curbno = 0; + + itrunc(&tino); + + clri(&tino); + + for (i = 0; i < NADDR; i++) + + taddr[i] = 0; + + l3tol(taddr, dino.di_addr, 1); + + getfile(d, rstrfile, rstrskip, dino.di_size); + + ip = &tino; + + ltol3(ip->di_addr, taddr, NADDR); + + ip1 = &dino; + + ip->di_mode = ip1->di_mode; + + ip->di_nlink = ip1->di_nlink; + + ip->di_uid = ip1->di_uid; + + ip->di_gid = ip1->di_gid; + + ip->di_size = ip1->di_size; + + ip->di_atime = ip1->di_atime; + + ip->di_mtime = ip1->di_mtime; + + ip->di_ctime = ip1->di_ctime; + + putdino(ino, &tino); + + } + + } + +} + + + +/* + + * Read the tape, bulding up a directory structure for extraction + + * by name + + */ + +#ifndef STANDALONE + +pass1() + +{ + + register i; + + struct dinode *ip; + + int putdir(), null(); + + + + while (gethead(&spcl) == 0) { + + printf("Can't find directory header!\n"); + + } + + for (;;) { + + if (checktype(&spcl, TS_BITS) == 1) { + + readbits(dumpmap); + + continue; + + } + + if (checktype(&spcl, TS_CLRI) == 1) { + + readbits(clrimap); + + continue; + + } + + if (checktype(&spcl, TS_INODE) == 0) { + +finish: + + flsh(); + + close(mt); + + return; + + } + + ip = &spcl.c_dinode; + + i = ip->di_mode & IFMT; + + if (i != IFDIR) { + + goto finish; + + } + + inotab[ipos].t_ino = spcl.c_inumber; + + inotab[ipos++].t_seekpt = seekpt; + + getfile(spcl.c_inumber, putdir, null, spcl.c_dinode.di_size); + + putent("\000\000/"); + + } + +} + +#endif + + + +/* + + * Do the file extraction, calling the supplied functions + + * with the blocks + + */ + +getfile(n, f1, f2, size) + +ino_t n; + +int (*f2)(), (*f1)(); + +long size; + +{ + + register i; + + struct spcl addrblock; + + char buf[BSIZE]; + + + + addrblock = spcl; + + curino = n; + + goto start; + + for (;;) { + + if (gethead(&addrblock) == 0) { + + printf("Missing address (header) block\n"); + + goto eloop; + + } + + if (checktype(&addrblock, TS_ADDR) == 0) { + + spcl = addrblock; + + curino = 0; + + curino = 0; + + return; + + } + +start: + + for (i = 0; i < addrblock.c_count; i += 2) { + + if (addrblock.c_addr[i]) + + readtape(buf, 0); + + else + + clearbuf(buf, 0); + + if (size > OBSIZE && addrblock.c_addr[i+1]) + + readtape(buf, 1); + + else + + clearbuf(buf, 1); + + if (addrblock.c_addr[i] || size > OBSIZE && addrblock.c_addr[i + 1]) + + (*f1)(buf, size > BSIZE ? (long) BSIZE : size); + + else + + (*f2)(buf, size > BSIZE ? (long) BSIZE : size); + + if ((size -= BSIZE) <= 0) { + +eloop: + + while (gethead(&spcl) == 0) + + ; + + if (checktype(&spcl, TS_ADDR) == 1) + + goto eloop; + + curino = 0; + + return; + + } + + } + + } + +} + + + +/* + + * Do the tape i\/o, dealling with volume changes + + * etc.. + + */ + +readtape(b, part) + +char *b; + +{ + + register i; + + struct spcl tmpbuf; + + + + if (bct >= NTREC) { + + for (i = 0; i < NTREC; i++) + + ((struct spcl *)&tbf[i*OBSIZE])->c_magic = 0; + + bct = 0; + + if ((i = read(mt, tbf, NTREC*OBSIZE)) < 0) { + + printf("Tape read error: inode %u\n", curino); + + eflag++; + + exit(1); + + } + + if (i == 0) { + + bct = NTREC + 1; + + volno++; + +loop: + + flsht(); + + close(mt); + + printf("Mount volume %d\n", volno); + + while (getchar() != '\n') + + ; + + if ((mt = open(magtape, 0)) == -1) { + + printf("Cannot open tape!\n"); + + goto loop; + + } + + if (readhdr(&tmpbuf) == 0) { + + printf("Not a dump tape.Try again\n"); + + goto loop; + + } + + if (checkvol(&tmpbuf, volno) == 0) { + + printf("Wrong tape. Try again\n"); + + goto loop; + + } + + readtape(b, part); + + return; + + } + + } + + copy(&tbf[(bct++*OBSIZE)], b + part * OBSIZE, OBSIZE); + +} + + + +flsht() + +{ + + bct = NTREC+1; + +} + + + +copy(f, t, s) + +register char *f, *t; + +{ + + register i; + + + + i = s; + + do + + *t++ = *f++; + + while (--i); + +} + + + +clearbuf(cp, part) + +register char *cp; + +{ + + register i; + + + + cp += part * OBSIZE; + + i = OBSIZE; + + do + + *cp++ = 0; + + while (--i); + +} + + + +/* + + * Put and get the directory entries from the compressed + + * directory file + + */ + +#ifndef STANDALONE + +putent(cp) + +char *cp; + +{ + + register i; + + + + for (i = 0; i < sizeof(ino_t); i++) + + writec(*cp++); + + for (i = 0; i < DIRSIZ; i++) { + + writec(*cp); + + if (*cp++ == 0) + + return; + + } + + return; + +} + + + +getent(bf) + +register char *bf; + +{ + + register i; + + + + for (i = 0; i < sizeof(ino_t); i++) + + *bf++ = readc(); + + for (i = 0; i < DIRSIZ; i++) + + if ((*bf++ = readc()) == 0) + + return; + + return; + +} + + + +/* + + * read/write te directory file + + */ + +writec(c) + +char c; + +{ + + drblock[bpt++] = c; + + seekpt++; + + if (bpt >= BSIZE) { + + bpt = 0; + + write(df, drblock, BSIZE); + + } + +} + + + +readc() + +{ + + if (bpt >= BSIZE) { + + read(df, drblock, BSIZE); + + bpt = 0; + + } + + return(drblock[bpt++]); + +} + + + +mseek(pt) + +daddr_t pt; + +{ + + bpt = BSIZE; + + lseek(df, pt, 0); + +} + + + +flsh() + +{ + + write(df, drblock, bpt+1); + +} + + + +/* + + * search the directory inode ino + + * looking for entry cp + + */ + +ino_t + +search(inum, cp) + +ino_t inum; + +char *cp; + +{ + + register i; + + struct direct dir; + + + + for (i = 0; i < MAXINO; i++) + + if (inotab[i].t_ino == inum) { + + goto found; + + } + + return(0); + +found: + + mseek(inotab[i].t_seekpt); + + do { + + getent((char *)&dir); + + if (direq(dir.d_name, "/")) + + return(0); + + } while (direq(dir.d_name, cp) == 0); + + return(dir.d_ino); + +} + + + +/* + + * Search the directory tree rooted at inode 2 + + * for the path pointed at by n + + */ + +psearch(n) + +char *n; + +{ + + register char *cp, *cp1; + + char c; + + + + ino = 2; + + if (*(cp = n) == '/') + + cp++; + +next: + + cp1 = cp + 1; + + while (*cp1 != '/' && *cp1) + + cp1++; + + c = *cp1; + + *cp1 = 0; + + ino = search(ino, cp); + + if (ino == 0) { + + *cp1 = c; + + return(0); + + } + + *cp1 = c; + + if (c == '/') { + + cp = cp1+1; + + goto next; + + } + + return(ino); + +} + + + +direq(s1, s2) + +register char *s1, *s2; + +{ + + register i; + + + + for (i = 0; i < DIRSIZ; i++) + + if (*s1++ == *s2) { + + if (*s2++ == 0) + + return(1); + + } else + + return(0); + + return(1); + +} + +#endif + + + +/* + + * read/write a disk block, be sure to update the buffer + + * cache if needed. + + */ + +dwrite(bno, b) + +daddr_t bno; + +char *b; + +{ + + register i; + + + + for (i = 0; i < NCACHE; i++) { + + if (cache[i].c_bno == bno) { + + copy(b, cache[i].c_block, BSIZE); + + cache[i].c_time = 0; + + break; + + } + + else + + cache[i].c_time++; + + } + + lseek(fi, bno*BSIZE, 0); + + if(write(fi, b, BSIZE) != BSIZE) { + +#ifdef STANDALONE + + printf("disk write error %D\n", bno); + +#else + + fprintf(stderr, "disk write error %ld\n", bno); + +#endif + + exit(1); + + } + +} + + + +dread(bno, buf, cnt) + +daddr_t bno; + +char *buf; + +{ + + register i, j; + + + + j = 0; + + for (i = 0; i < NCACHE; i++) { + + if (++curcache >= NCACHE) + + curcache = 0; + + if (cache[curcache].c_bno == bno) { + + copy(cache[curcache].c_block, buf, cnt); + + cache[curcache].c_time = 0; + + return; + + } + + else { + + cache[curcache].c_time++; + + if (cache[j].c_time < cache[curcache].c_time) + + j = curcache; + + } + + } + + + + lseek(fi, bno*BSIZE, 0); + + if (read(fi, cache[j].c_block, BSIZE) != BSIZE) { + +#ifdef STANDALONE + + printf("read error %D\n", bno); + +#else + + printf("read error %ld\n", bno); + +#endif + + exit(1); + + } + + copy(cache[j].c_block, buf, cnt); + + cache[j].c_time = 0; + + cache[j].c_bno = bno; + +} + + + +/* + + * the inode manpulation routines. Like the system. + + * + + * clri zeros the inode + + */ + +clri(ip) + +struct dinode *ip; + +{ + + int i, *p; + + i = sizeof(struct dinode)/sizeof(int); + + p = (int *)ip; + + do + + *p++ = 0; + + while(--i); + +} + + + +/* + + * itrunc/tloop/bfree free all of the blocks pointed at by the inode + + */ + +itrunc(ip) + +register struct dinode *ip; + +{ + + register i; + + daddr_t bn, iaddr[NADDR]; + + + + if (ip->di_mode == 0) + + return; + + i = ip->di_mode & IFMT; + + if (i != IFDIR && i != IFREG) + + return; + + l3tol(iaddr, ip->di_addr, NADDR); + + for(i=NADDR-1;i>=0;i--) { + + bn = iaddr[i]; + + if(bn == 0) continue; + + switch(i) { + + + + default: + + bfree(bn); + + break; + + + + case NADDR-3: + + tloop(bn, 0, 0); + + break; + + + + case NADDR-2: + + tloop(bn, 1, 0); + + break; + + + + case NADDR-1: + + tloop(bn, 1, 1); + + } + + } + + ip->di_size = 0; + +} + + + +tloop(bn, f1, f2) + +daddr_t bn; + +int f1, f2; + +{ + + register i; + + daddr_t nb; + + union { + + char data[BSIZE]; + + daddr_t indir[NINDIR]; + + } ibuf; + + + + dread(bn, ibuf.data, BSIZE); + + for(i=NINDIR-1;i>=0;i--) { + + nb = ibuf.indir[i]; + + if(nb) { + + if(f1) + + tloop(nb, f2, 0); + + else + + bfree(nb); + + } + + } + + bfree(bn); + +} + + + +bfree(bn) + +daddr_t bn; + +{ + + register i; + + union { + + char data[BSIZE]; + + struct fblk frees; + + } fbuf; + + + + if(sblock.s_nfree >= NICFREE) { + + fbuf.df_nfree = sblock.s_nfree; + + for(i=0;i0; j--) { + + sh += NSHIFT; + + nb <<= NSHIFT; + + if(bn < nb) + + break; + + bn -= nb; + + } + + if(j == 0) { + + return((daddr_t)0); + + } + + + + /* + + * fetch the address from the inode + + */ + + if((nb = iaddr[NADDR-j]) == 0) { + + iaddr[NADDR-j] = nb = balloc(); + + } + + + + /* + + * fetch through the indirect blocks + + */ + + for(; j<=3; j++) { + + dread(nb, (char *)indir, BSIZE); + + sh -= NSHIFT; + + i = (bn>>sh) & NMASK; + + nnb = indir[i]; + + if(nnb == 0) { + + nnb = balloc(); + + indir[i] = nnb; + + dwrite(nb, (char *)indir); + + } + + nb = nnb; + + } + + return(nb); + +} + + + +/* + + * read the tape into buf, then return whether or + + * or not it is a header block. + + */ + +gethead(buf) + +struct spcl *buf; + +{ + + readtape((char *)buf, 0); + + if (buf->c_magic != MAGIC || checksum((int *) buf) == 0) + + return(0); + + return(1); + +} + + + +/* + + * return whether or not the buffer contains a header block + + */ + +ishead(buf) + +struct spcl *buf; + +{ + + if (buf->c_magic != MAGIC || checksum((int *) buf) == 0) + + return(0); + + return(1); + +} + + + +checktype(b, t) + +struct spcl *b; + +int t; + +{ + + return(b->c_type == t); + +} + + + + + +checksum(b) + +int *b; + +{ + + register i, j; + + + + j = OBSIZE/sizeof(int); + + i = 0; + + do + + i += *b++; + + while (--j); + + if (i != CHECKSUM) { + + printf("Checksum error %o\n", i); + + return(0); + + } + + return(1); + +} + + + +checkvol(b, t) + +struct spcl *b; + +int t; + +{ + + if (b->c_volume == t) + + return(1); + + return(0); + +} + + + +readhdr(b) + +struct spcl *b; + +{ + + if (gethead(b) == 0) + + return(0); + + if (checktype(b, TS_TAPE) == 0) + + return(0); + + return(1); + +} + + + +/* + + * The next routines are called during file extraction to + + * put the data into the right form and place. + + */ + +#ifndef STANDALONE + +xtrfile(b, size) + +char *b; + +long size; + +{ + + write(ofile, b, (int) size); + +} + + + +null() {;} + + + +skip() + +{ + + lseek(ofile, (long) OBSIZE, 1); + +} + +#endif + + + + + +rstrfile(b, s) + +char *b; + +long s; + +{ + + daddr_t d; + + + + d = bmap(taddr, curbno); + + dwrite(d, b); + + curbno += 1; + +} + + + +rstrskip(b, s) + +char *b; + +long s; + +{ + + curbno += 1; + +} + + + +#ifndef STANDALONE + +putdir(b) + +char *b; + +{ + + register struct direct *dp; + + register i; + + + + for (dp = (struct direct *) b, i = 0; i < BSIZE; dp++, i += sizeof(*dp)) { + + if (dp->d_ino == 0) + + continue; + + putent((char *) dp); + + } + +} + +#endif + + + +/* + + * read/write an inode from the disk + + */ + +getdino(inum, b) + +ino_t inum; + +struct dinode *b; + +{ + + daddr_t bno; + + char buf[BSIZE]; + + + + bno = (ino - 1)/INOPB; + + bno += 2; + + dread(bno, buf, BSIZE); + + copy(&buf[((inum-1)%INOPB)*sizeof(struct dinode)], (char *) b, sizeof(struct dinode)); + +} + + + +putdino(inum, b) + +ino_t inum; + +struct dinode *b; + +{ + + daddr_t bno; + + char buf[BSIZE]; + + + + bno = ((ino - 1)/INOPB) + 2; + + dread(bno, buf, BSIZE); + + copy((char *) b, &buf[((inum-1)%INOPB)*sizeof(struct dinode)], sizeof(struct dinode)); + + dwrite(bno, buf); + +} + + + +/* + + * read a bit mask from the tape into m. + + */ + +readbits(m) + +short *m; + +{ + + register i; + + + + i = spcl.c_count; + + + + while (i--) { + + readtape((char *) m, 0); + + m += (OBSIZE/(MLEN/BITS)); + + } + + while (gethead(&spcl) == 0) + + ; + +} + + + +done() + +{ + + unlink(dirfile); + + exit(0); + +} diff --cc usr/src/cmd/ac.c index 0000000000,62103dfd56,0000000000..9125a9d74e mode 000000,100644,000000..100644 --- a/usr/src/cmd/ac.c +++ b/usr/src/cmd/ac.c @@@@ -1,0 -1,249 -1,0 +1,253 @@@@ + +/* + + * acct [ -w wtmp ] [ -d ] [ -p ] [ people ] + + */ +++static char *sccsid = "@(#)ac.c 4.1 (Berkeley) 10/1/80"; + + + +#include + +#include + +#include + +#include + +#include + +#include + + +++#define NMAX sizeof(ibuf.ut_name) +++#define LMAX sizeof(ibuf.ut_line) +++ + +#define TSIZE 1000 + +#define USIZE 500 + +struct utmp ibuf; + + + +struct ubuf { - char uname[8]; +++ char uname[NMAX]; + + long utime; + +} ubuf[USIZE]; + + + +struct tbuf { + + struct ubuf *userp; + + long ttime; + +} tbuf[TSIZE]; + + + +char *wtmp; + +int pflag, byday; + +long dtime; + +long midnight; + +long lastime; + +long day = 86400L; + +int pcount; + +char **pptr; + + + +main(argc, argv) + +char **argv; + +{ + + int c, fl; + + register i; + + FILE *wf; + + + + wtmp = "/usr/adm/wtmp"; + + while (--argc > 0 && **++argv == '-') + + switch(*++*argv) { + + case 'd': + + byday++; + + continue; + + + + case 'w': + + if (--argc>0) + + wtmp = *++argv; + + continue; + + + + case 'p': + + pflag++; + + continue; + + } + + pcount = argc; + + pptr = argv; + + if ((wf = fopen(wtmp, "r")) == NULL) { + + printf("No %s\n", wtmp); + + exit(1); + + } + + for(;;) { + + if (fread((char *)&ibuf, sizeof(ibuf), 1, wf) != 1) + + break; + + fl = 0; - for (i=0; i<8; i++) { +++ for (i=0; ittime += ibuf.ut_time-dtime; + + dtime = 0; + + return; + + } + + if (lastime>ibuf.ut_time || lastime+(1.5*day) midnight) { + + upall(1); + + print(); + + newday(); + + for (up=ubuf; up < &ubuf[USIZE]; up++) + + up->utime = 0; + + } + + if (ibuf.ut_line[0] == '~') { + + ibuf.ut_name[0] = '\0'; + + upall(0); + + return; + + } + + if (ibuf.ut_line[0]=='t') + + i = (ibuf.ut_line[3]-'0')*10 + (ibuf.ut_line[4]-'0'); + + else + + i = TSIZE-1; + + if (i<0 || i>=TSIZE) + + i = TSIZE-1; + + tp = &tbuf[i]; + + update(tp, 0); + +} + + + +print() + +{ + + int i; + + long ttime, t; + + + + ttime = 0; + + for (i=0; i0) + + ttime += t; + + if (pflag && ubuf[i].utime > 0) { - printf("\t%-8.8s%6.2f\n", +++ printf("\t%-*.*s%6.2f\n", NMAX, NMAX, + + ubuf[i].uname, ubuf[i].utime/3600.); + + } + + } + + if (ttime > 0) { + + pdate(); + + printf("\ttotal%9.2f\n", ttime/3600.); + + } + +} + + + +upall(f) + +{ + + register struct tbuf *tp; + + + + for (tp=tbuf; tp < &tbuf[TSIZE]; tp++) + + update(tp, f); + +} + + + +update(tp, f) + +struct tbuf *tp; + +{ + + int j; + + struct ubuf *up; + + long t, t1; + + + + if (f) + + t = midnight; + + else + + t = ibuf.ut_time; + + if (tp->userp) { + + t1 = t - tp->ttime; + + if (t1>0 && t1 < 1.5*day) + + tp->userp->utime += t1; + + } + + tp->ttime = t; + + if (f) + + return; + + if (ibuf.ut_name[0]=='\0') { + + tp->userp = 0; + + return; + + } + + for (up=ubuf; up < &ubuf[USIZE]; up++) { + + if (up->uname[0] == '\0') + + break; - for (j=0; j<8 && up->uname[j]==ibuf.ut_name[j]; j++); - if (j>=8) +++ for (j=0; juname[j]==ibuf.ut_name[j]; j++); +++ if (j>=NMAX) + + break; + + } - for (j=0; j<8; j++) +++ for (j=0; juname[j] = ibuf.ut_name[j]; + + tp->userp = up; + +} + + + +among(i) + +{ + + register j, k; + + register char *p; + + + + if (pcount==0) + + return(1); + + for (j=0; jtm_isdst) + + midnight -= 3600; + + } + + while (midnight <= ibuf.ut_time) + + midnight += day; + +} + + + +pdate() + +{ + + long x; + + char *ctime(); + + + + if (byday==0) + + return; + + x = midnight-1; + + printf("%.6s", ctime(&x)+4); + +} diff --cc usr/src/cmd/accton.c index 0000000000,90f1e9fc75,0000000000..8870f470c0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/accton.c +++ b/usr/src/cmd/accton.c @@@@ -1,0 -1,14 -1,0 +1,15 @@@@ +++static char *sccsid = "@(#)accton.c 4.1 (Berkeley) 10/1/80"; + +main(argc, argv) + +char **argv; + +{ + + extern errno; + + if (argc > 1) + + acct(argv[1]); + + else + + acct((char *)0); + + if (errno) { + + perror("accton"); + + exit(1); + + } + + exit(0); + +} diff --cc usr/src/cmd/analyze.c index 0000000000,9b3d99a96a,0000000000..cc0e271429 mode 000000,100644,000000..100644 --- a/usr/src/cmd/analyze.c +++ b/usr/src/cmd/analyze.c @@@@ -1,0 -1,749 -1,0 +1,777 @@@@ +++static char *sccsid = "@(#)analyze.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include - #include + +#include - #include +++#include + +#include + +#include +++#include + +#include + +#include + +#include + + + +/* + + * Analyze - analyze a core (and optional paging area) saved from + + * a virtual Unix system crash. + + */ + + + +int Dflg; + +int dflg; + +int vflg; + +int mflg; + +int fflg; + +int sflg; + + + +/* use vprintf with care; it plays havoc with ``else's'' */ + +#define vprintf if (vflg) printf + + + +#define clear(x) ((int)x & 0x7fffffff) + + + +struct proc proc[NPROC]; + +struct text text[NTEXT]; + +struct map swapmap[SMAPSIZ]; + +struct cmap *cmap; + +struct pte *usrpt; + +struct pte *Usrptma; + +int firstfree; + +int maxfree; + +int freemem; + +struct pte p0br[ctopt(MAXTSIZ+MAXDSIZ+MAXSSIZ)][NPTEPG]; + +int pid; + + + +struct paginfo { + + char z_type; + + char z_count; + + short z_pid; + + struct pte z_pte; + +} *paginfo; + +#define ZLOST 0 + +#define ZDATA 1 + +#define ZSTACK 2 + +#define ZUDOT 3 + +#define ZPAGET 4 + +#define ZTEXT 5 + +#define ZFREE 6 + +#define ZINTRAN 7 + + + +#define NDBLKS (2*SMAPSIZ) + +struct dblks { + + short d_first; + + short d_size; + + char d_type; + + char d_index; + +} dblks[NDBLKS]; + +int ndblks; + + + +#define DFREE 0 + +#define DDATA 1 + +#define DSTACK 2 + +#define DTEXT 3 + +#define DUDOT 4 + +#define DPAGET 5 + + + +union { + + char buf[UPAGES][512]; + + struct user U; + +} u_area; + +#define u u_area.U + + + +int fcore = -1; + +int fswap = -1; + + + +struct nlist nl[] = { + +#define X_PROC 0 - "_proc", 0, 0, 0, 0, +++ { "_proc" }, + +#define X_USRPT 1 - "_usrpt", 0, 0, 0, 0, +++ { "_usrpt" }, + +#define X_PTMA 2 - "_Usrptma", 0, 0, 0, 0, +++ { "_Usrptma" }, + +#define X_FIRSTFREE 3 - "_firstfr", 0, 0, 0, 0, +++ { "_firstfr" }, + +#define X_MAXFREE 4 - "_maxfree", 0, 0, 0, 0, +++ { "_maxfree" }, + +#define X_TEXT 5 - "_text", 0, 0, 0, 0, +++ { "_text" }, + +#define X_FREEMEM 6 - "_freemem", 0, 0, 0, 0, +++ { "_freemem" }, + +#define X_CMAP 7 - "_cmap", 0, 0, 0, 0, +++ { "_cmap" }, + +#define X_ECMAP 8 - "_ecmap", 0, 0, 0, 0, +++ { "_ecmap" }, + +#define X_SWAPMAP 9 - "_swapmap", 0, 0, 0, 0, - 0, 0, 0, 0, 0, - +++ { "_swapmap" }, +++ { 0 } + +}; + + + +main(argc, argv) + + int argc; + + char **argv; + +{ + + register struct nlist *np; + + register struct proc *p; + + register struct text *xp; + + register struct pte *pte; + + register int i; + + int w, a; + + + + argc--, argv++; + + while (argc > 0 && argv[0][0] == '-') { + + register char *cp = *argv++; + + argc--; + + while (*++cp) switch (*cp) { + + + + case 'm': + + mflg++; + + break; + + + + case 'v': + + vflg++; + + break; + + + + case 's': + + if (argc < 2) + + goto usage; + + if ((fswap = open(argv[0], 0)) < 0) { + + perror(argv[0]); + + exit(1); + + } + + argc--,argv++; + + sflg++; + + break; + + + + case 'f': + + fflg++; + + break; + + + + case 'D': + + Dflg++; + + break; + + + + case 'd': + + dflg++; + + break; + + + + default: + + goto usage; + + } + + } + + if (argc < 1) { + +usage: + + fprintf(stderr, "usage: analyze [ -vmfd ] [ -s swapfile ] corefile [ system ]\n"); + + exit(1); + + } + + close(0); + + if ((fcore = open(argv[0], 0)) < 0) { + + perror(argv[0]); + + exit(1); + + } + + nlist(argc > 1 ? argv[1] : "/vmunix", nl); + + if (nl[0].n_value == 0) { + + fprintf(stderr, "%s: bad namelist\n", + + argc > 1 ? argv[1] : "/vmunix"); + + exit(1); + + } + + for (np = nl; np->n_name[0]; np++) + + vprintf("%8.8s %x\n", np->n_name ,np->n_value ); + + usrpt = (struct pte *)clear(nl[X_USRPT].n_value); + + Usrptma = (struct pte *)clear(nl[X_PTMA].n_value); + + firstfree = get(nl[X_FIRSTFREE].n_value); + + maxfree = get(nl[X_MAXFREE].n_value); + + freemem = get(nl[X_FREEMEM].n_value); + + paginfo = (struct paginfo *)calloc(maxfree, sizeof (struct paginfo)); + + if (paginfo == NULL) { + + fprintf(stderr, "maxfree %x?... out of mem!\n", maxfree); + + exit(1); + + } + + vprintf("usrpt %x\nUsrptma %x\nfirstfree %x\nmaxfree %x\nfreemem %x\n", + + usrpt, Usrptma, firstfree, maxfree, freemem); + + lseek(fcore, (long)clear(nl[X_PROC].n_value), 0); + + if (read(fcore, (char *)proc, sizeof proc) != sizeof proc) { + + perror("proc read"); + + exit(1); + + } + + lseek(fcore, (long)clear(nl[X_TEXT].n_value), 0); + + if (read(fcore, (char *)text, sizeof text) != sizeof text) { + + perror("text read"); + + exit(1); + + } + + i = (get(nl[X_ECMAP].n_value) - get(nl[X_CMAP].n_value)); + + cmap = (struct cmap *)calloc(i, 1); + + if (cmap == NULL) { + + fprintf(stderr, "not enough mem for %x bytes of cmap\n", i); + + exit(1); + + } + + lseek(fcore, (long)clear(get(nl[X_CMAP].n_value)), 0); + + if (read(fcore, (char *)cmap, i) != i) { + + perror("cmap read"); + + exit(1); + + } + + lseek(fcore, (long)clear(nl[X_SWAPMAP].n_value), 0); + + if (read(fcore, (char *)swapmap, sizeof swapmap) != sizeof swapmap) { + + perror("swapmap read"); + + exit(1); + + } + + for (p = &proc[1]; p < &proc[NPROC]; p++) { + + p->p_p0br = (struct pte *)clear(p->p_p0br); +++ p->p_addr = (struct pte *)clear(p->p_addr); + + if (p->p_stat == 0) + + continue; + + printf("proc %d ", p->p_pid); - if (p->p_stat != SZOMB) { - if (getu(p)) - continue; - u.u_procp = p; - } + + if (p->p_stat == SZOMB) { + + printf("zombie\n"); + + continue; + + } + + if (p->p_flag & SLOAD) { + + printf("loaded, p0br %x, ", p->p_p0br); - p->p_szpt = u.u_pcb.pcb_szpt; + + printf("%d pages of page tables:", p->p_szpt); + + a = btokmx(p->p_p0br); + + for (i = 0; i < p->p_szpt; i++) { + + w = get(&Usrptma[a + i]); + + printf(" %x", w & PG_PFNUM); + + } + + printf("\n"); + + for(i = 0; i < p->p_szpt; i++) { + + w = get(&Usrptma[a + i]); + + if (getpt(w, i)) + + count(p, (struct pte *)&w, ZPAGET); + + } + + } else { + + /* i = ctopt(btoc(u.u_exdata.ux_dsize)); */ + + i = clrnd(ctopt(p->p_tsize + p->p_dsize + p->p_ssize)); + + printf("swapped, swaddr %x\n", p->p_swaddr); + + duse(p->p_swaddr, clrnd(ctod(UPAGES)), DUDOT, p - proc); + + duse(p->p_swaddr + ctod(UPAGES), + + clrnd(i - p->p_tsize / NPTEPG), DPAGET, p - proc); + + /* i, DPAGET, p - proc); */ + + } + + p->p_p0br = (struct pte *)p0br; +++ p->p_addr = uaddr(p); + + p->p_textp = &text[p->p_textp - (struct text *)nl[X_TEXT].n_value]; + + if (p->p_pid == 2) + + continue; +++ if (getu(p)) +++ continue; +++ u.u_procp = p; + + pdmap(); + + if ((p->p_flag & SLOAD) == 0) + + continue; + + pid = p->p_pid; + + for (i = 0; i < p->p_tsize; i++) { + + pte = tptopte(p, i); + + if (pte->pg_fod || pte->pg_pfnum == 0) + + continue; + + if (pte->pg_pfnum >= firstfree && pte->pg_pfnum < maxfree && cmap[pgtocm(pte->pg_pfnum)].c_intrans) + + count(p, pte, ZINTRAN); + + else + + count(p, pte, ZTEXT); + + } + + vprintf("\n"); + + for (i = 0; i < p->p_dsize; i++) { + + pte = dptopte(p, i); + + if (pte->pg_fod || pte->pg_pfnum == 0) + + continue; + + if (pte->pg_pfnum >= firstfree && pte->pg_pfnum < maxfree && cmap[pgtocm(pte->pg_pfnum)].c_intrans) + + count(p, pte, ZINTRAN); + + else + + count(p, pte, ZDATA); + + } + + vprintf("\n"); + + for (i = 0; i < p->p_ssize; i++) { + + pte = sptopte(p, i); + + if (pte->pg_fod || pte->pg_pfnum == 0) + + continue; + + if (pte->pg_pfnum >= firstfree && pte->pg_pfnum < maxfree && cmap[pgtocm(pte->pg_pfnum)].c_intrans) + + count(p, pte, ZINTRAN); + + else + + count(p, pte, ZSTACK); + + } + + vprintf("\n"); - for (w = 0; w < UPAGES; w++) { - int l = p->p_addr[w]; - count(p, (struct pte *)&l, ZUDOT); - } +++ for (i = 0; i < UPAGES; i++) +++ count(p, &p->p_addr[i], ZUDOT); + + vprintf("\n"); + + vprintf("\n"); + + } + + for (xp = &text[0]; xp < &text[NTEXT]; xp++) + + if (xp->x_iptr) { - duse(xp->x_daddr, xp->x_size, DTEXT, xp - text); +++ for (i = 0; i < xp->x_size; i += DMTEXT) +++ duse(xp->x_daddr[i], +++ (xp->x_size - i) > DMTEXT +++ ? DMTEXT : xp->x_size - i, +++ DTEXT, xp - text); + + if (xp->x_flag & XPAGI) - duse(xp->x_daddr + xp->x_size, - clrnd(ctopt(xp->x_size)), DTEXT, xp - text); +++ duse(xp->x_ptdaddr, clrnd(ctopt(xp->x_size)), +++ DTEXT, xp - text); + + } + + dmcheck(); + + fixfree(); + + summary(); + + exit(0); + +} + + + +pdmap() + +{ + + register struct text *xp; + + + + if (fswap == -1 && (u.u_procp->p_flag & SLOAD) == 0) + + return; + + if (Dflg) + + printf("disk for pid %d", u.u_procp->p_pid); - if (xp = u.u_procp->p_textp) { - xp = &text[xp - (struct text *)nl[X_TEXT].n_value]; - if (Dflg) - printf(", text: %x<%x>", xp->x_daddr, xp->x_size); - } +++ if ((xp = u.u_procp->p_textp) && Dflg) +++ ptdmap(xp->x_daddr, xp->x_size); + + pdmseg("data", &u.u_dmap, DDATA); + + pdmseg("stack", &u.u_smap, DSTACK); + + if (Dflg) + + printf("\n"); + +} + + +++ptdmap(dp, size) +++ register daddr_t *dp; +++ int size; +++{ +++ register int i; +++ int rem; +++ +++ if (Dflg) +++ printf(" text:"); +++ for (i = 0, rem = size; rem > 0; i++) { +++ if (Dflg) +++ printf(" %x<%x>", dp[i], rem < DMTEXT ? rem : DMTEXT); +++ rem -= rem < DMTEXT ? rem : DMTEXT; +++ } +++} +++ + +pdmseg(cp, dmp, type) + + char *cp; + + struct dmap *dmp; + +{ + + register int i; + + int b, rem; + + + + if (Dflg) + + printf(", %s:", cp); + + b = DMMIN; + + for (i = 0, rem = dmp->dm_size; rem > 0; i++) { + + if (Dflg) + + printf(" %x<%x>", dmp->dm_map[i], rem < b ? rem : b); + + duse(dmp->dm_map[i], b, type, u.u_procp - proc); + + rem -= b; + + if (b < DMMAX) + + b *= 2; + + } + +} + + + +duse(first, size, type, index) + +{ + + register struct dblks *dp; + + + + if (fswap == -1) + + return; + + dp = &dblks[ndblks]; + + if (++ndblks > NDBLKS) { + + fprintf(stderr, "too many disk blocks, increase NDBLKS\n"); + + exit(1); + + } + + dp->d_first = first; + + dp->d_size = size; + + dp->d_type = type; + + dp->d_index = index; + +} + + + +dsort(d, e) + + register struct dblks *d, *e; + +{ + + + + return (e->d_first - d->d_first); + +} + + + +dmcheck() + +{ + + register struct map *smp; + + register struct dblks *d, *e; + + + + for (smp = swapmap; smp->m_size; smp++) + + duse(smp->m_addr, smp->m_size, DFREE, 0); +++ duse(CLSIZE, DMTEXT - CLSIZE, DFREE, 0); + + qsort(dblks, ndblks, sizeof (struct dblks), dsort); + + d = &dblks[ndblks - 1]; + + if (d->d_first > 1) + + printf("lost swap map: start %x size %x\n", 1, d->d_first); + + for (; d > dblks; d--) { + + if (dflg) + + dprint(d); + + e = d - 1; + + if (d->d_first + d->d_size > e->d_first) { + + printf("overlap in swap mappings:\n"); + + dprint(d); + + dprint(e); + + } else if (d->d_first + d->d_size < e->d_first) { + + printf("lost swap map: start %x size %x\n", + + d->d_first + d->d_size, + + e->d_first - (d->d_first + d->d_size)); + + } + + } + + if (dflg) + + dprint(dblks); + + if (sflg) + + printf("swap space ends at %x\n", d->d_first + d->d_size); + +} + + + +char *dnames[] = { + + "DFREE", + + "DDATA", + + "DSTACK", + + "DTEXT", + + "DUDOT", + + "DPAGET", + +}; + + + +dprint(d) + + register struct dblks *d; + +{ + + + + printf("at %4x size %4x type %s", d->d_first, d->d_size, + + dnames[d->d_type]); + + switch (d->d_type) { + + + + case DSTACK: + + case DDATA: + + printf(" pid %d", proc[d->d_index].p_pid); + + break; + + } + + printf("\n"); + +} + + + +getpt(x, i) + + int x, i; + +{ + + + + lseek(fcore, (long)ctob((x & PG_PFNUM)), 0); + + if (read(fcore, (char *)(p0br[i]), NBPG) != NBPG) { + + perror("read"); + + fprintf(stderr, "getpt error reading frame %x\n", clear(x)); + + return (0); + + } + + return (1); + +} + + + +checkpg(p, pte, type) + + register struct pte *pte; + + register struct proc *p; + + int type; + +{ + + char corepg[NBPG], swapg[NBPG]; + + register int i, count, dblock; + + register int pfnum = pte->pg_pfnum; + + + + if (type == ZPAGET || type == ZUDOT) + + return (0); + + lseek(fcore, (long)(NBPG * pfnum), 0); + + if (read(fcore, corepg, NBPG) != NBPG){ + + perror("read"); + + fprintf(stderr, "Error reading core page %x\n", pfnum); + + return (0); + + } + + switch (type) { + + + + case ZDATA: + + if (ptetodp(p, pte) >= u.u_dmap.dm_size) + + return (0); + + break; + + + + case ZTEXT: + + break; + + + + case ZSTACK: + + if (ptetosp(p, pte) >= u.u_smap.dm_size) + + return (0); + + break; + + + + default: + + return(0); + + break; + + } + + dblock = vtod(p, ptetov(p, pte), &u.u_dmap, &u.u_smap); + + vprintf(" %x", dblock); + + if (pte->pg_fod || pte->pg_pfnum == 0) + + return (0); + + if (cmap[pgtocm(pte->pg_pfnum)].c_intrans || pte->pg_m || pte->pg_swapm) + + return (0); + + lseek(fswap, (long)(NBPG * dblock), 0); + + if (read(fswap, swapg, NBPG) != NBPG) { + + fprintf(stderr,"swap page %x: ", dblock); + + perror("read"); + + } + + count = 0; + + for (i = 0; i < NBPG; i++) + + if (corepg[i] != swapg[i]) + + count++; + + if (count == 0) + + vprintf("\tsame"); + + return (count); + +} + + + +getu(p) + + register struct proc *p; + +{ - int i, w, errs = 0; +++ int i, w, cc, errs = 0; + + + + for (i = 0; i < UPAGES; i++) { + + if (p->p_flag & SLOAD) { - w = p->p_addr[i]; - lseek(fcore, (long)(NBPG * clear(w)), 0); +++ lseek(fcore, ctob(p->p_addr[i].pg_pfnum), 0); + + if (read(fcore, u_area.buf[i], NBPG) != NBPG) + + perror("core u. read"), errs++; + + } else if (fswap >= 0) { + + lseek(fswap, (long)(NBPG * (p->p_swaddr+i)), 0); + + if (read(fswap, u_area.buf[i], NBPG) != NBPG) + + perror("swap u. read"), errs++; + + } + + } + + return (errs); + +} + + + +char *typepg[] = { + + "lost", + + "data", + + "stack", + + "udot", + + "paget", + + "text", + + "free", + + "intransit", + +}; + + + +count(p, pte, type) + + struct proc *p; + + register struct pte *pte; + + int type; + +{ + + register int pfnum = pte->pg_pfnum; + + register struct paginfo *zp = &paginfo[pfnum]; + + int ndif; + +#define zprintf if (type==ZINTRAN || vflg) printf + + + + if (type == ZINTRAN && pfnum == 0) + + return; + + zprintf("page %x %s", pfnum, typepg[type]); + + if (sflg == 0 || (ndif = checkpg(p, pte, type)) == 0) { + + zprintf("\n"); + + } else { + + if (vflg == 0 && type != ZINTRAN) + + printf("page %x %s,", pfnum, typepg[type]); + + printf(" %d bytes differ\n",ndif); + + } + + if (pfnum < firstfree || pfnum > maxfree) { + + printf("page number out of range:\n"); + + printf("\tpage %x type %s pid %d\n", pfnum, typepg[type], pid); + + return; + + } + + if (bad(zp, type)) { + + printf("dup page pte %x", *(int *)pte); + + dumpcm("", pte->pg_pfnum); + + dump(zp); + + printf("pte %x and as %s in pid %d\n", zp->z_pte, typepg[type], pid); + + return; + + } + + zp->z_type = type; + + zp->z_count++; + + zp->z_pid = pid; + + zp->z_pte = *pte; + +} + + + +bad(zp, type) + + struct paginfo *zp; + +{ + + if (type == ZTEXT) { + + if (zp->z_type != 0 && zp->z_type != ZTEXT) + + return (1); + + return (0); + + } + + return (zp->z_count); + +} + + + +dump(zp) + + struct paginfo *zp; + +{ + + + + printf("page %x type %s pid %d ", zp - paginfo, typepg[zp->z_type], zp->z_pid); + +} + + + +summary() + +{ + + register int i; + + register struct paginfo *zp; + + register int pfnum; + + + + for (i = firstfree + UPAGES; i < maxfree; i++) { + + zp = &paginfo[i]; + + if (zp->z_type == ZLOST) + + dumpcm("lost", i); + + pfnum = pgtocm(i); - if ((cmap[pfnum].c_flag & MLOCK) && !(cmap[pfnum].c_flag & MSYS)) +++ if (cmap[pfnum].c_lock && cmap[pfnum].c_type != CSYS) + + dumpcm("locked", i); + + if (mflg) + + dumpcm("mem", i); + + } + +} + + +++char *tynames[] = { +++ "sys", +++ "text", +++ "data", +++ "stack" +++}; + +dumpcm(cp, pg) + + char *cp; + + int pg; + +{ + + int pslot; + + int cm; +++ register struct cmap *c; + + + + printf("%s page %x ", cp, pg); + + cm = pgtocm(pg); - printf("\t[%x, %x", cmap[cm].c_page, cmap[cm].c_ndx); - if ((cmap[cm].c_flag&MTEXT) == 0) - printf(" (=pid %d)", proc[cmap[cm].c_ndx].p_pid); +++ c = &cmap[cm]; +++ printf("\t[%x, %x", c->c_page, c->c_ndx); +++ if (c->c_type != CTEXT) +++ printf(" (=pid %d)", proc[c->c_ndx].p_pid); + + else { - pslot=(text[cmap[cm].c_ndx].x_caddr - (struct proc *)nl[X_PROC].n_value); +++ pslot=(text[c->c_ndx].x_caddr - (struct proc *)nl[X_PROC].n_value); + + printf(" (=pid"); + + for(;;) { + + printf(" %d", proc[pslot].p_pid); + + if (proc[pslot].p_xlink == 0) + + break; + + pslot=(proc[pslot].p_xlink - (struct proc *)nl[X_PROC].n_value); + + } + + printf(")"); + + } - - #define Mflag(x,y) if (cmap[cm].c_flag&x) printf(y); - Mflag(MTEXT, " MTEXT"); - Mflag(MDATA, " MDATA"); - Mflag(MSTACK, "MSTACK"); - Mflag(MSYS, " MSYS"); - Mflag(MFREE, " MFREE"); - Mflag(MLOCK, " MLOCK"); - printf("]\n"); +++ printf("] "); +++ printf(tynames[c->c_type]); +++ if (c->c_free) +++ printf(" free"); +++ if (c->c_gone) +++ printf(" gone"); +++ if (c->c_lock) +++ printf(" lock"); +++ if (c->c_want) +++ printf(" want"); +++ if (c->c_intrans) +++ printf(" intrans"); +++ if (c->c_blkno) +++ printf(" blkno %x mdev %d", c->c_blkno, c->c_mdev); +++ printf("\n"); + +} + + + +fixfree() + +{ + + register int i, next, prev; + + + + next = CMHEAD; + + for (i=freemem/CLSIZE; --i >=0; ) { + + prev = next; + + next = cmap[next].c_next; - if ((cmap[next].c_flag&MFREE) == 0) { +++ if (cmap[next].c_free == 0) { + + printf("link to non free block: in %x to %x\n", cmtopg(prev), cmtopg(next)); + + dumpcm("bad free link in", cmtopg(prev)); + + dumpcm("to non free block", cmtopg(next)); + + } + + if (cmtopg(next) > maxfree) { + + printf("free list link out of range: in %x to %x\n", cmtopg(prev), cmtopg(next)); + + dumpcm("bad link in", cmtopg(prev)); + + } + + paginfo[cmtopg(next)].z_type = ZFREE; + + if (fflg) + + dumpcm("free", cmtopg(next)); + + paginfo[cmtopg(next)+1].z_type = ZFREE; + + if (fflg) + + dumpcm("free", cmtopg(next)+1); + + } + +} + + + +get(loc) + +unsigned loc; + +{ + + int x; + + + + lseek(fcore, (long)clear(loc), 0); + + if (read(fcore, (char *)&x, sizeof (int)) != sizeof (int)) { + + perror("read"); + + fprintf(stderr, "get failed on %x\n", clear(loc)); + + return (0); + + } + + return (x); + +} + +/* + + * Convert a virtual page number + + * to its corresponding disk block number. + + * Used in pagein/pageout to initiate single page transfers. + + */ + +vtod(p, v, dmap, smap) + + register struct proc *p; + + register struct dmap *dmap, *smap; + +{ + + struct dblock db; + + + + if (v < p->p_tsize) - return(p->p_textp->x_daddr + v); +++ return(p->p_textp->x_daddr[v / DMTEXT] + v % DMTEXT); + + if (isassv(p, v)) + + vstodb(vtosp(p, v), 1, smap, &db, 1); + + else + + vstodb(vtodp(p, v), 1, dmap, &db, 0); + + return (db.db_base); + +} + + + +/* + + * Convert a pte pointer to + + * a virtual page number. + + */ + +ptetov(p, pte) + + register struct proc *p; + + register struct pte *pte; + +{ + + + + if (isatpte(p, pte)) + + return (tptov(p, ptetotp(p, pte))); + + else if (isadpte(p, pte)) + + return (dptov(p, ptetodp(p, pte))); + + else + + return (sptov(p, ptetosp(p, pte))); + +} + + + +/* + + * Given a base/size pair in virtual swap area, + + * return a physical base/size pair which is the + + * (largest) initial, physically contiguous block. + + */ + +vstodb(vsbase, vssize, dmp, dbp, rev) + + register int vsbase; + + int vssize; + + register struct dmap *dmp; + + register struct dblock *dbp; + +{ + + register int blk = DMMIN; + + register swblk_t *ip = dmp->dm_map; + + + + if (vsbase < 0 || vsbase + vssize > dmp->dm_size) + + panic("vstodb"); + + while (vsbase >= blk) { + + vsbase -= blk; + + if (blk < DMMAX) + + blk *= 2; + + ip++; + + } + + dbp->db_size = min(vssize, blk - vsbase); + + dbp->db_base = *ip + (rev ? blk - (vsbase + vssize) : vsbase); + +} + + + +panic(cp) + + char *cp; + +{ + + printf("panic!: %s\n", cp); + +} + + + +min(a, b) + +{ + + return (a < b ? a : b); + +} diff --cc usr/src/cmd/ar.c index 0000000000,3d98efb6f1,0000000000..1932e45019 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ar.c +++ b/usr/src/cmd/ar.c @@@@ -1,0 -1,705 -1,0 +1,739 @@@@ +++static char sccsid[] = "@(#)ar.c 4.1 10/1/80"; +++/* +++ * ar - portable (ascii) format version +++ */ + +#include + +#include + +#include + +#include + +#include +++ +++typedef unsigned short ushort; + +struct stat stbuf; + +struct ar_hdr arbuf; +++struct lar_hdr { +++ char lar_name[16]; +++ long lar_date; +++ ushort lar_uid; +++ ushort lar_gid; +++ ushort lar_mode; +++ long lar_size; +++} larbuf; + + + +#define SKIP 1 + +#define IODD 2 + +#define OODD 4 + +#define HEAD 8 + + + +char *man = { "mrxtdpq" }; + +char *opt = { "uvnbail" }; + + + +int signum[] = {SIGHUP, SIGINT, SIGQUIT, 0}; + +int sigdone(); + +long lseek(); + +int rcmd(); + +int dcmd(); + +int xcmd(); + +int tcmd(); + +int pcmd(); + +int mcmd(); + +int qcmd(); + +int (*comfun)(); + +char flg[26]; + +char **namv; + +int namc; + +char *arnam; + +char *ponam; + +char *tmpnam = { "/tmp/vXXXXX" }; + +char *tmp1nam = { "/tmp/v1XXXXX" }; + +char *tmp2nam = { "/tmp/v2XXXXX" }; + +char *tfnam; + +char *tf1nam; + +char *tf2nam; + +char *file; + +char name[16]; + +int af; + +int tf; + +int tf1; + +int tf2; + +int qf; + +int bastate; + +char buf[BUFSIZ]; + + + +char *trim(); + +char *mktemp(); + +char *ctime(); + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + register char *cp; + + + + for(i=0; signum[i]; i++) + + if(signal(signum[i], SIG_IGN) != SIG_IGN) + + signal(signum[i], sigdone); + + if(argc < 3) + + usage(); + + cp = argv[1]; + + for(cp = argv[1]; *cp; cp++) + + switch(*cp) { + + case 'l': + + case 'v': + + case 'u': + + case 'n': + + case 'a': + + case 'b': + + case 'c': + + case 'i': + + flg[*cp - 'a']++; + + continue; + + + + case 'r': + + setcom(rcmd); + + continue; + + + + case 'd': + + setcom(dcmd); + + continue; + + + + case 'x': + + setcom(xcmd); + + continue; + + + + case 't': + + setcom(tcmd); + + continue; + + + + case 'p': + + setcom(pcmd); + + continue; + + + + case 'm': + + setcom(mcmd); + + continue; + + + + case 'q': + + setcom(qcmd); + + continue; + + + + default: + + fprintf(stderr, "ar: bad option `%c'\n", *cp); + + done(1); + + } + + if(flg['l'-'a']) { + + tmpnam = "vXXXXX"; + + tmp1nam = "v1XXXXX"; + + tmp2nam = "v2XXXXX"; - } +++ } + + if(flg['i'-'a']) + + flg['b'-'a']++; + + if(flg['a'-'a'] || flg['b'-'a']) { + + bastate = 1; + + ponam = trim(argv[2]); + + argv++; + + argc--; + + if(argc < 3) + + usage(); + + } + + arnam = argv[2]; + + namv = argv+3; + + namc = argc-3; + + if(comfun == 0) { + + if(flg['u'-'a'] == 0) { + + fprintf(stderr, "ar: one of [%s] must be specified\n", man); + + done(1); + + } + + setcom(rcmd); + + } + + (*comfun)(); + + done(notfound()); + +} + + + +setcom(fun) + +int (*fun)(); + +{ + + + + if(comfun != 0) { + + fprintf(stderr, "ar: only one of [%s] allowed\n", man); + + done(1); + + } + + comfun = fun; + +} + + + +rcmd() + +{ + + register f; + + + + init(); + + getaf(); + + while(!getdir()) { + + bamatch(); + + if(namc == 0 || match()) { + + f = stats(); + + if(f < 0) { + + if(namc) + + fprintf(stderr, "ar: cannot open %s\n", file); + + goto cp; + + } + + if(flg['u'-'a']) - if(stbuf.st_mtime <= arbuf.ar_date) { +++ if(stbuf.st_mtime <= larbuf.lar_date) { + + close(f); + + goto cp; + + } + + mesg('r'); + + copyfil(af, -1, IODD+SKIP); + + movefil(f); + + continue; + + } + + cp: + + mesg('c'); + + copyfil(af, tf, IODD+OODD+HEAD); + + } + + cleanup(); + +} + + + +dcmd() + +{ + + + + init(); + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(match()) { + + mesg('d'); + + copyfil(af, -1, IODD+SKIP); + + continue; + + } + + mesg('c'); + + copyfil(af, tf, IODD+OODD+HEAD); + + } + + install(); + +} + + + +xcmd() + +{ + + register f; + + + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(namc == 0 || match()) { - f = creat(file, arbuf.ar_mode & 0777); +++ f = creat(file, larbuf.lar_mode & 0777); + + if(f < 0) { + + fprintf(stderr, "ar: %s cannot create\n", file); + + goto sk; + + } + + mesg('x'); + + copyfil(af, f, IODD); + + close(f); + + continue; + + } + + sk: + + mesg('c'); + + copyfil(af, -1, IODD+SKIP); + + if (namc > 0 && !morefil()) + + done(0); + + } + +} + + + +pcmd() + +{ + + + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(namc == 0 || match()) { + + if(flg['v'-'a']) { + + printf("\n<%s>\n\n", file); + + fflush(stdout); + + } + + copyfil(af, 1, IODD); + + continue; + + } + + copyfil(af, -1, IODD+SKIP); + + } + +} + + + +mcmd() + +{ + + + + init(); + + if(getaf()) + + noar(); + + tf2nam = mktemp(tmp2nam); + + close(creat(tf2nam, 0600)); + + tf2 = open(tf2nam, 2); + + if(tf2 < 0) { + + fprintf(stderr, "ar: cannot create third temp\n"); + + done(1); + + } + + while(!getdir()) { + + bamatch(); + + if(match()) { + + mesg('m'); + + copyfil(af, tf2, IODD+OODD+HEAD); + + continue; + + } + + mesg('c'); + + copyfil(af, tf, IODD+OODD+HEAD); + + } + + install(); + +} + + + +tcmd() + +{ + + + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(namc == 0 || match()) { + + if(flg['v'-'a']) + + longt(); + + printf("%s\n", trim(file)); + + } + + copyfil(af, -1, IODD+SKIP); + + } + +} + + + +qcmd() + +{ + + register i, f; + + + + if (flg['a'-'a'] || flg['b'-'a']) { + + fprintf(stderr, "ar: abi not allowed with q\n"); + + done(1); + + } + + getqf(); + + for(i=0; signum[i]; i++) + + signal(signum[i], SIG_IGN); + + lseek(qf, 0l, 2); + + for(i=0; i 0) + + if (write(af, buf, i) != i) + + wrerr(); + + } + + if(tf2nam) { + + lseek(tf2, 0l, 0); + + while((i = read(tf2, buf, BUFSIZ)) > 0) + + if (write(af, buf, i) != i) + + wrerr(); + + } + + if(tf1nam) { + + lseek(tf1, 0l, 0); + + while((i = read(tf1, buf, BUFSIZ)) > 0) + + if (write(af, buf, i) != i) + + wrerr(); + + } + +} + + + +/* + + * insert the file 'file' + + * into the temporary file + + */ + +movefil(f) + +{ - register char *cp; - register i; - - cp = trim(file); - for(i=0; i<14; i++) - if(arbuf.ar_name[i] = *cp) - cp++; - arbuf.ar_size = stbuf.st_size; - arbuf.ar_date = stbuf.st_mtime; - arbuf.ar_uid = stbuf.st_uid; - arbuf.ar_gid = stbuf.st_gid; - arbuf.ar_mode = stbuf.st_mode; +++ char buf[sizeof(arbuf)+1]; +++ +++ sprintf(buf, "%-16s%-12ld%-6u%-6u%-8o%-10ld%-2s", +++ trim(file), +++ stbuf.st_mtime, +++ stbuf.st_uid, +++ stbuf.st_gid, +++ stbuf.st_mode, +++ stbuf.st_size, +++ ARFMAG); +++ strncpy((char *)&arbuf, buf, sizeof(arbuf)); +++ larbuf.lar_size = stbuf.st_size; + + copyfil(f, tf, OODD+HEAD); + + close(f); + +} + + + +stats() + +{ + + register f; + + + + f = open(file, 0); + + if(f < 0) + + return(f); + + if(fstat(f, &stbuf) < 0) { + + close(f); + + return(-1); + + } + + return(f); + +} + + + +/* + + * copy next file + + * size given in arbuf + + */ + +copyfil(fi, fo, flag) + +{ + + register i, o; + + int pe; + + - if(flag & HEAD) +++ if(flag & HEAD) { +++ for (i=sizeof(arbuf.ar_name)-1; i>=0; i--) { +++ if (arbuf.ar_name[i]==' ') +++ continue; +++ else if (arbuf.ar_name[i]=='\0') +++ arbuf.ar_name[i] = ' '; +++ else +++ break; +++ } + + if (write(fo, (char *)&arbuf, sizeof arbuf) != sizeof arbuf) + + wrerr(); +++ } + + pe = 0; - while(arbuf.ar_size > 0) { +++ while(larbuf.lar_size > 0) { + + i = o = BUFSIZ; - if(arbuf.ar_size < i) { - i = o = arbuf.ar_size; +++ if(larbuf.lar_size < i) { +++ i = o = larbuf.lar_size; + + if(i&1) { +++ buf[i] = '\n'; + + if(flag & IODD) + + i++; + + if(flag & OODD) + + o++; + + } + + } + + if(read(fi, buf, i) != i) + + pe++; + + if((flag & SKIP) == 0) + + if (write(fo, buf, o) != o) + + wrerr(); - arbuf.ar_size -= BUFSIZ; +++ larbuf.lar_size -= BUFSIZ; + + } + + if(pe) + + phserr(); + +} + + + +getdir() + +{ +++ register char *cp; + + register i; + + + + i = read(af, (char *)&arbuf, sizeof arbuf); + + if(i != sizeof arbuf) { + + if(tf1nam) { + + i = tf; + + tf = tf1; + + tf1 = i; + + } + + return(1); + + } - for(i=0; i<14; i++) - name[i] = arbuf.ar_name[i]; +++ if (strncmp(arbuf.ar_fmag, ARFMAG, sizeof(arbuf.ar_fmag))) { +++ fprintf(stderr, "ar: malformed archive (at %ld)\n", lseek(af, 0L, 1)); +++ done(1); +++ } +++ cp = arbuf.ar_name + sizeof(arbuf.ar_name); +++ while (*--cp==' ') +++ ; +++ *++cp = '\0'; +++ strncpy(name, arbuf.ar_name, sizeof(arbuf.ar_name)); + + file = name; +++ strncpy(larbuf.lar_name, name, sizeof(larbuf.lar_name)); +++ sscanf(arbuf.ar_date, "%ld", &larbuf.lar_date); +++ sscanf(arbuf.ar_uid, "%hd", &larbuf.lar_uid); +++ sscanf(arbuf.ar_gid, "%hd", &larbuf.lar_gid); +++ sscanf(arbuf.ar_mode, "%ho", &larbuf.lar_mode); +++ sscanf(arbuf.ar_size, "%ld", &larbuf.lar_size); + + return(0); + +} + + + +match() + +{ + + register i; + + + + for(i=0; i 1) + + printf("%c - %s\n", c, file); + +} + + + +char * + +trim(s) + +char *s; + +{ + + register char *p1, *p2; + + + + for(p1 = s; *p1; p1++) + + ; + + while(p1 > s) { + + if(*--p1 != '/') + + break; + + *p1 = 0; + + } + + p2 = s; + + for(p1 = s; *p1; p1++) + + if(*p1 == '/') + + p2 = p1+1; + + return(p2); + +} + + + +#define IFMT 060000 + +#define ISARG 01000 + +#define LARGE 010000 + +#define SUID 04000 + +#define SGID 02000 + +#define ROWN 0400 + +#define WOWN 0200 + +#define XOWN 0100 + +#define RGRP 040 + +#define WGRP 020 + +#define XGRP 010 + +#define ROTH 04 + +#define WOTH 02 + +#define XOTH 01 + +#define STXT 01000 + + + +longt() + +{ + + register char *cp; + + + + pmode(); - printf("%3d/%1d", arbuf.ar_uid, arbuf.ar_gid); - printf("%7D", arbuf.ar_size); - cp = ctime(&arbuf.ar_date); +++ printf("%3d/%1d", larbuf.lar_uid, larbuf.lar_gid); +++ printf("%7ld", larbuf.lar_size); +++ cp = ctime(&larbuf.lar_date); + + printf(" %-12.12s %-4.4s ", cp+4, cp+20); + +} + + + +int m1[] = { 1, ROWN, 'r', '-' }; + +int m2[] = { 1, WOWN, 'w', '-' }; + +int m3[] = { 2, SUID, 's', XOWN, 'x', '-' }; + +int m4[] = { 1, RGRP, 'r', '-' }; + +int m5[] = { 1, WGRP, 'w', '-' }; + +int m6[] = { 2, SGID, 's', XGRP, 'x', '-' }; + +int m7[] = { 1, ROTH, 'r', '-' }; + +int m8[] = { 1, WOTH, 'w', '-' }; + +int m9[] = { 2, STXT, 't', XOTH, 'x', '-' }; + + + +int *m[] = { m1, m2, m3, m4, m5, m6, m7, m8, m9}; + + + +pmode() + +{ + + register int **mp; + + + + for (mp = &m[0]; mp < &m[9];) + + select(*mp++); + +} + + + +select(pairp) + +int *pairp; + +{ + + register int n, *ap; + + + + ap = pairp; + + n = *ap++; - while (--n>=0 && (arbuf.ar_mode&*ap++)==0) +++ while (--n>=0 && (larbuf.lar_mode&*ap++)==0) + + ap++; + + putchar(*ap); + +} + + + +wrerr() + +{ + + perror("ar write error"); + + done(1); + +} diff --cc usr/src/cmd/ar11.c index 0000000000,b1099b57d2,0000000000..75ffe61a5d mode 000000,100644,000000..100644 --- a/usr/src/cmd/ar11.c +++ b/usr/src/cmd/ar11.c @@@@ -1,0 -1,664 -1,0 +1,664 @@@@ - +++static char *sccsid = "@(#)ar11.c 4.1 (Berkeley) 10/1/80"; + +/* ar11 - archiver for PDP-11 formatted archives */ + + + +#include + +#include + +#include + +#include + +#define ARMAG -155 /* 017545 */ + +struct ar_hdr { + + char ar_name[14]; + + short ar_date1; + + short ar_date2; + + char ar_uid; + + char ar_gid; + + short ar_mode; + + short ar_size1; + + short ar_size2; + +}; + +int ar_date; + +int ar_size; + +#include + +struct stat stbuf; + +struct ar_hdr arbuf; + +union ints + +{ + + struct fun + + { + + short h1; + + short h2; + + }; + + int w1; + +} x; + + + +#define SKIP 1 + +#define IODD 2 + +#define OODD 4 + +#define HEAD 8 + + + +char *man = { "mrxtdp" }; + +char *opt = { "uvnbai" }; + + + +int signum[] = {SIGHUP, SIGINT, SIGQUIT, 0}; + +int sigdone(); + +int rcmd(); + +int dcmd(); + +int xcmd(); + +int tcmd(); + +int pcmd(); + +int mcmd(); + +int (*comfun)(); + +char flg[26]; + +char **namv; + +int namc; + +char *arnam; + +char *ponam; + +char *tfnam; + +char *tf1nam; + +char *tf2nam; + +char *file; + +char name[16]; + +int af; + +int tf; + +int tf1; + +int tf2; + +int bastate; + +char buf[512]; + + + +char *trim(); + +char *mktemp(); + +char *ctime(); + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + register char *cp; + + + + for(i=0; signum[i]; i++) + + if(signal(signum[i], SIG_IGN) != SIG_IGN) + + signal(signum[i], sigdone); + + if(argc < 3) + + usage(); + + cp = argv[1]; + + for(cp = argv[1]; *cp; cp++) + + switch(*cp) { + + case 'c': + + case 'v': + + case 'u': + + case 'n': + + case 'a': + + case 'b': + + case 'i': + + flg[*cp - 'a']++; + + continue; + + + + case 'r': + + setcom(rcmd); + + continue; + + + + case 'd': + + setcom(dcmd); + + continue; + + + + case 'x': + + setcom(xcmd); + + continue; + + + + case 't': + + setcom(tcmd); + + continue; + + + + case 'p': + + setcom(pcmd); + + continue; + + + + case 'm': + + setcom(mcmd); + + continue; + + + + default: + + fprintf(stderr, "ar11: bad option `%c'\n", *cp); + + done(1); + + } + + if(flg['i'-'a']) + + flg['b'-'a']++; + + if(flg['a'-'a'] || flg['b'-'a']) { + + bastate = 1; + + ponam = trim(argv[2]); + + argv++; + + argc--; + + if(argc < 3) + + usage(); + + } + + arnam = argv[2]; + + namv = argv+3; + + namc = argc-3; + + if(comfun == 0) { + + if(flg['u'-'a'] == 0) { + + fprintf(stderr, "ar11: one of [%s] must be specified\n", man); + + done(1); + + } + + setcom(rcmd); + + } + + (*comfun)(); + + done(notfound()); + +} + + + +setcom(fun) + +int (*fun)(); + +{ + + + + if(comfun != 0) { + + fprintf(stderr, "ar11: only one of [%s] allowed\n", man); + + done(1); + + } + + comfun = fun; + +} + + + +rcmd() + +{ + + register f; + + + + init(); + + if(getaf() && flg['c'-'a']==0) { + + fprintf(stderr, "ar11: %s does not exist\n", arnam); + + done(1); + + } + + while(!getdir()) { + + bamatch(); + + if(namc == 0 || match()) { + + f = stats(); + + if(f < 0) { + + if(namc) + + fprintf(stderr, "ar11: cannot open %s\n", file); + + goto cp; + + } + + if(flg['u'-'a']) + + if(stbuf.st_mtime <= ar_date) { + + close(f); + + goto cp; + + } + + mesg('r'); + + copyfil(af, -1, IODD+SKIP); + + movefil(f); + + continue; + + } + + cp: + + mesg('c'); + + copyfil(af, tf, IODD+OODD+HEAD); + + } + + cleanup(); + +} + + + +dcmd() + +{ + + + + init(); + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(match()) { + + mesg('d'); + + copyfil(af, -1, IODD+SKIP); + + continue; + + } + + mesg('c'); + + copyfil(af, tf, IODD+OODD+HEAD); + + } + + install(); + +} + + + +xcmd() + +{ + + register f; + + + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(namc == 0 || match()) { + + f = creat(file, arbuf.ar_mode & 0777); + + if(f < 0) { + + fprintf(stderr, "ar11: %s cannot create\n", file); + + goto sk; + + } + + mesg('x'); + + copyfil(af, f, IODD); + + close(f); + + continue; + + } + + sk: + + mesg('c'); + + copyfil(af, -1, IODD+SKIP); + + } + +} + + + +pcmd() + +{ + + + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(namc == 0 || match()) { + + if(flg['v'-'a']) { + + printf("\n<%s>\n\n", file); + + fflush(stdout); + + } + + copyfil(af, 1, IODD); + + continue; + + } + + copyfil(af, -1, IODD+SKIP); + + } + +} + + + +mcmd() + +{ + + + + init(); + + if(getaf()) + + noar(); + + tf2nam = mktemp("/tmp/v2XXXXX"); + + close(creat(tf2nam, 0600)); + + tf2 = open(tf2nam, 2); + + if(tf2 < 0) { + + fprintf(stderr, "ar11: cannot create third temp\n"); + + done(1); + + } + + while(!getdir()) { + + bamatch(); + + if(match()) { + + mesg('m'); + + copyfil(af, tf2, IODD+OODD+HEAD); + + continue; + + } + + mesg('c'); + + copyfil(af, tf, IODD+OODD+HEAD); + + } + + install(); + +} + + + +tcmd() + +{ + + + + if(getaf()) + + noar(); + + while(!getdir()) { + + if(namc == 0 || match()) { + + if(flg['v'-'a']) + + longt(); + + printf("%s\n", trim(file)); + + } + + copyfil(af, -1, IODD+SKIP); + + } + +} + + + +init() + +{ + + static short mbuf = ARMAG; + + + + tfnam = mktemp("/tmp/vXXXXX"); + + close(creat(tfnam, 0600)); + + tf = open(tfnam, 2); + + if(tf < 0) { + + fprintf(stderr, "ar11: cannot create temp file\n"); + + done(1); + + } + + if (write(tf, (char *)&mbuf, sizeof(short)) != sizeof(short)) + + wrerr(); + +} + + + +getaf() + +{ + + short mbuf; + + + + af = open(arnam, 0); + + if(af < 0) + + return(1); + + if (read(af, (char *)&mbuf, sizeof(short)) != sizeof(short) || mbuf!=ARMAG) { + + fprintf(stderr, "ar11: %s not in PDP-11 archive format\n", arnam); + + done(1); + + } + + return(0); + +} + + + +usage() + +{ + + printf("usage: ar11 [%s][%s] archive files ...\n", opt, man); + + done(1); + +} + + + +noar() + +{ + + + + fprintf(stderr, "ar11: %s does not exist\n", arnam); + + done(1); + +} + + + +sigdone() + +{ + + done(100); + +} + + + +done(c) + +{ + + + + if(tfnam) + + unlink(tfnam); + + if(tf1nam) + + unlink(tf1nam); + + if(tf2nam) + + unlink(tf2nam); + + exit(c); + +} + + + +notfound() + +{ + + register i, n; + + + + n = 0; + + for(i=0; i 0) + + if (write(af, buf, i) != i) + + wrerr(); + + if(tf2nam) { + + lseek(tf2, 0l, 0); + + while((i = read(tf2, buf, 512)) > 0) + + if (write(af, buf, i) != i) + + wrerr(); + + } + + if(tf1nam) { + + lseek(tf1, 0l, 0); + + while((i = read(tf1, buf, 512)) > 0) + + if (write(af, buf, i) != i) + + wrerr(); + + } + +} + + + +/* + + * insert the file 'file' + + * into the temporary file + + */ + +movefil(f) + +{ + + register char *cp; + + register i; + + + + cp = trim(file); + + for(i=0; i<14; i++) + + if(arbuf.ar_name[i] = *cp) + + cp++; + + x.w1 = stbuf.st_size; + + arbuf.ar_size1 = x.h2; + + arbuf.ar_size2 = x.h1; + + x.w1 = stbuf.st_mtime; + + arbuf.ar_date1 = x.h2; + + arbuf.ar_date2 = x.h1; + + arbuf.ar_uid = stbuf.st_uid; + + arbuf.ar_gid = stbuf.st_gid; + + arbuf.ar_mode = stbuf.st_mode; + + copyfil(f, tf, OODD+HEAD); + + close(f); + +} + + + +stats() + +{ + + register f; + + + + f = open(file, 0); + + if(f < 0) + + return(f); + + if(fstat(f, &stbuf) < 0) { + + close(f); + + return(-1); + + } + + return(f); + +} + + + +/* + + * copy next file + + * size given in arbuf + + */ + +copyfil(fi, fo, flag) + +{ + + register i, o; + + int pe; + + + + if(flag & HEAD) + + if (write(fo, (char *)&arbuf, sizeof arbuf) != sizeof arbuf) + + wrerr(); + + pe = 0; + + while(ar_size > 0) { + + i = o = 512; + + if(ar_size < i) { + + i = o = ar_size; + + if(i&1) { + + if(flag & IODD) + + i++; + + if(flag & OODD) + + o++; + + } + + } + + if(read(fi, buf, i) != i) + + pe++; + + if((flag & SKIP) == 0) + + if (write(fo, buf, o) != o) + + wrerr(); + + ar_size -= 512; + + } + + if(pe) + + phserr(); + +} + + + +getdir() + +{ + + register i; + + + + i = read(af, (char *)&arbuf, sizeof arbuf); + + if(i != sizeof arbuf) { + + if(tf1nam) { + + i = tf; + + tf = tf1; + + tf1 = i; + + } + + return(1); + + } + + for(i=0; i<14; i++) + +{ + + name[i] = arbuf.ar_name[i]; + +} + + file = name; + + ar_date = swap(&arbuf.ar_date1); + + ar_size = swap(&arbuf.ar_size1); + + return(0); + +} + + + +match() + +{ + + register i; + + + + for(i=0; i 1) + + printf("%c - %s\n", c, file); + +} + + + +char * + +trim(s) + +char *s; + +{ + + register char *p1, *p2; + + + + for(p1 = s; *p1; p1++) + + ; + + while(p1 > s) { + + if(*--p1 != '/') + + break; + + *p1 = 0; + + } + + p2 = s; + + for(p1 = s; *p1; p1++) + + if(*p1 == '/') + + p2 = p1+1; + + return(p2); + +} + + + +#define IFMT 060000 + +#define ISARG 01000 + +#define LARGE 010000 + +#define SUID 04000 + +#define SGID 02000 + +#define ROWN 0400 + +#define WOWN 0200 + +#define XOWN 0100 + +#define RGRP 040 + +#define WGRP 020 + +#define XGRP 010 + +#define ROTH 04 + +#define WOTH 02 + +#define XOTH 01 + +#define STXT 01000 + + + +longt() + +{ + + register char *cp; + + + + pmode(); + + printf("%3d/%1d", arbuf.ar_uid, arbuf.ar_gid); + + printf("%7D", ar_size); + + cp = ctime(&ar_date); + + printf(" %-12.12s %-4.4s ", cp+4, cp+20); + +} + + + +int m1[] = { 1, ROWN, 'r', '-' }; + +int m2[] = { 1, WOWN, 'w', '-' }; + +int m3[] = { 2, SUID, 's', XOWN, 'x', '-' }; + +int m4[] = { 1, RGRP, 'r', '-' }; + +int m5[] = { 1, WGRP, 'w', '-' }; + +int m6[] = { 2, SGID, 's', XGRP, 'x', '-' }; + +int m7[] = { 1, ROTH, 'r', '-' }; + +int m8[] = { 1, WOTH, 'w', '-' }; + +int m9[] = { 2, STXT, 't', XOTH, 'x', '-' }; + + + +int *m[] = { m1, m2, m3, m4, m5, m6, m7, m8, m9}; + + + +pmode() + +{ + + register int **mp; + + + + for (mp = &m[0]; mp < &m[9];) + + select(*mp++); + +} + + + +select(pairp) + +int *pairp; + +{ + + register int n, *ap; + + + + ap = pairp; + + n = *ap++; + + while (--n>=0 && (arbuf.ar_mode&*ap++)==0) + + ap++; + + putchar(*ap); + +} + + + +wrerr() + +{ + + perror("ar write error"); + + done(1); + +} + + + +swap(word) + +short *word; + +{ + + x.h1 = ((struct fun *)word)->h2; + + x.h2 = ((struct fun *)word)->h1; + + + + return(x.w1); + +} diff --cc usr/src/cmd/arcv.c index 0000000000,0000000000,0000000000..64e6d76b41 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/arcv.c @@@@ -1,0 -1,0 -1,0 +1,121 @@@@ +++static char sccsid[] = "@(#)arcv.c 4.1 10/1/80"; +++/* +++ * arcv - convert old to new archive format +++ */ +++ +++#include +++#include +++#define OARMAG 0177545 +++struct oar_hdr { +++ char oar_name[14]; +++ long oar_date; +++ char oar_uid; +++ char oar_gid; +++ int oar_mode; +++ long oar_size; +++}; +++ +++struct ar_hdr nh; +++struct oar_hdr oh; +++char *tmp; +++char *mktemp(); +++int f; +++char buf[512]; +++int tf; +++main(argc, argv) +++char *argv[]; +++{ +++ register i; +++ +++ if (argc>1 && strcmp(argv[1], "-t")==0) { +++ tmp = mktemp("/usr/tmp/arcXXXXXX"); +++ argc--; +++ argv++; +++ } else +++ tmp = mktemp("/tmp/arcXXXXXX"); +++ for(i=1; i<4; i++) +++ signal(i, SIG_IGN); +++ for(i=1; i1) +++ printf("%s:\n", argv[i]); +++ conv(argv[i]); +++ } +++ unlink(tmp); +++ return(0); +++} +++ +++conv(fil) +++char *fil; +++{ +++ int oldmagic; +++ long n; +++ unsigned i; +++ +++ f = open(fil, 2); +++ if(f < 0) { +++ printf("arcv: cannot open %s\n", fil); +++ return; +++ } +++ close(creat(tmp, 0600)); +++ tf = open(tmp, 2); +++ if(tf < 0) { +++ printf("arcv: cannot open temp\n"); +++ close(f); +++ return; +++ } +++ oldmagic = 0; +++ read(f, (char *)&oldmagic, sizeof(oldmagic)); +++ if(oldmagic != 0177545) { +++ printf("arcv: %s not old archive format\n", fil); +++ close(tf); +++ close(f); +++ return; +++ } +++ chkwrite(tf, ARMAG, SARMAG); +++loop: +++ i = read(f, (char *)&oh, sizeof(oh)); +++ if(i != sizeof(oh)) +++ goto out; +++ +++ sprintf(buf, "%-16.14s%-12ld%-6u%-6u%-8o%-10ld%-2s", +++ oh.oar_name, +++ oh.oar_date, +++ oh.oar_uid, +++ oh.oar_gid, +++ (unsigned short)oh.oar_mode, +++ oh.oar_size, +++ ARFMAG); +++ strncpy((char *)&nh, buf, sizeof(nh)); +++ n = oh.oar_size; +++ chkwrite(tf, (char *)&nh, sizeof(nh)); +++ while(n > 0) { +++ i = 512; +++ if (n 0) +++ chkwrite(f, buf, i); +++ close(f); +++ close(tf); +++} +++ +++chkwrite(f, b, n) +++char *b; +++{ +++ if (write(f, b, n) != n) { +++ printf("arcv: write error\n"); +++ unlink(tmp); +++ exit(1); +++ } +++} diff --cc usr/src/cmd/arff.c index 0000000000,4ffe2e12f5,0000000000..be128e7d20 mode 000000,100644,000000..100644 --- a/usr/src/cmd/arff.c +++ b/usr/src/cmd/arff.c @@@@ -1,0 -1,751 -1,0 +1,752 @@@@ +++static char *sccsid = "@(#)arff.c 4.2 (Berkeley) 11/3/80"; + +#include + +#include + +#include + +#include + +#include + +#define dbprintf printf + +struct rt_dat { + +unsigned short int rt_yr:5; /*Year - 1972 */ + +unsigned short int rt_dy:5; /*day */ + +unsigned short int rt_mo:5; /*month */ + +}; + +struct rt_axent { + + char rt_sent[14]; + +}; + + + +struct rt_ent { + + char rt_pad; /*unusued */ + + char rt_stat; /*Type of entry, or end of seg*/ + + unsigned short rt_name[3]; /*Name, 3 words in rad50 form */ + + short rt_len; /*Length of file */ + + char rt_chan; /*Only used in temporary files*/ + + char rt_job; /*Only used in temporary files*/ + + struct rt_dat rt_date; /*Creation Date */ + +}; + +#define RT_TEMP 1 + +#define RT_NULL 2 + +#define RT_FILE 4 + +#define RT_ESEG 8 + +#define RT_BLOCK 512 + +struct rt_head { + + short rt_numseg; /*number of segments available*/ + + short rt_nxtseg; /*segment no of next log. seg */ + + short rt_lstseg; /*highest seg currenltly open */ + + unsigned short rt_entpad; /*extra words/dir. entry */ + + short rt_stfile; /*block no where files begin */ + +}; + +struct rt_dir { + + struct rt_head rt_axhead; + + struct rt_ent rt_ents[72]; + + char _dirpad[6]; + +}; + +extern struct rt_dir rt_dir; + +extern int rt_entsiz; + +extern int floppydes; + +extern char *rt_last; + +typedef struct fldope { + + int startad; + + int count; + +struct rt_ent *rtdope; + +} FLDOPE; + +FLDOPE *lookup(); + +#define rt(p) ((struct rt_ent *) p ) + +#define Ain1 03100 + +#define Ain2 050 + +#define flag(c) (flg[(c) - 'a']) + + + +char *man = { "rxtd" }; + + + +char zeroes[512]; + +extern char *val; + +extern char table[256]; + +struct rt_dir rt_dir = {{4,0,1,0,14},{0,RT_NULL,{0,0,0},494,0}, {0,RT_ESEG}}; + +int rt_entsiz; + +int rt_nleft; + +struct rt_ent *rt_curend; + +int floppydes; + +int dirdirty; + +char *rt_last; + +char *defdev = "/dev/floppy"; + + + +char *opt = { "vf" }; + + + +int signum[] = {SIGHUP, SIGINT, SIGQUIT, 0}; + +long lseek(); + +int rcmd(); + +int dcmd(); + +int xcmd(); + +int tcmd(); + +int (*comfun)(); + +char flg[26]; + +char **namv; + +int namc; + +int file; + + + + + +main(argc, argv) + +char *argv[]; + +{ + + register char *cp; + + + + /*register i; + + for(i=0; signum[i]; i++) + + if(signal(signum[i], SIG_IGN) != SIG_IGN) + + signal(signum[i], sigdone);*/ + + if(argc < 2) + + usage(); + + cp = argv[1]; + + for(cp = argv[1]; *cp; cp++) + + switch(*cp) { + + case 'm': + + case 'v': + + case 'u': + + case 'w': + + flg[*cp - 'a']++; + + continue; + + case 'c': + + { + +#define SURE "Are you sure you want to clobber the floppy?\n" + + int tty; - char response[2]; +++ char response[128]; + + tty = open("/dev/tty",2); + + write(tty,SURE,sizeof(SURE)); - read(tty,response,2); +++ read(tty,response,128); + + if(*response!='y') + + exit(50); + + flag('c')++; + + close(tty); + + } + + dirdirty++; + + continue; + + + + case 'r': + + setcom(rcmd); + + flag('r')++; + + continue; + + + + case 'd': + + setcom(dcmd); + + flag('d')++; + + continue; + + + + case 'x': + + setcom(xcmd); + + continue; + + + + case 't': + + setcom(tcmd); + + continue; + + + + case 'f': + + defdev = argv[2]; + + argv++; + + argc--; + + continue; + + + + + + default: + + fprintf(stderr, "arff: bad option `%c'\n", *cp); + + exit(1); + + } + + namv = argv+2; + + namc = argc-2; + + if(comfun == 0) { + + if(flg['u'-'a'] == 0) { + + fprintf(stderr, "arff: one of [%s] must be specified\n", man); + + exit(1); + + } + + setcom(rcmd); + + } + + (*comfun)(); + + exit(notfound()); + +} + + + +setcom(fun) + +int (*fun)(); + +{ + + + + if(comfun != 0) { + + fprintf(stderr, "arff: only one of [%s] allowed\n", man); + + exit(1); + + } + + comfun = fun; + +} + + + + + + + + + + + + + + + + + +usage() + +{ + + printf("usage: ar [%s][%s] archive files ...\n", opt, man); + + exit(1); + +} + + + + + + + +notfound() + +{ + + register i, n; + + + + n = 0; + + for(i=0; i 1) + + printf("%c - %s\n", c, file); + +} + + + +tcmd() + +{ + + register char *de; + + FLDOPE *lookup(), *dope; + + int nleft; register i; + + register struct rt_ent *rde; + + + + rt_init(); + + if(namc==0) + + for(de=((char *)&rt_dir)+10; de <= rt_last; de += rt_entsiz) { + + if(rtls(rt(de))) { + + nleft = (rt_last - de) / rt_entsiz; + + printf("\n\n%d entries remaining.\n",nleft); + + break; + + } + + } + + else + + for(i = 0; i < namc; i++) { + + if(dope = lookup(namv[i])) { + + rde = dope->rtdope; + + rtls(rde); + + namv[i] = 0; + + } + + } + +} + +rtls(de) + +register struct rt_ent *de; + +{ + + int month,day,year; + + char name[12], ext[4]; + + + + if(flg['v'-'a']) + + switch(de->rt_stat) { + + case RT_TEMP: + + printf("Tempfile:\n"); + + case RT_FILE: + + unrad50(2,de->rt_name,name); + + unrad50(1,&(de->rt_name[2]),ext); + + day = de->rt_date.rt_dy; + + year = de->rt_date.rt_yr + 72; + + month = de->rt_date.rt_mo; + + printf("%6.6s %3.3s %02d/%02d/%02d %d\n",name, + + ext,month,day,year,de->rt_len); + + break; + + + + case RT_NULL: + + printf("%-25.9s %d\n","",de->rt_len); + + break; + + + + case RT_ESEG: + + return(1); + + } + + else { + + switch(de->rt_stat) { + + case RT_TEMP: + + case RT_FILE: + + sunrad50(name,de->rt_name); + + printf(name);putchar('\n'); + + break; + + + + case RT_ESEG: + + return(1); + + + + case RT_NULL: + + ; + + } + + } + + return(0); + +} + +xcmd() + +{ + + register char *de; + + char name[12]; + + register int i; + + + + rt_init(); + + if(namc==0) + + for(de=((char *)&rt_dir)+10; de <= rt_last; de += rt_entsiz) { + + sunrad50(name,rt(de)->rt_name); + + rtx(name); + + } + + + + else + + for(i = 0; i < namc; i++) + + if(rtx(namv[i])==0) namv[i] = 0; + +} + +rtx(name) + +char *name; + +{ + + register FLDOPE *dope; + + FLDOPE *lookup(); + + register startad, count; + + int file; char buff[512]; + + + + + + if(dope = lookup(name)) { + + if(flg['v' - 'a']) + + rtls(dope->rtdope); + + else + + printf("x - %s\n",name); + + + + file = creat(name, 0666); + + if(file < 0) return(1); + + count = dope->count; + + startad = dope->startad; + + for( ; count > 0 ; count -= 512) { + + lread(startad,512,buff); + + write(file,buff,512); + + startad += 512; + + } + + close(file); + + return(0); + + } + + return(1); + +} + +rt_init() + +{ + + static initized = 0; + + register char *de; + + int mode; + + + + if(initized) return; + + initized = 1; + + if(flag('c') || flag('d') || flag('r')) + + mode = 2; + + else + + mode = 0; + + if((floppydes = open(defdev,mode)) < 0) + + dbprintf("Floppy open failed\n"); + + if(flag('c')==0) + + lread(6*RT_BLOCK,2*RT_BLOCK,(char *)&rt_dir); + + + + rt_entsiz = 2*rt_dir.rt_axhead.rt_entpad + 14; + + rt_entsiz = 14; + + rt_last = ((char *) &rt_dir) + 10 + 1014/rt_entsiz*rt_entsiz; + + for(de=((char *)&rt_dir)+10; de <= rt_last; de += rt_entsiz) { + + if(rt(de)->rt_stat==RT_ESEG) break; + + } + + rt_curend = rt(de); + + rt_nleft = (rt_last - de) / rt_entsiz; + +} + + + +static FLDOPE result; + +FLDOPE * + +lookup(name) + +char * name; + +{ + + unsigned short rname[3]; + + register char *de; + + register index; + + + + srad50(name,rname); + + + + /* + + * Search for name, accumulate blocks in index + + */ + + rt_init(); + + index = 0; + + for(de = ((char *) &rt_dir) + 10; de <= rt_last; de += rt_entsiz) { + + switch(rt(de)->rt_stat) { + + case RT_ESEG: + + return((FLDOPE *) 0); + + case RT_FILE: + + case RT_TEMP: + + if(samename(rname,rt(de)->rt_name)) + + goto found; + + case RT_NULL: + + index += rt(de)->rt_len; + + } + + } + + return((FLDOPE *) 0); + +found: result.count = rt(de)->rt_len * 512; + + result.startad = 512 * (rt_dir.rt_axhead.rt_stfile + index); + + result.rtdope = (struct rt_ent *) de; + + return(&result); + +} + +static + +samename(a,b) + +unsigned short a[3],b[3]; + +{ + + return( a[0]==b[0] && a[1]==b[1] && a[2]==b[2] ); + +} + + + + + +rad50(cp,out) + +register unsigned char *cp; + +unsigned short *out; + +{ + + register index; + + register temp; + + + + for(index = 0;*cp; index++) { + + + + temp = Ain1 * table[*cp++]; + + if(*cp!=0) { + + temp += Ain2 * table[*cp++]; + + + + if(*cp!=0) + + temp += table[*cp++]; + + } + + + + out[index] = temp; + + } + +} + +#define reduce(x,p,q) \ + + (x = v[p/q], p %= q); + + + +unrad50(count,in,cp) + +unsigned short *in; + +register char *cp; + +{ + + register i, temp; register unsigned char *v = (unsigned char *) val; + + + + for(i = 0; i < count; i++) { + + temp = in[i]; + + + + reduce (*cp++,temp,Ain1); + + reduce (*cp++,temp,Ain2); + + reduce (*cp++,temp,1); + + } + + *cp=0; + +} + + + +srad50(name,rname) + +register char * name; + +register unsigned short *rname; + +{ + + register index; register char *cp; + + char file[7],ext[4]; + + /* + + * Find end of pathname + + */ + + for(cp = name; *cp++; ); + + while(cp >= name && *--cp != '/'); + + cp++; + + /* + + * Change to rad50 + + * + + */ + + for(index = 0; *cp; ){ + + file[index++] = *cp++; + + if(*cp=='.') { + + cp++; + + break; + + } + + if(index>=6) { + + break; + + } + + } + + file[index] = 0; + + for(index = 0; *cp; ){ + + ext[index++] = *cp++; + + if(*cp=='.' || index>=3) { + + break; + + } + + } + + ext[index]=0; + + rname[0] = 0; + + rname[1] = 0; + + rname[2] = 0; + + rad50((unsigned char *)file,rname); + + rad50((unsigned char *)ext,rname+2); + +} + +sunrad50(name,rname) + +unsigned short rname[3]; + +register char *name; + +{ + + register char *cp, *cp2; + + char ext[4]; + + + + unrad50(2,rname,name); + + unrad50(1,rname + 2,ext); + + /* Jam name and extension together with a dot + + deleting white space */ + + for(cp = name; *cp++;);--cp; while(*--cp==' ' && cp>=name); + + *++cp = '.';cp++; + + for(cp2=ext; *cp2!=' ' && cp2 < ext + 3;) { + + *cp++ = *cp2++; + + } + + *cp=0; + + if(cp[-1]=='.') cp[-1] = 0; + +} + + + +static char *oval = " ABCDEFGHIJKLMNOPQRSTUVWXYZ$.@0123456789"; + +static char *val = " abcdefghijklmnopqrstuvwxyz$.@0123456789"; + +static char table[256] = { + +29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, + +29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, + +0, 29, 29, 29, 27, 29, 29, 29, 29, 29, 29, 29, 29, 29, 28, 29, + +30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 29, 29, 29, 29, 29, 29, + +29, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + +16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 29, 29, 29, 29, 29, + +29, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + +16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 29, 29, 29, 29, 29, + +29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, + +29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, + +0, 29, 29, 29, 27, 29, 29, 29, 29, 29, 29, 29, 29, 29, 28, 29, + +30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 29, 29, 29, 29, 29, 29, + +29, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + +16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 29, 29, 29, 29, 29, + +29, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + +16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 29, 29, 29, 29 }; + + + +long trans(logical) + +register int logical; + +{ + + /* Logical to physical adress translation */ + + register int sector, bytes, track; + + + + logical += 26 * 128; + + bytes = (logical & 127); + + logical >>= 7; + + sector = logical % 26; + + if(sector >= 13) + + sector = sector *2 +1; + + else + + sector *= 2; + + sector += 26 + ((track = (logical / 26)) - 1) * 6; + + sector %= 26; + + return( (((track *26) + sector) << 7) + bytes); + +} + +lread(startad,count,obuff) + +register startad, count; + +register char * obuff; + +{ + + long trans(); + + extern floppydes; + + rt_init(); + + if(flg['m'-'a']==0) + + while( (count -= 128) >= 0) { + + lseek(floppydes, trans(startad), 0); + + read(floppydes,obuff,128); + + obuff += 128; + + startad += 128; + + } + + else + + while( (count -= 512) >= 0) { + + lseek(floppydes,(long) (startad), 0); + + read(floppydes,obuff,512); + + obuff += 512; + + startad += 512; + + } + +} + +lwrite(startad,count,obuff) + +register startad, count; + +register char * obuff; + +{ + + long trans(); + + extern floppydes; + + rt_init(); + + if(flg['m'-'a']==0) + + while( (count -= 128) >= 0) { + + lseek(floppydes, trans(startad), 0); + + write(floppydes,obuff,128); + + obuff += 128; + + startad += 128; + + } + + else + + while( (count -= 512) >= 0) { + + lseek(floppydes,(long) (startad), 0); + + write(floppydes,obuff,512); + + obuff += 512; + + startad += 512; + + } + +} + + + +rcmd() + +{ + + register int i; + + + + rt_init(); + + if(namc>0) + + for(i = 0; i < namc; i++) + + if(rtr(namv[i])==0) namv[i]=0; + + + + + +} + + + +rtr(name) + +char *name; + +{ + + register FLDOPE *dope; register struct rt_ent *de; + + struct stat buf; register struct stat *bufp = &buf; + + + + if(stat(name,bufp)<0) return(1); + + if(dope = lookup(name)) { + + /* can replace, no problem */ + + de = dope->rtdope; + + if(bufp->st_size <= (de->rt_len * 512)) + + printf("r - %s\n",name), + + toflop(name,bufp->st_size,dope); + + else { + + printf("%s will not fit in currently used file on floppy\n",name); + + return(1); + + } + + } else { + + /* Search for vacant spot */ + + for(de = rt_dir.rt_ents; (char *) de <= rt_last; de++) { + + switch((de)->rt_stat) { + + case RT_NULL: + + if(bufp->st_size <= (de->rt_len * 512)) { + + printf("a - %s\n",name), + + mkent(de,bufp,name); + + goto found; + + } + + continue; + + case RT_ESEG: + + return(3); + + } + + } + + return(5); + + } + +found: if(dope=lookup(name)) { + + toflop(name,bufp->st_size,dope); + + return(0); + + } + + return(7); + + + +} + +mkent(de,bufp,name) + +register struct rt_ent *de; + +register struct stat *bufp; + +char *name; + +{ + + struct tm *localtime(); register struct tm *timp; + + register struct rt_ent *workp; int count; + + + + count = (((bufp->st_size -1) >>9) + 1); + + /* Make sure there is room */ + + if(de->rt_len==count) + + goto overwrite; + + if(rt_nleft==0) { + + if(flg['o'-'a']) + + goto overwrite; + + fprintf(stderr,"Directory full on %s\n",defdev); + + exit(1); + + } + + /* copy directory entries up */ + + for(workp = rt_curend+1; workp > de; workp--) + + *workp = workp[-1]; + + de[1].rt_len -= count; + + de->rt_len = count; + + rt_curend++; + + rt_nleft--; + +overwrite: + + srad50(name,de->rt_name); + + timp = localtime(&bufp->st_mtime); + + de->rt_date.rt_dy = timp->tm_mday + 1; + + de->rt_date.rt_mo = timp->tm_mon + 1; + + de->rt_date.rt_yr = timp->tm_year - 72; + + de->rt_stat = RT_FILE; + + de->rt_pad = 0; + + de->rt_chan = 0; + + de->rt_job = 0; + + lwrite(6*RT_BLOCK,2*RT_BLOCK,(char *)&rt_dir); + + + +} + + + +toflop(name,ocount,dope) + +char *name; + +register FLDOPE *dope; + +long ocount; + +{ + + register file, n, startad = dope->startad, count = ocount; + + char buff[512]; + + + + file = open(name,0); + + if(file < 0) { + + printf("arff: couldn't open %s\n",name);exit(1);} + + for( ; count >= 512; count -= 512) { + + read(file,buff,512); + + lwrite(startad,512,buff); + + startad += 512; + + } + + read(file,buff,count); + + close(file); + + if(count <= 0) return; + + for(n = count; n < 512; n ++) buff[n] = 0; + + lwrite(startad,512,buff); + + count = (dope->rtdope->rt_len * 512 - ocount) / 512 ; + + if(count <= 0) return; + + for( ; count > 0 ; count--) { + + startad += 512; + + lwrite(startad,512,zeroes); + + } + + + +} + +dcmd() + +{ + + register int i; + + + + rt_init(); + + if(namc) + + for(i = 0; i < namc; i++) + + if(rtk(namv[i])==0) namv[i]=0; + + if(dirdirty) + + scrunch(); + + + +} + +rtk(name) + +char *name; + +{ + + register FLDOPE *dope; + + register struct rt_ent *de; + + FLDOPE *lookup(); + + + + if(dope = lookup(name)) { + + printf("d - %s\n",name); + + de = dope->rtdope; + + de->rt_stat = RT_NULL; + + de->rt_name[0] = 0; + + de->rt_name[1] = 0; + + de->rt_name[2] = 0; + + * ((unsigned short *) & (de->rt_date)) = 0; + + dirdirty = 1; + + return(0); + + } + + return(1); + +} + +scrunch() { + + register struct rt_ent *de = rt_dir.rt_ents, *workp; + + for(de = rt_dir.rt_ents; de <= rt_curend; de++) { + + if(de->rt_stat==RT_NULL && de[1].rt_stat==RT_NULL) { + + (de+1)->rt_len += de->rt_len; + + for(workp = de; workp < rt_curend; workp++) + + *workp = workp[1]; + + de--; + + rt_curend--; + + rt_nleft++; + + } + + } + + lwrite(6*RT_BLOCK,2*RT_BLOCK,(char *)&rt_dir); + +} diff --cc usr/src/cmd/as/as.h index 0000000000,58d35b977c,0000000000..ca6cfbc439 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/as.h +++ b/usr/src/cmd/as/as.h @@@@ -1,0 -1,332 -1,0 +1,476 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* "@(#)as.h 4.8 11/5/80" */ +++#ifdef VMS +++# define vax 1 +++# define VAX 1 +++#endif VMS +++ +++#include +++#ifdef UNIX +++ +++#ifdef FLEXNAMES +++# include +++# include +++#else not FLEXNAMES +++# define ONLIST +++# include "a.out.h" +++# include +++#endif FLEXNAMES +++ +++#endif UNIX +++#ifdef VMS +++ +++#ifdef UNIXDEVEL +++# include +++#else not UNIXDEVEL +++# include +++#endif not UNIXDEVEL +++ +++#endif VMS +++ + +#define readonly - #define NINST 300 - #define NSYM 4000 - #define NHASH (NSYM+1) - #define NLOC 4 /* number of location ctrs */ - #define NCPS 8 /* number of characters per symbol, fixed */ +++#define NINST 300 +++ +++#define NEXP 20 /* max number of expr. terms per instruction */ +++#define NARG 6 /* max number of args per instruction */ +++#define NHASH 1103 /* hash table is dynamically extended */ +++#define TNAMESIZE 32 /* maximum length of temporary file names */ +++#define NLOC 4 /* number of location ctrs */ +++ +++#ifdef UNIX +++# ifndef FLEXNAMES +++# ifndef NCPS +++# define NCPS 8 /* number of characters per symbol*/ +++# endif +++# else +++# ifdef NCPS +++# undef NCPS +++# endif +++# define NCPS BUFSIZ /* needed to allocate yytext */ +++# endif +++# endif UNIX +++ +++# ifdef VMS +++# ifdef NCPS +++# undef NCPS +++# endif NCPS +++# define NCPS 15 +++# endif VMS + + + +/* + + * Symbol types + + */ + +#define XUNDEF 0x0 + +#define XABS 0x2 + +#define XTEXT 0x4 + +#define XDATA 0x6 + +#define XBSS 0x8 - #define XDATAO 0xA - #define XBSSO 0xC - #define XTEXTO 0xE - #define XABSO 0x10 - #define XUNDEFO 0x12 + + - #define XTXRN 0xA /* external symbol */ + +#define XXTRN 0x1 + +#define XTYPE 0x1E + + + +#define XFORW 0x20 /* Was forward-referenced when undefined */ + + + +#define ERR (-1) + +#define NBPW 32 /* Bits per word */ + + + +#define AMASK 017 + + + +/* + + * Actual argument syntax types + + */ - #define AREG 1 /* %r */ - #define ABASE 2 /* (%r) */ - #define ADECR 3 /* -(%r) */ - #define AINCR 4 /* (%r)+ */ - #define ADISP 5 /* expr(%r) */ - #define AEXP 6 /* expr */ - #define AIMM 7 /* $ expr */ - #define ASTAR 8 /* * */ - #define AINDX 16 /* [%r] */ +++#define AREG 1 /* %r */ +++#define ABASE 2 /* (%r) */ +++#define ADECR 3 /* -(%r) */ +++#define AINCR 4 /* (%r)+ */ +++#define ADISP 5 /* expr(%r) */ +++#define AEXP 6 /* expr */ +++#define AIMM 7 /* $ expr */ +++#define ASTAR 8 /* * */ +++#define AINDX 16 /* [%r] */ + + + +/* + + * Argument access types used to test validity of operands to operators + + */ - #define ACCA (8<<3) /* address only */ - #define ACCR (1<<3) /* read */ - #define ACCW (2<<3) /* write */ - #define ACCM (3<<3) /* modify */ - #define ACCB (4<<3) /* branch displacement */ - #define ACCI (5<<3) /* XFC code */ +++#define ACCR (1<<3) /* read */ +++#define ACCW (2<<3) /* write */ +++#define ACCB (4<<3) /* branch displacement */ +++#define ACCA (8<<3) /* address only */ +++#define ACCM (ACCR | ACCW) /* modify */ +++#define ACCI (ACCB | ACCR) /* XFC code */ +++ +++#define ACCESSMASK (ACCA | ACCR | ACCW | ACCB) /* the mask */ +++ +++/* +++ * Argument data types +++ * Also used to tell outrel what it is relocating +++ * (possibly in combination with RELOC_PCREL and TYPNONE) +++ */ +++#define TYPB 0 /* byte */ +++#define TYPW 1 /* word */ +++#define TYPL 2 /* long */ +++#define TYPQ 3 /* quad */ +++#define TYPF 4 /* floating */ +++#define TYPD 5 /* double floating */ +++#define TYPNONE 6 /* when nothing */ +++#define RELOC_PCREL 8 /* implicit argument to outrel; ==> PCREL */ +++ +++#define TYPMASK 7 + + + +/* - * Argument data types +++ * reference types for loader + + */ - #define TYPB 0 /* byte */ - #define TYPW 1 /* word */ - #define TYPL 2 /* long */ - #define TYPQ 3 /* quad */ - #define TYPF 4 /* floating */ - #define TYPD 5 /* double floating */ - - #define TYPMASK 7 - - /* reference types for loader */ - #define PCREL 1 - #define LEN1 2 - #define LEN2 4 - #define LEN4 6 - #define LEN8 8 - - #define TMPC 7 /* offset into the string /tmp/aaaXXX for creating tmp file names*/ +++#define PCREL 1 +++#define LEN1 2 +++#define LEN2 4 +++#define LEN4 6 +++#define LEN8 8 +++ +++extern int reflen[]; /* {LEN*+PCREL} ==> number of bytes */ +++extern int lgreflen[]; /* {LEN*+PCREL} ==> lg number of bytes */ +++extern int len124[]; /* {1,2,4,8} ==> {LEN1, LEN2, LEN4, LEN8} */ +++extern char mod124[]; /* {1,2,4,8} ==> {bits to construct operands */ +++extern int type_124[]; /* {1,2,4,8} ==> {TYPB, TYPW, TYPL, TYPQ} */ +++extern int ty_NORELOC[]; /* {TYPB..TYPD} ==> {1 if relocation not OK */ +++extern int ty_LEN[]; /* {TYPB..TYPD} ==> {LEN1..LEN8} */ +++extern int ty_nbyte[]; /* {TYPB..TYPD} ==> {1,2,4,8} */ +++extern int ty_nlg[]; /* {TYPB..TYPD} ==> lg{1,2,4,8} */ +++ +++#define TMPC 7 + +#define HW 01 + +#define FW 03 + +#define DW 07 + + - #include +++#ifdef UNIX +++# include +++#endif UNIX +++ +++#ifdef VMS +++# define PAGRND 0x1FFL +++#endif VMS + + + +#define round(x,y) (((x)+(y)) & ~(y)) + + + +#define STABTYPS 0340 - #define STABFLAG 0200 +++#define STABFLAG 0200 + + + +/* + + * Follows are the definitions for the symbol table tags, which are + + * all unsigned characters.. + + * High value tags are generated by the asembler for internal + + * use. + + * Low valued tags are the parser coded tokens the scanner returns. + + * There are several pertinant bounds in this ordering: + + * a) Symbols greater than JXQUESTIONABLE + + * are used by the jxxx bumper, indicating that + + * the symbol table entry is a jxxx entry + + * that has yet to be bumped. + + * b) Symbols greater than IGNOREBOUND are not + + * bequeathed to the loader; they are truly + + * for assembler internal use only. + + * c) Symbols greater than OKTOBUMP represent + + * indices into the program text that should + + * be changed in preceeding jumps or aligns + + * must get turned into their long form. + + */ + + - #define TAGMASK 0xFF +++#define TAGMASK 0xFF + + - # define JXACTIVE 0xFF /*jxxx instruction size unknown*/ - # define JXNOTYET 0xFE /*jxxx instruction size known, but not yet expanded*/ +++# define JXACTIVE 0xFF /*jxxx size unknown*/ +++# define JXNOTYET 0xFE /*jxxx size known, but not yet expanded*/ + +# define JXALIGN 0xFD /*align jxxx entry*/ - # define JXINACTIVE 0xFC /*jxxx instruction size known and expanded*/ +++# define JXINACTIVE 0xFC /*jxxx size known and expanded*/ + + - #define JXQUESTIONABLE 0xFB +++#define JXQUESTIONABLE 0xFB + + - # define JXTUNNEL 0xFA /*jxxx instruction that jumps to another*/ +++# define JXTUNNEL 0xFA /*jxxx that jumps to another*/ + +# define OBSOLETE 0xF9 /*erroneously entered symbol*/ + + - #define IGNOREBOUND 0xF8 /*symbols greater than this are ignored*/ +++#define IGNOREBOUND 0xF8 /*symbols greater than this are ignored*/ + +# define STABFLOATING 0xF7 + +# define LABELID 0xF6 + + + +#define OKTOBUMP 0xF5 + +# define STABFIXED 0xF4 + + + +/* + + * astoks.h contains reserved word codings the parser should + + * know about + + */ + +#include "astoks.h" + + + +/* + + * The structure for one symbol table entry. + + * Symbol table entries are used for both user defined symbols, + + * and symbol slots generated to create the jxxx jump from + + * slots. +++ * Caution: the instructions are stored in a shorter version +++ * of the struct symtab, using all fields in sym_nm and +++ * tag. The fields used in sym_nm are carefully redeclared +++ * in struct Instab and struct instab (see below). +++ * If struct nlist gets changed, then Instab and instab may +++ * have to be changed. + + */ + + - #define symfirstfields char *name; unsigned char tag, type - + +struct symtab{ - symfirstfields; - #ifdef vax - short ___hole; - #endif - /*save*/ char ptype; /*tag == NAME*/ - - #define jxbump ptype /*tag == JX..., how far to expand*/ - - /*save*/ char other; /*for stab info*/ - - /*save*/ short desc; /*tag == NAME*/ - - #define jxfear desc /*how far needs to be bumped*/ - - /*save*/ long value; /*address in the segment*/ - char jxoveralign; /*if a JXXX, jumped over an align*/ - short index; /*which segment*/ - struct symtab *dest; /*if JXXX, where going to*/ +++ struct nlist s_nm; +++ u_char s_tag; /* assembler tag */ +++ u_char s_ptype; /* if tag == NAME */ +++ u_char s_jxoveralign; /* if a JXXX, jumped over align */ +++ short s_index; /* which segment */ +++ struct symtab *s_dest; /* if JXXX, where going to */ + +#ifdef DJXXX - short jxline; /*source line of the jump from*/ +++ short s_jxline; /* source line of the jump from */ + +#endif + +}; - - struct instab{ - symfirstfields; - - #define opcode type /*use the same field as symtab.type*/ - - char nargs; /*how many arguments*/ - char argtype[6]; /*argument type info*/ +++/* +++ * Redefinitions of the fields in symtab for +++ * use when the symbol table entry marks a jxxx instruction. +++ */ +++#define s_jxbump s_ptype /* tag == JX..., how far to expand */ +++#define s_jxfear s_desc /* how far needs to be bumped */ +++/* +++ * Redefinitions of fields in the struct nlist for symbols so that +++ * one saves typing, and so that they conform +++ * with the old naming conventions. +++ */ +++#ifdef FLEXNAMES +++#define s_name s_nm.n_un.n_name /* name pointer */ +++#define s_nmx s_nm.n_un.n_strx /* string table index */ +++#else not FLEXNAMES +++#define s_name s_nm.n_name +++#endif +++#define s_type s_nm.n_type /* type of the symbol */ +++#define s_other s_nm.n_other /* other information for sdb */ +++#define s_desc s_nm.n_desc /* type descriptor */ +++#define s_value s_nm.n_value /* value of the symbol, or sdb delta */ +++ +++struct instab{ +++ struct nlist s_nm; /* instruction name, type (opcode) */ +++ u_char s_tag; +++ char s_pad[3]; /* round to 20 bytes */ + +}; +++/* +++ * The fields nm.n_desc and nm.n_value total 6 bytes; this is +++ * just enough for the 6 bytes describing the argument types. +++ * We use a macro to define access to these 6 bytes, assuming that +++ * they are allocated adjacently. +++ * IF THE FORMAT OF STRUCT nlist CHANGES, THESE MAY HAVE TO BE CHANGED. +++ * +++ * Instab is cleverly declared to look very much like the combination of +++ * a struct symtab and a struct nlist. +++ */ +++struct Instab{ +++#ifdef FLEXNAMES +++ char *I_name; +++#else not FLEXNAMES +++ char I_name[NCPS]; +++#endif +++ u_char I_opcode; +++ char I_nargs; +++ char I_args[6]; +++ u_char I_s_tag; +++ char I_pad[3]; /* round to 20 bytes */ +++}; +++/* +++ * Redefinitions of fields in the struct nlist for instructions so that +++ * one saves typing, and conforms to the old naming conventions +++ */ +++#define i_opcode s_nm.n_type /* use the same field as symtab.type */ +++#define i_nargs s_nm.n_other /* number of arguments */ +++#define fetcharg(ptr, n) ((struct Instab *)ptr)->I_args[n] + + + +struct arg { /*one argument to an instruction*/ - char atype; - char areg1; - char areg2; - char dispsize; /*usually d124, unless have B^, etc*/ - struct exp *xp; +++ char a_atype; +++ char a_areg1; +++ char a_areg2; +++ char a_dispsize; /*usually d124, unless have B^, etc*/ +++ struct exp *a_xp; + +}; + + + +struct exp { - char xtype; - char xloc; - long xvalue; - struct symtab *xname; - union{ - double dvalue; - struct { - unsigned int doub_MSW, doub_LSW; - } dis_dvalue; - } doubval; +++ long e_xvalue; /* MUST be the first field (look at union Double) */ +++ long e_yvalue; /* MUST be second field; least sig word of a double */ +++ char e_xtype; +++ char e_xloc; +++ struct symtab *e_xname; +++}; +++ +++#define doub_MSW e_xvalue +++#define doub_LSW e_yvalue +++ +++union Double { +++ struct{ +++ long doub_MSW; +++ long doub_LSW; +++ } dis_dvalue; +++ double dvalue; +++}; +++ +++struct Quad { +++ long quad_low_long; +++ long quad_high_long; + +}; + + + +/* + + * Magic layout macros + + */ + +#define MINBYTE -128 + +#define MAXBYTE 127 + +#define MINWORD -32768 + +#define MAXWORD 32767 + + + +#define LITFLTMASK 0x000043F0 /*really magic*/ + +/* + + * Is the floating point double word in xp a + + * short literal floating point number? + + */ - #define slitflt(xp) \ - ( (xp->doubval.dis_dvalue.doub_LSW == 0) \ - && ((xp->doubval.dis_dvalue.doub_MSW & LITFLTMASK) \ - == xp->doubval.dis_dvalue.doub_MSW) ) - - #define extlitflt(xp) \ - xp->doubval.dis_dvalue.doub_MSW >> 4 - +++#define slitflt(xp) \ +++ ( (xp->doub_LSW == 0) \ +++ && ( (xp->doub_MSW & LITFLTMASK) \ +++ == xp->doub_MSW) ) + +/* - * Structure that appears at the head of a.out +++ * If it is a slitflt, then extract the 6 interesting bits + + */ - struct hdr { - long magic; - long tsize; - long dsize; - long bsize; - long ssize; - long entry; - long trsize; - long drsize; - }; - - struct arg arglist[6]; /*building operands in instructions*/ - struct exp explist[20]; /*building up a list of expressions*/ +++#define extlitflt(xp) \ +++ xp->doub_MSW >> 4 + + +++ extern struct arg arglist[NARG]; /*building operands in instructions*/ +++ extern struct exp explist[NEXP]; /*building up a list of expressions*/ +++ extern struct exp *xp; /*current free expression*/ + + /* + + * Communication between the scanner and the jxxx handlers. + + * lastnam: the last name seen on the input + + * lastjxxx: pointer to the last symbol table entry for + + * a jump from + + */ + + extern struct symtab *lastnam; + + extern struct symtab *lastjxxx; +++ +++#ifdef VMS +++ extern char *vms_obj_ptr; /* object buffer pointer */ +++ extern char sobuf[]; /* object buffer */ +++ extern int objfil; /* VMS object file descriptor */ +++#endif VMS +++ + + /* - * For each of the named .text .data segments - * (introduced by .text ), we maintain - * the current value of the dot, and the Files where - * the information for each of the segments is salted - * away. - * - * Use of rulesfile and usefile is unclear - */ - extern struct exp usedot[NLOC+NLOC]; - extern FILE *usefile[NLOC+NLOC]; - extern FILE *rusefile[NLOC+NLOC]; - /* - * Strings used to construct the temporary files - * for each of the named segments in pass 2. +++ * Lgensym is used to make up funny names for local labels. +++ * lgensym[i] is the current funny number to put after +++ * references to if, lgensym[i]-1 is for ib. +++ * genref[i] is set when the label is referenced before +++ * it is defined (i.e. 2f) so that we can be sure these +++ * labels are always defined to avoid weird diagnostics +++ * from the loader later. + + */ - extern char *tmpn2; /* /tmp/aaaXXXX */ - extern char *tmpn3; /* /tmp/aabXXX */ +++ extern int lgensym[10]; +++ extern char genref[10]; + + - extern struct exp *dotp; /*the current dot location*/ +++ extern char tmpn1[TNAMESIZE]; /* Interpass temporary */ +++ extern struct exp *dotp; /* the current dot location */ + + extern int loctr; - extern long tsize; /* total text size */ - extern long dsize; /* total data size */ - extern long datbase; /* base of the data segment */ +++ +++ extern struct exec hdr; /* a.out header */ +++ extern u_long tsize; /* total text size */ +++ extern u_long dsize; /* total data size */ +++ extern u_long trsize; /* total text relocation size */ +++ extern u_long drsize; /* total data relocation size */ +++ extern u_long datbase; /* base of the data segment */ + + /* + + * Bitoff and bitfield keep track of the packing into + + * bytes mandated by the expression syntax ':' + + */ + + extern int bitoff; + + extern long bitfield; + + + + /* + + * The lexical analyzer builds up symbols in yytext. Lookup + + * expects its argument in this buffer + + */ + + extern char yytext[NCPS+2]; /* text buffer for lexical */ + + /* + + * Variables to manage the input assembler source file + + */ + + extern int lineno; /*the line number*/ + + extern char *dotsname; /*the name of the as source*/ - /*extern FILE stdin*;*/ /*the as source input*/ + + - extern FILE *txtfil; /* file for text*/ + + extern FILE *tmpfil; /* interpass communication*/ - extern FILE *relfil; /* holds relocation informtion*/ + + + + extern int passno; /* 1 or 2 */ + + + + extern int anyerrs; /*errors assembling arguments*/ + + extern int silent; /*don't mention the errors*/ + + extern int savelabels; /*save labels in a.out*/ - int orgwarn; /* questionable origin ? */ - int useVM; /*use virtual memory temp file*/ +++ extern int orgwarn; /* questionable origin ? */ +++ extern int useVM; /*use virtual memory temp file*/ +++ extern int jxxxJUMP; /*use jmp instead of brw for jxxx */ +++ extern int readonlydata; /*initialized data into text space*/ + +#ifdef DEBUG + + extern int debug; + + extern int toktrace; + +#endif + + /* + + * Information about the instructions + + */ - struct instab *itab[NINST]; /*maps opcodes to instructions*/ - extern readonly struct instab instab[]; +++ extern struct instab *itab[NINST]; /*maps opcodes to instructions*/ +++ extern readonly struct Instab instab[]; + + - int curlen; /*current storage size*/ +++ extern int curlen; /*current literal storage size*/ +++ extern int d124; /*current pointer storage size*/ + + + + struct symtab **lookup(); /*argument in yytext*/ + + struct symtab *symalloc(); + + - #ifdef METRIC - int outcounters; /*should we print them?*/ - int nhcollision; - int nhashed; - int nentered; - int lgtmpfile; - int jxxxiterate; - int jxxxtunnel; /*how many tunnel jumps done*/ - int jxdeadlock; - int nbadjxsegs; - #endif - +++#define outb(val) {dotp->e_xvalue++; if (passno==2) bputc((val), (txtfil));} + + - #define outb(val) {dotp->xvalue++; if (passno==2) putc((val), txtfil);} - - #define outs(cp, lg) dotp->xvalue += (lg); if (passno == 2) fwrite((cp), 1, (lg), txtfil) +++#define outs(cp, lg) dotp->e_xvalue += (lg); if (passno == 2) bwrite((cp), (lg), (txtfil)) + + + +/* + + * Most of the time, the argument to flushfield is a power of two constant, + + * the calculations involving it can be optimized to shifts. + + */ + +#define flushfield(n) if (bitoff != 0) Flushfield( ( (bitoff+n-1) /n ) * n) +++ +++/* +++ * The biobuf structure and associated routines are used to write +++ * into one file at several places concurrently. Calling bopen +++ * with a biobuf structure sets it up to write ``biofd'' starting +++ * at the specified offset. You can then use ``bwrite'' and/or ``bputc'' +++ * to stuff characters in the stream, much like ``fwrite'' and ``fputc''. +++ * Calling bflush drains all the buffers and MUST be done before exit. +++ */ +++struct biobuf { +++ short b_nleft; /* Number free spaces left in b_buf */ +++/* Initialize to be less than BUFSIZ initially, to boundary align in file */ +++ char *b_ptr; /* Next place to stuff characters */ +++ char b_buf[BUFSIZ]; /* The buffer itself */ +++ off_t b_off; /* Current file offset */ +++ struct biobuf *b_link; /* Link in chain for bflush() */ +++}; +++#define bputc(c,b) ((b)->b_nleft ? (--(b)->b_nleft, *(b)->b_ptr++ = (c)) \ +++ : bflushc(b, c)) +++#define BFILE struct biobuf +++ +++ extern BFILE *biobufs; /* head of the block I/O buffer chain */ +++ extern int biofd; /* file descriptor for block I/O file */ +++ extern off_t boffset; /* physical position in logical file */ +++ +++ /* +++ * For each of the named .text .data segments +++ * (introduced by .text ), we maintain +++ * the current value of the dot, and the BFILE where +++ * the information for each of the segments is placed +++ * during the second pass. +++ */ +++ extern struct exp usedot[NLOC + NLOC]; +++ extern BFILE *usefile[NLOC + NLOC]; +++ extern BFILE *txtfil;/* file for text and data: into usefile */ +++ /* +++ * Relocation information for each segment is accumulated +++ * seperately from the others. Writing the relocation +++ * information is logically viewed as writing to one +++ * relocation saving file for each segment; physically +++ * we have a bunch of buffers allocated internally that +++ * contain the relocation information. +++ */ +++ struct relbufdesc *rusefile[NLOC + NLOC]; +++ struct relbufdesc *relfil; diff --cc usr/src/cmd/as/ascode.c index 0000000000,cd33244278,0000000000..1cf20f596e mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/ascode.c +++ b/usr/src/cmd/as/ascode.c @@@@ -1,0 -1,274 -1,0 +1,375 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)ascode.c 4.7 11/5/80"; + +#include + +#include "as.h" + +#include "assyms.h" + + +++/* +++ * Loader reference types (plust PCREL) to bytes and lg bytes +++ */ +++/* LEN1 LEN1+PC LEN2 LEN2+PC LEN4 LEN4+PC LEN8 LEN8+PC*/ +++int reflen[] = /* {LEN*+PCREL} ==> number of bytes */ +++{0, 0, 1, 1, 2, 2, 4, 4, 8, 8}; +++int lgreflen[] = /* {LEN*+PCREL} ==> lg number of bytes */ +++{-1, -1, 0, 0, 1, 1, 2, 2, 3, 3}; +++ +++/* +++ * Sizes to Loader reference types and type flags +++ */ +++/*0 1 2 3 4 5 6 7 8*/ +++int len124[] = /* {1,2,4,8} ==> {LEN1, LEN2, LEN4, LEN8} */ +++{0, LEN1, LEN2, 0, LEN4, 0, 0, 0, LEN8}; +++char mod124[] = /* {1,2,4,8} ==> {bits to construct operands */ +++{0, 0x00, 0x20, 0, 0x40, 0, 0, 0, 0}; +++int type_124[] = /* {1,2,4,8} ==> {TYPB, TYPW, TYPL, TYPQ} */ +++{0, TYPB, TYPW, 0, TYPL, 0, 0, 0, TYPQ}; +++ +++/* +++ * type flags to Loader reference and byte lengths +++ */ +++/*TYPB TYPW TYPL TYPQ TYPF TYPD*/ +++int ty_NORELOC[] = /* {TYPB..TYPD} ==> {1 if relocation not OK */ +++{0, 0, 0, 1, 1, 1}; +++int ty_LEN[] = /* {TYPB..TYPD} ==> {LEN1..LEN8} */ +++{LEN1, LEN2, LEN4, LEN8, LEN4, LEN8}; +++int ty_nbyte[] = /* {TYPB..TYPD} ==> {1,2,4,8} */ +++{1, 2, 4, 8, 4, 8}; +++int ty_nlg[] = /* {TYPB..TYPD} ==> lg{1,2,4,8} */ +++{0, 1, 2, 3, 2, 3}; +++ + +insout(op, ap, nact) + + struct arg *ap; + +{ - int jxxflg; - +++ int jxxflg; +++ register struct instab *ip; /* the instruction */ +++ register struct arg *ap_walk; /* actual param walk */ +++ register int i; +++ register int ap_type; /* actual param type */ +++ register int ap_type_mask; /* masked actual param */ + + op &= 0xFF; + + jxxflg = nact; + + if (nact < 0) + + nact = -nact; - if (passno!=2) { - register struct arg *ap2; - register struct instab *ip; - int i,nexp; - ip = itab[op]; - nexp = ip->nargs; - if (nact < nexp) - yyerror("Too few arguments"); - if (nact > nexp) { - yyerror("Too many arguments"); - nact = nexp; - } +++ if (passno == 1) { +++ ip = itab[op]; +++ if (nact < ip->i_nargs) +++ yyerror("Too few arguments"); +++ if (nact > ip->i_nargs) { +++ yyerror("Too many arguments"); +++ nact = ip->i_nargs; +++ } +++ /* +++ * Check argument compatability with instruction template +++ */ +++ for (ap_walk = ap, i = 1; i <= nact; ap_walk++, i++){ +++ ap_type = ap_walk->a_atype; +++ ap_type_mask = ap_type & AMASK; + + /* - * Check argument compatability with instruction template +++ * The switch value is >> by 3 so that the switch +++ * code is dense, not implemented as a sequence +++ * of branches but implemented as a casel. +++ * In addition, cases ACCI and ACCR are added to force +++ * dense switch code. + + */ - for (ap2 = ap+nact, i = nact; --i >= 0;) - argcompat(--ap2, ip->argtype[i], i); - } +++ switch( ((fetcharg(ip, i-1)) & ACCESSMASK)>>3){ /* type of fp */ +++ case ACCI >> 3: +++ case ACCR >> 3: +++ break; +++ case ACCB >> 3: +++ if ( !((ap_type_mask == AEXP) || (ap_type_mask == AIMM)) ){ +++ yyerror("arg %d, branch displacement must be an expression",i); +++ return; +++ } +++ break; +++ case ACCA >> 3: +++ switch(ap_type_mask){ +++ case AREG: yyerror("arg %d, addressing a register",i); +++ return; +++ case AIMM: if ( !(ap_type & ASTAR) ){ +++ yyerror("arg %d, addressing an immediate operand",i); +++ return; +++ } +++ } +++ break; +++ case ACCM >> 3: +++ case ACCW >> 3: +++ switch(ap_type_mask){ +++ case AIMM: if (!(ap_type&ASTAR)) { +++ yyerror("arg %d, modifying a constant",i); +++ return; +++ } +++ } +++ break; +++ } /* end of the switch on fp_type */ +++ if (ap_type & AINDX) { +++ if (ap_walk->a_areg2==0xF) { +++ yyerror("arg %d, PC used as index",i); +++ return; +++ } +++ switch(ap_type_mask){ +++ case AREG: yyerror("arg %d, indexing the register file",i); +++ return; +++ case AIMM: yyerror("arg %d, indexing a constant",i); +++ return; +++ case ADECR: +++ case AINCR: if (ap_walk->a_areg1==ap_walk->a_areg2) { +++ yyerror("arg %d, indexing with modified register",i); +++ return; +++ } +++ break; +++ } /* end of switch on ap_type_mask */ +++ } /* end of AINDX */ +++ } +++ } /* both passes here */ + + if (jxxflg < 0) + + ijxout(op, ap, nact); + + else putins(op, ap, nact); + +} + + - argcompat(act, exp, i) - struct arg *act; - int exp,i; - { - register at,atm; - - at = act->atype; - atm = at & AMASK; - - if ((exp & ACCA) && (atm == AREG)) { - yyerror("arg %d, addressing a register",i); - return; - } - if ((exp&ACCW) && (atm==AIMM) && !(at&ASTAR)) { - yyerror("arg %d, modifying a constant",i); - return; - } - if (at & AINDX) { - if (act->areg2==017) { - yyerror("arg %d, PC used as index",i); - return; - } - if (atm==AREG) { - yyerror("arg %d, indexing the register file",i); - return; - } - if (atm==AIMM) { - yyerror("arg %d, indexing a constant",i); - return; - } - if (((atm==ADECR) || (atm==AINCR)) && (act->areg1==act->areg2)) { - yyerror("arg %d, indexing with modified register",i); - return; - } - } - } - - int d124 = {4}; - int len124[] = {0,LEN1,LEN2,0,LEN4}; - char mod124[] = {0,0x00,0x20,0,0x40}; +++extern int d124; + + + +putins(op, ap, n) + + /* + + * n had better be positive + + */ + + register struct arg *ap; + +{ + + register struct exp *xp; - register int a; - int i,xtrab; +++ register int argtype; +++ int i; +++ int reloc_how; + + - if (passno!=2) { - dotp->xvalue += n+1; /* 1 for the opcode, at least 1 per arg */ - for (i=0; iatype; - if (a & AINDX) - dotp->xvalue++; - switch (a&~(AINDX|ASTAR)) { - case AEXP: { - a = itab[op]->argtype[i]; - if (a == ACCB+TYPB) - break; - if (a==ACCB+TYPW){ - dotp->xvalue++; - break; - } - dotp->xvalue += ap->dispsize; - break; - } - case ADISP: { - xp=ap->xp; - if ((xp->xtype&XTYPE)!=XABS || xp->xtype&XFORW){ - dotp->xvalue += ap->dispsize; - break; - } - if (xp->xvalue==0 && !(a&ASTAR)) +++#ifdef DEBUG +++ fflush(stdout); +++#endif +++ if (passno == 2) +++ goto PASS2; +++ +++ dotp->e_xvalue += n+1; /* 1 for the opcode, at least 1 per arg */ +++ for (i=0; ia_atype; +++ if (argtype & AINDX) +++ dotp->e_xvalue++; +++ /* +++ * This switch has been fixed by enumerating the no action +++ * alternatives (those that have 1 one byte of code) +++ * so that a casel instruction is emitted. +++ */ +++ switch (argtype&~(AINDX|ASTAR)) { +++ case AREG: +++ case ABASE: +++ case ADECR: +++ case AINCR: +++ break; +++ case AEXP: +++ argtype = fetcharg(itab[op], i); +++ if (argtype == ACCB+TYPB) +++ break; +++ if (argtype==ACCB+TYPW){ +++ dotp->e_xvalue++; +++ break; +++ } +++ /* +++ * Reduces to PC relative +++ */ +++ dotp->e_xvalue += ap->a_dispsize; +++ break; +++ +++ case ADISP: +++ xp=ap->a_xp; +++ if ((xp->e_xtype&XTYPE)!=XABS || xp->e_xtype&XFORW){ +++ dotp->e_xvalue += ap->a_dispsize; +++ break; +++ } +++ if (xp->e_xvalue==0 && !(argtype&ASTAR)) +++ break; +++ dotp->e_xvalue++; +++ if ((xp->e_xvaluee_xvalue>MAXBYTE)) +++ dotp->e_xvalue++; +++ if ((xp->e_xvaluee_xvalue>MAXWORD)) +++ dotp->e_xvalue += 2; +++ break; +++ +++ case AIMM: +++ if (ap->a_atype&ASTAR) argtype=TYPL; +++ else { +++ argtype = fetcharg(itab[op], i); +++ if (argtype&ACCA) +++ argtype = TYPL; +++ else +++ argtype &= TYPMASK; +++ xp = ap->a_xp; +++ if ( ((xp->e_xtype&XTYPE)==XABS) +++ && (!(xp->e_xtype&XFORW)) +++ && (xp->e_xvalue>=0) +++ && (xp->e_xvalue<=63) +++ && (xp->e_yvalue == 0) +++ && (argtype != TYPD) +++ && (argtype != TYPF) +++ ) + + break; - dotp->xvalue++; - if ((xp->xvaluexvalue>MAXBYTE)) - dotp->xvalue++; - if ((xp->xvaluexvalue>MAXWORD)) - dotp->xvalue += 2; - break; +++ } +++ switch (argtype) { +++ case TYPD: +++ case TYPF: +++ if ( !(((xp->e_xtype&XTYPE)==XABS) +++ && (!(xp->e_xtype&XFORW)) +++ && (slitflt(xp))) +++ ){ +++ /* it is NOT short */ +++ dotp->e_xvalue += ((argtype==TYPF)? +++ 4 : 8); + + } - case AIMM: { - if (ap->atype&ASTAR) a=TYPL; - else { - xp = ap->xp; - if ((xp->xtype&XTYPE)==XABS && !(xp->xtype&XFORW) - && xp->xvalue>=0 && xp->xvalue<=63) - break; - a = itab[op]->argtype[i]; - if (a&ACCA) - a = TYPL; - else - a &= TYPMASK; - } - switch (a) { - case TYPD: - case TYPF: - if (slitflt(xp)) - break; - if (a==TYPF) - dotp->xvalue -= 4; - case TYPQ: - dotp->xvalue += 4; - case TYPL: - dotp->xvalue += 2; - case TYPW: - dotp->xvalue++; - case TYPB: - dotp->xvalue++; - } /*end of the switch on a*/ - } /*end of case AIMM*/ - } /*end of the switch on the type*/ - } /*end of looping for all arguments*/ - return; - } /*end of it being time for pass 1*/ - /* - * PASS2 HERE - */ +++ break; +++ case TYPQ: +++ dotp->e_xvalue += 8;break; +++ case TYPL: +++ dotp->e_xvalue += 4;break; +++ case TYPW: +++ dotp->e_xvalue += 2;break; +++ case TYPB: +++ dotp->e_xvalue += 1;break; +++ } /*end of the switch on argtype*/ +++ } /*end of the switch on the type*/ +++ } /*end of looping for all arguments*/ +++ return; +++ +++PASS2: + + +++#ifdef UNIX + + outb(op); /* the opcode */ +++#endif UNIX +++#ifdef VMS +++ *vms_obj_ptr++ = -1; *vms_obj_ptr++ = (char)op; +++ dotp->e_xvalue += 1; +++#endif VMS +++ + + for (i=0; iatype; - xp=ap->xp; - xtrab=0; - if (a&AINDX) { - { outb(0x40 | ap->areg2); } - a &= ~AINDX; +++ argtype=ap->a_atype; +++ xp=ap->a_xp; +++ reloc_how = TYPNONE; +++ if (argtype&AINDX) { +++#ifdef UNIX +++ { outb(0x40 | ap->a_areg2); } +++#endif UNIX +++#ifdef VMS +++ { *vms_obj_ptr++ = -1; +++ *vms_obj_ptr++ = (0x40 | ap->a_areg2); +++ dotp->e_xvalue += 1; } +++#endif VMS +++ argtype &= ~AINDX; + + } - if (a&ASTAR) { - ap->areg1 |= 0x10; - a &= ~ASTAR; +++ if (argtype&ASTAR) { +++ ap->a_areg1 |= 0x10; +++ argtype &= ~ASTAR; + + } - switch (a) { - case AREG: /* %r */ - ap->areg1 |= 0x50; - break; - case ABASE: /* (%r) */ - ap->areg1 |= 0x60; - break; - case ADECR: /* -(%r) */ - ap->areg1 |= 0x70; - break; - case AINCR: /* (%r) */ - ap->areg1 |= 0x80; +++ switch (argtype) { +++ case AREG: /* %r */ +++ ap->a_areg1 |= 0x50; +++ break; +++ case ABASE: /* (%r) */ +++ ap->a_areg1 |= 0x60; +++ break; +++ case ADECR: /* -(%r) */ +++ ap->a_areg1 |= 0x70; +++ break; +++ case AINCR: /* (%r)+ */ +++ ap->a_areg1 |= 0x80; +++ break; +++ case AEXP: /* expr */ +++ argtype = fetcharg(itab[op], i); +++ if (argtype == ACCB+TYPB) { +++ ap->a_areg1 = argtype = +++ xp->e_xvalue - (dotp->e_xvalue + 1); +++ if (argtypeMAXBYTE) +++ yyerror("Branch too far"); break; +++ } +++ if (argtype == ACCB+TYPW) { +++ ap->a_areg1 = argtype = xp->e_xvalue +++ -= dotp->e_xvalue + 2; +++ xp->e_xtype = XABS; +++ if (argtypeMAXWORD) +++ yyerror("Branch too far"); +++ xp->e_xvalue = argtype>>8; +++ reloc_how = TYPB; + + break; - case AEXP: {/* expr */ - a = itab[op]->argtype[i]; - if (a == ACCB+TYPB) { - ap->areg1 = a = - xp->xvalue - (dotp->xvalue + 1); - if (aMAXBYTE) - yyerror("Branch too far"); break; - } - if (a == ACCB+TYPW) { - ap->areg1 = a = xp->xvalue - -= dotp->xvalue + 2; - xp->xtype = XABS; - if (aMAXWORD) - yyerror("Branch too far"); - xp->xvalue = a>>8; - xtrab = LEN1; - break; - } - /* reduces to expr(pc) mode */ - ap->areg1 |= (0xAF + mod124[ap->dispsize]); - xtrab = len124[ap->dispsize]+PCREL; +++ } +++ /* reduces to expr(pc) mode */ +++ ap->a_areg1 |= (0xAF + mod124[ap->a_dispsize]); +++ reloc_how = type_124[ap->a_dispsize] + RELOC_PCREL; +++ break; +++ +++ case ADISP: /* expr(%r) */ +++ ap->a_areg1 |= 0xA0; +++ if ((xp->e_xtype&XTYPE)!=XABS || xp->e_xtype&XFORW){ +++ ap->a_areg1 += mod124[ap->a_dispsize]; +++ reloc_how = type_124[ap->a_dispsize]; + + break; + + } - case ADISP: {/* expr(%r) */ - ap->areg1 |= 0xA0; - if ((xp->xtype&XTYPE)!=XABS || xp->xtype&XFORW){ - ap->areg1 += mod124[ap->dispsize]; - xtrab=len124[ap->dispsize]; - break; - } - if (xp->xvalue==0 && !(ap->areg1&0x10)) { - ap->areg1 ^= 0xC0; - break; - } - xtrab=LEN1; - if ((xp->xvaluexvalue>MAXBYTE)){ - ap->areg1 += 0x20; - xtrab=LEN2; - } - if ((xp->xvaluexvalue>MAXWORD)){ - ap->areg1 += 0x20; - xtrab=LEN4; - } +++ if (xp->e_xvalue==0 && !(ap->a_areg1&0x10)) { +++ ap->a_areg1 ^= 0xC0; + + break; + + } - case AIMM: { /* $expr */ - if (ap->atype&ASTAR) - a=TYPL; - else { - if ( ( (xp->xtype&XTYPE) == XABS) - && !(xp->xtype&XFORW) - && (xp->xvalue >= 0) - && (xp->xvalue <= 63) ) { - ap->areg1 = xp->xvalue; - break; - } - a = itab[op]->argtype[i]; - if (a&ACCA) - a=TYPL; - else - a &= TYPMASK; +++ reloc_how = TYPB; +++ if ((xp->e_xvaluee_xvalue>MAXBYTE)){ +++ ap->a_areg1 += 0x20; +++ reloc_how = TYPW; +++ } +++ if ((xp->e_xvaluee_xvalue>MAXWORD)){ +++ ap->a_areg1 += 0x20; +++ reloc_how = TYPL; +++ } +++ break; +++ +++ case AIMM: /* $expr */ +++ if (ap->a_atype&ASTAR) +++ argtype=TYPL; +++ else { +++ argtype = fetcharg(itab[op], i); +++ if (argtype&ACCA) +++ argtype=TYPL; +++ else +++ argtype &= TYPMASK; +++ if ( ( (xp->e_xtype&XTYPE) == XABS) +++ && !(xp->e_xtype&XFORW) +++ && (xp->e_xvalue >= 0) +++ && (xp->e_xvalue <= 63) +++ && (xp->e_yvalue == 0) +++ && (argtype != TYPF) +++ && (argtype != TYPD) ) { +++ ap->a_areg1 = xp->e_xvalue; +++ break; + + } - ap->areg1 |= 0x8F; - switch (a) { - case TYPD: - case TYPF: - if (slitflt(xp)){ - ap->areg1=extlitflt(xp); - break; - } - if (a==TYPF) { - xtrab = LEN4; - break; - } - case TYPQ: xtrab = LEN8; break; - case TYPL: xtrab = LEN4; break; - case TYPW: xtrab = LEN2; break; - case TYPB: xtrab = LEN1; break; +++ } +++ ap->a_areg1 |= 0x8F; +++ reloc_how = argtype; +++ if (reloc_how == TYPD || reloc_how == TYPF){ +++ if ( ((xp->e_xtype&XTYPE)==XABS) +++ && (!(xp->e_xtype&XFORW)) +++ && (slitflt(xp)) +++ ){ +++ reloc_how = TYPNONE; +++ ap->a_areg1=extlitflt(xp); + + } - } /*end of the switch on AIMM*/ - } /*end of the switch on a*/ +++ } +++ break; +++ +++ } /*end of the switch on argtype*/ + + /* + + * use the first byte to describe the argument + + */ - outb(ap->areg1); - if (xtrab) - outrel(&xp->xvalue, xtrab, xp->xtype, xp->xname); +++#ifdef UNIX +++ outb(ap->a_areg1); +++#endif UNIX +++#ifdef VMS +++ *vms_obj_ptr++ = -1; *vms_obj_ptr++ = (char)(ap->a_areg1); +++ dotp->e_xvalue += 1; +++ if ((vms_obj_ptr-sobuf) > 400) { +++ write(objfil,sobuf,vms_obj_ptr-sobuf); +++ vms_obj_ptr=sobuf+1; +++ } +++#endif VMS +++ if (reloc_how != TYPNONE) +++ outrel(xp, reloc_how); + + } /*end of the for to pick up all arguments*/ + +} diff --cc usr/src/cmd/as/asexpr.c index 0000000000,e8aa8861d4,0000000000..0d1336a9c2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/asexpr.c +++ b/usr/src/cmd/as/asexpr.c @@@@ -1,0 -1,296 -1,0 +1,423 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)asexpr.c 4.2 8/15/80"; + +#include + +#include "as.h" + +#include "asexpr.h" + + + +/* + + * Tables for combination of operands. + + */ +++#define XTXRN 5<<1 /* indexes last row/column when right shifted */ + + + +/* + + * table for + + + */ + +readonly char pltab[6][6] = { + +/* UND ABS TXT DAT BSS EXT */ + + + +/*UND*/ XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, + +/*ABS*/ XUNDEF, XABS, XTEXT, XDATA, XBSS, XXTRN, + +/*TXT*/ XUNDEF, XTEXT, ERR, ERR, ERR, ERR, + +/*DAT*/ XUNDEF, XDATA, ERR, ERR, ERR, ERR, + +/*BSS*/ XUNDEF, XBSS, ERR, ERR, ERR, ERR, + +/*EXT*/ XUNDEF, XXTRN, ERR, ERR, ERR, ERR, + +}; + + + +/* + + * table for - + + */ + +readonly char mintab[6][6] = { + +/* UND ABS TXT DAT BSS EXT */ + + + +/*UND*/ XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, + +/*ABS*/ XUNDEF, XABS, ERR, ERR, ERR, ERR, + +/*TXT*/ XUNDEF, XTEXT, XABS, ERR, ERR, ERR, + +/*DAT*/ XUNDEF, XDATA, ERR, XABS, ERR, ERR, + +/*BSS*/ XUNDEF, XBSS, ERR, ERR, XABS, ERR, + +/*EXT*/ XUNDEF, XXTRN, ERR, ERR, ERR, ERR, + +}; + + + +/* + + * table for other operators + + */ + +readonly char othtab[6][6] = { + +/* UND ABS TXT DAT BSS EXT */ + + + +/*UND*/ XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, + +/*ABS*/ XUNDEF, XABS, ERR, ERR, ERR, ERR, + +/*TXT*/ XUNDEF, ERR, ERR, ERR, ERR, ERR, + +/*DAT*/ XUNDEF, ERR, ERR, ERR, ERR, ERR, + +/*BSS*/ XUNDEF, ERR, ERR, ERR, ERR, ERR, + +/*EXT*/ XUNDEF, ERR, ERR, ERR, ERR, ERR, + +}; + + + +struct exp * + +combine(op, exp1, exp2) + + register struct exp *exp1, *exp2; + +{ + + register e1_type, e2_type; - register type; +++ register back_type; + + + + lastnam=0; /* kludge for jxxx instructions */ + + - e1_type = exp1->xtype&XTYPE; - e2_type = exp2->xtype&XTYPE; +++ e1_type = exp1->e_xtype&XTYPE; +++ e2_type = exp2->e_xtype&XTYPE; + + - if (exp1->xtype==XXTRN+XUNDEF) +++ if (exp1->e_xtype==XXTRN+XUNDEF) + + e1_type = XTXRN; - if (exp2->xtype==XXTRN+XUNDEF) +++ if (exp2->e_xtype==XXTRN+XUNDEF) + + e2_type = XTXRN; + + if (passno==1) - if (exp1->xloc!=exp2->xloc && e1_type==e2_type) +++ if (exp1->e_xloc!=exp2->e_xloc && e1_type==e2_type) + + e1_type = e2_type = XTXRN; /* error on != loc ctrs */ - e1_type >>= 1; /*dispost of the external (XXTRN) bit*/ +++ e1_type >>= 1; /*dispose of the external (XXTRN) bit*/ + + e2_type >>= 1; + + + + switch (op) { + + case PLUS: - exp1->xvalue += exp2->xvalue; - type = pltab[e1_type][e2_type]; +++ exp1->e_xvalue += exp2->e_xvalue; +++ back_type = pltab[e1_type][e2_type]; + + break; + + case MINUS: - exp1->xvalue -= exp2->xvalue; - type = mintab[e1_type][e2_type]; +++ exp1->e_xvalue -= exp2->e_xvalue; +++ back_type = mintab[e1_type][e2_type]; + + break; + + case IOR: - exp1->xvalue |= exp2->xvalue; +++ exp1->e_xvalue |= exp2->e_xvalue; + + goto comm; + + case XOR: - exp1->xvalue ^= exp2->xvalue; +++ exp1->e_xvalue ^= exp2->e_xvalue; + + goto comm; + + case AND: - exp1->xvalue &= exp2->xvalue; +++ exp1->e_xvalue &= exp2->e_xvalue; + + goto comm; + + case ORNOT: - exp1->xvalue |= ~exp2->xvalue; +++ exp1->e_xvalue |= ~exp2->e_xvalue; + + goto comm; + + case LSH: - exp1->xvalue <<= exp2->xvalue; +++ exp1->e_xvalue <<= exp2->e_xvalue; + + goto comm; + + case RSH: - exp1->xvalue >>= exp2->xvalue; +++ exp1->e_xvalue >>= exp2->e_xvalue; + + goto comm; + + case TILDE: - exp1->xvalue |= ~ exp2->xvalue; +++ exp1->e_xvalue |= ~ exp2->e_xvalue; + + goto comm; + + case MUL: - exp1->xvalue *= exp2->xvalue; +++ exp1->e_xvalue *= exp2->e_xvalue; + + goto comm; + + case DIV: - if (exp2->xvalue == 0) +++ if (exp2->e_xvalue == 0) + + yyerror("Divide check"); + + else - exp1->xvalue /= exp2->xvalue; +++ exp1->e_xvalue /= exp2->e_xvalue; + + goto comm; + + case REGOP: - if (exp2->xvalue == 0) +++ if (exp2->e_xvalue == 0) + + yyerror("Divide check (modulo)"); + + else - exp1->xvalue %= exp2->xvalue; +++ exp1->e_xvalue %= exp2->e_xvalue; + + goto comm; + + + + comm: - type = othtab[e1_type][e2_type]; +++ back_type = othtab[e1_type][e2_type]; + + break; + + default: + + yyerror("Internal error: unknown operator"); + + } + + + + if (e2_type==(XTXRN>>1)) - exp1->xname = exp2->xname; - exp1->xtype = type | ( - (exp1->xtype|exp2->xtype) & (XFORW|XXTRN) ); - if (type==ERR) +++ exp1->e_xname = exp2->e_xname; +++ exp1->e_xtype = back_type | ( +++ (exp1->e_xtype|exp2->e_xtype) & (XFORW|XXTRN) ); +++ if (back_type==ERR) + + yyerror("Relocation error"); + + return(exp1); + +} + + + +buildtokensets() + +{ + +#define clobber(val, set) tokensets[(val)] |= (set) + + + + clobber(SEMI, LINSTBEGIN); + + clobber(NL, LINSTBEGIN); +++ clobber(INT, LINSTBEGIN); + + + + clobber(NAME, YUKKYEXPRBEG + LINSTBEGIN); + + clobber(INSTn, YUKKYEXPRBEG); + + clobber(INST0, YUKKYEXPRBEG); + + clobber(REG, YUKKYEXPRBEG); +++ clobber(BFINT, YUKKYEXPRBEG); + + + + clobber(INT, SAFEEXPRBEG); + + clobber(FLTNUM, SAFEEXPRBEG); + + + + clobber(PLUS, ADDOPS); + + clobber(MINUS, ADDOPS + EBEGOPS); + + + + clobber(LP, EBEGOPS); + + + + clobber(IOR, BOOLOPS); + + clobber(XOR, BOOLOPS); + + clobber(AND, BOOLOPS); + + clobber(ORNOT, BOOLOPS); + + + + clobber(TILDE, MULOPS + EBEGOPS); + + clobber(LSH, MULOPS); + + clobber(RSH, MULOPS); + + clobber(MUL, MULOPS); + + clobber(DIV, MULOPS); + + clobber(REGOP, MULOPS); /* % */ +++ + +} + + + +/* + + * We keep the current token class in this global variable, so + + * the recursive descent expression analyzers can talk amongst + + * themselves, and so that we may use the macros shift and shift over + + */ + + + +extern int yylval; /*the value of the lexical value*/ + +extern struct exp *xp; /*the next free expression slot*/ + + + +static int val; + +int exprparse(inval, backexpr) /*return the value the read head is sitting on*/ + + int inval; + + struct exp **backexpr; + +{ + + register struct exp *lexpr; + + int op; + + + + val = inval; + + lexpr = boolterm(); + + while (INTOKSET(val, ADDOPS)){ + + op = val; + + shift; + + lexpr = combine(op, lexpr, boolterm()); + + } + + *backexpr = lexpr; + + return(val); + +} + + + +struct exp *boolterm() + +{ + + register struct exp *lexpr; + + int op; + + + + lexpr = term(); + + while(INTOKSET(val, BOOLOPS)){ + + op = val; + + shift; + + lexpr = combine(op, lexpr, term()); + + } + + return(lexpr); + +} + + + +struct exp *term() + +{ + + register struct exp *lexpr; + + int op; + + + + lexpr = factor(); + + while(INTOKSET(val, MULOPS)){ + + op = val; + + shift; + + lexpr = combine(op, lexpr, factor()); + + } + + return(lexpr); + +} + + + +struct exp *factor() + +{ + + struct exp *lexpr; + + int op; + + extern int droppedLP; /*called exprparse after consuming an LP*/ + + + + if (val == LP || droppedLP){ + + if (droppedLP) + + droppedLP = 0; + + else + + shift; /*the LP*/ + + val = exprparse(val, &lexpr); + + if (val != RP) + + yyerror("right parenthesis expected"); + + else + + shift; + + } else + + if (INTOKSET(val, YUKKYEXPRBEG)){ + + lexpr = yukkyexpr(val, yylval); + + shift; + + } + + else if (INTOKSET(val, SAFEEXPRBEG)){ + + lexpr = (struct exp *)yylval; + + shift; + + } + + else if ( (val == TILDE) || (val == MINUS) ){ + + op = val; + + shift; + + lexpr = xp++; - lexpr->xtype = XABS; - lexpr->xvalue = 0; +++ lexpr->e_xtype = XABS; +++ lexpr->e_xvalue = 0; + + lexpr = combine(op, lexpr, factor()); + + } + + else { + + yyerror("Bad expression syntax"); + + lexpr = xp++; - lexpr->xtype = XABS; - lexpr->xvalue = 0; +++ lexpr->e_xtype = XABS; +++ lexpr->e_xvalue = 0; + + } + + return(lexpr); + +} + + + +struct exp *yukkyexpr(val, np) + + int val; + + register np; + +{ + + register struct exp *locxp; + + extern int exprisname; /*last factor is a name*/ + + + + exprisname = 0; + + locxp = xp++; - if (val == NAME){ +++ if (val == NAME || val == BFINT){ +++ if (val == BFINT) { +++ int off = 0; +++ yylval = ((struct exp *)np)->e_xvalue; +++ if (yylval < 0) { +++ yylval = -yylval; +++ yylval--; +++ off = -1; +++ if (lgensym[yylval] == 1) +++ yyerror("Reference to undefined local label %db", yylval); +++ } else { +++ yylval--; +++ genref[yylval] = 1; +++ } +++ sprintf(yytext, "L%d\001%d", yylval, lgensym[yylval] + off); +++ yylval = np = (int)*lookup(passno == 1); +++ lastnam = (struct symtab *)np; +++ } + + exprisname++; - locxp->xtype = ((struct symtab *)np)->type; - if (( ((struct symtab *)np)->type&XTYPE)==XUNDEF) { /*forward*/ - locxp->xname = (struct symtab *)np; - locxp->xvalue = 0; +++ locxp->e_xtype = ((struct symtab *)np)->s_type; +++ if (( ((struct symtab *)np)->s_type&XTYPE)==XUNDEF) { /*forward*/ +++ locxp->e_xname = (struct symtab *)np; +++ locxp->e_xvalue = 0; + + if (passno==1) - ((struct symtab *)np)->type |= XFORW; +++ ((struct symtab *)np)->s_type |= XFORW; + + } else { /*otherwise, just get the value*/ - locxp->xvalue = ((struct symtab *)np)->value; - locxp->xname = NULL; +++ locxp->e_xvalue = ((struct symtab *)np)->s_value; +++ locxp->e_xname = NULL; + + } + + } else { /*INSTn or INST0 or REG*/ - locxp->xtype = XABS; - locxp->xvalue = ( (int)np) & 0xFF; - locxp->xloc = 0; - locxp->xname = NULL; +++ locxp->e_xtype = XABS; +++ locxp->e_xvalue = ( (int)np) & 0xFF; +++ locxp->e_xloc = 0; +++ locxp->e_xname = NULL; + + } + + + + return(locxp); + +} +++ +++ +++#ifdef DEBUG +++char *tok_name[LASTTOKEN - FIRSTTOKEN + 1]; +++struct Tok_Desc{ +++ int tok_which; +++ char *tok_name; +++} tok_desc[] = { +++ FIRSTTOKEN, "firsttoken", /* 0 */ +++ ISPACE, "ispace", /* 1 */ +++ IBYTE, "ibyte", /* 2 */ +++ IWORD, "iword", /* 3 */ +++ IINT, "iint", /* 4 */ +++ ILONG, "ilong", /* 5 */ +++ IDATA, "idata", /* 6 */ +++ IGLOBAL, "iglobal", /* 7 */ +++ ISET, "iset", /* 8 */ +++ ITEXT, "itext", /* 9 */ +++ ICOMM, "icomm", /* 10 */ +++ ILCOMM, "ilcomm", /* 11 */ +++ IFLOAT, "ifloat", /* 12 */ +++ IDOUBLE, "idouble", /* 13 */ +++ IORG, "iorg", /* 14 */ +++ IASCII, "iascii", /* 15 */ +++ IASCIZ, "iasciz", /* 16 */ +++ ILSYM, "ilsym", /* 17 */ +++ IFILE, "ifile", /* 18 */ +++ ILINENO, "ilineno", /* 19 */ +++ IABORT, "iabort", /* 20 */ +++ ISTAB, "istab", /* 23 */ +++ ISTABSTR, "istabstr", /* 24 */ +++ ISTABNONE, "istabnone", /* 25 */ +++ ISTABDOT, "istabdot", /* 26 */ +++ IJXXX, "ijxxx", /* 27 */ +++ IALIGN, "ialign", /* 28 */ +++ INST0, "inst0", /* 29 */ +++ INSTn, "instn", /* 30 */ +++ BFINT, "bfint", /* 31 */ +++ PARSEEOF, "parseeof", /* 32 */ +++ ILINESKIP, "ilineskip", /* 33 */ +++ VOID, "void", /* 34 */ +++ SKIP, "skip", /* 35 */ +++ INT, "int", /* 36 */ +++ FLTNUM, "fltnum", /* 37 */ +++ NAME, "name", /* 38 */ +++ STRING, "string", /* 39 */ +++ QUAD, "quad", /* 40 */ +++ SIZESPEC, "sizespec", /* 41 */ +++ REG, "reg", /* 42 */ +++ MUL, "mul", /* 43 */ +++ LITOP, "litop", /* 44 */ +++ LP, "lp", /* 45 */ +++ MP, "mp", /* 46 */ +++ NEEDSBUF, "needsbuf", /* 48 */ +++ REGOP, "regop", /* 49 */ +++ NL, "nl", /* 50 */ +++ SCANEOF, "scaneof", /* 51 */ +++ BADCHAR, "badchar", /* 52 */ +++ SP, "sp", /* 53 */ +++ ALPH, "alph", /* 54 */ +++ DIG, "dig", /* 55 */ +++ SQ, "sq", /* 56 */ +++ DQ, "dq", /* 57 */ +++ SH, "sh", /* 58 */ +++ LSH, "lsh", /* 59 */ +++ RSH, "rsh", /* 60 */ +++ MINUS, "minus", /* 61 */ +++ SIZEQUOTE, "sizequote", /* 62 */ +++ XOR, "xor", /* 64 */ +++ DIV, "div", /* 65 */ +++ SEMI, "semi", /* 66 */ +++ COLON, "colon", /* 67 */ +++ PLUS, "plus", /* 68 */ +++ IOR, "ior", /* 69 */ +++ AND, "and", /* 70 */ +++ TILDE, "tilde", /* 71 */ +++ ORNOT, "ornot", /* 72 */ +++ CM, "cm", /* 73 */ +++ LB, "lb", /* 74 */ +++ RB, "rb", /* 75 */ +++ RP, "rp", /* 76 */ +++ LASTTOKEN, "lasttoken" /* 80 */ +++}; +++/* +++ * turn a token type into a string +++ */ +++static int fixed = 0; +++char *tok_to_name(token) +++{ +++ if (!fixed){ +++ int i; +++ for (i = FIRSTTOKEN; i <= LASTTOKEN; i++) +++ tok_name[i] = "NOT ASSIGNED"; +++ for (i = FIRSTTOKEN; i <= sizeof(tok_desc)/sizeof(struct Tok_Desc); i++){ +++ tok_name[tok_desc[i].tok_which] = tok_desc[i].tok_name; +++ } +++ fixed = 1; +++ } +++ if (FIRSTTOKEN <= token && token <= LASTTOKEN) +++ return(tok_name[token]); +++ else +++ panic("Unknown token number, %d\n", token); +++ /*NOTREACHED*/ +++} +++#endif DEBUG diff --cc usr/src/cmd/as/asexpr.h index 0000000000,45aca4888c,0000000000..6e4fdfc3e9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/asexpr.h +++ b/usr/src/cmd/as/asexpr.h @@@@ -1,0 -1,88 -1,0 +1,90 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* "@(#)asexpr.h 4.2 8/15/80" */ + +/* + + * Definitions to parse tokens + + */ + + + +#define ERROR(string) yyerror(string); goto errorfix + + + +#define peekahead (*tokptr) + + + +#define shift val = yylex() + +#define advance shift + + + +#define shiftover(token) if (val != token) { \ + + yyerror("token expected"); \ + + goto errorfix; \ + + } \ + + shift + + + +#define advanceover shiftover + + + +/* + + * To speed up the expression processing, we class the input tokens + + * into various sets. + + * + + * We don't call the recursive descent expression analyzer if we can + + * determine by looking at the next token after the first token in + + * an expression that the expression is simple (name, integer or floating + + * point value). Expressions with operators are parsed using the recursive + + * descent method. + + */ + + + +/* + + * Functional forwards for expression utility routines + + */ + +struct exp *combine(); + +struct exp *boolterm(); + +struct exp *term(); + +struct exp *factor(); + +struct exp *yukkyexpr(); + + + +/* + + * The set definitions + + */ + + - char tokensets[(LASTTOKEN) - (FIRSTTOKEN) + 1]; +++extern char tokensets[(LASTTOKEN) - (FIRSTTOKEN) + 1]; + + - #define LINSTBEGIN 01 /*SEMI, NL, NAME*/ +++#define LINSTBEGIN 01 /*SEMI, NL, NAME*/ + +#define EBEGOPS 02 /*LP, MINUS, TILDE*/ - #define YUKKYEXPRBEG 04 /*NAME, INSTn, INST0, REG, DOT*/ +++#define YUKKYEXPRBEG 04 /*NAME, INSTn, INST0, REG, BFINT*/ + +#define SAFEEXPRBEG 010 /*INT, FLTNUM*/ - #define ADDOPS 020 /*PLUS, MINUS*/ +++#define ADDOPS 020 /*PLUS, MINUS*/ + +#define BOOLOPS 040 /*IOR, XOR, AND*/ - #define MULOPS 0100 /*LSH, RSH, MUL, DIV, TILDE*/ +++#define MULOPS 0100 /*LSH, RSH, MUL, DIV, TILDE*/ + + + +#define INTOKSET(val, set) (tokensets[(val)] & (set) ) + + + +#define expr(xp, val) { \ + + if ( (!INTOKSET(val, EBEGOPS)) && (!INTOKSET(peekahead, ADDOPS+BOOLOPS+MULOPS))) { \ + + if (INTOKSET(val, YUKKYEXPRBEG)) xp = yukkyexpr(val, yylval); \ + + else xp = (struct exp *) yylval; \ + + shift; \ + + } else { \ + + val = exprparse(val, ptrloc1xp); \ + + xp = loc1xp; \ + + } \ + + } + + + +/* + + * Registers can be either of the form r0...pc, or + + * of the form % + + * NOTE: Reizers documentation on the assembler says that it + + * can be of the form r0 + .. That's not true. + + * + + * NOTE: Reizer's yacc grammar would seem to allow an expression + + * to be: (This is undocumented) + + * a) a register + + * b) an Instruction (INSTn or INST0) + + */ + + + +#define findreg(regno) \ + + if (val == REG) { \ + + regno = yylval; \ + + shift; \ + + } else \ + + if (val == REGOP) { \ + + shift; /*over the REGOP*/ \ + + val = funnyreg(val, ptrregno); \ + + } \ + + else { ERROR ("register expected"); } diff --cc usr/src/cmd/as/asio.c index 0000000000,0000000000,0000000000..b53580de33 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/as/asio.c @@@@ -1,0 -1,0 -1,0 +1,124 @@@@ +++/* Coypright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)asio.c 4.3 8/16/80"; +++#include +++#include "as.h" +++/* +++ * Block I/O routines for logical I/O concurrently in +++ * more than one place in the same file. +++ */ +++int biofd; /* file descriptor for block I/O file */ +++off_t boffset; /* physical position in logical file */ +++BFILE *biobufs; /* the block I/O buffers */ +++ +++#define error(severity, message) \ +++ {yyerror(message); if (severity) delexit();} +++ +++Flushfield(n) +++ register int n; +++{ +++ while (n>0) { +++ outb(bitfield); +++ bitfield >>= 8; +++ n -= 8; +++ } +++ bitoff=0; +++ bitfield=0; +++} +++ +++/* +++ * Block I/O Routines +++ */ +++bopen(bp, off) +++ struct biobuf *bp; +++ off_t off; +++{ +++ +++ bp->b_ptr = bp->b_buf; +++ bp->b_nleft = BUFSIZ - off % BUFSIZ; +++ bp->b_off = off; +++ bp->b_link = biobufs; +++ biobufs = bp; +++} +++ +++int bwrerror; +++ +++bwrite(p, cnt, bp) +++ register char *p; +++ register int cnt; +++ register struct biobuf *bp; +++{ +++ register int put; +++ register char *to; +++ +++top: +++ if (cnt == 0) +++ return; +++ if (bp->b_nleft) { +++ put = bp->b_nleft; +++ if (put > cnt) +++ put = cnt; +++ bp->b_nleft -= put; +++ to = bp->b_ptr; +++ asm("movc3 r8,(r11),(r7)"); +++ bp->b_ptr += put; +++ p += put; +++ cnt -= put; +++ goto top; +++ } +++ if (cnt >= BUFSIZ) { +++ if (bp->b_ptr != bp->b_buf) +++ bflush1(bp); +++ put = cnt - cnt % BUFSIZ; +++ if (boffset != bp->b_off) +++ lseek(biofd, bp->b_off, 0); +++ if (write(biofd, p, put) != put) { +++ bwrerror = 1; +++ error(1, "Output write error"); +++ } +++ bp->b_off += put; +++ boffset = bp->b_off; +++ p += put; +++ cnt -= put; +++ goto top; +++ } +++ bflush1(bp); +++ goto top; +++} +++ +++bflush() +++{ +++ register struct biobuf *bp; +++ +++ if (bwrerror) +++ return; +++ for (bp = biobufs; bp; bp = bp->b_link) +++ bflush1(bp); +++} +++ +++bflush1(bp) +++ register struct biobuf *bp; +++{ +++ register int cnt = bp->b_ptr - bp->b_buf; +++ +++ if (cnt == 0) +++ return; +++ if (boffset != bp->b_off) +++ lseek(biofd, bp->b_off, 0); +++ if (write(biofd, bp->b_buf, cnt) != cnt) { +++ bwrerror = 1; +++ error(1, "Output write error"); +++ } +++ bp->b_off += cnt; +++ boffset = bp->b_off; +++ bp->b_ptr = bp->b_buf; +++ bp->b_nleft = BUFSIZ; +++} +++ +++bflushc(bp, c) +++ register struct biobuf *bp; +++ char c; +++{ +++ +++ bflush1(bp); +++ bputc(c, bp); +++} diff --cc usr/src/cmd/as/asjxxx.c index 0000000000,ab126990df,0000000000..a1ea1432fd mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/asjxxx.c +++ b/usr/src/cmd/as/asjxxx.c @@@@ -1,0 -1,448 -1,0 +1,488 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)asjxxx.c 4.5 8/20/80"; + +#include + +#include "as.h" + +#include "assyms.h" + + - #define JBR 0x11 - #define BRW 0x31 +++#define JBR 0x11 +++#define BRW 0x31 +++#define JMP 0x17 + + + +/* + + * The number of bytes to add if the jxxx must be "exploded" + + * into the long form + + */ - #define JBRFSIZE 1 /*goes to brw*/ - #define JXXXFSIZE 3 /*goes to brb, brw */ +++#define JBRDELTA 1 /* brb ==> brw */ +++#define JXXXDELTA 3 /* brb ==> brb brw */ +++#define JBRJDELTA d124 /* brb ==> jmp L^(pc) *d124 */ +++#define JXXXJDELTA d124+2 /* brb ==> brb jmp L^(pc) *d124 */ +++ +++int jbrfsize = JBRDELTA; +++int jxxxfsize = JXXXDELTA; + + + +/* + + * These variables are filled by asscan.c with the + + * last name encountered (a pointer buried in the intermediate file), + + * and the last jxxx symbol table entry encountered. + + */ + +struct symtab *lastnam; + +struct symtab *lastjxxx; + + +++initijxxx() +++{ +++ jbrfsize = jxxxJUMP ? JBRJDELTA : JBRDELTA; +++ jxxxfsize = jxxxJUMP ? JXXXJDELTA : JXXXDELTA; +++ /* +++ * Note: ifjxxxJUMP is set, then we do NOT do any tunnelling; +++ * this was too complicated to figure out, and in the first +++ * version of the assembler, tunnelling proved to be the hardest +++ * to get to work! +++ */ +++} + +/* + + * Handle jxxx instructions + + */ + +ijxout(op,ap,nact) + + struct arg *ap; + +{ + + if (passno == 1){ + + /* + + * READ THIS BEFORE LOOKING AT jxxxfix() + + * + + * Record the jxxx in a special symbol table entry + + */ + + register struct symtab *jumpfrom; + + + + /* + + * We assume the MINIMAL length + + */ + + putins(op,ap,nact); + + jumpfrom = lastjxxx; - jumpfrom->tag = JXACTIVE; - jumpfrom->jxbump = 0; +++ jumpfrom->s_tag = JXACTIVE; +++ jumpfrom->s_jxbump = 0; + + if (op == JBR) - jumpfrom->jxfear = JBRFSIZE; +++ jumpfrom->s_jxfear = jbrfsize; + + else - jumpfrom->jxfear = JXXXFSIZE; - #ifdef DJXXX - jumpfrom->jxline = lineno; - #endif +++ jumpfrom->s_jxfear = jxxxfsize; + + if (lastnam == 0) + + yyerror("jxxx destination not a label"); - jumpfrom->dest = lastnam; - jumpfrom->type = dotp->xtype; /*only TEXT or DATA*/ - jumpfrom->index = dotp-usedot; +++ jumpfrom->s_dest = lastnam; +++ jumpfrom->s_type = dotp->e_xtype; /*only TEXT or DATA*/ +++ jumpfrom->s_index = dotp-usedot; + + /* + + * value ALWAYS (ALWAYS!!!) indexes the next instruction + + * after the jump, even in the jump must be exploded + + * (bumped) + + */ - jumpfrom->value = dotp->xvalue; +++ jumpfrom->s_value = dotp->e_xvalue; + + njxxx++; + + } else {/* pass2, resolve */ + + /* + + * READ THIS AFTER LOOKING AT jxxxfix() + + */ + + register long oxvalue; + + register struct exp *xp; + + register struct symtab *tunnel; + + register struct arg *aplast; + + + + aplast = ap + nact - 1; - xp = aplast->xp; - if (lastjxxx->tag == JXTUNNEL){ - lastjxxx->tag = JXINACTIVE; - tunnel = lastjxxx->dest; - xp->xvalue = tunnel->value /*index of instruction following*/ +++ xp = aplast->a_xp; +++ if (lastjxxx->s_tag == JXTUNNEL){ +++ lastjxxx->s_tag = JXINACTIVE; +++ tunnel = lastjxxx->s_dest; +++ xp->e_xvalue = tunnel->s_value /*index of instruction following*/ + + - 3 /* size of brw + word*/ - + ( ( (tunnel->jxfear == JBRFSIZE) && - (tunnel->jxbump == 0))?1:0); +++ + ( ( (tunnel->s_jxfear == jbrfsize) && +++ (tunnel->s_jxbump == 0))?1:0); + + /*non bumped branch byteis only 2 back*/ + + } - if (lastjxxx->jxbump == 0){ /*wasn't bumped, so is short form*/ +++ if (lastjxxx->s_jxbump == 0){ /*wasn't bumped, so is short form*/ + + putins(op, ap, nact); + + } else { + + if (op != JBR){ /*branch reverse conditional byte over + + branch unconditional word*/ - oxvalue = xp->xvalue; - xp->xvalue = lastjxxx->value; +++ oxvalue = xp->e_xvalue; +++ xp->e_xvalue = lastjxxx->s_value; + + putins(op^1, ap, nact); - xp->xvalue = oxvalue; +++ xp->e_xvalue = oxvalue; + + } - putins(BRW, aplast, 1); +++ putins(jxxxJUMP ? JMP : BRW, aplast, 1); + + } + + } + +} /*end of ijxout*/ + + + +jalign(xp, sp) + + register struct exp *xp; + + register struct symtab *sp; + +{ + + register int mask; - if (xp->xtype != XABS || xp->xvalue < 0 || xp->xvalue > 16) { +++ /* +++ * Problem with .align +++ * +++ * When the loader constructs an executable file from +++ * a number of objects, it effectively concatnates +++ * together all of the text segments from all objects, +++ * and then all of the data segments. +++ * +++ * If we do an align by a large value, we can align +++ * within the a.out this assembly produces, but +++ * after the loader concatnates, the alignment can't +++ * be guaranteed if the objects preceding this one +++ * in the load are also aligned to the same size. +++ * +++ * Currently, the loader guarantees full word alignment. +++ * So, ridiculous aligns are caught here and converted +++ * to a .align 2, if possible. +++ */ +++ if ( (xp->e_xtype != XABS) +++ || (xp->e_xvalue < 0) +++ || (xp->e_xvalue > 16) +++ ) { + + yyerror("Illegal `align' argument"); + + return; + + } +++ if (xp->e_xvalue > 2){ +++ if (passno == 1){ +++ yywarning(".align %d in any segment is NOT preserved by the loader", +++ xp->e_xvalue); +++ yywarning(".align %d converted to .align 2", +++ xp->e_xvalue); +++ } +++ xp->e_xvalue = 2; +++ } + + flushfield(NBPW/4); + + if (passno == 1) { - sp->tag = JXALIGN; - sp->jxfear = (1 << xp->xvalue) - 1; - #ifdef DJXXX - sp->jxline = lineno; - #endif - sp->type = dotp->xtype; - sp->index = dotp-usedot; +++ sp->s_tag = JXALIGN; +++ sp->s_jxfear = (1 << xp->e_xvalue) - 1; +++ sp->s_type = dotp->e_xtype; +++ sp->s_index = dotp-usedot; + + /* + + * We guess that the align will take up at least one + + * byte in the code output. We will correct for this + + * initial high guess when we explode (bump) aligns + + * when we fix the jxxxes. We must do this guess + + * so that the symbol table is sorted correctly + + * and labels declared to fall before the align + + * really get their, instead of guessing zero size + + * and have the label (incorrectly) fall after the jxxx. + + * This is a quirk of our requirement that indices into + + * the code stream point to the next byte following + + * the logical entry in the symbol table + + */ - dotp->xvalue += 1; - sp->value = dotp->xvalue; +++ dotp->e_xvalue += 1; +++ sp->s_value = dotp->e_xvalue; + + njxxx++; + + } else { - mask = (1 << xp->xvalue) - 1; - while (dotp->xvalue & mask){ +++ mask = (1 << xp->e_xvalue) - 1; +++ while (dotp->e_xvalue & mask){ +++#ifdef UNIX + + outb(0); +++#endif UNIX +++#ifdef VMS +++ *vms_obj_ptr++ = -1; +++ *vms_obj_ptr++ = 0; +++ dotp->e_xvalue += 1; +++#endif VMS + + } + + } + +} + + + +/* + + * Pass 1.5, resolve jxxx instructions and .align in .text + + */ + +jxxxfix() + +{ + + register struct symtab *jumpfrom; + + struct symtab **cojumpfrom, *ubjumpfrom; + + register struct symtab *dest; + + register struct symtab *intdest; /*intermediate dest*/ + + register struct symtab **cointdest, *ubintdest; + + + + register struct symtab *tunnel; + + int displ,nchange; + + int badjxalign; /*if jump across an align*/ + + int stillactives; /*if still active jxxxes*/ + + int segno; /*current segment number*/ + + int topono; /*which iteration in the topo sort*/ + + register unsigned char tag; + + /* + + * consider each segment in turn... + + */ + + for (segno = 0; segno < NLOC + NLOC; segno++){ + + badjxalign = 0; /*done on a per segment basis*/ + + /* + + * Do a lazy topological sort. + + */ + + for (topono = 1, nchange = 1; nchange != 0; topono++){ + +#ifdef DEBUG + + if (debug) + + printf("\nSegment %d, topo iteration %d\n", + + segno, topono); + +#endif + + nchange = 0; + + stillactives = 0; + + /* + + * We keep track of one possible tunnel location. + + * A tunnel will eventually be an unconditional + + * branch to the same place that another jxxx + + * will want to branch to. We will turn a + + * branch conditional/unconditional (word) that would + + * have to get bumped because its destination is too + + * far away, into a branch conditional/unconditional + + * byte to the tunnel branch conditional/unconditional. + + * Of course, the tunnel must branch to the same place + + * as we want to go. + + */ + + tunnel = 0; /*initially, no tunnel*/ + + SEGITERATE(segno, 0, 0, cojumpfrom, jumpfrom, ubjumpfrom, ++){ - tag = jumpfrom->tag; +++ tag = jumpfrom->s_tag; + + if (tag <= IGNOREBOUND) + + continue; /*just an ordinary symbol*/ + + if (tag == JXALIGN){ + + tunnel = 0; /*avoid tunneling across a flex alocation*/ + + continue; /*we take care of these later*/ + + } - if ( jumpfrom->jxfear == JBRFSIZE /*unconditional*/ +++ if ( jumpfrom->s_jxfear == jbrfsize /*unconditional*/ + + || ( tag == JXINACTIVE /*inactive bumped*/ - && (jumpfrom->jxbump != 0) +++ && (jumpfrom->s_jxbump != 0) + + ) + + ) tunnel = jumpfrom; + + if (tag != JXACTIVE) + + continue; - dest = jumpfrom->dest; - if (jumpfrom->index != dest->index){ +++ dest = jumpfrom->s_dest; +++ if (jumpfrom->s_index != dest->s_index){ + + yyerror("Intersegment jxxx"); + + continue; + + } - displ = dest->value - jumpfrom->value; +++ displ = dest->s_value - jumpfrom->s_value; + + if (displ < MINBYTE || displ > MAXBYTE) { + + /* + + * This is an immediate lose! + + * + + * We first attempt to tunnel + + * by finding an intervening jump that + + * has the same destination. + + * The tunnel is always the first preceeding + + * jxxx instruction, so the displacement + + * to the tunnel is less than zero, and + + * its relative position will be unaffected + + * by future jxxx expansions. +++ * +++ * No tunnels if doing jumps... + + */ - if ( (jumpfrom->jxfear > JBRFSIZE) +++ if ( (!jxxxJUMP) +++ && (jumpfrom->s_jxfear > jbrfsize) + + && (tunnel) - && (tunnel->dest == jumpfrom->dest) - && (tunnel->index == jumpfrom->index) - && (tunnel->value - jumpfrom->value >= - MINBYTE + JXXXFSIZE) +++ && (tunnel->s_dest == jumpfrom->s_dest) +++ && (tunnel->s_index == jumpfrom->s_index) +++ && (tunnel->s_value - jumpfrom->s_value >= +++ MINBYTE + jxxxfsize) + + ) { + + /* + + * tunnelling is OK + + */ - jumpfrom->dest = tunnel; +++ jumpfrom->s_dest = tunnel; + + /* + + * no bumping needed, this + + * is now effectively inactive + + * but must be remembered + + */ - jumpfrom->tag = JXTUNNEL; +++ jumpfrom->s_tag = JXTUNNEL; + +#ifdef DEBUG + + if(debug) + + printf("Tunnel from %s from line %d\n", - jumpfrom->name, lineno); - #endif - #ifdef METRIC - jxxxtunnel++; +++ jumpfrom->s_name, lineno); + +#endif + + continue; + + } else { /*tunneling not possible*/ + + /* + + * since this will be turned + + * into a bumped jump, we can + + * use the unconditional jump + + * as a tunnel + + */ + + tunnel = jumpfrom; - jumpfrom->tag = JXNOTYET; +++ jumpfrom->s_tag = JXNOTYET; + + ++nchange; + + continue; + + } + + } /*end of immediate lose*/ + + /* + + * Do a forward search for an intervening jxxx + + */ + + if (displ >= 0) { + + SEGITERATE(segno, cojumpfrom + 1,0,cointdest, + + intdest, ubintdest, ++){ - if (intdest->value > dest->value) +++ if (intdest->s_value > dest->s_value) + + break; /* beyond destination */ - if (intdest->tag <= JXQUESTIONABLE) +++ if (intdest->s_tag <= JXQUESTIONABLE) + + continue; /*frozen solid*/ - if (intdest->tag == JXALIGN){ - jumpfrom->jxoveralign = 1; +++ if (intdest->s_tag == JXALIGN){ +++ jumpfrom->s_jxoveralign = 1; + + badjxalign++; + + } + + /* + + * we assume the worst case + + * for unfrozen jxxxxes + + */ - displ += intdest->jxfear; +++ displ += intdest->s_jxfear; + + } + + if (displ <= MAXBYTE){ + + /* + + * the worst possible conditions + + * can't hurt us, so forget about + + * this jump + + */ - jumpfrom->tag = JXINACTIVE; +++ jumpfrom->s_tag = JXINACTIVE; + + } else { + + stillactives++; + + } + + } else { + + /* + + * backward search for intervening jxxx + + */ + + SEGITERATE(segno, cojumpfrom - 1,1,cointdest, + + intdest, ubintdest, --){ - if (intdest->value <= dest->value) +++ if (intdest->s_value <= dest->s_value) + + break; /* beyond destination */ - if (intdest->tag <= JXQUESTIONABLE) +++ if (intdest->s_tag <= JXQUESTIONABLE) + + continue; /*frozen solid*/ - if (intdest->tag == JXALIGN){ - jumpfrom->jxoveralign = 1; +++ if (intdest->s_tag == JXALIGN){ +++ jumpfrom->s_jxoveralign = 1; + + badjxalign++; + + } - displ -= intdest->jxfear; +++ displ -= intdest->s_jxfear; + + } + + if (displ >= MINBYTE) { - jumpfrom->tag = JXINACTIVE; +++ jumpfrom->s_tag = JXINACTIVE; + + } else { + + stillactives++; + + } + + } /*end of backwards search*/ + + } /*end of iterating through all symbols in this seg*/ + + + + if (nchange == 0) { + + /* + + * Now, if there are still active jxxx entries, + + * we are partially deadlocked. We can leave + + * these jxxx entries in their assumed short jump + + * form, as all initial displacement calcualtions + + * are hanging on unresolved jxxx instructions + + * that might explode into a long form, causing + + * other jxxxes jumping across the first set of + + * jxxxes to explode, etc. + + * However, if a jxxx jumps across a .align, + + * we assume the worst for the deadlock cycle, + + * and resolve all of them towards the long + + * jump. + + * Currently, the C compiler does not produce + + * jumps across aligns, as aligns are only used + + * in data segments, or in text segments to align + + * functions. + + */ + + if (stillactives){ - #ifdef METRIC - jxdeadlock++; - #endif + + SEGITERATE(segno, 0, 0, cojumpfrom, jumpfrom, + + ubjumpfrom, ++){ - if (jumpfrom->tag == JXACTIVE){ - jumpfrom->tag = +++ if (jumpfrom->s_tag == JXACTIVE){ +++ jumpfrom->s_tag = + + badjxalign?JXNOTYET:JXINACTIVE; + + } + + } + + if (badjxalign){ - jxxxbump(segno, 0); - #ifdef METRIC - nbadjxsegs++; - #endif +++ jxxxbump(segno, (struct symtab **)0); + + } + + } + + /* + + * Handle all of the .align s + + */ + + SEGITERATE(segno, 0, 0, cojumpfrom, jumpfrom, + + ubjumpfrom, ++){ - if (jumpfrom->tag == JXALIGN){ +++ if (jumpfrom->s_tag == JXALIGN){ + + /* + + * Predict the true displacement + + * needed, irregardless of the + + * fact that we guessed 1 + + */ - displ = (jumpfrom->value - 1) & (unsigned)jumpfrom->jxfear; +++ displ = (jumpfrom->s_value - 1) & (unsigned)jumpfrom->s_jxfear; + + if (displ == 0){ /*no virtual displacement*/ - jumpfrom->jxfear = -1; +++ jumpfrom->s_jxfear = -1; + + } else { - jumpfrom->jxfear = (jumpfrom->jxfear + 1) - displ; +++ jumpfrom->s_jxfear = (jumpfrom->s_jxfear + 1) - displ; + + /* - * assert jumpfrom->jxfear > 0 +++ * assert jumpfrom->s_jxfear > 0 + + */ - if (jumpfrom->jxfear == 1){ +++ if (jumpfrom->s_jxfear == 1){ + + /*our prediction was correct*/ + + continue; + + } + + /* - * assert jumpfrom->jxfear > 1 +++ * assert jumpfrom->s_jxfear > 1 + + */ - jumpfrom->jxfear -= 1; /*correct guess*/ +++ jumpfrom->s_jxfear -= 1; /*correct guess*/ + + } + + /* - * assert jumpfrom->jxfear = -1, +1...2**n-1 +++ * assert jumpfrom->s_jxfear = -1, +1...2**n-1 + + */ - jumpfrom->tag = JXNOTYET; /*signal*/ +++ jumpfrom->s_tag = JXNOTYET; /*signal*/ + + jxxxbump(segno, cojumpfrom); - jumpfrom->tag = JXINACTIVE; +++ jumpfrom->s_tag = JXINACTIVE; + + /* + + * Assert jxfrom->jxvalue indexes the first + + * code byte after the added bytes, and + + * has n low order zeroes. + + */ + + } + + } /*end of walking through each segment*/ + + } /*end of no changes */ + + else { /*changes, and still have to try another pass*/ - jxxxbump(segno, 0); +++ jxxxbump(segno, (struct symtab **)0); + + } + + } /*end of doing the topologic sort*/ + + } /*end of iterating through all segments*/ + +} /*end of jxxxfix*/ + + + +/* + + * Go through the symbols in a given segment number, + + * and see which entries are jxxx entries that have + + * been logically "exploded" (expanded), but for which + + * the value of textually following symbols has not been + + * increased + + */ + + + +jxxxbump(segno, starthint) + + int segno; + + struct symtab **starthint; + +{ + + register struct symtab **cosp, *sp; + + register struct symtab *ub; + + register int cum_bump; + + register unsigned char tag; + + - #ifdef METRIC - jxxxiterate++; - #endif + + cum_bump = 0; + + SEGITERATE(segno, starthint, 0, cosp, sp, ub, ++){ - tag = sp->tag; +++ tag = sp->s_tag; + + if (tag == JXNOTYET){ + +#ifdef DEBUG + + if (debug){ - if (sp->dest != 0) +++ if (sp->s_dest != 0) + + printf("Explode jump to %s on line %d\n", - sp->dest->name, lineno); +++ sp->s_dest->s_name, lineno); + + else + + printf("Explode an align!\n"); + + } + +#endif - sp->tag = JXINACTIVE; - sp->jxbump = 1; - cum_bump += sp->jxfear; +++ sp->s_tag = JXINACTIVE; +++ sp->s_jxbump = 1; +++ cum_bump += sp->s_jxfear; + + } + + /* + + * Only bump labels and jxxxes. Ignored entries can + + * be incremented, as they are thrown away later on. + + * Stabds are given their final value in the second + + * pass. + + */ + + if (tag >= OKTOBUMP) /*only bump labels and jxxxes and floating stabs*/ - sp->value += cum_bump; +++ sp->s_value += cum_bump; + + } - usedot[segno].xvalue += cum_bump; +++ usedot[segno].e_xvalue += cum_bump; + +} diff --cc usr/src/cmd/as/asmain.c index 0000000000,ed03351368,0000000000..259215d628 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/asmain.c +++ b/usr/src/cmd/as/asmain.c @@@@ -1,0 -1,485 -1,0 +1,622 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)asmain.c 4.8 8/20/80"; + +#include +++#include + +#include + + + +#include "as.h" + +#include "assyms.h" + +#include "asexpr.h" + +#include "asscan.h" + + - int curlen; +++#ifdef UNIX +++#define unix_lang_name "VAX/UNIX Assembler V8/20/80 4.8" +++#endif +++ +++#ifdef VMS +++#define vms_lang_name "VAX/VMS C Assembler V1.00" +++#endif VMS +++ + +/* - * variables to manage the assembly input +++ * variables to manage reading the assembly source files + + */ + +char *dotsname; /*the current file name; managed by the parser*/ + +int lineno; /*current line number; managed by the parser*/ - int silent; /*don't complain about any errors*/ - int savelabels; /*write the labels to the a.out file*/ +++char **innames; /*names of the files being assembled*/ +++int ninfiles; /*how many interesting files there are*/ +++/* +++ * Flags settable from the argv process argument list +++ */ +++int silent = 0; /*don't complain about any errors*/ +++int savelabels = 0; /*write the labels to the a.out file*/ +++int d124 = 4; /*default allocate 4 bytes for unknown pointers*/ +++int anyerrs = 0; /*no errors yet*/ +++int orgwarn = 0; /*Bad origins*/ +++int passno = 1; /* current pass*/ +++int jxxxJUMP = 0; /* in jxxxes that branch too far, use jmp instead of brw */ +++int readonlydata = 0; /* initialzed data -> text space */ + + + +#ifdef DEBUG - int debug; - int toktrace; +++int debug = 0; +++int toktrace = 0; + +#endif + + - long datbase; +++int useVM = /*put the temp file in virtual memory*/ +++#ifdef VMS +++ 1; /*VMS has virtual memory (duh)*/ +++#endif VMS +++#ifdef UNIX +++ 0; +++#endif + + - char *endcore; /*where to get more symbol space*/ +++char *endcore; /*where to get more symbol space*/ + + - struct hdr hdr = { - 0410, 0, 0, 0, 0, 0, 0, 0, - }; +++/* +++ * Managers of the a.out file. +++ */ +++struct exec hdr; +++#define MAGIC 0407 +++u_long tsize; /* total text size */ +++u_long dsize; /* total data size */ +++u_long datbase; /* base of the data segment */ +++u_long trsize; /* total text relocation size */ +++u_long drsize; /* total data relocation size */ + + - #ifndef vax - struct {short hiword; short loword;}; /* stupid fp-11 */ - #else - #define writel(p,n,f) fwrite( (long) p, sizeof (long), n, f) +++/* +++ * Information about the current segment is accumulated in +++ * usedot; the most important information stored is the +++ * accumulated size of each of the text and data segments +++ * +++ * dotp points to the correct usedot expression for the current segment +++ */ +++struct exp usedot[NLOC+NLOC]; /* info about all segments */ +++struct exp *dotp; /* data/text location pointer */ +++/* +++ * The inter pass temporary file is opened and closed by stdio, but +++ * is written to using direct read/write, as the temporary file +++ * is composed of buffers exactly BUFSIZ long. +++ */ +++FILE *tmpfil; /* interpass communication file */ +++/* +++ * a.out is created during the second pass. +++ * It is opened by stdio, but is filled with the parallel +++ * block I/O library +++ */ +++char *outfile = "a.out"; +++FILE *a_out_file; +++off_t a_out_off; /* cumulative offsets for segments */ +++/* +++ * The logical files containing the assembled data for each of +++ * the text and data segments are +++ * managed by the parallel block I/O library. +++ * a.out is logically opened in many places at once to +++ * receive the assembled data from the various segments as +++ * it all trickles in, but is physically opened only once +++ * to minimize file overhead. +++ */ +++BFILE *usefile[NLOC+NLOC]; /* text/data files */ +++BFILE *txtfil; /* current text/data file */ +++/* +++ * Relocation information is accumulated seperately for each +++ * segment. This is required by the old loader (from BTL), +++ * but not by the new loader (Bill Joy). +++ * +++ * However, the size of the relocation information can not be computed +++ * during or after the 1st pass because the ''absoluteness' of values +++ * is unknown until all locally declared symbols have been seen. +++ * Thus, the size of the relocation information is only +++ * known after the second pass is finished. +++ * This obviates the use of the block I/O +++ * library, which requires knowing the exact offsets in a.out. +++ * +++ * So, we save the relocation information internally (we don't +++ * go to internal files to minimize overhead). +++ * +++ * Empirically, we studied 259 files composing the system, +++ * two compilers and a compiler generator: (all of which have +++ * fairly large source files) +++ * +++ * Number of files = 259 +++ * Number of non zero text reloc files: 233 +++ * Number of non zero data reloc files: 53 +++ * Average text relocation = 889 +++ * Average data relocation = 346 +++ * Number of files > BUFSIZ text relocation = 71 +++ * Number of files > BUFSIZ data relocation = 6 +++ * +++ * For compiled C code, there is usually one text segment and two +++ * data segments; we see that allocating our own buffers and +++ * doing our internal handling of relocation information will, +++ * on the average, not use more memory than taken up by the buffers +++ * allocated for doing file I/O in parallel to a number of file. +++ * +++ * If we are assembling with the -V option, we +++ * use the left over token buffers from the 2nd pass, +++ * otherwise, we create our own. +++ * +++ * When the 2nd pass is complete, closeoutrel flushes the token +++ * buffers out to a BFILE. +++ * +++ * The internals to relbufdesc are known only in assyms.c +++ * +++ * outrel constructs the relocation information. +++ * closeoutrel flushes the relocation information to relfil. +++ */ +++struct relbufdesc *rusefile[NLOC+NLOC]; +++struct relbufdesc *relfil; /* un concatnated relocation info */ +++BFILE *relocfile; /* concatnated relocation info */ +++/* +++ * Once the relocation information has been written, +++ * we can write out the symbol table using the Block I/O +++ * mechanisms, as we once again know the offsets into +++ * the a.out file. +++ * +++ * We use relfil to output the symbol table information. +++ */ +++ +++char *tmpdirprefix = +++#ifdef UNIX +++ "/tmp/"; +++#else VMS +++ "/usr/tmp/"; + +#endif + + - char *tmpn1; - char *tmpn2; - char *tmpn3; +++#define TMP_SUFFIX "asXXXXXX" +++char tmpn1[TNAMESIZE]; +++ +++int delexit(); +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ +++ tmpn1[0] = 0; +++ endcore = (char *)sbrk(0); + + - struct exp usedot[NLOC+NLOC]; +++ argprocess(argc, argv); /* process argument lists */ +++ if (anyerrs) exit(1); + + - FILE *usefile[NLOC+NLOC]; - FILE *rusefile[NLOC+NLOC]; - char sibuf[TOKBUFLG]; /*buffer used for all input*/ - char sobuf[TOKBUFLG]; /*buffer used for all output*/ - /*except stdout and relfil*/ - char stdoutbuf[BUFSIZ]; /*stdout buffer*/ +++ initialize(); +++ zeroorigins(); /* set origins to zero */ +++ zerolocals(); /* fix local label counters */ + + - extern int njxxx; /*number of jumpxxx instructs*/ - extern int d124; /*allocate 1,2 or 4 bytes for unknowns*/ +++ i_pass1(); /* open temp files, etc */ +++ pass1(); /* first pass through .s files */ +++ testlocals(); /* check for undefined locals */ +++ if (anyerrs) delexit(); + + - int delexit(); +++ pass1_5(); /* resolve jxxx */ +++ if (anyerrs) delexit(); + + - char *innames[32]; /*names of the files being assembled*/ - int ninfiles; /*how many interesting files there are*/ +++ open_a_out(); /* open a.out */ +++ roundsegments(); /* round segments to FW */ +++ build_hdr(); /* build initial header, and output */ +++ +++ i_pass2(); /* reopen temporary file, etc */ +++ pass2(); /* second pass through the virtual .s */ +++ if (anyerrs) delexit(); + + - main(argc, argv) +++ fillsegments(); /* fill segments with 0 to FW */ +++ reloc_syms(); /* dump relocation and symbol table */ +++ +++ delete(); /* remove tmp file */ +++ bflush(); /* close off block I/O view of a.out */ +++ fix_a_out(); /* add in text and data reloc counts */ +++ +++ if (anyerrs == 0 && orgwarn) +++ yyerror("Caution: absolute origins.\n"); +++ exit(anyerrs != 0); +++} /*end of UNIX main*/ +++ +++argprocess(argc, argv) + + int argc; - char **argv; +++ char *argv[]; + +{ - int locindex; - long v; - char *outfile = "a.out"; - int filestep; - char *cp; +++ register char *cp; + + - setbuf(stdout, stdoutbuf); + + ninfiles = 0; + + silent = 0; - useVM = 0; + +#ifdef DEBUG + + debug = 0; + +#endif - /* - * Give the error processor something to complain about - * if there is an error processing an argument - */ +++ innames = (char **)ClearCalloc(argc+1, sizeof (innames[0])); + + dotsname = ""; + + while (argc > 1) { - if (argv[1][0] == '-'){ +++ if (argv[1][0] != '-') +++ innames[ninfiles++] = argv[1]; +++ else { + + cp = argv[1] + 1; + + /* + + * We can throw away single minus signs, so + + * that make scripts for the PDP 11 assembler work + + * on this assembler too + + */ + + while (*cp){ + + switch(*cp++){ + + default: + + yyerror("Unknown flag: %c", *--cp); + + cp++; + + break; + + case 'd': + + d124 = *cp++ - '0'; + + if ( (d124 != 1) && (d124 != 2) && + + (d124 != 4)){ + + yyerror("-d[124] only"); + + exit(1); + + } + + break; + + case 'o': + + if (argc < 3){ + + yyerror("-o what???"); + + exit(1); + + } + + outfile = argv[2]; +++ bumpone: + + argc -= 2; + + argv += 2; + + goto nextarg; + + - case 'V': - useVM = 1; - break; - #ifdef fooiearg - case 'M': +++ case 't': + + if (argc < 3){ - yyerror("Mode what?"); +++ yyerror("-t what???"); + + exit(1); + + } - hdr.magic = 0; - cp = argv[2]; - while (*cp && ('0' <= *cp) && (*cp <= '7')) - hdr.magic = hdr.magic<<3 + *cp++ - '0'; - argc -= 2; - argv += 2; - goto nextarg; - case 'W': silent = 1; +++ tmpdirprefix = argv[2]; +++ goto bumpone; +++ +++ case 'V': +++ useVM = 1; + + break; - #endif - - #ifdef DEBUG - case 'D': debug = 1; +++ case 'W': +++ silent = 1; + + break; - case 'T': toktrace = 1; +++ case 'L': +++ savelabels = 1; + + break; - #endif - #ifdef METRIC - case 'C': outcounters = 1; +++ case 'J': +++ jxxxJUMP = 1; +++ break; +++#ifdef DEBUG +++ case 'D': +++ debug = 1; +++ break; +++ case 'T': +++ toktrace = 1; + + break; + +#endif - case 'L': savelabels = 1; +++ case 'R': +++ readonlydata = 1; + + break; + + } /*end of the switch*/ + + } /*end of pulling out all arguments*/ + + } /*end of a flag argument*/ - else { /*file name*/ - if (ninfiles > 32){ - yyerror("More than 32 file names"); - exit(3); - } - innames[ninfiles++] = argv[1]; - } + + --argc; ++argv; + + nextarg:; - } /*end of looking at all of the arguments*/ - - if (anyerrs) - exit(1); - - endcore = (char *)sbrk(0); +++ } +++ /* innames[ninfiles] = 0; */ +++} + + +++initialize() +++{ +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) +++ signal(SIGINT, delexit); + + /* + + * Install symbols in the table + + */ + + symtabinit(); + + syminstall(); + + /* - * mark usedot: first NLOC slots for named text segments, +++ * Build the expression parser accelerator token sets +++ */ +++ buildtokensets(); +++} +++ +++zeroorigins() +++{ +++ register int locindex; +++ /* +++ * Mark usedot: the first NLOC slots are for named text segments, + + * the next for named data segments. + + */ - for (locindex=0; locindex_file; +++ a_out_off = 0; +++} + + +++roundsegments() +++{ +++ register int locindex; +++ register long v; + + /* - * round and assign text segment origins +++ * round and assign text segment origins +++ * the exec header always goes in usefile[0] + + */ + + tsize = 0; + + for (locindex=0; locindex0) - fclose(usefile[locindex]); - fclose(rusefile[locindex]); - } - if (usefile[NLOC+locindex]) { - txtfil = usefile[NLOC+locindex]; - dotp= &usedot[locindex+NLOC]; - relfil = rusefile[NLOC+locindex]; - while (usedot[locindex+NLOC].xvalue & FW) - outb(0); - fclose(txtfil); - fclose(relfil); + + } + + } +++} + + - txtfil = usefile[0]; - /* - * append csect text onto text for csect 0 - */ - for (locindex=1; locindex_file, 0L, 0) < 0) +++ yyerror("Reposition for header rewrite fails"); +++ if (write(a_out_file->_file, (char *)&hdr, sizeof (struct exec)) < 0) +++ yyerror("Rewrite of header fails"); +++} + + + +delexit() + +{ + + delete(); - #ifdef METRIC - pcounters(); - #endif +++ if (passno == 2){ +++ unlink(outfile); +++ } + + exit(1); + +} + + +++delete() +++{ +++ if (useVM == 0 || tmpn1[0]) +++ unlink(tmpn1); +++} +++ + +sawabort() + +{ - char buffer[BUFSIZ]; - #ifdef METRIC - pcounters(); - #endif - while (!feof(stdin)) - fread(buffer, 1, BUFSIZ, stdin); +++ char *fillinbuffer(); +++ while (fillinbuffer() != (char *)0) +++ continue; + + delete(); + + exit(1); /*although the previous pass will also exit non zero*/ + +} + + - delete() +++panic(fmt, a1, a2, a3, a4) +++ char *fmt; +++ /*VARARGS 1*/ + +{ - register locindex; - - if (tmpn1) - unlink(tmpn1); - for (locindex=0; locindex\n"); - else { - for (i = 0; i - #include + +#include "as.h" + +#include "asexpr.h" + +#include "asscan.h" + +#include "assyms.h" + + - extern struct exp usedot[];/*information on the dot for each seg*/ - struct exp *dotp = &usedot[0]; /*current dot*/ - int anyerrs; - - int passno = 1; - - FILE *tmpfil; - FILE *relfil; /*relocation info sent here*/ - FILE *txtfil; /*text (for any text #) sent here*/ - - int hshused; /*hash slots consumed */ - long tsize; - long dsize; +++int lgensym[10]; +++char genref[10]; + + + +long bitfield; + +int bitoff; +++int curlen; /* current length of literals */ + + + +/* + + * The following three variables are communication between various + + * modules to special case a number of things. They are properly + + * categorized as hacks. + + */ - struct symtab *lastnam; /*last name seen by the lexical analyzer*/ +++extern struct symtab *lastnam;/*last name seen by the lexical analyzer*/ + +int exprisname; /*last factor in an expression was a name*/ + +int droppedLP; /*one is analyzing an expression beginning with*/ + + /*a left parenthesis, which has already been*/ + + /*shifted. (Used to parse ()(rn)*/ + + - char yytext[NCPS+2]; - static char Dotsname[32]; - - struct exp *xp; /*next free expression slot, used by expr.c*/ - +++char yytext[NCPS+2]; /*the lexical image*/ + +int yylval; /*the lexical value; sloppy typing*/ +++/* +++ * Expression and argument managers +++ */ +++struct exp *xp; /*next free expression slot, used by expr.c*/ +++struct exp explist[NEXP]; /*max of 20 expressions in one opcode*/ +++struct arg arglist[NARG]; /*building up operands in instructions*/ +++/* +++ * Sets to accelerate token discrimination +++ */ +++char tokensets[(LASTTOKEN) - (FIRSTTOKEN) + 1]; + + - extern ptrall tokptr; /*points to current token being eaten*/ - extern int d124; +++static char UDotsname[32]; /*name of the assembly source*/ + + + +int yyparse() + +{ + + register struct exp *locxp; + + /* + + * loc1xp and ptrloc1xp are used in the + + * expression lookahead + + */ + + struct exp *loc1xp; /*must be non register*/ + + struct exp **ptrloc1xp = & loc1xp; + + struct exp *pval; /*hacking expr:expr*/ + + + + register struct symtab *np; + + register int argcnt; + + + + register int val; /*what yylex gives*/ + + register int auxval; /*saves val*/ + + + + register struct arg *ap; /*first free argument*/ + + + + struct symtab *p; + + register struct symtab *stpt; + + + + struct strdesc *stringp; /*handles string lists*/ + + + + int regno; /*handles arguments*/ + + int *ptrregno = ®no; + + int sawmul; /*saw * */ + + int sawindex; /*saw [rn]*/ + + int sawsize; + + int seg_type; /*the kind of segment: data or text*/ + + int seg_number; /*the segment number*/ - long space_value; /*how much .space needs*/ +++ int space_value; /*how much .space needs*/ +++ int fill_rep; /*how many reps for .fill */ +++ int fill_size; /*how many bytes for .fill */ + + + + int field_width; /*how wide a field is to be*/ + + int field_value; /*the value to stuff in a field*/ + + char *stabname; /*name of stab dealing with*/ + + ptrall stabstart; /*where the stab starts in the buffer*/ +++ int reloc_how; /* how to relocate expressions */ + + + + xp = explist; + + ap = arglist; + + + + val = yylex(); - while (val != PARSEEOF){ - while (INTOKSET(val, LINSTBEGIN)){ - if (val == NL){ - lineno++; - shift; - } else - if (val == SEMI) - shift; - else { /*its a name, so we have a label (hopefully*/ - if (val != NAME){ - ERROR("Name expected for a label"); - } - np = (struct symtab *)yylval; - shiftover(NAME); - shiftover(COLON); - flushfield(NBPW/4); - if ((np->type&XTYPE)!=XUNDEF) { - if( (np->type&XTYPE)!=dotp->xtype - || np->value!=dotp->xvalue - || ( (passno==1) - &&(np->index != dotp->xloc) - ) - ){ - #ifndef DEBUG - if (np->name[0] != 'L') - #endif - { - yyerror("%.8s redefined", np->name); - #ifdef DEBUG - printf("name.value=%d, dotp->xvalue=%d\n", - np->value, dotp->xvalue); - #endif - } - } - } - np->type &= ~(XTYPE|XFORW); - np->type |= dotp->xtype; - np->value = dotp->xvalue; - if (passno == 1){ - np->index = dotp-usedot; - if (np->name[0] == 'L'){ - nlabels++; - } - np->tag = LABELID; - } - } /*end of this being a label*/ - } /*end of to consuming all labels, NLs and SEMIS */ - - xp = explist; - ap = arglist; - - /* - * process the INSTRUCTION body - */ - switch(val){ - default: - ERROR("Unrecognized instruction or directive"); - - case IABORT: - shift; - sawabort(); - /*NOTREACHED*/ - break; + + - case PARSEEOF: - tokptr -= sizeof(toktype); - *tokptr++ = VOID; - tokptr[1] = VOID; - tokptr[2] = PARSEEOF; - break; - - case IFILE: - shift; - stringp = (struct strdesc *)yylval; - shiftover(STRING); - dotsname = &Dotsname[0]; - movestr(dotsname, stringp->str, - stringp->str_lg >= 32? 32 :stringp->str_lg); - dotsname[stringp->str_lg] = '\0'; - #ifdef DEBUG - if (debug) - printf("(from parser) Now considered to be in file %s\n", - dotsname); - #endif - break; - - case ILINENO: - shift; /*over the ILINENO*/ - expr(locxp, val); - lineno = locxp->xvalue; - #ifdef DEBUG - if (debug) - printf("Now considered to be on line number %d\n", - lineno); - #endif - break; +++ while (val != PARSEEOF){ /* primary loop */ + + - case ISET: { /* .set , */ +++ while (INTOKSET(val, LINSTBEGIN)){ +++ if (val == INT) { +++ int i = ((struct exp *)yylval)->e_xvalue; + + shift; +++ if (val != COLON) +++ goto nocolon; +++ if (i < 0 || i > 9) { +++ yyerror("Local labels are 0-9"); +++ goto errorfix; +++ } +++ sprintf(yytext, "L%d\001%d", i, lgensym[i]); +++ lgensym[i]++; +++ genref[i] = 0; +++ yylval = (int)*lookup(passno == 1); +++ val = NAME; + + np = (struct symtab *)yylval; - shiftover(NAME); - shiftover(CM); - expr(locxp, val); - np->type &= (XXTRN|XFORW); - np->type |= locxp->xtype&(XTYPE|XFORW); - np->value = locxp->xvalue; - if (passno==1) - np->index = locxp->xloc; - if ((locxp->xtype&XTYPE) == XUNDEF) - yyerror("Illegal set?"); - break; - } /*end of case ISET*/ - - case ILSYM: { /*.lsym name , expr */ +++ goto restlab; +++ } +++ if (val == NL){ +++ lineno++; + + shift; - np = (struct symtab *)yylval; - shiftover(NAME); - shiftover(CM); - expr(locxp, val); - /* - * Build the unique occurance of the - * symbol. - * The character scanner will have - * already entered it into the symbol - * table, but we should remove it - */ - if (passno == 1){ - stpt = (struct symtab *)symalloc(); - movestr(stpt->name, np->name, NCPS); - np->tag = OBSOLETE; /*invalidate original */ - nforgotten++; - np = stpt; - if (locxp->xtype != XABS) - ("Illegal lsym"); - np->value=locxp->xvalue; - np->type=XABS; - np->tag = ILSYM; - } - break; - } /*end of case ILSYM*/ - - case IGLOBAL: { /*.globl */ +++ } else +++ if (val == SEMI) + + shift; +++ else { /*its a name, so we have a label or def */ +++ if (val != NAME){ +++ ERROR("Name expected for a label"); +++ } + + np = (struct symtab *)yylval; + + shiftover(NAME); - np->type |= XXTRN; - break; - } /*end of case IGLOBAL*/ - - case IDATA: /*.data [ ] */ - case ITEXT: { /*.text [ ] */ - seg_type = -val; - shift; - if (INTOKSET(val, EBEGOPS+YUKKYEXPRBEG+SAFEEXPRBEG)){ - expr(locxp, val); - seg_type = -seg_type; /*now, it is positive*/ - } - - if (seg_type < 0) { /*there wasn't an associated expr*/ - seg_number = 0; - seg_type = -seg_type; - } else { - if (locxp->xtype != XABS || (seg_number=locxp->xvalue) >= NLOC) { - yyerror("illegal location counter"); - seg_number = 0; - } +++nocolon: +++ if (val != COLON) { +++#ifdef FLEXNAMES +++ yyerror("\"%s\" is not followed by a ':' for a label definition", +++#else not FLEXNAMES +++ yyerror("\"%.*s\" is not followed by a ':' for a label definition", +++ NCPS, +++#endif not FLEXNAMES +++ np->s_name); +++ goto errorfix; + + } - if (seg_type == IDATA) - seg_number += NLOC; +++restlab: +++ shift; + + flushfield(NBPW/4); - dotp = &usedot[seg_number]; - if (passno==2) { /* go salt away in pass 2*/ - if (usefile[seg_number] == NULL) { - tmpn2[TMPC] = 'a'+seg_number; - if ((usefile[seg_number] = - fopen(tmpn2, "w"))==NULL) { - yyerror("cannot create temp %s", tmpn2); - delexit(); - } - - tmpn3[TMPC] = 'a'+seg_number; - if ((rusefile[seg_number] = - fopen(tmpn3, "w"))==NULL) { - - yyerror("cannot create temp %s", - tmpn3); +++ if ((np->s_type&XTYPE)!=XUNDEF) { +++ if( (np->s_type&XTYPE)!=dotp->e_xtype +++ || np->s_value!=dotp->e_xvalue +++ || ( (passno==1) +++ &&(np->s_index != dotp->e_xloc) +++ ) +++ ){ +++#ifndef DEBUG +++ if (np->s_name[0] != 'L') +++#endif not DEBUG +++ { +++ if (passno == 1) +++#ifdef FLEXNAMES +++ yyerror("%s redefined", +++#else not FLEXNAMES +++ yyerror("%.*s redefined", +++ NCPS, +++#endif not FLEXNAMES +++ np->s_name); +++ else +++#ifdef FLEXNAMES +++ yyerror("%s redefined: PHASE ERROR, 1st: %d, 2nd: %d", +++#else not FLEXNAMES +++ yyerror("%.*s redefined: PHASE ERROR, 1st: %d, 2nd: %d", +++ NCPS, +++#endif not FLEXNAMES +++ np->s_name, +++ np->s_value, +++ dotp->e_xvalue); + + } + + } - txtfil = usefile[seg_number]; - relfil = rusefile[seg_number]; + + } +++ np->s_type &= ~(XTYPE|XFORW); +++ np->s_type |= dotp->e_xtype; +++ np->s_value = dotp->e_xvalue; +++ if (passno == 1){ +++ np->s_index = dotp-usedot; +++ if (np->s_name[0] == 'L'){ +++ nlabels++; +++ } +++ np->s_tag = LABELID; +++ } +++ } /*end of this being a label*/ +++ } /*end of to consuming all labels, NLs and SEMIS */ + + - break; - } /*end of case .TEXT and .DATA*/ +++ xp = explist; +++ ap = arglist; + + +++ /* +++ * process the INSTRUCTION body +++ */ +++ switch(val){ +++ +++ default: +++ ERROR("Unrecognized instruction or directive"); +++ +++ case IABORT: +++ shift; +++ sawabort(); +++ /*NOTREACHED*/ +++ break; +++ +++ case PARSEEOF: +++ tokptr -= sizeof(toktype); +++ *tokptr++ = VOID; +++ tokptr[1] = VOID; +++ tokptr[2] = PARSEEOF; +++ break; +++ +++ case IFILE: +++ shift; +++ stringp = (struct strdesc *)yylval; +++ shiftover(STRING); +++ dotsname = &UDotsname[0]; +++ movestr(dotsname, stringp->str, +++ stringp->str_lg >= 32? 32 :stringp->str_lg); +++ dotsname[stringp->str_lg] = '\0'; +++ break; +++ +++ case ILINENO: +++ shift; /*over the ILINENO*/ +++ expr(locxp, val); +++ lineno = locxp->e_xvalue; +++ break; +++ +++ case ISET: /* .set , */ +++ shift; +++ np = (struct symtab *)yylval; +++ shiftover(NAME); +++ shiftover(CM); +++ expr(locxp, val); +++ np->s_type &= (XXTRN|XFORW); +++ np->s_type |= locxp->e_xtype&(XTYPE|XFORW); +++ np->s_value = locxp->e_xvalue; +++ if (passno==1) +++ np->s_index = locxp->e_xloc; +++ if ((locxp->e_xtype&XTYPE) == XUNDEF) +++ yyerror("Illegal set?"); +++ break; +++ +++ case ILSYM: /*.lsym name , expr */ +++ shift; +++ np = (struct symtab *)yylval; +++ shiftover(NAME); +++ shiftover(CM); +++ expr(locxp, val); +++ /* +++ * Build the unique occurance of the +++ * symbol. +++ * The character scanner will have +++ * already entered it into the symbol +++ * table, but we should remove it +++ */ +++ if (passno == 1){ +++ stpt = (struct symtab *)symalloc(); +++#ifdef FLEXNAMES +++ stpt->s_name = np->s_name; +++#else +++ movestr(stpt->s_name, np->s_name, NCPS); +++#endif +++ np->s_tag = OBSOLETE; /*invalidate original */ +++ nforgotten++; +++ np = stpt; +++ if (locxp->e_xtype != XABS) +++ ("Illegal lsym"); +++ np->s_value=locxp->e_xvalue; +++ np->s_type=XABS; +++ np->s_tag = ILSYM; +++ } +++ break; +++ +++ case IGLOBAL: /*.globl */ +++ shift; +++ np = (struct symtab *)yylval; +++ shiftover(NAME); +++ np->s_type |= XXTRN; +++ break; +++ +++ case IDATA: /*.data [ ] */ +++ case ITEXT: /*.text [ ] */ +++ seg_type = -val; +++ shift; +++ if (INTOKSET(val, EBEGOPS+YUKKYEXPRBEG+SAFEEXPRBEG)){ +++ expr(locxp, val); +++ seg_type = -seg_type; /*now, it is positive*/ +++ } +++ +++ if (seg_type < 0) { /*there wasn't an associated expr*/ +++ seg_number = 0; +++ seg_type = -seg_type; +++ } else { +++ if (locxp->e_xtype != XABS || (seg_number=locxp->e_xvalue) >= NLOC) { +++ yyerror("illegal location counter"); +++ seg_number = 0; +++ } +++ } +++ if (seg_type == IDATA) +++ seg_number += NLOC; +++ flushfield(NBPW/4); +++ dotp = &usedot[seg_number]; +++#ifdef UNIX +++ if (passno==2) { /* go salt away in pass 2*/ +++ txtfil = usefile[seg_number]; +++ relfil = rusefile[seg_number]; +++ } +++#endif UNIX +++#ifdef VMS +++ if (passno==2) { +++ puchar(vms_obj_ptr,6); /* setpl */ +++ puchar(vms_obj_ptr,seg_number); /* psect # */ +++ plong(vms_obj_ptr,dotp->e_xvalue);/* offset */ +++ puchar(vms_obj_ptr,80); /* setrb */ +++ if((vms_obj_ptr-sobuf) > 400){ +++ write(objfil,sobuf,vms_obj_ptr-sobuf); +++ vms_obj_ptr=sobuf+1; /*flush buf*/ +++ } +++ } +++#endif VMS +++ break; +++ +++ /* +++ * Storage filler directives: +++ * +++ * .byte [] +++ * +++ * exprlist: empty | exprlist outexpr +++ * outexpr: | : +++ */ +++ case IBYTE: curlen = NBPW/4; goto elist; +++ +++ case IINT: +++ case ILONG: curlen = NBPW; goto elist; +++ +++ case IWORD: +++ curlen = NBPW/2; +++ elist: +++ seg_type = val; +++ shift; +++ +++ /* +++ * Expression List processing +++ */ +++ if (INTOKSET(val, EBEGOPS+YUKKYEXPRBEG+SAFEEXPRBEG)){ +++ do{ + + /* - * Storage filler directives: - * - * .byte [] - * - * exprlist: empty | exprlist outexpr - * outexpr: | : +++ * expression list consists of a list of : +++ * +++ * : +++ * (pack expr2 into expr1 bits + + */ - case IBYTE: curlen = NBPW/4; goto elist; - - case IINT: - case ILONG: curlen = NBPW; goto elist; - - case IWORD: { - curlen = NBPW/2; - elist: - seg_type = val; - shift; - - /* - * This processes an expression list - */ - if (INTOKSET(val, EBEGOPS+YUKKYEXPRBEG+SAFEEXPRBEG)){ - do{ - /* - * expression list consists of a list of : - * - * : - * (pack expr2 into expr1 bits - */ - expr(locxp, val); - /* - * now, pointing at the next token - */ - if (val == COLON){ - shiftover(COLON); - expr(pval, val); - if (locxp->xtype != XABS) - yyerror("Width not absolute"); - field_width = locxp->xvalue; - locxp = pval; - if (bitoff + field_width > - curlen) - flushfield(curlen); - if (field_width > curlen) - yyerror("Expression crosses field boundary"); - } /*value being colon*/ - else { - field_width = curlen; - flushfield(curlen); - } - - if ((locxp->xtype&XTYPE)!=XABS) { - if (bitoff) - yyerror("Illegal relocation in field"); - field_width=LEN1+!PCREL; - if (curlen==NBPW) - field_width = LEN4 + !PCREL; - if (curlen==NBPW/2) - field_width = LEN2 + !PCREL; - /* - * Save relocation information for this non absolute - * symbol: - * pass 1: saves enough space for the value, and - * fixes dotp. - * pass 2: writes the address info in ld compatable - * format onto one of the relfiles - */ - outrel(&locxp->xvalue, - field_width, - locxp->xtype, - locxp->xname); - } else { - field_value = locxp->xvalue & ( (1L << field_width)-1); - bitfield |= field_value << bitoff; - bitoff += field_width; - } - if ( auxval = (val == CM)) shift; - } while (auxval); - } /*existed an expression at all*/ - +++ expr(locxp, val); +++ /* +++ * now, pointing at the next token +++ */ +++ if (val == COLON){ +++ shiftover(COLON); +++ expr(pval, val); +++ if (locxp->e_xtype != XABS) +++ yyerror("Width not absolute"); +++ field_width = locxp->e_xvalue; +++ locxp = pval; +++ if (bitoff + field_width > +++ curlen) +++ flushfield(curlen); +++ if (field_width > curlen) +++ yyerror("Expression crosses field boundary"); +++ } else { +++ field_width = curlen; + + flushfield(curlen); - if ( ( curlen == NBPW/4) && bitoff) - dotp->xvalue ++; - break; - } /*end of case IBYTE, IWORD, ILONG, IINT*/ - - case ISPACE: { /* .space */ - shift; - expr(locxp, val); - if (locxp->xtype != XABS) - yyerror("Space size not absolute"); - space_value = locxp->xvalue; - ospace: - flushfield(NBPW/4); - while (space_value > 96){ - outs(strbuf[2].str, 96); - space_value -= 96; +++ } +++ +++ if ((locxp->e_xtype&XTYPE)!=XABS) { +++ if (bitoff) +++ yyerror("Illegal relocation in field"); +++ switch(curlen){ +++ case NBPW/4: reloc_how = TYPB; break; +++ case NBPW/2: reloc_how = TYPW; break; +++ case NBPW: reloc_how = TYPL; break; + + } - outs(strbuf[2].str, space_value); - break; - } /*end of case ISPACE*/ - - case IASCII: /* .ascii [ ] */ - case IASCIZ: { /* .asciz [ ] */ - auxval = val; - shift; - - /* - * Code to consume a string list - * - * stringlist: empty | STRING | stringlist STRING - */ - while (val == STRING){ - flushfield(NBPW/4); - if (bitoff) - dotp->xvalue++; - stringp = (struct strdesc *)yylval; - outs(stringp->str, stringp->str_lg); - shift; /*over the STRING*/ - if (val == CM) /*could be a split string*/ - shift; +++ if (passno == 1){ +++ dotp->e_xvalue += ty_nbyte[reloc_how]; +++ } else { +++ outrel(locxp, reloc_how); + + } - - if (auxval == IASCIZ){ - flushfield(NBPW/4); - outb(0); +++ } else { +++ field_value = locxp->e_xvalue & ( (1L << field_width)-1); +++ bitfield |= field_value << bitoff; +++ bitoff += field_width; +++ } +++ if ( auxval = (val == CM)) shift; +++ xp = explist; +++ } while (auxval); +++ } /*existed an expression at all*/ +++ +++ flushfield(curlen); +++ if ( ( curlen == NBPW/4) && bitoff) +++ dotp->e_xvalue ++; +++ break; +++ /*end of case IBYTE, IWORD, ILONG, IINT*/ +++ +++ case ISPACE: /* .space */ +++ shift; +++ expr(locxp, val); +++ if (locxp->e_xtype != XABS) +++ yyerror("Space size not absolute"); +++ space_value = locxp->e_xvalue; +++ ospace: +++ flushfield(NBPW/4); +++#ifdef UNIX +++ while (space_value > 96){ +++ outs(strbuf[2].str, 96); +++ space_value -= 96; +++ } +++ outs(strbuf[2].str, space_value); +++#endif UNIX +++#ifdef VMS +++ dotp->e_xvalue += space_value; /*bump pc*/ +++ if (passno==2){ +++ if(*(strbuf[2].str)==0) { +++ puchar(vms_obj_ptr,81); /* AUGR */ +++ pulong(vms_obj_ptr,space_value);/* incr */ +++ } else yyerror("VMS, encountered non-0 .space"); +++ if ((vms_obj_ptr-sobuf) > 400) { +++ write(objfil,sobuf,vms_obj_ptr-sobuf); +++ vms_obj_ptr=sobuf+1; /*pur buf*/ +++ } +++ } +++#endif VMS +++ break; +++ +++#ifdef UNIX +++ /* +++ * .fill rep, size, value +++ * repeat rep times: fill size bytes with (truncated) value +++ * size must be between 1 and 8 +++ */ +++ case IFILL: +++ shift; +++ expr(locxp, val); +++ if (locxp->e_xtype != XABS) +++ yyerror("Fill repetition count not absolute"); +++ fill_rep = locxp->e_xvalue; +++ shiftover(CM); +++ expr(locxp, val); +++ if (locxp->e_xtype != XABS) +++ yyerror("Fill size not absolute"); +++ fill_size = locxp->e_xvalue; +++ if (fill_size <= 0 || fill_size > 8) +++ yyerror("Fill count not in in 1..8"); +++ shiftover(CM); +++ expr(locxp, val); +++ if (passno == 2 && locxp->e_xtype != XABS) +++ yyerror("Fill value not absolute"); +++ flushfield(NBPW/4); +++ if (passno == 1) { +++ locxp->e_xvalue += fill_rep * fill_size; +++ } else { +++ while(fill_rep-- > 0) +++ bwrite(&locxp->e_xvalue, fill_size, txtfil); +++ } +++ break; +++#endif UNIX +++ +++ case IASCII: /* .ascii [ ] */ +++ case IASCIZ: /* .asciz [ ] */ +++ auxval = val; +++ shift; +++ +++ /* +++ * Code to consume a string list +++ * +++ * stringlist: empty | STRING | stringlist STRING +++ */ +++ while (val == STRING){ +++ flushfield(NBPW/4); +++ if (bitoff) +++ dotp->e_xvalue++; +++ stringp = (struct strdesc *)yylval; +++#ifdef UNIX +++ outs(stringp->str, stringp->str_lg); +++#endif UNIX +++#ifdef VMS +++ { +++ register int i; +++ for (i=0; i < stringp->str_lg; i++){ +++ dotp->e_xvalue += 1; +++ if (passno==2){ +++ puchar(vms_obj_ptr,-1); +++ puchar(vms_obj_ptr,stringp->str[i]); +++ if (vms_obj_ptr-sobuf > 400) { +++ write(objfil,sobuf,vms_obj_ptr-sobuf); +++ vms_obj_ptr = sobuf + 1; +++ } +++ } + + } - break; - } /*end of case IASCII and IASIZ*/ - - case IORG: { /* .org */ +++ } +++#endif VMS +++ shift; /*over the STRING*/ +++ if (val == CM) /*could be a split string*/ + + shift; - expr(locxp, val); +++ } + + - if (locxp->xtype==XABS) - orgwarn++; - else if (locxp->xtype!=dotp->xtype) - yyerror("Illegal expression to set origin"); - space_value = locxp->xvalue - dotp->xvalue; - if (space_value < 0) - yyerror("Backwards 'org'"); - goto ospace; - break; - } /*end of case IORG*/ - +++ if (auxval == IASCIZ){ +++ flushfield(NBPW/4); +++#ifdef UNIX +++ outb(0); +++#endif UNIX +++#ifdef VMS +++ if (passno == 2) { +++ puchar(vms_obj_ptr,-1); +++ puchar(vms_obj_ptr,0); +++ } +++ dotp->e_xvalue += 1; +++#endif VMS +++ } +++ break; +++ +++ case IORG: /* .org */ +++ shift; +++ expr(locxp, val); +++ +++ if (locxp->e_xtype==XABS) +++ orgwarn++; +++ else if ((locxp->e_xtype & ~XXTRN) != dotp->e_xtype) +++ yyerror("Illegal expression to set origin"); +++ space_value = locxp->e_xvalue - dotp->e_xvalue; +++ if (space_value < 0) +++ yyerror("Backwards 'org'"); +++ goto ospace; +++ break; +++ +++/* +++ * +++ * Process stabs. Stabs are created only by the f77 +++ * and the C compiler with the -g flag set. +++ * We only look at the stab ONCE, during pass 1, and +++ * virtually remove the stab from the intermediate file +++ * so it isn't seen during pass2. This makes for some +++ * hairy processing to handle labels occuring in +++ * stab entries, but since most expressions in the +++ * stab are integral we save lots of time in the second +++ * pass by not looking at the stabs. +++ * A stab that is tagged floating will be bumped during +++ * the jxxx resolution phase. A stab tagged fixed will +++ * not be be bumped. +++ * +++ * .stab: Old fashioned stabs +++ * .stabn: For stabs without names +++ * .stabs: For stabs with string names +++ * .stabd: For stabs for line numbers or bracketing, +++ * without a string name, without +++ * a final expression. The value of the +++ * final expression is taken to be the current +++ * location counter, and is patched by the 2nd pass +++ * +++ * .stab{,}*NCPS,, , , +++ * .stabn , , , +++ * .stabs STRING, , , , +++ * .stabd , , # . +++ */ +++ case ISTAB: +++#ifndef FLEXNAMES +++ stabname = ".stab"; +++ if (passno == 2) goto errorfix; +++ stpt = (struct symtab *)yylval; +++ /* +++ * Make a pointer to the .stab slot. +++ * There is a pointer in the way (stpt), and +++ * tokptr points to the next token. +++ */ +++ stabstart = tokptr; +++ (char *)stabstart -= sizeof(struct symtab *); +++ (char *)stabstart -= sizeof(toktype); +++ shift; +++ for (argcnt = 0; argcnt < NCPS; argcnt++){ +++ expr(locxp, val); +++ stpt->s_name[argcnt] = locxp->e_xvalue; +++ xp = explist; +++ shiftover(CM); +++ } +++ goto tailstab; +++#else FLEXNAMES +++ yyerror(".stab directive not supported in; report this compiler bug to system administrator"); +++ goto errorfix; +++#endif FLEXNAMES +++ +++ tailstab: +++ expr(locxp, val); +++ if (! (locxp->e_xvalue & STABTYPS)){ +++ yyerror("Invalid type in %s",stabname); +++ goto errorfix; +++ } +++ stpt->s_ptype = locxp->e_xvalue; +++ shiftover(CM); +++ expr(locxp, val); +++ stpt->s_other = locxp->e_xvalue; +++ shiftover(CM); +++ expr(locxp, val); +++ stpt->s_desc = locxp->e_xvalue; +++ shiftover(CM); +++ exprisname = 0; +++ expr(locxp, val); +++ p = locxp->e_xname; +++ if (p == NULL) { /*absolute expr to begin with*/ +++ stpt->s_value = locxp->e_xvalue; +++ stpt->s_index = dotp - usedot; +++ if (exprisname){ +++ switch(stpt->s_ptype){ +++ case N_GSYM: +++ case N_FNAME: +++ case N_RSYM: +++ case N_SSYM: +++ case N_LSYM: +++ case N_PSYM: +++ case N_BCOMM: +++ case N_ECOMM: +++ case N_LENG: +++ stpt->s_tag = STABFIXED; +++ break; +++ default: +++ stpt->s_tag = STABFLOATING; +++ break; +++ } +++ } else +++ stpt->s_tag = STABFIXED; +++ } +++ else { /*really have a name*/ +++ stpt->s_dest = locxp->e_xname; +++ stpt->s_index = p->s_index; +++ stpt->s_type = p->s_type | STABFLAG; +++ /* +++ * We will assign a more accruate +++ * guess of locxp's location when +++ * we sort the symbol table +++ * The final value of value is +++ * given by stabfix() +++ */ +++ stpt->s_tag = STABFLOATING; +++ } +++ /* +++ * tokptr now points at one token beyond +++ * the current token stored in val and yylval, +++ * which are the next tokens after the end of +++ * this .stab directive. This next token must +++ * be either a SEMI or NL, so is of width just +++ * one. Therefore, to point to the next token +++ * after the end of this stab, just back up one.. +++ */ +++ buildskip(stabstart, (char *)tokptr - sizeof(toktype)); +++ break; /*end of the .stab*/ +++ +++ case ISTABDOT: +++ stabname = ".stabd"; +++ stpt = (struct symtab *)yylval; +++ /* +++ * We clobber everything after the +++ * .stabd and its pointer... we MUST +++ * be able to get back to this .stabd +++ * so that we can resolve its final value +++ */ +++ stabstart = tokptr; +++ shift; /*over the ISTABDOT*/ +++ if (passno == 1){ +++ expr(locxp, val); +++ if (! (locxp->e_xvalue & STABTYPS)){ +++ yyerror("Invalid type in .stabd"); +++ goto errorfix; +++ } +++ stpt->s_ptype = locxp->e_xvalue; +++ shiftover(CM); +++ expr(locxp, val); +++ stpt->s_other = locxp->e_xvalue; +++ shiftover(CM); +++ expr(locxp, val); +++ stpt->s_desc = locxp->e_xvalue; + + /* + + * - * Process stabs. Stabs are created only by the f77 - * and the C compiler with the -g flag set. - * We only look at the stab ONCE, during pass 1, and - * virtually remove the stab from the intermediate file - * so it isn't seen during pass2. This makes for some - * hairy processing to handle labels occuring in - * stab entries, but since most expressions in the - * stab are integral we save lots of time in the second - * pass by not looking at the stabs. - * A stab that is tagged floating will be bumped during - * the jxxx resolution phase. A stab tagged fixed will - * not be be bumped. - * - * .stab: Old fashioned stabs - * .stabn: For stabs without names - * .stabs: For stabs with string names - * .stabd: For stabs for line numbers or bracketing, - * without a string name, without - * a final expression. The value of the - * final expression is taken to be the current - * location counter, and is patched by the 2nd pass - * - * .stab{,}*8,, , , - * .stabn , , , - * .stabs STRING, , , , - * .stabd , , # . +++ * Now, clobber everything but the +++ * .stabd pseudo and the pointer +++ * to its symbol table entry +++ * tokptr points to the next token, +++ * build the skip up to this + + */ - case ISTAB: { - stabname = ".stab"; - if (passno == 2) goto errorfix; - stpt = (struct symtab *)yylval; - /* - * Make a pointer to the .stab slot. - * There is a pointer in the way (stpt), and - * tokptr points to the next token. - */ - stabstart = tokptr; - (char *)stabstart -= sizeof(struct symtab *); - (char *)stabstart -= sizeof(toktype); - shift; - for (argcnt = 0; argcnt < 8; argcnt++){ - expr(locxp, val); - stpt->name[argcnt] = locxp->xvalue; - shiftover(CM); - } - tailstab: - expr(locxp, val); - if (! (locxp->xvalue & STABTYPS)){ - yyerror("Invalid type in %s",stabname); - goto errorfix; - } - stpt->ptype = locxp->xvalue; - shiftover(CM); - expr(locxp, val); - stpt->other = locxp->xvalue; - shiftover(CM); - expr(locxp, val); - stpt->desc = locxp->xvalue; - shiftover(CM); - exprisname = 0; - expr(locxp, val); - p = locxp->xname; - if (p == NULL) { /*absolute expr to begin with*/ - stpt->value = locxp->xvalue; - stpt->index = dotp - usedot; - if (exprisname){ - switch(stpt->ptype){ - case N_GSYM: - case N_FNAME: - case N_RSYM: - case N_SSYM: - case N_LSYM: - case N_PSYM: - case N_BCOMM: - case N_ECOMM: - case N_LENG: - stpt->tag = STABFIXED; - break; - default: - stpt->tag = STABFLOATING; - break; - } - } else - stpt->tag = STABFIXED; - } - else { /*really have a name*/ - stpt->dest = locxp->xname; - stpt->index = p->index; - stpt->type = p->type | STABFLAG; - /* - * We will assign a more accruate - * guess of locxp's location when - * we sort the symbol table - * The final value of value is - * given by stabfix() - */ - stpt->tag = STABFLOAT; - #ifdef DSTAB - printf("FORWARD REF FOR %s...\n", stabname); - printf("value (xname) = %x value(value(xname) = %x\n", - stpt->dest,stpt->dest->value); - printf("name: %.8s\n\n", - (stpt->dest)->name); +++ buildskip(stabstart, (toktype *)tokptr - sizeof(toktype)); +++ } +++ /* +++ * pass 1: Assign a good guess for its position +++ * (ensures they are sorted into right place)/ +++ * pass 2: Fix the actual value +++ */ +++ stpt->s_value = dotp->e_xvalue; +++ stpt->s_index = dotp - usedot; +++ stpt->s_tag = STABFLOATING; /*although it has no effect in pass 2*/ +++ break; +++ +++ case ISTABNONE: stabname = ".stabn"; goto shortstab; +++ +++ case ISTABSTR: stabname = ".stabs"; +++ shortstab: +++ auxval = val; +++ if (passno == 2) goto errorfix; +++ stpt = (struct symtab *)yylval; +++ stabstart = tokptr; +++ (char *)stabstart -= sizeof(struct symtab *); +++ (char *)stabstart -= sizeof(toktype); +++ shift; +++ if (auxval == ISTABSTR){ +++ stringp = (struct strdesc *)yylval; +++ shiftover(STRING); +++#ifndef FLEXNAMES +++ auxval = stringp->str_lg > NCPS ? NCPS : stringp->str_lg; +++#else +++ stringp->str[stringp->str_lg] = 0; + +#endif +++ shiftover(CM); +++ } else { +++ stringp = &(strbuf[2]); +++#ifndef FLEXNAMES +++ auxval = NCPS; +++#endif +++ } +++#ifndef FLEXNAMES +++ movestr(stpt->s_name, stringp->str, auxval); +++#else +++ stpt->s_name = savestr(stringp->str); +++#endif +++ goto tailstab; +++ break; +++ +++ case ICOMM: /* .comm , */ +++ case ILCOMM: /* .lcomm , */ +++ auxval = val; +++ shift; +++ np = (struct symtab *)yylval; +++ shiftover(NAME); +++ shiftover(CM); +++ expr(locxp, val); +++ +++ if (locxp->e_xtype != XABS) +++ yyerror("comm size not absolute"); +++ if (passno==1 && (np->s_type&XTYPE)!=XUNDEF) +++#ifdef FLEXNAMES +++ yyerror("Redefinition of %s", +++#else not FLEXNAMES +++ yyerror("Redefinition of %.*s", +++ NCPS, +++#endif not FLEXNAMES +++ np->s_name); +++ if (passno==1) { +++ np->s_value = locxp->e_xvalue; +++ if (auxval == ICOMM) +++ np->s_type |= XXTRN; +++ else { +++ np->s_type &= ~XTYPE; +++ np->s_type |= XBSS; +++ } +++ } +++ break; +++ +++ case IALIGN: /* .align */ +++ stpt = (struct symtab *)yylval; +++ shift; +++ expr(locxp, val); +++ jalign(locxp, stpt); +++ break; +++ +++ case INST0: /* instructions w/o arguments*/ +++ insout(yylval, (struct arg *)0, 0); +++ shift; +++ break; +++ +++ case INSTn: /* instructions with arguments*/ +++ case IJXXX: /* UNIX style jump instructions */ +++ auxval = val; +++ seg_type = yylval; +++ /* +++ * Code to process an argument list +++ */ +++ ap = arglist; +++ xp = explist; +++ +++ shift; /* bring in the first token for the arg list*/ +++ +++ for (argcnt = 1; argcnt <= 6; argcnt++, ap++){ +++ /* +++ * code to process an argument proper +++ */ +++ sawindex = sawmul = sawsize = 0; +++ { +++ switch(val) { +++ +++ default: +++ disp: +++ if( !(INTOKSET(val, +++ EBEGOPS +++ +YUKKYEXPRBEG +++ +SAFEEXPRBEG)) ) { +++ ERROR("expression expected"); + + } - /* - * tokptr now points at one token beyond - * the current token stored in val and yylval, - * which are the next tokens after the end of - * this .stab directive. This next token must - * be either a SEMI or NL, so is of width just - * one. Therefore, to point to the next token - * after the end of this stab, just back up one.. - */ - buildskip(stabstart, (char *)tokptr - sizeof(toktype)); - break; /*end of the .stab*/ - } /*end of ISTAB*/ - - case ISTABDOT: { - stabname = ".stabd"; - stpt = (struct symtab *)yylval; - /* - * We clobber everything after the - * .stabd and its pointer... we MUST - * be able to get back to this .stabd - * so that we can resolve its final value - */ - stabstart = tokptr; - shift; /*over the ISTABDOT*/ - if (passno == 1){ - expr(locxp, val); - if (! (locxp->xvalue & STABTYPS)){ - yyerror("Invalid type in .stabd"); - goto errorfix; - } - stpt->ptype = locxp->xvalue; - shiftover(CM); - expr(locxp, val); - stpt->other = locxp->xvalue; - shiftover(CM); - expr(locxp, val); - stpt->desc = locxp->xvalue; - /* - * - * Now, clobber everything but the - * .stabd pseudo and the pointer - * to its symbol table entry - * tokptr points to the next token, - * build the skip up to this - */ - buildskip(stabstart, (toktype *)tokptr - sizeof(toktype)); - } - /* - * pass 1: Assign a good guess for its position - * (ensures they are sorted into right place)/ - * pass 2: Fix the actual value - */ - stpt->value = dotp->xvalue; - stpt->index = dotp - usedot; - stpt->tag = STABFLOAT; /*although it has no effect in pass 2*/ - break; - } /*end of case ISTABDOT*/ - - case ISTABNONE: stabname = ".stabn"; goto shortstab; - - case ISTABSTR: { stabname = ".stabs"; - shortstab: - auxval = val; - if (passno == 2) goto errorfix; - stpt = (struct symtab *)yylval; - stabstart = tokptr; - (char *)stabstart -= sizeof(struct symtab *); - (char *)stabstart -= sizeof(toktype); - shift; - if (auxval == ISTABSTR){ - stringp = (struct strdesc *)yylval; - shiftover(STRING); - auxval = stringp->str_lg > NCPS ? NCPS : stringp->str_lg; - shiftover(CM); +++ expr(ap->a_xp,val); +++ overdisp: +++ if ( val == LP || sawsize){ +++ shiftover(LP); +++ findreg(regno); +++ shiftover(RP); +++ ap->a_atype = ADISP; +++ ap->a_areg1 = regno; + + } else { - stringp = &(strbuf[2]); - auxval = NCPS; +++ ap->a_atype = AEXP; +++ ap->a_areg1 = 0; + + } - movestr(stpt->name, stringp->str, auxval); - goto tailstab; - break; - } /*end of case ISTABSTR and ISTABN*/ - - case ICOMM: /* .comm , */ - case ILCOMM: { /* .lcomm , */ - auxval = val; +++ goto index; +++ +++ case SIZESPEC: +++ sizespec: +++ sawsize = yylval; + + shift; - np = (struct symtab *)yylval; - shiftover(NAME); - shiftover(CM); - expr(locxp, val); +++ goto disp; + + - if (locxp->xtype != XABS) - yyerror("comm size not absolute"); - if (passno==1 && (np->type&XTYPE)!=XUNDEF) - yyerror("Redefinition of %.8s", np->name); - if (passno==1) { - np->value = locxp->xvalue; - if (auxval == ICOMM) - np->type |= XXTRN; - else { - np->type &= ~XTYPE; - np->type |= XBSS; - } - } +++ case REG: +++ case REGOP: +++ findreg(regno); +++ ap->a_atype = AREG; +++ ap->a_areg1 = regno; + + break; - } /*end of case ICOMM and ILCOMM*/ - - case IALIGN: { /* .align */ - stpt = (struct symtab *)yylval; +++ +++ case MUL: +++ sawmul = 1; + + shift; - expr(locxp, val); - jalign(locxp, stpt); - break; - } /*end of case IALIGN*/ - - case INST0: { /* instructions w/o arguments*/ - insout(yylval, 0, 0); - shift; +++ if (val == LP) goto base; +++ if (val == LITOP) goto imm; +++ if (val == SIZESPEC) goto sizespec; +++ if (INTOKSET(val, +++ EBEGOPS +++ +YUKKYEXPRBEG +++ +SAFEEXPRBEG)) goto disp; +++ ERROR("expression, '(' or '$' expected"); + + break; - } /*end of case INST0*/ - - case INSTn: /* instructions with arguments*/ - case IJXXX: { /* UNIX style jump instructions */ - auxval = val; - seg_type = yylval; +++ +++ case LP: +++ base: +++ shift; /*consume the LP*/ + + /* - * Code to process an argument list +++ * hack the ambiguity of +++ * movl (expr) (rn), ... +++ * note that (expr) could also +++ * be (rn) (by special hole in the +++ * grammar), which we ensure +++ * means register indirection, instead +++ * of an expression with value n + + */ - ap = arglist; - xp = explist; /*must be set before bring in the first token*/ - - shift; /*and bring in the first token for the arg list*/ - - for (argcnt = 1; argcnt <= 6; argcnt++, ap++){ - /* - * code to process an argument proper - */ - sawindex = sawmul = sawsize = 0; - { - switch(val) { - - default: { - disp: - if( !(INTOKSET(val, - EBEGOPS - +YUKKYEXPRBEG - +SAFEEXPRBEG)) ) { - ERROR("expression expected"); - } - expr(ap->xp,val); - overdisp: - if ( val == LP || sawsize){ - shiftover(LP); - findreg(regno); - shiftover(RP); - ap->atype = ADISP; - ap->areg1 = regno; - } else { - ap->atype = AEXP; - ap->areg1 = 0; - } - goto index; - } /*end of the default action*/ - - case SIZESPEC: { - sizespec: - sawsize = yylval; - shift; - goto disp; - } - - case REG: - case REGOP: { - findreg(regno); - ap->atype = AREG; - ap->areg1 = regno; - break; - } /*end of case REG*/ - - case MUL: { - sawmul = 1; - shift; - if (val == LP) goto base; - if (val == LITOP) goto imm; - if (val == SIZESPEC) goto sizespec; - if (INTOKSET(val, - EBEGOPS - +YUKKYEXPRBEG - +SAFEEXPRBEG)) goto disp; - ERROR("expression, '(' or '$' expected"); - break; - } /*end of case MUL*/ - - case LP: { - base: - shift; /*consume the LP*/ - /* - * hack the ambiguity of - * movl (expr) (rn), ... - * note that (expr) could also - * be (rn) (by special hole in the - * grammar), which we ensure - * means register indirection, instead - * of an expression with value n - */ - if (val != REG && val != REGOP){ - droppedLP = 1; - val = exprparse(val, &(ap->xp)); - droppedLP = 0; - goto overdisp; - } - findreg(regno); - shiftover(RP); - if (val == PLUS){ - shift; - ap->atype = AINCR; - } else - ap->atype = ABASE; - ap->areg1 = regno; - goto index; - } /*end of case LP*/ - - case LITOP: { - imm: - shift; - expr(locxp, val); - ap->atype = AIMM; - ap->areg1 = 0; - ap->xp = locxp; - goto index; - } /*end of case LITOP*/ - - case MP: { - shift; /* -(reg) */ - findreg(regno); - shiftover(RP); - ap->atype = ADECR; - ap->areg1 = regno; - index: /*look for [reg] */ - if (val == LB){ - shift; - findreg(regno); - shiftover(RB); - sawindex = 1; - ap->areg2 = regno; - } - break; - } /*end of case MP*/ - - } /*end of the switch to process an arg*/ - } /*end of processing an argument*/ - - if (sawmul){ - /* - * Make a concession for *(%r) - * meaning *0(%r) - */ - if (ap->atype == ABASE) { - ap->atype = ADISP; - xp->xtype = XABS; - xp->xvalue = 0; - xp->xloc = 0; - ap->xp = xp++; - } - ap->atype |= ASTAR; - sawmul = 0; - } - if (sawindex){ - ap->atype |= AINDX; - sawindex = 0; - } - ap->dispsize = sawsize == 0 ? d124 : sawsize; - if (val != CM) break; - shiftover(CM); - } /*processing all the arguments*/ - - if (argcnt > 6){ - yyerror("More than 6 arguments"); - goto errorfix; +++ if (val != REG && val != REGOP){ +++ droppedLP = 1; +++ val = exprparse(val, &(ap->a_xp)); +++ droppedLP = 0; +++ goto overdisp; + + } +++ findreg(regno); +++ shiftover(RP); +++ if (val == PLUS){ +++ shift; +++ ap->a_atype = AINCR; +++ } else +++ ap->a_atype = ABASE; +++ ap->a_areg1 = regno; +++ goto index; + + - insout(seg_type, arglist, - auxval == INSTn ? argcnt : - argcnt); - break; - } /*end of case INSTn and IJXXX*/ - - case IFLOAT: curlen = 4; goto floatlist; - - case IDOUBLE: { - curlen = 8; - floatlist: - /* - * eat a list of floating point numbers - */ +++ case LITOP: +++ imm: + + shift; - if (val == FLTNUM){ - do{ - if (val == CM) shift; - if (val != FLTNUM) { - ERROR("floating number expected"); - } - dotp->xvalue += curlen; - if (passno == 2) - fwrite( - &(((struct exp *)yylval)->doubval.dvalue), - 1, curlen, txtfil); - shift; - } while (val == CM); +++ expr(locxp, val); +++ ap->a_atype = AIMM; +++ ap->a_areg1 = 0; +++ ap->a_xp = locxp; +++ goto index; +++ +++ case MP: +++ shift; /* -(reg) */ +++ findreg(regno); +++ shiftover(RP); +++ ap->a_atype = ADECR; +++ ap->a_areg1 = regno; +++ index: /*look for [reg] */ +++ if (val == LB){ +++ shift; +++ findreg(regno); +++ shiftover(RB); +++ sawindex = 1; +++ ap->a_areg2 = regno; + + } + + break; - } /*end of case IFLOAT and IDOUBLE*/ + + - } /*end of the switch for looking at each reserved word*/ +++ } /*end of the switch to process an arg*/ +++ } /*end of processing an argument*/ + + - /* - * If got here, then one has no syntax errors! - */ - continue; +++ if (sawmul){ +++ /* +++ * Make a concession for *(%r) +++ * meaning *0(%r) +++ */ +++ if (ap->a_atype == ABASE) { +++ ap->a_atype = ADISP; +++ xp->e_xtype = XABS; +++ xp->e_xvalue = 0; +++ xp->e_xloc = 0; +++ ap->a_xp = xp++; +++ } +++ ap->a_atype |= ASTAR; +++ sawmul = 0; +++ } +++ if (sawindex){ +++ ap->a_atype |= AINDX; +++ sawindex = 0; +++ } +++ ap->a_dispsize = sawsize == 0 ? d124 : sawsize; +++ if (val != CM) break; +++ shiftover(CM); +++ } /*processing all the arguments*/ +++ +++ if (argcnt > 6){ +++ yyerror("More than 6 arguments"); +++ goto errorfix; +++ } + + - /* - * got here by either requesting to skip to the - * end of this statement, or by erroring out and - * wanting to apply panic mode recovery - */ - errorfix: { - #ifdef DEBUG - if (debug) - printf("Discarding tokens from here:\n"); - #endif - while ( (val != NL) - && (val != SEMI) - && (val != PARSEEOF) - ){ - #ifdef DEBUG - if (debug) - printf("****>>>>\t"); - #endif - shift; - } - if (val == NL) - lineno++; - #ifdef DEBUG - if (debug) - printf("To here.\n"); - #endif +++ insout(seg_type, arglist, +++ auxval == INSTn ? argcnt : - argcnt); +++ break; +++ +++ case IFLOAT: curlen = 4; goto floatlist; +++ case IQUAD: +++ case IDOUBLE: +++ curlen = 8; +++ floatlist: +++ /* +++ * eat a list of floating point numbers +++ */ +++ shift; +++ if (val == FLTNUM){ +++ /* KLS MOD */ +++ float flocal; +++ do{ +++ if (val == CM) shift; +++ if (val != FLTNUM) { +++ ERROR("floating number expected"); +++ } +++ dotp->e_xvalue += curlen; +++#ifdef UNIX +++ if (passno == 2) { +++ if(curlen == 8) +++ bwrite((char *)&(((union Double *)yylval)->dvalue), +++ curlen, txtfil); +++ else { +++ flocal = ((union Double *)yylval)->dvalue; +++ bwrite((char *)&flocal, curlen, txtfil); +++ } +++ } +++#endif UNIX +++ +++#ifdef VMS +++ if (passno == 2) { +++ puchar(vms_obj_ptr,-4); +++ pulong(vms_obj_ptr, +++ ((struct exp *)yylval) +++ ->doub_MSW); +++ if (curlen==8) { +++ puchar(vms_obj_ptr,-4); +++ pulong(vms_obj_ptr, +++ ((struct exp *)yylval) +++ ->doub_LSW); +++ } +++ if((vms_obj_ptr-sobuf) > 400) { +++ write(objfil,sobuf,vms_obj_ptr-sobuf); +++ vms_obj_ptr = sobuf + 1; +++ } +++ } +++#endif VMS + + shift; - } - - } /*end of the loop to read the entire file, line by line*/ +++ xp = explist; +++ } while (val == CM); +++ } +++ break; +++ } /*end of the switch for looking at each reserved word*/ +++ +++ continue; +++ +++ errorfix: +++ /* +++ * got here by either requesting to skip to the +++ * end of this statement, or by erroring out and +++ * wanting to apply panic mode recovery +++ */ +++ while ( (val != NL) +++ && (val != SEMI) +++ && (val != PARSEEOF) +++ ){ +++ shift; +++ } +++ if (val == NL) +++ lineno++; +++ shift; + + +++ } /*end of the loop to read the entire file, line by line*/ + + + +} /*end of yyparse*/ + + + +/* + + * Process a register declaration of the form + + * % + + * + + * Note: + + * The scanner has already processed funny registers of the form + + * %dd[+-]*, where dd is a decimal number in the range 00 to 15 (optional + + * preceding zero digit). If there was any space between the % and + + * the digit, the scanner wouldn't have recognized it, so we + + * hack it out here. + + */ + +int funnyreg(val, regnoback) /*what the read head will sit on*/ + + int val; /*what the read head is sitting on*/ + + int *regnoback; /*call by return*/ + +{ + + register struct exp *locxp; + + struct exp *loc1xp; + + struct exp **ptrloc1xp = & loc1xp; + + + + expr(locxp, val); /*and leave the current read head with value*/ + + if ( (passno == 2) && - ( locxp->xtype & XTYPE != XABS - || locxp->xvalue < 0 - || locxp->xvalue >= 16 +++ ( locxp->e_xtype & XTYPE != XABS +++ || locxp->e_xvalue < 0 +++ || locxp->e_xvalue >= 16 + + ) + + ){ + + yyerror("Illegal register"); + + return(0); + + } - *regnoback = locxp->xvalue; +++ *regnoback = locxp->e_xvalue; + + return(val); + +} + + - /* VARARGS 1*/ - yyerror(s, a1, a2) +++/*VARARGS1*/ +++yyerror(s, a1, a2,a3,a4,a5) + + char *s; + +{ - FILE *sink; + + - #ifdef DEBUG - sink = stdout; - #else - sink = stderr; - #endif +++#define sink stdout + + + + if (anyerrs == 0 && ! silent) + + fprintf(sink, "Assembler:\n"); + + anyerrs++; + + if (silent) return; + + + + fprintf(sink, "\"%s\", line %d: ", dotsname, lineno); - fprintf(sink, s, a1, a2); +++ fprintf(sink, s, a1, a2,a3,a4,a5); +++ fprintf(sink, "\n"); +++} +++ +++/*VARARGS1*/ +++yywarning(s, a1, a2,a3,a4,a5) +++ char *s; +++{ +++ +++#define sink stdout +++ +++ if (anyerrs == 0 && ! silent) +++ fprintf(sink, "Assembler:\n"); +++ if (silent) return; +++ +++ fprintf(sink, "\"%s\", line %d: WARNING: ", dotsname, lineno); +++ fprintf(sink, s, a1, a2,a3,a4,a5); + + fprintf(sink, "\n"); + +} diff --cc usr/src/cmd/as/aspseudo.c index 0000000000,b9b3f4322e,0000000000..fc5229aa6d mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/aspseudo.c +++ b/usr/src/cmd/as/aspseudo.c @@@@ -1,0 -1,92 -1,0 +1,96 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)aspseudo.c 4.3 8/16/80"; + +#include + +#include "as.h" + + - #define OP(name,opcode,nargs,arg1,arg2,arg3,arg4,arg5,arg6) \ +++#define OP(name, opcode, nargs, arg1, arg2, arg3, arg4, arg5, arg6) \ + + { \ - name,(nargs==0 ? INST0:INSTn), opcode,nargs, \ - arg1,arg2,arg3,arg4,arg5,arg6 \ +++ name, opcode, nargs, arg1, arg2, arg3, arg4, arg5, arg6, \ +++ (nargs == 0 ? INST0:INSTn) \ + + } - #define PSEUDO(name, type, tag) \ +++#define PSEUDO(name, type, tag) \ + + { \ - name, tag, type \ +++ name, type, 0, 0, 0, 0, 0, 0, 0, \ +++ tag \ + + } + + - readonly struct instab instab[] = { +++readonly struct Instab instab[] = { + +PSEUDO(".space", 0, ISPACE), +++PSEUDO(".fill", 0, IFILL), + +PSEUDO(".byte", 0, IBYTE), + +PSEUDO(".word", 0, IWORD), + +PSEUDO(".long", 0, ILONG), + +PSEUDO(".int", 0, IINT), +++PSEUDO(".quad", 0, IQUAD), + +PSEUDO(".data", 0, IDATA), + +PSEUDO(".globl", 0, IGLOBAL), + +PSEUDO(".set", 0, ISET), + +PSEUDO(".text", 0, ITEXT), + +PSEUDO(".comm", 0, ICOMM), + +PSEUDO(".lcomm", 0, ILCOMM), + +PSEUDO(".lsym", 0, ILSYM), + +PSEUDO(".align", 0, IALIGN), + +PSEUDO(".float", 0, IFLOAT), + +PSEUDO(".double", 0, IDOUBLE), + +PSEUDO(".org", 0, IORG), + +PSEUDO(".stab", 0, ISTAB), + +PSEUDO(".stabs", 0, ISTABSTR), + +PSEUDO(".stabn", 0, ISTABNONE), + +PSEUDO(".stabd", 0, ISTABDOT), + +PSEUDO(".ascii", 0, IASCII), + +PSEUDO(".asciz", 0, IASCIZ), + +PSEUDO(".file", 0, IFILE), + +PSEUDO(".line", 0, ILINENO), + +PSEUDO(".ABORT", 0, IABORT), + + + +PSEUDO("r0", 0, REG), + +PSEUDO("r1", 1, REG), + +PSEUDO("r2", 2, REG), + +PSEUDO("r3", 3, REG), + +PSEUDO("r4", 4, REG), + +PSEUDO("r5", 5, REG), + +PSEUDO("r6", 6, REG), + +PSEUDO("r7", 7, REG), + +PSEUDO("r8", 8, REG), + +PSEUDO("r9", 9, REG), + +PSEUDO("r10", 10, REG), + +PSEUDO("r11", 11, REG), + +PSEUDO("r12", 12, REG), + +PSEUDO("r13", 13, REG), + +PSEUDO("r14", 14, REG), + +PSEUDO("r15", 15, REG), + +PSEUDO("ap", 12, REG), + +PSEUDO("fp", 13, REG), + +PSEUDO("sp", 14, REG), + +PSEUDO("pc", 15, REG), + + + +PSEUDO("jcc", 0x1e, IJXXX), + +PSEUDO("jcs", 0x1f, IJXXX), + +PSEUDO("jeql", 0x13, IJXXX), + +PSEUDO("jeqlu", 0x13, IJXXX), + +PSEUDO("jgeq", 0x18, IJXXX), + +PSEUDO("jgequ", 0x1e, IJXXX), + +PSEUDO("jgtr", 0x14, IJXXX), + +PSEUDO("jgtru", 0x1a, IJXXX), + +PSEUDO("jleq", 0x15, IJXXX), + +PSEUDO("jlequ", 0x1b, IJXXX), + +PSEUDO("jlss", 0x19, IJXXX), + +PSEUDO("jlssu", 0x1f, IJXXX), + +PSEUDO("jneq", 0x12, IJXXX), + +PSEUDO("jnequ", 0x12, IJXXX), + +PSEUDO("jvc", 0x1c, IJXXX), + +PSEUDO("jvs", 0x1d, IJXXX), + +PSEUDO("jbr", 0x11, IJXXX), + +PSEUDO("jbc", 0xe1, IJXXX), + +PSEUDO("jbs", 0xe0, IJXXX), + +PSEUDO("jbcc", 0xe5, IJXXX), + +PSEUDO("jbsc", 0xe4, IJXXX), + +PSEUDO("jbcs", 0xe3, IJXXX), + +PSEUDO("jbss", 0xe2, IJXXX), + +PSEUDO("jlbc", 0xe9, IJXXX), + +PSEUDO("jlbs", 0xe8, IJXXX), + + + +#include "instrs" + + + +0 + +}; diff --cc usr/src/cmd/as/asscan.c index 0000000000,ee3fd8cea2,0000000000..6ba09c6ac1 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/asscan.c +++ b/usr/src/cmd/as/asscan.c @@@@ -1,0 -1,934 -1,0 +1,1130 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)asscan.c 4.6 9/8/80"; + +#include + +#include "as.h" + +#include "asscan.h" + + - extern int d124; - extern struct exp *xp; - - struct tokbufdesc *bufstart; /*where the buffer list begins*/ - struct tokbufdesc *buftail; /*last one on the list*/ - struct tokbufdesc *emptybuf; /*the one being filled*/ +++/* +++ * NOTE: +++ * This version of the assembler does not use fread and fwrite +++ * for the token buffering. The token buffers are integrals of BUFSIZ +++ * at all times, so we use direct read and write. fread and fwrite +++ * as supplied from BTL in stdio are HORRENDOUSLY inefficient, +++ * as they use putchar for each character, nested two deep in loops. +++ */ +++#define writeTEST(pointer, size, nelements, ioptr) \ +++ write(ioptr->_file, pointer, nelements * size) != nelements * size + + +++#define readTEST(pointer, size, nelements, ioptr) \ +++ read(ioptr->_file, pointer, nelements * size) != nelements * size +++/* +++ * Variables to manage the token buffering. +++ * We scan (lexically analyze) a large number of tokens, and +++ * then parse all of the tokens in the scan buffer. +++ * This reduces procedure call overhead when the parser +++ * demands a token, allows for an efficient reread during +++ * the second pass, and confuses the line number reporting +++ * for errors encountered in the scanner and in the parser. +++ */ + +#define TOKDALLOP 8 +++struct tokbufdesc *bufstart; /*where the buffer list begins*/ +++struct tokbufdesc *buftail; /*last one on the list*/ +++struct tokbufdesc *emptybuf; /*the one being filled*/ +++/* +++ * If we are using VM, during the second pass we reclaim the used +++ * token buffers for saving the relocation information +++ */ +++struct tokbufdesc *tok_free; /* free pool */ +++struct tokbufdesc *tok_temp; /* temporary for doing list manipulation */ +++/* +++ * Other token buffer managers +++ */ +++int bufno; /*which buffer number: 0,1 for tmp file*/ +++struct tokbufdesc tokbuf[2]; /*our initial increment of buffers*/ +++ptrall tokptr; /*where the current token comes from*/ +++ptrall tokub; /*the last token in the current token buffer*/ + + - int useVM; /*keep `tmp' file in virtual memory*/ - int bufno; /*which buffer number: 0,1 for tmp file*/ - struct tokbufdesc tokbuf[2]; /*our initial increment of buffers*/ +++/* +++ * Variables to manage the string buffering +++ * declared in asscan.h. +++ */ +++int strno; /*the current string being filled*/ +++struct strdesc strbuf[3]; /*the string buffers; the first for nulls*/ +++struct strdesc *strptr; /*current string buffer being filled*/ + + + +inittmpfile() + +{ + + if (passno == 1){ + + if (useVM){ + + bufstart = &tokbuf[0]; + + buftail = &tokbuf[1]; + + bufstart->tok_next = buftail; + + buftail->tok_next = 0; + + } + + tokbuf[0].tok_count = -1; + + tokbuf[1].tok_count = -1; + + } +++ tok_temp = 0; +++ tok_free = 0; + + bufno = 0; + + emptybuf = &tokbuf[bufno]; + + tokptr = 0; + + tokub = 0; + +} + + + +closetmpfile() + +{ + + if (passno == 1){ + + if (useVM){ + + emptybuf->toks[emptybuf->tok_count++] = PARSEEOF; + + } else { + + /* + + * Clean up the buffers that haven't been + + * written out yet + + */ + + if (tokbuf[bufno ^ 1].tok_count >= 0){ - if (fwrite(&tokbuf[bufno ^ 1], sizeof *emptybuf, 1, tmpfil) != 1){ +++ if (writeTEST((char *)&tokbuf[bufno ^ 1], sizeof *emptybuf, 1, tmpfil)){ + + badwrite: + + yyerror("Unexpected end of file writing the interpass tmp file"); + + exit(2); + + } + + } + + /* + + * Ensure that we will read an End of file, + + * if there are more than one file names + + * in the argument list + + */ + + tokbuf[bufno].toks[tokbuf[bufno].tok_count++] = PARSEEOF; - if (fwrite(&tokbuf[bufno], sizeof *emptybuf, 1, tmpfil) - != 1) goto badwrite; +++ if (writeTEST((char *)&tokbuf[bufno], sizeof *emptybuf, 1, tmpfil)) +++ goto badwrite; + + } + + } /*end of being pass 1*/ + +} + + + +#define bstrlg(from, length) \ + + *(lgtype *)from = length; \ + + (char *)from += sizeof(lgtype) + length + + + +#define bstrfromto(from,to) \ + + *(lgtype *)from = (char *)to - (char *)from - sizeof(lgtype); \ + + (char *)from += sizeof(lgtype) + (char *)to - (char *)from + + + +#define eatstrlg(from) \ + + (char *)from += sizeof(lgtype) + *(lgtype *)from + + + +#define bskiplg(from, length) \ + + *(lgtype *)from = length; \ + + (char *)from += sizeof(lgtype) + length + + + +#define bskipfromto(from, to) \ + + *(lgtype *)from = (toktype *)to - (toktype *)from - sizeof(lgtype); \ + + (char *)from += sizeof (lgtype) + (toktype *)to - (toktype *)from + + + +#define eatskiplg(from) \ + + (toktype *)from += sizeof(lgtype) + *(lgtype *)from + + + +#ifdef DEBUG + + ptrall firsttoken; - #endif +++#endif DEBUG + + + +extern int yylval; /*global communication with parser*/ +++static int Lastjxxx; /*this ONLY shuts up cc; see below*/ + + + +toktype yylex() + +{ + + register ptrall bufptr; + + register toktype val; + + register struct exp *locxp; + + + + bufptr = tokptr; /*copy in the global value*/ + + top: + + if (bufptr < tokub){ + + gtoken(val, bufptr); + + switch(yylval = val){ - case PARSEEOF : - yylval = val = PARSEEOF; - break; - case INT: - locxp = xp++; - glong(locxp->xvalue, bufptr); - makevalue: - locxp->xtype = XABS; - locxp->xloc = 0; - locxp->xname = NULL; - yylval = (int)locxp; - break; - case FLTNUM: /*case patched on 3-Jan-80*/ - locxp = xp++; - gdouble(locxp->doubval.dvalue, bufptr); - /* - * We make sure that locxp->xvalue - * is not in the range suitable for - * a short literal. The field - * xvalue is only used for - * integers, not doubles, but when - * we test for short literals - * in ascode.c, we look - * at the field xvalue when - * it encounters an in line - * floating number. Ergo, - * give it a bad value. - */ - locxp->xvalue = -1; - goto makevalue; - case NAME: - gptr(yylval, bufptr); - lastnam = (struct symtab *)yylval; - break; - case SIZESPEC: - case REG: - case INSTn: - case INST0: - gchar(yylval, bufptr); - break; - case IJXXX: - gchar(yylval, bufptr); - gptr(lastjxxx, bufptr); - break; - case ILINESKIP: - gint(yylval, bufptr); - lineno += yylval; - goto top; - case SKIP: - eatskiplg(bufptr); - goto top; - case VOID: - goto top; - case STRING: - strptr = &strbuf[strno ^= 1]; - strptr->str_lg = *((lgtype *)bufptr); - movestr(&strptr->str[0], - (char *)bufptr + sizeof(lgtype), - strptr->str_lg); - eatstrlg(bufptr); - yylval = (int)strptr; - break; - case ISTAB: - case ISTABSTR: - case ISTABNONE: - case ISTABDOT: - case IALIGN: - gptr(yylval, bufptr); - break; - } /*end of the switch*/ - +++ case PARSEEOF : +++ yylval = val = PARSEEOF; +++ break; +++ case BFINT: +++ case INT: +++ if (xp >= &explist[NEXP]) +++ yyerror("Too many expressions; try simplyfing"); +++ else +++ locxp = xp++; +++ glong(locxp->e_xvalue, bufptr); +++ locxp->e_yvalue = 0; +++ makevalue: +++ locxp->e_xtype = XABS; +++ locxp->e_xloc = 0; +++ locxp->e_xname = NULL; +++ yylval = (int)locxp; +++ break; +++ case FLTNUM: +++ if (xp >= &explist[NEXP]) +++ yyerror("Too many expressions; try simplyfing"); +++ else +++ locxp = xp++; +++ gdouble( ( (union Double *)locxp)->dvalue, bufptr); +++ goto makevalue; +++ case QUAD: +++ if (xp >= &explist[NEXP]) +++ yyerror("Too many expressions; try simplyfing"); +++ else +++ locxp = xp++; +++ glong(locxp->e_xvalue, bufptr); +++ glong(locxp->e_yvalue, bufptr); +++ yylval = val = INT; +++ goto makevalue; +++ case NAME: +++ gptr(yylval, bufptr); +++ lastnam = (struct symtab *)yylval; +++ break; +++ case SIZESPEC: +++ case REG: +++ case INSTn: +++ case INST0: +++ gchar(yylval, bufptr); +++ break; +++ case IJXXX: +++ gchar(yylval, bufptr); +++ /* We can't cast Lastjxxx into (int *) here.. */ +++ gptr(Lastjxxx, bufptr); +++ lastjxxx = (struct symtab *)Lastjxxx; +++ break; +++ case ILINESKIP: +++ gint(yylval, bufptr); +++ lineno += yylval; +++ goto top; +++ case SKIP: +++ eatskiplg(bufptr); +++ goto top; +++ case VOID: +++ goto top; +++ case STRING: +++ strptr = &strbuf[strno ^= 1]; +++ strptr->str_lg = *((lgtype *)bufptr); +++ movestr(&strptr->str[0], +++ (char *)bufptr + sizeof(lgtype), +++ strptr->str_lg); +++ eatstrlg(bufptr); +++ yylval = (int)strptr; +++ break; +++ case ISTAB: +++ case ISTABSTR: +++ case ISTABNONE: +++ case ISTABDOT: +++ case IALIGN: +++ gptr(yylval, bufptr); +++ break; +++ } + +#ifdef DEBUG - - if (toktrace) +++ if (toktrace){ +++ char *tok_to_name(); +++ printf("P: %d T#: %4d, %s ", +++ passno, bufptr - firsttoken, tok_to_name(val)); + + switch(val){ - case INT: printf("Class integer val %d\n", - ((struct exp *)yylval)->xvalue); - break; - case FLTNUM: printf("Class floating point num value %4.3f\n", - ((struct exp *)yylval) -> doubval.dvalue); - break; - case NAME: printf("Class name, \"%.8s\"\n", - ((struct symtab *)yylval)->name); - break; - case REG: printf("Class register, number %d\n", - yylval); - break; - case INSTn: printf("Class INSTn, %.8s\n", - itab[0xFF &yylval]->name); - break; - case IJXXX: printf("Class IJXXX, %.8s\n", - itab[0xFF &yylval]->name); - break; - case INST0: printf("Class INST0, %.8s\n", - itab[0xFF &yylval]->name); - break; - case STRING: printf("Class string, length %d\n", - ((struct strdesc *)yylval)->str_lg); - break; - default: printf("Pass: %d Tok: %d Other class: %d, 0%o, '%c'\n", - passno, - bufptr - firsttoken, - val,val, val); - break; - } /*end of the debug switch*/ - #endif +++ case INT: printf("val %d", +++ ((struct exp *)yylval)->e_xvalue); +++ break; +++ case BFINT: printf("val %d", +++ ((struct exp *)yylval)->e_xvalue); +++ break; +++ case QUAD: printf("val[msd] = 0x%x, val[lsd] = 0x%x.", +++ ((struct exp *)yylval)->e_xvalue, +++ ((struct exp *)yylval)->e_yvalue); +++ break; +++ case FLTNUM: printf("value %20.17f", +++ ((union Double *)yylval)->dvalue); +++ break; +++ case NAME: printf("\"%.8s\"", +++ ((struct symtab *)yylval)->s_name); +++ break; +++ case REG: printf(" r%d", +++ yylval); +++ break; +++ case IJXXX: +++ case INST0: +++ case INSTn: printf("%.8s", +++ itab[0xFF &yylval]->s_name); +++ break; +++ case STRING: printf("length %d ", +++ ((struct strdesc *)yylval)->str_lg); +++ printf("value\"%s\"", +++ ((struct strdesc *)yylval)->str); +++ break; +++ } /*end of the debug switch*/ +++ printf("\n"); +++ } +++#endif DEBUG + + - } /*end of this buffer*/ - else { - if (useVM){ - bufno += 1; +++ } else { /* start a new buffer */ +++ if (useVM){ +++ if (passno == 2){ +++ tok_temp = emptybuf->tok_next; +++ emptybuf->tok_next = tok_free; +++ tok_free = emptybuf; +++ emptybuf = tok_temp; +++ } else { + + emptybuf = emptybuf->tok_next; - if (emptybuf == 0){ - struct tokbufdesc *newdallop; - int i; - if (passno == 2) - goto badread; - emptybuf = newdallop = - (struct tokbufdesc *)sbrk( - TOKDALLOP*sizeof (struct tokbufdesc)); - if (emptybuf == (struct tokbufdesc *)-1) - goto badwrite; - for (i=0; i < TOKDALLOP; i++){ - buftail->tok_next = newdallop; - buftail = newdallop; - newdallop += 1; - } - buftail->tok_next = 0; - } /*end of need to get more buffers*/ - (toktype *)bufptr = &(emptybuf->toks[0]); - if (passno == 1) - scan_dot_s(emptybuf); - } else { /*don't use VM*/ - bufno ^= 1; - emptybuf = &tokbuf[bufno]; - ((toktype *)bufptr) = &(emptybuf->toks[0]); - if (passno == 1){ - /* - * First check if there are things to write - * out at all - */ - if (emptybuf->tok_count >= 0){ - if (fwrite(emptybuf, sizeof *emptybuf, 1, tmpfil) != 1){ - badwrite: - yyerror("Unexpected end of file writing the interpass tmp file"); - exit(2); - } - } - scan_dot_s(emptybuf); - } else { /*pass 2*/ - if (fread(emptybuf, sizeof *emptybuf, 1, tmpfil) != 1){ - badread: - yyerror("Unexpected end of file while reading the interpass tmp file"); - exit(1); - } - } /*end of pass2*/ - } /*end of using a real live file*/ - (char *)tokub = (char *)bufptr + emptybuf->tok_count; +++ } +++ bufno += 1; +++ if (emptybuf == 0){ +++ struct tokbufdesc *newdallop; +++ int i; +++ if (passno == 2) +++ goto badread; +++ emptybuf = newdallop = (struct tokbufdesc *) +++ Calloc(TOKDALLOP, sizeof (struct tokbufdesc)); +++ for (i=0; i < TOKDALLOP; i++){ +++ buftail->tok_next = newdallop; +++ buftail = newdallop; +++ newdallop += 1; +++ } +++ buftail->tok_next = 0; +++ } /*end of need to get more buffers*/ +++ (toktype *)bufptr = &(emptybuf->toks[0]); +++ if (passno == 1) +++ scan_dot_s(emptybuf); +++ } else { /*don't use VM*/ +++ bufno ^= 1; +++ emptybuf = &tokbuf[bufno]; +++ ((toktype *)bufptr) = &(emptybuf->toks[0]); +++ if (passno == 1){ +++ /* +++ * First check if there are things to write +++ * out at all +++ */ +++ if (emptybuf->tok_count >= 0){ +++ if (writeTEST((char *)emptybuf, sizeof *emptybuf, 1, tmpfil)){ +++ badwrite: +++ yyerror("Unexpected end of file writing the interpass tmp file"); +++ exit(2); +++ } +++ } +++ scan_dot_s(emptybuf); +++ } else { /*pass 2*/ +++ if (readTEST((char *)emptybuf, sizeof *emptybuf, 1, tmpfil)){ +++ badread: +++ yyerror("Unexpected end of file while reading the interpass tmp file"); +++ exit(1); +++ } +++ } +++ } /*end of using a real live file*/ +++ (char *)tokub = (char *)bufptr + emptybuf->tok_count; + +#ifdef DEBUG - firsttoken = bufptr; - if (debug) - printf("created buffernumber %d with %d tokens\n", - bufno, emptybuf->tok_count); - #endif - goto top; +++ firsttoken = bufptr; +++ if (debug) +++ printf("created buffernumber %d with %d tokens\n", +++ bufno, emptybuf->tok_count); +++#endif DEBUG +++ goto top; + + } /*end of reading/creating a new buffer*/ + + tokptr = bufptr; /*copy back the global value*/ + + return(val); + +} /*end of yylex*/ + + + + + +buildskip(from, to) + + register ptrall from, to; + +{ + + int diff; + + register int frombufno; + + register struct tokbufdesc *middlebuf; + + /* + + * check if from and to are in the same buffer + + * from and to DIFFER BY AT MOST 1 buffer and to is + + * always ahead of from, with to being in the buffer emptybuf + + * points to. + + * The hard part here is accounting for the case where the + + * skip is to cross a buffer boundary; we must construct + + * two skips. + + * + + * Figure out where the buffer boundary between from and to is + + * It's easy in VM, as buffers increase to high memory, but + + * w/o VM, we alternate between two buffers, and want + + * to look at the exact middle of the contiguous buffer region. + + */ + + middlebuf = useVM ? emptybuf : &tokbuf[1]; + + if ( ( (toktype *)from > (toktype *)middlebuf) + + ^ ( (toktype *)to > (toktype *)middlebuf) + + ){ /*split across a buffer boundary*/ + + ptoken(from, SKIP); + + /* + + * Set the skip so it lands someplace beyond + + * the end of this buffer. + + * When we pull this skip out in the second pass, + + * we will temporarily move the current pointer + + * out beyond the end of the buffer, but immediately + + * do a compare and fail the compare, and then reset + + * all the pointers correctly to point into the next buffer. + + */ + + bskiplg(from, TOKBUFLG + 1); + + /* + + * Now, force from to be in the same buffer as to + + */ + + (toktype *)from = (toktype *)&(emptybuf->toks[0]); + + } + + /* + + * Now, to and from are in the same buffer + + */ + + if (from > to) + + yyerror("Internal error: bad skip construction"); + + else { + + if ( (diff = (toktype *)to - (toktype *)from) >= + + (sizeof(toktype) + sizeof(lgtype) + 1)) { + + ptoken(from, SKIP); + + bskipfromto(from, to); + + } else { + + for ( ; diff > 0; --diff) + + ptoken(from, VOID); + + } + + } + +} + + + +movestr(to, from, lg) + + register char *to, *from; + + register int lg; + +{ + + if (lg <= 0) return; + + do + + *to++ = *from++; + + while (--lg); + +} + +static int newfflag = 0; + +static char *newfname; + +int scanlineno; /*the scanner's linenumber*/ + + + +new_dot_s(namep) + + char *namep; + +{ + + newfflag = 1; + + newfname = namep; + + dotsname = namep; + + lineno = 1; + + scanlineno = 1; + +} + + + +/* + + * Maps characters to their use in assembly language + + */ + +#define EOFCHAR (-1) + +#define NEEDCHAR (-2) + + + +readonly short type[] = { + + NEEDSBUF, /*fill up the input buffer*/ + + SCANEOF, /*hit the hard end of file*/ + + SP, BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR, /*\0..^G*/ + + BADCHAR,SP, NL, BADCHAR,BADCHAR,SP, BADCHAR,BADCHAR, /*BS..SI*/ + + BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR, /*DLE..ETB*/ + + BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR,BADCHAR, /*CAN..US*/ + + SP, ORNOT, DQ, SH, LITOP, REGOP, AND, SQ, /*sp .. '*/ + + LP, RP, MUL, PLUS, CM, MINUS, ALPH, DIV, /*( .. /*/ + + DIG, DIG, DIG, DIG, DIG, DIG, DIG, DIG, /*0 .. 7*/ + + DIG, DIG, COLON, SEMI, LSH, BADCHAR,RSH, BADCHAR, /*8 .. ?*/ + + BADCHAR,ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH,/*@ .. G*/ + + ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH,/*H .. BADCHAR*/ + + ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH,/*P .. V*/ + + ALPH, ALPH, ALPH, LB, BADCHAR,RB, XOR, ALPH,/*W .. _*/ + + SIZEQUOTE,ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH,/*` .. g*/ + + ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH,/*h .. o*/ + + ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH, ALPH,/*p .. v*/ + + ALPH, ALPH, ALPH, BADCHAR,IOR, BADCHAR,TILDE, BADCHAR,/*x .. del*/ + +}; + + + +/* + + * The table of possible uses for each character to test set inclusion. + + * Different than the above table, which knows about tokens yylex + + * is to return. + + */ + +#define HEXFLAG 01 /* 'x' or 'X' */ + +#define HEXLDIGIT 02 /* 'a' .. 'f' */ - #define HEXUDIGIT 04 /* 'A' .. 'F' */ +++#define HEXUDIGIT 04 /* 'A' .. 'F' */ + +#define ALPHA 010 /* 'A' .. 'Z', 'a' .. 'z', '_'*/ - #define DIGIT 020 /* '0' .. '9' */ +++#define DIGIT 020 /* '0' .. '9' */ + +#define FLOATEXP 040 /* 'd' 'e' 'D' 'E' */ - /*exponent field*/ - #define SIGN 0100 /* '+' .. '-'*/ - #define REGDIGIT 0200 /* '0' .. '5' */ - #define SZSPECBEGIN 0400 /* 'b', 'B', 'l', 'L', 'w', 'W' */ - #define POINT 01000 /* '.' */ - #define SPACE 02000 /* '\t' or ' ' */ - #define BSESCAPE 04000 /* bnrtf */ - #define STRESCAPE 010000 /* '"', '\\', '\n' */ - #define OCTDIGIT 020000 /* '0' .. '7' */ +++#define SIGN 0100 /* '+' .. '-'*/ +++#define REGDIGIT 0200 /* '0' .. '5' */ +++#define SZSPECBEGIN 0400 /* 'b', 'B', 'l', 'L', 'w', 'W' */ +++#define POINT 01000 /* '.' */ +++#define SPACE 02000 /* '\t' or ' ' */ +++#define BSESCAPE 04000 /* bnrtf */ +++#define STRESCAPE 010000 /* '"', '\\', '\n' */ +++#define OCTDIGIT 020000 /* '0' .. '7' */ + +#define FLOATFLAG 040000 /* 'd', 'D', 'f', 'F' */ + + /*after leading 0*/ + + + +readonly short charsets[] = { + + 0, 0, 0, 0, 0, 0, 0, 0, /*\0..^G*/ + + 0, SPACE, STRESCAPE,0, 0, 0, 0, 0, /*BS..SI*/ + + 0, 0, 0, 0, 0, 0, 0, 0, /*DLE..ETB*/ + + 0, 0, 0, 0, 0, 0, 0, 0, /*CAN..US*/ - SPACE, 0, STRESCAPE,0, 0, 0, 0, 0, /*sp.. '*/ +++/* dollar is an alpha character */ +++ SPACE, 0, STRESCAPE,0, ALPHA, 0, 0, 0, /*sp.. '*/ + + 0, 0, 0, SIGN, 0, SIGN, POINT+ALPHA,0, /*( .. /*/ + + DIGIT+REGDIGIT+OCTDIGIT, DIGIT+REGDIGIT+OCTDIGIT, /*0..1*/ + + DIGIT+REGDIGIT+OCTDIGIT, DIGIT+REGDIGIT+OCTDIGIT, /*2..3*/ + + DIGIT+REGDIGIT+OCTDIGIT, DIGIT+REGDIGIT+OCTDIGIT, /*4..5*/ + + DIGIT+OCTDIGIT, DIGIT+OCTDIGIT, /*6..7*/ + + DIGIT, DIGIT, 0, 0, 0, 0, 0, 0, /*8..?*/ + + 0, /*@*/ + + ALPHA+HEXUDIGIT,ALPHA+HEXUDIGIT+SZSPECBEGIN, /*A..B*/ + + ALPHA+HEXUDIGIT,ALPHA+HEXUDIGIT+FLOATEXP+FLOATFLAG, /*C..D*/ + + ALPHA+HEXUDIGIT+FLOATEXP,ALPHA+HEXUDIGIT+FLOATFLAG, /*E..F*/ + + ALPHA, /*G*/ + + ALPHA, ALPHA, ALPHA, ALPHA, /*H..K*/ + + ALPHA+SZSPECBEGIN, ALPHA, ALPHA, ALPHA, /*L..O*/ + + ALPHA, ALPHA, ALPHA, ALPHA, /*P..S*/ + + ALPHA, ALPHA, ALPHA, ALPHA+SZSPECBEGIN, /*T..W*/ + + ALPHA+HEXFLAG, ALPHA, ALPHA, 0,STRESCAPE,0, 0, ALPHA,/*X.._*/ + + + + 0, + + ALPHA+HEXLDIGIT,ALPHA+HEXLDIGIT+BSESCAPE+SZSPECBEGIN, /*a..b*/ + + ALPHA+HEXLDIGIT,ALPHA+HEXLDIGIT+FLOATEXP+FLOATFLAG, /*c..d*/ + + ALPHA+HEXLDIGIT+FLOATEXP,ALPHA+HEXLDIGIT+BSESCAPE+FLOATFLAG, /*e..f*/ + + ALPHA, /*g*/ + + ALPHA, ALPHA, ALPHA, ALPHA, /*h..k*/ + + ALPHA+SZSPECBEGIN, ALPHA, ALPHA+BSESCAPE, ALPHA, /*l..o*/ + + ALPHA, ALPHA, ALPHA+BSESCAPE, ALPHA, /*p..s*/ + + ALPHA+BSESCAPE, ALPHA, ALPHA, ALPHA+SZSPECBEGIN,/*t..w*/ + + ALPHA+HEXFLAG, ALPHA, ALPHA, 0,0, 0, 0, 0, /*x..del*/ + +0}; + + - #define INCHARSET(val, kind) (charsets[val] & (kind) ) +++#define INCHARSET(val, kind) (charsets[val] & (kind) ) + +static toktype oval = NL; + + - #define INBUFLG 2 + 2*BUFSIZ + 128 +++#define NINBUFFERS 2 +++#define INBUFLG NINBUFFERS*BUFSIZ + 2 +++ /* +++ * We have two input buffers; the first one is reserved +++ * for catching the tail of a line split across a buffer +++ * boundary; the other one are used for snarfing a buffer +++ * worth of .s source. +++ */ + +static char inbuffer[INBUFLG]; + +static char *InBufPtr = 0; + + - #ifdef getchar - #undef getchar +++#ifdef getchar +++#undef getchar + +#endif - #define getchar() *inbufptr++ +++#define getchar() *inbufptr++ + + - #ifdef ungetc - #undef ungetc +++#ifdef ungetc +++#undef ungetc + +#endif - #define ungetc(char, fileptr) *--inbufptr = char +++#define ungetc(char) *--inbufptr = char + + +++/* +++ * fill the inbuffer from the standard input. +++ * Assert: there are always n COMPLETE! lines in the buffer area. +++ * Assert: there is always a \n terminating the last line +++ * in the buffer area. +++ * Assert: after the \n, there is an EOFCHAR (hard end of file) +++ * or a NEEDCHAR (end of buffer) +++ * Assert: fgets always null pads the string it reads. +++ * Assert: no ungetc's are done at the end of a line or at the +++ * beginning of a line. +++ * +++ * We read a complete buffer of characters in one single read. +++ * We then back scan within this buffer to find the end of the +++ * last complete line, and force the assertions, and save a pointer +++ * to the incomplete line. +++ * The next call to fillinbuffer will move the unread characters +++ * to the end of the first buffer, and then read another two buffers, +++ * completing the cycle. +++ */ +++ +++static char p_swapped = '\0'; +++static char *p_start = &inbuffer[NINBUFFERS * BUFSIZ]; +++static char *p_stop = &inbuffer[NINBUFFERS * BUFSIZ]; + +char *fillinbuffer() + +{ - register char *cp, *inbufptr; +++ register char *to; +++ register char *from; +++ char *inbufptr; + + int nread; + + - inbufptr = &inbuffer[2]; /*allow enough room for two ungetcs*/ - nread = fread(inbufptr, 1, 2*BUFSIZ, stdin); - if (nread == 2*BUFSIZ){ - cp = fgets(inbufptr+2*BUFSIZ, 128, stdin); /*get next whole line*/ - if (cp != 0){ - while(*cp++); /*find the trailing null*/ - *--cp = NEEDCHAR; /*clobber with a NEED character*/ - return(inbufptr); - } else { - *(inbufptr + 2*BUFSIZ) = EOFCHAR; - return(inbufptr); - } - } else { - if (nread == 0) /*hard end of file*/ - return(0); - inbuffer[2+nread] = EOFCHAR; - return(inbufptr); - } +++ *p_start = p_swapped; +++ inbufptr = &inbuffer[1*BUFSIZ] - (p_stop - p_start); +++ +++ for (to = inbufptr, from = p_start; from < p_stop;) +++ *to++ = *from++; +++ /* +++ * Now, go read two full buffers (hopefully) +++ */ +++ nread = read(stdin->_file, &inbuffer[1*BUFSIZ], (NINBUFFERS - 1)*BUFSIZ); +++ if (nread == 0) +++ return(0); +++ p_stop = from = &inbuffer[1*BUFSIZ + nread]; +++ *from = '\0'; +++ while (*--from != '\n') /* back over the partial line */ +++ continue; +++ from++; /* first char of partial line */ +++ p_start = from; +++ p_swapped = *p_start; +++ *p_start = NEEDCHAR; /* force assertion */ +++ return(inbufptr); + +} + + + +scan_dot_s(bufferbox) + + struct tokbufdesc *bufferbox; + +{ + + register int yylval;/*lexical value*/ + + register toktype val; /*the value returned; the character read*/ + + register int base; /*the base of the number also counter*/ + + register char *cp; + + register char *inbufptr; + + register struct symtab *op; + + register unsigned char tag; +++ int forb; + + + + register ptrall bufptr; /*where to stuff tokens*/ + + ptrall lgbackpatch; /*where to stuff a string length*/ + + ptrall bufub; /*where not to stuff tokens*/ + + register int maxstrlg; /*how long a string can be*/ + + long intval; /*value of int*/ + + char fltchr[64]; /*buffer for floating values*/ - double fltval; /*floating value returned*/ +++ union Double fltval; /*floating value returned*/ +++ struct Quad quadval; /*quad returned from immediate constant */ + + int linescrossed; /*when doing strings and comments*/ + + +++ (toktype *)bufptr = (toktype *) & (bufferbox->toks[0]); +++ (toktype *)bufub = &(bufferbox->toks[AVAILTOKS]); +++ + + inbufptr = InBufPtr; + + if (inbufptr == 0){ + + inbufptr = fillinbuffer(); + + if (inbufptr == 0){ /*end of file*/ + + endoffile: + + inbufptr = 0; + + ptoken(bufptr, PARSEEOF); + + goto done; + + } + + } + + - (toktype *)bufptr = (toktype *) & (bufferbox->toks[0]); - (toktype *)bufub = &(bufferbox->toks[AVAILTOKS]); - + + if (newfflag){ - #ifdef DEBUG - if (debug) - printf(">>>>>>>>>>>>>(scanner) Starting to insert tokens into a new file: %s\n", - newfname); - #endif + + ptoken(bufptr, IFILE); + + ptoken(bufptr, STRING); + + val = strlen(newfname) + 1; + + movestr( (char *)&( ( (lgtype *)bufptr)[1]), newfname, val); + + bstrlg(bufptr, val); + + + + ptoken(bufptr, ILINENO); + + ptoken(bufptr, INT); + + pint(bufptr, 1); + + newfflag = 0; + + } + + + + while (bufptr < bufub){ + + loop: - switch(yylval = (type+2)[val = getchar()]) { - case SCANEOF: - inbufptr = 0; +++ switch(yylval = (type+2)[val = getchar()]) { +++ case SCANEOF: +++ inbufptr = 0; +++ goto endoffile; +++ +++ case NEEDSBUF: +++ inbufptr = fillinbuffer(); +++ if (inbufptr == 0) + + goto endoffile; +++ goto loop; + + - case NEEDSBUF: - inbufptr = fillinbuffer(); - if (inbufptr == 0) - goto endoffile; - goto loop; - - case DIV: /*process C style comments*/ - if ( (val = getchar()) == '*') { /*comment prelude*/ - int incomment; - linescrossed = 0; - incomment = 1; - val = getchar(); /*skip over the * */ - do{ - while ( (val != '*') && - (val != '\n') && - (val != EOFCHAR) && - (val != NEEDCHAR)) - val = getchar(); - if (val == '\n'){ - scanlineno++; - linescrossed++; - } else - if (val == EOFCHAR) - goto endoffile; - if (val == NEEDCHAR){ - inbufptr = fillinbuffer(); - if (inbufptr == 0) - goto endoffile; - lineno++; - incomment = 1; - val = getchar(); /*pull in the new char*/ - } else { /*its a star */ +++ case DIV: /*process C style comments*/ +++ if ( (val = getchar()) == '*') { /*comment prelude*/ +++ int incomment; +++ linescrossed = 0; +++ incomment = 1; +++ val = getchar(); /*skip over the * */ +++ do{ +++ while ( (val != '*') && +++ (val != '\n') && +++ (val != EOFCHAR) && +++ (val != NEEDCHAR)) + + val = getchar(); - incomment = val != '/'; - } - } while (incomment); - val = ILINESKIP; - yylval = linescrossed; - goto ret; - } else { /*just an ordinary DIV*/ - ungetc(val, stdin); - val = yylval = DIV; - goto ret; - } - case SH: - if (oval == NL){ - /* - * Attempt to recognize a C preprocessor - * style comment '^#[ \t]*[0-9]*[ \t]*".*" - */ - val = getchar(); /*bump the #*/ +++ if (val == '\n'){ +++ scanlineno++; +++ linescrossed++; +++ } else +++ if (val == EOFCHAR) +++ goto endoffile; +++ if (val == NEEDCHAR){ +++ inbufptr = fillinbuffer(); +++ if (inbufptr == 0) +++ goto endoffile; +++ lineno++; +++ incomment = 1; +++ val = getchar(); /*pull in the new char*/ +++ } else { /*its a star */ +++ val = getchar(); +++ incomment = val != '/'; +++ } +++ } while (incomment); +++ val = ILINESKIP; +++ yylval = linescrossed; +++ goto ret; +++ } else { /*just an ordinary DIV*/ +++ ungetc(val); +++ val = yylval = DIV; +++ goto ret; +++ } +++ case SH: +++ if (oval == NL){ +++ /* +++ * Attempt to recognize a C preprocessor +++ * style comment '^#[ \t]*[0-9]*[ \t]*".*" +++ */ +++ val = getchar(); /*bump the #*/ +++ while (INCHARSET(val, SPACE)) +++ val = getchar();/*bump white */ +++ if (INCHARSET(val, DIGIT)){ +++ intval = 0; +++ while(INCHARSET(val, DIGIT)){ +++ intval = intval *10 + val - '0'; +++ val = getchar(); +++ } + + while (INCHARSET(val, SPACE)) - val = getchar();/*bump white */ - if (INCHARSET(val, DIGIT)){ - intval = 0; - while(INCHARSET(val, DIGIT)){ - intval = intval *10 + val - '0'; - val = getchar(); - } - while (INCHARSET(val, SPACE)) - val = getchar(); - if (val == '"'){ - ptoken(bufptr, ILINENO); - ptoken(bufptr, INT); - pint(bufptr, intval - 1); - ptoken(bufptr, IFILE); - /* - * The '"' has already been - * munched - * - * eatstr will not eat - * the trailing \n, so - * it is given to the parser - * and counted. - */ - goto eatstr; - } +++ val = getchar(); +++ if (val == '"'){ +++ ptoken(bufptr, ILINENO); +++ ptoken(bufptr, INT); +++ pint(bufptr, intval - 1); +++ ptoken(bufptr, IFILE); +++ /* +++ * The '"' has already been +++ * munched +++ * +++ * eatstr will not eat +++ * the trailing \n, so +++ * it is given to the parser +++ * and counted. +++ */ +++ goto eatstr; + + } + + } +++ } +++ /* +++ * Well, its just an ordinary decadent comment +++ */ +++ while ((val != '\n') && (val != EOFCHAR)) +++ val = getchar(); +++ if (val == EOFCHAR) +++ goto endoffile; +++ val = yylval = oval = NL; +++ scanlineno++; +++ goto ret; +++ +++ case NL: +++ scanlineno++; +++ val = yylval; +++ goto ret; +++ +++ case SP: +++ oval = SP; /*invalidate ^# meta comments*/ +++ goto loop; +++ +++ case REGOP: /* % , could be used as modulo, or register*/ +++ val = getchar(); +++ if (INCHARSET(val, DIGIT)){ +++ yylval = val-'0'; +++ if (val=='1') { +++ if (INCHARSET( (val = getchar()), REGDIGIT)) +++ yylval = 10+val-'0'; +++ else +++ ungetc(val); +++ } + + /* - * Well, its just an ordinary decadent comment +++ * God only knows what the original author +++ * wanted this undocumented feature to +++ * do. +++ * %5++ is really r7 + + */ - while ((val != '\n') && (val != EOFCHAR)) - val = getchar(); - if (val == EOFCHAR) - goto endoffile; - val = yylval = oval = NL; - scanlineno++; +++ while(INCHARSET( (val = getchar()), SIGN)) { +++ if (val=='+') +++ yylval++; +++ else +++ yylval--; +++ } +++ ungetc(val); +++ val = REG; +++ } else { +++ ungetc(val); +++ val = REGOP; +++ } +++ goto ret; +++ +++ case ALPH: +++ yylval = val; +++ if (INCHARSET(val, SZSPECBEGIN)){ +++ if( (val = getchar()) == '`' || val == '^'){ +++ yylval |= 0100; /*convert to lower*/ +++ if (yylval == 'b') yylval = 1; +++ else if (yylval == 'w') yylval = 2; +++ else if (yylval == 'l') yylval = 4; +++ else yylval = d124; +++ val = SIZESPEC; +++ goto ret; +++ } else { +++ ungetc(val); +++ val = yylval; /*restore first character*/ +++ } +++ } +++ cp = yytext; +++ do { +++ if (cp < &yytext[NCPS]) +++ *cp++ = val; +++ } while (INCHARSET ( (val = getchar()), ALPHA | DIGIT)); +++ *cp = '\0'; +++ while (INCHARSET(val, SPACE)) +++ val = getchar(); +++ ungetc(val); +++ doit: +++ tag = (op = *lookup(1))->s_tag; +++ if (tag && tag != LABELID){ +++ yylval = ( (struct instab *)op)->i_opcode; +++ val = op->s_tag ; + + goto ret; - - case NL: - scanlineno++; - val = yylval; +++ } else { +++ /* +++ * Its a name... (Labels are subsets ofname) +++ */ +++ yylval = (int)op; +++ val = NAME; + + goto ret; +++ } + + - case SP: - oval = SP; /*invalidate ^# meta comments*/ - goto loop; - - case REGOP: /* % , could be used as modulo, or register*/ +++ case DIG: +++ base = 10; +++ cp = fltchr; +++ intval = 0; +++ if (val=='0') { + + val = getchar(); - if (INCHARSET(val, DIGIT)){ - yylval = val-'0'; - if (val=='1') { - if (INCHARSET( (val = getchar()), REGDIGIT)) - yylval = 10+val-'0'; - else - ungetc(val, stdin); - } +++ if (val == 'b') { +++ yylval = -1; +++ val = BFINT; +++ goto ret; +++ } +++ if (val == 'f') { + + /* - * God only knows what the original author - * wanted this undocumented feature to - * do. - * %5++ is really r7 +++ * Well, it appears to be a local label +++ * reference, but check to see if +++ * the next character makes it a floating +++ * point constant. + + */ - while(INCHARSET( (val = getchar()), SIGN)) { - if (val=='+') - yylval++; - else - yylval--; +++ forb = getchar(); +++ ungetc(forb); +++ if (!(INCHARSET(forb,(DIGIT|SIGN|FLOATEXP|POINT)))){ +++ yylval = 1; +++ val = BFINT; +++ goto ret; + + } - ungetc(val, stdin); - val = REG; - } else { - ungetc(val, stdin); - val = REGOP; + + } - goto ret; - - case ALPH: - yylval = val; - if (INCHARSET(val, SZSPECBEGIN)){ - if( (val = getchar()) == '`' || val == '^'){ - yylval |= 0100; /*convert to lower*/ - if (yylval == 'b') yylval = 1; - else if (yylval == 'w') yylval = 2; - else if (yylval == 'l') yylval = 4; - else yylval = d124; - val = SIZESPEC; +++ if (INCHARSET(val, HEXFLAG)){ +++ base = 16; +++ } else +++ if (INCHARSET(val, FLOATFLAG)){ +++ double atof(); +++ while ( (cp < &fltchr[63]) && +++ INCHARSET( +++ (val=getchar()), +++ (DIGIT|SIGN|FLOATEXP|POINT) +++ ) +++ ) *cp++ = val; +++ if (cp == fltchr) { +++ yylval = 1; +++ val = BFINT; + + goto ret; - } else { - ungetc(val, stdin); - val = yylval; /*restore first character*/ + + } - } - cp = yytext; - do { - if (cp < &yytext[NCPS]) - *cp++ = val; - } while (INCHARSET ( (val = getchar()), ALPHA | DIGIT)); - *cp = '\0'; - while (INCHARSET(val, SPACE)) - val = getchar(); - ungetc(val, stdin); - tag = (op = *lookup(1))->tag; - if (tag && tag != LABELID){ - yylval = ( (struct instab *)op)->opcode; - val = op->tag ; +++ ungetc(val); +++ *cp++ = '\0'; +++ fltval.dvalue = atof(fltchr); +++ val = FLTNUM; + + goto ret; + + } else { - /* - * Its a name... (Labels are subsets ofname) - */ - yylval = (int)op; - val = NAME; - goto ret; +++ ungetc(val); +++ base = 8; + + } - - case DIG: - intval = val-'0'; - if (val=='0') { - val = getchar(); - if (INCHARSET(val, HEXFLAG)){ - base = 16; - } else - if (INCHARSET(val, FLOATFLAG)){ - char *p = fltchr; - double atof(); - - while ( (p < &fltchr[63]) && - INCHARSET( - (val=getchar()), - (DIGIT|SIGN|FLOATEXP|POINT) - ) - ) *p++ = val; - ungetc(val, stdin); - *p++ = '\0'; - fltval = atof(fltchr); - val = FLTNUM; - goto ret; - } else { - ungetc(val, stdin); - base = 8; - } - } else - base = 10; - while ( INCHARSET( (val = getchar()), DIGIT) || - (base==16 && (INCHARSET(val, HEXLDIGIT|HEXUDIGIT) ) - ) - ){ - if (base==8) - intval <<= 3; - else if (base==10) - intval *= 10; - else { - intval <<= 4; - if (INCHARSET(val, HEXLDIGIT)) - val -= 'a' - 10 - '0'; - else if (INCHARSET(val, HEXUDIGIT)) - val -= 'A' - 10 - '0'; - } - intval += val-'0'; +++ } else { +++ forb = getchar(); +++ if (forb == 'f' || forb == 'b') { +++ yylval = val - '0' + 1; +++ if (forb == 'b') +++ yylval = -yylval; +++ val = BFINT; +++ goto ret; + + } - ungetc(val, stdin); - val = INT; - goto ret; - - case LSH: - case RSH: - /* - * We allow the C style operators - * << and >>, as well as < and > - */ - if ( (base = getchar()) != val) - ungetc(base, stdin); - val = yylval; - goto ret; - - case MINUS: - if ( (val = getchar()) =='(') - yylval=val=MP; +++ ungetc(forb); /* put back non zero */ +++ goto middle; +++ } +++ while ( (val = getchar()) == '0') +++ continue; +++ ungetc(val); +++ while ( INCHARSET( (val = getchar()), DIGIT) || +++ (base==16 && (INCHARSET(val, HEXLDIGIT|HEXUDIGIT) ) +++ ) +++ ){ +++ if (base==8) +++ intval <<= 3; +++ else if (base==10) +++ intval *= 10; + + else { - ungetc(val,stdin); - val=MINUS; +++ intval <<= 4; +++ if (INCHARSET(val, HEXLDIGIT)) +++ val -= 'a' - 10 - '0'; +++ else if (INCHARSET(val, HEXUDIGIT)) +++ val -= 'A' - 10 - '0'; + + } - goto ret; - - case SQ: - if ((yylval = getchar()) == '\n') - scanlineno++; /*not entirely correct*/ - intval = yylval; +++middle: +++ *cp++ = (val -= '0'); +++ intval += val; +++ } +++ ungetc(val); +++ *cp = 0; +++ maxstrlg = cp - fltchr; +++ if ( (maxstrlg > 8) +++ && ( ( (base == 8) +++ && ( (maxstrlg>11) +++ || ( (maxstrlg == 11) +++ && (*fltchr > 3) +++ ) +++ ) +++ ) +++ || ( (base == 16) +++ && (maxstrlg > 8) +++ ) +++ || ( (base == 10) +++ && (maxstrlg >= 10) +++ ) +++ ) +++ ) { +++ val = QUAD; +++ get_quad(base, fltchr, cp, &quadval); +++ } else + + val = INT; - goto ret; - - case DQ: - eatstr: - linescrossed = 0; - maxstrlg = (char *)bufub - (char *)bufptr; +++ goto ret; + + - if (maxstrlg < MAXSTRLG) { - ungetc('"', stdin); - *(toktype *)bufptr = VOID ; - bufub = bufptr; - goto done; - } - if (maxstrlg > MAXSTRLG) - maxstrlg = MAXSTRLG; - - ptoken(bufptr, STRING); - lgbackpatch = bufptr; /*this is where the size goes*/ - bufptr += sizeof(lgtype); - /* - * bufptr is now set to - * be stuffed with characters from - * the input - */ +++ case LSH: +++ case RSH: +++ /* +++ * We allow the C style operators +++ * << and >>, as well as < and > +++ */ +++ if ( (base = getchar()) != val) +++ ungetc(base); +++ val = yylval; +++ goto ret; + + - while ( (maxstrlg > 0) - && !(INCHARSET( (val = getchar()), STRESCAPE)) - ){ - stuff: - maxstrlg-= 1; - pchar(bufptr, val); - } - if (maxstrlg <= 0){ /*enough characters to fill a string buffer*/ - ungetc('"', stdin); /*will read it next*/ +++ case MINUS: +++ if ( (val = getchar()) =='(') +++ yylval=val=MP; +++ else { +++ ungetc(val); +++ val=MINUS; +++ } +++ goto ret; +++ +++ case SQ: +++ if ((yylval = getchar()) == '\n') +++ scanlineno++; /*not entirely correct*/ +++ intval = yylval; +++ val = INT; +++ goto ret; +++ +++ case DQ: +++ eatstr: +++ linescrossed = 0; +++ maxstrlg = (char *)bufub - (char *)bufptr; +++ +++ if (maxstrlg < MAXSTRLG) { +++ ungetc('"'); +++ *(toktype *)bufptr = VOID ; +++ bufub = bufptr; +++ goto done; +++ } +++ if (maxstrlg > MAXSTRLG) +++ maxstrlg = MAXSTRLG; +++ +++ ptoken(bufptr, STRING); +++ lgbackpatch = bufptr; /*this is where the size goes*/ +++ bufptr += sizeof(lgtype); +++ /* +++ * bufptr is now set to +++ * be stuffed with characters from +++ * the input +++ */ +++ +++ while ( (maxstrlg > 0) +++ && !(INCHARSET( (val = getchar()), STRESCAPE)) +++ ){ +++ stuff: +++ maxstrlg-= 1; +++ pchar(bufptr, val); + + } - else if (val == '"'); /*done*/ - else if (val == '\n'){ - scanlineno++; - linescrossed++; +++ if (maxstrlg <= 0){ /*enough characters to fill a string buffer*/ +++ ungetc('"'); /*will read it next*/ +++ } +++ else if (val == '"'); /*done*/ +++ else if (val == '\n'){ +++ yywarning("New line embedded in a string constant."); +++ scanlineno++; +++ linescrossed++; +++ val = getchar(); +++ if (val == EOFCHAR){ +++ do_eof: +++ pchar(bufptr, '\n'); +++ ungetc(EOFCHAR); +++ } else +++ if (val == NEEDCHAR){ +++ if ( (inbufptr = fillinbuffer()) == 0) +++ goto do_eof; +++ val = '\n'; + + goto stuff; - } else { - val = getchar(); /*skip the '\\'*/ - if ( INCHARSET(val, BSESCAPE)){ - switch (val){ - case 'b': val = '\b'; goto stuff; - case 'f': val = '\f'; goto stuff; - case 'n': val = '\n'; goto stuff; - case 'r': val = '\r'; goto stuff; - case 't': val = '\t'; goto stuff; - } - } - if ( !(INCHARSET(val,OCTDIGIT)) ) goto stuff; - base = 0; - intval = 0; - while ( (base < 3) && (INCHARSET(val, OCTDIGIT))){ - base++;intval <<= 3;intval += val - '0'; - val = getchar(); - } - ungetc(val, stdin); - val = (char)intval; +++ } else { /* simple case */ +++ ungetc(val); +++ val = '\n'; + + goto stuff; + + } - /* - * bufptr now points at the next free slot - */ - bstrfromto(lgbackpatch, bufptr); - if (linescrossed){ - val = ILINESKIP; - yylval = linescrossed; - goto ret; - } else - goto builtval; - - case BADCHAR: - linescrossed = lineno; - lineno = scanlineno; - yyerror("Illegal character mapped: %d, char read:(octal) %o", - yylval, val); - lineno = linescrossed; - val = BADCHAR; - goto ret; - - default: - val = yylval; +++ } else { +++ val = getchar(); /*skip the '\\'*/ +++ if ( INCHARSET(val, BSESCAPE)){ +++ switch (val){ +++ case 'b': val = '\b'; goto stuff; +++ case 'f': val = '\f'; goto stuff; +++ case 'n': val = '\n'; goto stuff; +++ case 'r': val = '\r'; goto stuff; +++ case 't': val = '\t'; goto stuff; +++ } +++ } +++ if ( !(INCHARSET(val,OCTDIGIT)) ) goto stuff; +++ base = 0; +++ intval = 0; +++ while ( (base < 3) && (INCHARSET(val, OCTDIGIT))){ +++ base++;intval <<= 3;intval += val - '0'; +++ val = getchar(); +++ } +++ ungetc(val); +++ val = (char)intval; +++ goto stuff; +++ } +++ /* +++ * bufptr now points at the next free slot +++ */ +++ bstrfromto(lgbackpatch, bufptr); +++ if (linescrossed){ +++ val = ILINESKIP; +++ yylval = linescrossed; + + goto ret; - } /*end of the switch*/ +++ } else +++ goto builtval; +++ +++ case BADCHAR: +++ linescrossed = lineno; +++ lineno = scanlineno; +++ yyerror("Illegal character mapped: %d, char read:(octal) %o", +++ yylval, val); +++ lineno = linescrossed; +++ val = BADCHAR; +++ goto ret; +++ +++ default: +++ val = yylval; +++ goto ret; +++ } /*end of the switch*/ + + /* + + * here with one token, so stuff it + + */ + + ret: + + oval = val; + + ptoken(bufptr, val); + + switch(val){ + + case ILINESKIP: + + pint(bufptr, yylval); + + break; + + case SIZESPEC: + + pchar(bufptr, yylval); + + break; +++ case BFINT: plong(bufptr, yylval); +++ break; + + case INT: plong(bufptr, intval); + + break; - case FLTNUM: pdouble(bufptr, fltval); +++ case QUAD: plong(bufptr, quadval.quad_low_long); +++ plong(bufptr, quadval.quad_high_long); +++ break; +++ case FLTNUM: pdouble(bufptr, fltval.dvalue); + + break; + + case NAME: pptr(bufptr, (int)(struct symtab *)yylval); + + break; + + case REG: pchar(bufptr, yylval); + + break; + + case INST0: + + case INSTn: + + pchar(bufptr, yylval); + + break; + + case IJXXX: + + pchar(bufptr, yylval); + + pptr(bufptr, (int)(struct symtab *)symalloc()); + + break; + + case ISTAB: + + case ISTABSTR: + + case ISTABNONE: + + case ISTABDOT: + + case IALIGN: + + pptr(bufptr, (int)(struct symtab *)symalloc()); + + break; + + /* + + * default: + + */ + + } + + builtval: ; + + } /*end of the while to stuff the buffer*/ + + done: + + bufferbox->tok_count = (toktype *)bufptr - &(bufferbox->toks[0]); + + + + /* + + * This is a real kludge: + + * + + * We put the last token in the buffer to be a MINUS + + * symbol. This last token will never be picked up + + * in the normal way, but can be looked at during + + * a peekahead look that the short circuit expression + + * evaluator uses to see if an expression is complicated. + + * + + * Consider the following situation: + + * + + * .word 45 + 47 + + * buffer 1 | buffer 0 + + * the peekahead would want to look across the buffer, + + * but will look in the buffer end zone, see the minus, and + + * fail. + + */ + + ptoken(bufptr, MINUS); + + InBufPtr = inbufptr; /*copy this back*/ + +} +++ +++struct Quad _quadtemp; +++get_quad(radix, cp_start, cp_end, quadptr) +++ int radix; +++ char *cp_start, *cp_end; +++ struct Quad *quadptr; +++{ +++ register char *cp = cp_start; /* r11 */ +++ register struct Quad *qp = quadptr; /* r10 */ +++ register long temp; /* r9 */ +++ +++ asm("clrq (r10)"); +++ for (; cp < cp_end; cp++){ +++ switch (radix) { +++ case 8: +++ asm ("ashq $3, (r10), (r10)"); +++ break; +++ case 16: +++ asm ("ashq $4, (r10), (r10)"); +++ break; +++ case 10: +++ asm ("ashq $1, (r10), __quadtemp"); +++ asm ("ashq $3, (r10), (r10)"); +++ asm ("addl2 __quadtemp, (r10)"); +++ asm ("adwc __quadtemp+4, 4(r10)"); +++ break; +++ } +++ asm ("cvtbl (r11), r9"); +++ asm ("addl2 r9, (r10)"); +++ asm ("adwc $0, 4(r10)"); +++ } +++} diff --cc usr/src/cmd/as/asscan.h index 0000000000,71e8d4c12d,0000000000..61dc627ada mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/asscan.h +++ b/usr/src/cmd/as/asscan.h @@@@ -1,0 -1,118 -1,0 +1,106 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ - +++/* Copyright (c) 1980 Regents of the University of California */ +++/* "@(#)asscan.h 4.3 8/15/80" */ + +/* + + * The character scanner is called to fill up one token buffer + + * - * In the first pass, the tokens in this buffer may be overwriten - * to eliminate .stabs, and to change fully assemblable instructions - * into ascii strings. However, once the tokens are filled up by the +++ * However, once the tokens are filled up by the + + * character scanner, they are used in both the first and the second - * pass. Holes created by .stab removal and preassembly are replaced +++ * pass. Holes created by .stab removal are replaced + + * with 'skip' tokens that direct the second pass to ignore the + + * following tokens. - * - * While the first pass could write a second version of the intermediate - * file and really purge the .stabs and such, the buffering required - * to do this seems to be too complex and too slow. + + */ + + - #define TOKBUFLG 2*BUFSIZ +++#define TOKBUFLG BUFSIZ + +#define MAXVAX 32 - #define SAFETY 2*NCPS +++#define SAFETY 16 + + + +#define AVAILTOKS TOKBUFLG -\ - sizeof(short) -\ +++ sizeof(int) -\ + + sizeof (struct tokbufdesc *) -\ + + MAXVAX - SAFETY + + + +struct tokbufdesc{ - short tok_count; /*absolute byte length*/ +++ int tok_count; /*absolute byte length*/ + + struct tokbufdesc *tok_next; + + char toks[AVAILTOKS]; + + char bufovf[MAXVAX + SAFETY]; + +}; - - /* - * All variables handling these resources are local to astmpfil.c; - * we must have the structure defnitions here so that - * asscan.c can touch the stuff in a token buffer - */ - + +/* + + * Definitions for handling tokens in the intermediate file + + * buffers. + + * + + * We want to have the compiler produce the efficient auto increment + + * instruction for stepping through the buffer of tokens. We must + + * fool the type checker into thinking that a pointer can point + + * to various size things. + + */ + + + +typedef char toktype; + + + +typedef char *ptrall; /*all uses will be type cast*/ + +typedef short lgtype; /*for storing length of strings or skiping*/ + +/* + + * defintions for putting various typed values + + * into the intermediate buffers + + * ptr will ALWAYS be of type ptrall + + */ + + + +#define pchar(ptr,val) *ptr++ = val + +#define puchar(ptr,val) *ptr++ = val + + + +#define pshort(ptr,val) *(short *)ptr=val, ptr += sizeof(short) - #define pushort(ptr,val) *(unsigned short *)ptr=val, ptr += sizeof(short) +++#define pushort(ptr,val) *(unsigned short *)ptr=val, ptr += sizeof(short) + +#define pint(ptr,val) *(int *)ptr = val, ptr += sizeof(int) - #define puint(ptr,val) *(unsigned int *)ptr=val, ptr += sizeof(int) +++#define puint(ptr,val) *(unsigned int *)ptr=val, ptr += sizeof(int) + +#define plong(ptr,val) *(long *)ptr = val, ptr += sizeof(long) - #define pulong(ptr,val) *(unsigned long *)ptr=val,ptr += sizeof(long) +++#define pulong(ptr,val) *(unsigned long *)ptr=val, ptr += sizeof(long) + +#define pfloat(ptr,val) *(float *)ptr = val, ptr += sizeof (float) + +#define pdouble(ptr,val) *(double *)ptr = val, ptr += sizeof (double) + +#define pptr(ptr,val) *(int *)ptr = (val), ptr += sizeof(ptrall) + +#define ptoken(ptr,val) *ptr++ = val + +#define pstrlg(ptr,val) *(lgtype *)ptr = val, ptr += sizeof(short) + +#define pskiplg(ptr,val) *(lgtype *)ptr = val, ptr += sizeof(short) + + + +#define gchar(val, ptr) val = *ptr++ + +#define guchar(val, ptr) val = *ptr++ + + + +#define gshort(val, ptr) val = *(short *)ptr , ptr += sizeof (short) + +#define gushort(val, ptr) val = *(unsigned short *)ptr , ptr += sizeof (short) + +#define gint(val, ptr) val = *(int *)ptr, ptr += sizeof (int) + +#define guint(val, ptr) val = *(unsigend int *)ptr, ptr += sizeof (int) + +#define glong(val, ptr) val = *(long *)ptr, ptr += sizeof (long) + +#define gulong(val, ptr) val = *(unsigned long *)ptr, ptr += sizeof (long) + +#define gfloat(val, ptr) val = *(float *)ptr, ptr += sizeof (float) + +#define gdouble(val, ptr) val = *(double *)ptr, ptr += sizeof (double) + +#define gptr(val, ptr) val = *(int *)ptr, ptr += sizeof (ptrall) + +#define gtoken(val, ptr) val = *ptr++ + +#define gstrlg(val, ptr) val = *(lgtype *)ptr, ptr += sizeof (short) + +#define gskiplg(val, ptr) val = *(lgtype *)ptr, ptr += sizeof (short) + + + + - ptrall tokptr; /*the next token to consume, call by copy*/ - ptrall tokub; /*current upper bound in the current buffer*/ +++extern ptrall tokptr; /*the next token to consume, call by copy*/ +++extern ptrall tokub; /*current upper bound in the current buffer*/ + + + +/* + + * Strings are known for their characters and for their length. + + * We cannot use a normal zero termination byte, because strings + + * can contain anything. + + * + + * We have two "strings", so that an input string that is too long can be + + * split across two string buffers, and not confuse the yacc grammar. + + * (This is probably superflous) + + * + + * We have a third string of nulls so that the .skip can be + + * handled in the same way as strings. + + */ + +#define MAXSTRLG 127 + + + +struct strdesc{ + + char str_lg; + + char str[MAXSTRLG]; + +}; + + - struct strdesc strbuf[3]; - struct strdesc *strptr; /*points to the current string*/ - int strno; /*the current string being filled*/ +++extern struct strdesc strbuf[3]; +++extern struct strdesc *strptr; /*points to the current string*/ +++extern int strno; /*the current string being filled*/ +++char *savestr(); diff --cc usr/src/cmd/as/assyms.c index 0000000000,fe262044f8,0000000000..c445471a63 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/assyms.c +++ b/usr/src/cmd/as/assyms.c @@@@ -1,0 -1,529 -1,0 +1,703 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char sccsid[] = "@(#)assyms.c 4.6 11/5/80"; + +#include +++#include + +#include "as.h" +++#include "asscan.h" + +#include "assyms.h" + + - struct allocbox *allochead; - struct allocbox *alloctail; - struct symtab *nextsym; - struct allocbox *newbox; - char *namebuffer; - int symsleft; +++/* +++ * Managers for chunks of symbols allocated from calloc() +++ * We maintain a linked list of such chunks. +++ * +++ */ +++struct allocbox *allochead; /*head of chunk list*/ +++struct allocbox *alloctail; /*tail*/ +++struct allocbox *newbox; /*for creating a new chunk*/ +++struct symtab *nextsym; /*next symbol free*/ +++int symsleft; /*slots left in current chunk*/ +++ +++struct symtab **symptrs; +++struct symtab **symdelim[NLOC + NLOC +1]; +++struct symtab **symptrub; +++/* +++ * Managers for the dynamically extendable hash table +++ */ +++struct hashdallop *htab; +++ +++struct instab *itab[NINST]; /*maps opcodes to instructions*/ +++/* +++ * Counts what went into the symbol table, so that the +++ * size of the symbol table can be computed. +++ */ +++int nsyms; /* total number in the symbol table */ +++int njxxx; /* number of jxxx entrys */ +++int nforgotten; /* number of symbols erroneously entered */ +++int nlabels; /* number of label entries */ +++int hshused; /* number of hash slots used */ +++ +++/* +++ * Managers of the symbol literal storage. +++ * If we have flexible names, then we allocate BUFSIZ long +++ * string, and pack strings into that. Otherwise, we allocate +++ * symbol storage in fixed hunks NCPS long when we allocate space +++ * for other symbol attributes. +++ */ +++#ifdef FLEXNAMES +++struct strpool *strplhead = 0; +++#endif FLEXNAMES + + + +symtabinit() + +{ + + allochead = 0; + + alloctail = 0; + + nextsym = 0; + + symsleft = 0; +++#ifdef FLEXNAMES +++ strpoolalloc(); /* get the first strpool storage area */ +++#endif FLEXNAMES +++ htab = 0; +++ htaballoc(); /* get the first part of the hash table */ + +} + + + +/* + + * Install all known instructions in the symbol table + + */ + +syminstall() + +{ + + register struct instab *ip; + + register struct symtab **hp; + + register char *p1, *p2; + + - for (ip=instab; ip->name[0]!=0; ip++) { - p1 = ip->name; +++#ifdef FLEXNAMES +++ for (ip = (struct instab *)instab; ip->s_name != 0; ip++) { +++#else not FLEXNAMES +++ for (ip = (struct instab *)instab; ip->s_name[0] != '\0'; ip++){ +++#endif not FLEXNAMES +++ p1 = ip->s_name; + + p2 = yytext; + + while (*p2++ = *p1++); + + hp = lookup(0); /* 0 => don't install this*/ + + if (*hp==NULL) { + + *hp = (struct symtab *)ip; - if ( (ip->tag!=INSTn) - && (ip->tag!=INST0) - && (ip->tag!=0)) +++ if ( (ip->s_tag!=INSTn) +++ && (ip->s_tag!=INST0) +++ && (ip->s_tag!=0)) + + continue; /* was pseudo-op */ - itab[ip->opcode & 0xFF] = ip; +++ itab[ip->i_opcode & 0xFF] = ip; + + } + + } + +} /*end of syminstall*/ + + + + + +/* + + * Assign final values to symbols, + + * and overwrite the index field with its relative position in + + * the symbol table we give to the loader. + + */ - extern struct hdr hdr; +++extern struct exec hdr; + + + +freezesymtab() + +{ + + register struct symtab *sp; + + long bs; + + register int relpos = 0; - #ifdef SORTEDOUTPUT - register struct symtab **cosp; - #else + + register struct symtab *ubsp; + + register struct allocbox *allocwalk; - #endif + + - #ifdef SORTEDOUTPUT - SYMITERATE(cosp, sp) - #else + + DECLITERATE(allocwalk, sp, ubsp) - #endif + + { - if (sp->tag >= IGNOREBOUND) +++ if (sp->s_tag >= IGNOREBOUND) + + continue; /*totally ignore jxxx entries */ + + /* + + * Ignore stabs, but give them a symbol table index + + */ - if (sp->type & STABFLAG) +++ if (sp->s_type & STABFLAG) + + goto assignindex; - if ((sp->type&XTYPE)==XUNDEF) - sp->type = XXTRN+XUNDEF; - else if ((sp->type&XTYPE)==XDATA) - sp->value += usedot[sp->index].xvalue; - else if ((sp->type&XTYPE)==XTEXT) - sp->value += usedot[sp->index].xvalue; - else if ((sp->type&XTYPE)==XBSS) { - bs = sp->value; - sp->value = hdr.bsize + datbase; - hdr.bsize += bs; +++ if ((sp->s_type&XTYPE)==XUNDEF) +++ sp->s_type = XXTRN+XUNDEF; +++ else if ((sp->s_type&XTYPE)==XDATA) +++ sp->s_value += usedot[sp->s_index].e_xvalue; +++ else if ((sp->s_type&XTYPE)==XTEXT) +++ sp->s_value += usedot[sp->s_index].e_xvalue; +++ else if ((sp->s_type&XTYPE)==XBSS) { +++ bs = sp->s_value; +++ sp->s_value = hdr.a_bss + datbase; +++ hdr.a_bss += bs; + + } + + assignindex: - if ( (sp->name[0] != 'L') - || (sp->tag != LABELID) +++ if ( (sp->s_name[0] != 'L') +++ || (sp->s_tag != LABELID) + + || savelabels + + ) /*then, we will write it later on*/ - sp->index = relpos++; +++ sp->s_index = relpos++; + + } + +} + + + + + + + +/* + + * For all of the stabs that had their final value undefined during pass 1 + + * and during pass 2 assign a final value. + + * We have already given stab entrys a initial approximation + + * when we constsructed the sorted symbol table. + + * Iteration order doesn't matter. + + */ + +stabfix() { + + register struct symtab *sp, **cosp; + + register struct symtab *p; + + + + SYMITERATE(cosp, sp){ - if(sp->ptype && (sp->type & STABFLAG)) { - p = sp->dest; - sp->value = p->value; - sp->index = p->index; - sp->type = p->type; - #ifdef DSTAB - printf("STABFIX: %s (old %s) to %d offsets %d %d\n", - sp->name, p->name, sp->value, sp, p); - #endif +++ if(sp->s_ptype && (sp->s_type & STABFLAG)) { +++ p = sp->s_dest; +++ sp->s_value = p->s_value; +++ sp->s_index = p->s_index; +++ sp->s_type = p->s_type; + + } + + } + +} + + + +char *Calloc(number, size) + + int number, size; + +{ + + register char *newstuff; + + newstuff = (char *)sbrk(number*size); + + if ((int)newstuff == -1){ + + yyerror("Ran out of Memory"); + + delexit(); + + } + + return(newstuff); + +} + + - struct symtab * symalloc() +++char *ClearCalloc(number, size) +++ int number, size; + +{ - if (symsleft == 0){ - register int *p; +++ register char *newstuff; /* r11 */ +++ register int length = number * size; /* r10 */ +++ newstuff = Calloc(number, size); +++ asm("movc5 $0, (r0), $0, r10, (r11)"); +++ return(newstuff); +++} + + - newbox = (struct allocbox *)Calloc(1,ALLOCQTY); +++struct symtab *symalloc() +++{ +++ if (symsleft == 0){ +++ newbox = (struct allocbox *)ClearCalloc(1,ALLOCQTY); + + symsleft = SYMDALLOP; + + nextsym = &newbox->symslots[0]; - namebuffer = &newbox->symnames[0]; - p = (int *)(&newbox->symnames[SYMDALLOP * NCPS]); - while ( p > (int *)newbox){ - *--p = 0; - } + + if (alloctail == 0){ + + allochead = alloctail = newbox; + + } else { + + alloctail->nextalloc = newbox; + + alloctail = newbox; + + } + + } + + --symsleft; + + ++nsyms; - nextsym->name = namebuffer; - namebuffer += NCPS; + + return(nextsym++); + +} + + - symcmp(pptr, qptr) - struct symtab **pptr, **qptr; +++#ifdef FLEXNAMES +++strpoolalloc() + +{ - register struct symtab *p = *pptr; - register struct symtab *q = *qptr; - if (p->index < q->index) +++ register struct strpool *new; +++ +++ new = (struct strpool *)Calloc(1, sizeof (struct strpool)); +++ new->str_nalloc = 0; +++ new->str_next = strplhead; +++ strplhead = new; +++} +++#endif FLEXNAMES +++ +++symcmp(Pptr, Qptr) +++ struct symtab **Pptr, **Qptr; +++{ +++ register struct symtab *p = *Pptr; +++ register struct symtab *q = *Qptr; +++ if (p->s_index < q->s_index) + + return(-1); - if (p->index > q->index) +++ if (p->s_index > q->s_index) + + return(1); - if (p->value < q->value) +++ if (p->s_value < q->s_value) + + return(-1); - if (p->value > q->value) +++ if (p->s_value > q->s_value) + + return(1); + + /* + + * Force jxxx entries to virtually preceed labels defined + + * to follow the jxxxx instruction, so that bumping the + + * jxxx instruction correctly fixes up the following labels + + */ - if (p->tag >= IGNOREBOUND) /*p points to a jxxx*/ +++ if (p->s_tag >= IGNOREBOUND) /*p points to a jxxx*/ + + return(-1); - if (q->tag >= IGNOREBOUND) +++ if (q->s_tag >= IGNOREBOUND) + + return(1); + + /* + + * both are now just plain labels; the relative order doesn't + + * matter. Both can't be jxxxes, as they would have different + + * values. + + */ + + return(0); + +} /*end of symcmp*/ + + + +/* + + * We construct the auxiliary table of pointers, symptrs and + + * symdelim + + * We also assign preliminary values to stab entries that did not yet + + * have an absolute value (because they initially referred to + + * forward references). We don't worry about .stabds, as they + + * already have an estimated final value + + */ + + + +sortsymtab() + +{ + + register struct symtab *sp; + + register struct symtab **cowalk; + + register struct allocbox *allocwalk; + + struct symtab *ubsp; + + int segno; + + int slotno; + + int symsin; /*number put into symptrs*/ + + + + symptrs = (struct symtab **)Calloc(nsyms + 2, sizeof *symptrs); + + /* + + * Allocate one word at the beginning of the symptr array + + * so that backwards scans through the symptr array will + + * work correctly while scanning through the zeroth segment + + */ + + *symptrs++ = 0; + + cowalk = symptrs; + + symsin = 0; + + DECLITERATE(allocwalk, sp, ubsp) { - if (sp->ptype && (sp->type &STABFLAG)){ - sp->value = sp->dest->value; - sp->index = sp->dest->index; +++ if (sp->s_ptype && (sp->s_type &STABFLAG)){ +++ sp->s_value = sp->s_dest->s_value; +++ sp->s_index = sp->s_dest->s_index; + + } + + if (symsin >= nsyms) + + yyerror("INTERNAL ERROR: overfilled symbol table indirection table"); + + *cowalk++ = sp; + + symsin++; + + } + + if (symsin != nsyms) + + yyerror("INTERNAL ERROR: installed %d syms, should have installed %d", + + symsin, nsyms); + + symptrub = &symptrs[nsyms ]; + + qsort(symptrs, nsyms, sizeof *symptrs, symcmp); + + symdelim[0] = symptrs; + + for (cowalk = symptrs, sp = *cowalk, segno = 0, slotno = 1; + + segno < NLOC + NLOC; + + segno++, slotno++){ - for (; sp && sp->index == segno; sp = *++cowalk); +++ for (; sp && sp->s_index == segno; sp = *++cowalk); + + symdelim[slotno] = cowalk; /*forms the ub delimeter*/ + + } + +} /*end of sortsymtab*/ + + + +#ifdef DEBUG + +dumpsymtab() + +{ + + register int segno; + + register struct symtab *sp, **cosp, *ub; + + char *tagstring(); + + + + printf("Symbol Table dump:\n"); + + for (segno = 0; segno < NLOC + NLOC; segno++){ + + printf("Segment number: %d\n", segno); + + SEGITERATE(segno, 0, 0, cosp, sp, ub, ++){ - printf("\tSeg: %d \"%8.8s\" value: %d index: %d tag %s\n", - segno, sp->name, sp->value, sp->index, tagstring(sp->tag)); +++#ifdef FLEXNAMES +++ printf("\tSeg: %d \"%s\" value: %d index: %d tag %s\n", +++ segno, sp->s_name, +++ sp->s_value, sp->s_index, +++ tagstring(sp->s_tag)); +++#else not FLEXNAMES +++ printf("\tSeg: %d \"%*.*s\" value: %d index: %d tag %s\n", +++ segno, NCPS, NCPS, sp->s_name, +++ sp->s_value, sp->s_index, +++ tagstring(sp->s_tag)); +++#endif not FLEXNAMES + + printf("\t\ttype: %d jxbump %d jxfear: %d\n", - sp->type, sp->jxbump, sp->jxfear); +++ sp->s_type, sp->s_jxbump, sp->s_jxfear); + + } + + printf("\n\n"); + + } + +} + + + +static char tagbuff[4]; + + + +char *tagstring(tag) + + unsigned char tag; + +{ + + switch(tag){ + + case JXACTIVE: return("active"); + + case JXNOTYET: return("notyet"); + + case JXALIGN: return("align"); + + case JXQUESTIONABLE: return("jxquestionable"); + + case JXINACTIVE: return("inactive"); + + case JXTUNNEL: return("tunnel"); + + case OBSOLETE: return("obsolete"); + + case IGNOREBOUND: return("ignorebound"); + + case STABFLOATING: return("stabfloating"); + + case STABFIXED: return("stabfixed"); + + case LABELID: return("labelid"); + + case OKTOBUMP: return("oktobump"); + + case ISET: return("iset"); + + case ILSYM: return("ilsym"); + + default: sprintf(tagbuff,"%d", tag); + + return(tagbuff); + + } + +} - #endif +++#endif DEBUG +++ +++htaballoc() +++{ +++ register struct hashdallop *new; +++ new = (struct hashdallop *)ClearCalloc(1, sizeof (struct hashdallop)); +++ if (htab == 0) +++ htab = new; +++ else { /* add AFTER the 1st slot */ +++ new->h_next = htab->h_next; +++ htab->h_next = new; +++ } +++} + + - #define HASHCLOGGED (NHASH * 3 ) / 4 +++#define HASHCLOGGED (NHASH / 2) + + +++/* +++ * Lookup a symbol stored in extern yytext. +++ * All strings passed in via extern yytext had better have +++ * a trailing null. Strings are placed in yytext for hashing by +++ * syminstall() and by yylex(); +++ * +++ * We take pains to avoid function calls; this functdion +++ * is called quite frequently, and the calls overhead +++ * in the vax contributes significantly to the overall +++ * execution speed of as. +++ */ + +struct symtab **lookup(instflg) + + int instflg; /* 0: don't install */ + +{ - register int ihash; +++ static int initialprobe; + + register struct symtab **hp; - register char *p1, *p2; - register int i; - - #ifdef METRIC - nhashed++; - #endif - - /* - * All strings passed in in yytext had better have - * a trailing null. Strings are placed in yytext for - * hashing by syminstall() and yylex() - */ - for (ihash = 0, p1 = yytext ; *p1; ihash <<= 2, ihash += *p1++); - ihash += p1[-1] << 5; - ihash %= NHASH; - if (ihash < 0) ihash += NHASH; - hp = &hshtab[ihash]; - ihash = 1; /*now, it counts the number of times we rehash*/ - while (*hp) { - p1 = yytext; - p2 = (*hp)->name; - for (i = 0; (i= NCPS) /*both symbols are maximal length*/ - return(hp); - if (*p2 == 0) /*assert *p1 == 0*/ - return(hp); - no: - #ifdef METRIC - nhcollisions++; - #endif - hp += ihash; - ihash += 2; - if (hp >= &hshtab[NHASH]) - hp -= NHASH; +++ register char *from; +++ register char *to; +++ register int len; +++ register int nprobes; +++ static struct hashdallop *hdallop; +++ static struct symtab **emptyslot; +++ static struct hashdallop *emptyhd; +++ static struct symtab **hp_ub; +++ +++ emptyslot = 0; +++ for (nprobes = 0, from = yytext; +++ *from; +++ nprobes <<= 2, nprobes += *from++) +++ continue; +++ nprobes += from[-1] << 5; +++ nprobes %= NHASH; +++ if (nprobes < 0) +++ nprobes += NHASH; +++ +++ initialprobe = nprobes; +++ for (hdallop = htab; hdallop != 0; hdallop = hdallop->h_next){ +++ for (hp = &(hdallop->h_htab[initialprobe]), +++ nprobes = 1, +++ hp_ub = &(hdallop->h_htab[NHASH]); +++ (*hp) && (nprobes < NHASH); +++ hp += nprobes, +++ hp -= (hp >= hp_ub) ? NHASH:0, +++ nprobes += 2) +++ { +++ from = yytext; +++ to = (*hp)->s_name; +++#ifndef FLEXNAMES +++ for (len = 0; (len= NCPS) /*both are maximal length*/ +++ return(hp); +++ if (*to == 0) /*assert *from == 0*/ +++ return(hp); +++#else FLEXNAMES +++ while (*from && *to) +++ if (*from++ != *to++) +++ goto nextprobe; +++ if (*to == *from) /*assert both are == 0*/ +++ return(hp); +++#endif FLEXNAMES +++ +++ nextprobe: ; +++ } +++ if (*hp == 0 && emptyslot == 0 && +++ hdallop->h_nused < HASHCLOGGED) { +++ emptyslot = hp; +++ emptyhd = hdallop; +++ } + + } - if(++hshused >= HASHCLOGGED) { - yyerror("Symbol table overflow"); - delexit(); +++ if (emptyslot == 0) { +++ htaballoc(); +++ hdallop = htab->h_next; /* aren't we smart! */ +++ hp = &hdallop->h_htab[initialprobe]; +++ } else { +++ hdallop = emptyhd; +++ hp = emptyslot; + + } + + if (instflg) { - #ifdef METRIC - nentered++; - #endif + + *hp = symalloc(); - p1 = yytext; - p2 = (*hp)->name; - while (*p2++ = *p1++); +++ hdallop->h_nused++; +++#ifndef FLEXNAMES +++ for(len = 0, from = yytext, to = (*hp)->s_name; (len= (STRPOOLDALLOP - strplhead->str_nalloc)) +++ strpoolalloc(); +++ for ( (*hp)->s_name = to = strplhead->str_names + strplhead->str_nalloc, from = yytext; +++ ( (*to++ = *from++) != '\0'); ) +++ continue; +++ strplhead->str_nalloc += len; +++#endif FLEXNAMES + + } + + return(hp); - } /*end of symlook*/ - - #ifdef vax - #define writel(p,n,f) fwrite((long)p, sizeof (long), n, f) - #else - writel(p,n,f) - long *p; - FILE *f; +++} /*end of lookup*/ +++ +++#ifdef FLEXNAMES +++char *savestr(str) +++ char *str; + +{ - while (n--) { - fwrite(&(*p).loword,2,1,f); - fwrite(&(*p).hiword,2,1,f); - p++; - } +++ register int len; +++ register char *from, *to; +++ char *res; +++ +++ for (from = str, len = 1; *from++; len++) +++ continue; +++ if (len >= (STRPOOLDALLOP - strplhead->str_nalloc)) +++ strpoolalloc(); +++ for ( res = to = strplhead->str_names + strplhead->str_nalloc, from = str; +++ ( (*to++ = *from++) != '\0'); ) +++ continue; +++ strplhead->str_nalloc += len; +++ return (res); + +} - #endif - - int reflen[] = {0,0,1,1,2,2,4,4,8,8}; +++#endif FLEXNAMES + + + +/* - * Save the relocation information +++ * The relocation information is saved internally in an array of +++ * lists of relocation buffers. The relocation buffers are +++ * exactly the same size as a token buffer; if we use VM for the +++ * temporary file we reclaim this storage, otherwise we create +++ * them by mallocing. + + */ - outrel(pval,reftype,reltype,xsym) - long *pval; - register int reftype,reltype; - struct symtab *xsym; +++#define RELBUFLG TOKBUFLG +++#define NRELOC ((TOKBUFLG - \ +++ (sizeof (int) + sizeof (struct relbufdesc *)) \ +++ ) / (sizeof (struct relocation_info))) +++ +++struct relbufdesc{ +++ int rel_count; +++ struct relbufdesc *rel_next; +++ struct relocation_info rel_reloc[NRELOC]; +++}; +++extern struct relbufdesc *tok_free; +++#define rel_free tok_free +++static struct relbufdesc *rel_temp; +++struct relocation_info r_can_1PC; +++struct relocation_info r_can_0PC; +++ +++initoutrel() + +{ +++ r_can_0PC.r_address = 0; +++ r_can_0PC.r_symbolnum = 0; +++ r_can_0PC.r_pcrel = 0; +++ r_can_0PC.r_length = 0; +++ r_can_0PC.r_extern = 0; +++ +++ r_can_1PC = r_can_0PC; +++ r_can_1PC.r_pcrel = 1; +++} + + - /* - * reftype: PCREL or not, plus length LEN1, LEN2, LEN4, LEN8 - * reltype: csect ("segment") number (XTEXT, XDATA, ...) associated with 'val' - * xsym: symbol table pointer - */ - long ts; - char tc; - long tl; - short t; - if (passno!=2) { - dotp->xvalue += reflen[reftype]; - return; - } +++outrel(xp, reloc_how) +++ register struct exp *xp; +++ int reloc_how; /* TYPB..TYPD + (possibly)RELOC_PCREL */ +++{ +++ struct relocation_info reloc; +++ register int x_type_mask; +++ int pcrel; +++ +++ x_type_mask = xp->e_xtype & ~XFORW; +++ pcrel = reloc_how & RELOC_PCREL; +++ reloc_how &= ~RELOC_PCREL; +++ + + if (bitoff&07) + + yyerror("Padding error"); - reltype &= ~XFORW; - if (reltype == XUNDEF) +++ if (x_type_mask == XUNDEF) + + yyerror("Undefined reference"); - if (reltype != XABS || reftype & PCREL) { - /* write the address portion of a relocation datum */ - if (dotp >= &usedot[NLOC]) { - hdr.drsize += sizeof(dotp->xvalue) + 3 + sizeof tc; - tl = dotp->xvalue-datbase; - writel(&tl,1,relfil); - } else { - hdr.trsize += sizeof(dotp->xvalue) + 3 + sizeof tc; - writel(&dotp->xvalue,1,relfil); +++ +++ if ( (x_type_mask != XABS) || pcrel ) { +++ if (ty_NORELOC[reloc_how]) +++ yyerror("Illegal Relocation of float, double or quad."); +++ reloc = pcrel ? r_can_1PC : r_can_0PC; +++ reloc.r_address = dotp->e_xvalue - +++ ( (dotp < &usedot[NLOC] || readonlydata) ? 0 : datbase ); +++ reloc.r_length = ty_nlg[reloc_how]; +++ switch(x_type_mask){ +++ case XXTRN | XUNDEF: +++ reloc.r_symbolnum = xp->e_xname->s_index; +++ reloc.r_extern = 1; +++ break; +++ default: +++ if (readonlydata && (x_type_mask&~XXTRN) == XDATA) +++ x_type_mask = XTEXT | (x_type_mask&XXTRN); +++ reloc.r_symbolnum = x_type_mask; +++ break; + + } - /* write the properties portion of a relocation datum */ - if (reltype == XXTRN+XUNDEF) { - ts = (xsym->index); - tc = (XXTRN<<3) | (reftype-LEN1); - } else if ((reltype&XTYPE) == XUNDEFO) { - ts = (xsym->index); - tc = ((XXTRN+2)<<3) | (reftype-LEN1); - } else { - ts = (reltype); - tc = (reftype-LEN1); +++ if ( (relfil == 0) || (relfil->rel_count >= NRELOC) ){ +++ if (rel_free){ +++ rel_temp = rel_free; +++ rel_free = rel_temp->rel_next; +++ } else { +++ rel_temp = (struct relbufdesc *) +++ Calloc(1,sizeof (struct relbufdesc)); +++ } +++ rel_temp->rel_count = 0; +++ rel_temp->rel_next = relfil; +++ relfil = rusefile[dotp - &usedot[0]] = rel_temp; + + } - fwrite((char *)&ts, 3, 1, relfil); - fwrite(&tc, sizeof(tc), 1, relfil); +++ relfil->rel_reloc[relfil->rel_count++] = reloc; + + } - /* write the raw ("unrelocated") value to the text file */ - t = reflen[reftype]; - dotp->xvalue += t; - if (reftype & PCREL) - *pval -= dotp->xvalue; - #ifdef vax - fwrite(pval,1,t,txtfil); - #else - if (t>2) { - fwrite(&((*pval).loword),1,2,txtfil); - fwrite(&((*pval).hiword),1,t-2,txtfil); - } else fwrite(&((*pval).loword),1,t,txtfil); - #endif +++ /* +++ * write the unrelocated value to the text file +++ */ +++ dotp->e_xvalue += ty_nbyte[reloc_how]; +++ if (pcrel) +++ xp->e_xvalue -= dotp->e_xvalue; +++ bwrite((char *)&(xp->e_xvalue), ty_nbyte[reloc_how], txtfil); + +} - - + +/* - * Write out n symbols to file f, beginning at p - * ignoring symbols that are obsolete, jxxx instructions, and - * possibly, labels +++ * Flush out all of the relocation information. +++ * Note that the individual lists of buffers are in +++ * reverse order, so we must reverse them + + */ +++off_t closeoutrel(relocfile) +++ BFILE *relocfile; +++{ +++ int locindex; +++ u_long Closeoutrel(); + + - int sizesymtab() +++ trsize = 0; +++ for (locindex = 0; locindex < NLOC; locindex++){ +++ trsize += Closeoutrel(rusefile[locindex], relocfile); +++ } +++ drsize = 0; +++ for (locindex = 0; locindex < NLOC; locindex++){ +++ drsize += Closeoutrel(rusefile[NLOC + locindex], relocfile); +++ } +++ return(trsize + drsize); +++} +++ +++u_long Closeoutrel(relfil, relocfile) +++ struct relbufdesc *relfil; +++ BFILE *relocfile; + +{ - struct symtab *sp; +++ u_long tail; +++ if (relfil == 0) +++ return(0L); +++ tail = Closeoutrel(relfil->rel_next, relocfile); +++ bwrite((char *)&relfil->rel_reloc[0], +++ relfil->rel_count * sizeof (struct relocation_info), +++ relocfile); +++ return(tail + relfil->rel_count * sizeof (struct relocation_info)); +++} + + + +#define NOUTSYMS (nsyms - njxxx - nforgotten - (savelabels ? 0 : nlabels)) - - return ( - ( NCPS - + sizeof (sp->ptype) - + sizeof (sp->other) - + sizeof (sp->desc) - + sizeof (sp->value) - ) - * NOUTSYMS - ); +++int sizesymtab() +++{ +++ return (sizeof (struct nlist) * NOUTSYMS); + +} + + - symwrite(f) - FILE *f; +++#ifdef FLEXNAMES +++/* +++ * We write out the flexible length character strings for names +++ * in two stages. +++ * 1) We have always! maintain a fixed sized name list entry; +++ * the string is indexed by a four byte quantity from the beginning +++ * of the string pool area. Index 0 is reserved, and indicates +++ * that there is no associated string. The first valid index is 4. +++ * 2) We concatenate together and write all of the strings +++ * in the string pool at the end of the name list. The first +++ * four bytes in the string pool are indexed only by 0 (see above); +++ * they contain the total number of bytes in the string pool. +++ */ +++#endif FLEXNAMES +++ +++/* +++ * Write out n symbols to file f, beginning at p +++ * ignoring symbols that are obsolete, jxxx instructions, and +++ * possibly, labels +++ */ +++ +++int symwrite(symfile) +++ BFILE *symfile; + +{ + + int symsout; /*those actually written*/ + + int symsdesired = NOUTSYMS; + + register struct symtab *sp, *ub; - #ifdef SORTEDOUTPUT - int segno; - register struct symtab **copointer; - #else +++#ifdef FLEXNAMES +++ char *name; /* temp to save the name */ +++ long stroff = sizeof (stroff); +++ /* +++ * We use sp->s_index to hold the length of the +++ * name; it isn't used for anything else +++ */ +++#endif FLEXNAMES +++ + + register struct allocbox *allocwalk; - #endif + + - #ifdef SORTEDOUTPUT - for (segno = 0, symsout = 0; segno < NLOC + NLOC; segno++) - SEGITERATE(segno, 0, 0, copointer, sp, ub, ++) - #else + + symsout = 0; + + DECLITERATE(allocwalk, sp, ub) - #endif + + { - if (sp->tag >= IGNOREBOUND) +++ if (sp->s_tag >= IGNOREBOUND) + + continue; - if ((sp->name[0] == 'L') && (sp->tag == LABELID) && !savelabels) +++ if ((sp->s_name[0] == 'L') && (sp->s_tag == LABELID) && !savelabels) + + continue; + + symsout++; - fwrite(sp->name, NCPS, 1, f); - sp->type &= ~XFORW; - fwrite((sp->ptype) ? (char *)(&(sp->ptype)) : (char *)(&(sp->type)), - sizeof(char), 1, f); - /* - * WATCH OUT. THIS DEPENDS THAT THE ALLOCATION OF - * the four fields ptype, other, desc and value are - * contiguous. This may have to be changed! - * This is safe (as of 2-Nov-79). - */ - fwrite(&(sp->other), - sizeof (sp->other) - + sizeof (sp->desc) - + sizeof (sp->value), 1, f - ); - #ifdef fooie - #ifdef vax - fwrite(&(sp->name[0]), sizeof(symtab[0].name), 1, f); - fwrite(sp->ptype ? &(sp->ptype) : &(sp->type), - sizeof(symtab[0].type), 1, f); - fwrite(&(sp->other), sizeof(symtab[0].other), 1, f); - fwrite(&(sp->desc), sizeof(symtab[0].desc), 1, f); - fwrite(&(sp->value), sizeof(symtab[0].value), 1, f); - #else - writel(&(p->value), 1, f); - #endif +++ +++#ifdef FLEXNAMES +++ name = sp->s_name; /* save pointer */ +++ if ( (sp->s_index = strlen(sp->s_name)) != 0){ +++ sp->s_nmx = stroff; /* clobber pointer */ +++ stroff += sp->s_index + 1; +++ } else { +++ sp->s_nmx = 0; /* clobber pointer */ +++ } + +#endif +++ sp->s_type = (sp->s_ptype != 0) ? sp->s_ptype : (sp->s_type & (~XFORW)); +++ if (readonlydata && (sp->s_type&~N_EXT) == N_DATA) +++ sp->s_type = N_TEXT | (sp->s_type & N_EXT); +++ bwrite(&sp->s_nm, sizeof (struct nlist), symfile); +++#ifdef FLEXNAMES +++ sp->s_name = name; /* restore pointer */ +++#endif FLEXNAMES + + } + + if (symsout != symsdesired) + + yyerror("INTERNAL ERROR: Wrote %d symbols, wanted to write %d symbols\n", + + symsout, symsdesired); - } - - Flushfield(n) - register int n; - { - while (n>0) { - outb(bitfield); - bitfield >>= 8; - n -= 8; +++#ifdef FLEXNAMES +++ /* +++ * Pass 2 through the string pool +++ */ +++ symsout = 0; +++ bwrite(&stroff, sizeof (stroff), symfile); +++ stroff = sizeof (stroff); +++ symsout = 0; +++ DECLITERATE(allocwalk, sp, ub) +++ { +++ if (sp->s_tag >= IGNOREBOUND) +++ continue; +++ if ((sp->s_name[0] == 'L') && (sp->s_tag == LABELID) && !savelabels) +++ continue; +++ sp->s_index = strlen(sp->s_name); +++ if (sp->s_index) +++ bwrite(sp->s_name, sp->s_index + 1, symfile); + + } - bitoff=0; - bitfield=0; +++#endif FLEXNAMES + +} diff --cc usr/src/cmd/as/assyms.h index 0000000000,915fa652bd,0000000000..f4410c7e72 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/assyms.h +++ b/usr/src/cmd/as/assyms.h @@@@ -1,0 -1,67 -1,0 +1,99 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* "@(#)assyms.h 4.2 8/15/80" */ + +/* + + * To speed up walks through symbols defined in a particular + + * segment, we buil up a table of pointers into the symbol table + + * and a table of delimiters for each segment. The delimiter for + + * the particular segment points to the first word in that segment. + + */ + + - struct symtab **symptrs; /*dynamically allocated*/ - struct symtab **symdelim[NLOC + NLOC + 1]; - struct symtab *hshtab[NHASH]; - struct symtab **symptrub; - int nsyms; /*number in the symbol table*/ - int njxxx; /*the number of jxxx entries in the table*/ - int nforgotten; /*how many entries erroneously entered*/ - int nlabels; /*how many labels in the symbol table*/ - int hshused; /*how many hash slots used*/ +++extern struct symtab **symptrs; /*dynamically allocated*/ +++extern struct symtab **symdelim[NLOC + NLOC + 1]; +++extern struct symtab **symptrub; +++extern int nsyms; /*number in the symbol table*/ +++extern int njxxx; /*the number of jxxx entries in the table*/ +++extern int nforgotten; /*how many entries erroneously entered*/ +++extern int nlabels; /*how many labels in the symbol table*/ +++extern int hshused; /*how many hash slots used*/ + + + +#define SEGITERATE(segno, start, end, copointer, walkpointer, ubpointer, direction) \ + + for(copointer = start == 0? symdelim[segno]:start,\ + + ubpointer = end == 0 ? *symdelim[segno+1] : *(symdelim[segno]-1),\ + + walkpointer = *copointer;\ + + walkpointer != ubpointer;\ + + walkpointer = * direction copointer) + + + +#define SYMITERATE(copointer, walkpointer) \ + + for(copointer = symptrs, \ + + walkpointer = *copointer; \ + + copointer < symptrub; \ + + walkpointer = * ++ copointer) + +/* + + * Symbols are allocated in non contiguous chunks by extending + + * the data area. This way, it is extremely easy to + + * allow virtual memory temporary files, change the length + + * of NCPS, and allows for a much more flexible storage + + * allocation + + */ + + + +#define SYMDALLOP 200 + +struct allocbox{ + + struct allocbox *nextalloc; + + struct symtab symslots[SYMDALLOP]; - char symnames[SYMDALLOP * NCPS]; + +}; + + +++#ifdef FLEXNAMES +++/* +++ * Names are allocated in a string pool. String pools are linked +++ * together and are allocated dynamically by Calloc. +++ */ +++#define STRPOOLDALLOP NCPS +++struct strpool{ +++ struct strpool *str_next; +++ int str_nalloc; +++ char str_names[STRPOOLDALLOP]; +++}; +++ +++extern struct strpool *strplhead; +++#endif +++ + +extern struct allocbox *allochead; + +extern struct allocbox *alloctail; + +extern struct symtab *nextsym; + +extern struct allocbox *newbox; + +extern char *namebuffer; + +extern int symsleft; + + + +#define ALLOCQTY sizeof (struct allocbox) + +/* + + * Iterate through all symbols in the symbol table in declaration + + * order + + */ + +#define DECLITERATE(allocwalk, walkpointer, ubpointer) \ + + for(allocwalk = allochead; \ + + allocwalk != 0; \ + + allocwalk = allocwalk->nextalloc) \ + + for (walkpointer = &allocwalk->symslots[0],\ + + ubpointer = &allocwalk->symslots[SYMDALLOP], \ + + ubpointer = ubpointer > ( (struct symtab *)alloctail) \ + + ? nextsym : ubpointer ;\ + + walkpointer < ubpointer; \ + + walkpointer++ ) +++/* +++ * The hash table is segmented, and dynamically extendable. +++ * We have a linked list of hash table segments; within each +++ * segment we use a quadratic rehash that touches no more than 1/2 +++ * of the buckets in the hash table when probing. +++ * If the probe does not find the desired symbol, it moves to the +++ * next segment, or allocates a new segment. +++ * +++ * Hash table segments are kept on the linked list with the first +++ * segment always first (that contains the reserved words) and +++ * the last added segment immediately after the first segment +++ * to hopefully gain something by locality of reference. +++ */ +++struct hashdallop { +++ int h_nused; +++ struct hashdallop *h_next; +++ struct symtab *h_htab[NHASH]; +++}; diff --cc usr/src/cmd/as/astoks.h index 0000000000,aa5c086273,0000000000..c5d7e45959 mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/astoks.h +++ b/usr/src/cmd/as/astoks.h @@@@ -1,0 -1,107 -1,0 +1,112 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* "@(#)astoks.h 4.2 8/16/80" */ + +/* + + * Message to the wary: The order of tokens has been + + * hand optimized and assigned to that all switch statements + + * are implemented by a casel instruction on the VAX. + + * there are 4 switch statements that have to be worried about: + + * l) Per character switch in the character scanner (scan_dot_s) + + * 2) Per token switch in the buffer manager (yylex) + + * 3) Per keyword switch in the parser (yyparse) + + * 4) Leading token switch for argments to opcodes + + * + + * You can't just add new tokens willy-nilly; make sure that you + + * add them into the proper order! + + */ + +# define FIRSTTOKEN 0 + + + +/* + + * Tokens between ISPACE and INSTn are used by the per keyword switch + + */ + +# define ISPACE 1 + +# define IBYTE 2 + +# define IWORD 3 + +# define IINT 4 + +# define ILONG 5 + +# define IDATA 6 + +# define IGLOBAL 7 + +# define ISET 8 + +# define ITEXT 9 + +# define ICOMM 10 + +# define ILCOMM 11 + +# define IFLOAT 12 + +# define IDOUBLE 13 + +# define IORG 14 + +# define IASCII 15 + +# define IASCIZ 16 + +# define ILSYM 17 + +# define IFILE 18 + +# define ILINENO 19 + +# define IABORT 20 +++# define IFILL 21 +++# define IQUAD 22 + +/* + + * Tokens between ISTAB and REG are used in the per token switch + + */ + +# define ISTAB 23 + +# define ISTABSTR 24 + +# define ISTABNONE 25 + +# define ISTABDOT 26 + +# define IJXXX 27 + +# define IALIGN 28 + +# define INST0 29 + +# define INSTn 30 + + +++# define BFINT 31 + +# define PARSEEOF 32 + +# define ILINESKIP 33 + +# define VOID 34 + +# define SKIP 35 + +# define INT 36 + +# define FLTNUM 37 + +# define NAME 38 + +# define STRING 39 +++# define QUAD 40 + +/* + + * Tokens between SIZESPEC and REGOP are used in the instruction + + * argument switch + + */ + +# define SIZESPEC 41 + +# define REG 42 + +# define MUL 43 + +# define LITOP 44 + +# define LP 45 + +# define MP 46 + +/* + + * Tokens between REGOP and DIV are used in the per character switch + + */ + +# define NEEDSBUF 48 /*signal refilling the input buffer*/ + +# define REGOP 49 /*the percent sign*/ + +# define NL 50 + +# define SCANEOF 51 + +# define BADCHAR 52 + +# define SP 53 + +# define ALPH 54 + +# define DIG 55 + +# define SQ 56 + +# define DQ 57 + +# define SH 58 + +# define LSH 59 + +# define RSH 60 + +# define MINUS 61 + +# define SIZEQUOTE 62 + +/* + + * Tokens between XOR and RP are used at random (primarily by the + + * expression analyzer), and not used in any switch + + */ + +# define XOR 64 + +# define DIV 65 + + + +# define SEMI 66 + +# define COLON 67 + +# define PLUS 68 + +# define IOR 69 + +# define AND 70 + +# define TILDE 71 + +# define ORNOT 72 + +# define CM 73 + +# define LB 74 + +# define RB 75 + +# define RP 76 + + + +# define LASTTOKEN 80 diff --cc usr/src/cmd/as/instrs index 0000000000,c9854658e7,0000000000..95fdaeef3c mode 000000,100644,000000..100644 --- a/usr/src/cmd/as/instrs +++ b/usr/src/cmd/as/instrs @@@@ -1,0 -1,257 -1,0 +1,259 @@@@ - OP("acbb", 0x9d, 4, ACCR+TYPB, ACCR+TYPB, ACCM+TYPB, ACCB+TYPW,0,0), - OP("acbd", 0x6f, 4, ACCR+TYPD, ACCR+TYPD, ACCM+TYPD, ACCB+TYPW,0,0), - OP("acbf", 0x4f, 4, ACCR+TYPF, ACCR+TYPF, ACCM+TYPF, ACCB+TYPW,0,0), - OP("acbl", 0xf1, 4, ACCR+TYPL, ACCR+TYPL, ACCM+TYPL, ACCB+TYPW,0,0), - OP("acbw", 0x3d, 4, ACCR+TYPW, ACCR+TYPW, ACCM+TYPW, ACCB+TYPW,0,0), - OP("adawi", 0x58, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("addb2", 0x80, 2, ACCR+TYPB, ACCM+TYPB,0,0,0,0), - OP("addb3", 0x81, 3, ACCR+TYPB, ACCR+TYPB, ACCW+TYPB,0,0,0), - OP("addd2", 0x60, 2, ACCR+TYPD, ACCM+TYPD,0,0,0,0), - OP("addd3", 0x61, 3, ACCR+TYPD, ACCR+TYPD, ACCW+TYPD,0,0,0), - OP("addf2", 0x40, 2, ACCR+TYPF, ACCM+TYPF,0,0,0,0), - OP("addf3", 0x41, 3, ACCR+TYPF, ACCR+TYPF, ACCW+TYPF,0,0,0), - OP("addl2", 0xc0, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("addl3", 0xc1, 3, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("addp4", 0x20, 4, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0,0), - OP("addp6", 0x21, 6, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB), - OP("addw2", 0xa0, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("addw3", 0xa1, 3, ACCR+TYPW, ACCR+TYPW, ACCW+TYPW,0,0,0), - OP("adwc", 0xd8, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("aobleq", 0xf3, 3, ACCR+TYPL, ACCM+TYPL, ACCB+TYPB,0,0,0), - OP("aoblss", 0xf2, 3, ACCR+TYPL, ACCM+TYPL, ACCB+TYPB,0,0,0), - OP("ashl", 0x78, 3, ACCR+TYPB, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("ashp", 0xf8, 6, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB), - OP("ashq", 0x79, 3, ACCR+TYPB, ACCR+TYPQ, ACCW+TYPQ,0,0,0), - OP("bbc", 0xe1, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bbcc", 0xe5, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bbcci", 0xe7, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bbcs", 0xe3, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bbs", 0xe0, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bbsc", 0xe4, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bbss", 0xe2, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bbssi", 0xe6, 3, ACCR+TYPL, ACCR+TYPB, ACCB+TYPB,0,0,0), - OP("bcc", 0x1e, 1, ACCB+TYPB,0,0,0,0,0), - OP("bcs", 0x1f, 1, ACCB+TYPB,0,0,0,0,0), - OP("beql", 0x13, 1, ACCB+TYPB,0,0,0,0,0), - OP("beqlu", 0x13, 1, ACCB+TYPB,0,0,0,0,0), - OP("bgeq", 0x18, 1, ACCB+TYPB,0,0,0,0,0), - OP("bgequ", 0x1e, 1, ACCB+TYPB,0,0,0,0,0), - OP("bgtr", 0x14, 1, ACCB+TYPB,0,0,0,0,0), - OP("bgtru", 0x1a, 1, ACCB+TYPB,0,0,0,0,0), - OP("bicb2", 0x8a, 2, ACCR+TYPB, ACCM+TYPB,0,0,0,0), - OP("bicb3", 0x8b, 3, ACCR+TYPB, ACCR+TYPB, ACCW+TYPB,0,0,0), - OP("bicl2", 0xca, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("bicl3", 0xcb, 3, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("bicpsw", 0xb9, 1, ACCR+TYPW,0,0,0,0,0), - OP("bicw2", 0xaa, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("bicw3", 0xab, 3, ACCR+TYPW, ACCR+TYPW, ACCW+TYPW,0,0,0), - OP("bisb2", 0x88, 2, ACCR+TYPB, ACCM+TYPB,0,0,0,0), - OP("bisb3", 0x89, 3, ACCR+TYPB, ACCR+TYPB, ACCW+TYPB,0,0,0), - OP("bisl2", 0xc8, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("bisl3", 0xc9, 3, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("bispsw", 0xb8, 1, ACCR+TYPW,0,0,0,0,0), - OP("bisw2", 0xa8, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("bisw3", 0xa9, 3, ACCR+TYPW, ACCR+TYPW, ACCW+TYPW,0,0,0), - OP("bitb", 0x93, 2, ACCR+TYPB, ACCR+TYPB,0,0,0,0), - OP("bitl", 0xd3, 2, ACCR+TYPL, ACCR+TYPL,0,0,0,0), - OP("bitw", 0xb3, 2, ACCR+TYPW, ACCR+TYPW,0,0,0,0), - OP("blbs", 0xe8, 2, ACCR+TYPL, ACCB+TYPB,0,0,0,0), - OP("blbc", 0xe9, 2, ACCR+TYPL, ACCB+TYPB,0,0,0,0), - OP("bleq", 0x15, 1, ACCB+TYPB,0,0,0,0,0), - OP("blequ", 0x1b, 1, ACCB+TYPB,0,0,0,0,0), - OP("blss", 0x19, 1, ACCB+TYPB,0,0,0,0,0), - OP("blssu", 0x1f, 1, ACCB+TYPB,0,0,0,0,0), - OP("bneq", 0x12, 1, ACCB+TYPB,0,0,0,0,0), - OP("bnequ", 0x12, 1, ACCB+TYPB,0,0,0,0,0), - OP("bpt", 0x03,0,0,0,0,0,0,0), - OP("brb", 0x11, 1, ACCB+TYPB,0,0,0,0,0), - OP("brw", 0x31, 1, ACCB+TYPW,0,0,0,0,0), - OP("bsbb", 0x10, 1, ACCB+TYPB,0,0,0,0,0), - OP("bsbw", 0x30, 1, ACCB+TYPW,0,0,0,0,0), - OP("bvc", 0x1c, 1, ACCB+TYPB,0,0,0,0,0), - OP("bvs", 0x1d, 1, ACCB+TYPB,0,0,0,0,0), - OP("callg", 0xfa, 2, ACCA+TYPB, ACCA+TYPB,0,0,0,0), - OP("calls", 0xfb, 2, ACCR+TYPL, ACCA+TYPB,0,0,0,0), - OP("caseb", 0x8f, 3, ACCR+TYPB, ACCR+TYPB, ACCR+TYPB,0,0,0), - OP("casel", 0xcf, 3, ACCR+TYPL, ACCR+TYPL, ACCR+TYPL,0,0,0), - OP("casew", 0xaf, 3, ACCR+TYPW, ACCR+TYPW, ACCR+TYPW,0,0,0), - OP("chme", 0xbd, 1, ACCR+TYPW,0,0,0,0,0), - OP("chmk", 0xbc, 1, ACCR+TYPW,0,0,0,0,0), - OP("chms", 0xbe, 1, ACCR+TYPW,0,0,0,0,0), - OP("chmu", 0xbf, 1, ACCR+TYPW,0,0,0,0,0), - OP("clrb", 0x94, 1, ACCW+TYPB,0,0,0,0,0), - OP("clrd", 0x7c, 1, ACCW+TYPD,0,0,0,0,0), - OP("clrf", 0xd4, 1, ACCW+TYPF,0,0,0,0,0), - OP("clrl", 0xd4, 1, ACCW+TYPL,0,0,0,0,0), - OP("clrq", 0x7c, 1, ACCW+TYPQ,0,0,0,0,0), - OP("clrw", 0xb4, 1, ACCW+TYPW,0,0,0,0,0), - OP("cmpb", 0x91, 2, ACCR+TYPB, ACCR+TYPB,0,0,0,0), - OP("cmpc3", 0x29, 3, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB,0,0,0), - OP("cmpc5", 0x2d, 5, ACCR+TYPW, ACCA+TYPB, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB,0), - OP("cmpd", 0x71, 2, ACCR+TYPD, ACCR+TYPD,0,0,0,0), - OP("cmpf", 0x51, 2, ACCR+TYPF, ACCR+TYPF,0,0,0,0), - OP("cmpl", 0xd1, 2, ACCR+TYPL, ACCR+TYPL,0,0,0,0), - OP("cmpp3", 0x35, 3, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB,0,0,0), - OP("cmpp4", 0x37, 4, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0,0), - OP("cmpv", 0xec, 4, ACCR+TYPL, ACCR+TYPB, ACCR+TYPB, ACCR+TYPL,0,0), - OP("cmpw", 0xb1, 2, ACCR+TYPW, ACCR+TYPW,0,0,0,0), - OP("cmpzv", 0xed, 4, ACCR+TYPL, ACCR+TYPB, ACCR+TYPB, ACCR+TYPL,0,0), - OP("crc", 0x0b, 4, ACCA+TYPB, ACCR+TYPL, ACCR+TYPW, ACCA+TYPB,0,0), - OP("cvtbd", 0x6c, 2, ACCR+TYPB, ACCW+TYPD,0,0,0,0), - OP("cvtbf", 0x4c, 2, ACCR+TYPB, ACCW+TYPB,0,0,0,0), - OP("cvtbl", 0x98, 2, ACCR+TYPB, ACCW+TYPL,0,0,0,0), - OP("cvtbw", 0x99, 2, ACCR+TYPB, ACCW+TYPW,0,0,0,0), - OP("cvtdb", 0x68, 2, ACCR+TYPD, ACCW+TYPB,0,0,0,0), - OP("cvtdf", 0x76, 2, ACCR+TYPD, ACCW+TYPF,0,0,0,0), - OP("cvtdl", 0x6a, 2, ACCR+TYPD, ACCW+TYPL,0,0,0,0), - OP("cvtdw", 0x69, 2, ACCR+TYPD, ACCW+TYPW,0,0,0,0), - OP("cvtfb", 0x48, 2, ACCR+TYPF, ACCW+TYPB,0,0,0,0), - OP("cvtfd", 0x56, 2, ACCR+TYPF, ACCW+TYPD,0,0,0,0), - OP("cvtfl", 0x4a, 2, ACCR+TYPF, ACCW+TYPL,0,0,0,0), - OP("cvtfw", 0x49, 2, ACCR+TYPF, ACCW+TYPW,0,0,0,0), - OP("cvtlb", 0xf6, 2, ACCR+TYPL, ACCW+TYPB,0,0,0,0), - OP("cvtld", 0x6e, 2, ACCR+TYPL, ACCW+TYPD,0,0,0,0), - OP("cvtlf", 0x4e, 2, ACCR+TYPL, ACCW+TYPF,0,0,0,0), - OP("cvtlp", 0xf9, 3, ACCR+TYPL, ACCR+TYPW, ACCA+TYPB,0,0,0), - OP("cvtlw", 0xf7, 2, ACCR+TYPL, ACCW+TYPW,0,0,0,0), - OP("cvtpl", 0x36, 3, ACCR+TYPW, ACCA+TYPB, ACCW+TYPL,0,0,0), - OP("cvttp", 0x26, 5, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0), - OP("cvtpt", 0x24, 5, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0), - OP("cvtps", 0x08, 4, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0,0), - OP("cvtrdl", 0x6b, 2, ACCR+TYPD, ACCW+TYPL,0,0,0,0), - OP("cvtrfl", 0x4b, 2, ACCR+TYPF, ACCW+TYPL,0,0,0,0), - OP("cvtsp", 0x09, 4, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0,0), - OP("cvtwb", 0x33, 2, ACCR+TYPW, ACCW+TYPB,0,0,0,0), - OP("cvtwd", 0x6d, 2, ACCR+TYPW, ACCW+TYPD,0,0,0,0), - OP("cvtwf", 0x4d, 2, ACCR+TYPW, ACCW+TYPF,0,0,0,0), - OP("cvtwl", 0x32, 2, ACCR+TYPW, ACCW+TYPL,0,0,0,0), - OP("decb", 0x97, 1, ACCM+TYPB,0,0,0,0,0), - OP("decl", 0xd7, 1, ACCM+TYPL,0,0,0,0,0), - OP("decw", 0xb7, 1, ACCM+TYPW,0,0,0,0,0), - OP("divb2", 0x86, 2, ACCR+TYPB, ACCM+TYPB,0,0,0,0), - OP("divb3", 0x87, 3, ACCR+TYPB, ACCR+TYPB, ACCW+TYPB,0,0,0), - OP("divd2", 0x66, 2, ACCR+TYPD, ACCM+TYPD,0,0,0,0), - OP("divd3", 0x67, 3, ACCR+TYPD, ACCR+TYPD, ACCR+TYPD,0,0,0), - OP("divf2", 0x46, 2, ACCR+TYPF, ACCM+TYPF,0,0,0,0), - OP("divf3", 0x47, 3, ACCR+TYPF, ACCR+TYPF, ACCW+TYPF,0,0,0), - OP("divl2", 0xc6, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("divl3", 0xc7, 3, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("divp", 0x27, 6, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB), - OP("divw2", 0xa6, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("divw3", 0xa7, 3, ACCR+TYPW, ACCR+TYPW, ACCW+TYPW,0,0,0), - OP("editpc", 0x38, 4, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB, ACCA+TYPB,0,0), - OP("ediv", 0x7b, 4, ACCR+TYPL, ACCR+TYPQ, ACCW+TYPL, ACCW+TYPL,0,0), - OP("emodd", 0x74, 5, ACCR+TYPD, ACCR+TYPB, ACCR+TYPD, ACCW+TYPL, ACCW+TYPD,0), - OP("emodf", 0x54, 5, ACCR+TYPF, ACCR+TYPB, ACCR+TYPF, ACCW+TYPL, ACCW+TYPF,0), - OP("emul", 0x7a, 4, ACCR+TYPL, ACCR+TYPL, ACCR+TYPL, ACCW+TYPQ,0,0), - OP("extv", 0xee, 4, ACCR+TYPL, ACCR+TYPB, ACCR+TYPB, ACCW+TYPL,0,0), - OP("extzv", 0xef, 4, ACCR+TYPL, ACCR+TYPB, ACCR+TYPB, ACCW+TYPL,0,0), - OP("ffc", 0xeb, 4, ACCR+TYPL, ACCR+TYPB, ACCR+TYPB, ACCW+TYPL,0,0), - OP("ffs", 0xea, 4, ACCR+TYPL, ACCR+TYPB, ACCR+TYPB, ACCW+TYPL,0,0), - OP("halt", 0x00,0,0,0,0,0,0,0), - OP("incb", 0x96, 1, ACCM+TYPB,0,0,0,0,0), - OP("incl", 0xd6, 1, ACCM+TYPL,0,0,0,0,0), - OP("incw", 0xb6, 1, ACCM+TYPW,0,0,0,0,0), - OP("index", 0x0a, 6, ACCR+TYPL, ACCR+TYPL, ACCR+TYPL, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL), - OP("insque", 0x0e, 2, ACCA+TYPB, ACCA+TYPB,0,0,0,0), - OP("insv", 0xf0, 4, ACCR+TYPL, ACCR+TYPL, ACCR+TYPB, ACCW+TYPB,0,0), - OP("jmp", 0x17, 1, ACCA+TYPB,0,0,0,0,0), - OP("jsb", 0x16, 1, ACCA+TYPB,0,0,0,0,0), - OP("ldpctx", 0x06,0,0,0,0,0,0,0), - OP("locc", 0x3a, 3, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB,0,0,0), - OP("matchc", 0x39, 4, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0,0), - OP("mcomb", 0x92, 2, ACCR+TYPB, ACCW+TYPB,0,0,0,0), - OP("mcoml", 0xd2, 2, ACCR+TYPL, ACCW+TYPL,0,0,0,0), - OP("mcomw", 0xb2, 2, ACCR+TYPW, ACCW+TYPW,0,0,0,0), - OP("mfpr", 0xdb, 2, ACCR+TYPL, ACCW+TYPL,0,0,0,0), - OP("mnegb", 0x8e, 2, ACCR+TYPB, ACCW+TYPB,0,0,0,0), - OP("mnegd", 0x72, 2, ACCR+TYPD, ACCW+TYPD,0,0,0,0), - OP("mnegf", 0x52, 2, ACCR+TYPF, ACCW+TYPF,0,0,0,0), - OP("mnegl", 0xce, 2, ACCR+TYPL, ACCW+TYPL,0,0,0,0), - OP("mnegw", 0xae, 2, ACCR+TYPW, ACCW+TYPL,0,0,0,0), - OP("movab", 0x9e, 2, ACCA+TYPB, ACCW+TYPL,0,0,0,0), - OP("movad", 0x7e, 2, ACCA+TYPD, ACCW+TYPL,0,0,0,0), - OP("movaf", 0xde, 2, ACCA+TYPF, ACCW+TYPL,0,0,0,0), - OP("moval", 0xde, 2, ACCA+TYPL, ACCW+TYPL,0,0,0,0), - OP("movaq", 0x7e, 2, ACCA+TYPQ, ACCW+TYPL,0,0,0,0), - OP("movaw", 0x3e, 2, ACCA+TYPW, ACCW+TYPL,0,0,0,0), - OP("movb", 0x90, 2, ACCR+TYPB, ACCW+TYPB,0,0,0,0), - OP("movc3", 0x28, 3, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB,0,0,0), - OP("movc5", 0x2c, 5, ACCR+TYPW, ACCA+TYPB, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB,0), - OP("movd", 0x70, 2, ACCR+TYPD, ACCW+TYPD,0,0,0,0), - OP("movf", 0x50, 2, ACCR+TYPF, ACCW+TYPF,0,0,0,0), - OP("movl", 0xd0, 2, ACCR+TYPL, ACCW+TYPL,0,0,0,0), - OP("movp", 0x34, 3, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB,0,0,0), - OP("movpsl", 0xdc, 1, ACCW+TYPL,0,0,0,0,0), - OP("movq", 0x7d, 2, ACCR+TYPQ, ACCW+TYPQ,0,0,0,0), - OP("movtc", 0x2e, 6, ACCR+TYPW, ACCA+TYPB, ACCR+TYPB, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB), - OP("movtuc", 0x2f, 6, ACCR+TYPW, ACCA+TYPB, ACCR+TYPB, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB), - OP("movw", 0xb0, 2, ACCR+TYPW, ACCW+TYPW,0,0,0,0), - OP("movzbl", 0x9a, 2, ACCR+TYPB, ACCW+TYPL,0,0,0,0), - OP("movzbw", 0x9b, 2, ACCR+TYPB, ACCW+TYPW,0,0,0,0), - OP("movzwl", 0x3c, 2, ACCR+TYPW, ACCW+TYPL,0,0,0,0), - OP("mtpr", 0xda, 2, ACCR+TYPL, ACCR+TYPL,0,0,0,0), - OP("mulb2", 0x84, 2, ACCR+TYPB, ACCM+TYPB,0,0,0,0), - OP("mulb3", 0x85, 3, ACCR+TYPB, ACCR+TYPB, ACCW+TYPB,0,0,0), - OP("muld2", 0x64, 2, ACCR+TYPD, ACCM+TYPD,0,0,0,0), - OP("muld3", 0x65, 3, ACCR+TYPD, ACCR+TYPD, ACCW+TYPD,0,0,0), - OP("mulf2", 0x44, 2, ACCR+TYPF, ACCM+TYPF,0,0,0,0), - OP("mulf3", 0x45, 3, ACCR+TYPF, ACCR+TYPF, ACCW+TYPF,0,0,0), - OP("mull2", 0xc4, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("mull3", 0xc5, 3, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("mulp", 0x25, 6, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB), - OP("mulw2", 0xa4, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("mulw3", 0xa5, 3, ACCR+TYPW, ACCR+TYPW, ACCW+TYPW,0,0,0), - OP("nop", 0x01,0,0,0,0,0,0,0), - OP("polyd", 0x75, 3, ACCR+TYPD, ACCR+TYPW, ACCA+TYPB,0,0,0), - OP("polyf", 0x55, 3, ACCR+TYPF, ACCR+TYPW, ACCA+TYPB,0,0,0), - OP("popr", 0xba, 1, ACCR+TYPW,0,0,0,0,0), - OP("prober", 0x0c, 3, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB,0,0,0), - OP("probew", 0x0d, 3, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB,0,0,0), - OP("pushab", 0x9f, 1, ACCA+TYPB,0,0,0,0,0), - OP("pushad", 0x7f, 1, ACCA+TYPD,0,0,0,0,0), - OP("pushaf", 0xdf, 1, ACCA+TYPF,0,0,0,0,0), - OP("pushal", 0xdf, 1, ACCA+TYPL,0,0,0,0,0), - OP("pushaq", 0x7f, 1, ACCA+TYPQ,0,0,0,0,0), - OP("pushaw", 0x3f, 1, ACCA+TYPW,0,0,0,0,0), - OP("pushl", 0xdd, 1, ACCR+TYPL,0,0,0,0,0), - OP("pushr", 0xbb, 1, ACCR+TYPW,0,0,0,0,0), - OP("rei", 0x02,0,0,0,0,0,0,0), - OP("remque", 0x0f, 2, ACCA+TYPB, ACCW+TYPL,0,0,0,0), - OP("ret", 0x04,0,0,0,0,0,0,0), - OP("rotl", 0x9c, 3, ACCR+TYPB, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("rsb", 0x05,0,0,0,0,0,0,0), - OP("sbwc", 0xd9, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("scanc", 0x2a, 4, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB, ACCR+TYPB,0,0), - OP("skpc", 0x3b, 3, ACCR+TYPB, ACCR+TYPW, ACCA+TYPB,0,0,0), - OP("sobgeq", 0xf4, 2, ACCM+TYPL, ACCB+TYPB,0,0,0,0), - OP("sobgtr", 0xf5, 2, ACCM+TYPL, ACCB+TYPB,0,0,0,0), - OP("spanc", 0x2b, 4, ACCR+TYPW, ACCA+TYPB, ACCA+TYPB, ACCR+TYPB,0,0), - OP("subb2", 0x82, 2, ACCR+TYPB, ACCM+TYPB,0,0,0,0), - OP("subb3", 0x83, 3, ACCR+TYPB, ACCR+TYPB, ACCW+TYPB,0,0,0), - OP("subd2", 0x62, 2, ACCR+TYPD, ACCM+TYPD,0,0,0,0), - OP("subd3", 0x63, 3, ACCR+TYPD, ACCR+TYPD, ACCW+TYPD,0,0,0), - OP("subf2", 0x42, 2, ACCR+TYPF, ACCM+TYPF,0,0,0,0), - OP("subf3", 0x43, 3, ACCR+TYPF, ACCR+TYPF, ACCW+TYPF,0,0,0), - OP("subl2", 0xc2, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("subl3", 0xc3, 3, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("subp4", 0x22, 4, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB,0,0), - OP("subp6", 0x23, 6, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB, ACCR+TYPW, ACCA+TYPB), - OP("subw2", 0xa2, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("subw3", 0xa3, 3, ACCR+TYPW, ACCR+TYPW, ACCW+TYPW,0,0,0), - OP("svpctx", 0x07,0,0,0,0,0,0,0), - OP("tstb", 0x95, 1, ACCR+TYPB,0,0,0,0,0), - OP("tstd", 0x73, 1, ACCR+TYPD,0,0,0,0,0), - OP("tstf", 0x53, 1, ACCR+TYPF,0,0,0,0,0), - OP("tstl", 0xd5, 1, ACCR+TYPL,0,0,0,0,0), - OP("tstw", 0xb5, 1, ACCR+TYPW,0,0,0,0,0), - OP("xfc", 0xfc, 1, ACCI+TYPB,0,0,0,0,0), - OP("xorb2", 0x8c, 2, ACCR+TYPB, ACCM+TYPB,0,0,0,0), - OP("xorb3", 0x8d, 3, ACCR+TYPB, ACCR+TYPB, ACCW+TYPB,0,0,0), - OP("xorl2", 0xcc, 2, ACCR+TYPL, ACCM+TYPL,0,0,0,0), - OP("xorl3", 0xcd, 3, ACCR+TYPL, ACCR+TYPL, ACCW+TYPL,0,0,0), - OP("xorw2", 0xac, 2, ACCR+TYPW, ACCM+TYPW,0,0,0,0), - OP("xorw3", 0xad, 3, ACCR+TYPW, ACCR+TYPW, ACCW+TYPW,0,0,0), - OP("escd", 0xfd,0,0,0,0,0,0,0), - OP("esce", 0xfe,0,0,0,0,0,0,0), - OP("escf", 0xff,0,0,0,0,0,0,0), +++/* Copyright(c) 1980 Regents of the University of California */ +++/* "@(#)instrs 4.1 8/16/80" */ +++OP("acbb",0x9d,4,ACCR+TYPB,ACCR+TYPB,ACCM+TYPB,ACCB+TYPW,0,0), +++OP("acbd",0x6f,4,ACCR+TYPD,ACCR+TYPD,ACCM+TYPD,ACCB+TYPW,0,0), +++OP("acbf",0x4f,4,ACCR+TYPF,ACCR+TYPF,ACCM+TYPF,ACCB+TYPW,0,0), +++OP("acbl",0xf1,4,ACCR+TYPL,ACCR+TYPL,ACCM+TYPL,ACCB+TYPW,0,0), +++OP("acbw",0x3d,4,ACCR+TYPW,ACCR+TYPW,ACCM+TYPW,ACCB+TYPW,0,0), +++OP("adawi",0x58,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("addb2",0x80,2,ACCR+TYPB,ACCM+TYPB,0,0,0,0), +++OP("addb3",0x81,3,ACCR+TYPB,ACCR+TYPB,ACCW+TYPB,0,0,0), +++OP("addd2",0x60,2,ACCR+TYPD,ACCM+TYPD,0,0,0,0), +++OP("addd3",0x61,3,ACCR+TYPD,ACCR+TYPD,ACCW+TYPD,0,0,0), +++OP("addf2",0x40,2,ACCR+TYPF,ACCM+TYPF,0,0,0,0), +++OP("addf3",0x41,3,ACCR+TYPF,ACCR+TYPF,ACCW+TYPF,0,0,0), +++OP("addl2",0xc0,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("addl3",0xc1,3,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("addp4",0x20,4,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0,0), +++OP("addp6",0x21,6,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB), +++OP("addw2",0xa0,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("addw3",0xa1,3,ACCR+TYPW,ACCR+TYPW,ACCW+TYPW,0,0,0), +++OP("adwc",0xd8,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("aobleq",0xf3,3,ACCR+TYPL,ACCM+TYPL,ACCB+TYPB,0,0,0), +++OP("aoblss",0xf2,3,ACCR+TYPL,ACCM+TYPL,ACCB+TYPB,0,0,0), +++OP("ashl",0x78,3,ACCR+TYPB,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("ashp",0xf8,6,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB), +++OP("ashq",0x79,3,ACCR+TYPB,ACCR+TYPQ,ACCW+TYPQ,0,0,0), +++OP("bbc",0xe1,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bbcc",0xe5,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bbcci",0xe7,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bbcs",0xe3,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bbs",0xe0,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bbsc",0xe4,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bbss",0xe2,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bbssi",0xe6,3,ACCR+TYPL,ACCR+TYPB,ACCB+TYPB,0,0,0), +++OP("bcc",0x1e,1,ACCB+TYPB,0,0,0,0,0), +++OP("bcs",0x1f,1,ACCB+TYPB,0,0,0,0,0), +++OP("beql",0x13,1,ACCB+TYPB,0,0,0,0,0), +++OP("beqlu",0x13,1,ACCB+TYPB,0,0,0,0,0), +++OP("bgeq",0x18,1,ACCB+TYPB,0,0,0,0,0), +++OP("bgequ",0x1e,1,ACCB+TYPB,0,0,0,0,0), +++OP("bgtr",0x14,1,ACCB+TYPB,0,0,0,0,0), +++OP("bgtru",0x1a,1,ACCB+TYPB,0,0,0,0,0), +++OP("bicb2",0x8a,2,ACCR+TYPB,ACCM+TYPB,0,0,0,0), +++OP("bicb3",0x8b,3,ACCR+TYPB,ACCR+TYPB,ACCW+TYPB,0,0,0), +++OP("bicl2",0xca,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("bicl3",0xcb,3,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("bicpsw",0xb9,1,ACCR+TYPW,0,0,0,0,0), +++OP("bicw2",0xaa,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("bicw3",0xab,3,ACCR+TYPW,ACCR+TYPW,ACCW+TYPW,0,0,0), +++OP("bisb2",0x88,2,ACCR+TYPB,ACCM+TYPB,0,0,0,0), +++OP("bisb3",0x89,3,ACCR+TYPB,ACCR+TYPB,ACCW+TYPB,0,0,0), +++OP("bisl2",0xc8,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("bisl3",0xc9,3,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("bispsw",0xb8,1,ACCR+TYPW,0,0,0,0,0), +++OP("bisw2",0xa8,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("bisw3",0xa9,3,ACCR+TYPW,ACCR+TYPW,ACCW+TYPW,0,0,0), +++OP("bitb",0x93,2,ACCR+TYPB,ACCR+TYPB,0,0,0,0), +++OP("bitl",0xd3,2,ACCR+TYPL,ACCR+TYPL,0,0,0,0), +++OP("bitw",0xb3,2,ACCR+TYPW,ACCR+TYPW,0,0,0,0), +++OP("blbs",0xe8,2,ACCR+TYPL,ACCB+TYPB,0,0,0,0), +++OP("blbc",0xe9,2,ACCR+TYPL,ACCB+TYPB,0,0,0,0), +++OP("bleq",0x15,1,ACCB+TYPB,0,0,0,0,0), +++OP("blequ",0x1b,1,ACCB+TYPB,0,0,0,0,0), +++OP("blss",0x19,1,ACCB+TYPB,0,0,0,0,0), +++OP("blssu",0x1f,1,ACCB+TYPB,0,0,0,0,0), +++OP("bneq",0x12,1,ACCB+TYPB,0,0,0,0,0), +++OP("bnequ",0x12,1,ACCB+TYPB,0,0,0,0,0), +++OP("bpt",0x03,0,0,0,0,0,0,0), +++OP("brb",0x11,1,ACCB+TYPB,0,0,0,0,0), +++OP("brw",0x31,1,ACCB+TYPW,0,0,0,0,0), +++OP("bsbb",0x10,1,ACCB+TYPB,0,0,0,0,0), +++OP("bsbw",0x30,1,ACCB+TYPW,0,0,0,0,0), +++OP("bvc",0x1c,1,ACCB+TYPB,0,0,0,0,0), +++OP("bvs",0x1d,1,ACCB+TYPB,0,0,0,0,0), +++OP("callg",0xfa,2,ACCA+TYPB,ACCA+TYPB,0,0,0,0), +++OP("calls",0xfb,2,ACCR+TYPL,ACCA+TYPB,0,0,0,0), +++OP("caseb",0x8f,3,ACCR+TYPB,ACCR+TYPB,ACCR+TYPB,0,0,0), +++OP("casel",0xcf,3,ACCR+TYPL,ACCR+TYPL,ACCR+TYPL,0,0,0), +++OP("casew",0xaf,3,ACCR+TYPW,ACCR+TYPW,ACCR+TYPW,0,0,0), +++OP("chme",0xbd,1,ACCR+TYPW,0,0,0,0,0), +++OP("chmk",0xbc,1,ACCR+TYPW,0,0,0,0,0), +++OP("chms",0xbe,1,ACCR+TYPW,0,0,0,0,0), +++OP("chmu",0xbf,1,ACCR+TYPW,0,0,0,0,0), +++OP("clrb",0x94,1,ACCW+TYPB,0,0,0,0,0), +++OP("clrd",0x7c,1,ACCW+TYPD,0,0,0,0,0), +++OP("clrf",0xd4,1,ACCW+TYPF,0,0,0,0,0), +++OP("clrl",0xd4,1,ACCW+TYPL,0,0,0,0,0), +++OP("clrq",0x7c,1,ACCW+TYPQ,0,0,0,0,0), +++OP("clrw",0xb4,1,ACCW+TYPW,0,0,0,0,0), +++OP("cmpb",0x91,2,ACCR+TYPB,ACCR+TYPB,0,0,0,0), +++OP("cmpc3",0x29,3,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,0,0,0), +++OP("cmpc5",0x2d,5,ACCR+TYPW,ACCA+TYPB,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB,0), +++OP("cmpd",0x71,2,ACCR+TYPD,ACCR+TYPD,0,0,0,0), +++OP("cmpf",0x51,2,ACCR+TYPF,ACCR+TYPF,0,0,0,0), +++OP("cmpl",0xd1,2,ACCR+TYPL,ACCR+TYPL,0,0,0,0), +++OP("cmpp3",0x35,3,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,0,0,0), +++OP("cmpp4",0x37,4,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0,0), +++OP("cmpv",0xec,4,ACCR+TYPL,ACCR+TYPB,ACCR+TYPB,ACCR+TYPL,0,0), +++OP("cmpw",0xb1,2,ACCR+TYPW,ACCR+TYPW,0,0,0,0), +++OP("cmpzv",0xed,4,ACCR+TYPL,ACCR+TYPB,ACCR+TYPB,ACCR+TYPL,0,0), +++OP("crc",0x0b,4,ACCA+TYPB,ACCR+TYPL,ACCR+TYPW,ACCA+TYPB,0,0), +++OP("cvtbd",0x6c,2,ACCR+TYPB,ACCW+TYPD,0,0,0,0), +++OP("cvtbf",0x4c,2,ACCR+TYPB,ACCW+TYPB,0,0,0,0), +++OP("cvtbl",0x98,2,ACCR+TYPB,ACCW+TYPL,0,0,0,0), +++OP("cvtbw",0x99,2,ACCR+TYPB,ACCW+TYPW,0,0,0,0), +++OP("cvtdb",0x68,2,ACCR+TYPD,ACCW+TYPB,0,0,0,0), +++OP("cvtdf",0x76,2,ACCR+TYPD,ACCW+TYPF,0,0,0,0), +++OP("cvtdl",0x6a,2,ACCR+TYPD,ACCW+TYPL,0,0,0,0), +++OP("cvtdw",0x69,2,ACCR+TYPD,ACCW+TYPW,0,0,0,0), +++OP("cvtfb",0x48,2,ACCR+TYPF,ACCW+TYPB,0,0,0,0), +++OP("cvtfd",0x56,2,ACCR+TYPF,ACCW+TYPD,0,0,0,0), +++OP("cvtfl",0x4a,2,ACCR+TYPF,ACCW+TYPL,0,0,0,0), +++OP("cvtfw",0x49,2,ACCR+TYPF,ACCW+TYPW,0,0,0,0), +++OP("cvtlb",0xf6,2,ACCR+TYPL,ACCW+TYPB,0,0,0,0), +++OP("cvtld",0x6e,2,ACCR+TYPL,ACCW+TYPD,0,0,0,0), +++OP("cvtlf",0x4e,2,ACCR+TYPL,ACCW+TYPF,0,0,0,0), +++OP("cvtlp",0xf9,3,ACCR+TYPL,ACCR+TYPW,ACCA+TYPB,0,0,0), +++OP("cvtlw",0xf7,2,ACCR+TYPL,ACCW+TYPW,0,0,0,0), +++OP("cvtpl",0x36,3,ACCR+TYPW,ACCA+TYPB,ACCW+TYPL,0,0,0), +++OP("cvttp",0x26,5,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0), +++OP("cvtpt",0x24,5,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0), +++OP("cvtps",0x08,4,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0,0), +++OP("cvtrdl",0x6b,2,ACCR+TYPD,ACCW+TYPL,0,0,0,0), +++OP("cvtrfl",0x4b,2,ACCR+TYPF,ACCW+TYPL,0,0,0,0), +++OP("cvtsp",0x09,4,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0,0), +++OP("cvtwb",0x33,2,ACCR+TYPW,ACCW+TYPB,0,0,0,0), +++OP("cvtwd",0x6d,2,ACCR+TYPW,ACCW+TYPD,0,0,0,0), +++OP("cvtwf",0x4d,2,ACCR+TYPW,ACCW+TYPF,0,0,0,0), +++OP("cvtwl",0x32,2,ACCR+TYPW,ACCW+TYPL,0,0,0,0), +++OP("decb",0x97,1,ACCM+TYPB,0,0,0,0,0), +++OP("decl",0xd7,1,ACCM+TYPL,0,0,0,0,0), +++OP("decw",0xb7,1,ACCM+TYPW,0,0,0,0,0), +++OP("divb2",0x86,2,ACCR+TYPB,ACCM+TYPB,0,0,0,0), +++OP("divb3",0x87,3,ACCR+TYPB,ACCR+TYPB,ACCW+TYPB,0,0,0), +++OP("divd2",0x66,2,ACCR+TYPD,ACCM+TYPD,0,0,0,0), +++OP("divd3",0x67,3,ACCR+TYPD,ACCR+TYPD,ACCR+TYPD,0,0,0), +++OP("divf2",0x46,2,ACCR+TYPF,ACCM+TYPF,0,0,0,0), +++OP("divf3",0x47,3,ACCR+TYPF,ACCR+TYPF,ACCW+TYPF,0,0,0), +++OP("divl2",0xc6,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("divl3",0xc7,3,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("divp",0x27,6,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB), +++OP("divw2",0xa6,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("divw3",0xa7,3,ACCR+TYPW,ACCR+TYPW,ACCW+TYPW,0,0,0), +++OP("editpc",0x38,4,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,ACCA+TYPB,0,0), +++OP("ediv",0x7b,4,ACCR+TYPL,ACCR+TYPQ,ACCW+TYPL,ACCW+TYPL,0,0), +++OP("emodd",0x74,5,ACCR+TYPD,ACCR+TYPB,ACCR+TYPD,ACCW+TYPL,ACCW+TYPD,0), +++OP("emodf",0x54,5,ACCR+TYPF,ACCR+TYPB,ACCR+TYPF,ACCW+TYPL,ACCW+TYPF,0), +++OP("emul",0x7a,4,ACCR+TYPL,ACCR+TYPL,ACCR+TYPL,ACCW+TYPQ,0,0), +++OP("extv",0xee,4,ACCR+TYPL,ACCR+TYPB,ACCR+TYPB,ACCW+TYPL,0,0), +++OP("extzv",0xef,4,ACCR+TYPL,ACCR+TYPB,ACCR+TYPB,ACCW+TYPL,0,0), +++OP("ffc",0xeb,4,ACCR+TYPL,ACCR+TYPB,ACCR+TYPB,ACCW+TYPL,0,0), +++OP("ffs",0xea,4,ACCR+TYPL,ACCR+TYPB,ACCR+TYPB,ACCW+TYPL,0,0), +++OP("halt",0x00,0,0,0,0,0,0,0), +++OP("incb",0x96,1,ACCM+TYPB,0,0,0,0,0), +++OP("incl",0xd6,1,ACCM+TYPL,0,0,0,0,0), +++OP("incw",0xb6,1,ACCM+TYPW,0,0,0,0,0), +++OP("index",0x0a,6,ACCR+TYPL,ACCR+TYPL,ACCR+TYPL,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL), +++OP("insque",0x0e,2,ACCA+TYPB,ACCA+TYPB,0,0,0,0), +++OP("insv",0xf0,4,ACCR+TYPL,ACCR+TYPL,ACCR+TYPB,ACCW+TYPB,0,0), +++OP("jmp",0x17,1,ACCA+TYPB,0,0,0,0,0), +++OP("jsb",0x16,1,ACCA+TYPB,0,0,0,0,0), +++OP("ldpctx",0x06,0,0,0,0,0,0,0), +++OP("locc",0x3a,3,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB,0,0,0), +++OP("matchc",0x39,4,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0,0), +++OP("mcomb",0x92,2,ACCR+TYPB,ACCW+TYPB,0,0,0,0), +++OP("mcoml",0xd2,2,ACCR+TYPL,ACCW+TYPL,0,0,0,0), +++OP("mcomw",0xb2,2,ACCR+TYPW,ACCW+TYPW,0,0,0,0), +++OP("mfpr",0xdb,2,ACCR+TYPL,ACCW+TYPL,0,0,0,0), +++OP("mnegb",0x8e,2,ACCR+TYPB,ACCW+TYPB,0,0,0,0), +++OP("mnegd",0x72,2,ACCR+TYPD,ACCW+TYPD,0,0,0,0), +++OP("mnegf",0x52,2,ACCR+TYPF,ACCW+TYPF,0,0,0,0), +++OP("mnegl",0xce,2,ACCR+TYPL,ACCW+TYPL,0,0,0,0), +++OP("mnegw",0xae,2,ACCR+TYPW,ACCW+TYPL,0,0,0,0), +++OP("movab",0x9e,2,ACCA+TYPB,ACCW+TYPL,0,0,0,0), +++OP("movad",0x7e,2,ACCA+TYPD,ACCW+TYPL,0,0,0,0), +++OP("movaf",0xde,2,ACCA+TYPF,ACCW+TYPL,0,0,0,0), +++OP("moval",0xde,2,ACCA+TYPL,ACCW+TYPL,0,0,0,0), +++OP("movaq",0x7e,2,ACCA+TYPQ,ACCW+TYPL,0,0,0,0), +++OP("movaw",0x3e,2,ACCA+TYPW,ACCW+TYPL,0,0,0,0), +++OP("movb",0x90,2,ACCR+TYPB,ACCW+TYPB,0,0,0,0), +++OP("movc3",0x28,3,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,0,0,0), +++OP("movc5",0x2c,5,ACCR+TYPW,ACCA+TYPB,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB,0), +++OP("movd",0x70,2,ACCR+TYPD,ACCW+TYPD,0,0,0,0), +++OP("movf",0x50,2,ACCR+TYPF,ACCW+TYPF,0,0,0,0), +++OP("movl",0xd0,2,ACCR+TYPL,ACCW+TYPL,0,0,0,0), +++OP("movp",0x34,3,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,0,0,0), +++OP("movpsl",0xdc,1,ACCW+TYPL,0,0,0,0,0), +++OP("movq",0x7d,2,ACCR+TYPQ,ACCW+TYPQ,0,0,0,0), +++OP("movtc",0x2e,6,ACCR+TYPW,ACCA+TYPB,ACCR+TYPB,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB), +++OP("movtuc",0x2f,6,ACCR+TYPW,ACCA+TYPB,ACCR+TYPB,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB), +++OP("movw",0xb0,2,ACCR+TYPW,ACCW+TYPW,0,0,0,0), +++OP("movzbl",0x9a,2,ACCR+TYPB,ACCW+TYPL,0,0,0,0), +++OP("movzbw",0x9b,2,ACCR+TYPB,ACCW+TYPW,0,0,0,0), +++OP("movzwl",0x3c,2,ACCR+TYPW,ACCW+TYPL,0,0,0,0), +++OP("mtpr",0xda,2,ACCR+TYPL,ACCR+TYPL,0,0,0,0), +++OP("mulb2",0x84,2,ACCR+TYPB,ACCM+TYPB,0,0,0,0), +++OP("mulb3",0x85,3,ACCR+TYPB,ACCR+TYPB,ACCW+TYPB,0,0,0), +++OP("muld2",0x64,2,ACCR+TYPD,ACCM+TYPD,0,0,0,0), +++OP("muld3",0x65,3,ACCR+TYPD,ACCR+TYPD,ACCW+TYPD,0,0,0), +++OP("mulf2",0x44,2,ACCR+TYPF,ACCM+TYPF,0,0,0,0), +++OP("mulf3",0x45,3,ACCR+TYPF,ACCR+TYPF,ACCW+TYPF,0,0,0), +++OP("mull2",0xc4,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("mull3",0xc5,3,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("mulp",0x25,6,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB), +++OP("mulw2",0xa4,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("mulw3",0xa5,3,ACCR+TYPW,ACCR+TYPW,ACCW+TYPW,0,0,0), +++OP("nop",0x01,0,0,0,0,0,0,0), +++OP("polyd",0x75,3,ACCR+TYPD,ACCR+TYPW,ACCA+TYPB,0,0,0), +++OP("polyf",0x55,3,ACCR+TYPF,ACCR+TYPW,ACCA+TYPB,0,0,0), +++OP("popr",0xba,1,ACCR+TYPW,0,0,0,0,0), +++OP("prober",0x0c,3,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB,0,0,0), +++OP("probew",0x0d,3,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB,0,0,0), +++OP("pushab",0x9f,1,ACCA+TYPB,0,0,0,0,0), +++OP("pushad",0x7f,1,ACCA+TYPD,0,0,0,0,0), +++OP("pushaf",0xdf,1,ACCA+TYPF,0,0,0,0,0), +++OP("pushal",0xdf,1,ACCA+TYPL,0,0,0,0,0), +++OP("pushaq",0x7f,1,ACCA+TYPQ,0,0,0,0,0), +++OP("pushaw",0x3f,1,ACCA+TYPW,0,0,0,0,0), +++OP("pushl",0xdd,1,ACCR+TYPL,0,0,0,0,0), +++OP("pushr",0xbb,1,ACCR+TYPW,0,0,0,0,0), +++OP("rei",0x02,0,0,0,0,0,0,0), +++OP("remque",0x0f,2,ACCA+TYPB,ACCW+TYPL,0,0,0,0), +++OP("ret",0x04,0,0,0,0,0,0,0), +++OP("rotl",0x9c,3,ACCR+TYPB,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("rsb",0x05,0,0,0,0,0,0,0), +++OP("sbwc",0xd9,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("scanc",0x2a,4,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,ACCR+TYPB,0,0), +++OP("skpc",0x3b,3,ACCR+TYPB,ACCR+TYPW,ACCA+TYPB,0,0,0), +++OP("sobgeq",0xf4,2,ACCM+TYPL,ACCB+TYPB,0,0,0,0), +++OP("sobgtr",0xf5,2,ACCM+TYPL,ACCB+TYPB,0,0,0,0), +++OP("spanc",0x2b,4,ACCR+TYPW,ACCA+TYPB,ACCA+TYPB,ACCR+TYPB,0,0), +++OP("subb2",0x82,2,ACCR+TYPB,ACCM+TYPB,0,0,0,0), +++OP("subb3",0x83,3,ACCR+TYPB,ACCR+TYPB,ACCW+TYPB,0,0,0), +++OP("subd2",0x62,2,ACCR+TYPD,ACCM+TYPD,0,0,0,0), +++OP("subd3",0x63,3,ACCR+TYPD,ACCR+TYPD,ACCW+TYPD,0,0,0), +++OP("subf2",0x42,2,ACCR+TYPF,ACCM+TYPF,0,0,0,0), +++OP("subf3",0x43,3,ACCR+TYPF,ACCR+TYPF,ACCW+TYPF,0,0,0), +++OP("subl2",0xc2,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("subl3",0xc3,3,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("subp4",0x22,4,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,0,0), +++OP("subp6",0x23,6,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB,ACCR+TYPW,ACCA+TYPB), +++OP("subw2",0xa2,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("subw3",0xa3,3,ACCR+TYPW,ACCR+TYPW,ACCW+TYPW,0,0,0), +++OP("svpctx",0x07,0,0,0,0,0,0,0), +++OP("tstb",0x95,1,ACCR+TYPB,0,0,0,0,0), +++OP("tstd",0x73,1,ACCR+TYPD,0,0,0,0,0), +++OP("tstf",0x53,1,ACCR+TYPF,0,0,0,0,0), +++OP("tstl",0xd5,1,ACCR+TYPL,0,0,0,0,0), +++OP("tstw",0xb5,1,ACCR+TYPW,0,0,0,0,0), +++OP("xfc",0xfc,1,ACCI+TYPB,0,0,0,0,0), +++OP("xorb2",0x8c,2,ACCR+TYPB,ACCM+TYPB,0,0,0,0), +++OP("xorb3",0x8d,3,ACCR+TYPB,ACCR+TYPB,ACCW+TYPB,0,0,0), +++OP("xorl2",0xcc,2,ACCR+TYPL,ACCM+TYPL,0,0,0,0), +++OP("xorl3",0xcd,3,ACCR+TYPL,ACCR+TYPL,ACCW+TYPL,0,0,0), +++OP("xorw2",0xac,2,ACCR+TYPW,ACCM+TYPW,0,0,0,0), +++OP("xorw3",0xad,3,ACCR+TYPW,ACCR+TYPW,ACCW+TYPW,0,0,0), +++OP("escd",0xfd,0,0,0,0,0,0,0), +++OP("esce",0xfe,0,0,0,0,0,0,0), +++OP("escf",0xff,0,0,0,0,0,0,0), diff --cc usr/src/cmd/at.c index 0000000000,a94f701868,0000000000..16b62dde80 mode 000000,100644,000000..100644 --- a/usr/src/cmd/at.c +++ b/usr/src/cmd/at.c @@@@ -1,0 -1,320 -1,0 +1,343 @@@@ +++static char *sccsid = "@(#)at.c 4.2 (Berkeley) 10/21/80"; + +/* + + * at time mon day + + * at time wday + + * at time wday 'week' + + * + + */ + +#include + +#include + +#include + +#include + + + +#define HOUR 100 + +#define HALFDAY (12*HOUR) + +#define DAY (24*HOUR) + +#define THISDAY "/usr/spool/at" + + + +char *days[] = { + + "sunday", + + "monday", + + "tuesday", + + "wednesday", + + "thursday", + + "friday", + + "saturday", + +}; + + + +struct monstr { + + char *mname; + + int mlen; + +} months[] = { + + { "january", 31 }, + + { "february", 28 }, + + { "march", 31 }, + + { "april", 30 }, + + { "may", 31 }, + + { "june", 30 }, + + { "july", 31 }, + + { "august", 31 }, + + { "september", 30 }, + + { "october", 31 }, + + { "november", 30 }, + + { "december", 31 }, + + { 0, 0 }, + +}; + + + +char fname[100]; + +int utime; /* requested time in grains */ + +int now; /* when is it */ + +int uday; /* day of year to be done */ + +int uyear; /* year */ + +int today; /* day of year today */ + +FILE *file; + +FILE *ifile; + +char **environ; + +char *prefix(); + +char *getenv(); + +FILE *popen(); + + + +main(argc, argv) + +char **argv; + +{ + + extern onintr(); + + register c; + + char pwbuf[100]; + + FILE *pwfil; + + int larg; + + char *tmp; + + + + /* argv[1] is the user's time: e.g., 3AM */ + + /* argv[2] is a month name or day of week */ + + /* argv[3] is day of month or 'week' */ + + /* another argument might be an input file */ + + if (argc < 2) { + + fprintf(stderr, "at: arg count\n"); + + exit(1); + + } + + makeutime(argv[1]); + + larg = makeuday(argc,argv)+1; + + if (uday==today && larg<=2 && utime<=now) + + uday++; + + c = uyear%4==0? 366: 365; + + if (uday >= c) { + + uday -= c; + + uyear++; + + } + + filename(THISDAY, uyear, uday, utime); +++ /* Create file, then change UIDS */ +++ close(creat(fname,0644)); +++ chown(fname,getuid(),getgid()); +++ setuid(getuid()); + + ifile = stdin; + + if (argc > larg) + + ifile = fopen(argv[larg], "r"); + + if (ifile == NULL) { + + fprintf(stderr, "at: cannot open input: %s\n", argv[larg]); + + exit(1); + + } + + if (signal(SIGINT, SIG_IGN) != SIG_IGN) + + signal(SIGINT, onintr); - file = fopen(fname, "a"); - chmod(fname, 0644); - chown(fname,getuid(),getgid()); +++ file = fopen(fname, "w"); + + if (file == NULL) { + + fprintf(stderr, "at: cannot open memo file\n"); + + exit(1); + + } + + if ((pwfil = popen("pwd", "r")) == NULL) { + + fprintf(stderr, "at: can't execute pwd\n"); + + exit(1); + + } + + fgets(pwbuf, 100, pwfil); + + pclose(pwfil); + + fprintf(file, "cd %s", pwbuf); +++ c = umask(0); +++ umask(c); +++ fprintf(file, "umask %.1o\n", c); + + if (environ) { + + char **ep = environ; + + while(*ep) + + { - fprintf(file, "%s\nexport ", *ep); +++ char *cp; +++ for (tmp = *ep, cp = "TERMCAP"; *tmp==*cp; tmp++,cp++); +++ if (*cp == 0 && *tmp== '=') { +++ ep++; +++ continue; +++ } +++ for(tmp = *ep ; *tmp != '=' ; tmp++) putc(*tmp,file); +++ putc('=', file); +++ putc('\'', file); +++ for (tmp++; *tmp; tmp++) { +++ if (*tmp == '\'') +++ putc('\\', file); +++ putc(*tmp, file); +++ } +++ putc('\'', file); +++ fprintf(file, "\nexport "); + + for(tmp = *ep ; *tmp != '=' ; tmp++) putc(*tmp,file); + + putc('\n',file); + + ep++; + + } + + } - /* see if the SHELL variable in the current enviroment is /bin/csh +++ /* +++ * see if the SHELL variable in the current enviroment is /bin/csh + + * and in that case, use the csh as the shell + + */ - if(strcmp(getenv("SHELL"), "/bin/csh") == 0) - fprintf(file, "%s\n", "csh << 'xxFUNNYxx'"); +++ tmp = getenv("SHELL"); +++ if (strcmp(tmp+strlen(tmp)-3, "csh") == 0) +++ fprintf(file, "%s %s\n", tmp, "<< 'xxFUNNYxx'"); + + while((c = getc(ifile)) != EOF) { + + putc(c, file); + + } - if(strcmp(getenv("SHELL"), "/bin/csh") == 0) +++ if (strcmp(tmp+strlen(tmp)-3, "csh") == 0) + + fprintf(file, "%s\n", "xxFUNNYxx"); + + exit(0); + +} + + + +makeutime(pp) + +char *pp; + +{ + + register val; + + register char *p; + + + + /* p points to a user time */ + + p = pp; + + val = 0; + + while(isdigit(*p)) { + + val = val*10+(*p++ -'0'); + + } + + if (p-pp < 3) + + val *= HOUR; + + + + for (;;) { + + switch(*p) { + + + + case ':': + + ++p; + + if (isdigit(*p)) { + + if (isdigit(p[1])) { + + val +=(10* *p + p[1] - 11*'0'); + + p += 2; + + continue; + + } + + } + + fprintf(stderr, "at: bad time format:\n"); + + exit(1); + + + + case 'A': + + case 'a': + + if (val >= HALFDAY+HOUR) + + val = DAY+1; /* illegal */ + + if (val >= HALFDAY && val <(HALFDAY+HOUR)) + + val -= HALFDAY; + + break; + + + + case 'P': + + case 'p': + + if (val >= HALFDAY+HOUR) + + val = DAY+1; /* illegal */ + + if (val < HALFDAY) + + val += HALFDAY; + + break; + + + + case 'n': + + case 'N': + + val = HALFDAY; + + break; + + + + case 'M': + + case 'm': + + val = 0; + + break; + + + + + + case '\0': + + case ' ': + + /* 24 hour time */ + + if (val == DAY) + + val -= DAY; + + break; + + + + default: + + fprintf(stderr, "at: bad time format\n"); + + exit(1); + + + + } + + break; + + } + + if (val < 0 || val >= DAY) { + + fprintf(stderr, "at: time out of range\n"); + + exit(1); + + } + + if (val%HOUR >= 60) { + + fprintf(stderr, "at: illegal minute field\n"); + + exit(1); + + } + + utime = val; + +} + + + + + +makeuday(argc,argv) + +char **argv; + +{ + + /* the presumption is that argv[2], argv[3] are either + + month day OR weekday [week]. Returns either 2 or 3 as last + + argument used */ + + /* first of all, what's today */ + + long tm; + + int found = -1; + + char **ps; + + struct tm *detail, *localtime(); + + struct monstr *pt; + + + + time(&tm); + + detail = localtime(&tm); + + uday = today = detail->tm_yday; + + uyear = detail->tm_year; + + now = detail->tm_hour*100+detail->tm_min; + + if (argc<=2) + + return(1); + + /* is the next argument a month name ? */ + + for (pt=months; pt->mname; pt++) { + + if (prefix(argv[2], pt->mname)) { + + if (found<0) + + found = pt-months; + + else { + + fprintf(stderr, "at: ambiguous month\n"); + + exit(1); + + } + + } + + } + + if (found>=0) { + + if (argc<=3) + + return(2); + + uday = atoi(argv[3]) - 1; + + if (uday<0) { + + fprintf(stderr, "at: illegal day\n"); + + exit(1); + + } + + while(--found>=0) + + uday += months[found].mlen; + + if (detail->tm_year%4==0 && uday>59) + + uday += 1; + + return(3); + + } + + /* not a month, try day of week */ + + found = -1; + + for (ps=days; pstm_wday; + + if (uday<=0) + + uday += 7; + + uday += today; + + if (argc>3 && strcmp("week", argv[3])==0) { + + uday += 7; + + return(3); + + } + + return(2); + +} + + + +char * + +prefix(begin, full) + +char *begin, *full; + +{ + + int c; + + while (c = *begin++) { + + if (isupper(c)) + + c = tolower(c); + + if (*full != c) + + return(0); + + else + + full++; + + } + + return(full); + +} + + + +filename(dir, y, d, t) + +char *dir; + +{ + + register i; + + + + for (i=0; ; i += 53) { + + sprintf(fname, "%s/%02d.%03d.%04d.%02d", dir, y, d, t, + + (getpid()+i)%100); + + if (access(fname, 0) == -1) + + return; + + } + +} + + + +onintr() + +{ + + unlink(fname); + + exit(1); + +} diff --cc usr/src/cmd/atrun.c index 0000000000,401862a8cf,0000000000..7e8c225a6c mode 000000,100644,000000..100644 --- a/usr/src/cmd/atrun.c +++ b/usr/src/cmd/atrun.c @@@@ -1,0 -1,108 -1,0 +1,110 @@@@ +++static char *sccsid = "@(#)atrun.c 4.2 (Berkeley) 10/21/80"; + +/* + + * Run programs submitted by at. + + */ + +#include + +#include + +#include + +#include + +#include + + + +# define DIR "/usr/spool/at" + +# define PDIR "past" + +# define LASTF "/usr/spool/at/lasttimedone" + + + +int nowtime; + +int nowdate; + +int nowyear; + + + +main(argc, argv) + +char **argv; + +{ + + int tt, day, year, uniq; + + struct direct dirent; + + FILE *dirf; +++ char file[DIRSIZ+1]; + + - setuid(0); - setgid(0); + + chdir(DIR); + + makenowtime(); + + if ((dirf = fopen(".", "r")) == NULL) { + + fprintf(stderr, "Cannot read at directory\n"); + + exit(1); + + } + + while (fread((char *)&dirent, sizeof(dirent), 1, dirf) == 1) { + + if (dirent.d_ino==0) + + continue; - if (sscanf(dirent.d_name, "%2d.%3d.%4d.%2d", &year, &day, &tt, &uniq) != 4) +++ strcpyn(file, dirent.d_name, DIRSIZ); +++ file[DIRSIZ] = '\0'; +++ if (sscanf(file, "%2d.%3d.%4d.%2d", &year, &day, &tt, &uniq) != 4) + + continue; + + if (nowyear < year) + + continue; + + if (nowyear==year && nowdate < day) + + continue; + + if (nowyear==year && nowdate==day && nowtime < tt) + + continue; - run(dirent.d_name); +++ run(file); + + } + + fclose(dirf); + + updatetime(nowtime); + + exit(0); + +} + + + +makenowtime() + +{ + + long t; + + struct tm *localtime(); + + register struct tm *tp; + + + + time(&t); + + tp = localtime(&t); + + nowtime = tp->tm_hour*100 + tp->tm_min; + + nowdate = tp->tm_yday; + + nowyear = tp->tm_year; + +} + + + +updatetime(t) + +{ + + FILE *tfile; + + + + tfile = fopen(LASTF, "w"); + + if (tfile == NULL) { + + fprintf(stderr, "can't write lastfile\n"); + + exit(1); + + } + + fprintf(tfile, "%04d\n", t); + +} + + + +run(file) + +char *file; + +{ + + struct stat stbuf; + + register pid, i; + + char sbuf[64]; + + + + /* printf("running %s\n", file); */ + + if (fork()!=0) + + return; + + for (i=0; i<15; i++) + + close(i); + + dup(dup(open("/dev/null", 0))); - sprintf(sbuf, "/bin/mv %.14s %s", file, PDIR); - system(sbuf); +++ sprintf(sbuf, "%s/%s", PDIR, file); +++ link(file, sbuf); +++ unlink(file); + + chdir(PDIR); + + if (stat(file, &stbuf) == -1) + + exit(1); + + if (pid = fork()) { + + if (pid == -1) + + exit(1); + + wait((int *)0); + + unlink(file); + + exit(0); + + } + + setgid(stbuf.st_gid); + + setuid(stbuf.st_uid); - nice(3); + + execl("/bin/sh", "sh", file, 0); + + execl("/usr/bin/sh", "sh", file, 0); + + fprintf(stderr, "Can't execl shell\n"); + + exit(1); + +} diff --cc usr/src/cmd/basename.c index 0000000000,52df45fb5a,0000000000..c307d1e047 mode 000000,100644,000000..100644 --- a/usr/src/cmd/basename.c +++ b/usr/src/cmd/basename.c @@@@ -1,0 -1,29 -1,0 +1,30 @@@@ +++static char *sccsid = "@(#)basename.c 4.1 (Berkeley) 10/1/80"; + +#include "stdio.h" + + + +main(argc, argv) + +char **argv; + +{ + + register char *p1, *p2, *p3; + + + + if (argc < 2) { + + putchar('\n'); + + exit(1); + + } + + p1 = argv[1]; + + p2 = p1; + + while (*p1) { + + if (*p1++ == '/') + + p2 = p1; + + } + + if (argc>2) { + + for(p3=argv[2]; *p3; p3++) + + ; + + while(p1>p2 && p3>argv[2]) + + if(*--p3 != *--p1) + + goto output; + + *p1 = '\0'; + + } + +output: + + puts(p2, stdout); + + exit(0); + +} diff --cc usr/src/cmd/bc.y index 0000000000,1e50fc51e1,0000000000..a12c3d9741 mode 000000,100644,000000..100644 --- a/usr/src/cmd/bc.y +++ b/usr/src/cmd/bc.y @@@@ -1,0 -1,597 -1,0 +1,598 @@@@ + +%{ +++static char *sccsid = "@(#)bc.y 4.1 (Berkeley) 10/1/80"; + + int *getout(); + +%} + +%right '=' + +%left '+' '-' + +%left '*' '/' '%' + +%right '^' + +%left UMINUS + + + +%term LETTER DIGIT SQRT LENGTH _IF FFF EQ + +%term _WHILE _FOR NE LE GE INCR DECR + +%term _RETURN _BREAK _DEFINE BASE OBASE SCALE + +%term EQPL EQMI EQMUL EQDIV EQREM EQEXP + +%term _AUTO DOT + +%term QSTR + + + +%{ + +#include + +int in; + +char cary[1000], *cp = { cary }; + +char string[1000], *str = {string}; + +int crs = '0'; + +int rcrs = '0'; /* reset crs */ + +int bindx = 0; + +int lev = 0; + +int ln; + +char *ss; + +int bstack[10] = { 0 }; + +char *numb[15] = { + + " 0", " 1", " 2", " 3", " 4", " 5", + + " 6", " 7", " 8", " 9", " 10", " 11", + + " 12", " 13", " 14" }; + +int *pre, *post; + +%} + +%% + +start : + + | start stat tail + + = output( $2 ); + + | start def dargs ')' '{' dlist slist '}' + + ={ bundle( 6,pre, $7, post ,"0",numb[lev],"Q"); + + conout( $$, $2 ); + + rcrs = crs; + + output( "" ); + + lev = bindx = 0; + + } + + ; + + + +dlist : tail + + | dlist _AUTO dlets tail + + ; + + + +stat : e + + ={ bundle(2, $1, "ps." ); } + + | + + ={ bundle(1, "" ); } + + | QSTR + + ={ bundle(3,"[",$1,"]P");} + + | LETTER '=' e + + ={ bundle(3, $3, "s", $1 ); } + + | LETTER '[' e ']' '=' e + + ={ bundle(4, $6, $3, ":", geta($1)); } + + | LETTER EQOP e + + ={ bundle(6, "l", $1, $3, $2, "s", $1 ); } + + | LETTER '[' e ']' EQOP e + + ={ bundle(8,$3, ";", geta($1), $6, $5, $3, ":", geta($1));} + + | _BREAK + + ={ bundle(2, numb[lev-bstack[bindx-1]], "Q" ); } + + | _RETURN '(' e ')' + + = bundle(4, $3, post, numb[lev], "Q" ); + + | _RETURN '(' ')' + + = bundle(4, "0", post, numb[lev], "Q" ); + + | _RETURN + + = bundle(4,"0",post,numb[lev],"Q"); + + | SCALE '=' e + + = bundle(2, $3, "k"); + + | SCALE EQOP e + + = bundle(4,"K",$3,$2,"k"); + + | BASE '=' e + + = bundle(2,$3, "i"); + + | BASE EQOP e + + = bundle(4,"I",$3,$2,"i"); + + | OBASE '=' e + + = bundle(2,$3,"o"); + + | OBASE EQOP e + + = bundle(4,"O",$3,$2,"o"); + + | '{' slist '}' + + ={ $$ = $2; } + + | FFF + + ={ bundle(1,"fY"); } + + | error + + ={ bundle(1,"c"); } + + | _IF CRS BLEV '(' re ')' stat + + ={ conout( $7, $2 ); + + bundle(3, $5, $2, " " ); + + } + + | _WHILE CRS '(' re ')' stat BLEV + + ={ bundle(3, $6, $4, $2 ); + + conout( $$, $2 ); + + bundle(3, $4, $2, " " ); + + } + + | fprefix CRS re ';' e ')' stat BLEV + + ={ bundle(5, $7, $5, "s.", $3, $2 ); + + conout( $$, $2 ); + + bundle(5, $1, "s.", $3, $2, " " ); + + } + + | '~' LETTER '=' e + + ={ bundle(3,$4,"S",$2); } + + ; + + + +EQOP : EQPL + + ={ $$ = "+"; } + + | EQMI + + ={ $$ = "-"; } + + | EQMUL + + ={ $$ = "*"; } + + | EQDIV + + ={ $$ = "/"; } + + | EQREM + + ={ $$ = "%%"; } + + | EQEXP + + ={ $$ = "^"; } + + ; + + + +fprefix : _FOR '(' e ';' + + ={ $$ = $3; } + + ; + + + +BLEV : + + ={ --bindx; } + + ; + + + +slist : stat + + | slist tail stat + + ={ bundle(2, $1, $3 ); } + + ; + + + +tail : '\n' + + ={ln++;} + + | ';' + + ; + + + +re : e EQ e + + = bundle(3, $1, $3, "=" ); + + | e '<' e + + = bundle(3, $1, $3, ">" ); + + | e '>' e + + = bundle(3, $1, $3, "<" ); + + | e NE e + + = bundle(3, $1, $3, "!=" ); + + | e GE e + + = bundle(3, $1, $3, "!>" ); + + | e LE e + + = bundle(3, $1, $3, "!<" ); + + | e + + = bundle(2, $1, " 0!=" ); + + ; + + + +e : e '+' e + + = bundle(3, $1, $3, "+" ); + + | e '-' e + + = bundle(3, $1, $3, "-" ); + + | '-' e %prec UMINUS + + = bundle(3, " 0", $2, "-" ); + + | e '*' e + + = bundle(3, $1, $3, "*" ); + + | e '/' e + + = bundle(3, $1, $3, "/" ); + + | e '%' e + + = bundle(3, $1, $3, "%%" ); + + | e '^' e + + = bundle(3, $1, $3, "^" ); + + | LETTER '[' e ']' + + ={ bundle(3,$3, ";", geta($1)); } + + | LETTER INCR + + = bundle(4, "l", $1, "d1+s", $1 ); + + | INCR LETTER + + = bundle(4, "l", $2, "1+ds", $2 ); + + | DECR LETTER + + = bundle(4, "l", $2, "1-ds", $2 ); + + | LETTER DECR + + = bundle(4, "l", $1, "d1-s", $1 ); + + | LETTER '[' e ']' INCR + + = bundle(7,$3,";",geta($1),"d1+",$3,":",geta($1)); + + | INCR LETTER '[' e ']' + + = bundle(7,$4,";",geta($2),"1+d",$4,":",geta($2)); + + | LETTER '[' e ']' DECR + + = bundle(7,$3,";",geta($1),"d1-",$3,":",geta($1)); + + | DECR LETTER '[' e ']' + + = bundle(7,$4,";",geta($2),"1-d",$4,":",geta($2)); + + | SCALE INCR + + = bundle(1,"Kd1+k"); + + | INCR SCALE + + = bundle(1,"K1+dk"); + + | SCALE DECR + + = bundle(1,"Kd1-k"); + + | DECR SCALE + + = bundle(1,"K1-dk"); + + | BASE INCR + + = bundle(1,"Id1+i"); + + | INCR BASE + + = bundle(1,"I1+di"); + + | BASE DECR + + = bundle(1,"Id1-i"); + + | DECR BASE + + = bundle(1,"I1-di"); + + | OBASE INCR + + = bundle(1,"Od1+o"); + + | INCR OBASE + + = bundle(1,"O1+do"); + + | OBASE DECR + + = bundle(1,"Od1-o"); + + | DECR OBASE + + = bundle(1,"O1-do"); + + | LETTER '(' cargs ')' + + = bundle(4, $3, "l", getf($1), "x" ); + + | LETTER '(' ')' + + = bundle(3, "l", getf($1), "x" ); + + | cons + + ={ bundle(2, " ", $1 ); } + + | DOT cons + + ={ bundle(2, " .", $2 ); } + + | cons DOT cons + + ={ bundle(4, " ", $1, ".", $3 ); } + + | cons DOT + + ={ bundle(3, " ", $1, "." ); } + + | DOT + + ={ $$ = "l."; } + + | LETTER + + = { bundle(2, "l", $1 ); } + + | LETTER '=' e + + ={ bundle(3, $3, "ds", $1 ); } + + | LETTER EQOP e %prec '=' + + ={ bundle(6, "l", $1, $3, $2, "ds", $1 ); } + + | LETTER '[' e ']' '=' e + + = { bundle(5,$6,"d",$3,":",geta($1)); } + + | LETTER '[' e ']' EQOP e + + = { bundle(9,$3,";",geta($1),$6,$5,"d",$3,":",geta($1)); } + + | LENGTH '(' e ')' + + = bundle(2,$3,"Z"); + + | SCALE '(' e ')' + + = bundle(2,$3,"X"); /* must be before '(' e ')' */ + + | '(' e ')' + + = { $$ = $2; } + + | '?' + + ={ bundle(1, "?" ); } + + | SQRT '(' e ')' + + ={ bundle(2, $3, "v" ); } + + | '~' LETTER + + ={ bundle(2,"L",$2); } + + | SCALE '=' e + + = bundle(2,$3,"dk"); + + | SCALE EQOP e %prec '=' + + = bundle(4,"K",$3,$2,"dk"); + + | BASE '=' e + + = bundle(2,$3,"di"); + + | BASE EQOP e %prec '=' + + = bundle(4,"I",$3,$2,"di"); + + | OBASE '=' e + + = bundle(2,$3,"do"); + + | OBASE EQOP e %prec '=' + + = bundle(4,"O",$3,$2,"do"); + + | SCALE + + = bundle(1,"K"); + + | BASE + + = bundle(1,"I"); + + | OBASE + + = bundle(1,"O"); + + ; + + + +cargs : eora + + | cargs ',' eora + + = bundle(2, $1, $3 ); + + ; + +eora: e + + | LETTER '[' ']' + + =bundle(2,"l",geta($1)); + + ; + + + +cons : constant + + ={ *cp++ = '\0'; } + + + +constant: + + '_' + + ={ $$ = cp; *cp++ = '_'; } + + | DIGIT + + ={ $$ = cp; *cp++ = $1; } + + | constant DIGIT + + ={ *cp++ = $2; } + + ; + + + +CRS : + + ={ $$ = cp; *cp++ = crs++; *cp++ = '\0'; + + if(crs == '[')crs+=3; + + if(crs == 'a')crs='{'; + + if(crs >= 0241){yyerror("program too big"); + + getout(); + + } + + bstack[bindx++] = lev++; } + + ; + + + +def : _DEFINE LETTER '(' + + ={ $$ = getf($2); + + pre = ""; + + post = ""; + + lev = 1; + + bstack[bindx=0] = 0; + + } + + ; + + + +dargs : + + | lora + + ={ pp( $1 ); } + + | dargs ',' lora + + ={ pp( $3 ); } + + ; + + + +dlets : lora + + ={ tp($1); } + + | dlets ',' lora + + ={ tp($3); } + + ; + +lora : LETTER + + | LETTER '[' ']' + + ={ $$ = geta($1); } + + ; + + + +%% + +# define error 256 + + + +int peekc = -1; + +int sargc; + +int ifile; + +char **sargv; + + + +char funtab[52] = { + + 01,0,02,0,03,0,04,0,05,0,06,0,07,0,010,0,011,0,012,0,013,0,014,0,015,0,016,0,017,0, + + 020,0,021,0,022,0,023,0,024,0,025,0,026,0,027,0,030,0,031,0,032,0 }; + +char atab[52] = { + + 0241,0,0242,0,0243,0,0244,0,0245,0,0246,0,0247,0,0250,0,0251,0,0252,0,0253,0, + + 0254,0,0255,0,0256,0,0257,0,0260,0,0261,0,0262,0,0263,0,0264,0,0265,0,0266,0, + + 0267,0,0270,0,0271,0,0272,0}; + +char *letr[26] = { + + "a","b","c","d","e","f","g","h","i","j", + + "k","l","m","n","o","p","q","r","s","t", + + "u","v","w","x","y","z" } ; + +char *dot = { "." }; + +yylex(){ + + int c, ch; + +restart: + + c = getch(); + + peekc = -1; + + while( c == ' ' || c == '\t' ) c = getch(); + + if(c == '\\'){ + + getch(); + + goto restart; + + } + + if( c<= 'z' && c >= 'a' ) { + + /* look ahead to look for reserved words */ + + peekc = getch(); + + if( peekc >= 'a' && peekc <= 'z' ){ /* must be reserved word */ + + if( c=='i' && peekc=='f' ){ c=_IF; goto skip; } + + if( c=='w' && peekc=='h' ){ c=_WHILE; goto skip; } + + if( c=='f' && peekc=='o' ){ c=_FOR; goto skip; } + + if( c=='s' && peekc=='q' ){ c=SQRT; goto skip; } + + if( c=='r' && peekc=='e' ){ c=_RETURN; goto skip; } + + if( c=='b' && peekc=='r' ){ c=_BREAK; goto skip; } + + if( c=='d' && peekc=='e' ){ c=_DEFINE; goto skip; } + + if( c=='s' && peekc=='c' ){ c= SCALE; goto skip; } + + if( c=='b' && peekc=='a' ){ c=BASE; goto skip; } + + if( c=='i' && peekc == 'b'){ c=BASE; goto skip; } + + if( c=='o' && peekc=='b' ){ c=OBASE; goto skip; } + + if( c=='d' && peekc=='i' ){ c=FFF; goto skip; } + + if( c=='a' && peekc=='u' ){ c=_AUTO; goto skip; } + + if( c == 'l' && peekc=='e'){ c=LENGTH; goto skip; } + + if( c == 'q' && peekc == 'u'){getout();} + + /* could not be found */ + + return( error ); + + skip: /* skip over rest of word */ + + peekc = -1; + + while( (ch = getch()) >= 'a' && ch <= 'z' ); + + peekc = ch; + + return( c ); + + } + + + + /* usual case; just one single letter */ + + + + yylval = letr[c-'a']; + + return( LETTER ); + + } + + if( c>= '0' && c <= '9' || c>= 'A' && c<= 'F' ){ + + yylval = c; + + return( DIGIT ); + + } + + switch( c ){ + + case '.': return( DOT ); + + case '=': + + switch( peekc = getch() ){ + + case '=': c=EQ; goto gotit; + + case '+': c=EQPL; goto gotit; + + case '-': c=EQMI; goto gotit; + + case '*': c=EQMUL; goto gotit; + + case '/': c=EQDIV; goto gotit; + + case '%': c=EQREM; goto gotit; + + case '^': c=EQEXP; goto gotit; + + default: return( '=' ); + + gotit: peekc = -1; return(c); + + } + + case '+': return( cpeek( '+', INCR, '+' ) ); + + case '-': return( cpeek( '-', DECR, '-' ) ); + + case '<': return( cpeek( '=', LE, '<' ) ); + + case '>': return( cpeek( '=', GE, '>' ) ); + + case '!': return( cpeek( '=', NE, '!' ) ); + + case '/': + + if((peekc = getch()) == '*'){ + + peekc = -1; + + while((getch() != '*') || ((peekc = getch()) != '/')); + + peekc = -1; + + goto restart; + + } + + else return(c); + + case '"': + + yylval = str; + + while((c=getch()) != '"'){*str++ = c; + + if(str >= &string[999]){yyerror("string space exceeded"); + + getout(); + + } + + } + + *str++ = '\0'; + + return(QSTR); + + default: return( c ); + + } + +} + + + +cpeek( c, yes, no ){ + + if( (peekc=getch()) != c ) return( no ); + + else { + + peekc = -1; + + return( yes ); + + } + +} + + + +getch(){ + + int ch; + +loop: + + ch = (peekc < 0) ? getc(in) : peekc; + + peekc = -1; + + if(ch != EOF)return(ch); + + if(++ifile > sargc){ + + if(ifile >= sargc+2)getout(); + + in = stdin; + + ln = 0; + + goto loop; + + } + + fclose(in); + + if((in = fopen(sargv[ifile],"r")) != NULL){ + + ln = 0; + + ss = sargv[ifile]; + + goto loop; + + } + + yyerror("cannot open input file"); + +} + +# define b_sp_max 3000 + +int b_space [ b_sp_max ]; + +int * b_sp_nxt = { b_space }; + + + +int bdebug = 0; + +bundle(a){ + + int i, *p, *q; + + + + p = &a; + + i = *p++; + + q = b_sp_nxt; + + if( bdebug ) printf("bundle %d elements at %o\n",i, q ); + + while(i-- > 0){ + + if( b_sp_nxt >= & b_space[b_sp_max] ) yyerror( "bundling space exceeded" ); + + * b_sp_nxt++ = *p++; + + } + + * b_sp_nxt++ = 0; + + yyval = q; + + return( q ); + +} + + + +routput(p) int *p; { + + if( bdebug ) printf("routput(%o)\n", p ); + + if( p >= &b_space[0] && p < &b_space[b_sp_max]){ + + /* part of a bundle */ + + while( *p != 0 ) routput( *p++ ); + + } + + else printf( p ); /* character string */ + +} + + + +output( p ) int *p; { + + routput( p ); + + b_sp_nxt = & b_space[0]; + + printf( "\n" ); + + fflush(stdout); + + cp = cary; + + crs = rcrs; + +} + + + +conout( p, s ) int *p; char *s; { + + printf("["); + + routput( p ); + + printf("]s%s\n", s ); + + fflush(stdout); + + lev--; + +} + + + +yyerror( s ) char *s; { + + if(ifile > sargc)ss="teletype"; + + printf("c[%s on line %d, %s]pc\n", s ,ln+1,ss); + + fflush(stdout); + + cp = cary; + + crs = rcrs; + + bindx = 0; + + lev = 0; + + b_sp_nxt = &b_space[0]; + +} + + + +pp( s ) char *s; { + + /* puts the relevant stuff on pre and post for the letter s */ + + + + bundle(3, "S", s, pre ); + + pre = yyval; + + bundle(4, post, "L", s, "s." ); + + post = yyval; + +} + + + +tp( s ) char *s; { /* same as pp, but for temps */ + + bundle(3, "0S", s, pre ); + + pre = yyval; + + bundle(4, post, "L", s, "s." ); + + post = yyval; + +} + + + +yyinit(argc,argv) int argc; char *argv[];{ + + signal( 2, (int(*)())1 ); /* ignore all interrupts */ + + sargv=argv; + + sargc= -- argc; + + if(sargc == 0)in=stdin; + + else if((in = fopen(sargv[1],"r")) == NULL) + + yyerror("cannot open input file"); + + ifile = 1; + + ln = 0; + + ss = sargv[1]; + +} + +int *getout(){ + + printf("q"); + + fflush(stdout); + + exit(); + +} + + + +int * + +getf(p) char *p;{ + + return(&funtab[2*(*p -0141)]); + +} + +int * + +geta(p) char *p;{ + + return(&atab[2*(*p - 0141)]); + +} + + + +main(argc, argv) + +char **argv; + +{ + + int p[2]; + + + + + + if (argc > 1 && *argv[1] == '-') { + + if((argv[1][1] == 'd')||(argv[1][1] == 'c')){ + + yyinit(--argc, ++argv); + + yyparse(); + + exit(); + + } + + if(argv[1][1] != 'l'){ + + printf("unrecognizable argument\n"); + + fflush(stdout); + + exit(); + + } + + argv[1] = "/usr/lib/lib.b"; + + } + + pipe(p); + + if (fork()==0) { + + close(1); + + dup(p[1]); + + close(p[0]); + + close(p[1]); + + yyinit(argc, argv); + + yyparse(); + + exit(); + + } + + close(0); + + dup(p[0]); + + close(p[0]); + + close(p[1]); + + execl("/bin/dc", "dc", "-", 0); + + execl("/usr/bin/dc", "dc", "-", 0); + +} diff --cc usr/src/cmd/biff.c index 0000000000,0000000000,0000000000..528a7d1e1b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/biff.c @@@@ -1,0 -1,0 -1,0 +1,44 @@@@ +++static char *sccsid ="@(#)biff.c 4.1 (Berkeley) 10/18/80"; +++/* +++ * biff +++ */ +++ +++#include +++#include +++#include +++ +++char *ttyname(); +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ char *cp = ttyname(2); +++ struct stat stb; +++ +++ argc--, argv++; +++ if (cp == 0) +++ fprintf(stderr, "Where are you?\n"), exit(1); +++ if (stat(cp, &stb) < 0) +++ perror(cp), exit(1); +++ if (argc == 0) { +++ printf("is %s\n", stb.st_mode&0100 ? "y" : "n"); +++ exit((stb.st_mode&0100) ? 0 : 1); +++ } +++ switch (argv[0][0]) { +++ +++ case 'y': +++ if (chmod(cp, stb.st_mode|0100) < 0) +++ perror(cp); +++ break; +++ +++ case 'n': +++ if (chmod(cp, stb.st_mode&~0100) < 0) +++ perror(cp); +++ break; +++ +++ default: +++ fprintf(stderr, "usage: biff [y] [n]\n"); +++ } +++ exit((stb.st_mode&0100) ? 0 : 1); +++} diff --cc usr/src/cmd/c2/c2.h index 0000000000,88aeb4af93,0000000000..d9e42d88c6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/c2/c2.h +++ b/usr/src/cmd/c2/c2.h @@@@ -1,0 -1,159 -1,0 +1,169 @@@@ - /* @(#)c2.h 1.13 78/09/23 16:37:28 */ +++/*static char sccsid[] = "@(#)c2.h 4.2 10/17/80";*/ +++/* @(#)c2.h 1.19 80/08/26 13:39:07 */ + +/* + + * Header for object code improver + + */ + + + +#define JBR 1 + +#define CBR 2 + +#define JMP 3 + +#define LABEL 4 + +#define DLABEL 5 + +#define EROU 7 + +#define JSW 9 + +#define MOV 10 + +#define CLR 11 + +#define INC 12 + +#define DEC 13 + +#define TST 14 + +#define PUSH 15 + +#define CVT 16 + +#define CMP 17 + +#define ADD 18 + +#define SUB 19 + +#define BIT 20 + +#define BIC 21 + +#define BIS 22 + +#define XOR 23 + +#define COM 24 + +#define NEG 25 + +#define MUL 26 + +#define DIV 27 + +#define ASH 28 + +#define EXTV 29 + +#define EXTZV 30 + +#define INSV 31 + +#define CALLS 32 + +#define RET 33 + +#define CASE 34 + +#define SOB 35 + +#define TEXT 36 + +#define DATA 37 + +#define BSS 38 + +#define ALIGN 39 + +#define END 40 + +#define MOVZ 41 + +#define WGEN 42 + +#define SOBGEQ 43 + +#define SOBGTR 44 + +#define AOBLEQ 45 + +#define AOBLSS 46 + +#define ACB 47 + +#define MOVA 48 + +#define PUSHA 49 + +#define LGEN 50 + +#define SET 51 +++#define MOVC3 52 +++#define RSB 53 +++#define JSB 54 +++#define MFPR 55 +++#define MTPR 56 +++#define PROBER 57 +++#define PROBEW 58 +++#define LCOMM 59 +++#define COMM 60 + + + +#define JEQ 0 + +#define JNE 1 + +#define JLE 2 + +#define JGE 3 + +#define JLT 4 + +#define JGT 5 + +/* rearranged for unsigned branches so that jxxu = jxx + 6 */ + +#define JLOS 8 + +#define JHIS 9 + +#define JLO 10 + +#define JHI 11 + + + +#define JBC 12 + +#define JBS 13 + +#define JLBC 14 + +#define JLBS 15 + +#define JBCC 16 + +#define JBSC 17 + +#define JBCS 18 + +#define JBSS 19 + + + +#define BYTE 1 + +#define WORD 2 + +#define LONG 3 + +#define FLOAT 4 + +#define DOUBLE 5 + +#define QUAD 6 + +#define OP2 7 + +#define OP3 8 + +#define OPB 9 + +#define OPX 10 + + + +#define T(a,b) (a|((b)<<8)) + +#define U(a,b) (a|((b)<<4)) + + + +struct optab { + + char opstring[7]; + + short opcode; + +} optab[]; + + + +struct node { + + char op; + + char subop; + + short refc; + + struct node *forw; + + struct node *back; + + struct node *ref; + + char *code; + + struct optab *pop; - short labno; +++ long labno; + + short seq; + +}; + + + +struct { + + short combop; + +}; + + - char line[BUFSIZ]; +++char line[512]; + +struct node first; + +char *curlp; + +int nbrbr; + +int nsaddr; + +int redunm; + +int iaftbr; + +int njp1; + +int nrlab; + +int nxjump; + +int ncmot; + +int nrevbr; + +int loopiv; + +int nredunj; + +int nskip; + +int ncomj; + +int nsob; + +int nrtst; + +int nbj; + +int nfield; + + + +int nchange; + +int isn; + +int debug; + +char *lasta; + +char *lastr; + +char *firstr; + +char revbr[]; + +#define NREG 12 + +char *regs[NREG+5]; /* 0-11, 4 for operands, 1 for running off end */ + +char conloc[20]; + +char conval[20]; + +char ccloc[20]; + + + +#define RT1 12 + +#define RT2 13 + +#define RT3 14 + +#define RT4 15 + +#define LABHS 127 + + + +struct { char lbyte; }; + + + +char *copy(); + +long getnum(); + +struct node *codemove(); + +struct node *insertl(); + +struct node *nonlab(); diff --cc usr/src/cmd/c2/c20.c index 0000000000,1ddb682d3f,0000000000..ac14a67f6e mode 000000,100644,000000..100644 --- a/usr/src/cmd/c2/c20.c +++ b/usr/src/cmd/c2/c20.c @@@@ -1,0 -1,657 -1,0 +1,710 @@@@ + +# - char C20[] = {"@(#)c20.c 1.27 78/10/23 14:06:38"}; /* sccs ident */ +++static char sccsid[] = "@(#)c20.c 4.3 10/17/80"; +++/* char C20[] = {"@(#)c20.c 1.35 80/08/26 14:13:40"}; /* sccs ident */ + +/* + + * C object code improver + + */ + + - #include + +#include "c2.h" +++#include + +#include + + + +char _sibuf[BUFSIZ], _sobuf[BUFSIZ]; + +int ioflag; - int isn = 20000; +++long isn = 2000000; + +struct optab *oplook(); + +struct optab *getline(); +++long lgensym[10] = +++ {100000L,200000L,300000L,400000L,500000L,600000L,700000L,800000L,900000L,1000000L}; + + + +struct node * + +alloc(an) + +{ + + register int n; + + register char *p; + + + + n = an; - n++; - n &= ~01; +++ n+=sizeof(char *)-1; +++ n &= ~(sizeof(char *)-1); + + if (lasta+n >= lastr) { + + if (sbrk(2000) == -1) { + + fprintf(stderr, "Optimizer: out of space\n"); + + exit(1); + + } + + lastr += 2000; + + } + + p = lasta; + + lasta += n; + + return(p); + +} + + + +main(argc, argv) + +char **argv; + +{ + + register int niter, maxiter, isend; + + int nflag,infound; + + + + nflag = 0; infound=0; argc--; argv++; + + while (argc>0) {/* get flags */ + + if (**argv=='+') debug++; + + else if (**argv=='-') { + + if ((*argv)[1]=='i') ioflag++; else nflag++; + + } else if (infound==0) { + + if (freopen(*argv, "r", stdin) ==NULL) { + + fprintf(stderr,"C2: can't find %s\n", *argv); + + exit(1); + + } + + setbuf(stdin,_sibuf); ++infound; + + } else if (freopen(*argv, "w", stdout) ==NULL) { + + fprintf(stderr,"C2: can't create %s\n", *argv); + + exit(1); + + } + + setbuf(stdout,_sobuf); + + argc--; argv++; + + } + + lasta = lastr = sbrk(2); + + opsetup(); + + lasta = firstr = lastr = alloc(0); + + maxiter = 0; + + do { + + isend = input(); + + niter = 0; + + bmove(); + + do { + + refcount(); + + do { + + iterate(); + + clearreg(); + + niter++; + + } while (nchange); + + comjump(); + + rmove(); + + } while (nchange || jumpsw()); + + addsob(); + + output(); + + if (niter > maxiter) + + maxiter = niter; + + lasta = firstr; + + } while (isend); + + if (nflag) { + + fprintf(stderr,"%d iterations\n", maxiter); + + fprintf(stderr,"%d jumps to jumps\n", nbrbr); + + fprintf(stderr,"%d inst. after jumps\n", iaftbr); + + fprintf(stderr,"%d jumps to .+1\n", njp1); + + fprintf(stderr,"%d redundant labels\n", nrlab); + + fprintf(stderr,"%d cross-jumps\n", nxjump); + + fprintf(stderr,"%d code motions\n", ncmot); + + fprintf(stderr,"%d branches reversed\n", nrevbr); + + fprintf(stderr,"%d redundant moves\n", redunm); + + fprintf(stderr,"%d simplified addresses\n", nsaddr); + + fprintf(stderr,"%d loops inverted\n", loopiv); + + fprintf(stderr,"%d redundant jumps\n", nredunj); + + fprintf(stderr,"%d common seqs before jmp's\n", ncomj); + + fprintf(stderr,"%d skips over jumps\n", nskip); + + fprintf(stderr,"%d sob's added\n", nsob); + + fprintf(stderr,"%d redundant tst's\n", nrtst); + + fprintf(stderr,"%d jump on bit\n", nbj); + + fprintf(stderr,"%d field operations\n", nfield); + + fprintf(stderr,"%dK core\n", ((unsigned)lastr+01777) >> 10); + + } +++ putc('\n',stdout); + + fflush(stdout); exit(0); + +} + + + +input() + +{ + + register struct node *p, *lastp; + + struct optab *op; register char *cp1; + + static struct optab F77JSW = {".long", T(JSW,1)}; + + + + lastp = &first; + + for (;;) { + + top: + + op = getline(); + + if (debug && op==0) fprintf(stderr,"? %s\n",line); + + switch (op->opcode&0377) { + + + + case LABEL: + + p = alloc(sizeof first); - if (line[0] == 'L') { +++ if (isdigit(line[0]) && (p->labno=locdef(line)) || +++ (line[0] == 'L') && (p->labno=getnum(line+1))) { + + p->combop = LABEL; - p->labno = getnum(line+1); - if (isn<=p->labno) isn=1+p->labno; +++ if (p->labno<100000L && isn<=p->labno) isn=1+p->labno; + + p->code = 0; + + } else { + + p->combop = DLABEL; + + p->labno = 0; + + p->code = copy(line); + + } + + break; + + + + case LGEN: - if (*curlp!='L') goto std; +++ if (*curlp!='L' && !locuse(curlp)) goto std; + + op= &F77JSW; + + case JBR: - if (op->opcode==T(JBR,RET)) goto std; +++ if (op->opcode==T(JBR,RET) || op->opcode==T(JBR,RSB)) goto std; + + case CBR: + + case JMP: + + case JSW: + + case SOBGEQ: case SOBGTR: case AOBLEQ: case AOBLSS: case ACB: + + p = alloc(sizeof first); + + p->combop = op->opcode; p->code=0; cp1=curlp; - if (*cp1!='L' || 0==(p->labno = getnum(cp1+1))) {/* jbs, etc.? */ +++ if ((!isdigit(*cp1) || 0==(p->labno=locuse(cp1))) && +++ (*cp1!='L' || 0==(p->labno = getnum(cp1+1)))) {/* jbs, etc.? */ + + while (*cp1++); while (*--cp1!=',' && cp1!=curlp); - if (cp1==curlp || *++cp1!='L' || 0==(p->labno=getnum(cp1+1))) +++ if (cp1==curlp || +++ (!isdigit(*++cp1) || 0==(p->labno=locuse(cp1))) && +++ (*cp1!='L' || 0==(p->labno=getnum(cp1+1)))) + + p->labno = 0; + + else *--cp1=0; + + p->code = copy(curlp); + + } + + if (isn<=p->labno) isn=1+p->labno; + + break; + + + + case MOVA: + + p=alloc(sizeof first); - p->combop=op->opcode; p->code=0; cp1=curlp; - if (*cp1++=='L') { +++ p->combop=op->opcode; p->code=0; cp1=curlp+1; +++ if (cp1[-1]=='L' || isdigit(cp1[-1])) { + + while (*cp1++!=','); *--cp1=0; - if (0!=(p->labno=getnum(curlp+1))) p->code=copy(cp1+1); +++ if (0!=(p->labno=locuse(curlp)) || +++ 0!=(p->labno=getnum(curlp+1))) p->code=copy(cp1+1); + + else {*cp1=','; p->code=copy(curlp);} - /* new */ } else {p->code=copy(--cp1); p->labno=0;} +++ } else {p->code=copy(--cp1); p->labno=0;} + + break; + + + + case SET: +++ case COMM: +++ case LCOMM: + + printf("%s\n",line); goto top; + + + + case BSS: + + case DATA: + + for (;;) { + + printf("%s%c",line,(op->opcode==LABEL ? ':' : '\n')); + + if (op->opcode==TEXT) goto top; + + if (END==(op=getline())->opcode) {/* dangling .data is bad for you */ + + printf(".text\n"); + + break; + + } + + } + + + + std: + + default: + + p = alloc(sizeof first); + + p->combop = op->opcode; + + p->labno = 0; + + p->code = copy(curlp); + + break; + + + + } + + p->forw = 0; + + p->back = lastp; + + p->pop = op; + + lastp->forw = p; + + lastp = p; + + p->ref = 0; + + if (p->op==CASE) { + + char *lp; int ncase; + + lp=curlp; while (*lp++); while (*--lp!='$'); ncase=getnum(lp+1); + + if (LABEL!=(getline())->opcode) abort(-2); + + do { + + if (WGEN!=(getline())->opcode) abort(-3); + + p = alloc(sizeof first); p->combop = JSW; p->code = 0; + + lp=curlp; while(*lp++!='-'); *--lp=0; p->labno=getnum(curlp+1); + + if (isn<=p->labno) isn=1+p->labno; + + p->forw = 0; p->back = lastp; lastp->forw = p; lastp = p; + + p->ref = 0; p->pop=0; + + } while (--ncase>=0); + + } + + if (op->opcode==EROU) + + return(1); + + if (op->opcode==END) + + return(0); + + } + +} + + + +struct optab * + +getline() + +{ + + register char *lp; + + register c; + + static struct optab OPLABEL={"",LABEL}; + + static struct optab OPEND={"",END}; + + + + lp = line; + + while (EOF!=(c=getchar()) && isspace(c)); + + while (EOF!=c) { + + if (c==':') { + + *lp++ = 0; + + return(&OPLABEL); + + } + + if (c=='\n') { + + *lp++ = 0; + + return(oplook()); + + } + + *lp++ = c; + + c = getchar(); + + } + + *lp++ = 0; + + return(&OPEND); + +} + + + +long + +getnum(p) + +register char *p; + +{ + + register c; int neg; register long n; + + + + n = 0; neg=0; if (*p=='-') {++neg; ++p;} + + while (isdigit(c = *p++)) { + + c -= '0'; n *= 10; if (neg) n -= c; else n += c; + + } + + if (*--p != 0) + + return(0); + + return(n); + +} + + +++locuse(p) +++register char *p; +++{ +++ register c; int neg; register long n; +++ +++ if (!isdigit(p[0]) || p[1] != 'f' && p[1] != 'b' || p[2]) return(0); +++ return (lgensym[p[0] - '0'] - (p[1] == 'b')); +++} +++ +++locdef(p) +++register char *p; +++{ +++ +++ if (!isdigit(p[0]) || p[1]) return(0); +++ return (lgensym[p[0] - '0']++); +++} +++ + +output() + +{ + + register struct node *t; + + int casebas; + + + + t = &first; + + while (t = t->forw) switch (t->op) { + + + + case END: +++ fflush(stdout); + + return; + + + + case LABEL: + + printf("L%d:", t->labno); + + continue; + + + + case DLABEL: + + printf("%s:", t->code); + + continue; + + + + case CASE: + + casebas=0; + + + + default: std: + + if (t->pop==0) {/* must find it */ + + register struct optab *p; + + for (p=optab; p->opstring[0]; ++p) + + if (p->opcode==t->combop) {t->pop=p; break;} + + } + + printf("%s", t->pop->opstring); + + if (t->code) printf("\t%s", t->code); + + if (t->labno!=0) printf("%cL%d\n", + + (t->code ? ',' : '\t'), + + t->labno); + + else printf("\n"); + + continue; + + + + case MOVA: + + if (t->labno==0) goto std; + + printf("mova%c\tL%d,%s\n","bwlq"[t->subop-BYTE],t->labno,t->code); + + continue; + + + + case JSW: + + if (t->subop!=0) {/* F77JSW */ + + printf(".long\tL%d\n",t->labno); continue; + + } + + if (casebas==0) printf("L%d:\n",casebas=isn++); + + printf(".word L%d-L%d\n", t->labno, casebas); + + continue; + + + + } + +} + + + +char * + +copy(ap) + +char *ap; + +{ + + register char *p, *np; + + char *onp; + + register n; + + int na; + + + + na = nargs(); + + p = ap; + + n = 0; + + if (*p==0) + + return(0); + + do + + n++; + + while (*p++); + + if (na>1) { + + p = (&ap)[1]; + + while (*p++) + + n++; + + } + + onp = np = alloc(n); + + p = ap; + + while (*np++ = *p++); + + if (na>1) { + + p = (&ap)[1]; + + np--; + + while (*np++ = *p++); + + } + + return(onp); + +} + + + +#define OPHS 560 + +struct optab *ophash[OPHS]; + + + +opsetup() + +{ + + register struct optab *optp, **ophp; + + register int i,t; + + + + for(i=NREG+5;--i>=0;) regs[i]=alloc(20); + + for (optp = optab; optp->opstring[0]; optp++) { + + t=7; i=0; while (--t>=0) i+= i+optp->opstring[t]; + + ophp = &ophash[i % OPHS]; + + while (*ophp++) { + +/* fprintf(stderr,"\ncollision: %d %s %s", + +/* ophp-1-ophash,optp->opstring,(*(ophp-1))->opstring); + +*/ + + if (ophp > &ophash[OPHS]) + + ophp = ophash; + + } + + *--ophp = optp; + + } + +} + + + +struct optab * + +oplook() + +{ + + register struct optab *optp,**ophp; + + register char *p,*p2; + + register int t; + + char tempop[20]; + + static struct optab OPNULL={"",0}; + + + + for (p=line, p2=tempop; *p && !isspace(*p); *p2++= *p++); *p2=0; p2=p; + + while (isspace(*p2)) ++p2; curlp=p2; + + t=0; while(--p>=line) t += t+*p; ophp = &ophash[t % OPHS]; + + while (optp = *ophp) { + + if (equstr(tempop,optp->opstring)) return(optp); + + if ((++ophp) >= &ophash[OPHS]) ophp = ophash; + + } + + curlp = line; + + return(&OPNULL); + +} + + + +refcount() + +{ + + register struct node *p, *lp; + + struct node *labhash[LABHS]; + + register struct node **hp; + + + + for (hp = labhash; hp < &labhash[LABHS];) + + *hp++ = 0; + + for (p = first.forw; p!=0; p = p->forw) + + if (p->op==LABEL) { + + labhash[p->labno % LABHS] = p; + + p->refc = 0; + + } + + for (p = first.forw; p!=0; p = p->forw) { - if (p->op==JBR || p->op==CBR || p->op==JSW || p->op==JMP +++ if (p->combop==JBR || p->op==CBR || p->op==JSW || p->op==JMP + + || p->op==SOBGEQ || p->op==SOBGTR || p->op==AOBLEQ || p->op==AOBLSS + + || p->op==ACB || (p->op==MOVA && p->labno!=0)) { + + p->ref = 0; + + lp = labhash[p->labno % LABHS]; + + if (lp==0 || p->labno!=lp->labno) + + for (lp = first.forw; lp!=0; lp = lp->forw) { + + if (lp->op==LABEL && p->labno==lp->labno) + + break; + + } + + if (lp) { + + hp = nonlab(lp)->back; + + if (hp!=lp) { + + p->labno = hp->labno; + + lp = hp; + + } + + p->ref = lp; + + lp->refc++; + + } + + } + + } + + for (p = first.forw; p!=0; p = p->forw) + + if (p->op==LABEL && p->refc==0 + + && (lp = nonlab(p))->op && lp->op!=JSW) + + decref(p); + +} + + + +iterate() + +{ + + register struct node *p, *rp, *p1; + + + + nchange = 0; + + for (p = first.forw; p!=0; p = p->forw) { + + if ((p->op==JBR||p->op==CBR||p->op==JSW) && p->ref) { + + rp = nonlab(p->ref); + + if (rp->op==JBR && rp->labno && p->labno!=rp->labno) { + + nbrbr++; + + p->labno = rp->labno; + + decref(p->ref); + + rp->ref->refc++; + + p->ref = rp->ref; + + nchange++; + + } + + } +++#ifndef COPYCODE + + if (p->op==CBR && (p1 = p->forw)->combop==JBR) {/* combop: RET problems */ +++#else +++ if (p->op==CBR && (p1 = p->forw)->combop==JBR && +++ p->ref) {/* combop: RET problems */ +++#endif + + rp = p->ref; + + do + + rp = rp->back; + + while (rp->op==LABEL); + + if (rp==p1) { + + decref(p->ref); + + p->ref = p1->ref; + + p->labno = p1->labno; +++#ifdef COPYCODE +++ if (p->labno == 0) +++ p->code = p1->code; +++#endif + + p1->forw->back = p; + + p->forw = p1->forw; + + p->subop = revbr[p->subop]; + + p->pop=0; + + nchange++; + + nskip++; + + } + + } + + if (p->op==JBR || p->op==JMP) { + + while (p->forw && p->forw->op!=LABEL && p->forw->op!=DLABEL + + && p->forw->op!=EROU && p->forw->op!=END + + && p->forw->op!=ALIGN + + && p->forw->op!=0 && p->forw->op!=DATA) { + + nchange++; + + iaftbr++; + + if (p->forw->ref) + + decref(p->forw->ref); + + p->forw = p->forw->forw; + + p->forw->back = p; + + } + + rp = p->forw; + + while (rp && rp->op==LABEL) { + + if (p->ref == rp) { + + p->back->forw = p->forw; + + p->forw->back = p->back; + + p = p->back; + + decref(rp); + + nchange++; + + njp1++; + + break; + + } + + rp = rp->forw; + + } + + xjump(p); + + p = codemove(p); + + } + + } + +} + + + +xjump(p1) + +register struct node *p1; + +{ + + register struct node *p2, *p3; + + int nxj; + + + + nxj = 0; + + if ((p2 = p1->ref)==0) + + return(0); + + for (;;) { + + while ((p1 = p1->back) && p1->op==LABEL); + + while ((p2 = p2->back) && p2->op==LABEL); + + if (!equop(p1, p2) || p1==p2) + + return(nxj); + + p3 = insertl(p2); + + p1->combop = JBR; + + p1->pop=0; + + p1->ref = p3; + + p1->labno = p3->labno; + + p1->code = 0; + + nxj++; + + nxjump++; + + nchange++; + + } + +} + + + +struct node * + +insertl(op) + +register struct node *op; + +{ + + register struct node *lp; + + + + if (op->op == LABEL) { + + op->refc++; + + return(op); + + } + + if (op->back->op == LABEL) { + + op = op->back; + + op->refc++; + + return(op); + + } + + lp = alloc(sizeof first); + + lp->combop = LABEL; + + lp->labno = isn++; + + lp->ref = 0; + + lp->code = 0; + + lp->refc = 1; + + lp->back = op->back; + + lp->forw = op; + + op->back->forw = lp; + + op->back = lp; + + return(lp); + +} + + + +struct node * + +codemove(ap) + +struct node *ap; + +{ + + register struct node *p1, *p2, *p3; + + struct node *t, *tl; + + int n; + + + + p1 = ap; - if (p1->op!=JBR || (p2 = p1->ref)==0) +++/* last clause to avoid infinite loop on partial compiler droppings: +++ L183: jbr L179 +++ L191: jbr L179 +++ casel r0,$0,$1 +++ L193: .word L183-L193 +++ .word L191-L193 +++ L179: ret +++*/ +++ if (p1->op!=JBR || (p2 = p1->ref)==0 || p2==p1->forw) + + return(p1); + + while (p2->op == LABEL) + + if ((p2 = p2->back) == 0) + + return(p1); + + if (p2->op!=JBR && p2->op!=JMP) + + goto ivloop; + + p2 = p2->forw; + + p3 = p1->ref; + + while (p3) { + + if (p3->op==JBR || p3->op==JMP) { + + if (p1==p3) + + return(p1); + + ncmot++; + + nchange++; + + p1->back->forw = p2; + + p1->forw->back = p3; + + p2->back->forw = p3->forw; + + p3->forw->back = p2->back; + + p2->back = p1->back; + + p3->forw = p1->forw; + + decref(p1->ref); + + return(p2); + + } else + + p3 = p3->forw; + + } + + return(p1); + +ivloop: + + if (p1->forw->op!=LABEL) + + return(p1); + + p3 = p2 = p2->forw; + + n = 16; + + do { + + if ((p3 = p3->forw) == 0 || p3==p1 || --n==0) + + return(p1); + + } while (p3->op!=CBR || p3->labno!=p1->forw->labno); + + do + + if ((p1 = p1->back) == 0) + + return(ap); + + while (p1!=p3); + + p1 = ap; + + tl = insertl(p1); + + p3->subop = revbr[p3->subop]; + + p3->pop=0; + + decref(p3->ref); + + p2->back->forw = p1; + + p3->forw->back = p1; + + p1->back->forw = p2; + + p1->forw->back = p3; + + t = p1->back; + + p1->back = p2->back; + + p2->back = t; + + t = p1->forw; + + p1->forw = p3->forw; + + p3->forw = t; + + p2 = insertl(p1->forw); + + p3->labno = p2->labno; +++#ifdef COPYCODE +++ if (p3->labno == 0) +++ p3->code = p2->code; +++#endif + + p3->ref = p2; + + decref(tl); + + if (tl->refc<=0) + + nrlab--; + + loopiv++; + + nchange++; + + return(p3); + +} + + + +comjump() + +{ + + register struct node *p1, *p2, *p3; + + + + for (p1 = first.forw; p1!=0; p1 = p1->forw) - if (p1->op==JBR && ((p2 = p1->ref) && p2->refc > 1 || p1->subop==RET)) +++ if (p1->op==JBR && ((p2 = p1->ref) && p2->refc > 1 +++ || p1->subop==RET || p1->subop==RSB)) + + for (p3 = p1->forw; p3!=0; p3 = p3->forw) + + if (p3->op==JBR && p3->ref == p2) + + backjmp(p1, p3); + +} + + + +backjmp(ap1, ap2) + +struct node *ap1, *ap2; + +{ + + register struct node *p1, *p2, *p3; + + + + p1 = ap1; + + p2 = ap2; + + for(;;) { + + while ((p1 = p1->back) && p1->op==LABEL); + + p2 = p2->back; + + if (equop(p1, p2)) { + + p3 = insertl(p1); + + p2->back->forw = p2->forw; + + p2->forw->back = p2->back; + + p2 = p2->forw; + + decref(p2->ref); + + p2->combop = JBR; /* to handle RET */ + + p2->pop=0; + + p2->labno = p3->labno; +++#ifdef COPYCODE +++ p2->code = 0; +++#endif + + p2->ref = p3; + + nchange++; + + ncomj++; + + } else + + return; + + } + +} diff --cc usr/src/cmd/c2/c21.c index 0000000000,7e5aa06672,0000000000..6bc93b4aeb mode 000000,100644,000000..100644 --- a/usr/src/cmd/c2/c21.c +++ b/usr/src/cmd/c2/c21.c @@@@ -1,0 -1,955 -1,0 +1,1347 @@@@ - # - char C21[] = {"@(#)c21.c 1.59 79/01/20 11:07:52"}; /* sccs ident */ +++static char sccsid[] = "@(#)c21.c 4.3 10/17/80"; +++/* char C21[] = {"@(#)c21.c 1.83 80/10/16 21:18:22 JFR"}; /* sccs ident */ +++ + +/* + + * C object code improver-- second part + + */ + + - #include + +#include "c2.h" +++#include + +#include + + + +#define NUSE 6 - extern int ioflag; +++int ioflag; + +int biti[NUSE] = {1,2,4,8,16,32}; + +int bitsize[4] = {0,8,16,32}; /* index by type codes */ + +int pos,siz; long f; /* for bit field communication */ + +struct node *uses[NUSE]; /* for backwards flow analysis */ + +char *lastrand; /* last operand of instruction */ + +struct node *bflow(); + +struct node *bicopt(); + +char *findcon(); + + + +redun3(p,split) register struct node *p; int split; { + +/* check for 3 addr instr which should be 2 addr */ + + if (OP3==((p->subop>>4)&0xF)) { + + if (split) splitrand(p); + + if (equstr(regs[RT1],regs[RT3]) + + && (p->op==ADD || p->op==MUL || p->op==BIS || p->op==XOR)) { + + register char *t=regs[RT1]; regs[RT1]=regs[RT2]; regs[RT2]=t; + + } + + if (equstr(regs[RT2],regs[RT3])) { + + p->subop=(p->subop&0xF)|(OP2<<4); p->pop=0; + + lastrand=regs[RT2]; *regs[RT3]=0; return(1); + + } + + } return(0); + +} + + + +bmove() { + + register struct node *p, *lastp; register char *cp1,*cp2; register int r; + + refcount(); + + for (p=lastp= &first; 0!=(p=p->forw); lastp=p); + + clearreg(); clearuse(); + + for (p=lastp; p!= &first; p=p->back) { + + if (debug) { - for (r=NUSE;--r>=0;) if (uses[r]) printf("%d: %s\n",r,uses[r]->code); +++ printf("Uses:\n"); +++ for (r=NUSE;--r>=0;) if (uses[r]) +++ printf("%d: %s\n",r,uses[r]->code? uses[r]->code:""); + + printf("-\n"); + + } - if (OP3==((p->subop>>4)&0xF) && 0!=redun3(p,1)) {newcode(p); redunm++;} +++ r=(p->subop>>4)&0xF; +++ if (OP2==r && (cp1=p->code, *cp1++)=='$' && *cp1++=='0' && *cp1++==',' && +++ !source(cp1)) {/* a no-op unless MUL or DIV */ +++ if (p->op==MUL) {p->op=MOV; p->subop&=0xF; p->pop=0;} +++ else if (p->op==DIV) fprintf(stderr,"c2: zero divide\n"); +++ else {delnode(p); redunm++; continue;} +++ } +++ if (OP3==r && 0!=redun3(p,1)) {newcode(p); redunm++;} + + switch (p->op) { + + case LABEL: case DLABEL: - if (p->back && p->back->op==JBR && p->back->subop!=RET) - for (r=NUSE; --r>=0;) if (uses[r] && regs[r][0]!= -1) - p->ref=(struct node *) (((int)p->ref)|biti[r]); - case CALLS: case 0: +++ for (r=NUSE; --r>=0;) +++ if (uses[r]) p->ref=(struct node *) (((int)p->ref)|biti[r]); +++ break; +++ case CALLS: +++ clearuse(); goto std; +++ case 0: + + clearuse(); break; + + case SUB: + + if ((p->subop&0xF)!=LONG) goto std; cp1=p->code; + + if (*cp1++!='$') goto std; splitrand(p); + + if (equstr(regs[RT2],"fp") && !indexa(regs[RT1])) {/* address comp. */ + + char buf[50]; cp2=buf; *cp2++='-'; + + cp1=regs[RT1]+1; while (*cp2++= *cp1++); --cp2; + + cp1="(fp),"; while (*cp2++= *cp1++); --cp2; + + cp1=regs[RT3]; while (*cp2++= *cp1++); + + p->code=copy(buf); p->combop=T(MOVA,LONG); p->pop=0; + + } else if (*cp1++=='-' && 0<=(r=getnum(cp1))) { + + p->op=ADD; p->pop=0; *--cp1='$'; p->code=cp1; + + } goto std; + + case ADD: + + if ((p->subop&0xF)!=LONG) goto std; cp1=p->code; + + if (*cp1++!='$') goto std; splitrand(p); +++ if (isstatic(cp1) && (r=isreg(regs[RT2]))>=0 && rforw) +++ { +++ /* address comp: +++ ** addl2 $_foo,r0 \ movab _foo[r0],bar +++ ** movl r0,bar / +++ */ +++ register struct node *pnext = p->forw; +++ char buf[50]; +++ +++ if (pnext->op == MOV && pnext->subop == LONG) +++ { +++ cp1 = ®s[RT1][1]; cp2 = &buf[0]; +++ while (*cp2++ = *cp1++) ; cp2--; +++ splitrand(pnext); +++ if (r == isreg(regs[RT1])) +++ { +++ delnode(p); p = pnext; +++ p->op = MOVA; p->subop = BYTE; +++ p->pop = 0; +++ cp1 = regs[RT1]; *cp2++ = '['; +++ while (*cp2++ = *cp1++) ; cp2--; +++ *cp2++ = ']'; *cp2++ = ','; +++ cp1 = regs[RT2]; +++ while (*cp2++ = *cp1++) ; +++ p->code = copy(buf); +++ } +++ } +++ } +++ else + + if (equstr(regs[RT2],"fp") && !indexa(regs[RT1])) {/* address comp. */ + + cp2=cp1-1; cp1=regs[RT1]+1; while (*cp2++= *cp1++); --cp2; + + cp1="(fp)"; while (*cp2++= *cp1++); *--cp2=','; + + p->combop=T(MOVA,LONG); p->pop=0; + + } else if (*cp1++=='-' && 0<=(r=getnum(cp1))) { + + p->op=SUB; p->pop=0; *--cp1='$'; p->code=cp1; + + } +++ /* fall thru ... */ + + case CASE: + + default: std: + + p=bflow(p); break; - case JBR: - if (p->subop==RET) {uses[0]=p; regs[0][0]= -1; break;} - else if (p->ref->ref!=0) for (r=NUSE;--r>=0;) +++ case MUL: +++ { +++ /* +++ ** Change multiplication by constant powers of 2 to +++ ** shifts. +++ */ +++ splitrand(p); +++ if (regs[RT1][0] != '$' || regs[RT1][1] == '-') goto std; +++ if ((r = ispow2(getnum(®s[RT1][1]))) < 0) goto std; +++ switch (r) +++ { +++ case 0: /* mull3 $1,x,y */ +++ if (p->subop == U(LONG,OP3)) +++ { +++ if (equstr(regs[RT2], regs[RT3])) +++ { +++ delnode(p); p = p->forw; +++ } +++ else +++ { +++ p->op = MOV; p->subop = LONG; +++ p->pop = 0; newcode(p); nchange++; +++ } +++ } +++ else +++ if (p->subop == U(LONG,OP2)) +++ { +++ delnode(p); p = p->forw; +++ } +++ goto std; +++ +++ case 1: /* mull2 $2,x */ +++ if (p->subop == U(LONG, OP2) && !source(regs[RT2])) +++ { +++ strcpy(regs[RT1], regs[RT2]); +++ p->op = ADD; p->pop = 0; newcode(p); nchange++; +++ } +++ goto std; +++ } +++ if(p->subop==U(LONG,OP3)||(p->subop==U(LONG,OP2)&&!source(regs[RT2]))) +++ { +++ if (p->subop == U(LONG,OP2)) +++ strcpy(regs[RT3], regs[RT2]); +++ sprintf(regs[RT1], "$%d", r); +++ p->op = ASH; p->subop = LONG; +++ p->pop = 0; newcode(p); nchange++; +++ } +++ goto std; +++ } +++ case ASH: +++ { +++ /* address comp: +++ ** ashl $1,bar,r0 \ movl bar,r0 +++ ** movab _foo[r0] / movaw _foo[r0] +++ ** +++ ** ashl $2,r0,r0 \ moval _foo[r0] +++ ** movab _foo[r0] / +++ */ +++ register struct node *pf; +++ register int shfrom, shto; +++ long shcnt; +++ char *regfrom; +++ +++ splitrand(p); +++ if (regs[RT1][0] != '$') goto std; +++ if ((shcnt = getnum(®s[RT1][1])) < 1 || shcnt > 3) goto std; +++ if ((shfrom = isreg(regs[RT2])) >= 0) +++ regfrom = copy(regs[RT2],"]"); +++ if ((shto = isreg(regs[RT3])) >= 0 && shtoforw)) goto ashadd; +++ if (pf->op != MOVA && pf->op != PUSHA) goto ashadd; +++ if (pf->subop != BYTE) goto ashadd; +++ splitrand(pf); +++ if (!indexa(regs[RT1])) goto std; +++ cp2 = regs[RT1]; +++ if(!isstatic(cp2)) goto std; +++ while (*cp2++ != '[') ; +++ if (*cp2++ != 'r' || !isdigit(*cp2)) goto std; +++ regnum = *cp2++ - '0'; +++ if (isdigit(*cp2)) +++ { +++ if (cp2[1] != ']') goto std; +++ regnum *= 10; regnum += *cp2 - '0'; +++ } +++ if (regnum != shto) goto std; +++ if (shfrom >= 0) /* ashl $N,r*,r0 */ +++ { +++ delnode(p); +++ if (shfrom != shto) +++ { +++ uses[shto] = NULL; splitrand(pf); +++ cp2=regs[RT1]; while (*cp2++!='['); +++ cp1=regfrom; while (*cp2++= *cp1++); +++ newcode(pf); +++ } +++ } +++ else +++ { +++ p->op = MOV; splitrand(p); +++ strcpy(regs[RT1], regs[RT2]); +++ strcpy(regs[RT2], regs[RT3]); +++ regs[RT3][0] = '\0'; +++ p->pop = 0; newcode(p); +++ } +++ switch (shcnt) +++ { +++ case 1: pf->subop = WORD; break; +++ case 2: pf->subop = LONG; break; +++ case 3: pf->subop = QUAD; break; +++ } +++ redunm++; nsaddr++; nchange++; +++ } +++ goto std; +++ashadd: +++ /* at this point, RT2 and RT3 are guaranteed to be simple regs*/ +++ if (shcnt == 1 && equstr(regs[RT2], regs[RT3])) +++ { +++ /* +++ ** quickie: +++ ** ashl $1,A,A > addl2 A,A +++ */ +++ p->op = ADD; p->subop = U(LONG,OP2); p->pop = 0; +++ strcpy(regs[RT1], regs[RT2]); regs[RT3][0] = '\0'; +++ newcode(p); nchange++; +++ } +++ goto std; +++ } +++ +++ case EXTV: +++ case EXTZV: +++ { +++ /* bit tests: +++ ** extv A,$1,B,rC \ +++ ** tstl rC > jbc A,B,D +++ ** jeql D / +++ ** +++ ** also byte- and word-size fields: +++ ** extv $n*8,$8,A,B > cvtbl n+A,B +++ ** extv $n*16,$16,A,B > cvtwl n+A,B +++ ** extzv $n*8,$8,A,B > movzbl n+A,B +++ ** extzv $n*16,$16,A,B > movzwl n+A,B +++ */ +++ register struct node *pf; /* forward node */ +++ register struct node *pn; /* next node (after pf) */ +++ int flen; /* field length */ +++ +++ splitrand(p); +++ if (regs[RT2][0] != '$') goto std; +++ if ((flen = getnum(®s[RT2][1])) < 0) goto std; +++ if (flen == 1) +++ { +++ register int extreg; /* reg extracted to */ +++ +++ extreg = isreg(regs[RT4]); +++ if (extreg < 0 || extreg >= NUSE) goto std; +++ if ((pf = p->forw)->op != TST) goto std; +++ if (uses[extreg] && uses[extreg] != pf) goto std; +++ splitrand(pf); +++ if (extreg != isreg(regs[RT1])) goto std; +++ if ((pn = pf->forw)->op != CBR) goto std; +++ if (pn->subop != JEQ && pn->subop != JNE) goto std; +++ delnode(p); delnode(pf); +++ pn->subop = (pn->subop == JEQ) ? JBC : JBS; +++ for(cp2=p->code; *cp2++!=',';); +++ for(cp1=cp2; *cp1++!=',';); +++ while (*cp1!=',') *cp2++= *cp1++; *cp2='\0'; +++ pn->code = p->code; pn->pop = NULL; +++ uses[extreg] = NULL; +++ } +++ else +++ if (flen == 8 || flen == 16) +++ { +++ register int boff; /* bit offset */ +++ register int coff; /* chunk (byte or word) offset*/ +++ +++ if (regs[RT1][0] != '$') goto std; +++ if ((boff = getnum(®s[RT1][1])) < 0) goto std; +++ coff = boff / flen; +++ if (coff && (isreg(regs[RT3]) >= 0)) goto std; +++ if (boff < 0 || (boff % flen) != 0) goto std; +++ p->op = (p->op == EXTV) ? CVT : MOVZ; +++ p->subop = U((flen == 8 ? BYTE : WORD), LONG); +++ if (coff == 0) +++ strcpy(regs[RT1], regs[RT3]); +++ else +++ sprintf(regs[RT1], "%d%s%s", coff, regs[RT3][0]=='(' ? "":"+", +++ regs[RT3]); +++ strcpy(regs[RT2], regs[RT4]); +++ regs[RT3][0] = '\0'; regs[RT4][0] = '\0'; +++ p->pop = 0; newcode(p); +++ } +++ nchange++; +++ goto std; +++ } +++ +++ case CMP: +++ { +++ /* comparison to -63 to -1: +++ ** cmpl r0,$-1 > incl r0 +++ ** jeql ... +++ ** +++ ** cmpl r0,$-63 > addl2 $63,r0 +++ ** jeql ... +++ */ +++ register int num; +++ register int reg; +++ register struct node *regp = p->back; +++ +++ if (p->forw->op != CBR) goto std; +++ if (p->forw->subop != JEQ && p->forw->subop != JNE) goto std; +++ splitrand(p); +++ if (strncmp(regs[RT2], "$-", 2) != 0) goto std; +++ reg = r = isreg(regs[RT1]); +++ if (r < 0) goto std; +++ if (r < NUSE && uses[r] != 0) goto std; +++ if (r >= NUSE && regp->op == MOV && p->subop == regp->subop) +++ { +++ if (*regp->code != 'r') goto std; +++ reg = regp->code[1] - '0'; +++ if (isdigit(regp->code[2]) || reg >= NUSE || uses[reg]) +++ goto std; +++ } +++ if (r >= NUSE) goto std; +++ if (reg != r) +++ sprintf(regs[RT1], "r%d", reg); +++ if ((num = getnum(®s[RT2][2])) <= 0 || num > 63) goto std; +++ if (num == 1) +++ { +++ p->op = INC; regs[RT2][0] = '\0'; +++ } +++ else +++ { +++ register char *t; +++ +++ t=regs[RT1];regs[RT1]=regs[RT2];regs[RT2]=t; +++ p->op = ADD; p->subop = U(p->subop, OP2); +++ for (t = ®s[RT1][2]; t[-1] = *t; t++) ; +++ } +++ p->pop = 0; newcode(p); +++ nchange++; +++ goto std; +++ } +++ +++ case JSB: +++ if (equstr(p->code,"mcount")) {uses[0]=p; regs[0][0]= -1;} +++ goto std; +++ case JBR: case JMP: +++ clearuse(); +++ if (p->subop==RET || p->subop==RSB) {uses[0]=p; regs[0][0]= -1; break;} +++ if (p->ref==0) goto std; /* jmp (r0) */ +++ /* fall through */ +++ case CBR: +++ if (p->ref->ref!=0) for (r=NUSE;--r>=0;) + + if (biti[r] & (int)p->ref->ref) {uses[r]=p; regs[r][0]= -1;} - case CBR: case JMP: case EROU: case JSW: +++ case EROU: case JSW: + + case TEXT: case DATA: case BSS: case ALIGN: case WGEN: case END: ; + + } + + } +++ for (p= &first; p!=0; p=p->forw) +++ if (p->op==LABEL || p->op==DLABEL) p->ref=0; /* erase our tracks */ + +} + + + +rmove() + +{ + + register struct node *p, *lastp; + + register int r; + + int r1; + + + + clearreg(); + + for (p=first.forw; p!=0; p = p->forw) { + + lastp=p; + + if (debug) { +++ printf("Regs:\n"); + + for (r=0; r>4, regs[r]+1); + + } + + printf("-\n"); + + } + + switch (p->op) { + + + + case CVT: + + splitrand(p); goto mov; + + + + case MOV: + + splitrand(p); + + if ((r = findrand(regs[RT1],p->subop)) >= 0) { + + if (r == isreg(regs[RT2]) && p->forw->op!=CBR) { + + delnode(p); redunm++; break; + + } + + } - mov: +++mov: + + repladdr(p); + + r = isreg(regs[RT1]); + + r1 = isreg(regs[RT2]); + + dest(regs[RT2],p->subop); - if (r >= 0) - if (r1 >= 0) savereg(r1, regs[r]+1, p->subop); - else savereg(r, regs[RT2], p->subop); - else - if (r1 >= 0) savereg(r1, regs[RT1], p->subop); - else setcon(regs[RT1], regs[RT2], p->subop); +++ if (r>=0) { +++ if (r1>=0) savereg(r1, regs[r]+1, p->subop); +++ else if (p->op!=CVT) savereg(r, regs[RT2], p->subop); +++ } else if (r1>=0) savereg(r1, regs[RT1], p->subop); +++ else if (p->op!=CVT) setcon(regs[RT1], regs[RT2], p->subop); + + break; + + + +/* .rx,.wx */ +++ case MFPR: + + case COM: + + case NEG: + +/* .rx,.wx or .rx,.rx,.wx */ + + case ADD: + + case SUB: + + case BIC: + + case BIS: + + case XOR: + + case MUL: + + case DIV: + + case ASH: + + case MOVZ: + +/* .rx,.rx,.rx,.wx */ + + case EXTV: + + case EXTZV: + + case INSV: + + splitrand(p); + + repladdr(p); + + dest(lastrand,p->subop); + + if (p->op==INSV) ccloc[0]=0; + + break; + + + +/* .mx or .wx */ + + case CLR: + + case INC: + + case DEC: + + splitrand(p); + + dest(lastrand,p->subop); + + if (p->op==CLR) + + if ((r = isreg(regs[RT1])) >= 0) + + savereg(r, "$0", p->subop); + + else + + setcon("$0", regs[RT1], p->subop); + + break; + + + +/* .rx */ + + case TST: + + case PUSH: + + splitrand(p); + + lastrand=regs[RT1+1]; /* fool repladdr into doing 1 operand */ + + repladdr(p); + + if (p->op==TST && equstr(lastrand=regs[RT1], ccloc+1) - && equtype(ccloc[0],p->subop) &&!source(lastrand)) { +++ && ((0xf&(ccloc[0]>>4))==p->subop || equtype(ccloc[0],p->subop)) +++ &&!source(lastrand)) { + + delnode(p); p = p->back; nrtst++; nchange++; + + } + + setcc(lastrand,p->subop); + + break; + + + +/* .rx,.rx,.rx */ +++ case PROBER: +++ case PROBEW: + + case CASE: +++ case MOVC3: + +/* .rx,.rx */ +++ case MTPR: + + case CALLS: + + case CMP: + + case BIT: + + splitrand(p); + + /* fool repladdr into doing right number of operands */ - if (p->op!=CASE) lastrand=regs[RT3]; else lastrand=regs[RT4]; +++ if (p->op==CASE || p->op==MOVC3 || p->op==PROBER || p->op==PROBEW) +++ lastrand=regs[RT4]; +++ else lastrand=regs[RT3]; + + repladdr(p); - if (p->op==CALLS) clearreg(); +++ if (p->op==CALLS || p->op==MOVC3) clearreg(); + + if (p->op==BIT) bitopt(p); + + ccloc[0]=0; break; + + + + case CBR: - if (p->subop>=JBC) {/* 2 operands can be optimized */ - splitrand(p); lastrand=regs[RT3]; repladdr(p); +++ if (p->subop>=JBC) { +++ splitrand(p); +++ if (p->subopsubop>>4)) return(regs[RT3]); + + switch (p->op) { +++ case MFPR: +++ case JSB: + + case PUSHA: + + case TST: case INC: case DEC: case PUSH: return(regs[RT2]); +++ case MTPR: + + case BIT: case CMP: case CALLS: return(regs[RT3]); - case CASE: return(regs[RT4]); +++ case PROBER: case PROBEW: +++ case CASE: case MOVC3: return(regs[RT4]); + + } + + return(lastrand); + +} + + + +struct node * - bflow(p) register struct node *p; { +++bflow(p) +++register struct node *p; +++{ + + register char *cp1,*cp2,**preg; register int r; +++ int flow= -1; +++ struct node *olduse=0; + + splitrand(p); - if (0<=(r=isreg(lastrand)) && rop!=PUSH && - uses[r]==p->forw && p->subop && equtype(regs[r][0],p->subop)) { +++ if (p->op!=PUSH && p->subop && 0<=(r=isreg(lastrand)) && rforw) { +++ if (equtype(p->subop,regs[r][0]) +++ || ((p->op==CVT || p->op==MOVZ) +++ && 0xf®s[r][0] && compat(0xf&(p->subop>>4),regs[r][0]))) { +++ register int r2; + + if (regs[r][1]!=0) {/* send directly to destination */ + + if (p->op==INC || p->op==DEC) { + + if (p->op==DEC) p->op=SUB; else p->op=ADD; + + p->subop=(OP2<<4)+(p->subop&0xF); /* use 2 now, convert to 3 later */ + + p->pop=0; + + cp1=lastrand; cp2=regs[RT2]; while (*cp2++= *cp1++); /* copy reg */ + + cp1=lastrand; *cp1++='$'; *cp1++='1'; *cp1=0; + + } + + cp1=regs[r]+1; cp2=lastrand; + + if (OP2==(p->subop>>4)) {/* use 3 operand form of instruction */ + + p->pop=0; + + p->subop += (OP3-OP2)<<4; lastrand=cp2=regs[RT3]; + + } + + while (*cp2++= *cp1++); + + if (p->op==MOVA && p->forw->op==PUSH) { + + p->op=PUSHA; *regs[RT2]=0; p->pop=0; +++ } else if (p->op==MOV && p->forw->op==PUSH) { +++ p->op=PUSH ; *regs[RT2]=0; p->pop=0; + + } + + delnode(p->forw); +++ if (0<=(r2=isreg(lastrand)) && r2op==MOV && p->forw->op!=EXTV && p->forw->op!=EXTZV) { + + /* superfluous fetch */ + + int nmatch; - char src[20]; cp2=src; cp1=regs[RT1]; while (*cp2++= *cp1++); - splitrand(p->forw); lastrand=byondrd(p->forw); nmatch=0; - for (preg=regs+RT1;*preg!=lastrand;preg++) if (r==isreg(*preg)) { +++ char src[20]; +++ movit: +++ cp2=src; cp1=regs[RT1]; while (*cp2++= *cp1++); +++ splitrand(p->forw); +++ if (p->forw->op != INC && p->forw->op != DEC) +++ lastrand=byondrd(p->forw); +++ nmatch=0; +++ for (preg=regs+RT1;*preg!=lastrand;preg++) +++ if (r==isreg(*preg)) { + + cp2= *preg; cp1=src; while (*cp2++= *cp1++); ++nmatch; + + } + + if (nmatch==1) { + + if (OP2==(p->forw->subop>>4) && equstr(src,regs[RT2])) { + + p->forw->pop=0; + + p->forw->subop += (OP3-OP2)<<4; cp1=regs[RT3]; + + *cp1++='r'; *cp1++=r+'0'; *cp1=0; + + } + + delnode(p); p=p->forw; +++ if (0<=(r2=isreg(src)) && r2op==MOV && (p->forw->op==CVT || p->forw->op==MOVZ) +++ && p->forw->subop&0xf /* if base or index, then forget it */ +++ && compat(p->subop,p->forw->subop) && !source(cp1=regs[RT1]) +++ && !indexa(cp1)) goto movit; + + } + + /* adjust 'lastrand' past any 'read' or 'modify' operands. */ + + lastrand=byondrd(p); + + /* a 'write' clobbers the register. */ + + if (0<=(r=isreg(lastrand)) && rsubop>>4) && 0<=(r=isreg(regs[RT2])) && rsubop>>4) && 0<=(r=isreg(regs[RT2])) && rop) { +++ case ACB: +++ case AOBLEQ: case AOBLSS: case SOBGTR: case SOBGEQ: break; +++ default: +++ if (uses[r]==0) {/* no direct uses, check for use of condition codes */ +++ register struct node *q=p; +++ while ((q=nonlab(q->forw))->combop==JBR) q=q->ref; /* cc unused, unchanged */ +++ if (q->op!=CBR) {/* ... and destroyed */ +++ preg=regs+RT1; +++ while (cp1= *preg++) { +++ if (cp1==lastrand) {redunm++; delnode(p); return(p->forw);} +++ if (source(cp1) || equstr(cp1,lastrand)) break; +++ } +++ } +++ } +++ flow=r; +++ } +++ } +++ if (0<=(r=flow)) {olduse=uses[r]; uses[r]=0; *(short *)(regs[r])=0;} +++ /* these two are here, rather than in bmove(), +++ /* because I decided that it was better to go for 3-address code +++ /* (save time) rather than fancy jbxx (save 1 byte) +++ /* on sequences like bisl2 $64,r0; movl r0,foo +++ */ + + if (p->op==BIC) {p=bicopt(p); splitrand(p); lastrand=byondrd(p);} - if (p->op==BIS) bixprep(p,JBSS); +++ if (p->op==BIS) {bixprep(p,JBSS); lastrand=byondrd(p);} + + /* now look for 'read' or 'modify' (read & write) uses */ + + preg=regs+RT1; + + while (*(cp1= *preg++)) { + + /* check for r */ + + if (lastrand!=cp1 && 0<=(r=isreg(cp1)) && rsubop; - if (p->op==MOV || p->op==PUSH) { - if (p->op==PUSH) cp1="-(sp)"; else cp1=regs[RT2]; - while (*cp2++= *cp1++); - } else *cp2++=0; +++ if (p->op==ASH && preg==(regs+RT1+1)) cp2[-1]=BYTE; /* stupid DEC */ +++ if (p->op==MOV || p->op==PUSH || p->op==CVT || p->op==MOVZ || p->op==COM || p->op==NEG) { +++ if (p->op==PUSH) cp1="-(sp)"; +++ else { +++ cp1=regs[RT2]; +++ if (0<=(r=isreg(cp1)) && rop!=MOV) cp1=0; +++ } +++ if (cp1) while (*cp2++= *cp1++); +++ else *cp2=0; +++ } else *cp2=0; + + continue; + + } + + /* check for (r),(r)+,-(r),[r] */ + + do if (*cp1=='(' || *cp1=='[') {/* get register number */ + + char t; + + cp2= ++cp1; while (*++cp1!=')' && *cp1!=']'); t= *cp1; *cp1=0; + + if (0<=(r=isreg(cp2)) && rcombop==T(MOV,LONG)) { + + if (regs[RT1][1]=='L' && 0!=(p->labno=getnum(regs[RT1]+2))) { + + cp1=p->code; while (*cp1++!=','); p->code= --cp1; + + } + + p->combop=T(MOVA,LONG); ++p->code; p->pop=0; + + } else if (p->combop==T(PUSH,LONG)) { + + p->combop=T(PUSHA,LONG); ++p->code; p->pop=0; + + } else if ((p->combop&0xFFFF)==T(ADD,U(LONG,OP3)) + + && 0<=(r=isreg(regs[RT2]))) { + + cp1=cp2=p->code; ++cp1; + + do *cp2++= *cp1; while (*cp1++!=','); cp2[-1]='['; + + do *cp2++= *cp1; while (*cp1++!=','); cp2[-1]=']'; + + if (!equstr(regs[RT3],"-(sp)")) p->combop=T(MOVA,BYTE); + + else {p->combop=T(PUSHA,BYTE); *cp2=0;} + + if (uses[r]==0) {uses[r]=p; regs[r][0]=OPX<<4;} + + p->pop=0; + + } + + } + + return(p); + +} + + + +ispow2(n) register long n; {/* -1 -> no; else -> log to base 2 */ + + register int log; + + if (n==0 || n&(n-1)) return(-1); log=0; + + for (;;) {n >>= 1; if (n==0) return(log); ++log; if (n== -1) return(log);} + +} + + + +bitopt(p) register struct node *p; { + + /* change "bitx $,a" followed by JEQ or JNE + + /* into JBC or JBS. watch out for I/O registers. (?) + + /* assumes that 'splitrand' has already been called. + + */ + + register char *cp1,*cp2; int b; + + cp1=regs[RT1]; cp2=regs[RT2]; + + if (*cp1++!='$' || !okio(cp2) || p->forw->op!=CBR || p->forw->subop&-2 || - 0>(b=ispow2(getnum(cp1))) || p->subop!=BYTE && indexa(cp2)) return; +++ 0>(b=ispow2(getnum(cp1))) || +++ p->subop!=BYTE && (source(cp2) || indexa(cp2))) return; + + if (b>=bitsize[p->subop]) {/* you dummy! */ + + if (source(cp2)) {/* side effect: auto increment or decrement */ + + p->pop=0; + + p->op=TST; --cp1; while (*cp1++= *cp2++); + + regs[RT2][0]=0; newcode(p); + + } else delnode(p); + + p = p->forw; + + if (p->subop==JEQ) {p->combop=JBR; p->pop=0;} + + else delnode(p); + + nchange++; nbj++; return; + + } + + if (cp1=p->forw->code) {/* destination is not an internal label */ + + cp2=regs[RT3]; while (*cp2++= *cp1++); + + } + + if (b==0 && (p->subop==LONG || !indexa(regs[RT2]))) {/* JLB optimization, ala BLISS */ + + cp2=regs[RT1]; cp1=regs[RT2]; while (*cp2++= *cp1++); + + cp2=regs[RT2]; cp1=regs[RT3]; while (*cp2++= *cp1++); + + *(regs[RT3])=0; p->forw->subop += JLBC-JBC; + + p->forw->pop=0; + + } else { + + cp1=regs[RT1]+1; + + if (b>9) *cp1++= b/10 +'0'; *cp1++= b%10 +'0'; *cp1=0; /* $ */ + + } + + nbj++; newcode(p); p->combop = p->forw->combop+((JBC-JEQ)<<8); + + p->labno = p->forw->labno; delnode(p->forw); + + p->pop=0; + +} + + + +isfield(n) register long n; {/* -1 -> no; else -> position of low bit */ + + register int pos; register long t; + + t= ((n-1)|n) +1; + + if (n!=0 && (0==t || 0==n || 0<=ispow2(t))) { + + pos=0; while(!(n&1)) {n >>= 1; ++pos;} return(pos); + + } else return(-1); + +} + + + +bixprep(p,bix) register struct node *p; { + +/* initial setup, single-bit checking for bisopt, bicopt. + +/* return: 0->don't bother any more; 1->worthwhile trying + +*/ + + register char *cp1,*cp2; + + splitrand(p); cp1=regs[RT1]; cp2=regs[RT2]; + + if (*cp1++!='$' || 0>(pos=isfield(f=getnum(cp1))) + + || !okio(cp2) || indexa(cp2) || source(cp2) || !okio(lastrand)) return(0); + + f |= f-1; if (++f==0) siz=32-pos; else siz=ispow2(f)-pos; + + if (siz==1 && pos>5 && (p->subop>>4)==OP2 && (p->subop&0xF)!=BYTE + + && possubop&0xF]) { + + p->ref = insertl(p->forw); p->combop = CBR | (bix<<8); + + p->pop=0; + + p->labno = p->ref->labno; + + if (pos>9) {*cp1++= pos/10 +'0'; pos %= 10;} + + *cp1++=pos+'0'; *cp1=0; newcode(p); nbj++; return(0); + + } + + return(1); + +} + + + + + +struct node * + +bicopt(p) register struct node *p; { + +/* use field operations or MOVZ if possible. done as part of 'bflow'. + +*/ + + register char *cp1,*cp2; int r; + + char src[50]; + + if (!bixprep(p,JBCC)) return(p); - if (f<=0) {/* the BIC isolates low order bits */ +++ if (f==0) {/* the BIC isolates low order bits */ + + siz=pos; pos=0; + + if ((p->subop&0xF)==LONG && *(regs[RT2])!='$') {/* result of EXTZV is long */ + + /* save source of BICL in 'src' */ + + cp1=regs[RT2]; cp2=src; while (*cp2++= *cp1++); + + if (p->back->op==ASH) {/* try for more */ + + splitrand(p->back); cp1=regs[RT1]; cp2=regs[RT3]; + + if (*cp1++=='$' && *(regs[RT2])!='$' && !indexa(regs[RT2]) + + && 0>(f=getnum(cp1)) && equstr(src,cp2) - && 0<=(r=isreg(cp2)) && rback); + + } + + } + + if (p->back->op==CVT || p->back->op==MOVZ) {/* greedy, aren't we? */ + + splitrand(p->back); cp1=regs[RT1]; cp2=regs[RT2]; + + if (equstr(src,cp2) && okio(cp1) && !indexa(cp1) - && 0<=(r=isreg(cp2)) && rback->subop&0xF]>=(pos+siz) + + && bitsize[p->back->subop>>4]>=(pos+siz)) {/* good CVT */ + + cp1=regs[RT1]; cp2=src; while (*cp2++= *cp1++); + + delnode(p->back); + + } + + } + + /* 'pos', 'siz' known; source of field is in 'src' */ + + splitrand(p); /* retrieve destination of BICL */ + + if (siz==8 && pos==0) { + + p->combop = T(MOVZ,U(BYTE,LONG)); + + sprintf(line,"%s,%s",src,lastrand); + + } else { + + p->combop = T(EXTZV,LONG); + + sprintf(line,"$%d,$%d,%s,%s",pos,siz,src,lastrand); + + } + + p->pop=0; + + p->code = copy(line); nfield++; return(p); + + }/* end EXTZV possibility */ + + }/* end low order bits */ + +/* unfortunately, INSV clears the condition codes, thus cannot be used */ + +/* else {/* see if BICL2 of positive field should be INSV $0 */ + +/* if (p->subop==(LONG | (OP2<<4)) && 6<=(pos+siz)) { + +/* p->combop = INSV; + +/* sprintf(line,"$0,$%d,$%d,%s",pos,siz,lastrand); + +/* p->code = copy(line); nfield++; return(p); + +/* } + +/* } + +*/ + + return(p); + +} + + + +jumpsw() + +{ + + register struct node *p, *p1; + + register t; + + int nj; + + + + t = 0; + + nj = 0; + + for (p=first.forw; p!=0; p = p->forw) + + p->seq = ++t; + + for (p=first.forw; p!=0; p = p1) { + + p1 = p->forw; + + if (p->op == CBR && p1->op==JBR && p->ref && p1->ref + + && abs(p->seq - p->ref->seq) > abs(p1->seq - p1->ref->seq)) { + + if (p->ref==p1->ref) + + continue; + + p->subop = revbr[p->subop]; + + p->pop=0; + + t = p1->ref; + + p1->ref = p->ref; + + p->ref = t; + + t = p1->labno; + + p1->labno = p->labno; + + p->labno = t; +++#ifdef COPYCODE +++ if (p->labno == 0) { +++ t = p1->code; p1->code = p->code; p->code = t; +++ } +++#endif + + nrevbr++; + + nj++; + + } + + } + + return(nj); + +} + + + +addsob() + +{ + + register struct node *p, *p1, *p2, *p3; + + + + for (p = &first; (p1 = p->forw)!=0; p = p1) { + + if (p->combop==T(DEC,LONG) && p1->op==CBR) { + + if (abs(p->seq - p1->ref->seq) > 12) continue; + + if (p1->subop==JGE || p1->subop==JGT) { + + if (p1->subop==JGE) p->combop=SOBGEQ; else p->combop=SOBGTR; + + p->pop=0; + + p->labno = p1->labno; delnode(p1); nsob++; + + } + + } else if (p->combop==T(INC,LONG)) { + + if (p1->op==LABEL && p1->refc==1 && p1->forw->combop==T(CMP,LONG) + + && (p2=p1->forw->forw)->combop==T(CBR,JLE) + + && (p3=p2->ref->back)->combop==JBR && p3->ref==p1 + + && p3->forw->op==LABEL && p3->forw==p2->ref) { + + /* change INC LAB: CMP to LAB: INC CMP */ + + p->back->forw=p1; p1->back=p->back; + + p->forw=p1->forw; p1->forw->back=p; + + p->back=p1; p1->forw=p; + + p1=p->forw; + + /* adjust beginning value by 1 */ + + p2=alloc(sizeof first); p2->combop=T(DEC,LONG); + + p2->pop=0; + + p2->forw=p3; p2->back=p3->back; p3->back->forw=p2; + + p3->back=p2; p2->code=p->code; p2->labno=0; + + } + + if (p1->combop==T(CMP,LONG) && (p2=p1->forw)->op==CBR) { + + register char *cp1,*cp2; + + splitrand(p1); if (!equstr(p->code,regs[RT1])) continue; + + if (abs(p->seq - p2->ref->seq)>12) {/* outside byte displ range */ + + if (p2->subop!=JLE) continue; + + p->combop=T(ACB,LONG); + + cp2=regs[RT1]; cp1=regs[RT2]; while (*cp2++= *cp1++); /* limit */ + + cp2=regs[RT2]; cp1="$1"; while (*cp2++= *cp1++); /* increment */ + + cp2=regs[RT3]; cp1=p->code; while (*cp2++= *cp1++); /* index */ + + p->pop=0; newcode(p); + + p->labno = p2->labno; delnode(p2); delnode(p1); nsob++; + + } else if (p2->subop==JLE || p2->subop==JLT) { + + if (p2->subop==JLE) p->combop=AOBLEQ; else p->combop=AOBLSS; + + cp2=regs[RT1]; cp1=regs[RT2]; while (*cp2++= *cp1++); /* limit */ + + cp2=regs[RT2]; cp1=p->code; while (*cp2++= *cp1++); /* index */ + + p->pop=0; newcode(p); + + p->labno = p2->labno; delnode(p2); delnode(p1); nsob++; + + } + + } + + } + + } + +} + + + +abs(x) + +{ + + return(x<0? -x: x); + +} + + + +equop(p1, p2) + +register struct node *p1; + +struct node *p2; + +{ + + register char *cp1, *cp2; + + + + if (p1->combop != p2->combop) + + return(0); + + if (p1->op>0 && p1->opop==MOVA && p1->labno!=p2->labno) return(0); + + cp1 = p1->code; + + cp2 = p2->code; + + if (cp1==0 && cp2==0) + + return(1); + + if (cp1==0 || cp2==0) + + return(0); + + while (*cp1 == *cp2++) + + if (*cp1++ == 0) + + return(1); + + return(0); + +} + + + +delnode(p) register struct node *p; { + + p->back->forw = p->forw; + + p->forw->back = p->back; + +} + + + +decref(p) + +register struct node *p; + +{ + + if (p && --p->refc <= 0) { + + nrlab++; + + delnode(p); + + } + +} + + + +struct node * + +nonlab(ap) + +struct node *ap; + +{ + + register struct node *p; + + + + p = ap; + + while (p && p->op==LABEL) + + p = p->forw; + + return(p); + +} + + + +clearuse() { + + register struct node **i; + + for (i=uses+NUSE; i>uses;) *--i=0; + +} + + + +clearreg() { + + register short **i; + + for (i=regs+NREG; i>regs;) **--i=0; + + conloc[0] = 0; ccloc[0] = 0; + +} + + + +savereg(ai, s, type) + +register char *s; + +{ + + register char *p, *sp; + + + + sp = p = regs[ai]; + + if (source(s)) /* side effects in addressing */ + + return; + + /* if any indexing, must be parameter or local */ + + /* indirection (as in "*-4(fp)") is ok, however */ + + *p++ = type; + + while (*p++ = *s) + + if (*s=='[' || *s++=='(' && *s!='a' && *s!='f') {*sp = 0; return;} + +} + + + +dest(s,type) + +register char *s; + +{ + + register int i; + + + + source(s); /* handle addressing side effects */ + + if ((i = isreg(s)) >= 0) { + + *(short *)(regs[i]) = 0; /* if register destination, that reg is a goner */ + + if (DOUBLE==(type&0xF) || DOUBLE==((type>>4)&0xF)) + + *(short *)(regs[i+1]) = 0; /* clobber two at once */ + + } + + for (i=NREG; --i>=0;) + + if (regs[i][1]=='*' && equstr(s, regs[i]+2)) + + *(short *)(regs[i]) = 0; /* previous indirection through destination is invalid */ + + while ((i = findrand(s,0)) >= 0) /* previous values of destination are invalid */ + + *(short *)(regs[i]) = 0; + + if (!natural(s)) {/* wild store, everything except constants vanishes */ + + for (i=NREG; --i>=0;) if (regs[i][1] != '$') *(short *)(regs[i]) = 0; + + conloc[0] = 0; ccloc[0] = 0; + + } else setcc(s,type); /* natural destinations set condition codes */ + +} + + + +splitrand(p) struct node *p; { + +/* separate operands at commas, set up 'regs' and 'lastrand' */ + +register char *p1, *p2; register char **preg; + +preg=regs+RT1; + +if (p1=p->code) while (*p1) { + + lastrand=p2= *preg++; + + while (*p1) if (','==(*p2++= *p1++)) {--p2; break;} + + *p2=0; + +} + +while (preg<(regs+RT1+5)) *(*preg++)=0; + +} + + + +compat(have, want) { + +register int hsrc, hdst; + +if (0==(want &= 0xF)) return(1); /* anything satisfies a wildcard want */ + +hsrc=have&0xF; if (0==(hdst=((have>>4)&0xF)) || hdst>=OP2) hdst=hsrc; - /* last term prevents floats, doubles from satisfying a request for an int */ - return(hsrc>=want && hdst>=want && !((want>=FLOAT) ^ (hdst>=FLOAT))); +++if (want>=FLOAT) return(hdst==want && hsrc==want); +++ /* FLOAT, DOUBLE not compat: rounding */ +++return(hsrc>=want && hdst>=want && hdst=regs;) { + + if (**i && equstr(*i+1, as) && compat(**i,type)) + + return(i-regs); + + } + + return(-1); + +} + + + +isreg(s) + +register char *s; + +{ + + if (*s++!='r' || !isdigit(*s++)) return(-1); + + if (*s==0) return(*--s-'0'); + + if (*(s-1)=='1' && isdigit(*s++) && *s==0) return(10+*--s-'0'); + + return(-1); + +} + + + +check() + +{ + + register struct node *p, *lp; + + + + lp = &first; + + for (p=first.forw; p!=0; p = p->forw) { + + if (p->back != lp) + + abort(-1); + + lp = p; + + } + +} + + + +source(ap) + +char *ap; + +{ + + register char *p1, *p2; + + + + p1 = ap; + + p2 = p1; + + if (*p1==0) + + return(0); + + while (*p2++ && *(p2-1)!='['); + + if (*p1=='-' && *(p1+1)=='(' + + || *p1=='*' && *(p1+1)=='-' && *(p1+2)=='(' + + || *(p2-2)=='+') { + + while (*p1 && *p1++!='r'); + + if (isdigit(*p1++)) + + if (isdigit(*p1)) *(short *)(regs[10+*p1-'0'])=0; + + else *(short *)(regs[*--p1-'0'])=0; + + return(1); + + } + + return(0); + +} + + + +newcode(p) struct node *p; { + + register char *p1,*p2,**preg; + + preg=regs+RT1; p2=line; + + while (*(p1= *preg++)) {while (*p2++= *p1++); *(p2-1)=',';} + + *--p2=0; + + p->code=copy(line); + +} + + + +repladdr(p) + +struct node *p; + +{ + + register r; + + register char *p1, *p2; + + char **preg; int nrepl; + + + + preg=regs+RT1; nrepl=0; + + while (lastrand!=(p1= *preg++)) + + if (!source(p1) && 0<=(r=findrand(p1,p->subop))) { + + *p1++='r'; if (r>9) {*p1++='1'; r -= 10;} *p1++=r+'0'; *p1=0; + + nrepl++; nsaddr++; + + } + + if (nrepl) newcode(p); + +} + + + +/* movedat() + +/* { + +/* register struct node *p1, *p2; + +/* struct node *p3; + +/* register seg; + +/* struct node data; + +/* struct node *datp; + +/* + +/* if (first.forw == 0) + +/* return; + +/* datp = &data; + +/* for (p1 = first.forw; p1!=0; p1 = p1->forw) { + +/* if (p1->op == DATA) { + +/* p2 = p1->forw; + +/* while (p2 && p2->op!=TEXT) + +/* p2 = p2->forw; + +/* if (p2==0) + +/* break; + +/* p3 = p1->back; + +/* p1->back->forw = p2->forw; + +/* p2->forw->back = p3; + +/* p2->forw = 0; + +/* datp->forw = p1; + +/* p1->back = datp; + +/* p1 = p3; + +/* datp = p2; + +/* } + +/* } + +/* if (data.forw) { + +/* datp->forw = first.forw; + +/* first.forw->back = datp; + +/* data.forw->back = &first; + +/* first.forw = data.forw; + +/* } + +/* seg = -1; + +/* for (p1 = first.forw; p1!=0; p1 = p1->forw) { + +/* if (p1->op==TEXT||p1->op==DATA||p1->op==BSS) { + +/* if (p1->op == seg || p1->forw&&p1->forw->op==seg) { + +/* p1->back->forw = p1->forw; + +/* p1->forw->back = p1->back; + +/* p1 = p1->back; + +/* continue; + +/* } + +/* seg = p1->op; + +/* } + +/* } + +/* } + +*/ + + + +redunbr(p) + +register struct node *p; + +{ + + register struct node *p1; + + register char *ap1; + + char *ap2; + + + + if ((p1 = p->ref) == 0) + + return; + + p1 = nonlab(p1); + + if (p1->op==TST) { + + splitrand(p1); + + savereg(RT2, "$0", p1->subop); + + } else if (p1->op==CMP) + + splitrand(p1); + + else + + return; + + if (p1->forw->op==CBR) { + + ap1 = findcon(RT1, p1->subop); + + ap2 = findcon(RT2, p1->subop); + + p1 = p1->forw; + + if (compare(p1->subop, ap1, ap2)) { + + nredunj++; + + nchange++; + + decref(p->ref); + + p->ref = p1->ref; + + p->labno = p1->labno; - p->ref->refc++; +++#ifdef COPYCODE +++ if (p->labno == 0) +++ p->code = p1->code; +++ if (p->ref) +++#endif +++ p->ref->refc++; + + } + + } else if (p1->op==TST && equstr(regs[RT1],ccloc+1) && + + equtype(ccloc[0],p1->subop)) { + + p1=insertl(p1->forw); decref(p->ref); p->ref=p1; + + nrtst++; nchange++; + + } + +} + + + +char * + +findcon(i, type) + +{ + + register char *p; + + register r; + + + + p = regs[i]; + + if (*p=='$') + + return(p); + + if ((r = isreg(p)) >= 0 && compat(regs[r][0],type)) + + return(regs[r]+1); + + if (equstr(p, conloc)) + + return(conval+1); + + return(p); + +} + + + +compare(op, acp1, acp2) + +char *acp1, *acp2; + +{ + + register char *cp1, *cp2; + + register n1; + + int n2; int sign; + + + + cp1 = acp1; + + cp2 = acp2; + + if (*cp1++ != '$' || *cp2++ != '$') + + return(0); + + n1 = 0; sign=1; if (*cp2=='-') {++cp2; sign= -1;} + + while (isdigit(*cp2)) {n1 *= 10; n1 += (*cp2++ - '0')*sign;} + + n2 = n1; + + n1 = 0; sign=1; if (*cp1=='-') {++cp1; sign= -1;} + + while (isdigit(*cp1)) {n1 *= 10; n1 += (*cp1++ - '0')*sign;} + + if (*cp1=='+') + + cp1++; + + if (*cp2=='+') + + cp2++; + + do { + + if (*cp1++ != *cp2) + + return(0); + + } while (*cp2++); + + cp1 = n1; + + cp2 = n2; + + switch(op) { + + + + case JEQ: + + return(cp1 == cp2); + + case JNE: + + return(cp1 != cp2); + + case JLE: + + return(((int)cp1) <= ((int)cp2)); + + case JGE: + + return(((int)cp1) >= ((int)cp2)); + + case JLT: + + return(((int)cp1) < ((int)cp2)); + + case JGT: + + return(((int)cp1) > ((int)cp2)); + + case JLO: + + return(cp1 < cp2); + + case JHI: + + return(cp1 > cp2); + + case JLOS: + + return(cp1 <= cp2); + + case JHIS: + + return(cp1 >= cp2); + + } + + return(0); + +} + + + +setcon(cv, cl, type) + +register char *cv, *cl; + +{ + + register char *p; + + + + if (*cv != '$') + + return; + + if (!natural(cl)) + + return; + + p = conloc; + + while (*p++ = *cl++); + + p = conval; + + *p++ = type; + + while (*p++ = *cv++); + +} + + + +equstr(p1, p2) + +register char *p1, *p2; + +{ + + do { + + if (*p1++ != *p2) + + return(0); + + } while (*p2++); + + return(1); + +} + + + +setcc(ap,type) + +char *ap; + +{ + + register char *p, *p1; + + + + p = ap; + + if (!natural(p)) { + + ccloc[0] = 0; + + return; + + } + + p1 = ccloc; + + *p1++ = type; + + while (*p1++ = *p++); + +} + + + +okio(p) register char *p; {/* 0->probable I/O space address; 1->not */ + + if (ioflag && (!natural(p) || 0>getnum(p))) return(0); + + return(1); + +} + + + +indexa(p) register char *p; {/* 1-> uses [r] addressing mode; 0->doesn't */ + + while (*p) if (*p++=='[') return(1); + + return(0); + +} + + + +natural(p) + +register char *p; + +{/* 1->simple local, parameter, global, or register; 0->otherwise */ + + if (*p=='*' || *p=='(' || *p=='-'&&*(p+1)=='(' || *p=='$'&&getnum(p+1)) + + return(0); + + while (*p++); + + p--; + + if (*--p=='+' || *p==']' || *p==')' && *(p-2)!='a' && *(p-2)!='f') + + return(0); + + return(1); + +} +++ +++/* +++** Tell if an argument is most likely static. +++*/ +++ +++isstatic(cp) +++register char *cp; +++{ +++ if (*cp == '_' || *cp == 'L' || (*cp++ == 'v' && *cp == '.')) +++ return (1); +++ return (0); +++} diff --cc usr/src/cmd/c2/c22.c index 0000000000,d82e84fa32,0000000000..89d58ff9ad mode 000000,100644,000000..100644 --- a/usr/src/cmd/c2/c22.c +++ b/usr/src/cmd/c2/c22.c @@@@ -1,0 -1,301 -1,0 +1,303 @@@@ - #include +++static char sccsid[] = "@(#)c22.c 4.1 10/16/80"; + +#include "c2.h" - char c22[] = "@(#)c22.c 1.5 78/09/23 16:37:33"; +++/* char c22[] = "@(#)c22.c 1.10 80/03/14 10:27:37"; */ + +#define readonly + + + +readonly char revbr[] = { + + JNE, JEQ, JGT, JLT, JGE, JLE, + + JNE, JEQ, JHI, JLO, JHIS, JLOS, + + JBS, JBC, JLBS, JLBC, JBSC, JBCC, JBSS, JBCS }; + + + +/* cursed be the preprocessor, whose impotence and stupidity + +/* prevented this table being macro-generated from ../as/instrs + +*/ + + + +readonly struct optab optab[] = { + +"jbr",JBR, + +"jeql",T(CBR,JEQ), + +"jneq",T(CBR,JNE), + +"jleq",T(CBR,JLE), + +"jgeq",T(CBR,JGE), + +"jlss",T(CBR,JLT), + +"jgtr",T(CBR,JGT), + +"jbc",T(CBR,JBC), + +"jbs",T(CBR,JBS), + +"jlequ",T(CBR,JLOS), + +"jgequ",T(CBR,JHIS), + +"jlssu",T(CBR,JLO), + +"jgtru",T(CBR,JHI), + +"jlbc",T(CBR,JLBC), + +"jlbs",T(CBR,JLBS), + +"jbcc",T(CBR,JBCC), + +"jbsc",T(CBR,JBSC), + +"jbcs",T(CBR,JBCS), + +"jbss",T(CBR,JBSS), + +"acbb",T(ACB,BYTE), + +"acbd",T(ACB,DOUBLE), + +"acbf",T(ACB,FLOAT), + +"acbl",T(ACB,LONG), + +"acbw",T(ACB,WORD), + +"addb2",T(ADD,U(BYTE,OP2)), + +"addb3",T(ADD,U(BYTE,OP3)), + +"addd2",T(ADD,U(DOUBLE,OP2)), + +"addd3",T(ADD,U(DOUBLE,OP3)), + +"addf2",T(ADD,U(FLOAT,OP2)), + +"addf3",T(ADD,U(FLOAT,OP3)), + +"addl2",T(ADD,U(LONG,OP2)), + +"addl3",T(ADD,U(LONG,OP3)), + +"addw2",T(ADD,U(WORD,OP2)), + +"addw3",T(ADD,U(WORD,OP3)), + +"aobleq",AOBLEQ, + +"aoblss",AOBLSS, + +"ashl",T(ASH,LONG), + +"ashq",T(ASH,QUAD), + +"bbc",T(CBR,JBC), + +"bbcc",T(CBR,JBCC), + +"bbcci",T(CBR,JBCC), + +"bbcs",T(CBR,JBCS), + +"bbs",T(CBR,JBS), + +"bbsc",T(CBR,JBSC), + +"bbss",T(CBR,JBSS), + +"bbssi",T(CBR,JBSS), + +"bcc",T(CBR,JHIS), + +"bcs",T(CBR,JLO), + +"beql",T(CBR,JEQ), + +"beqlu",T(CBR,JEQ), + +"bgeq",T(CBR,JGE), + +"bgequ",T(CBR,JHIS), + +"bgtr",T(CBR,JGT), + +"bgtru",T(CBR,JHI), + +"bicb2",T(BIC,U(BYTE,OP2)), + +"bicb3",T(BIC,U(BYTE,OP3)), + +"bicl2",T(BIC,U(LONG,OP2)), + +"bicl3",T(BIC,U(LONG,OP3)), + +"bicw2",T(BIC,U(WORD,OP2)), + +"bicw3",T(BIC,U(WORD,OP3)), + +"bisb2",T(BIS,U(BYTE,OP2)), + +"bisb3",T(BIS,U(BYTE,OP3)), + +"bisl2",T(BIS,U(LONG,OP2)), + +"bisl3",T(BIS,U(LONG,OP3)), + +"bisw2",T(BIS,U(WORD,OP2)), + +"bisw3",T(BIS,U(WORD,OP3)), + +"bitb",T(BIT,BYTE), + +"bitl",T(BIT,LONG), + +"bitw",T(BIT,WORD), + +"blbs",T(CBR,JLBS), + +"blbc",T(CBR,JLBC), + +"bleq",T(CBR,JLE), + +"blequ",T(CBR,JLOS), + +"blss",T(CBR,JLT), + +"blssu",T(CBR,JLO), + +"bneq",T(CBR,JNE), + +"bnequ",T(CBR,JNE), + +"brb",JBR, + +"brw",JBR, + +"bvc",T(CBR,0), + +"bvs",T(CBR,0), + +"callg",CALLS, + +"calls",CALLS, + +"caseb",T(CASE,BYTE), + +"casel",T(CASE,LONG), + +"casew",T(CASE,WORD), + +"clrb",T(CLR,BYTE), + +"clrd",T(CLR,DOUBLE), + +"clrf",T(CLR,FLOAT), + +"clrl",T(CLR,LONG), + +"clrq",T(CLR,QUAD), + +"clrw",T(CLR,WORD), + +"cmpb",T(CMP,BYTE), + +"cmpd",T(CMP,DOUBLE), + +"cmpf",T(CMP,FLOAT), + +"cmpl",T(CMP,LONG), + +"cmpw",T(CMP,WORD), + +"cvtbd",T(CVT,U(BYTE,DOUBLE)), + +"cvtbf",T(CVT,U(BYTE,FLOAT)), + +"cvtbl",T(CVT,U(BYTE,LONG)), + +"cvtbw",T(CVT,U(BYTE,WORD)), + +"cvtdb",T(CVT,U(DOUBLE,BYTE)), + +"cvtdf",T(CVT,U(DOUBLE,FLOAT)), + +"cvtdl",T(CVT,U(DOUBLE,LONG)), + +"cvtdw",T(CVT,U(DOUBLE,WORD)), + +"cvtfb",T(CVT,U(FLOAT,BYTE)), + +"cvtfd",T(CVT,U(FLOAT,DOUBLE)), + +"cvtfl",T(CVT,U(FLOAT,LONG)), + +"cvtfw",T(CVT,U(FLOAT,WORD)), + +"cvtlb",T(CVT,U(LONG,BYTE)), + +"cvtld",T(CVT,U(LONG,DOUBLE)), + +"cvtlf",T(CVT,U(LONG,FLOAT)), + +"cvtlw",T(CVT,U(LONG,WORD)), + +"cvtrdl",T(CVT,U(DOUBLE,LONG)), + +"cvtrfl",T(CVT,U(FLOAT,LONG)), + +"cvtwb",T(CVT,U(WORD,BYTE)), + +"cvtwd",T(CVT,U(WORD,DOUBLE)), + +"cvtwf",T(CVT,U(WORD,FLOAT)), + +"cvtwl",T(CVT,U(WORD,LONG)), + +"decb",T(DEC,BYTE), + +"decl",T(DEC,LONG), + +"decw",T(DEC,WORD), + +"divb2",T(DIV,U(BYTE,OP2)), + +"divb3",T(DIV,U(BYTE,OP3)), + +"divd2",T(DIV,U(DOUBLE,OP2)), + +"divd3",T(DIV,U(DOUBLE,OP3)), + +"divf2",T(DIV,U(FLOAT,OP2)), + +"divf3",T(DIV,U(FLOAT,OP3)), + +"divl2",T(DIV,U(LONG,OP2)), + +"divl3",T(DIV,U(LONG,OP3)), + +"divw2",T(DIV,U(WORD,OP2)), + +"divw3",T(DIV,U(WORD,OP3)), + +"extv",T(EXTV,LONG), + +"extzv",T(EXTZV,LONG), + +"incb",T(INC,BYTE), + +"incl",T(INC,LONG), + +"incw",T(INC,WORD), + +"insv",T(INSV,-1), + +"jmp",JMP, + +"mcomb",T(COM,BYTE), + +"mcoml",T(COM,LONG), + +"mcomw",T(COM,WORD), + +"mnegb",T(NEG,BYTE), + +"mnegd",T(NEG,DOUBLE), + +"mnegf",T(NEG,FLOAT), + +"mnegl",T(NEG,LONG), + +"mnegw",T(NEG,WORD), + +"movab",T(MOVA,BYTE), + +"movad",T(MOVA,DOUBLE), + +"movaf",T(MOVA,FLOAT), + +"moval",T(MOVA,LONG), + +"movaq",T(MOVA,QUAD), + +"movaw",T(MOVA,WORD), + +"movb",T(MOV,BYTE), + +"movd",T(MOV,DOUBLE), + +"movf",T(MOV,FLOAT), + +"movl",T(MOV,LONG), + +"movq",T(MOV,QUAD), + +"movw",T(MOV,WORD), + +"movzbl",T(MOVZ,U(BYTE,LONG)), + +"movzbw",T(MOVZ,U(BYTE,WORD)), + +"movzwl",T(MOVZ,U(WORD,LONG)), + +"mulb2",T(MUL,U(BYTE,OP2)), + +"mulb3",T(MUL,U(BYTE,OP3)), + +"muld2",T(MUL,U(DOUBLE,OP2)), + +"muld3",T(MUL,U(DOUBLE,OP3)), + +"mulf2",T(MUL,U(FLOAT,OP2)), + +"mulf3",T(MUL,U(FLOAT,OP3)), + +"mull2",T(MUL,U(LONG,OP2)), + +"mull3",T(MUL,U(LONG,OP3)), + +"mulw2",T(MUL,U(WORD,OP2)), + +"mulw3",T(MUL,U(WORD,OP3)), + +"pushab",T(PUSHA,BYTE), + +"pushad",T(PUSHA,DOUBLE), + +"pushaf",T(PUSHA,FLOAT), + +"pushal",T(PUSHA,LONG), + +"pushaq",T(PUSHA,QUAD), + +"pushaw",T(PUSHA,WORD), + +"pushl",T(PUSH,LONG), + +"ret",T(JBR,RET), + +"sobgeq",SOBGEQ, + +"sobgtr",SOBGTR, + +"subb2",T(SUB,U(BYTE,OP2)), + +"subb3",T(SUB,U(BYTE,OP3)), + +"subd2",T(SUB,U(DOUBLE,OP2)), + +"subd3",T(SUB,U(DOUBLE,OP3)), + +"subf2",T(SUB,U(FLOAT,OP2)), + +"subf3",T(SUB,U(FLOAT,OP3)), + +"subl2",T(SUB,U(LONG,OP2)), + +"subl3",T(SUB,U(LONG,OP3)), + +"subw2",T(SUB,U(WORD,OP2)), + +"subw3",T(SUB,U(WORD,OP3)), + +"tstb",T(TST,BYTE), + +"tstd",T(TST,DOUBLE), + +"tstf",T(TST,FLOAT), + +"tstl",T(TST,LONG), + +"tstw",T(TST,WORD), + +"xorb2",T(XOR,U(BYTE,OP2)), + +"xorb3",T(XOR,U(BYTE,OP3)), + +"xorl2",T(XOR,U(LONG,OP2)), + +"xorl3",T(XOR,U(LONG,OP3)), + +"xorw2",T(XOR,U(WORD,OP2)), + +"xorw3",T(XOR,U(WORD,OP3)), +++"movc3",MOVC3, + +".globl",EROU, + +".text",TEXT, + +".data",DATA, + +".bss",BSS, + +".align",ALIGN, + +".word",WGEN, + +".long",LGEN, + +".set",SET, +++".lcomm",LCOMM, +++".comm",COMM, + +".end",END, +++"rsb",T(JBR,RSB), +++"jsb",JSB, +++"mfpr",T(MFPR,LONG), +++"mtpr",T(MTPR,LONG), +++"prober",T(PROBER,BYTE), +++"probew",T(PROBEW,BYTE), + +"adawi",0, + +"addp4",0, + +"addp6",0, + +"adwc",0, + +"ashp",0, + +"bicpsw",0, + +"bispsw",0, + +"bpt",0, + +"bsbb",0, + +"bsbw",0, + +"chme",0, + +"chmk",0, + +"chms",0, + +"chmu",0, + +"cmpc3",0, + +"cmpc5",0, + +"cmpp3",0, + +"cmpp4",0, + +"cmpv",0, + +"cmpzv",0, + +"crc",0, + +"cvtlp",0, + +"cvtpl",0, + +"cvttp",0, + +"cvtpt",0, + +"cvtps",0, + +"cvtsp",0, + +"divp",0, + +"editpc",0, + +"ediv",0, + +"emodd",0, + +"emodf",0, + +"emul",0, + +"ffc",0, + +"ffs",0, + +"halt",0, + +"index",0, + +"insque",0, - "jsb",0, + +"ldpctx",0, + +"locc",0, + +"matchc",0, - "mfpr",0, - "movc3",0, + +"movc5",0, + +"movp",0, + +"movpsl",0, + +"movtc",0, + +"movtuc",0, - "mtpr",0, + +"mulp",0, + +"nop",0, + +"polyd",0, + +"polyf",0, + +"popr",0, - "prober",0, - "probew",0, + +"pushr",0, + +"rei",0, + +"remque",0, + +"rotl",0, - "rsb",0, + +"sbwc",0, + +"scanc",0, + +"skpc",0, + +"spanc",0, + +"subp4",0, + +"subp6",0, + +"svpctx",0, + +"xfc",0, + +"escd",0, + +"esce",0, + +"escf",0, + + 0, 0}; diff --cc usr/src/cmd/call.c index 0000000000,9723e8800f,0000000000..b74fa2f439 mode 000000,100644,000000..100644 --- a/usr/src/cmd/call.c +++ b/usr/src/cmd/call.c @@@@ -1,0 -1,42 -1,0 +1,43 @@@@ +++static char *sccsid = "@(#)call.c 4.1 (Berkeley) 10/1/80"; + +char *dn; + + + +main(argc, argv) + +char *argv[]; + +{ + + register f, n, c; + + + + + + if(argc < 2) + + goto arg; + + dn = "/dev/dn0"; + + if(*argv[1] == '-') { + + dn = argv[1]+1; + + argc--; + + argv++; + + } + + if(argc < 2) + + goto arg; + + c = 0; + +loop: + + f = open(dn, 1); + + if(f < 0) + + goto slp; + + for(n=0; argv[1][n]; n++) + + ; + + alarm(120); + + if(write(f, argv[1], n) == n) + + exit(0); + + + +slp: + + if(f >= 0) + + close(f); + + c++; + + if(c > 100) + + exit(1); + + sleep(10); + + goto loop; + + + +arg: + + printf("arg c\n"); + + exit(1); + +} diff --cc usr/src/cmd/cat.c index 0000000000,e0f4ef6263,0000000000..acff04c5d9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/cat.c +++ b/usr/src/cmd/cat.c @@@@ -1,0 -1,63 -1,0 +1,141 @@@@ + +/* + + * Concatenate files. + + */ +++static char *Sccsid = "@(#)cat.c 4.2 (Berkeley) 10/9/80"; + + + +#include + +#include + +#include + + + +char stdbuf[BUFSIZ]; +++int bflg, eflg, nflg, sflg, tflg, vflg; +++int spaced, col, lno, inline; + + + +main(argc, argv) + +char **argv; + +{ + + int fflg = 0; + + register FILE *fi; + + register c; + + int dev, ino = -1; + + struct stat statb; + + +++ lno = 1; + + setbuf(stdout, stdbuf); + + for( ; argc>1 && argv[1][0]=='-'; argc--,argv++) { + + switch(argv[1][1]) { + + case 0: + + break; + + case 'u': + + setbuf(stdout, (char *)NULL); + + continue; +++ case 'n': +++ nflg++; +++ continue; +++ case 'b': +++ bflg++; +++ nflg++; +++ continue; +++ case 'v': +++ vflg++; +++ continue; +++ case 's': +++ sflg++; +++ continue; +++ case 'e': +++ eflg++; +++ vflg++; +++ continue; +++ case 't': +++ tflg++; +++ vflg++; +++ continue; + + } + + break; + + } + + fstat(fileno(stdout), &statb); + + statb.st_mode &= S_IFMT; + + if (statb.st_mode!=S_IFCHR && statb.st_mode!=S_IFBLK) { + + dev = statb.st_dev; + + ino = statb.st_ino; + + } + + if (argc < 2) { + + argc = 2; + + fflg++; + + } + + while (--argc > 0) { + + if (fflg || (*++argv)[0]=='-' && (*argv)[1]=='\0') + + fi = stdin; + + else { + + if ((fi = fopen(*argv, "r")) == NULL) { + + fprintf(stderr, "cat: can't open %s\n", *argv); + + continue; + + } + + } + + fstat(fileno(fi), &statb); + + if (statb.st_dev==dev && statb.st_ino==ino) { + + fprintf(stderr, "cat: input %s is output\n", + + fflg?"-": *argv); + + fclose(fi); + + continue; + + } - while ((c = getc(fi)) != EOF) - putchar(c); +++ if (nflg||sflg||vflg) +++ copyopt(fi); +++ else { +++ while ((c = getc(fi)) != EOF) +++ putchar(c); +++ } + + if (fi!=stdin) + + fclose(fi); + + } +++ if (ferror(stdout)) +++ fprintf(stderr, "cat: output write error\n"); + + return(0); + +} +++ +++copyopt(f) +++ register FILE *f; +++{ +++ register int c; +++ +++top: +++ c = getc(f); +++ if (c == EOF) +++ return; +++ if (c == '\n') { +++ if (inline == 0) { +++ if (sflg && spaced) +++ goto top; +++ spaced = 1; +++ } +++ if (nflg && bflg==0 && inline == 0) +++ printf("%6d\t", lno++); +++ if (eflg) +++ putchar('$'); +++ putchar('\n'); +++ inline = 0; +++ goto top; +++ } +++ if (nflg && inline == 0) +++ printf("%6d\t", lno++); +++ inline = 1; +++ if (vflg) { +++ if (tflg==0 && c == '\t') +++ putchar(c); +++ else { +++ if (c > 0177) { +++ printf("M-"); +++ c &= 0177; +++ } +++ if (c < ' ') +++ printf("^%c", c+'@'); +++ else if (c == 0177) +++ printf("^?"); +++ else +++ putchar(c); +++ } +++ } else +++ putchar(c); +++ spaced = 0; +++ goto top; +++} diff --cc usr/src/cmd/catman.c index 0000000000,0000000000,0000000000..ec939f3dc4 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/catman.c @@@@ -1,0 -1,0 -1,0 +1,128 @@@@ +++static char *sccsid = "@(#)catman.c 4.1 (Berkeley) 10/1/80"; +++# include +++# include +++# include +++# include +++# include +++ +++# define reg register +++# define bool char +++ +++# define SYSTEM(str) (pflag ? printf("%s\n", str) : system(str)) +++ +++char buf[BUFSIZ], +++ pflag = 0, +++ nflag = 0, +++ wflag = 0; +++ +++main(ac, av) +++int ac; +++char *av[]; { +++ +++ reg char *tsp, *msp, *csp, *man, *cat, *sp; +++ reg FILE *mdir, *inf; +++ reg long time; +++ reg char *sections; +++ reg int exstat = 0; +++ reg bool changed = 0; +++ static struct dir dir; +++ static struct stat sbuf; +++ +++ while (ac > 1) { +++ av++; +++ if (strcmp(*av, "-p") == 0) +++ pflag++; +++ else if (strcmp(*av, "-n") == 0) +++ nflag++; +++ else if (strcmp(*av, "-w") == 0) +++ wflag++; +++ else if (*av[0] == '-') +++ goto usage; +++ else +++ break; +++ ac--; +++ } +++ if (ac == 2) +++ sections = *av; +++ else if (ac < 2) +++ sections = "12345678"; +++ else { +++usage: +++ printf("usage: catman [ -p ] [ -n ] [ -w ] [ sections ]\n"); +++ exit(-1); +++ } +++ if (wflag) +++ goto whatis; +++ chdir("/usr/man"); +++ man = "manx/xxxxxxxxxxxxxx"; +++ cat = "catx/xxxxxxxxxxxxxx"; +++ msp = &man[5]; +++ csp = &cat[5]; +++ umask(0); +++ for (sp = sections; *sp; sp++) { +++ man[3] = cat[3] = *sp; +++ *msp = *csp = '\0'; +++ if ((mdir = fopen(man, "r")) == NULL) { +++ fprintf(stderr, "fopen:"); +++ perror(man); +++ exstat = 1; +++ continue; +++ } +++ if (stat(cat, &sbuf) < 0) { +++ sprintf(buf, "mkdir %s", cat); +++ SYSTEM(buf); +++ stat(cat, &sbuf); +++ } +++ if ((sbuf.st_mode & 0777) != 0777) +++ chmod(cat, 0777); +++ while (fread((char *) &dir, sizeof dir, 1, mdir) > 0) { +++ if (dir.d_ino == 0 || dir.d_name[0] == '.') +++ continue; +++ /* +++ * make sure this is a man file, i.e., that it +++ * ends in .[0-9] or .[0-9][a-z] +++ */ +++ tsp = rindex(dir.d_name, '.'); +++ if (tsp == NULL) +++ continue; +++ if (!isdigit(*++tsp) || ((*++tsp && !isalpha(*tsp)) || *++tsp)) +++ continue; +++ +++ strncpy(msp, dir.d_name, DIRSIZ); +++ if ((inf = fopen(man, "r")) == NULL) { +++ perror(man); +++ exstat = 1; +++ continue; +++ } +++ if (getc(inf) == '.' && getc(inf) == 's' +++ && getc(inf) == 'o') { +++ fclose(inf); +++ continue; +++ } +++ fclose(inf); +++ strncpy(csp, dir.d_name, DIRSIZ); +++ if (stat(cat, &sbuf) >= 0) { +++ time = sbuf.st_mtime; +++ stat(man, &sbuf); +++ if (time >= sbuf.st_mtime) +++ continue; +++ unlink(cat); +++ } +++ sprintf(buf, "nroff -man %s > %s", man, cat); +++ SYSTEM(buf); +++ changed = 1; +++ } +++ fclose(mdir); +++ } +++ if (changed && !nflag) { +++whatis: +++ if (pflag) +++ printf("/bin/sh /usr/lib/makewhatis\n"); +++ else { +++ execl("/bin/sh", "/bin/sh", "/usr/lib/makewhatis", 0); +++ perror("/bin/sh /usr/lib/makewhatis"); +++ exstat = 1; +++ } +++ } +++ exit(exstat); +++} diff --cc usr/src/cmd/cb.c index 0000000000,6452ae2d99,0000000000..c88b67fbbb mode 000000,100644,000000..100644 --- a/usr/src/cmd/cb.c +++ b/usr/src/cmd/cb.c @@@@ -1,0 -1,357 -1,0 +1,358 @@@@ +++static char *sccsid = "@(#)cb.c 4.1 (Berkeley) 10/1/80"; + +#include + +int slevel[10]; + +int clevel = 0; + +int spflg[20][10]; + +int sind[20][10]; + +int siflev[10]; + +int sifflg[10]; + +int iflev = 0; + +int ifflg = -1; + +int level = 0; + +int ind[10] = { + + 0,0,0,0,0,0,0,0,0,0 }; + +int eflg = 0; + +int paren = 0; + +int pflg[10] = { + + 0,0,0,0,0,0,0,0,0,0 }; + +char lchar; + +char pchar; + +int aflg = 0; + +int ct; + +int stabs[20][10]; + +int qflg = 0; + +char *wif[] = { + + "if",0}; + +char *welse[] = { + + "else",0}; + +char *wfor[] = { + + "for",0}; + +char *wds[] = { + + "case","default",0}; + +int j = 0; + +char string[200]; + +char cc; + +int sflg = 1; + +int peek = -1; + +int tabs = 0; + +int lastchar; + +int c; + +main(argc,argv) int argc; + +char argv[]; + +{ + + while((c = getch()) != EOF){ + + switch(c){ + + case ' ': + + case '\t': + + if(lookup(welse) == 1){ + + gotelse(); + + if(sflg == 0 || j > 0)string[j++] = c; + + puts(); + + sflg = 0; + + continue; + + } + + if(sflg == 0 || j > 0)string[j++] = c; + + continue; + + case '\n': + + if((eflg = lookup(welse)) == 1)gotelse(); + + puts(); + + printf("\n"); + + sflg = 1; + + if(eflg == 1){ + + pflg[level]++; + + tabs++; + + } + + else + + if(pchar == lchar) + + aflg = 1; + + continue; + + case '{': + + if(lookup(welse) == 1)gotelse(); + + siflev[clevel] = iflev; + + sifflg[clevel] = ifflg; + + iflev = ifflg = 0; + + clevel++; + + if(sflg == 1 && pflg[level] != 0){ + + pflg[level]--; + + tabs--; + + } + + string[j++] = c; + + puts(); + + getnl(); + + puts(); + + printf("\n"); + + tabs++; + + sflg = 1; + + if(pflg[level] > 0){ + + ind[level] = 1; + + level++; + + slevel[level] = clevel; + + } + + continue; + + case '}': + + clevel--; + + if((iflev = siflev[clevel]-1) < 0)iflev = 0; + + ifflg = sifflg[clevel]; + + if(pflg[level] >0 && ind[level] == 0){ + + tabs -= pflg[level]; + + pflg[level] = 0; + + } + + puts(); + + tabs--; + + ptabs(); + + if((peek = getch()) == ';'){ + + printf("%c;",c); + + peek = -1; + + } + + else printf("%c",c); + + getnl(); + + puts(); + + printf("\n"); + + sflg = 1; + + if(clevel < slevel[level])if(level > 0)level--; + + if(ind[level] != 0){ + + tabs -= pflg[level]; + + pflg[level] = 0; + + ind[level] = 0; + + } + + continue; + + case '"': + + case '\'': + + string[j++] = c; + + while((cc = getch()) != c){ + + string[j++] = cc; + + if(cc == '\\'){ + + string[j++] = getch(); + + } + + if(cc == '\n'){ + + puts(); + + sflg = 1; + + } + + } + + string[j++] = cc; + + if(getnl() == 1){ + + lchar = cc; + + peek = '\n'; + + } + + continue; + + case ';': + + string[j++] = c; + + puts(); + + if(pflg[level] > 0 && ind[level] == 0){ + + tabs -= pflg[level]; + + pflg[level] = 0; + + } + + getnl(); + + puts(); + + printf("\n"); + + sflg = 1; + + if(iflev > 0) + + if(ifflg == 1){iflev--; + + ifflg = 0; + + } + + else iflev = 0; + + continue; + + case '\\': + + string[j++] = c; + + string[j++] = getch(); + + continue; + + case '?': + + qflg = 1; + + string[j++] = c; + + continue; + + case ':': + + string[j++] = c; + + if(qflg == 1){ + + qflg = 0; + + continue; + + } + + if(lookup(wds) == 0){ + + sflg = 0; + + puts(); + + } + + else{ + + tabs--; + + puts(); + + tabs++; + + } + + if((peek = getch()) == ';'){ + + printf(";"); + + peek = -1; + + } + + getnl(); + + puts(); + + printf("\n"); + + sflg = 1; + + continue; + + case '/': + + string[j++] = c; + + if((peek = getch()) != '*')continue; + + string[j++] = peek; + + peek = -1; + + comment(); + + continue; + + case ')': + + paren--; + + string[j++] = c; + + puts(); + + if(getnl() == 1){ + + peek = '\n'; + + if(paren != 0)aflg = 1; + + else if(tabs > 0){ + + pflg[level]++; + + tabs++; + + ind[level] = 0; + + } + + } + + continue; + + case '#': + + string[j++] = c; + + while((cc = getch()) != '\n')string[j++] = cc; + + string[j++] = cc; + + sflg = 0; + + puts(); + + sflg = 1; + + continue; + + case '(': + + string[j++] = c; + + paren++; + + if(lookup(wfor) == 1){ + + while((c = gets()) != ';'); + + ct=0; + +cont: + + while((c = gets()) != ')'){ + + if(c == '(') ct++; + + } + + if(ct != 0){ + + ct--; + + goto cont; + + } + + paren--; + + puts(); + + if(getnl() == 1){ + + peek = '\n'; + + pflg[level]++; + + tabs++; + + ind[level] = 0; + + } + + continue; + + } + + if(lookup(wif) == 1){ + + puts(); + + stabs[clevel][iflev] = tabs; + + spflg[clevel][iflev] = pflg[level]; + + sind[clevel][iflev] = ind[level]; + + iflev++; + + ifflg = 1; + + } + + continue; + + default: + + string[j++] = c; + + if(c != ',')lchar = c; + + } + + } + +} + +ptabs(){ + + int i; + + for(i=0; i < tabs; i++)printf("\t"); + +} + +getch(){ + + if(peek < 0 && lastchar != ' ' && lastchar != '\t')pchar = lastchar; + + lastchar = (peek<0) ? getc(stdin):peek; + + peek = -1; + + return(lastchar); + +} + +puts(){ + + if(j > 0){ + + if(sflg != 0){ + + ptabs(); + + sflg = 0; + + if(aflg == 1){ + + aflg = 0; + + if(tabs > 0)printf(" "); + + } + + } + + string[j] = '\0'; + + printf("%s",string); + + j = 0; + + } + + else{ + + if(sflg != 0){ + + sflg = 0; + + aflg = 0; + + } + + } + +} + +lookup(tab) + +char *tab[]; + +{ + + char r; + + int l,kk,k,i; + + if(j < 1)return(0); + + kk=0; + + while(string[kk] == ' ')kk++; + + for(i=0; tab[i] != 0; i++){ + + l=0; + + for(k=kk;(r = tab[i][l++]) == string[k] && r != '\0';k++); + + if(r == '\0' && (string[k] < 'a' || string[k] > 'z' || k >= j))return(1); + + } + + return(0); + +} + +gets(){ + + char ch; + +beg: + + if((ch = string[j++] = getch()) == '\\'){ + + string[j++] = getch(); + + goto beg; + + } + + if(ch == '\'' || ch == '"'){ + + while((cc = string[j++] = getch()) != ch)if(cc == '\\')string[j++] = getch(); + + goto beg; + + } + + if(ch == '\n'){ + + puts(); + + aflg = 1; + + goto beg; + + } + + else return(ch); + +} + +gotelse(){ + + tabs = stabs[clevel][iflev]; + + pflg[level] = spflg[clevel][iflev]; + + ind[level] = sind[clevel][iflev]; + + ifflg = 1; + +} + +getnl(){ + + while((peek = getch()) == '\t' || peek == ' '){ + + string[j++] = peek; + + peek = -1; + + } + + if((peek = getch()) == '/'){ + + peek = -1; + + if((peek = getch()) == '*'){ + + string[j++] = '/'; + + string[j++] = '*'; + + peek = -1; + + comment(); + + } + + else string[j++] = '/'; + + } + + if((peek = getch()) == '\n'){ + + peek = -1; + + return(1); + + } + + return(0); + +} + +comment(){ + +rep: + + while((c = string[j++] = getch()) != '*') + + if(c == '\n'){ + + puts(); + + sflg = 1; + + } + +gotstar: + + if((c = string[j++] = getch()) != '/'){ + + if(c == '*')goto gotstar; + + goto rep; + + } + +} diff --cc usr/src/cmd/cc.c index 0000000000,ce5137b27d,0000000000..3504a2ae2e mode 000000,100644,000000..100644 --- a/usr/src/cmd/cc.c +++ b/usr/src/cmd/cc.c @@@@ -1,0 -1,484 -1,0 +1,409 @@@@ - # - # include - # include - # include - /* C command */ +++static char sccsid[] = "@(#)cc.c 4.1 10/1/80"; +++/* +++ * cc - front end for C compiler +++ */ +++#include +++#include +++#include +++#include +++#include + + - # define SBSIZE 10000 - # define MAXINC 10 - # define MAXFIL 100 - # define MAXLIB 100 - # define MAXOPT 100 - char tmp0[30]; - char *tmp1; - char *tmp2; - char *tmp3; - char *tmp4; - char *tmp5; +++char *cpp = "/lib/cpp"; +++char *ccom = "/lib/ccom"; +++char *c2 = "/lib/c2"; +++char *as = "/bin/as"; +++char *ld = "/bin/ld"; +++char *crt0 = "/lib/crt0.o"; +++ +++char tmp0[30]; /* big enough for /tmp/ctm%05.5d */ +++char *tmp1, *tmp2, *tmp3, *tmp4, *tmp5; + +char *outfile; - char *copy(),*setsuf(); - # define CHSPACE 1000 - char ts[CHSPACE+50]; - char *tsa = ts; - char *tsp = ts; - char *av[50]; - char *clist[MAXFIL]; - char *llist[MAXLIB]; - char *alist[20]; - int Wflag; - int dflag; - int pflag; - int sflag; - int cflag; - int eflag; - int gflag; - int exflag; - int oflag; - int proflag; - int noflflag; +++char *savestr(), *strspl(), *setsuf(); +++int idexit(); +++char **av, **clist, **llist, **plist; +++int cflag, eflag, gflag, oflag, pflag, sflag, wflag, Rflag, exflag, proflag; +++char *dflag; + +int exfail; - char *chpass ; - char *npassname ; - char pass0[40] = "/lib/ccom"; - char pass2[20] = "/lib/c2"; - char passp[20] = "/lib/cpp"; - char *pref = "/lib/crt0.o"; +++char *chpass; +++char *npassname; +++ +++int nc, nl, np, nxo, na; +++ +++#define cunlink(s) if (s) unlink(s) + + + +main(argc, argv) - char *argv[]; { +++ char **argv; +++{ + + char *t; - char *savetsp; + + char *assource; - char **pv, *ptemp[MAXOPT], **pvt; - int nc, nl, i, j, c, f20, nxo, na; - int idexit(); +++ int i, j, c; +++ +++ /* ld currently adds upto 5 args; 10 is room to spare */ +++ av = (char **)calloc(argc+10, sizeof (char **)); +++ clist = (char **)calloc(argc, sizeof (char **)); +++ llist = (char **)calloc(argc, sizeof (char **)); +++ plist = (char **)calloc(argc, sizeof (char **)); +++ for (i = 1; i < argc; i++) { +++ if (*argv[i] == '-') switch (argv[i][1]) { + + - i = nc = nl = f20 = nxo = 0; - pv = ptemp; - while(++i < argc) { - if(*argv[i] == '-') switch (argv[i][1]) { - default: - goto passa; + + case 'S': + + sflag++; + + cflag++; - break; +++ continue; + + case 'o': + + if (++i < argc) { - char t; + + outfile = argv[i]; - if ((t=getsuf(outfile))=='c'||t=='o') { - error("Would overwrite %s", outfile); +++ switch (getsuf(outfile)) { +++ +++ case 'c': +++ case 'o': +++ error("-o would overwrite %s", +++ outfile); + + exit(8); + + } + + } - break; +++ continue; +++ case 'R': +++ Rflag++; +++ continue; + + case 'O': + + oflag++; - break; +++ continue; + + case 'p': + + proflag++; - break; +++ continue; + + case 'g': + + gflag++; - break; - case 'W': /* deprecated */ +++ continue; + + case 'w': - Wflag++; - break; +++ wflag++; +++ continue; + + case 'E': + + exflag++; + + case 'P': + + pflag++; + + if (argv[i][1]=='P') - fprintf(stderr, "(Warning): -P option obsolete\n"); - *pv++ = argv[i]; +++ fprintf(stderr, +++ "cc: warning: -P option obsolete; you should use -E instead\n"); +++ plist[np++] = argv[i]; + + case 'c': + + cflag++; - break; - - case 'f': - noflflag++; - if (npassname || chpass) - error("-f overwrites earlier option",0); - npassname = "/lib/f"; - chpass = "12"; - break; - - case '2': - if(argv[i][2] == '\0') - pref = "/lib/crt2.o"; - else { - pref = "/lib/crt20.o"; - f20 = 1; - } - break; +++ continue; + + case 'D': + + case 'I': + + case 'U': + + case 'C': - *pv++ = argv[i]; - if (pv >= ptemp+MAXOPT) - { - error("Too many DIUC options", 0); - --pv; - } - break; +++ plist[np++] = argv[i]; +++ continue; + + case 't': + + if (chpass) - error("-t overwrites earlier option",0); +++ error("-t overwrites earlier option", 0); + + chpass = argv[i]+2; + + if (chpass[0]==0) + + chpass = "012p"; - break; - +++ continue; + + case 'B': + + if (npassname) + + error("-B overwrites earlier option", 0); + + npassname = argv[i]+2; + + if (npassname[0]==0) + + npassname = "/usr/c/o"; - break; - +++ continue; + + case 'd': - dflag++; - strcpyn(alist, argv[i], 19); - break; - } else { - passa: - t = argv[i]; - if((c=getsuf(t))=='c' || c=='s'|| exflag) { - clist[nc++] = t; - if (nc>=MAXFIL) - { - error("Too many source files",0); - exit(1); - } - t = setsuf(t, 'o'); - } - if (nodup(llist, t)) { - llist[nl++] = t; - if (nl >= MAXLIB) - { - error("Too many object/library files",0); - exit(1); - } - if (getsuf(t)=='o') - nxo++; - } +++ dflag = argv[i]; +++ continue; +++ } +++ t = argv[i]; +++ c = getsuf(t); +++ if (c=='c' || c=='s' || exflag) { +++ clist[nc++] = t; +++ t = setsuf(t, 'o'); +++ } +++ if (nodup(llist, t)) { +++ llist[nl++] = t; +++ if (getsuf(t)=='o') +++ nxo++; + + } + + } - if (gflag) oflag = 0; +++ if (gflag) { +++ if (oflag) +++ fprintf(stderr, "cc: warning: -g disables -O\n"); +++ oflag = 0; +++ } + + if (npassname && chpass ==0) + + chpass = "012p"; + + if (chpass && npassname==0) - npassname = "/usr/c/"; +++ npassname = "/usr/new"; + + if (chpass) - for (t=chpass; *t; t++) - { - switch (*t) - { - case '0': - strcpy (pass0, npassname); - strcat (pass0, "ccom"); - continue; - case '2': - strcpy (pass2, npassname); - strcat (pass2, "c2"); - continue; - case 'p': - strcpy (passp, npassname); - strcat (passp, "cpp"); - continue; - } - } - if (noflflag) - pref = proflag ? "/lib/fmcrt0.o" : "/lib/fcrt0.o"; - else if (proflag) - pref = "/lib/mcrt0.o"; - if(nc==0) - goto nocom; - if (pflag==0) { - FILE *c; - sprintf(tmp0,"/tmp/ctm%05.5da",getpid()); - while((c=fopen(tmp0, "r")) != NULL) { - fclose(c); - tmp0[9]++; +++ for (t=chpass; *t; t++) { +++ switch (*t) { +++ +++ case '0': +++ ccom = strspl(npassname, "ccom"); +++ continue; +++ case '2': +++ c2 = strspl(npassname, "c2"); +++ continue; +++ case 'p': +++ cpp = strspl(npassname, "cpp"); +++ continue; + + } - while((creat(tmp0, 0400))<0) - tmp0[9]++; + + } - if (signal(SIGINT, SIG_IGN) != SIG_IGN) /* interrupt */ +++ if (proflag) +++ crt0 = "/lib/mcrt0.o"; +++ if (nc==0) +++ goto nocom; +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) + + signal(SIGINT, idexit); - if (signal(SIGTERM, SIG_IGN) != SIG_IGN) /* terminate */ +++ if (signal(SIGTERM, SIG_IGN) != SIG_IGN) + + signal(SIGTERM, idexit); - (tmp1 = copy(tmp0))[13] = '1'; - (tmp2 = copy(tmp0))[13] = '2'; - (tmp3 = copy(tmp0))[13] = '3'; - if (oflag) - (tmp5 = copy(tmp0))[13] = '5'; + + if (pflag==0) - (tmp4 = copy(tmp0))[13] = '4'; - pvt = pv; +++ sprintf(tmp0, "/tmp/ctm%05.5d", getpid()); +++ tmp1 = strspl(tmp0, "1"); +++ tmp2 = strspl(tmp0, "2"); +++ tmp3 = strspl(tmp0, "3"); +++ if (pflag==0) +++ tmp4 = strspl(tmp0, "4"); +++ if (oflag) +++ tmp5 = strspl(tmp0, "5"); + + for (i=0; i1) { +++ if (nc > 1) { + + printf("%s:\n", clist[i]); + + fflush(stdout); + + } - if (getsuf(clist[i])=='s') { +++ if (getsuf(clist[i]) == 's') { + + assource = clist[i]; + + goto assemble; + + } else + + assource = tmp3; + + if (pflag) + + tmp4 = setsuf(clist[i], 'i'); - savetsp = tsp; - av[0] = "cpp"; - av[1] = clist[i]; - av[2] = exflag ? "-" : tmp4; +++ av[0] = "cpp"; av[1] = clist[i]; av[2] = exflag ? "-" : tmp4; + + na = 3; - for(pv=ptemp; pv 1) { +++ cunlink(tmp1); cunlink(tmp2); cunlink(tmp4); +++ av[0] = "as"; av[1] = "-o"; av[2] = setsuf(clist[i], 'o'); +++ na = 3; +++ if (Rflag) +++ av[na++] = "-R"; +++ if (dflag) +++ av[na++] = dflag; +++ av[na++] = assource; +++ av[na] = 0; +++ if (callsys(as, av) > 1) { + + cflag++; + + eflag++; + + continue; + + } + + } + +nocom: + + if (cflag==0 && nl!=0) { + + i = 0; - av[0] = "ld"; - av[1] = "-X"; - av[2] = pref; - j = 3; +++ av[0] = "ld"; av[1] = "-X"; av[2] = crt0; na = 3; + + if (outfile) { - av[j++] = "-o"; - av[j++] = outfile; +++ av[na++] = "-o"; +++ av[na++] = outfile; + + } - while(i2 && *s++=='.') - return(*s); - return(0); +++ if (c <= DIRSIZ && c > 2 && *s++ == '.') +++ return (*s); +++ return (0); + +} + + + +char * + +setsuf(as, ch) - char as[]; +++ char *as; + +{ + + register char *s, *s1; + + - s = s1 = copy(as); - while(*s) +++ s = s1 = savestr(as); +++ while (*s) + + if (*s++ == '/') + + s1 = s; + + s[-1] = ch; - return(s1); +++ return (s1); + +} + + + +callsys(f, v) - char f[], *v[]; { +++ char *f, **v; +++{ + + int t, status; + + - if ((t=vfork())==0) { +++ t = vfork(); +++ if (t == -1) { +++ printf("No more processes\n"); +++ return (100); +++ } +++ if (t == 0) { + + execv(f, v); + + printf("Can't find %s\n", f); + + fflush(stdout); + + _exit(100); - } else - if (t == -1) { - printf("Try again\n"); - return(100); - } - while(t!=wait(&status)); +++ } +++ while (t != wait(&status)) +++ ; + + if ((t=(status&0377)) != 0 && t!=14) { - if (t!=2) /* interrupt */ - { +++ if (t!=2) { + + printf("Fatal error in %s\n", f); + + eflag = 8; - } +++ } + + dexit(); + + } - return((status>>8) & 0377); - } - - char * - copy(as) - char as[]; - { - register char *otsp, *s; - int i; - - otsp = tsp; - s = as; - while(*tsp++ = *s++); - if (tsp >tsa+CHSPACE) - { - tsp = tsa = i = calloc(CHSPACE+50,1); - if (i== -1){ - error("no space for file names"); - dexit(8); - } - } - return(otsp); +++ return ((status>>8) & 0377); + +} + + + +nodup(l, os) - char **l, *os; +++ char **l, *os; + +{ + + register char *t, *s; + + register int c; + + + + s = os; + + if (getsuf(s) != 'o') - return(1); - while(t = *l++) { - while(c = *s++) +++ return (1); +++ while (t = *l++) { +++ while (c = *s++) + + if (c != *t++) + + break; - if (*t=='\0' && c=='\0') - return(0); +++ if (*t==0 && c==0) +++ return (0); + + s = os; + + } - return(1); +++ return (1); + +} + + - cunlink(f) - char *f; +++#define NSAVETAB 1024 +++char *savetab; +++int saveleft; +++ +++char * +++savestr(cp) +++ register char *cp; + +{ - if (f==0) - return(0); - return(unlink(f)); +++ register int len; +++ +++ len = strlen(cp) + 1; +++ if (len > saveleft) { +++ saveleft = NSAVETAB; +++ if (len > saveleft) +++ saveleft = len; +++ savetab = (char *)malloc(saveleft); +++ if (savetab == 0) { +++ fprintf(stderr, "ran out of memory (savestr)\n"); +++ exit(1); +++ } +++ } +++ strncpy(savetab, cp, len); +++ cp = savetab; +++ savetab += len; +++ saveleft -= len; +++ return (cp); +++} +++ +++char * +++strspl(left, right) +++ char *left, *right; +++{ +++ char buf[BUFSIZ]; +++ +++ strcpy(buf, left); +++ strcat(buf, right); +++ return (savestr(buf)); + +} diff --cc usr/src/cmd/checkeq.c index 0000000000,f60a127d1c,0000000000..66d95d439f mode 000000,100644,000000..100644 --- a/usr/src/cmd/checkeq.c +++ b/usr/src/cmd/checkeq.c @@@@ -1,0 -1,85 -1,0 +1,86 @@@@ +++static char *sccsid = "@(#)checkeq.c 4.1 (Berkeley) 10/1/80"; + +#include + +FILE *fin; + +int delim = '$'; + + + +main(argc, argv) char **argv; { + + + + if (argc <= 1) + + check(stdin); + + else + + while (--argc > 0) { + + if ((fin = fopen(*++argv, "r")) == NULL) { + + printf("Can't open %s\n", *argv); + + exit(1); + + } + + printf("%s:\n", *argv); + + check(fin); + + fclose(fin); + + } + +} + + + +check(f) + +FILE *f; + +{ + + int start, line, eq, ndel, totdel; + + char in[600], *p; + + + + start = eq = line = ndel = totdel = 0; + + while (fgets(in, 600, f) != NULL) { + + line++; + + ndel = 0; + + for (p = in; *p; p++) + + if (*p == delim) + + ndel++; + + if (*in=='.' && *(in+1)=='E' && *(in+2)=='Q') { + + if (eq++) + + printf(" Spurious EQ, line %d\n", line); + + if (totdel) + + printf(" EQ in %c%c, line %d\n", delim, delim, line); + + } else if (*in=='.' && *(in+1)=='E' && *(in+2)=='N') { + + if (eq==0) + + printf(" Spurious EN, line %d\n", line); + + else + + eq = 0; + + if (totdel > 0) + + printf(" EN in %c%c, line %d\n", delim, delim, line); + + start = 0; + + } else if (eq && *in=='d' && *(in+1)=='e' && *(in+2)=='l' && *(in+3)=='i' && *(in+4)=='m') { + + for (p=in+5; *p; p++) + + if (*p != ' ') { + + if (*p == 'o' && *(p+1) == 'f') + + delim = 0; + + else + + delim = *p; + + break; + + } + + if (delim == 0) + + printf(" Delim off, line %d\n", line); + + else + + printf(" New delims %c%c, line %d\n", delim, delim, line); + + } + + if (ndel > 0 && eq > 0) + + printf(" %c%c in EQ, line %d\n", delim, delim, line); + + if (ndel == 0) + + continue; + + totdel += ndel; + + if (totdel%2) { + + if (start == 0) + + start = line; + + else { + + printf(" %d line %c%c, lines %d-%d\n", line-start+1, delim, delim, start, line); + + start = line; + + } + + } else { + + if (start > 0) { + + printf(" %d line %c%c, lines %d-%d\n", line-start+1, delim, delim, start, line); + + start = 0; + + } + + totdel = 0; + + } + + } + + if (totdel) + + printf(" Unfinished %c%c\n", delim, delim); + + if (eq) + + printf(" Unfinished EQ\n"); + +} diff --cc usr/src/cmd/checknr.c index 0000000000,0000000000,0000000000..0db74b670b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/checknr.c @@@@ -1,0 -1,0 -1,0 +1,523 @@@@ +++static char *sccsid = "@(#)checknr.c 4.2 (Berkeley) 10/12/80"; +++/* +++ * checknr: check an nroff/troff input file for matching macro calls. +++ * we also attempt to match size and font changes, but only the embedded +++ * kind. These must end in \s0 and \fP resp. Maybe more sophistication +++ * later but for now think of these restrictions as contributions to +++ * structured typesetting. +++ */ +++#include +++#include +++ +++#define MAXSTK 100 /* Stack size */ +++#define MAXBR 100 /* Max number of bracket pairs known */ +++#define MAXCMDS 500 /* Max number of commands known */ +++ +++/* +++ * The stack on which we remember what we've seen so far. +++ */ +++struct stkstr { +++ int opno; /* number of opening bracket */ +++ int pl; /* '+', '-', ' ' for \s, 1 for \f, 0 for .ft */ +++ int parm; /* parm to size, font, etc */ +++ int lno; /* line number the thing came in in */ +++} stk[MAXSTK]; +++int stktop; +++ +++/* +++ * The kinds of opening and closing brackets. +++ */ +++struct brstr { +++ char *opbr; +++ char *clbr; +++} br[MAXBR] = { +++ /* A few bare bones troff commands */ +++#define SZ 0 +++ "sz", "sz", /* also \s */ +++#define FT 1 +++ "ft", "ft", /* also \f */ +++ /* the -ms package */ +++ "AB", "AE", +++ "RS", "RE", +++ "LG", "NL", +++ "SM", "NL", +++ "FS", "FE", +++ "DS", "DE", +++ "CD", "DE", +++ "LD", "DE", +++ "ID", "DE", +++ "KS", "KE", +++ "KF", "KE", +++ "QS", "QE", +++ /* Things needed by preprocessors */ +++ "TS", "TE", +++ "EQ", "EN", +++ /* The -me package */ +++ "(l", ")l", +++ "(q", ")q", +++ "(b", ")b", +++ "(z", ")z", +++ "(c", ")c", +++ "(d", ")d", +++ "(f", ")f", +++ "(x", ")x", +++ 0, 0 +++}; +++ +++/* +++ * All commands known to nroff, plus ms and me. +++ * Used so we can complain about unrecognized commands. +++ */ +++char *knowncmds[MAXCMDS] = { +++"$c", "$f", "$h", "$p", "$s", "(b", "(c", "(d", "(f", "(l", +++"(q", "(t", "(x", "(z", ")b", ")c", ")d", ")f", ")l", ")q", +++")t", ")x", ")z", "++", "+c", "1C", "1c", "2C", "2c", "@(", +++"@)", "@C", "@D", "@F", "@I", "@M", "@c", "@e", "@f", "@h", +++"@m", "@n", "@o", "@p", "@r", "@t", "@z", "AB", "AB", "AE", +++"AE", "AI", "AI", "AT", "AU", "AU", "AX", "B", "B1", "B2", +++"BD", "BG", "BT", "BX", "C1", "C2", "CD", "CM", "CT", "D", +++"DA", "DE", "DF", "DS", "EG", "EM", "EN", "EQ", "EQ", "FA", +++"FE", "FJ", "FK", "FL", "FN", "FO", "FQ", "FS", "FV", "FX", +++"HO", "I", "ID", "IE", "IH", "IM", "IP", "IZ", "KD", "KE", +++"KF", "KQ", "KS", "LB", "LD", "LG", "LP", "MC", "ME", "MF", +++"MH", "MR", "ND", "NH", "NL", "NP", "OK", "PP", "PT", "PY", +++"QE", "QP", "QS", "R", "RA", "RC", "RE", "RP", "RQ", "RS", +++"RT", "S0", "S2", "S3", "SG", "SH", "SM", "SY", "TA", "TC", +++"TD", "TE", "TH", "TL", "TL", "TM", "TQ", "TR", "TS", "TS", +++"TX", "UL", "US", "UX", "WH", "XD", "XF", "XK", "XP", "[-", +++"[0", "[1", "[2", "[3", "[4", "[5", "[<", "[>", "[]", "]-", +++"]<", "]>", "][", "ab", "ac", "ad", "af", "am", "ar", "as", +++"b", "ba", "bc", "bd", "bi", "bl", "bp", "bp", "br", "bx", +++"c.", "c2", "cc", "ce", "cf", "ch", "cs", "ct", "cu", "da", +++"de", "di", "dl", "dn", "ds", "dt", "dw", "dy", "ec", "ef", +++"eh", "el", "em", "eo", "ep", "ev", "ex", "fc", "fi", "fl", +++"fo", "fp", "ft", "fz", "hc", "he", "hl", "hp", "ht", "hw", +++"hx", "hy", "i", "ie", "if", "ig", "in", "ip", "it", "ix", +++"lc", "lg", "li", "ll", "ll", "ln", "lo", "lp", "ls", "lt", +++"m1", "m2", "m3", "m4", "mc", "mk", "mo", "n1", "n2", "na", +++"ne", "nf", "nh", "nl", "nm", "nn", "np", "nr", "ns", "nx", +++"of", "oh", "os", "pa", "pc", "pi", "pl", "pm", "pn", "po", +++"po", "pp", "ps", "q", "r", "rb", "rd", "re", "re", "rm", +++"rn", "ro", "rr", "rs", "rt", "sb", "sc", "sh", "sk", "so", +++"sp", "ss", "st", "sv", "sz", "ta", "tc", "th", "ti", "tl", +++"tm", "tp", "tr", "u", "uf", "uh", "ul", "vs", "wh", "yr", +++0 +++}; +++ +++int lineno; /* current line number in input file */ +++char line[256]; /* the current line */ +++char *cfilename; /* name of current file */ +++int nfiles; /* number of files to process */ +++int fflag; /* -f: ignore \f */ +++int sflag; /* -s: ignore \s */ +++int ncmds; /* size of knowncmds */ +++int slot; /* slot in knowncmds found by binsrch */ +++ +++char *malloc(); +++ +++main(argc, argv) +++int argc; +++char **argv; +++{ +++ FILE *f; +++ int i; +++ char *cp; +++ char b1[4]; +++ +++ if (argc <= 1) +++ usage(); +++ /* Figure out how many known commands there are */ +++ while (knowncmds[ncmds]) +++ ncmds++; +++ while (argc > 1 && argv[1][0] == '-') { +++ switch(argv[1][1]) { +++ +++ /* -a: add pairs of macros */ +++ case 'a': +++ i = strlen(argv[1]) - 2; +++ if (i % 6 != 0) +++ usage(); +++ /* look for empty macro slots */ +++ for (i=0; br[i].opbr; i++) +++ ; +++ for (cp=argv[1]+3; cp[-1]; cp += 6) { +++ br[i].opbr = malloc(3); +++ strncpy(br[i].opbr, cp, 2); +++ br[i].clbr = malloc(3); +++ strncpy(br[i].clbr, cp+3, 2); +++ addmac(br[i].opbr); /* knows pairs are also known cmds */ +++ addmac(br[i].clbr); +++ i++; +++ } +++ break; +++ +++ /* -c: add known commands */ +++ case 'c': +++ i = strlen(argv[1]) - 2; +++ if (i % 3 != 0) +++ usage(); +++ for (cp=argv[1]+3; cp[-1]; cp += 3) { +++ if (cp[2] && cp[2] != '.') +++ usage(); +++ strncpy(b1, cp, 2); +++ addmac(b1); +++ } +++ break; +++ +++ /* -f: ignore font changes */ +++ case 'f': +++ fflag = 1; +++ break; +++ +++ /* -s: ignore size changes */ +++ case 's': +++ sflag = 1; +++ break; +++ default: +++ usage(); +++ } +++ argc--; argv++; +++ } +++ +++ nfiles = argc - 1; +++ +++ if (nfiles > 0) { +++ for (i=1; i=0; i--) { +++ complain(i); +++ } +++} +++ +++complain(i) +++{ +++ pe(stk[i].lno); +++ printf("Unmatched "); +++ prop(i); +++ printf("\n"); +++} +++ +++prop(i) +++{ +++ if (stk[i].pl == 0) +++ printf(".%s", br[stk[i].opno].opbr); +++ else switch(stk[i].opno) { +++ case SZ: +++ printf("\\s%c%d", stk[i].pl, stk[i].parm); +++ break; +++ case FT: +++ printf("\\f%c", stk[i].parm); +++ break; +++ default: +++ printf("Bug: stk[%d].opno = %d = .%s, .%s", +++ i, stk[i].opno, br[stk[i].opno].opbr, br[stk[i].opno].clbr); +++ } +++} +++ +++chkcmd(line, mac) +++char *line; +++char *mac; +++{ +++ register int i, n; +++ +++ /* +++ * Check to see if it matches top of stack. +++ */ +++ if (stktop >= 0 && eq(mac, br[stk[stktop].opno].clbr)) +++ stktop--; /* OK. Pop & forget */ +++ else { +++ /* No. Maybe it's an opener */ +++ for (i=0; br[i].opbr; i++) { +++ if (eq(mac, br[i].opbr)) { +++ /* Found. Push it. */ +++ stktop++; +++ stk[stktop].opno = i; +++ stk[stktop].pl = 0; +++ stk[stktop].parm = 0; +++ stk[stktop].lno = lineno; +++ break; +++ } +++ /* +++ * Maybe it's an unmatched closer. +++ * NOTE: this depends on the fact +++ * that none of the closers can be +++ * openers too. +++ */ +++ if (eq(mac, br[i].clbr)) { +++ nomatch(mac); +++ break; +++ } +++ } +++ } +++} +++ +++nomatch(mac) +++char *mac; +++{ +++ register int i, j; +++ +++ /* +++ * Look for a match further down on stack +++ * If we find one, it suggests that the stuff in +++ * between is supposed to match itself. +++ */ +++ for (j=stktop; j>=0; j--) +++ if (eq(mac,br[stk[j].opno].clbr)) { +++ /* Found. Make a good diagnostic. */ +++ if (j == stktop-2) { +++ /* +++ * Check for special case \fx..\fR and don't +++ * complain. +++ */ +++ if (stk[j+1].opno==FT && stk[j+1].parm!='R' +++ && stk[j+2].opno==FT && stk[j+2].parm=='R') { +++ stktop = j -1; +++ return; +++ } +++ /* +++ * We have two unmatched frobs. Chances are +++ * they were intended to match, so we mention +++ * them together. +++ */ +++ pe(stk[j+1].lno); +++ prop(j+1); +++ printf(" does not match %d: ", stk[j+2].lno); +++ prop(j+2); +++ printf("\n"); +++ } else for (i=j+1; i <= stktop; i++) { +++ complain(i); +++ } +++ stktop = j-1; +++ return; +++ } +++ /* Didn't find one. Throw this away. */ +++ pe(lineno); +++ printf("Unmatched .%s\n", mac); +++} +++ +++/* eq: are two strings equal? */ +++eq(s1, s2) +++char *s1, *s2; +++{ +++ return (strcmp(s1, s2) == 0); +++} +++ +++/* print the first part of an error message, given the line number */ +++pe(lineno) +++int lineno; +++{ +++ if (nfiles > 1) +++ printf("%s: ", cfilename); +++ printf("%d: ", lineno); +++} +++ +++checkknown(mac) +++char *mac; +++{ +++ +++ if (eq(mac, ".")) +++ return; +++ if (binsrch(mac) >= 0) +++ return; +++ +++ pe(lineno); +++ printf("Unknown command: .%s\n", mac); +++} +++ +++/* +++ * We have a .de xx line in "line". Add xx to the list of known commands. +++ */ +++addcmd(line) +++char *line; +++{ +++ char *mac; +++ +++ /* grab the macro being defined */ +++ mac = line+4; +++ while (isspace(*mac)) +++ mac++; +++ if (*mac == 0) { +++ pe(lineno); +++ printf("illegal define: %s\n", line); +++ return; +++ } +++ mac[2] = 0; +++ if (isspace(mac[1]) || mac[1] == '\\') +++ mac[1] = 0; +++ if (ncmds >= MAXCMDS) { +++ printf("Only %d known commands allowed\n", MAXCMDS); +++ exit(1); +++ } +++ addmac(mac); +++} +++ +++/* +++ * Add mac to the list. We should really have some kind of tree +++ * structure here but this is a quick-and-dirty job and I just don't +++ * have time to mess with it. (I wonder if this will come back to haunt +++ * me someday?) Anyway, I claim that .de is fairly rare in user +++ * nroff programs, and the register loop below is pretty fast. +++ */ +++addmac(mac) +++char *mac; +++{ +++ register char **src, **dest, **loc; +++ +++ binsrch(mac); /* it's OK to redefine something */ +++ /* binsrch sets slot as a side effect */ +++#ifdef DEBUG +++printf("binsrch(%s) -> %d\n", mac, slot); +++#endif +++ loc = &knowncmds[slot]; +++ src = &knowncmds[ncmds-1]; +++ dest = src+1; +++ while (dest > loc) +++ *dest-- = *src--; +++ *loc = malloc(3); +++ strcpy(*loc, mac); +++ ncmds++; +++#ifdef DEBUG +++printf("after: %s %s %s %s %s, %d cmds\n", knowncmds[slot-2], knowncmds[slot-1], knowncmds[slot], knowncmds[slot+1], knowncmds[slot+2], ncmds); +++#endif +++} +++ +++/* +++ * Do a binary search in knowncmds for mac. +++ * If found, return the index. If not, return -1. +++ */ +++binsrch(mac) +++char *mac; +++{ +++ register char *p; /* pointer to current cmd in list */ +++ register int d; /* difference if any */ +++ register int mid; /* mid point in binary search */ +++ register int top, bot; /* boundaries of bin search, inclusive */ +++ +++ top = ncmds-1; +++ bot = 0; +++ while (top >= bot) { +++ mid = (top+bot)/2; +++ p = knowncmds[mid]; +++ d = p[0] - mac[0]; +++ if (d == 0) +++ d = p[1] - mac[1]; +++ if (d == 0) +++ return mid; +++ if (d < 0) +++ bot = mid + 1; +++ else +++ top = mid - 1; +++ } +++ slot = bot; /* place it would have gone */ +++ return -1; +++} diff --cc usr/src/cmd/chfn.c index 0000000000,36249de30a,0000000000..ed8774163d mode 000000,100644,000000..100644 --- a/usr/src/cmd/chfn.c +++ b/usr/src/cmd/chfn.c @@@@ -1,0 -1,111 -1,0 +1,113 @@@@ +++static char *sccsid = "@(#)chfn.c 4.1 (Berkeley) 10/1/80"; + +/* + + * chfn - change full name (or other info in gecos field) + + */ + +#include + +#include + +#include + + + +char passwd[] = "/etc/passwd"; + +char temp[] = "/etc/ptmp"; + +struct passwd *pwd; + +struct passwd *getpwent(); + +int endpwent(); + +char *crypt(); + +char *getpass(); + +char *pw; + +char pwbuf[10]; + +char buf[BUFSIZ]; + + + +main(argc, argv) + +char *argv[]; + +{ + + char *p; + + int i; + + char saltc[2]; + + long salt; + + int u,fi,fo; + + int insist; + + int ok, flags; + + int c; + + int pwlen; + + FILE *tf; + + + + insist = 0; + + if (argc != 3) { + + printf("Usage: chfn user full-name\n"); + + goto bex; + + } + + if (index(argv[2], ':') || index(argv[2], '\n')) { + + printf("Illegal character in new string\n"); + + exit(1); + + } + + while((pwd=getpwent()) != NULL){ + + if(strcmp(pwd->pw_name,argv[1]) == 0){ + + u = getuid(); + + if(u!=0 && u != pwd->pw_uid){ + + printf("Permission denied.\n"); + + goto bex; + + } + + break; + + } + + } + + endpwent(); + + signal(SIGHUP, 1); + + signal(SIGINT, 1); + + signal(SIGQUIT, 1); +++ signal(SIGTSTP, 1); + + + + if(access(temp, 0) >= 0) { + + printf("Temporary file busy -- try again\n"); + + goto bex; + + } + + if((tf=fopen(temp,"w")) == NULL) { + + printf("Cannot create temporary file\n"); + + goto bex; + + } + + + +/* + + * copy passwd to temp, replacing matching lines + + * with new shell. + + */ + + + + while((pwd=getpwent()) != NULL) { + + if(strcmp(pwd->pw_name,argv[1]) == 0) { + + u = getuid(); + + if(u != 0 && u != pwd->pw_uid) { + + printf("Permission denied.\n"); + + goto out; + + } + + pwd->pw_gecos = argv[2]; + + } + + fprintf(tf,"%s:%s:%d:%d:%s:%s:%s\n", + + pwd->pw_name, + + pwd->pw_passwd, + + pwd->pw_uid, + + pwd->pw_gid, + + pwd->pw_gecos, + + pwd->pw_dir, + + pwd->pw_shell); + + } + + endpwent(); + + fclose(tf); + + + +/* + + * copy temp back to passwd file + + */ + + + + if((fi=open(temp,0)) < 0) { + + printf("Temp file disappeared!\n"); + + goto out; + + } + + if((fo=creat(passwd, 0644)) < 0) { + + printf("Cannot recreat passwd file.\n"); + + goto out; + + } + + while((u=read(fi,buf,sizeof(buf))) > 0) write(fo,buf,u); + + + +out: + + unlink(temp); + + + +bex: + + exit(1); + +} diff --cc usr/src/cmd/chgrp.c index 0000000000,13b23ff6ef,0000000000..34f96c1a92 mode 000000,100644,000000..100644 --- a/usr/src/cmd/chgrp.c +++ b/usr/src/cmd/chgrp.c @@@@ -1,0 -1,53 -1,0 +1,54 @@@@ +++static char *sccsid = "@(#)chgrp.c 4.1 (Berkeley) 10/1/80"; + +/* + + * chgrp gid file ... + + */ + + + +#include + +#include + +#include + +#include + +#include + + + +struct group *gr,*getgrnam(); + +struct stat stbuf; + +int gid; + +int status; + + + +main(argc, argv) + +char *argv[]; + +{ + + register c; + + + + if(argc < 3) { + + printf("usage: chgrp gid file ...\n"); + + exit(4); + + } + + if(isnumber(argv[1])) { + + gid = atoi(argv[1]); + + } else { + + if((gr=getgrnam(argv[1])) == NULL) { + + printf("unknown group: %s\n",argv[1]); + + exit(4); + + } + + gid = gr->gr_gid; + + } + + for(c=2; c + +#include + +#include + + + +#define USER 05700 /* user's bits */ + +#define GROUP 02070 /* group's bits */ + +#define OTHER 00007 /* other's bits */ + +#define ALL 01777 /* all (note absence of setuid, etc) */ + + + +#define READ 00444 /* read permit */ + +#define WRITE 00222 /* write permit */ + +#define EXEC 00111 /* exec permit */ + +#define SETID 06000 /* set[ug]id */ + +#define STICKY 01000 /* sticky bit */ + + + +char *ms; + +int um; + +struct stat st; + + + +main(argc,argv) + +char **argv; + +{ + + register i; + + register char *p; + + int status = 0; + + + + if (argc < 3) { + + fprintf(stderr, "Usage: chmod [ugoa][+-=][rwxstugo] file ...\n"); + + exit(255); + + } + + ms = argv[1]; + + um = umask(0); + + newmode(0); + + for (i = 2; i < argc; i++) { + + p = argv[i]; + + if (stat(p, &st) < 0) { + + fprintf(stderr, "chmod: can't access %s\n", p); + + ++status; + + continue; + + } + + ms = argv[1]; + + if (chmod(p, newmode(st.st_mode)) < 0) { + + fprintf(stderr, "chmod: can't change %s\n", p); + + ++status; + + continue; + + } + + } + + exit(status); + +} + + + +newmode(nm) + +unsigned nm; + +{ + + register o, m, b; + + + + m = abs(); + + if (!*ms) + + return(m); + + do { + + m = who(); + + while (o = what()) { + + b = where(nm); + + switch (o) { + + case '+': + + nm |= b & m; + + break; + + case '-': + + nm &= ~(b & m); + + break; + + case '=': + + nm &= ~m; + + nm |= b & m; + + break; + + } + + } + + } while (*ms++ == ','); + + if (*--ms) { + + fprintf(stderr, "chmod: invalid mode\n"); + + exit(255); + + } + + return(nm); + +} + + + +abs() + +{ + + register c, i; + + + + i = 0; + + while ((c = *ms++) >= '0' && c <= '7') + + i = (i << 3) + (c - '0'); + + ms--; + + return(i); + +} + + + +who() + +{ + + register m; + + + + m = 0; + + for (;;) switch (*ms++) { + + case 'u': + + m |= USER; + + continue; + + case 'g': + + m |= GROUP; + + continue; + + case 'o': + + m |= OTHER; + + continue; + + case 'a': + + m |= ALL; + + continue; + + default: + + ms--; + + if (m == 0) + + m = ALL & ~um; + + return m; + + } + +} + + + +what() + +{ + + switch (*ms) { + + case '+': + + case '-': + + case '=': + + return *ms++; + + } + + return(0); + +} + + + +where(om) + +register om; + +{ + + register m; + + + + m = 0; + + switch (*ms) { + + case 'u': + + m = (om & USER) >> 6; + + goto dup; + + case 'g': + + m = (om & GROUP) >> 3; + + goto dup; + + case 'o': + + m = (om & OTHER); + + dup: + + m &= (READ|WRITE|EXEC); + + m |= (m << 3) | (m << 6); + + ++ms; + + return m; + + } + + for (;;) switch (*ms++) { + + case 'r': + + m |= READ; + + continue; + + case 'w': + + m |= WRITE; + + continue; + + case 'x': + + m |= EXEC; + + continue; + + case 's': + + m |= SETID; + + continue; + + case 't': + + m |= STICKY; + + continue; + + default: + + ms--; + + return m; + + } + +} diff --cc usr/src/cmd/chown.c index 0000000000,edfa00e69b,0000000000..d4b3f9dcbf mode 000000,100644,000000..100644 --- a/usr/src/cmd/chown.c +++ b/usr/src/cmd/chown.c @@@@ -1,0 -1,55 -1,0 +1,56 @@@@ +++static char *sccsid = "@(#)chown.c 4.1 (Berkeley) 10/1/80"; + +/* + + * chown uid file ... + + */ + + + +#include + +#include + +#include + +#include + +#include + + + +struct passwd *pwd,*getpwnam(); + +struct stat stbuf; + +int uid; + +int status; + + + +main(argc, argv) + +char *argv[]; + +{ + + register c; + + + + if(argc < 3) { + + printf("usage: chown uid file ...\n"); + + exit(4); + + } + + if(isnumber(argv[1])) { + + uid = atoi(argv[1]); + + goto cho; + + } + + if((pwd=getpwnam(argv[1])) == NULL) { + + printf("unknown user id: %s\n",argv[1]); + + exit(4); + + } + + uid = pwd->pw_uid; + + + +cho: + + for(c=2; c + +#include + +#include + + + +char passwd[] = "/etc/passwd"; + +char temp[] = "/etc/ptmp"; + +struct passwd *pwd; + +struct passwd *getpwent(); + +int endpwent(); + +char *crypt(); + +char *getpass(); + +char *pw; + +char pwbuf[10]; + +char buf[BUFSIZ]; + + + +main(argc, argv) + +char *argv[]; + +{ + + char *p; + + int i; + + char saltc[2]; + + long salt; + + int u,fi,fo; + + int insist; + + int ok, flags; + + int c; + + int pwlen; + + FILE *tf; + + + + insist = 0; + + if(argc < 2 || argc > 3) { - printf("Usage: chsh user [ /bin/csh ]\n"); +++ printf("Usage: chsh user [ /bin/oldcsh ] [ /bin/csh ]\n"); + + goto bex; + + } + + if (argc == 2) + + argv[2] = ""; - else if (strcmp(argv[2], "/bin/csh") && getuid()) { - printf("Only /bin/csh may be specified\n"); +++ else if (strcmp(argv[2], "/bin/oldcsh") && strcmp(argv[2], "/bin/csh") && getuid()) { +++ printf("Only /bin/oldcsh or /bin/csh may be specified\n"); + + exit(1); + + } + + while((pwd=getpwent()) != NULL){ + + if(strcmp(pwd->pw_name,argv[1]) == 0){ + + u = getuid(); + + if(u!=0 && u != pwd->pw_uid){ + + printf("Permission denied.\n"); + + goto bex; + + } + + break; + + } + + } + + endpwent(); + + signal(SIGHUP, 1); + + signal(SIGINT, 1); + + signal(SIGQUIT, 1); +++ signal(SIGTSTP, 1); + + + + if(access(temp, 0) >= 0) { + + printf("Temporary file busy -- try again\n"); + + goto bex; + + } + + if((tf=fopen(temp,"w")) == NULL) { + + printf("Cannot create temporary file\n"); + + goto bex; + + } + + + +/* + + * copy passwd to temp, replacing matching lines + + * with new shell. + + */ + + + + while((pwd=getpwent()) != NULL) { + + if(strcmp(pwd->pw_name,argv[1]) == 0) { + + u = getuid(); + + if(u != 0 && u != pwd->pw_uid) { + + printf("Permission denied.\n"); + + goto out; + + } + + pwd->pw_shell = argv[2]; + + } + + fprintf(tf,"%s:%s:%d:%d:%s:%s:%s\n", + + pwd->pw_name, + + pwd->pw_passwd, + + pwd->pw_uid, + + pwd->pw_gid, + + pwd->pw_gecos, + + pwd->pw_dir, + + pwd->pw_shell); + + } + + endpwent(); + + fclose(tf); + + + +/* + + * copy temp back to passwd file + + */ + + + + if((fi=open(temp,0)) < 0) { + + printf("Temp file disappeared!\n"); + + goto out; + + } + + if((fo=creat(passwd, 0644)) < 0) { + + printf("Cannot recreat passwd file.\n"); + + goto out; + + } + + while((u=read(fi,buf,sizeof(buf))) > 0) write(fo,buf,u); + + + +out: + + unlink(temp); + + + +bex: + + exit(1); + +} diff --cc usr/src/cmd/clear.c index 0000000000,dcc7e999f4,0000000000..d8435c98d1 mode 000000,100644,000000..100644 --- a/usr/src/cmd/clear.c +++ b/usr/src/cmd/clear.c @@@@ -1,0 -1,42 -1,0 +1,43 @@@@ +++static char *sccsid = "@(#)clear.c 4.1 (Berkeley) 10/1/80"; + +/* load me with -ltermlib */ + +/* #include on version 6 */ + +/* + + * clear - clear the screen + + */ + + + +#include + +#include + + + +char *getenv(); + +char *tgetstr(); + +char PC; + +short ospeed; + +#undef putchar + +int putchar(); + + + +main() + +{ + + char *cp = getenv("TERM"); + + char clbuf[20]; + + char pcbuf[20]; + + char *clbp = clbuf; + + char *pcbp = pcbuf; + + char *clear; + + char buf[1024]; + + char *pc; + + struct sgttyb tty; + + + + gtty(1, &tty); + + ospeed = tty.sg_ospeed; + + if (cp == (char *) 0) + + exit(1); + + if (tgetent(buf, cp) != 1) + + exit(1); + + pc = tgetstr("pc", &pcbp); + + if (pc) + + PC = *pc; + + clear = tgetstr("cl", &clbp); + + if (clear) + + tputs(clear, tgetnum("li"), putchar); + + exit (clear != (char *) 0); + +} diff --cc usr/src/cmd/clri.c index 0000000000,8c2fa625fb,0000000000..78f7c79f90 mode 000000,100644,000000..100644 --- a/usr/src/cmd/clri.c +++ b/usr/src/cmd/clri.c @@@@ -1,0 -1,79 -1,0 +1,80 @@@@ +++static char *sccsid = "@(#)clri.c 4.1 (Berkeley) 10/1/80"; + +/* + + * clri filsys inumber ... + + */ + + + +#include + +#include + + + +#define ISIZE (sizeof(struct dinode)) + +#define NI (BSIZE/ISIZE) + +struct ino + +{ + + char junk[ISIZE]; + +}; + +struct ino buf[NI]; + +int status; + + + +main(argc, argv) + +char *argv[]; + +{ + + register i, f; + + unsigned n; + + int j, k; + + long off; + + + + if(argc < 3) { + + printf("usage: clri filsys inumber ...\n"); + + exit(4); + + } + + f = open(argv[1], 2); + + if(f < 0) { + + printf("cannot open %s\n", argv[1]); + + exit(4); + + } + + for(i=2; i '9') + + return(0); + + return(1); + +} diff --cc usr/src/cmd/cmp.c index 0000000000,4400b8554c,0000000000..38985ebbd9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/cmp.c +++ b/usr/src/cmd/cmp.c @@@@ -1,0 -1,121 -1,0 +1,122 @@@@ +++static char *sccsid = "@(#)cmp.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + + + +FILE *file1,*file2; + +int eflg; + +int lflg = 1; + +long line = 1; + +long chr = 0; + +long skip1; + +long skip2; + + + +long otoi(); + + + +main(argc, argv) + +char **argv; + +{ + + register c1, c2; + + char *arg; + + + + if(argc < 3) + + goto narg; + + arg = argv[1]; + + if(arg[0] == '-' && arg[1] == 's') { + + lflg--; + + argv++; + + argc--; + + } + + arg = argv[1]; + + if(arg[0] == '-' && arg[1] == 'l') { + + lflg++; + + argv++; + + argc--; + + } + + if(argc < 3) + + goto narg; + + arg = argv[1]; + + if( arg[0]=='-' && arg[1]==0 ) + + file1 = stdin; + + else if((file1 = fopen(arg, "r")) == NULL) + + goto barg; + + arg = argv[2]; + + if((file2 = fopen(arg, "r")) == NULL) + + goto barg; + + if (argc>3) + + skip1 = otoi(argv[3]); + + if (argc>4) + + skip2 = otoi(argv[4]); + + while (skip1) { + + if ((c1 = getc(file1)) == EOF) { + + arg = argv[1]; + + goto earg; + + } + + skip1--; + + } + + while (skip2) { + + if ((c2 = getc(file2)) == EOF) { + + arg = argv[2]; + + goto earg; + + } + + skip2--; + + } + + + +loop: + + chr++; + + c1 = getc(file1); + + c2 = getc(file2); + + if(c1 == c2) { + + if (c1 == '\n') + + line++; + + if(c1 == EOF) { + + if(eflg) + + exit(1); + + exit(0); + + } + + goto loop; + + } + + if(lflg == 0) + + exit(1); + + if(c1 == EOF) { + + arg = argv[1]; + + goto earg; + + } + + if(c2 == EOF) + + goto earg; + + if(lflg == 1) { + + printf("%s %s differ: char %ld, line %ld\n", argv[1], arg, + + chr, line); + + exit(1); + + } + + eflg = 1; + + printf("%6ld %3o %3o\n", chr, c1, c2); + + goto loop; + + + +narg: + + printf("cmp: arg count\n"); + + exit(2); + + + +barg: + + if (lflg) + + printf("cmp: cannot open %s\n", arg); + + exit(2); + + + +earg: + + printf("cmp: EOF on %s\n", arg); + + exit(1); + +} + + + +long otoi(s) + +char *s; + +{ + + long v; + + int base; + + + + v = 0; + + base = 10; + + if (*s == '0') + + base = 8; + + while(isdigit(*s)) + + v = v*base + *s++ - '0'; + + return(v); + +} diff --cc usr/src/cmd/col.c index 0000000000,c222405e5a,0000000000..9ab0ba386e mode 000000,100644,000000..100644 --- a/usr/src/cmd/col.c +++ b/usr/src/cmd/col.c @@@@ -1,0 -1,309 -1,0 +1,310 @@@@ +++static char *sccsid = "@(#)col.c 4.1 (Berkeley) 10/1/80"; + +# include + +# define PL 256 + +# define ESC '\033' + +# define RLF '\013' + +# define SI '\017' + +# define SO '\016' + +# define GREEK 0200 + +# define LINELN 800 + + + +char *page[PL]; + +char lbuff [LINELN], *line; + +int bflag, hflag, fflag; + +int half; + +int cp, lp; + +int ll, llh, mustwr; + +int pcp = 0; + +char *pgmname; + +char *strcpy(); + + + +main (argc, argv) + + int argc; char **argv; + +{ + + int i; + + int greek; + + register int c; + + char fbuff[BUFSIZ]; + + + + setbuf (stdout, fbuff); + + pgmname = argv[0]; + + + + for (i = 1; i < argc; i++) { + + register char *p; + + if (*argv[i] != '-') { + + fprintf (stderr, "%s: bad option %s\n", + + pgmname, argv[i]); + + exit (2); + + } + + for (p = argv[i]+1; *p; p++) { + + switch (*p) { + + case 'b': + + bflag++; + + break; + + + + case 'h': + + hflag++; + + break; + + + + case 'f': + + fflag++; + + break; + + + + default: + + fprintf (stderr, "%s: bad option letter %c\n", + + pgmname, *p); + + exit (2); + + } + + } + + } + + + + for (ll=0; ll 0) { + + incr(); + + incr(); + + half -= 2; + + } + + } + + break; + + } + + continue; + + + + case SO: + + greek = GREEK; + + continue; + + + + case SI: + + greek = 0; + + continue; + + + + case RLF: + + decr(); + + decr(); + + continue; + + + + case '\r': + + cp = 0; + + continue; + + + + case '\t': + + cp = (cp + 8) & -8; + + continue; + + + + case '\b': + + if (cp > 0) + + cp--; + + continue; + + + + case ' ': + + cp++; + + continue; + + + + default: + + c &= 0177; + + if (c > 040 && c < 0177) { /* if printable */ + + outc(c | greek); + + cp++; + + } + + continue; + + } + + } + + + + for (i=0; i cp) { + + line = lbuff; + + lp = 0; + + } + + + + while (lp < cp) { + + switch (*line) { + + case '\0': + + *line = ' '; + + lp++; + + break; + + + + case '\b': + + lp--; + + break; + + + + default: + + lp++; + + } + + line++; + + } + + while (*line == '\b') { + + line += 2; + + } + + if (bflag || *line == '\0' || *line == ' ') + + *line = c; + + else { + + register char c1, c2, c3; + + c1 = *++line; + + *line++ = '\b'; + + c2 = *line; + + *line++ = c; + + while (c1) { + + c3 = *line; + + *line++ = c1; + + c1 = c2; + + c2 = c3; + + } + + lp = 0; + + line = lbuff; + + } + +} + + + +store (lno) + +{ + + char *malloc(); + + + + lno %= PL; + + if (page[lno] != 0) + + free (page[lno]); + + page[lno] = malloc((unsigned)strlen(lbuff) + 2); + + if (page[lno] == 0) { + + fprintf (stderr, "%s: no storage\n", pgmname); + + exit (2); + + } + + strcpy (page[lno],lbuff); + +} + + + +fetch(lno) + +{ + + register char *p; + + + + lno %= PL; + + p = lbuff; + + while (*p) + + *p++ = '\0'; + + line = lbuff; + + lp = 0; + + if (page[lno]) + + strcpy (line, page[lno]); + +} + +emit (s, lineno) + + char *s; + + int lineno; + +{ + + static int cline = 0; + + register int ncp; + + register char *p; + + static int gflag = 0; + + + + if (*s) { + + while (cline < lineno - 1) { + + putchar ('\n'); + + pcp = 0; + + cline += 2; + + } + + if (cline != lineno) { + + putchar (ESC); + + putchar ('9'); + + cline++; + + } + + if (pcp) + + putchar ('\r'); + + pcp = 0; + + p = s; + + while (*p) { + + ncp = pcp; + + while (*p++ == ' ') { + + if ((++ncp & 7) == 0 && hflag) { + + pcp = ncp; + + putchar ('\t'); + + } + + } + + if (!*--p) + + break; + + while (pcp < ncp) { + + putchar (' '); + + pcp++; + + } + + if (gflag != (*p & GREEK) && *p != '\b') { + + if (gflag) + + putchar (SI); + + else + + putchar (SO); + + gflag ^= GREEK; + + } + + putchar (*p & ~GREEK); + + if (*p++ == '\b') + + pcp--; + + else + + pcp++; + + } + + } + +} + + + +incr() + +{ + + store (ll++); + + if (ll > llh) + + llh = ll; + + if (ll >= mustwr && page[ll%PL]) { + + emit (page[ll%PL], ll - PL); + + mustwr++; + + free (page[ll%PL]); + + page[ll%PL] = 0; + + } + + fetch (ll); + +} + + + +decr() + +{ + + if (ll > mustwr - PL) { + + store (ll--); + + fetch (ll); + + } + +} diff --cc usr/src/cmd/colcrt.c index 0000000000,81e509f7f5,0000000000..dd04705970 mode 000000,100644,000000..100644 --- a/usr/src/cmd/colcrt.c +++ b/usr/src/cmd/colcrt.c @@@@ -1,0 -1,233 -1,0 +1,234 @@@@ +++static char *sccsid = "@(#)colcrt.c 4.1 (Berkeley) 10/1/80"; + +#include + +/* + + * colcrt - replaces col for crts with new nroff esp. when using tbl. + + * Bill Joy UCB July 14, 1977 + + * + + * This filter uses a screen buffer, 267 half-lines by 132 columns. + + * It interprets the up and down sequences generated by the new + + * nroff when used with tbl and by \u \d and \r. + + * General overstriking doesn't work correctly. + + * Underlining is split onto multiple lines, etc. + + * + + * Option - suppresses all underlining. + + * Option -2 forces printing of all half lines. + + */ + + + +char page[267][132]; + + + +int outline = 1; + +int outcol; + + + +char buf[256]; + +char suppresul; + +char printall; + + + +char *progname; + +FILE *f; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register c; + + register char *cp, *dp; + + + + argc--; + + progname = *argv++; + + while (argc > 0 && argv[0][0] == '-') { + + switch (argv[0][1]) { + + case 0: + + suppresul = 1; + + break; + + case '2': + + printall = 1; + + break; + + default: + + printf("usage: %s [ - ] [ -2 ] [ file ... ]\n", progname); + + fflush(stdout); + + exit(1); + + } + + argc--; + + argv++; + + } + + setbuf(stdout, buf); + + do { + + if (argc > 0) { + + close(0); + + if ((f=fopen(argv[0], "r") + +) < 0) { + + fflush(stdout); + + perror(argv[0]); + + fflush(stdout); + + exit (1); + + } + + argc--; + + argv++; + + } + + for (;;) { + + c = getc(stdin); + + if (c == -1) { + + pflush(outline); + + fflush(stdout); + + break; + + } + + switch (c) { + + case '\n': + + if (outline >= 265) + + pflush(62); + + outline += 2; + + outcol = 0; + + continue; + + case '\016': + + case '\017': + + continue; + + case 033: + + c = getc(stdin); + + switch (c) { + + case '9': + + if (outline >= 266) + + pflush(62); + + outline++; + + continue; + + case '8': + + if (outline >= 1) + + outline--; + + continue; + + case '7': + + outline -= 2; + + if (outline < 0) + + outline = 0; + + continue; + + default: + + continue; + + } + + case '\b': + + if (outcol) + + outcol--; + + continue; + + case '\t': + + outcol += 8; + + outcol &= ~7; + + outcol--; + + c = ' '; + + default: + + if (outcol >= 132) { + + outcol++; + + continue; + + } + + cp = &page[outline][outcol]; + + outcol++; + + if (c == '_') { + + if (suppresul) + + continue; + + cp += 132; + + c = '-'; + + } + + if (*cp == 0) { + + *cp = c; + + dp = cp - outcol; + + for (cp--; cp >= dp && *cp == 0; cp--) + + *cp = ' '; + + } else + + if (plus(c, *cp) || plus(*cp, c)) + + *cp = '+'; + + else if (*cp == ' ' || *cp == 0) + + *cp = c; + + continue; + + } + + } + + } while (argc > 0); + + fflush(stdout); + + exit(0); + +} + + + +plus(c, d) + + char c, d; + +{ + + + + return (c == '|' && d == '-' || d == '_'); + +} + + + +int first; + + + +pflush(ol) + + int ol; + +{ + + register int i, j; + + register char *cp; + + char lastomit; + + int l; + + + + l = ol; + + lastomit = 0; + + if (l > 266) + + l = 266; + + else + + l |= 1; + + for (i = first | 1; i < l; i++) { + + move(i, i - 1); + + move(i, i + 1); + + } + + for (i = first; i < l; i++) { + + cp = page[i]; + + if (printall == 0 && lastomit == 0 && *cp == 0) { + + lastomit = 1; + + continue; + + } + + lastomit = 0; + + printf("%s\n", cp); + + } + + copy(page, page[ol], (267 - ol) * 132); + + clear(page[267- ol], ol * 132); + + outline -= ol; + + outcol = 0; + + first = 1; + +} + +move(l, m) + + int l, m; + +{ + + register char *cp, *dp; + + + + for (cp = page[l], dp = page[m]; *cp; cp++, dp++) { + + switch (*cp) { + + case '|': + + if (*dp != ' ' && *dp != '|' && *dp != 0) + + return; + + break; + + case ' ': + + break; + + default: + + return; + + } + + } + + if (*cp == 0) { + + for (cp = page[l], dp = page[m]; *cp; cp++, dp++) + + if (*cp == '|') + + *dp = '|'; + + else if (*dp == 0) + + *dp = ' '; + + page[l][0] = 0; + + } + +} + + + +copy(to, from, i) + + register char *to, *from; + + register int i; + +{ + + + + if (i > 0) + + do + + *to++ = *from++; + + while (--i); + +} + + + +clear(at, cnt) + + register char *at; + + register int cnt; + +{ + + + + if (cnt > 0) + + do + + *at++ = 0; + + while (--cnt); + +} diff --cc usr/src/cmd/colrm.c index 0000000000,4030f3a153,0000000000..a616677e53 mode 000000,100644,000000..100644 --- a/usr/src/cmd/colrm.c +++ b/usr/src/cmd/colrm.c @@@@ -1,0 -1,72 -1,0 +1,78 @@@@ +++static char *Sccsid = "@(#)colrm.c 4.2 (Berkeley) 10/9/80"; + +#include + +/* + +COLRM removes unwanted columns from a file + + Jeff Schriebman UC Berkeley 11-74 + +*/ + + + + + +main(argc,argv) + +char **argv; + +{ + + int first; + + register ct,last; + + register char c; - char buffer[512]; +++ char buffer[BUFSIZ]; + + + + setbuf(stdout, buffer); + + first = 20000; + + last = -1; + + if (argc>1) { + + first = getn(*++argv); + + last = 20000; + + } + + if (argc>2) + + last = getn(*++argv); + + + +start: + + ct = 0; + +loop1: + + if ((c=getc(stdin))<0) + + goto fin; - ct++; +++ if (c == '\t') +++ ct = (ct + 8) &~ 7; +++ else if (c == '\b') +++ ct = ct ? ct - 1 : 0; +++ else +++ ct++; + + if (c=='\n') { + + putc(c,stdout); + + goto start; + + } + + if (ct0) { + + putc(c,stdout); + + if (c=='\n') + + goto start; + + } + +fin: + + fflush(stdout); + +} + + + +getn(ap) + +char *ap; + +{ + + register int n,c; + + register char *p; + + + + p = ap; + + n = 0; + + while ((c = *p++) >= '0' && c <= '9') + + n = n*10 + c - '0'; + + return(n); + +} diff --cc usr/src/cmd/comm.c index 0000000000,a137ca3a0e,0000000000..6f105c6506 mode 000000,100644,000000..100644 --- a/usr/src/cmd/comm.c +++ b/usr/src/cmd/comm.c @@@@ -1,0 -1,166 -1,0 +1,167 @@@@ +++static char *sccsid = "@(#)comm.c 4.1 (Berkeley) 10/1/80"; + +#include + +#define LB 256 + +int one; + +int two; + +int three; + + + +char *ldr[3]; + + + +FILE *ib1; + +FILE *ib2; + +FILE *openfil(); + +main(argc,argv) + +char *argv[]; + +{ + + int l; + + char lb1[LB],lb2[LB]; + + + + ldr[0] = ""; + + ldr[1] = "\t"; + + ldr[2] = "\t\t"; + + if(argc > 1) { + + if(*argv[1] == '-' && argv[1][1] != 0) { + + l = 1; + + while(*++argv[1]) { + + switch(*argv[1]) { + + case'1': + + if(!one) { + + one = 1; + + ldr[1][0] = + + ldr[2][l--] = '\0'; + + } + + break; + + case '2': + + if(!two) { + + two = 1; + + ldr[2][l--] = '\0'; + + } + + break; + + case '3': + + three = 1; + + break; + + default: + + fprintf(stderr,"comm: illegal flag\n"); + + exit(1); + + } + + } + + argv++; + + argc--; + + } + + } + + + + if(argc < 3) { + + fprintf(stderr,"comm: arg count\n"); + + exit(1); + + } + + + + ib1 = openfil(argv[1]); + + ib2 = openfil(argv[2]); + + + + + + if(rd(ib1,lb1) < 0) { + + if(rd(ib2,lb2) < 0) exit(0); + + copy(ib2,lb2,2); + + } + + if(rd(ib2,lb2) < 0) copy(ib1,lb1,1); + + + + while(1) { + + + + switch(compare(lb1,lb2)) { + + + + case 0: + + wr(lb1,3); + + if(rd(ib1,lb1) < 0) { + + if(rd(ib2,lb2) < 0) exit(0); + + copy(ib2,lb2,2); + + } + + if(rd(ib2,lb2) < 0) copy(ib1,lb1,1); + + continue; + + + + case 1: + + wr(lb1,1); + + if(rd(ib1,lb1) < 0) copy(ib2,lb2,2); + + continue; + + + + case 2: + + wr(lb2,2); + + if(rd(ib2,lb2) < 0) copy(ib1,lb1,1); + + continue; + + } + + } + +} + + + +rd(file,buf) + +FILE *file; + +char *buf; + +{ + + + + register int i, c; + + i = 0; + + while((c = getc(file)) != EOF) { + + *buf = c; + + if(c == '\n' || i > LB-2) { + + *buf = '\0'; + + return(0); + + } + + i++; + + buf++; + + } + + return(-1); + +} + + + +wr(str,n) + + char *str; + +{ + + + + switch(n) { + + + + case 1: + + if(one) return; + + break; + + + + case 2: + + if(two) return; + + break; + + + + case 3: + + if(three) return; + + } + + printf("%s%s\n",ldr[n-1],str); + +} + + + +copy(ibuf,lbuf,n) + +FILE *ibuf; + +char *lbuf; + +{ + + do { + + wr(lbuf,n); + + } while(rd(ibuf,lbuf) >= 0); + + + + exit(0); + +} + + + +compare(a,b) + + char *a,*b; + +{ + + register char *ra,*rb; + + + + ra = --a; + + rb = --b; + + while(*++ra == *++rb) + + if(*ra == '\0') return(0); + + if(*ra < *rb) return(1); + + return(2); + +} + +FILE *openfil(s) + +char *s; + +{ + + FILE *b; + + if(s[0]=='-' && s[1]==0) + + b = stdin; + + else if((b=fopen(s,"r")) == NULL) { + + fprintf(stderr,"comm: cannot open %s\n",s); + + exit(1); + + } + + return(b); + +} diff --cc usr/src/cmd/comsat.c index 0000000000,0000000000,0000000000..fdd35cf45f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/comsat.c @@@@ -1,0 -1,0 -1,0 +1,255 @@@@ +++static char *sccsid = "@(#)comsat.c 4.2 (Berkeley) 10/20/80"; +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++ +++/* +++ * comsat +++ */ +++#define dprintf if (0) printf +++int xd; +++ +++struct ctp { +++ short ctrl; +++ short ctrlarg; +++ struct sgttyb ctrlv; +++} ctp; +++ +++#define MAXUTMP 100 /* down from init */ +++ +++struct utmp utmp[100]; +++int nutmp; +++int uf; +++unsigned utmpmtime; /* last modification time for utmp */ +++int onalrm(); +++ +++#define NAMLEN (sizeof (uts[0].ut_name) + 1) +++ +++main(argc, argv) +++char **argv; +++{ +++ register cc; +++ char buf[BUFSIZ]; +++ +++ if (fork()) +++ exit(); +++ chdir("/usr/spool/mail"); +++ if((uf = open("/etc/utmp",0)) < 0) +++ perror("/etc/utmp"), exit(1); +++ while (fork()) +++ wait(0); +++ sleep(10); +++ onalrm(); +++ sigset(SIGALRM, onalrm); +++ sigignore(SIGTTOU); +++ unlink("/dev/mail"); +++ xd = mpx("/dev/mail", 0666); +++ if (xd < 0) { +++ close(2); +++ open("/dev/console", 1); +++ perror("/dev/mail"); +++ exit(1); +++ } +++ while((cc=read(xd, buf, BUFSIZ)) >= 0) { +++ dprintf("0: got %d bytes\n", cc); +++ unpack(buf, cc); +++ } +++ _exit(1); +++} +++ +++#define skip(rp, c) ((struct rh *)(((char *)rp)+c)) +++ +++unpack(rp, cc) +++ register struct rh *rp; +++{ +++ register struct rh *end; +++ int i; +++ +++ i = 0; +++ end = skip(rp, cc); +++ while (rp < end) { +++ dprintf("%d: ", ++i); +++ if (rp->count==0) { +++ dprintf("%d byte control message\n", rp->ccount); +++ control(rp->index, rp+1, rp->ccount); +++ } else { +++ dprintf("%*.*s\n", rp->count, rp->count, rp+1); +++ sighold(SIGALRM); +++ mailfor(rp+1); +++ sigrelse(SIGALRM); +++ } +++ rp->count += rp->ccount; +++ if (rp->count & 1) +++ rp->count++; +++ rp = skip(rp, rp->count); +++ rp++; +++ } +++} +++ +++control(x, cb, cc) +++ register char *cb; +++{ +++ register char *end; +++ int cmd; +++ short *sp; +++ struct wh or; +++ +++ end = cb + cc; +++ cmd = *cb++; +++ sp = (short *)cb+1; +++ switch (cmd) { +++ +++ case M_WATCH: +++ dprintf("attach %x, uid %d\n", x, *sp); +++ attach(x, xd); +++ break; +++ +++ case M_CLOSE: +++ sp = (short *)cb; +++ dprintf("detach %x, uid %d\n", x, *sp); +++ detach(x, xd); +++ break; +++ +++ case M_IOCTL: +++ dprintf("ioctl %x\n", x); +++ or.index = x; +++ or.count = 0; +++ or.ccount = sizeof ctp; +++ or.data = (char *) &ctp.ctrlarg; +++ ctp.ctrlarg = M_IOANS; +++ write(xd, &or, sizeof or); +++ break; +++ +++ default: +++ dprintf("unknown command %d\n", cmd); +++ return; +++ } +++} +++ +++onalrm() +++{ +++ struct stat statbf; +++ struct utmp *utp; +++ +++ dprintf("alarm\n"); +++ alarm(15); +++ fstat(uf,&statbf); +++ if (statbf.st_mtime > utmpmtime) { +++ dprintf(" changed\n"); +++ utmpmtime = statbf.st_mtime; +++ lseek(uf, 0, 0); +++ nutmp = read(uf,utmp,sizeof(utmp))/sizeof(struct utmp); +++ } else +++ dprintf(" ok\n"); +++} +++ +++mailfor(name) +++ char *name; +++{ +++ register struct utmp *utp = &utmp[nutmp]; +++ register char *cp; +++ char *rindex(); +++ int offset; +++ +++ dprintf("mailfor %s\n", name); +++ cp = name; +++ while (*cp && *cp != '@') +++ cp++; +++ if (*cp == 0) { +++ dprintf("bad format\n"); +++ return; +++ } +++ *cp = 0; +++ offset = atoi(cp+1); +++ while (--utp >= utmp) +++ if (!strncmp(utp->ut_name, name, sizeof(utmp[0].ut_name))) +++ if (fork() == 0) { +++ signal(SIGALRM, SIG_DFL); +++ alarm(30); +++ notify(utp, offset), exit(0); +++ } else +++ while (wait3(0, WNOHANG, 0) > 0) +++ continue; +++} +++ +++char *cr; +++ +++notify(utp, offset) +++ register struct utmp *utp; +++{ +++ FILE *tp; +++ struct sgttyb gttybuf; +++ char tty[20]; +++ char name[sizeof (utmp[0].ut_name) + 1]; +++ struct stat stb; +++ +++ strcpy(tty, "/dev/"); +++ strncat(tty, utp->ut_line, sizeof(utp->ut_line)); +++ dprintf("notify %s on %s\n", utp->ut_name, tty); +++ if (stat(tty, &stb) == 0 && (stb.st_mode & 0100) == 0) { +++ dprintf("wrong mode\n"); +++ return; +++ } +++ if ((tp = fopen(tty,"w")) == 0) { +++ dprintf("fopen failed\n"); +++ return; +++ } +++ gtty(fileno(tp),>tybuf); +++ cr = (gttybuf.sg_flags & CRMOD) ? "" : "\r"; +++ strncpy(name, utp->ut_name, sizeof (utp->ut_name)); +++ name[sizeof (name) - 1] = 0; +++ fprintf(tp,"%s\n\007New mail for %s\007 has arrived:%s\n", +++ cr, name, cr); +++ fprintf(tp,"----%s\n", cr); +++ jkfprintf(tp, name, offset); +++ fclose(tp); +++} +++ +++jkfprintf(tp, name, offset) +++ register FILE *tp; +++{ +++ register FILE *fi; +++ register int linecnt, charcnt; +++ +++ dprintf("HERE %s's mail starting at %d\n", +++ name, offset); +++ if ((fi = fopen(name,"r")) == NULL) { +++ dprintf("Cant read the mail\n"); +++ return; +++ } +++ fseek(fi, offset, 0); +++ linecnt = 7; +++ charcnt = 560; +++ /* +++ * print the first 7 lines or 560 characters of the new mail +++ * (whichever comes first) +++ */ +++ for (;;) { +++ register ch; +++ +++ if ((ch = getc(fi)) == EOF) { +++ fprintf(tp,"----%s\n", cr); +++ break; +++ } +++ if (ch == '\n') { +++ fprintf(tp,"%s\n", cr); +++ if (linecnt-- < 0) { +++ fprintf(tp,"...more...%s\n", cr); +++ break; +++ } +++ } else if(linecnt <= 0) { +++ fprintf(tp,"...more...%s\n", cr); +++ break; +++ } else +++ putc(ch, tp); +++ if (charcnt-- == 0) { +++ fprintf(tp, "%s\n", cr); +++ break; +++ } +++ } +++} diff --cc usr/src/cmd/cp.c index 0000000000,730388357a,0000000000..3e1f1fbdbe mode 000000,100644,000000..100644 --- a/usr/src/cmd/cp.c +++ b/usr/src/cmd/cp.c @@@@ -1,0 -1,90 -1,0 +1,123 @@@@ +++static char *sccsid = "@(#)cp.c 4.1 (Berkeley) 10/1/80"; + +/* + + * cp oldfile newfile + + */ + + + +#define BSIZE 1024 + +#include + +#include + +#include + +struct stat stbuf1, stbuf2; + +char iobuf[BSIZE]; +++int iflag = 0; /* interactive flag. If this flag is set, +++ * the user is queried before files are +++ * destroyed by cp. +++ */ + + + +main(argc, argv) + +char *argv[]; + +{ + + register i, r; + + +++ /* get the flag(s) */ +++ +++ if (argc < 2) +++ goto usage; +++ if (*argv[1] == '-') { +++ argc--; +++ while (*++argv[1] != '\0') +++ switch (*argv[1]) { +++ +++ /* interactive mode */ +++ case 'i': +++ iflag++; +++ break; +++ +++ /* don't live with bad options */ +++ default: +++ goto usage; +++ } +++ argv++; +++ } + + if (argc < 3) + + goto usage; + + if (argc > 3) { + + if (stat(argv[argc-1], &stbuf2) < 0) + + goto usage; + + if ((stbuf2.st_mode&S_IFMT) != S_IFDIR) + + goto usage; + + } + + r = 0; + + for(i=1; i=0 && + + (stbuf2.st_mode&S_IFMT) == S_IFDIR) { + + p1 = from; + + p2 = to; + + bp = iobuf; + + while(*bp++ = *p2++) + + ; + + bp[-1] = '/'; + + p2 = bp; + + while(*bp = *p1++) + + if (*bp++ == '/') + + bp = p2; + + to = iobuf; + + } + + if (stat(to, &stbuf2) >= 0) { + + if (stbuf1.st_dev == stbuf2.st_dev && + + stbuf1.st_ino == stbuf2.st_ino) { + + fprintf(stderr, "cp: cannot copy file to itself.\n"); + + return(1); +++ } else if (iflag) { +++ fprintf (stderr, "overwrite %s? ", to); +++ i = c = getchar(); +++ while (c != '\n' && c != EOF) +++ c = getchar(); +++ if (i != 'y') +++ return(1); + + } + + } + + if ((fnew = creat(to, mode)) < 0) { + + fprintf(stderr, "cp: cannot create %s\n", to); + + close(fold); + + return(1); + + } + + while(n = read(fold, iobuf, BSIZE)) { + + if (n < 0) { + + perror("cp: read"); + + close(fold); + + close(fnew); + + return(1); + + } else + + if (write(fnew, iobuf, n) != n) { + + perror("cp: write"); + + close(fold); + + close(fnew); + + return(1); + + } + + } + + close(fold); + + close(fnew); + + return(0); + +} diff --cc usr/src/cmd/cron.c index 0000000000,b10c8b3491,0000000000..2069c5a5ea mode 000000,100644,000000..100644 --- a/usr/src/cmd/cron.c +++ b/usr/src/cmd/cron.c @@@@ -1,0 -1,252 -1,0 +1,253 @@@@ +++static char *sccsid = "@(#)cron.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +#include + +#include + +#include + + + +#define LISTS 512 + + + +#define EXACT 0 + +#define ANY 1 + +#define LIST 2 + +#define RANGE 3 + +#define EOS 4 + +char crontab[] = "/usr/lib/crontab"; + +time_t itime; + +struct tm *loct; + +struct tm *localtime(); + +char *malloc(); + +char *realloc(); + +int flag; + +char *list; + +unsigned listsize; + + + +main() + +{ + + register char *cp; + + char *cmp(); + + time_t filetime = 0; + + - setuid(1); +++ /* setuid(1); */ + + if (fork()) + + exit(0); + + chdir("/"); + + freopen(crontab, "r", stdin); + + freopen("/", "r", stdout); + + freopen("/", "r", stderr); + + signal(SIGHUP, SIG_IGN); + + signal(SIGINT, SIG_IGN); + + signal(SIGQUIT, SIG_IGN); + + time(&itime); + + itime -= localtime(&itime)->tm_sec; + + fclose(stdin); + + + + for (;; itime+=60, slp()) { + + struct stat cstat; + + + + if (stat(crontab, &cstat) == -1) + + continue; + + if (cstat.st_mtime > filetime) { + + filetime = cstat.st_mtime; + + init(); + + } + + loct = localtime(&itime); + + loct->tm_mon++; /* 1-12 for month */ + + for(cp = list; *cp != EOS;) { + + flag = 0; + + cp = cmp(cp, loct->tm_min); + + cp = cmp(cp, loct->tm_hour); + + cp = cmp(cp, loct->tm_mday); + + cp = cmp(cp, loct->tm_mon); + + cp = cmp(cp, loct->tm_wday); + + if(flag == 0) { + + slp(); + + ex(cp); + + } + + while(*cp++ != 0) + + ; + + } + + } + +} + + + +char * + +cmp(p, v) + +char *p; + +{ + + register char *cp; + + + + cp = p; + + switch(*cp++) { + + + + case EXACT: + + if (*cp++ != v) + + flag++; + + return(cp); + + + + case ANY: + + return(cp); + + + + case LIST: + + while(*cp != LIST) + + if(*cp++ == v) { + + while(*cp++ != LIST) + + ; + + return(cp); + + } + + flag++; + + return(cp+1); + + + + case RANGE: + + if(*cp > v || cp[1] < v) + + flag++; + + return(cp+2); + + } + + if(cp[-1] != v) + + flag++; + + return(cp); + +} + + + +slp() + +{ + + register i; + + time_t t; + + + + time(&t); + + i = itime - t; + + if(i > 0) + + sleep(i); + +} + + + +ex(s) + +char *s; + +{ + + int st; + + + + if(fork()) { + + wait(&st); + + return; + + } + + if(fork()) + + exit(0); + + freopen("/", "r", stdin); + + execl("/bin/sh", "sh", "-c", s, 0); + + exit(0); + +} + + + +init() + +{ + + register i, c; + + register char *cp; + + register char *ocp; + + register int n; + + + + freopen(crontab, "r", stdin); + + if (list) { + + free(list); + + list = realloc(list, LISTS); + + } else + + list = malloc(LISTS); + + listsize = LISTS; + + cp = list; + + + +loop: + + if(cp > list+listsize-100) { + + char *olist; + + listsize += LISTS; + + olist = list; + + free(list); + + list = realloc(list, listsize); + + cp = list + (cp - olist); + + } + + ocp = cp; + + for(i=0;; i++) { + + do + + c = getchar(); + + while(c == ' ' || c == '\t') + + ; + + if(c == EOF || c == '\n') + + goto ignore; + + if(i == 5) + + break; + + if(c == '*') { + + *cp++ = ANY; + + continue; + + } + + if ((n = number(c)) < 0) + + goto ignore; + + c = getchar(); + + if(c == ',') + + goto mlist; + + if(c == '-') + + goto mrange; + + if(c != '\t' && c != ' ') + + goto ignore; + + *cp++ = EXACT; + + *cp++ = n; + + continue; + + + + mlist: + + *cp++ = LIST; + + *cp++ = n; + + do { + + if ((n = number(getchar())) < 0) + + goto ignore; + + *cp++ = n; + + c = getchar(); + + } while (c==','); + + if(c != '\t' && c != ' ') + + goto ignore; + + *cp++ = LIST; + + continue; + + + + mrange: + + *cp++ = RANGE; + + *cp++ = n; + + if ((n = number(getchar())) < 0) + + goto ignore; + + c = getchar(); + + if(c != '\t' && c != ' ') + + goto ignore; + + *cp++ = n; + + } + + while(c != '\n') { + + if(c == EOF) + + goto ignore; + + if(c == '%') + + c = '\n'; + + *cp++ = c; + + c = getchar(); + + } + + *cp++ = '\n'; + + *cp++ = 0; + + goto loop; + + + +ignore: + + cp = ocp; + + while(c != '\n') { + + if(c == EOF) { + + *cp++ = EOS; + + *cp++ = EOS; + + fclose(stdin); + + return; + + } + + c = getchar(); + + } + + goto loop; + +} + + + +number(c) + +register c; + +{ + + register n = 0; + + + + while (isdigit(c)) { + + n = n*10 + c - '0'; + + c = getchar(); + + } + + ungetc(c, stdin); + + if (n>100) + + return(-1); + + return(n); + +} diff --cc usr/src/cmd/crypt.c index 0000000000,b53e451d0f,0000000000..33f764ad90 mode 000000,100644,000000..100644 --- a/usr/src/cmd/crypt.c +++ b/usr/src/cmd/crypt.c @@@@ -1,0 -1,91 -1,0 +1,92 @@@@ +++static char *sccsid = "@(#)crypt.c 4.1 (Berkeley) 10/1/80"; + +/* + + * A one-rotor machine designed along the lines of Enigma + + * but considerably trivialized. + + */ + + + +#define ECHO 010 + +#include + +#define ROTORSZ 256 + +#define MASK 0377 + +char t1[ROTORSZ]; + +char t2[ROTORSZ]; + +char t3[ROTORSZ]; + +char *getpass(); + + + +setup(pw) + +char *pw; + +{ + + int ic, i, k, temp, pf[2]; + + unsigned random; + + char buf[13]; + + long seed; + + + + strncpy(buf, pw, 8); + + while (*pw) + + *pw++ = '\0'; + + buf[8] = buf[0]; + + buf[9] = buf[1]; + + pipe(pf); + + if (fork()==0) { + + close(0); + + close(1); + + dup(pf[0]); + + dup(pf[1]); + + execl("/usr/lib/makekey", "-", 0); + + execl("/lib/makekey", "-", 0); + + exit(1); + + } + + write(pf[1], buf, 10); + + wait((int *)NULL); + + if (read(pf[0], buf, 13) != 13) { + + fprintf(stderr, "crypt: cannot generate key\n"); + + exit(1); + + } + + seed = 123; + + for (i=0; i<13; i++) + + seed = seed*buf[i] + i; + + for(i=0;i>= 8; + + temp = t1[k]; + + t1[k] = t1[ic]; + + t1[ic] = temp; + + if(t3[k]!=0) continue; + + ic = (random&MASK) % k; + + while(t3[ic]!=0) ic = (ic+1) % k; + + t3[k] = ic; + + t3[ic] = k; + + } + + for(i=0;i=0) { + + i = t2[(t3[(t1[(i+n1)&MASK]+n2)&MASK]-n2)&MASK]-n1; + + putchar(i); + + n1++; + + if(n1==ROTORSZ) { + + n1 = 0; + + n2++; + + if(n2==ROTORSZ) n2 = 0; + + } + + } + +} diff --cc usr/src/cmd/csh/alloc.c index 0000000000,18a5589434,0000000000..ac3ca8acb4 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/alloc.c +++ b/usr/src/cmd/csh/alloc.c @@@@ -1,0 -1,216 -1,0 +1,216 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)alloc.c 4.1 10/9/80"; +++ + +#include "sh.local.h" + +#ifdef debug + +#define ASSERT(p) if(!(p))botch("p");else + +botch(s) + +char *s; + +{ + + printf("assertion botched: %s\n",s); - chdir("/usr/bill/cshcore"); + + abort(); + +} + +#else + +#define ASSERT(p) + +#endif + + + +/* avoid break bug */ + +#ifdef pdp11 + +#define GRANULE 64 + +#else + +#define GRANULE 0 + +#endif + +/* C storage allocator + + * circular first-fit strategy + + * works with noncontiguous, but monotonically linked, arena + + * each block is preceded by a ptr to the (pointer of) + + * the next following block + + * blocks are exact number of words long + + * aligned to the data type requirements of ALIGN + + * pointers to blocks must have BUSY bit 0 + + * bit in ptr is 1 for busy, 0 for idle + + * gaps in arena are merely noted as busy blocks + + * last block of arena (pointed to by alloct) is empty and + + * has a pointer to first + + * idle blocks are coalesced during space search + + * + + * a different implementation may need to redefine + + * ALIGN, NALIGN, BLOCK, BUSY, INT + + * where INT is integer type to which a pointer can be cast + +*/ + +#define INT int + +#define ALIGN int + +#define NALIGN 1 + +#define WORD sizeof(union store) + +#define BLOCK 1024 /* a multiple of WORD*/ + +#define BUSY 1 + +#define NULL 0 + +#define testbusy(p) ((INT)(p)&BUSY) + +#define setbusy(p) (union store *)((INT)(p)|BUSY) + +#define clearbusy(p) (union store *)((INT)(p)&~BUSY) + + + +union store { union store *ptr; + + ALIGN dummy[NALIGN]; + + int calloc; /*calloc clears an array of integers*/ + +}; + + + +static union store allocs[2]; /*initial arena*/ + +static union store *allocp; /*search ptr*/ + +static union store *alloct; /*arena top*/ + +static union store *allocx; /*for benefit of realloc*/ + +char *sbrk(); + + + +char * + +malloc(nbytes) + +unsigned nbytes; + +{ + + register union store *p, *q; + + register nw; + + static temp; /*coroutines assume no auto*/ + + + + if(allocs[0].ptr==0) { /*first time*/ + + allocs[0].ptr = setbusy(&allocs[1]); + + allocs[1].ptr = setbusy(&allocs[0]); + + alloct = &allocs[1]; + + allocp = &allocs[0]; + + } + + nw = (nbytes+WORD+WORD-1)/WORD; + + ASSERT(allocp>=allocs && allocp<=alloct); + + ASSERT(allock()); + + for(p=allocp; ; ) { + + for(temp=0; ; ) { + + if(!testbusy(p->ptr)) { + + while(!testbusy((q=p->ptr)->ptr)) { + + ASSERT(q>p&&qptr = q->ptr; + + } + + if(q>=p+nw && p+nw>=p) + + goto found; + + } + + q = p; + + p = clearbusy(p->ptr); + + if(p>q) + + ASSERT(p<=alloct); + + else if(q!=alloct || p!=allocs) { + + ASSERT(q==alloct&&p==allocs); + + return(NULL); + + } else if(++temp>1) + + break; + + } + + temp = ((nw+BLOCK/WORD)/(BLOCK/WORD))*(BLOCK/WORD); + + q = (union store *)sbrk(0); + + if(q+temp+GRANULE < q) { + + return(NULL); + + } + + q = (union store *)sbrk(temp*WORD); + + if((INT)q == -1) { + + return(NULL); + + } + + ASSERT(q>alloct); + + alloct->ptr = q; + + if(q!=alloct+1) + + alloct->ptr = setbusy(alloct->ptr); + + alloct = q->ptr = q+temp-1; + + alloct->ptr = setbusy(allocs); + + } + +found: + + allocp = p + nw; + + ASSERT(allocp<=alloct); + + if(q>allocp) { + + allocx = allocp->ptr; + + allocp->ptr = p->ptr; + + } + + p->ptr = setbusy(allocp); + + return((char *)(p+1)); + +} + + + +/* freeing strategy tuned for LIFO allocation + +*/ + +free(ap) + +register char *ap; + +{ + + register union store *p = (union store *)ap; + + + + ASSERT(p>clearbusy(allocs[1].ptr)&&p<=alloct); + + ASSERT(allock()); + + allocp = --p; + +/* ASSERT(testbusy(p->ptr)); */ + + p->ptr = clearbusy(p->ptr); + + ASSERT(p->ptr > allocp && p->ptr <= alloct); + +} + + + +/* realloc(p, nbytes) reallocates a block obtained from malloc() + + * and freed since last call of malloc() + + * to have new size nbytes, and old content + + * returns new location, or 0 on failure + +*/ + + + +char * + +realloc(p, nbytes) + +register union store *p; + +unsigned nbytes; + +{ + + register union store *q; + + union store *s, *t; + + register unsigned nw; + + unsigned onw; + + + + if(testbusy(p[-1].ptr)) + + free((char *)p); + + onw = p[-1].ptr - p; + + q = (union store *)malloc(nbytes); + + if(q==NULL || q==p) + + return((char *)q); + + s = p; + + t = q; + + nw = (nbytes+WORD-1)/WORD; + + if(nw=p) + + (q+(q+nw-p))->ptr = allocx; + + return((char *)q); + +} + + + +#ifdef debug + +allock() + +{ + +#ifdef longdebug + + register union store *p; + + int x; + + x = 0; + + for(p= &allocs[0]; clearbusy(p->ptr) > p; p=clearbusy(p->ptr)) { + + if(p==allocp) + + x++; + + } + + ASSERT(p==alloct); + + return(x==1|p==allocp); + +#else + + return(1); + +#endif + +} + +#endif + + + +#ifdef debug + +showall(v) + + char **v; + +{ + + register union store *p, *q; + + int used = 0, free = 0, i; + + + + for (p = clearbusy(allocs[1].ptr); p != alloct; p = q) { + + q = clearbusy(p->ptr); + + if (v[1]) + + printf("%6o %5d %s\n", p, + + ((unsigned) q - (unsigned) p), + + testbusy(p->ptr) ? "BUSY" : "FREE"); + + i = ((unsigned) q - (unsigned) p); + + if (testbusy(p->ptr)) used += i; else free += i; + + } + + printf("%d used, %d free, %l end\n", used, free, clearbusy(alloct)); + +} + +#endif diff --cc usr/src/cmd/csh/doprnt.c index 0000000000,0000000000,0000000000..502d77b80c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/csh/doprnt.c @@@@ -1,0 -1,0 -1,0 +1,473 @@@@ +++/* static char *sccsid = "@(#)doprnt.c 4.1 10/9/80"; */ +++ +++ # C library -- conversions +++ +++.globl __doprnt +++.globl __strout +++ +++#define flags r10 +++#define literb 0 +++#define liter 1 +++#define ndfndb 0 +++#define ndfnd 1 +++#define ljustb 1 +++#define ljust 2 +++#define zfillb 2 +++#define zfill 4 +++#define precb 3 +++#define prec 8 +++#define psignb 4 +++#define psign 16 +++#define gflagb 5 +++#define gflag 32 +++#define width r9 +++#define ndigit r8 +++#define fdesc -4(fp) +++#define exp -8(fp) +++#define sign -9(fp) +++ .set one,010 # 1.0 in floating immediate +++ .set ch.zer,'0 # cpp doesn't like single appostrophes +++ +++ .align 1 +++__doprnt: +++ .word 0xfc0 # uses r11-r6 +++ subl2 $128,sp +++ movl 4(ap),r11 # addr of format string +++ movl 12(ap),fdesc # output FILE ptr +++ movl 8(ap),ap # addr of first arg +++loop: +++ movl r11,r0 # current point in format +++ bicl2 $liter,flags # no literal characters yet +++L1: movb (r11)+,width # next character of format +++ beql L2 # end of format string +++ cmpb width,$'% +++ beql L2 # warning character +++ bisl2 $liter,flags # literal character +++ jbr L1 +++L2: blbc flags,L3 # bbc $literb,flags,L3 # no literals in format +++ pushl fdesc # file pointer +++ pushl $0 # no left/right adjust +++ pushl r0 # addr +++ subl3 r0,r11,r1 # length +++ subl3 $1,r1,-(sp) # % or null not part of literal +++ calls $4,__strout # dump the literal +++L3: +++ blbs width,L4 # % is odd; end of format? +++ ret # yes +++ +++ # htab overlaps last 16 characters of ftab +++ftab: .byte 0, 0, 0,'c,'d,'e,'f,'g, 0, 0, 0,'+,'l,'-,'.,'o +++htab: .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a,'b,'c,'d,'e,'f +++ +++L4: movl sp,r5 # reset output buffer pointer +++ clrq r9 # width; flags ljustb,ndfndb,zfillb +++L4a: movzbl (r11)+,r0 # supposed format +++ extzv $0,$5,r0,r1 # bottom 5 bits +++L4b: cmpb r0,ftab[r1] # good enough? +++ jneq L6 # no +++L4c: casel r1,$3,$22 # yes +++L5: .word charac-L5 # c +++ .word decimal-L5 # d +++ .word scien-L5 # e +++ .word float-L5 # f +++ .word general-L5 # g +++ .word L6-L5 # h +++ .word L6-L5 # i +++ .word L6-L5 # j +++ .word plus-L5 # + +++ .word longorunsg-L5 # l +++ .word minus-L5 # - +++ .word dot-L5 # . +++ .word octal-L5 # o +++ .word gnum0-L5 # 0 +++ .word gnum-L5 # 1 +++ .word gnum-L5 # 2 +++ .word gnum-L5 # 3 +++ .word gnum-L5 # 4 +++ .word gnum-L5 # 5 +++ .word gnum-L5 # 6 +++ .word gnum-L5 # 7 +++ .word gnum-L5 # 8 +++ .word gnum-L5 # 9 +++ +++L6: jbcs $5,r0,L4b # capitals same as small +++ cmpb r0,$'s +++ jeql string +++ cmpb r0,$'x +++ jeql hex +++ cmpb r0,$'u +++ jeql unsigned +++ cmpb r0,$'r +++ jeql remote +++ movzbl -1(r11),r0 # orginal "format" character +++ cmpb r0,$'* +++ jeql indir +++L9: movb r0,(r5)+ # print the unfound character +++ jbr prbuf +++ +++nulstr: +++ .byte '(,'n,'u,'l,'l,'),0 +++ +++string: +++ movl ndigit,r0 +++ jbs $precb,flags,L20 # max length was specified +++ mnegl $1,r0 # default max length +++L20: movl (ap)+,r2 # addr first byte +++ bneq L21 +++ movab nulstr,r2 +++L21: locc $0,r0,(r2) # find the zero at the end +++ movl r1,r5 # addr last byte +1 +++ movl r2,r1 # addr first byte +++ jbr prstr +++ +++ +++longorunsg: +++ movb (r11)+,r0 +++ cmpb r0,$'o +++ jeql loct +++ cmpb r0,$'x +++ jeql lhex +++ cmpb r0,$'d +++ jeql long +++ cmpb r0,$'u +++ jeql lunsigned +++ decl r11 +++ jbr unsigned +++ +++loct: +++octal: +++ movl $30,r2 # init position +++ movl $3,r3 # field width +++ movl $10,r4 # result length -1 +++ jbr L10 +++ +++lhex: +++hex: +++ movl $28,r2 # init position +++ movl $4,r3 # field width +++ movl $7,r4 # result length -1 +++L10: mnegl r3,r6 # increment +++ clrl r1 +++ movl (ap)+,r0 # fetch arg +++L11: extzv r2,r3,r0,r1 # pull out a digit +++ movb htab[r1],(r5)+ # convert to character +++L12: acbl $0,r6,r2,L11 # continue until done +++ clrb (r5) # flag end +++ skpc $'0,r4,(sp) # skip over leading zeroes +++ jbr prstr +++ +++patdec: # editpc pattern for decimal printing +++ .byte 0xA9 # eo$float 9 +++ .byte 0x01 # eo$end_float +++ .byte 0x91 # eo$move 1 +++ .byte 0 # eo$end +++ +++long: +++decimal: +++ cvtlp (ap)+,$10,(sp) # 10 digits max +++L14: editpc $10,(sp),patdec,8(sp) # ascii at 8(sp); r5=end+1 +++ skpc $' ,$10,8(sp) # skip leading blanks; r1=first +++ +++prstr: # r1=addr first byte; r5=addr last byte +1 +++ cvtbl $' ,-(sp) # blank fill +++ jbc $zfillb,flags,L15 +++ cvtbl $'0,(sp) # zero fill +++L15: pushl fdesc # FILE +++ subl2 r1,r5 # r5=actual length=end+1-first +++ subl3 r5,width,r0 # if >0, how much to fill +++ bgeq L24 +++ clrl r0 # no fill +++L24: jbs $ljustb,flags,L25 +++ mnegl r0,r0 +++L25: pushl r0 # fill count +++ pushl r1 # addr first byte +++ pushl r5 # length +++ calls $5,__strout +++ jbr loop +++ +++pone: .byte 0x1C # packed 1 +++ +++unsigned: +++lunsigned: +++ extzv $1,$31,(ap),r0 # right shift logical 1 bit +++ cvtlp r0,$10,(sp) # convert [n/2] to packed +++ movp $10,(sp),8(sp) # copy packed +++ addp4 $10,8(sp),$10,(sp) # 2*[n/2] in packed, at (sp) +++ blbc (ap)+,L14 # n was even +++ addp4 $1,pone,$10,(sp) # n was odd +++ jbr L14 +++ +++charac: +++ movl $4,r0 # chars per word +++L18: movb (ap)+,(r5)+ # transfer char +++ bneq L19 +++ decl r5 # omit null characters +++L19: sobgtr r0,L18 +++ +++prbuf: +++ movl sp,r1 # addr first byte +++ jbr prstr +++ +++plus: bisl2 $psign,flags # always print sign for floats +++ jbr L4a +++minus: bisl2 $ljust,flags # left justification, please +++ jbr L4a +++gnum0: jbs $ndfndb,flags,gnum +++ jbs $precb,flags,gnump # ignore when reading precision +++ bisl2 $zfill,flags # leading zero fill, please +++gnum: jbs $precb,flags,gnump +++ moval (width)[width],width # width *= 5; +++ movaw -ch.zer(r0)[width],width # width = 2*witdh + r0 - '0'; +++ jbr gnumd +++gnump: moval (ndigit)[ndigit],ndigit # ndigit *= 5; +++ movaw -ch.zer(r0)[ndigit],ndigit # ndigit = 2*ndigit + r0 - '0'; +++gnumd: bisl2 $ndfnd,flags # digit seen +++ jbr L4a +++dot: clrl ndigit # start on the precision +++ bisl2 $prec,flags +++ bicl2 $ndfnd,flags +++ jbr L4a +++indir: movl (ap)+,ndigit # width specified by parameter +++ jbr gnumd +++remote: movl (ap)+,ap +++ movl (ap)+,r11 +++ jbr loop +++ +++float: +++ bsbw fltcvt +++fltg: jbs $ndfndb,flags,float1 +++ movl $6,ndigit # default # digits to right of decpt. +++float1: addl3 exp,ndigit,r7 +++ movl r7,r6 # for later "underflow" checking +++ bgeq fxplrd +++ clrl r7 # poor programmer planning +++fxplrd: cmpl r7,$31 # expressible in packed decimal? +++ bleq fnarro # yes +++ movl $31,r7 +++fnarro: subl3 $17,r7,r0 # where to round +++ ashp r0,$17,(sp),$5,r7,16(sp) # do it +++ bvc fnovfl +++ # band-aid for microcode error (spurious overflow) +++ clrl r0 # assume even length result +++ jlbc r7,fleven # right +++ movl $4,r0 # odd length result +++fleven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow +++ bneq fnovfl +++ # end band-aid +++ aobleq $0,r6,fnovfl # if "underflow" then jump +++ movl r7,r0 +++ incl exp +++ incl r7 +++ ashp r0,$1,pone,$0,r7,16(sp) +++ ashl $-1,r7,r0 # displ to last byte +++ bisb2 sign,16(sp)[r0] # insert sign +++fnovfl: +++ movc3 $4,patsci,(sp) +++ clrl r6 # # digits moved so far +++ movl exp,r0 +++ bleq fexpng +++ bsbb patmov # digits to left of decpt. +++fexpng: tstl ndigit +++ jeql fnodp +++ movc3 $2,fpatdp,(r3) +++ tstl exp +++ bgeq fxppos +++ addl3 exp,ndigit,r6 +++ bgeq flfakl +++ clrl r6 # it's all fill +++flfakl: subl3 r6,$31,r6 # fake length for patmov +++flfill: movc3 $2,fpatzf,(r3) # zero fill to right of dec.pt +++fxppos: movl ndigit,r0 +++ bsbb patmov +++fnodp: sobgeq r6,fledit # must move at least 1 digit +++ movl $31,r6 # none moved; fake it +++ aobleq $1,ndigit,flfill # with a one-character zero fill +++fledit: editpc r7,16(sp),(sp),32(sp) +++ jbr prflt +++ +++patexp: .byte 0x03 # eo$set_signif +++ .byte 0x44,'e # eo$insert 'e +++ .byte 0x42,'+ # eo$load_plus '+ +++ .byte 0x04 # eo$store_sign +++ .byte 0x92 # eo$move 2 +++ .byte 0 # eo$end +++patsci: .byte 0x42,'+ # eo$load_plus '+ +++ .byte 0x03 # eo$set_signif +++ .byte 0x04 # eo$store_sign +++ .byte 0x91 # eo$move 1 +++fpatdp: .byte 0x44,'. # eo$insert '. +++fpatzf: .byte 0x40,'0 # eo$load_fill '0 +++ +++ # construct pattern at (r3) to move r0 digits in editpc; +++ # r6 digits already moved for this number +++patmov: +++ movb $0x90,r2 # eo$move +++ subl3 r6,$31,r1 # # digits remaining in packed +++ addl2 r0,r6 +++ cmpl r0,r1 # enough digits remaining? +++ bleq patsml # yes +++ tstl exp # zero 'fill'; before or after rest? +++ bgeq pataft # after +++ pushl r1 # # digits remaining +++ movb $0x80,r2 # eo$fill +++ subl3 $31,r6,r0 # number of fill bytes +++ bsbb patsml # recursion! +++ movl (sp)+,r0 +++ movb $0x90,r2 # eo$move +++ jbr patsml +++pataft: movl r1,r0 # last of the 31 +++ bsbb patsml # recursion! +++ subl3 $31,r6,r0 # number of fill bytes +++ movb $0x80,r2 # eo$fill +++patsml: tstl r0 +++ bleq patzer # DEC doesn't like repetition counts of 0 +++ mnegl $15,r1 # 15 digits at a time +++ subl2 r1,r0 # counteract acbl +++ jbr pattst +++patmlp: bisb3 r2,$15,(r3)+ # 15 +++pattst: acbl $16,r1,r0,patmlp # until <= 15 left +++ bisb3 r2,r0,(r3)+ # rest +++patzer: clrb (r3) # eo$end +++ rsb +++ +++scien: +++ bsbw fltcvt # get packed digits +++scig: incl ndigit +++ jbs $ndfndb,flags,L23 +++ movl $7,ndigit +++L23: subl3 $17,ndigit,r0 # rounding position +++ ashp r0,$17,(sp),$5,ndigit,16(sp) # shift and round +++ bvc snovfl +++ # band-aid for microcode error (spurious overflow) +++ clrl r0 # assume even length result +++ jlbc ndigit,sceven # right +++ movl $4,r0 # odd length result +++sceven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow +++ bneq snovfl +++ # end band-aid +++ incl exp # rounding overflowed to 100... +++ subl3 $1,ndigit,r0 +++ ashp r0,$1,pone,$0,ndigit,16(sp) +++ ashl $-1,ndigit,r0 # displ to last byte +++ bisb2 sign,16(sp)[r0] # insert sign +++snovfl: +++ jbc $gflagb,flags,enotg # not %g format +++ # find trailing zeroes in packed number +++ ashl $-1,ndigit,r0 +++ addl2 r3,r0 # addr of l.s.digit and sign +++ movl $4,r1 # bit position of digit +++ movl ndigit,r7 # current length of packed +++ jbr gtz +++gtz1: xorl2 $4,r1 # position of next digit +++ bneq gtz # same byte +++ decl r0 # different byte +++gtz: cmpv r1,$4,(r0),$0 # a trailing zero? +++ jneq gntz +++ sobgtr r7,gtz1 +++ incl r7 +++gntz: # r7: minimum width of fraction +++ cmpl exp,$-4 +++ jleq eg # small exponents use %e +++ subl3 r7,exp,r0 +++ cmpl $5,r0 +++ jleq eg # so do (w+5) <= exp +++ tstl r0 # rest use %f +++ jleq fg # did we trim too many trailing zeroes? +++ movl exp,r7 # yes +++fg: subl3 ndigit,r7,r0 +++ ashp r0,ndigit,16(sp),$0,r7,(sp) +++ movp r7,(sp),16(sp) +++ subl3 exp,r7,ndigit # correct ndigit for %f +++ jbr fnovfl +++eg: subl3 ndigit,r7,r0 +++ ashp r0,ndigit,16(sp),$0,r7,(sp) +++ movp r7,(sp),16(sp) +++ movl r7,ndigit # packed number has been trimmed +++enotg: +++ movc3 $7,patsci,(sp) +++ movl $1,r6 # 1P +++ subl3 $1,ndigit,r0 # digits after dec.pt +++ bsbw patmov +++ editpc ndigit,16(sp),(sp),32(sp) # 32(sp)->result, r5->(end+1) +++ decl exp # compensate: 1 digit left of dec.pt +++ cvtlp exp,$2,(sp) # exponent +++ editpc $2,(sp),patexp,(r5) +++prflt: movab 32(sp),r1 +++ jbs $psignb,flags,prflt1 +++ cmpb (r1)+,$'+ +++ beql prflt1 +++ decl r1 +++prflt1: skpc $' ,$63,(r1) +++ jbr prstr +++ +++general: +++ jbcs $gflagb,flags,scien +++ jbr scien # safety net +++ +++ # convert double-floating at (ap) to 17-digit packed at (sp), +++ # set 'sign' and 'exp', advance ap. +++fltcvt: +++ clrb sign +++ movd (ap)+,r5 +++ jeql fzero +++ bgtr fpos +++ mnegd r5,r5 +++ incb sign +++fpos: +++ extzv $7,$8,r5,r2 # exponent of 2 +++ movaw -0600(r2)[r2],r2 # unbias and mult by 3 +++ bgeq epos +++ subl2 $9,r2 +++epos: divl2 $10,r2 +++ bsbb expten +++ cmpd r0,r5 +++ bgtr ceil +++ incl r2 +++ceil: movl r2,exp +++ mnegl r2,r2 +++ cmpl r2,$29 # 10^(29+9) is all we can handle +++ bleq getman +++ muld2 ten16,r5 +++ subl2 $16,r2 +++getman: addl2 $9,r2 # -ceil(log10(x)) + 9 +++ bsbb expten +++ emodd r0,r4,r5,r0,r5 # (r0+r4)*r5; r0=int, r5=frac +++fz1: cvtlp r0,$9,16(sp) # leading 9 digits +++ ashp $8,$9,16(sp),$0,$17,4(sp) # as top 9 of 17 +++ emodd ten8,$0,r5,r0,r5 +++ cvtlp r0,$8,16(sp) # trailing 8 digits +++ addp4 $8,16(sp),$17,4(sp) # combine leading and trailing +++ bisb2 sign,12(sp) # and insert sign +++ rsb +++fzero: clrl r0 +++ movl $1,exp # 0.000e+00 and 0.000 rather than 0.000e-01 and .000 +++ jbr fz1 +++ +++ # return 10^r2 as a double float in r0||r1 and 8 extra bits of precision in r4 +++ # preserve r2, r5||r6 +++expten: +++ movd $one,r0 # begin computing 10^exp10 +++ clrl r4 # bit counter +++ movad ten1,r3 # table address +++ tstl r2 +++ bgeq e10lp +++ mnegl r2,r2 # get absolute value +++ jbss $6,r2,e10lp # flag as negative +++e10lp: jbc r4,r2,el1 # want this power? +++ muld2 (r3),r0 # yes +++el1: addl2 $8,r3 # advance to next power +++ aobleq $5,r4,e10lp # through 10^32 +++ jbcc $6,r2,el2 # correct for negative exponent +++ divd3 r0,$one,r0 # by taking reciprocal +++ mnegl r2,r2 +++el2: clrl r4 # 8 extra bits of precision +++ rsb +++ +++ # powers of ten +++ .align 2 +++ten1: .word 0x4220,0,0,0 +++ten2: .word 0x43c8,0,0,0 +++ten4: .word 0x471c,0x4000,0,0 +++ten8: .word 0x4dbe,0xbc20,0,0 +++ten16: .word 0x5b0e,0x1bc9,0xbf04,0 +++ten32: .word 0x759d,0xc5ad,0xa82b,0x70b6 diff --cc usr/src/cmd/csh/errlst.c index 0000000000,2b5f3ba202,0000000000..680826467e mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/errlst.c +++ b/usr/src/cmd/csh/errlst.c @@@@ -1,0 -1,38 -1,0 +1,39 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)errlst.c 4.1 10/9/80"; +++ + +char *sys_errlist[] { + + "Error 0", + + "Not super-user", + + "No such file or directory", + + "No such process", + + "Interrupted system call", + + "I/O error", + + "No such device or address", + + "Arguments too long", + + "Exec format error", + + "Bad file number", + + "No children", + + "No more processes", + + "Not enough core", + + "Permission denied", + + "Error 14", + + "Block device required", + + "Mount device busy", + + "File exists", + + "Cross-device link", + + "No such device", + + "Not a directory", + + "Is a directory", + + "Invalid argument", + + "File table overflow", + + "Too many open files", + + "Not a typewriter", + + "Text file busy", + + "File too large", + + "No space left on device", + + "Illegal seek", + + "Read-only file system", + + "Too many links", + + "Broken Pipe", + + "Disk quota exceeded", + +}; + +int sys_nerr { sizeof sys_errlist/sizeof sys_errlist[0] }; diff --cc usr/src/cmd/csh/getpwent.c index 0000000000,28cc556df3,0000000000..66adb1b453 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/getpwent.c +++ b/usr/src/cmd/csh/getpwent.c @@@@ -1,0 -1,99 -1,0 +1,90 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)getpwent.c 4.1 10/9/80"; +++ + +#include + + + +#define BUFSIZ 160 + + + +static int pwf = -1; + +static char line[BUFSIZ+1]; + +static struct passwd passwd; + + + +setpwent() + +{ + + if( pwf == -1 ) + + pwf = open( "/etc/passwd", 0 ); + + else + + lseek(pwf, 0l, 0); + +} + + + +endpwent() + +{ + + if( pwf != -1 ){ + + close( pwf ); + + pwf = -1; + + } + +} + + + +static char * + +pwskip(p) + +register char *p; + +{ + + while( *p && *p != ':' ) + + ++p; + + if( *p ) *p++ = 0; + + return(p); + +} + + + +struct passwd * + +getpwent() + +{ + + register char *p, *q; + + register int i, j; + + + + if (pwf == -1) { + + if( (pwf = open( "/etc/passwd", 0 )) == -1 ) + + return(0); + + } + + i = read(pwf, line, BUFSIZ); + + for (j = 0; j < i; j++) + + if (line[j] == '\n') + + break; + + if (j >= i) + + return(0); + + line[++j] = 0; + + lseek(pwf, (long) (j - i), 1); + + p = line; + + passwd.pw_name = p; + + p = pwskip(p); + +/* passwd.pw_passwd = p; */ + + p = q = pwskip(p); + +/* passwd.pw_uid = atoi(p); */ + + p = pwskip(p); + + p[-1] = 0; + + passwd.pw_uid = atou(q); + +/* passwd.pw_gid = atoi(p); */ + +/* passwd.pw_quota = 0; */ + +/* passwd.pw_comment = ""; */ + + q = p; + + p = pwskip(p); + + p[-1] = 0; - #ifdef CORY - passwd.pw_uid =+ atou(q) << 8; - #endif - #ifdef CC - passwd.pw_uid =+ atou(q) << 8; - #endif - #ifndef CORY - #ifndef CC + + passwd.pw_gid = atou(q); - #endif - #endif + +/* passwd.pw_gecos = p; */ + + p = pwskip(p); + + passwd.pw_dir = p; + + p = pwskip(p); + +/* passwd.pw_shell = p; */ + +/* while(*p && *p != '\n') p++; */ + + *p = '\0'; + + return(&passwd); + +} + + + +atou(p) + + register char *p; + +{ + + register int i = 0; + + + + if (p != 0) + + while (*p) + + i = i * 10 + *p++ - '0'; + + return (i); + +} diff --cc usr/src/cmd/csh/getpwnam.c index 0000000000,dcd83d328b,0000000000..b68755275a mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/getpwnam.c +++ b/usr/src/cmd/csh/getpwnam.c @@@@ -1,0 -1,15 -1,0 +1,16 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)getpwnam.c 4.1 10/9/80"; +++ + +#include + + + +struct passwd * + +getpwnam(name) + +char *name; + +{ + + register struct passwd *p; + + struct passwd *getpwent(); + + + + setpwent(); + + while( (p = getpwent()) && strcmp(name,p->pw_name) ); + + endpwent(); + + return(p); + +} diff --cc usr/src/cmd/csh/getpwuid.c index 0000000000,95afd64e88,0000000000..5ce14e3a57 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/getpwuid.c +++ b/usr/src/cmd/csh/getpwuid.c @@@@ -1,0 -1,15 -1,0 +1,16 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)getpwuid.c 4.1 10/9/80"; +++ + +#include + + + +struct passwd * + +getpwuid(uid) + +register uid; + +{ + + register struct passwd *p; + + struct passwd *getpwent(); + + + + setpwent(); + + while( (p = getpwent()) && p->pw_uid != uid ); + + endpwent(); + + return(p); + +} diff --cc usr/src/cmd/csh/malloc.c index 0000000000,099cc84c4f,0000000000..9832a28b9b mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/malloc.c +++ b/usr/src/cmd/csh/malloc.c @@@@ -1,0 -1,190 -1,0 +1,191 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)malloc.c 4.1 10/9/80"; +++ + +#ifdef debug + +#define ASSERT(p) if(!(p))botch("p");else + +botch(s) + +char *s; + +{ + + printf("assertion botched: %s\n",s); + + abort(); + +} + +#else + +#define ASSERT(p) + +#endif + + + +/* avoid break bug */ + +#ifdef pdp11 + +#define GRANULE 64 + +#else + +#define GRANULE 0 + +#endif + +/* C storage allocator + + * circular first-fit strategy + + * works with noncontiguous, but monotonically linked, arena + + * each block is preceded by a ptr to the (pointer of) + + * the next following block + + * blocks are exact number of words long + + * aligned to the data type requirements of ALIGN + + * pointers to blocks must have BUSY bit 0 + + * bit in ptr is 1 for busy, 0 for idle + + * gaps in arena are merely noted as busy blocks + + * last block of arena (pointed to by alloct) is empty and + + * has a pointer to first + + * idle blocks are coalesced during space search + + * + + * a different implementation may need to redefine + + * ALIGN, NALIGN, BLOCK, BUSY, INT + + * where INT is integer type to which a pointer can be cast + +*/ + +#define INT int + +#define ALIGN int + +#define NALIGN 1 + +#define WORD sizeof(union store) + +#define BLOCK 1024 /* a multiple of WORD*/ + +#define BUSY 1 + +#define NULL 0 + +#define testbusy(p) ((INT)(p)&BUSY) + +#define setbusy(p) (union store *)((INT)(p)|BUSY) + +#define clearbusy(p) (union store *)((INT)(p)&~BUSY) + + + +union store { union store *ptr; + + ALIGN dummy[NALIGN]; + + int calloc; /*calloc clears an array of integers*/ + +}; + + + +static union store allocs[2]; /*initial arena*/ + +static union store *allocp; /*search ptr*/ + +static union store *alloct; /*arena top*/ + +static union store *allocx; /*for benefit of realloc*/ + +char *sbrk(); + + + +char * + +malloc(nbytes) + +unsigned nbytes; + +{ + + register union store *p, *q; + + register nw; + + static temp; /*coroutines assume no auto*/ + + + + if(allocs[0].ptr==0) { /*first time*/ + + allocs[0].ptr = setbusy(&allocs[1]); + + allocs[1].ptr = setbusy(&allocs[0]); + + alloct = &allocs[1]; + + allocp = &allocs[0]; + + } + + nw = (nbytes+WORD+WORD-1)/WORD; + + ASSERT(allocp>=allocs && allocp<=alloct); + + ASSERT(allock()); + + for(p=allocp; ; ) { + + for(temp=0; ; ) { + + if(!testbusy(p->ptr)) { + + while(!testbusy((q=p->ptr)->ptr)) { + + ASSERT(q>p&&qptr = q->ptr; + + } + + if(q>=p+nw && p+nw>=p) + + goto found; + + } + + q = p; + + p = clearbusy(p->ptr); + + if(p>q) + + ASSERT(p<=alloct); + + else if(q!=alloct || p!=allocs) { + + ASSERT(q==alloct&&p==allocs); + + return(NULL); + + } else if(++temp>1) + + break; + + } + + temp = ((nw+BLOCK/WORD)/(BLOCK/WORD))*(BLOCK/WORD); + + q = (union store *)sbrk(0); + + if(q+temp+GRANULE < q) { + + return(NULL); + + } + + q = (union store *)sbrk(temp*WORD); + + if((INT)q == -1) { + + return(NULL); + + } + + ASSERT(q>alloct); + + alloct->ptr = q; + + if(q!=alloct+1) + + alloct->ptr = setbusy(alloct->ptr); + + alloct = q->ptr = q+temp-1; + + alloct->ptr = setbusy(allocs); + + } + +found: + + allocp = p + nw; + + ASSERT(allocp<=alloct); + + if(q>allocp) { + + allocx = allocp->ptr; + + allocp->ptr = p->ptr; + + } + + p->ptr = setbusy(allocp); + + return((char *)(p+1)); + +} + + + +/* freeing strategy tuned for LIFO allocation + +*/ + +free(ap) + +register char *ap; + +{ + + register union store *p = (union store *)ap; + + + + ASSERT(p>clearbusy(allocs[1].ptr)&&p<=alloct); + + ASSERT(allock()); + + allocp = --p; + + ASSERT(testbusy(p->ptr)); + + p->ptr = clearbusy(p->ptr); + + ASSERT(p->ptr > allocp && p->ptr <= alloct); + +} + + + +/* realloc(p, nbytes) reallocates a block obtained from malloc() + + * and freed since last call of malloc() + + * to have new size nbytes, and old content + + * returns new location, or 0 on failure + +*/ + + + +char * + +realloc(p, nbytes) + +register union store *p; + +unsigned nbytes; + +{ + + register union store *q; + + union store *s, *t; + + register unsigned nw; + + unsigned onw; + + + + if(testbusy(p[-1].ptr)) + + free((char *)p); + + onw = p[-1].ptr - p; + + q = (union store *)malloc(nbytes); + + if(q==NULL || q==p) + + return((char *)q); + + s = p; + + t = q; + + nw = (nbytes+WORD-1)/WORD; + + if(nw=p) + + (q+(q+nw-p))->ptr = allocx; + + return((char *)q); + +} + + + +#ifdef debug + +allock() + +{ + +#ifdef longdebug + + register union store *p; + + int x; + + x = 0; + + for(p= &allocs[0]; clearbusy(p->ptr) > p; p=clearbusy(p->ptr)) { + + if(p==allocp) + + x++; + + } + + ASSERT(p==alloct); + + return(x==1|p==allocp); + +#else + + return(1); + +#endif + +} + +#endif diff --cc usr/src/cmd/csh/printf.c index 0000000000,dc11d0c8ba,0000000000..5ff9fe7e6e mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/printf.c +++ b/usr/src/cmd/csh/printf.c @@@@ -1,0 -1,35 -1,0 +1,36 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)printf.c 4.1 10/9/80"; +++ + +/* + + * Hacked "printf" which prints through putchar. + + * DONT USE WITH STDIO! + + */ + +printf(fmt, args) + +char *fmt; + +{ + + _doprnt(fmt, &args, 0); + +} + + + +_strout(count, string, adjust, foo, fillch) + +register char *string; + +register int count; + +int adjust; + +register struct { int a[6]; } *foo; + +{ + + + + if (foo != 0) + + abort(); + + while (adjust < 0) { + + if (*string=='-' && fillch=='0') { + + putchar(*string++); + + count--; + + } + + putchar(fillch); + + adjust++; + + } + + while (--count>=0) + + putchar(*string++); + + while (adjust) { + + putchar(fillch); + + adjust--; + + } + +} diff --cc usr/src/cmd/csh/sh.c index 0000000000,17168f88ee,0000000000..dea30dddcf mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.c +++ b/usr/src/cmd/csh/sh.c @@@@ -1,0 -1,754 -1,0 +1,856 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ - #include "sh.h" +++static char *sccsid = "@(#)sh.c 4.1 10/9/80"; + + +++#include "sh.h" +++#include + +/* + + * C Shell + + * - * Bill Joy, UC Berkeley - * October, 1978 +++ * Bill Joy, UC Berkeley, California, USA +++ * October 1978, May 1980 +++ * +++ * Jim Kulp, IIASA, Laxenburg, Austria +++ * April 1980 + + */ + + - char *pathlist[] = { SRCHPATH, 0 }; +++char *pathlist[] = { ".", "/usr/ucb", "/bin", "/usr/bin", 0 }; +++char HIST = '!'; +++char HISTSUB = '^'; +++bool nofile; +++bool reenter; +++bool nverbose; +++bool nexececho; +++bool quitit; +++bool fast; +++bool prompt = 1; + + + +main(c, av) + + int c; + + char **av; + +{ + + register char **v, *cp; - int nofile = 0; - int reenter = 0; - bool nverbose = 0, nexececho = 0, quitit = 0, fast = 0, prompt = 1; - char *hp; +++ register int f; + + + + settimes(); /* Immed. estab. timing base */ - hp = getenv("HOME"); + + v = av; + + if (eq(v[0], "a.out")) /* A.out's are quittable */ + + quitit = 1; + + uid = getuid(); - #ifdef V6 - loginsh = eq(*v, "-"); /* To do .login/.logout */ - #else + + loginsh = **v == '-'; - #endif + + if (loginsh) + + time(&chktim); + + + + /* + + * Move the descriptors to safe places. + + * The variable didfds is 0 while we have only FSH* to work with. + + * When didfds is true, we have 0,1,2 and prefer to use these. + + */ + + initdesc(); + + + + /* + + * Initialize the shell variables. + + * ARGV and PROMPT are initialized later. + + * STATUS is also munged in several places. + + * CHILD is munged when forking/waiting + + */ + + + + set("status", "0"); - if (hp == 0) +++ dinit(cp = getenv("HOME")); /* dinit thinks that HOME == cwd in a +++ * login shell */ +++ if (cp == NOSTR) + + fast++; /* No home -> can't read scripts */ + + else - set("home", hp); - if (uid == 0) - pathlist[0] = "/etc"; - set1("path", saveblk(pathlist), &shvhed); +++ set("home", savestr(cp)); +++ /* +++ * Grab other useful things from the environment. +++ * Should we grab everything?? +++ */ +++ if ((cp = getenv("USER")) != NOSTR) +++ set("user", savestr(cp)); +++ if ((cp = getenv("TERM")) != NOSTR) +++ set("term", savestr(cp)); + + /* + + * Re-initialize path if set in environment - * - cp = getenv("PATH"); - if (cp != 0) { - register int i = 0; +++ */ +++ if ((cp = getenv("PATH")) == NOSTR) +++ set1("path", saveblk(pathlist), &shvhed); +++ else { +++ register unsigned i = 0; + + register char *dp; + + register char **pv; + + + + for (dp = cp; *dp; dp++) + + if (*dp == ':') + + i++; - pv = calloc(i+1, sizeof (char **)); - dp = cp; - i = 0; - while (*dp) { +++ pv = (char **)calloc(i+2, sizeof (char **)); +++ for (dp = cp, i = 0; ;) + + if (*dp == ':') { + + *dp = 0; - pv[i++] = savestr(cp); - *dp = ':'; - } else if (*dp == 0) { - pv[i++] = savestr(cp); +++ pv[i++] = savestr(*cp ? cp : "."); +++ *dp++ = ':'; +++ cp = dp; +++ } else if (*dp++ == 0) { +++ pv[i++] = savestr(*cp ? cp : "."); + + break; + + } - dp++; - } + + pv[i] = 0; + + set1("path", pv, &shvhed); + + } - */ + + set("shell", SHELLPATH); + + + + doldol = putn(getpid()); /* For $$ */ + + shtemp = strspl("/tmp/sh", doldol); /* For << */ + + + + /* + + * Record the interrupt states from the parent process. + + * If the parent is non-interruptible our hand must be forced + + * or we (and our children) won't be either. + + * Our children inherit termination from our parent. + + * We catch it only if we are the login shell. + + */ + + parintr = signal(SIGINT, SIG_IGN); /* parents interruptibility */ - signal(SIGINT, parintr); /* ... restore */ +++ sigset(SIGINT, parintr); /* ... restore */ + + parterm = signal(SIGTERM, SIG_IGN); /* parents terminability */ + + signal(SIGTERM, parterm); /* ... restore */ + + + + /* + + * Process the arguments. + + * + + * Note that processing of -v/-x is actually delayed till after + + * script processing. + + * + + * We set the first character of our name to be '-' if we are + + * a shell running interruptible commands. Many programs which + + * examine ps'es use this to filter such shells out. + + */ + + c--, v++; + + while (c > 0 && (cp = v[0])[0] == '-') { + + do switch (*cp++) { + + + + case 0: /* - Interruptible, no prompt */ + + prompt = 0; - **av = '-'; +++ setintr++; + + nofile++; + + break; + + + + case 'c': /* -c Command input from arg */ + + if (c == 1) + + exit(0); + + c--, v++; + + arginp = v[0]; + + prompt = 0; + + nofile++; + + break; + + + + case 'e': /* -e Exit on any error */ + + exiterr++; + + break; + + + + case 'f': /* -f Fast start */ + + fast++; + + break; + + + + case 'i': /* -i Interactive, even if !intty */ + + intact++; - **av = '-'; + + nofile++; + + break; + + + + case 'n': /* -n Don't execute */ + + noexec++; + + break; + + + + case 'q': /* -q (Undoc'd) ... die on quit */ + + quitit = 1; + + break; + + + + case 's': /* -s Read from std input */ + + nofile++; - if (isatty(SHIN)) - **v = '-'; + + break; + + + + case 't': /* -t Read one line from input */ + + onelflg = 2; - if (isatty(SHIN)) - **v = '-'; + + prompt = 0; + + nofile++; + + break; + + + + case 'v': /* -v Echo hist expanded input */ + + nverbose = 1; /* ... later */ + + break; + + + + case 'x': /* -x Echo just before execution */ + + nexececho = 1; /* ... later */ + + break; + + + + case 'V': /* -V Echo hist expanded input */ + + setNS("verbose"); /* NOW! */ + + break; + + + + case 'X': /* -X Echo just before execution */ + + setNS("echo"); /* NOW! */ + + break; + + + + } while (*cp); + + v++, c--; + + } + + + + if (quitit) /* With all due haste, for debugging */ + + signal(SIGQUIT, SIG_DFL); + + + + /* + + * Unless prevented by -, -c, -i, -s, or -t, if there + + * are remaining arguments the first of them is the name + + * of a shell file from which to read commands. + + */ + + if (nofile == 0 && c > 0) { + + nofile = open(v[0], 0); + + if (nofile < 0) { + + child++; /* So this ... */ + + Perror(v[0]); /* ... doesn't return */ + + } + + file = v[0]; + + SHIN = dmove(nofile, FSHIN); /* Replace FSHIN */ + + prompt = 0; + + c--, v++; + + } - + + /* + + * Consider input a tty if it really is or we are interactive. + + */ + + intty = intact || isatty(SHIN); +++ /* +++ * Decide whether we should play with signals or not. +++ * If we are explicitly told (via -i, or -) or we are a login +++ * shell (arg0 starts with -) or the input and output are both +++ * the ttys("csh", or "csh/dev/ttyx") +++ * Note that in only the login shell is it likely that parent +++ * may have set signals to be ignored +++ */ +++ if (loginsh || intact || intty && isatty(SHOUT)) +++ setintr = 1; + +#ifdef TELL + + settell(); + +#endif + + /* - * Commands are interruptible if we are interactive - * or the process which created us was. - */ - if (intact || parintr == SIG_DFL) - **av = '-'; - - /* - * Save the remaining arguments in ARGV. - * Normally the system-supplied argument list is ok as - * a zero terminated value block. - * On some version 6 systems, it is -1 terminated and setting it - * to zero messes up "ps" so we change it to zero, copy - * the block of pointers, and put it back the way it was. +++ * Save the remaining arguments in argv. + + */ - /* - if (c == 0) - set("argv", 0); - else - */ - if ((int) v[c] == -1) { - /* ick */ - v[c] = 0, setq("argv", copyblk(v), &shvhed), v[c] = (char *) -1; - } else - setq("argv", v, &shvhed); +++ setq("argv", v, &shvhed); + + + + /* + + * Set up the prompt. + + */ + + if (prompt) + + set("prompt", uid == 0 ? "# " : "% "); + + + + /* + + * If we are an interactive shell, then start fiddling + + * with the signals; this is a tricky game. + + */ - if (**av == '-') { - setintr++; +++ shpgrp = getpgrp(0); +++ opgrp = tpgrp = -1; +++ oldisc = -1; +++ if (setintr) { +++ **av = '-'; + + if (!quitit) /* Wary! */ + + signal(SIGQUIT, SIG_IGN); - signal(SIGINT, SIG_IGN); +++ sigset(SIGINT, pintr); +++ sighold(SIGINT); + + signal(SIGTERM, SIG_IGN); +++ if (quitit == 0 && arginp == 0) { +++ signal(SIGTSTP, SIG_IGN); +++ signal(SIGTTIN, SIG_IGN); +++ signal(SIGTTOU, SIG_IGN); +++ /* +++ * Wait till in foreground, in case someone +++ * stupidly runs +++ * csh & +++ * dont want to try to grab away the tty. +++ */ +++ if (isatty(FSHDIAG)) +++ f = FSHDIAG; +++ else if (isatty(FSHOUT)) +++ f = FSHOUT; +++ else if (isatty(OLDSTD)) +++ f = OLDSTD; +++ else +++ f = -1; +++retry: +++ if (ioctl(f, TIOCGPGRP, &tpgrp) == 0 && tpgrp != -1) { +++ int ldisc; +++ if (tpgrp != shpgrp) { +++ int old = sigsys(SIGTTIN, SIG_DFL); +++ kill(0, SIGTTIN); +++ sigsys(SIGTTIN, old); +++ goto retry; +++ } +++ if (ioctl(f, TIOCGETD, &oldisc) != 0) +++ goto notty; +++ if (oldisc != NTTYDISC) { +++ printf("Switching to new tty driver...\n"); +++ ldisc = NTTYDISC; +++ ioctl(f, TIOCSETD, &ldisc); +++ } else +++ oldisc = -1; +++ opgrp = shpgrp; +++ shpgrp = getpid(); +++ tpgrp = shpgrp; +++ ioctl(f, TIOCSPGRP, &shpgrp); +++ setpgrp(0, shpgrp); +++ dcopy(f, FSHTTY); +++ ioctl(FSHTTY, FIOCLEX, 0); +++ } else { +++notty: +++ printf("Warning: no access to tty; thus no job control in this shell...\n"); +++ tpgrp = -1; +++ } +++ } + + } +++ sigset(SIGCHLD, pchild); /* while signals not ready */ + + + + /* + + * Set an exit here in case of an interrupt or error reading + + * the shell start-up scripts. + + */ + + setexit(); + + haderr = 0; /* In case second time through */ + + if (!fast && reenter == 0) { + + reenter++; + + /* Will have value("home") here because set fast if don't */ + + srccat(value("home"), "/.cshrc"); + + if (!fast && !arginp && !onelflg) + + dohash(); - if (loginsh) - #ifdef NOHELP - srccat("", ".login"); - #else +++ if (loginsh) { +++ int ldisc; + + srccat(value("home"), "/.login"); - #endif +++ } + + } + + + + /* + + * Now are ready for the -v and -x flags + + */ + + if (nverbose) + + setNS("verbose"); + + if (nexececho) + + setNS("echo"); + + + + /* + + * All the rest of the world is inside this call. + + * The argument to process indicates whether it should + + * catch "error unwinds". Thus if we are a interactive shell + + * our call here will never return by being blown past on an error. + + */ + + process(setintr); + + + + /* + + * Mop-up. + + */ + + if (loginsh) { + + printf("logout\n"); + + close(SHIN); + + child++; + + goodbye(); + + } + + exitstat(); + +} + + +++untty() +++{ +++ +++ if (tpgrp > 0) { +++ setpgrp(0, opgrp); +++ ioctl(FSHTTY, TIOCSPGRP, &opgrp); +++ if (oldisc != -1 && oldisc != NTTYDISC) { +++ printf("\nReverting to old tty driver...\n"); +++ ioctl(FSHTTY, TIOCSETD, &oldisc); +++ } +++ } +++} +++ +++importpath(cp) +++char *cp; +++{ +++ register int i = 0; +++ register char *dp; +++ register char **pv; +++ int c; +++ static char dot[2] = {'.', 0}; +++ +++ for (dp = cp; *dp; dp++) +++ if (*dp == ':') +++ i++; +++ /* +++ * i+2 where i is the number of colons in the path. +++ * There are i+1 directories in the path plus we need +++ * room for a zero terminator. +++ */ +++ pv = (char **) calloc(i+2, sizeof (char **)); +++ dp = cp; +++ i = 0; +++ if (*dp) +++ for (;;) { +++ if ((c = *dp) == ':' || c == 0) { +++ *dp = 0; +++ pv[i++] = savestr(*cp ? cp : dot); +++ if (c) { +++ cp = dp + 1; +++ *dp = ':'; +++ } else +++ break; +++ } +++ dp++; +++ } +++ pv[i] = 0; +++ set1("path", pv, &shvhed); +++} +++ + +/* + + * Source to the file which is the catenation of the argument names. + + */ + +srccat(cp, dp) + + char *cp, *dp; + +{ + + register char *ep = strspl(cp, dp); + + register int unit = dmove(open(ep, 0), -1); + + + + /* ioctl(unit, FIOCLEX, NULL); */ + + xfree(ep); +++#ifdef INGRES + + srcunit(unit, 0); +++#else +++ srcunit(unit, 1); +++#endif + +} + + + +/* - * Source to a unit. If onlyown it must be our file or +++ * Source to a unit. If onlyown it must be our file or our group or + + * we don't chance it. This occurs on ".cshrc"s and the like. + + */ + +srcunit(unit, onlyown) + + register int unit; + + bool onlyown; + +{ + + /* We have to push down a lot of state here */ + + /* All this could go into a structure */ + + int oSHIN = -1, oldintty = intty; + + struct whyle *oldwhyl = whyles; + + char *ogointr = gointr, *oarginp = arginp; +++ char *oevalp = evalp, **oevalvec = evalvec; + + int oonelflg = onelflg; + +#ifdef TELL + + bool otell = cantell; + +#endif + + struct Bin saveB; + + + + /* The (few) real local variables */ + + jmp_buf oldexit; + + int reenter; - register int (*oldint)(); + + + + if (unit < 0) + + return; +++ if (didfds) +++ donefds(); + + if (onlyown) { + + struct stat stb; + + - #ifdef CC - if (fstat(unit, &stb) < 0 || (stb.st_uid != uid && stb.st_uid != (uid &~ 0377))) { - #endif - #ifdef CORY - if (fstat(unit, &stb) < 0 || (stb.st_uid != uid && stb.st_uid != (uid &~ 0377))) { - #endif - #ifndef CC - #ifndef CORY - if (fstat(unit, &stb) < 0 || stb.st_uid != uid) { - #endif - #endif +++ if (fstat(unit, &stb) < 0 || (stb.st_uid != uid && stb.st_gid != getgid())) { + + close(unit); + + return; + + } + + } + + + + /* + + * There is a critical section here while we are pushing down the + + * input stream since we have stuff in different structures. + + * If we weren't careful an interrupt could corrupt SHIN's Bin + + * structure and kill the shell. + + * + + * We could avoid the critical region by grouping all the stuff + + * in a single structure and pointing at it to move it all at + + * once. This is less efficient globally on many variable references + + * however. + + */ + + getexit(oldexit); + + reenter = 0; - oldint = signal(SIGINT, SIG_IGN); +++ if (setintr) +++ sighold(SIGINT); + + setexit(); + + reenter++; + + if (reenter == 1) { + + /* Setup the new values of the state stuff saved above */ - copy(&saveB, &B, sizeof saveB); +++ copy((char *)&saveB, (char *)&B, sizeof saveB); + + fbuf = (char **) 0; + + fseekp = feobp = fblocks = 0; + + oSHIN = SHIN, SHIN = unit, arginp = 0, onelflg = 0; + + intty = isatty(SHIN), whyles = 0, gointr = 0; +++ evalvec = 0; evalp = 0; + + /* + + * Now if we are allowing commands to be interrupted, + + * we let ourselves be interrupted. + + */ - signal(SIGINT, setintr ? pintr : oldint); +++ if (setintr) +++ sigrelse(SIGINT); + +#ifdef TELL + + settell(); + +#endif + + process(0); /* 0 -> blow away on errors */ + + } - signal(SIGINT, oldint); +++ if (setintr) +++ sigrelse(SIGINT); + + if (oSHIN >= 0) { + + register int i; + + + + /* We made it to the new state... free up its storage */ + + /* This code could get run twice but xfree doesn't care */ + + for (i = 0; i < fblocks; i++) + + xfree(fbuf[i]); - xfree(fbuf); +++ xfree((char *)fbuf); + + + + /* Reset input arena */ - copy(&B, &saveB, sizeof B); +++ copy((char *)&B, (char *)&saveB, sizeof B); + + + + close(SHIN), SHIN = oSHIN; + + arginp = oarginp, onelflg = oonelflg; +++ evalp = oevalp, evalvec = oevalvec; + + intty = oldintty, whyles = oldwhyl, gointr = ogointr; + +#ifdef TELL + + cantell = otell; + +#endif + + } + + + + resexit(oldexit); + + /* + + * If process reset() (effectively an unwind) then + + * we must also unwind. + + */ + + if (reenter >= 2) - error(0); +++ error(NOSTR); + +} + + + +goodbye() + +{ + + + + if (loginsh) { + + signal(SIGQUIT, SIG_IGN); - signal(SIGINT, SIG_IGN); +++ sigset(SIGINT, SIG_IGN); + + signal(SIGTERM, SIG_IGN); + + setintr = 0; /* No interrupts after "logout" */ + + if (adrof("home")) + + srccat(value("home"), "/.logout"); + + } + + exitstat(); + +} + + + +exitstat() + +{ + + + + /* + + * Note that if STATUS is corrupted (i.e. getn bombs) + + * then error will exit directly because we poke child here. + + * Otherwise we might continue unwarrantedly (sic). + + */ + + child++; + + exit(getn(value("status"))); + +} + + +++char *jobargv[2] = { "jobs", 0 }; + +/* + + * Catch an interrupt, e.g. during lexical input. + + * If we are an interactive shell, we reset the interrupt catch + + * immediately. In any case we drain the shell output, + + * and finally go through the normal error mechanism, which + + * gets a chance to make the shell go away. + + */ + +pintr() + +{ + + register char **v; + + +++ if (setintr) { +++ sigrelse(SIGINT); +++ if (pjobs) { +++ pjobs = 0; +++ printf("\n"); +++ dojobs(jobargv); +++ bferr("Interrupted"); +++ } +++ } + + if (setintr) - signal(SIGINT, SIG_IGN); +++ sighold(SIGINT); +++ sigrelse(SIGCHLD); + + draino(); + + + + /* + + * If we have an active "onintr" then we search for the label. + + * Note that if one does "onintr -" then we shan't be interruptible + + * so we needn't worry about that here. + + */ + + if (gointr) { + + search(ZGOTO, 0, gointr); + + timflg = 0; + + if (v = pargv) + + pargv = 0, blkfree(v); + + if (v = gargv) + + gargv = 0, blkfree(v); + + reset(); + + } else if (intty) + + printf("\n"); /* Some like this, others don't */ - error(0); +++ error(NOSTR); + +} + + + +/* + + * Process is the main driving routine for the shell. + + * It runs all command processing, except for those within { ... } + + * in expressions (which is run by a routine evalav in sh.exp.c which + + * is a stripped down process), and `...` evaluation which is run + + * also by a subset of this code in sh.glob.c in the routine backeval. + + * + + * The code here is a little strange because part of it is interruptible + + * and hence freeing of structures appears to occur when none is necessary + + * if this is ignored. + + * + + * Note that if catch is not set then we will unwind on any error. - * In an end-of-file occurs, we return. +++ * If an end-of-file occurs, we return. + + */ + +process(catch) + + bool catch; + +{ + + register char *cp; + + jmp_buf osetexit; - struct wordent paraml; + + struct command *t; + + + + getexit(osetexit); + + for (;;) { +++ pendjob(); + + paraml.next = paraml.prev = ¶ml; + + paraml.word = ""; + + t = 0; + + setexit(); + + justpr = 0; /* A chance to execute */ + + + + /* + + * Interruptible during interactive reads + + */ + + if (setintr) - signal(SIGINT, pintr); +++ sigrelse(SIGINT); + + + + /* + + * For the sake of reset() + + */ + + freelex(¶ml), freesyn(t), t = 0; + + + + if (haderr) { + + if (!catch) { + + /* unwind */ + + doneinp = 0; + + resexit(osetexit); + + reset(); + + } + + haderr = 0; + + /* + + * Every error is eventually caught here or + + * the shell dies. It is at this + + * point that we clean up any left-over open + + * files, by closing all but a fixed number + + * of pre-defined files. Thus routines don't + + * have to worry about leaving files open due + + * to deeper errors... they will get closed here. + + */ + + closem(); + + continue; + + } + + if (doneinp) { + + doneinp = 0; + + break; + + } - if (intty) { +++ if (chkstop) +++ chkstop--; +++ if (neednote) +++ pnote(); +++ if (intty && evalvec == 0) { + + mailchk(); + + /* + + * If we are at the end of the input buffer + + * then we are going to read fresh stuff. + + * Otherwise, we are rereading input and don't + + * need or want to prompt. + + */ + + if (fseekp == feobp) + + if (!whyles) + + for (cp = value("prompt"); *cp; cp++) - if (*cp == '!') +++ if (*cp == HIST) + + printf("%d", eventno + 1); + + else { - if (*cp == '\\' && cp[1] == '!') +++ if (*cp == '\\' && cp[1] == HIST) + + cp++; + + putchar(*cp | QUOTE); + + } + + else + + /* + + * Prompt for forward reading loop + + * body content. + + */ + + printf("? "); + + flush(); + + } + + err = 0; + + + + /* + + * Echo not only on VERBOSE, but also with history expansion. + + * If there is a lexical error then we forego history echo. + + */ + + if (lex(¶ml) && !err && intty || adrof("verbose")) { + + haderr = 1; + + prlex(¶ml); + + haderr = 0; + + } + + + + /* + + * The parser may lose space if interrupted. + + */ + + if (setintr) - signal(SIGINT, SIG_IGN); +++ sighold(SIGINT); + + + + /* + + * Save input text on the history list if it + + * is from the terminal at the top level and not + + * in a loop. + + */ + + if (catch && intty && !whyles) + + savehist(¶ml); + + + + /* + + * Print lexical error messages. + + */ + + if (err) + + error(err); + + + + /* + + * If had a history command :p modifier then + + * this is as far as we should go + + */ + + if (justpr) + + reset(); + + + + alias(¶ml); + + + + /* + + * Parse the words of the input into a parse tree. + + */ - t = syntax(paraml.next, ¶ml); +++ t = syntax(paraml.next, ¶ml, 0); + + if (err) + + error(err); + + + + /* + + * Execute the parse tree + + */ - execute(t); +++ execute(t, tpgrp); + + + + /* + + * Made it! + + */ + + freelex(¶ml), freesyn(t); + + } + + resexit(osetexit); + +} + + + +dosource(t) + + register char **t; + +{ + + register char *f; + + register int u; + + + + t++; + + f = globone(*t); + + u = dmove(open(f, 0), -1); + + xfree(f); + + if (u < 0) + + Perror(f); - didfds = 0; + + srcunit(u, 0); + +} + + + +/* + + * Check for mail. + + * If we are a login shell, then we don't want to tell + + * about any mail file unless its been modified + + * after the time we started. + + * This prevents us from telling the user things he already - * knows, since the login program insist on saying +++ * knows, since the login program insists on saying + + * "You have mail." + + */ + +mailchk() + +{ + + register struct varent *v; + + register char **vp; + + time_t t; + + int intvl, cnt; +++ struct stat stb; +++ bool new; + + + + v = adrof("mail"); + + if (v == 0) + + return; + + time(&t); + + vp = v->vec; + + cnt = blklen(vp); + + intvl = (cnt && number(*vp)) ? (--cnt, getn(*vp++)) : MAILINTVL; + + if (intvl < 1) + + intvl = 1; + + if (chktim + intvl > t) + + return; + + for (; *vp; vp++) { - bool new; - struct stat stb; - + + if (stat(*vp, &stb) < 0) + + continue; - /* - * We assume that a file has been read if the access time is - * greater than the mod time. - */ - #ifndef CORY - if (stb.st_size == 0) - continue; - #endif - if (stb.st_atime > stb.st_mtime || stb.st_atime < chktim) - continue; + + new = stb.st_mtime > time0; - if (loginsh && !new) +++ if (stb.st_size == 0 || stb.st_atime > stb.st_mtime || +++ (stb.st_atime < chktim && stb.st_mtime < chktim) || +++ loginsh && !new) + + continue; + + if (cnt == 1) + + printf("You have %smail.\n", new ? "new " : ""); + + else + + printf("%s in %s.\n", new ? "New mail" : "Mail", *vp); + + } + + chktim = t; + +} + + + +#include + +/* + + * Extract a home directory from the password file + + * The argument points to a buffer where the name of the + + * user whose home directory is sought is currently. + + * We write the home directory of the user back there. + + */ + +gethdir(home) + + char *home; + +{ + + register struct passwd *pp = getpwnam(home); + + + + if (pp == 0) + + return (1); + + strcpy(home, pp->pw_dir); + + return (0); + +} + + + +/* + + * Move the initial descriptors to their eventual + + * resting places, closin all other units. + + */ + +initdesc() + +{ + + + + didcch = 0; /* Havent closed for child */ + + didfds = 0; /* 0, 1, 2 aren't set up */ + + SHIN = dcopy(0, FSHIN); + + SHOUT = dcopy(1, FSHOUT); + + SHDIAG = dcopy(2, FSHDIAG); + + OLDSTD = dcopy(SHIN, FOLDSTD); + + closem(); + +} + + - #ifndef V6 + +exit(i) + + int i; + +{ + + +++ untty(); +++#ifdef PROF +++ IEH3exit(i); +++#else + + _exit(i); - } + +#endif +++} diff --cc usr/src/cmd/csh/sh.dir.c index 0000000000,0000000000,0000000000..838947047b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/csh/sh.dir.c @@@@ -1,0 -1,0 -1,0 +1,354 @@@@ +++static char *sccsid = "@(#)sh.dir.c 4.1 10/9/80"; +++ +++#include "sh.h" +++#include "sh.dir.h" +++ +++/* +++ * C Shell - directory management +++ */ +++ +++struct directory *dfind(); +++char *dfollow(); +++struct directory dhead; /* "head" of loop */ +++int printd; /* force name to be printed */ +++static char *fakev[] = { "dirs", NOSTR }; +++ +++/* +++ * dinit - initialize current working directory +++ */ +++dinit(hp) +++ char *hp; +++{ +++ register char *cp; +++ register struct directory *dp; +++ char path[BUFSIZ]; +++ +++ if (loginsh && hp) +++ cp = hp; +++ else +++ cp = getwd(path); +++ dp = (struct directory *)calloc(sizeof (struct directory), 1); +++ dp->di_name = savestr(cp); +++ dp->di_count = 0; +++ dhead.di_next = dhead.di_prev = dp; +++ dp->di_next = dp->di_prev = &dhead; +++ printd = 0; +++ dnewcwd(dp); +++} +++ +++/* +++ * dodirs - list all directories in directory loop +++ */ +++dodirs(v) +++ char **v; +++{ +++ register struct directory *dp; +++ bool lflag; +++ char *hp = value("home"); +++ +++ if (*hp == '\0') +++ hp = NOSTR; +++ if (*++v != NOSTR) +++ if (eq(*v, "-l") && *++v == NOSTR) +++ lflag = 1; +++ else +++ error("Usage: dirs [ -l ]"); +++ else +++ lflag = 0; +++ dp = dcwd; +++ do { +++ if (dp == &dhead) +++ continue; +++ if (!lflag && hp != NOSTR) { +++ dtildepr(hp, dp->di_name); +++ } else +++ printf("%s", dp->di_name); +++ printf(" "); +++ } while ((dp = dp->di_prev) != dcwd); +++ printf("\n"); +++} +++ +++dtildepr(home, dir) +++ register char *home, *dir; +++{ +++ +++ if (!eq(home, "/") && prefix(home, dir)) +++ printf("~%s", dir + strlen(home)); +++ else +++ printf("%s", dir); +++} +++ +++/* +++ * dochngd - implement chdir command. +++ */ +++dochngd(v) +++ char **v; +++{ +++ register char *cp; +++ register struct directory *dp; +++ +++ printd = 0; +++ if (*++v == NOSTR) { +++ if ((cp = value("home")) == NOSTR || *cp == 0) +++ bferr("No home directory"); +++ if (chdir(cp) < 0) +++ bferr("Can't change to home directory"); +++ cp = savestr(cp); +++ } else if ((dp = dfind(*v)) != 0) { +++ printd = 1; +++ if (chdir(dp->di_name) < 0) +++ Perror(dp->di_name); +++ dcwd->di_prev->di_next = dcwd->di_next; +++ dcwd->di_next->di_prev = dcwd->di_prev; +++ goto flushcwd; +++ } else +++ cp = dfollow(*v); +++ dp = (struct directory *)calloc(sizeof (struct directory), 1); +++ dp->di_name = cp; +++ dp->di_count = 0; +++ dp->di_next = dcwd->di_next; +++ dp->di_prev = dcwd->di_prev; +++ dp->di_prev->di_next = dp; +++ dp->di_next->di_prev = dp; +++flushcwd: +++ dfree(dcwd); +++ dnewcwd(dp); +++} +++ +++/* +++ * dfollow - change to arg directory; fall back on cdpath if not valid +++ */ +++char * +++dfollow(cp) +++ register char *cp; +++{ +++ register char **cdp; +++ struct varent *c; +++ +++ cp = globone(cp); +++ if (chdir(cp) == 0) +++ goto gotcha; +++ if (cp[0] != '/' && !prefix("./", cp) && !prefix("../", cp) +++ && (c = adrof("cdpath"))) { +++ for (cdp = c->vec; *cdp; cdp++) { +++ char buf[BUFSIZ]; +++ +++ strcpy(buf, *cdp); +++ strcat(buf, "/"); +++ strcat(buf, cp); +++ if (chdir(buf) >= 0) { +++ printd = 1; +++ xfree(cp); +++ cp = savestr(buf); +++ goto gotcha; +++ } +++ } +++ } +++ if (adrof(cp)) { +++ char *dp = value(cp); +++ +++ if (dp[0] == '/' || dp[0] == '.') +++ if (chdir(dp) >= 0) { +++ xfree(cp); +++ cp = savestr(dp); +++ printd = 1; +++ goto gotcha; +++ } +++ } +++ xfree(cp); +++ Perror(cp); +++ +++gotcha: +++ if (*cp != '/') { +++ char *dp = calloc(strlen(cp) + strlen(dcwd->di_name) + 2, 1); +++ strcpy(dp, dcwd->di_name); +++ strcat(dp, "/"); +++ strcat(dp, cp); +++ xfree(cp); +++ cp = dp; +++ } +++ dcanon(cp); +++ return (cp); +++} +++ +++/* +++ * dopushd - push new directory onto directory stack. +++ * with no arguments exchange top and second. +++ * with numeric argument (+n) bring it to top. +++ */ +++dopushd(v) +++ char **v; +++{ +++ register struct directory *dp; +++ +++ printd = 1; +++ if (*++v == NOSTR) { +++ if ((dp = dcwd->di_prev) == &dhead) +++ dp = dhead.di_prev; +++ if (dp == dcwd) +++ bferr("No other directory"); +++ if (chdir(dp->di_name) < 0) +++ Perror(dp->di_name); +++ dp->di_prev->di_next = dp->di_next; +++ dp->di_next->di_prev = dp->di_prev; +++ dp->di_next = dcwd->di_next; +++ dp->di_prev = dcwd; +++ dcwd->di_next->di_prev = dp; +++ dcwd->di_next = dp; +++ } else if (dp = dfind(*v)) { +++ if (chdir(dp->di_name) < 0) +++ Perror(dp->di_name); +++ } else { +++ register char *cp; +++ +++ cp = dfollow(*v); +++ dp = (struct directory *)calloc(sizeof (struct directory), 1); +++ dp->di_name = cp; +++ dp->di_count = 0; +++ dp->di_prev = dcwd; +++ dp->di_next = dcwd->di_next; +++ dcwd->di_next = dp; +++ dp->di_next->di_prev = dp; +++ } +++ dnewcwd(dp); +++} +++ +++/* +++ * dfind - find a directory if specified by numeric (+n) argument +++ */ +++struct directory * +++dfind(cp) +++ register char *cp; +++{ +++ register struct directory *dp; +++ register int i; +++ register char *ep; +++ +++ if (*cp++ != '+') +++ return (0); +++ for (ep = cp; digit(*ep); ep++) +++ continue; +++ if (*ep) +++ return (0); +++ i = getn(cp); +++ if (i <= 0) +++ return (0); +++ for (dp = dcwd; i != 0; i--) { +++ if ((dp = dp->di_prev) == &dhead) +++ dp = dp->di_prev; +++ if (dp == dcwd) +++ bferr("Directory stack not that deep"); +++ } +++ return (dp); +++} +++ +++/* +++ * dopopd - pop a directory out of the directory stack +++ * with a numeric argument just discard it. +++ */ +++dopopd(v) +++ char **v; +++{ +++ register struct directory *dp, *p; +++ +++ printd = 1; +++ if (*++v == NOSTR) +++ dp = dcwd; +++ else if ((dp = dfind(*v)) == 0) +++ bferr("Bad directory"); +++ if (dp->di_prev == &dhead && dp->di_next == &dhead) +++ bferr("Directory stack empty"); +++ if (dp == dcwd) { +++ if ((p = dp->di_prev) == &dhead) +++ p = dhead.di_prev; +++ if (chdir(p->di_name) < 0) +++ Perror(p->di_name); +++ } +++ dp->di_prev->di_next = dp->di_next; +++ dp->di_next->di_prev = dp->di_prev; +++ if (dp == dcwd) +++ dnewcwd(p); +++ else +++ dodirs(fakev); +++ dfree(dp); +++} +++ +++/* +++ * dfree - free the directory (or keep it if it still has ref count) +++ */ +++dfree(dp) +++ register struct directory *dp; +++{ +++ +++ if (dp->di_count != 0) +++ dp->di_next = dp->di_prev = 0; +++ else +++ xfree(dp->di_name), xfree((char *)dp); +++} +++ +++/* +++ * dcanon - canonicalize the pathname, removing excess ./ and ../ etc. +++ * we are of course assuming that the file system is standardly +++ * constructed (always have ..'s, directories have links) +++ */ +++dcanon(cp) +++ char *cp; +++{ +++ register char *p, *sp; +++ register bool slash; +++ +++ if (*cp != '/') +++ abort(); +++ for (p = cp; *p; ) { /* for each component */ +++ sp = p; /* save slash address */ +++ while(*++p == '/') /* flush extra slashes */ +++ ; +++ if (p != ++sp) +++ strcpy(sp, p); +++ p = sp; /* save start of component */ +++ slash = 0; +++ while(*++p) /* find next slash or end of path */ +++ if (*p == '/') { +++ slash = 1; +++ *p = 0; +++ break; +++ } +++ if (*sp == '\0') /* if component is null */ +++ if (--sp == cp) /* if path is one char (i.e. /) */ +++ break; +++ else +++ *sp = '\0'; +++ else if (eq(".", sp)) { +++ if (slash) { +++ strcpy(sp, ++p); +++ p = --sp; +++ } else if (--sp != cp) +++ *sp = '\0'; +++ } else if (eq("..", sp)) { +++ if (--sp != cp) +++ while (*--sp != '/') +++ ; +++ if (slash) { +++ strcpy(++sp, ++p); +++ p = --sp; +++ } else if (cp == sp) +++ *++sp = '\0'; +++ else +++ *sp = '\0'; +++ } else if (slash) +++ *p = '/'; +++ } +++} +++ +++/* +++ * dnewcwd - make a new directory in the loop the current one +++ */ +++dnewcwd(dp) +++ register struct directory *dp; +++{ +++ +++ dcwd = dp; +++ set("cwd", savestr(dcwd->di_name)); +++ if (printd) +++ dodirs(fakev); +++} diff --cc usr/src/cmd/csh/sh.dol.c index 0000000000,f38af501be,0000000000..52e1ab9e9f mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.dol.c +++ b/usr/src/cmd/csh/sh.dol.c @@@@ -1,0 -1,668 -1,0 +1,700 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.dol.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C shell + + */ + + + +/* + + * These routines perform variable substitution and quoting via ' and ". + + * To this point these constructs have been preserved in the divided + + * input words. Here we expand variables and turn quoting via ' and " into + + * QUOTE bits on characters (which prevent further interpretation). + + * If the `:q' modifier was applied during history expansion, then + + * some QUOTEing may have occurred already, so we dont "scan(,&trim)" here. + + */ + + + +int Dpeekc, Dpeekrd; /* Peeks for DgetC and Dreadc */ + +char *Dcp, **Dvp; /* Input vector for Dreadc */ + + + +#define DEOF -1 + + + +#define unDgetC(c) Dpeekc = c + + + +char *QUOTES = "\\'`\""; + + + +/* + + * The following variables give the information about the current + + * $ expansion, recording the current word position, the remaining + + * words within this expansion, the count of remaining words, and the + + * information about any : modifier which is being applied. + + */ + +char *dolp; /* Remaining chars from this word */ + +char **dolnxt; /* Further words */ + +int dolcnt; /* Count of further words */ + +char dolmod; /* : modifier character */ + +int dolmcnt; /* :gx -> 10000, else 1 */ + + + +int Dtest(); /* Test for \ " ` or ' */ + + + +/* + + * Fix up the $ expansions and quotations in the + + * argument list to command t. + + */ + +Dfix(t) + + register struct command *t; + +{ + + + + if (noexec) + + return; + + gflag = 0, rscan(t->t_dcom, Dtest); + + if (gflag == 0) + + return; + + Dfix2(t->t_dcom); + + blkfree(t->t_dcom), t->t_dcom = gargv, gargv = 0; + +} + + + +/* + + * $ substitute one word, for i/o redirection + + */ + +char * + +Dfix1(cp) + + register char *cp; + +{ + + char *Dv[2]; + + + + if (noexec) + + return (0); + + Dv[0] = cp; Dv[1] = NOSTR; + + Dfix2(Dv); + + if (gargc != 1) { + + setname(cp); + + bferr("Ambiguous"); + + } + + cp = savestr(gargv[0]); + + blkfree(gargv), gargv = 0; + + return (cp); + +} + + + +/* + + * Subroutine to do actual fixing after state initialization. + + */ + +Dfix2(v) + + char **v; + +{ + + char *agargv[GAVSIZ]; + + + + ginit(agargv); /* Initialize glob's area pointers */ + + Dvp = v; Dcp = ""; /* Setup input vector for Dreadc */ + + unDgetC(0); unDredc(0); /* Clear out any old peeks (at error) */ + + dolp = 0; dolcnt = 0; /* Clear out residual $ expands (...) */ + + while (Dword()) + + continue; + + gargv = copyblk(gargv); + +} + + + +/* + + * Get a word. This routine is analogous to the routine + + * word() in sh.lex.c for the main lexical input. One difference + + * here is that we don't get a newline to terminate our expansion. + + * Rather, DgetC will return a DEOF when we hit the end-of-input. + + */ + +Dword() + +{ + + register int c, c1; + + char wbuf[BUFSIZ]; + + register char *wp = wbuf; + + register int i = BUFSIZ - 4; + + register bool dolflg; + + bool sofar = 0; + + + +loop: + + c = DgetC(DODOL); + + switch (c) { + + + + case DEOF: + +deof: + + if (sofar == 0) + + return (0); + + /* finish this word and catch the code above the next time */ + + unDredc(c); + + /* fall into ... */ + + + + case '\n': + + *wp = 0; + + goto ret; + + + + case ' ': + + case '\t': + + goto loop; + + + + case '`': + + /* We preserve ` quotations which are done yet later */ + + *wp++ = c, --i; + + case '\'': + + case '"': + + /* + + * Note that DgetC never returns a QUOTES character + + * from an expansion, so only true input quotes will + + * get us here or out. + + */ + + c1 = c; + + dolflg = c1 == '"' ? DODOL : 0; + + for (;;) { + + c = DgetC(dolflg); + + if (c == c1) + + break; + + if (c == '\n' || c == DEOF) + + error("Unmatched %c", c1); + + if ((c & (QUOTE|TRIM)) == ('\n' | QUOTE)) + + --wp, ++i; + + if (--i <= 0) + + goto toochars; + + switch (c1) { + + + + case '"': + + /* + + * Leave any `s alone for later. + + * Other chars are all quoted, thus `...` + + * can tell it was within "...". + + */ + + *wp++ = c == '`' ? '`' : c | QUOTE; + + break; + + + + case '\'': + + /* Prevent all further interpretation */ + + *wp++ = c | QUOTE; + + break; + + + + case '`': + + /* Leave all text alone for later */ + + *wp++ = c; + + break; + + } + + } + + if (c1 == '`') + + *wp++ = '`', --i; + + goto pack; /* continue the word */ + + + + case '\\': + + c = DgetC(0); /* No $ subst! */ + + if (c == '\n' || c == DEOF) + + goto loop; + + c |= QUOTE; + + break; + + } + + unDgetC(c); + +pack: + + sofar = 1; + + /* pack up more characters in this word */ + + for (;;) { + + c = DgetC(DODOL); + + if (c == '\\') { + + c = DgetC(0); + + if (c == DEOF) + + goto deof; + + if (c == '\n') + + c = ' '; + + else + + c |= QUOTE; + + } + + if (c == DEOF) + + goto deof; + + if (any(c, " '`\"\t\n")) { + + unDgetC(c); + + if (any(c, QUOTES)) + + goto loop; + + *wp++ = 0; + + goto ret; + + } + + if (--i <= 0) + +toochars: + + error("Word too long"); + + *wp++ = c; + + } + +ret: + + Gcat("", wbuf); + + return (1); + +} + + + +/* + + * Get a character, performing $ substitution unless flag is 0. + + * Any QUOTES character which is returned from a $ expansion is + + * QUOTEd so that it will not be recognized above. + + */ + +DgetC(flag) + + register int flag; + +{ + + register int c; + + + +top: + + if (c = Dpeekc) { + + Dpeekc = 0; + + return (c); + + } + + if (lap) { - c = *lap++; +++ c = *lap++ & (QUOTE|TRIM); + + if (c == 0) { + + lap = 0; + + goto top; + + } + +quotspec: + + if (any(c, QUOTES)) + + return (c | QUOTE); + + return (c); + + } + + if (dolp) { - if (c = *dolp++) +++ if (c = *dolp++ & (QUOTE|TRIM)) + + goto quotspec; + + if (dolcnt > 0) { + + setDolp(*dolnxt++); + + --dolcnt; + + return (' '); + + } + + dolp = 0; + + } + + if (dolcnt > 0) { + + setDolp(*dolnxt++); + + --dolcnt; + + goto top; + + } + + c = Dredc(); + + if (c == '$' && flag) { + + Dgetdol(); + + goto top; + + } + + return (c); + +} + + + +char *nulvec[] = { 0 }; + +struct varent nulargv = { nulvec, "argv", 0 }; + + + +/* + + * Handle the multitudinous $ expansion forms. + + * Ugh. + + */ + +Dgetdol() + +{ + + register char *np; + + register struct varent *vp; + + char name[20]; + + int c, sc; + + int subscr = 0, lwb = 1, upb = 0; + + bool dimen = 0, isset = 0; +++ char wbuf[BUFSIZ]; + + + + dolmod = dolmcnt = 0; + + c = sc = DgetC(0); + + if (c == '{') + + c = DgetC(0); /* sc is { to take } later */ + + if ((c & TRIM) == '#') + + dimen++, c = DgetC(0); /* $# takes dimension */ + + else if (c == '?') + + isset++, c = DgetC(0); /* $? tests existence */ + + switch (c) { + + + + case '$': + + if (dimen || isset) + + goto syntax; /* No $?$, $#$ */ + + setDolp(doldol); + + goto eatbrac; + + +++ case '<'|QUOTE: +++ if (dimen || isset) +++ goto syntax; /* No $?<, $#< */ +++ for (np = wbuf; read(OLDSTD, np, 1) == 1; np++) { +++ if (np >= &wbuf[BUFSIZ-1]) +++ error("$< line too long"); +++ if (*np <= 0 || *np == '\n') +++ break; +++ } +++ *np = 0; +++ /* +++ * KLUDGE: dolmod is set here because it will +++ * cause setDolp to call domod and thus to copy wbuf. +++ * Otherwise setDolp would use it directly. If we saved +++ * it ourselves, no one would know when to free it. +++ * The actual function of the 'q' causes filename +++ * expansion not to be done on the interpolated value. +++ */ +++ dolmod = 'q'; +++ dolmcnt = 10000; +++ setDolp(wbuf); +++ goto eatbrac; +++ + + case DEOF: + + case '\n': + + goto syntax; + + + + case '*': + + strcpy(name, "argv"); + + vp = adrof("argv"); + + subscr = -1; /* Prevent eating [...] */ + + break; + + + + default: + + np = name; + + if (digit(c)) { + + if (dimen) + + goto syntax; /* No $#1, e.g. */ + + subscr = 0; + + do { + + subscr = subscr * 10 + c - '0'; + + c = DgetC(0); + + } while (digit(c)); + + unDredc(c); + + if (subscr < 0) + + goto oob; + + if (subscr == 0) { + + if (isset) { + + dolp = file ? "1" : "0"; + + goto eatbrac; + + } + + if (file == 0) + + error("No file for $0"); + + setDolp(file); + + goto eatbrac; + + } + + if (isset) + + goto syntax; + + vp = adrof("argv"); + + if (vp == 0) { + + vp = &nulargv; + + goto eatmod; + + } + + break; + + } - if (!letter(c)) +++ if (!alnum(c)) + + goto syntax; + + for (;;) { + + *np++ = c; + + c = DgetC(0); - if (!letter(c)) +++ if (!alnum(c)) + + break; + + if (np >= &name[sizeof name - 2]) + +syntax: + + error("Variable syntax"); + + } + + *np++ = 0; + + unDredc(c); + + vp = adrof(name); + + } + + if (isset) { - dolp = vp ? "1" : "0"; +++ dolp = (vp || getenv(name)) ? "1" : "0"; + + goto eatbrac; + + } - if (vp == 0) +++ if (vp == 0) { +++ np = getenv(name); +++ if (np) { +++ addla(np); +++ return; +++ } + + udvar(name); +++ /*NOTREACHED*/ +++ } + + c = DgetC(0); + + upb = blklen(vp->vec); + + if (dimen == 0 && subscr == 0 && c == '[') { + + np = name; + + for (;;) { + + c = DgetC(DODOL); /* Allow $ expand within [ ] */ + + if (c == ']') + + break; + + if (c == '\n' || c == DEOF) + + goto syntax; + + if (np >= &name[sizeof name - 2]) + + goto syntax; + + *np++ = c; + + } + + *np = 0, np = name; + + if (dolp || dolcnt) /* $ exp must end before ] */ + + goto syntax; + + if (!*np) + + goto syntax; + + if (digit(*np)) { + + register int i = 0; + + + + while (digit(*np)) + + i = i * 10 + *np++ - '0'; + + if ((i < 0 || i > upb) && !any(*np, "-*")) { + +oob: + + setname(vp->name); + + error("Subscript out of range"); + + } + + lwb = i; + + if (!*np) + + upb = lwb, np = "*"; + + } + + if (*np == '*') + + np++; + + else if (*np != '-') + + goto syntax; + + else { + + register int i = upb; + + + + np++; + + if (digit(*np)) { + + i = 0; + + while (digit(*np)) + + i = i * 10 + *np++ - '0'; + + if (i < 0 || i > upb) + + goto oob; + + } + + if (i < lwb) + + upb = lwb - 1; + + else + + upb = i; + + } + + if (lwb == 0) { + + if (upb != 0) + + goto oob; + + upb = -1; + + } + + if (*np) + + goto syntax; + + } else { + + if (subscr > 0) + + if (subscr > upb) + + lwb = 1, upb = 0; + + else + + lwb = upb = subscr; + + unDredc(c); + + } + + if (dimen) { + + char *cp = putn(upb - lwb + 1); + + + + addla(cp); + + xfree(cp); + + } else { + +eatmod: + + c = DgetC(0); + + if (c == ':') { + + c = DgetC(0), dolmcnt = 1; + + if (c == 'g') + + c = DgetC(0), dolmcnt = 10000; - if (!any(c, "htrqx")) +++ if (!any(c, "htrqxe")) + + error("Bad : mod in $"); + + dolmod = c; + + if (c == 'q') + + dolmcnt = 10000; + + } else + + unDredc(c); + + dolnxt = &vp->vec[lwb - 1]; + + dolcnt = upb - lwb + 1; + + } + +eatbrac: + + if (sc == '{') { + + c = Dredc(); + + if (c != '}') + + goto syntax; + + } + +} + + + +setDolp(cp) + + register char *cp; + +{ + + register char *dp; + + + + if (dolmod == 0 || dolmcnt == 0) { + + dolp = cp; + + return; + + } + + dp = domod(cp, dolmod); + + if (dp) { + + dolmcnt--; + + addla(dp); + + xfree(dp); + + } else + + addla(cp); + + dolp = ""; + +} + + + +unDredc(c) + + int c; + +{ + + + + Dpeekrd = c; + +} + + + +Dredc() + +{ + + register int c; + + + + if (c = Dpeekrd) { + + Dpeekrd = 0; + + return (c); + + } + + if (Dcp && (c = *Dcp++)) - return (c); +++ return (c&(QUOTE|TRIM)); + + if (*Dvp == 0) { + + Dcp = 0; + + return (DEOF); + + } + + Dcp = *Dvp++; + + return (' '); + +} + + + +Dtest(c) + + register int c; + +{ + + + + /* Note that c isn't trimmed thus !...:q's aren't lost */ + + if (any(c, "$\\'`\"")) + + gflag = 1; + +} + + + +Dtestq(c) + + register int c; + +{ + + + + if (any(c, "\\'`\"")) + + gflag = 1; + +} + + + +/* + + * Form a shell temporary file (in unit 0) from the words + + * of the shell input up to a line the same as "term". + + * Unit 0 should have been closed before this call. + + */ + +heredoc(term) + + char *term; + +{ + + register int c; + + char *Dv[2]; + + char obuf[BUFSIZ], lbuf[BUFSIZ], mbuf[BUFSIZ]; + + int ocnt, lcnt, mcnt; + + register char *lbp, *obp, *mbp; + + char **vp; + + bool quoted; + + + + if (creat(shtemp, 0600) < 0) + + Perror(shtemp); + + close(0); + + if (open(shtemp, 2) < 0) { + + int oerrno = errno; + + + + unlink(shtemp); + + errno = oerrno; + + Perror(shtemp); + + } + + unlink(shtemp); /* 0 0 inode! */ + + Dv[0] = term; Dv[1] = NOSTR; gflag = 0; + + scan(Dv, trim); rscan(Dv, Dtestq); quoted = gflag; + + ocnt = BUFSIZ; obp = obuf; + + for (;;) { + + /* + + * Read up a line + + */ + + lbp = lbuf; lcnt = BUFSIZ - 4; + + for (;;) { + + c = readc(1); /* 1 -> Want EOF returns */ + + if (c < 0) { + + setname(term); + + bferr("<< terminator not found"); + + } + + if (c == '\n') + + break; + + if (c &= TRIM) { + + *lbp++ = c; + + if (--lcnt < 0) { + + setname("<<"); + + error("Line overflow"); + + } + + } + + } + + *lbp = 0; + + + + /* + + * Compare to terminator -- before expansion + + */ + + if (eq(lbuf, term)) { + + write(0, obuf, BUFSIZ - ocnt); + + lseek(0, 0l, 0); + + return; + + } + + + + /* + + * If term was quoted or -n just pass it on + + */ + + if (quoted || noexec) { + + *lbp++ = '\n'; *lbp = 0; + + for (lbp = lbuf; c = *lbp++;) { + + *obp++ = c; + + if (--ocnt == 0) { + + write(0, obuf, BUFSIZ); + + obp = obuf; ocnt = BUFSIZ; + + } + + } + + continue; + + } + + + + /* + + * Term wasn't quoted so variable and then command + + * expand the input line + + */ + + Dcp = lbuf; Dvp = Dv + 1; mbp = mbuf; mcnt = BUFSIZ - 4; + + for (;;) { + + c = DgetC(DODOL); + + if (c == DEOF) + + break; + + if ((c &= TRIM) == 0) + + continue; + + /* \ quotes \ $ ` here */ + + if (c =='\\') { + + c = DgetC(0); + + if (!any(c, "$\\`")) + + unDgetC(c | QUOTE), c = '\\'; + + else + + c |= QUOTE; + + } + + *mbp++ = c; + + if (--mcnt == 0) { + + setname("<<"); + + bferr("Line overflow"); + + } + + } + + *mbp++ = 0; + + + + /* + + * If any ` in line do command substitution + + */ + + mbp = mbuf; + + if (any('`', mbp)) { + + /* + + * 1 arg to dobackp causes substitution to be literal. + + * Words are broken only at newlines so that all blanks + + * and tabs are preserved. Blank lines (null words) + + * are not discarded. + + */ + + vp = dobackp(mbuf, 1); + + } else + + /* Setup trivial vector similar to return of dobackp */ + + Dv[0] = mbp, Dv[1] = NOSTR, vp = Dv; + + + + /* + + * Resurrect the words from the command substitution + + * each separated by a newline. Note that the last + + * newline of a command substitution will have been + + * discarded, but we put a newline after the last word + + * because this represents the newline after the last + + * input line! + + */ + + for (; *vp; vp++) { + + for (mbp = *vp; *mbp; mbp++) { + + *obp++ = *mbp & TRIM; + + if (--ocnt == 0) { + + write(0, obuf, BUFSIZ); + + obp = obuf; ocnt = BUFSIZ; + + } + + } + + *obp++ = '\n'; + + if (--ocnt == 0) { + + write(0, obuf, BUFSIZ); + + obp = obuf; ocnt = BUFSIZ; + + } + + } + + if (pargv) + + blkfree(pargv), pargv = 0; + + } + +} diff --cc usr/src/cmd/csh/sh.err.c index 0000000000,4be7bcae53,0000000000..d72a51882e mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.err.c +++ b/usr/src/cmd/csh/sh.err.c @@@@ -1,0 -1,155 -1,0 +1,142 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.err.c 4.1 10/9/80"; +++ + +#include "sh.h" +++#include + + + +/* + + * C Shell + + */ + + + +bool errspl; /* Argument to error was spliced by seterr2 */ + +char one[2] = { '1', 0 }; + +char *onev[2] = { one, NOSTR }; + +/* + + * Print error string s with optional argument arg. + + * This routine always resets or exits. The flag haderr + + * is set so the routine who catches the unwind can propogate + + * it if they want. + + * + + * Note that any open files at the point of error will eventually + + * be closed in the routine process in sh.c which is the only + + * place error unwinds are ever caught. + + */ + +error(s, arg) + + char *s; + +{ + + register char **v; + + register char *ep; + + + + /* + + * Must flush before we print as we wish output before the error + + * to go on (some form of) standard output, while output after + + * goes on (some form of) diagnostic output. + + * If didfds then output will go to 1/2 else to FSHOUT/FSHDIAG. + + * See flush in sh.print.c. + + */ + + flush(); + + haderr = 1; /* Now to diagnostic output */ + + timflg = 0; /* This isn't otherwise reset */ + + if (v = pargv) + + pargv = 0, blkfree(v); + + if (v = gargv) + + gargv = 0, blkfree(v); + + + + /* + + * A zero arguments causes no printing, else print + + * an error diagnostic here. + + */ + + if (s) + + printf(s, arg), printf(".\n"); + + + + didfds = 0; /* Forget about 0,1,2 */ + + if ((ep = err) && errspl) { + + errspl = 0; + + xfree(ep); + + } + + errspl = 0; + + + + /* + + * Reset the state of the input. + + * This buffered seek to end of file will also + + * clear the while/foreach stack. + + */ + + btoeof(); + + + + /* + + * Go away if -e or we are a child shell + + */ + + if (exiterr || child) + + exit(1); + + + + setq("status", onev, &shvhed); +++ if (tpgrp > 0) +++ ioctl(FSHTTY, TIOCSPGRP, &tpgrp); + + reset(); /* Unwind */ + +} + + + +/* + + * Perror is the shells version of perror which should otherwise + + * never be called. + + */ + +Perror(s) + + char *s; + +{ + + + + /* + + * Perror uses unit 2, thus if we didn't set up the fd's + + * we must set up unit 2 now else the diagnostic will disappear + + */ + + if (!didfds) { + + register int oerrno = errno; + + + + dcopy(SHDIAG, 2); + + errno = oerrno; + + } + + perror(s); - error(0); /* To exit or unwind */ - } - - /* - * For builtin functions, the routine bferr may be called - * to print a diagnostic of the form: - * name: Diagnostic. - * where name has been setup by setname. - * (Made into a macro to save space) - * - char *bname; - - setname(cp) - char *cp; - { - - bname = cp; +++ error(NOSTR); /* To exit or unwind */ + +} - */ + + + +bferr(cp) + + char *cp; + +{ + + + + flush(); + + haderr = 1; + + printf("%s: ", bname); + + error(cp); + +} + + + +/* + + * The parser and scanner set up errors for later by calling seterr, + + * which sets the variable err as a side effect; later to be tested, + + * e.g. in process. + + */ + +seterr(s) + + char *s; + +{ + + + + if (err == 0) + + err = s, errspl = 0; + +} + + + +/* Set err to a splice of cp and dp, to be freed later in error() */ + +seterr2(cp, dp) + + char *cp, *dp; + +{ + + + + if (err) + + return; + + err = strspl(cp, dp); + + errspl++; + +} + + + +/* Set err to a splice of cp with a string form of character d */ + +seterrc(cp, d) + + char *cp, d; + +{ + + char chbuf[2]; + + + + chbuf[0] = d; + + chbuf[1] = 0; + + seterr2(cp, chbuf); + +} diff --cc usr/src/cmd/csh/sh.exec.c index 0000000000,f8937bbd4e,0000000000..9a7925174d mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.exec.c +++ b/usr/src/cmd/csh/sh.exec.c @@@@ -1,0 -1,291 -1,0 +1,316 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.exec.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C shell + + */ + + + +/* + + * System level search and execute of a command. + + * We look in each directory for the specified command name. + + * If the name contains a '/' then we execute only the full path name. + + * If there is no search path then we execute only full path names. + + */ + + + +/* + + * As we search for the command we note the first non-trivial error + + * message for presentation to the user. This allows us often + + * to show that a file has the wrong mode/no access when the file + + * is not in the last component of the search path, so we must + + * go on after first detecting the error. + + */ + +char *exerr; /* Execution error message */ + +char *expath; /* Path for exerr */ + + + +/* + + * Xhash is an array of HSHSIZ chars, which are used to hash execs. + + * If it is allocated, then to tell whether ``name'' is (possibly) + + * present in the i'th component of the variable path, you look at + + * the i'th bit of xhash[hash("name")]. This is setup automatically + + * after .login is executed, and recomputed whenever ``path'' is + + * changed. + + */ + +int havhash; + +#define HSHSIZ 511 + +char xhash[HSHSIZ]; +++#ifdef VFORK + +int hits, misses; +++#endif + + + +/* Dummy search path for just absolute search when no path */ + +char *justabs[] = { "", 0 }; + + + +doexec(t) + + register struct command *t; + +{ + + char *sav; + + register char *dp, **pv, **av; + + register struct varent *v; + + bool slash = any('/', t->t_dcom[0]); + + int hashval, i; + + char *blk[2]; + + + + /* + + * Glob the command name. If this does anything, then we + + * will execute the command only relative to ".". One special + + * case: if there is no PATH, then we execute only commands + + * which start with '/'. + + */ + + dp = globone(t->t_dcom[0]); + + sav = t->t_dcom[0]; + + exerr = 0; expath = t->t_dcom[0] = dp; + + xfree(sav); + + v = adrof("path"); + + if (v == 0 && expath[0] != '/') + + pexerr(); + + slash |= gflag; + + + + /* + + * Glob the argument list, if necessary. + + * Otherwise trim off the quote bits. + + */ + + gflag = 0; av = &t->t_dcom[1]; + + rscan(av, tglob); + + if (gflag) { + + av = glob(av); + + if (av == 0) + + error("No match"); + + } + + blk[0] = t->t_dcom[0]; + + blk[1] = 0; + + av = blkspl(blk, av); + +#ifdef VFORK + + Vav = av; + +#endif + + scan(av, trim); + + + + xechoit(av); /* Echo command if -x */ + + closech(); /* Close random fd's */ + + +++ /* +++ * We must do this after any possible forking (like `foo` +++ * in glob) so that this shell can still do subprocesses. +++ */ +++ sigsys(SIGCHLD, SIG_IGN); /* sigsys for vforks sake */ +++ + + /* + + * If no path, no words in path, or a / in the filename + + * then restrict the command search. + + */ + + if (v == 0 || v->vec[0] == 0 || slash) + + pv = justabs; + + else + + pv = v->vec; + + sav = strspl("/", *av); /* / command name for postpending */ + +#ifdef VFORK + + Vsav = sav; + +#endif + + if (havhash) + + hashval = xhash[hash(*av)]; + + i = 0; +++#ifdef VFORK + + hits++; +++#endif + + do { + + if (!slash && pv[0][0] == '/' && havhash && (hashval & (1 << (i % 8))) == 0) + + goto cont; + + if (pv[0][0] == 0 || eq(pv[0], ".")) /* don't make ./xxx */ + + texec(*av, av); + + else { + + dp = strspl(*pv, sav); + +#ifdef VFORK + + Vdp = dp; + +#endif + + texec(dp, av); + +#ifdef VFORK + + Vdp = 0; + +#endif + + xfree(dp); + + } +++#ifdef VFORK + + misses++; +++#endif + +cont: + + pv++; + + i++; + + } while (*pv); +++#ifdef VFORK + + hits--; +++#endif + +#ifdef VFORK + + Vsav = 0; + + Vav = 0; + +#endif + + xfree(sav); + + xfree(av); + + pexerr(); + +} + + + +pexerr() + +{ + + + + /* Couldn't find the damn thing */ + + setname(expath); + + /* xfree(expath); */ + + if (exerr) + + bferr(exerr); + + bferr("Command not found"); + +} + + + +/* Last resort shell */ + +char *lastsh[] = { SHELLPATH, 0 }; + + + +/* + + * Execute command f, arg list t. + + * Record error message if not found. + + * Also do shell scripts here. + + */ + +texec(f, t) + + char *f; + + register char **t; + +{ + + register struct varent *v; + + register char **vp; + + extern char *sys_errlist[]; + + + + execv(f, t); + + switch (errno) { + + + + case ENOEXEC: + + /* + + * If there is an alias for shell, then + + * put the words of the alias in front of the + + * argument list replacing the command name. + + * Note no interpretation of the words at this point. + + */ + + v = adrof1("shell", &aliases); + + if (v == 0) { + +#ifdef OTHERSH + + register int ff = open(f, 0); + + char ch; + +#endif + + + + vp = lastsh; + + vp[0] = adrof("shell") ? value("shell") : SHELLPATH; + +#ifdef OTHERSH + + if (ff != -1 && read(ff, &ch, 1) == 1 && ch != '#') + + vp[0] = OTHERSH; + + close(ff); + +#endif + + } else + + vp = v->vec; + + t[0] = f; + + t = blkspl(vp, t); /* Splice up the new arglst */ + + f = *t; + + execv(f, t); - xfree(t); +++ xfree((char *)t); + + /* The sky is falling, the sky is falling! */ + + + + case ENOMEM: + + Perror(f); + + + + case ENOENT: + + break; + + + + default: + + if (exerr == 0) { + + exerr = sys_errlist[errno]; + + expath = savestr(f); + + } + + } + +} + + + +execash(t, kp) + + register struct command *kp; + +{ + + + + didcch++; +++ signal(SIGINT, parintr); +++ signal(SIGQUIT, parintr); +++ signal(SIGTERM, parterm); /* if doexec loses, screw */ + + lshift(kp->t_dcom, 1); +++ exiterr++; + + doexec(kp); + + /*NOTREACHED*/ + +} + + + +xechoit(t) + + char **t; + +{ + + + + if (adrof("echo")) { + + flush(); + + haderr = 1; + + blkpr(t), printf("\n"); + + haderr = 0; + + } + +} + + + +dohash() + +{ + + struct stat stb; + + struct direct dirbuf[BUFSIZ / sizeof (struct direct)]; + + char d_name[DIRSIZ + 1]; + + register int dirf, cnt; + + int i = 0; + + struct varent *v = adrof("path"); + + char **pv; + + + + havhash = 1; + + for (cnt = 0; cnt < HSHSIZ; cnt++) + + xhash[cnt] = 0; + + if (v == 0) + + return; + + for (pv = v->vec; *pv; pv++, i = (i + 1) % 8) { + + if (pv[0][0] != '/') + + continue; + + dirf = open(*pv, 0); + + if (dirf < 0) + + continue; + + if (fstat(dirf, &stb) < 0 || !isdir(stb)) { + + close(dirf); + + continue; + + } + + while ((cnt = read(dirf, (char *) dirbuf, sizeof dirbuf)) >= sizeof dirbuf[0]) { + + register struct direct *ep = dirbuf; + + + + for (cnt /= sizeof(struct direct); cnt > 0; cnt--, ep++) { + + if (ep->d_ino == 0) + + continue; + + copdent(d_name, ep->d_name); + + xhash[hash(d_name)] |= (1 << i); + + } + + } + + close(dirf); + + } + +} + + + +dounhash() + +{ + + + + havhash = 0; + +} + + +++#ifdef VFORK + +hashstat() + +{ + + + + if (hits+misses) + + printf("%d hits, %d misses, %2d%%\n", hits, misses, 100 * hits / (hits + misses)); + +} +++#endif + + + +hash(cp) + + register char *cp; + +{ - register int hash = 0; +++ register long hash = 0; +++ int retval; + + + + while (*cp) + + hash += hash + *cp++; - return (hash % HSHSIZ); +++ if (hash < 0) +++ hash = -hash; +++ retval = hash % HSHSIZ; +++ return (retval); + +} diff --cc usr/src/cmd/csh/sh.exp.c index 0000000000,74d359de32,0000000000..b940c58f2e mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.exp.c +++ b/usr/src/cmd/csh/sh.exp.c @@@@ -1,0 -1,553 -1,0 +1,575 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.exp.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C shell + + */ + + +++#define IGNORE 1 /* in ignore, it means to ignore value, just parse */ +++#define NOGLOB 2 /* in ignore, it means not to globone */ +++ + +#define ADDOP 1 + +#define MULOP 2 + +#define EQOP 4 + +#define RELOP 8 + +#define RESTOP 16 + +#define ANYOP 31 + + + +#define EQEQ 1 + +#define GTR 2 + +#define LSS 4 + +#define NOTEQ 6 +++#define EQMATCH 7 +++#define NOTEQMATCH 8 + + + +exp(vp) + + register char ***vp; + +{ + + + + return (exp0(vp, 0)); + +} + + + +exp0(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register int p1 = exp1(vp, ignore); + + + +#ifdef EDEBUG + + etraci("exp0 p1", p1, vp); + +#endif + + if (**vp && eq(**vp, "||")) { + + register int p2; + + + + (*vp)++; - p2 = exp0(vp, ignore || p1); +++ p2 = exp0(vp, (ignore&IGNORE) || p1); + +#ifdef EDEBUG + + etraci("exp0 p2", p2, vp); + +#endif + + return (p1 || p2); + + } + + return (p1); + +} + + + +exp1(vp, ignore) + + register char ***vp; + +{ + + register int p1 = exp2(vp, ignore); + + + +#ifdef EDEBUG + + etraci("exp1 p1", p1, vp); + +#endif + + if (**vp && eq(**vp, "&&")) { + + register int p2; + + + + (*vp)++; - p2 = exp1(vp, ignore || !p1); +++ p2 = exp1(vp, (ignore&IGNORE) || !p1); + +#ifdef EDEBUG + + etraci("exp1 p2", p2, vp); + +#endif + + return (p1 && p2); + + } + + return (p1); + +} + + + +exp2(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register int p1 = exp2a(vp, ignore); + + + +#ifdef EDEBUG + + etraci("exp3 p1", p1, vp); + +#endif + + if (**vp && eq(**vp, "|")) { + + register int p2; + + + + (*vp)++; + + p2 = exp2(vp, ignore); + +#ifdef EDEBUG + + etraci("exp3 p2", p2, vp); + +#endif + + return (p1 | p2); + + } + + return (p1); + +} + + + +exp2a(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register int p1 = exp2b(vp, ignore); + + + +#ifdef EDEBUG + + etraci("exp2a p1", p1, vp); + +#endif + + if (**vp && eq(**vp, "^")) { + + register int p2; + + + + (*vp)++; + + p2 = exp2a(vp, ignore); + +#ifdef EDEBUG + + etraci("exp2a p2", p2, vp); + +#endif + + return (p1 ^ p2); + + } + + return (p1); + +} + + + +exp2b(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register int p1 = exp2c(vp, ignore); + + + +#ifdef EDEBUG + + etraci("exp2b p1", p1, vp); + +#endif + + if (**vp && eq(**vp, "&")) { + + register int p2; + + + + (*vp)++; + + p2 = exp2b(vp, ignore); + +#ifdef EDEBUG + + etraci("exp2b p2", p2, vp); + +#endif + + return (p1 & p2); + + } + + return (p1); + +} + + + +exp2c(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register char *p1 = exp3(vp, ignore); + + register char *p2; + + register int i; + + + +#ifdef EDEBUG + + etracc("exp2c p1", p1, vp); + +#endif + + if (i = isa(**vp, EQOP)) { + + (*vp)++; +++ if (i == EQMATCH || i == NOTEQMATCH) +++ ignore |= NOGLOB; + + p2 = exp3(vp, ignore); + +#ifdef EDEBUG + + etracc("exp2c p2", p2, vp); + +#endif - if (!ignore) switch (i) { +++ if (!(ignore&IGNORE)) switch (i) { + + + + case EQEQ: + + i = eq(p1, p2); + + break; + + + + case NOTEQ: + + i = !eq(p1, p2); + + break; +++ +++ case EQMATCH: +++ i = Gmatch(p1, p2); +++ break; +++ +++ case NOTEQMATCH: +++ i = !Gmatch(p1, p2); +++ break; + + } + + xfree(p1), xfree(p2); + + return (i); + + } + + i = egetn(p1); + + xfree(p1); + + return (i); + +} + + + +char * + +exp3(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register char *p1, *p2; + + register int i; + + + + p1 = exp3a(vp, ignore); + +#ifdef EDEBUG + + etracc("exp3 p1", p1, vp); + +#endif + + if (i = isa(**vp, RELOP)) { + + (*vp)++; + + if (**vp && eq(**vp, "=")) + + i |= 1, (*vp)++; + + p2 = exp3(vp, ignore); + +#ifdef EDEBUG + + etracc("exp3 p2", p2, vp); + +#endif - if (!ignore) switch (i) { +++ if (!(ignore&IGNORE)) switch (i) { + + + + case GTR: + + i = egetn(p1) > egetn(p2); + + break; + + + + case GTR|1: + + i = egetn(p1) >= egetn(p2); + + break; + + + + case LSS: + + i = egetn(p1) < egetn(p2); + + break; + + + + case LSS|1: + + i = egetn(p1) <= egetn(p2); + + break; + + } + + xfree(p1), xfree(p2); + + return (putn(i)); + + } + + return (p1); + +} + + + +char * + +exp3a(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register char *p1, *p2, *op; + + register int i; + + + + p1 = exp4(vp, ignore); + +#ifdef EDEBUG + + etracc("exp3a p1", p1, vp); + +#endif + + op = **vp; + + if (op && any(op[0], "<>") && op[0] == op[1]) { + + (*vp)++; + + p2 = exp3a(vp, ignore); + +#ifdef EDEBUG + + etracc("exp3a p2", p2, vp); + +#endif + + if (op[0] == '<') + + i = egetn(p1) << egetn(p2); + + else + + i = egetn(p1) >> egetn(p2); + + xfree(p1), xfree(p2); + + return (putn(i)); + + } + + return (p1); + +} + + + +char * + +exp4(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register char *p1, *p2; + + register int i = 0; + + + + p1 = exp5(vp, ignore); + +#ifdef EDEBUG + + etracc("exp4 p1", p1, vp); + +#endif + + if (isa(**vp, ADDOP)) { + + register char *op = *(*vp)++; + + + + p2 = exp4(vp, ignore); + +#ifdef EDEBUG + + etracc("exp4 p2", p2, vp); + +#endif - if (!ignore) switch (op[0]) { +++ if (!(ignore&IGNORE)) switch (op[0]) { + + + + case '+': + + i = egetn(p1) + egetn(p2); + + break; + + + + case '-': + + i = egetn(p1) - egetn(p2); + + break; + + } + + xfree(p1), xfree(p2); + + return (putn(i)); + + } + + return (p1); + +} + + + +char * + +exp5(vp, ignore) + + register char ***vp; + + bool ignore; + +{ + + register char *p1, *p2; + + register int i = 0; + + + + p1 = exp6(vp, ignore); + +#ifdef EDEBUG + + etracc("exp5 p1", p1, vp); + +#endif + + if (isa(**vp, MULOP)) { + + register char *op = *(*vp)++; + + + + p2 = exp5(vp, ignore); + +#ifdef EDEBUG + + etracc("exp5 p2", p2, vp); + +#endif - if (!ignore) switch (op[0]) { +++ if (!(ignore&IGNORE)) switch (op[0]) { + + + + case '*': + + i = egetn(p1) * egetn(p2); + + break; + + + + case '/': + + i = egetn(p2); + + if (i == 0) + + error("Divide by 0"); + + i = egetn(p1) / i; + + break; + + + + case '%': + + i = egetn(p2); + + if (i == 0) + + error("Mod by 0"); + + i = egetn(p1) % i; + + break; + + } + + xfree(p1), xfree(p2); + + return (putn(i)); + + } + + return (p1); + +} + + + +char * + +exp6(vp, ignore) + + register char ***vp; + +{ + + int ccode, i; + + register char *cp, *dp, *ep; + + + + if (eq(**vp, "!")) { + + (*vp)++; + + cp = exp6(vp, ignore); + +#ifdef EDEBUG + + etracc("exp6 ! cp", cp, vp); + +#endif + + i = egetn(cp); + + xfree(cp); + + return (putn(!i)); + + } + + if (eq(**vp, "~")) { + + (*vp)++; + + cp = exp6(vp, ignore); + +#ifdef EDEBUG + + etracc("exp6 ~ cp", cp, vp); + +#endif + + i = egetn(cp); + + xfree(cp); + + return (putn(~i)); + + } + + if (eq(**vp, "(")) { + + (*vp)++; + + ccode = exp0(vp, ignore); + +#ifdef EDEBUG + + etraci("exp6 () ccode", ccode, vp); + +#endif + + if (*vp == 0 || **vp == 0 || ***vp != ')') + + bferr("Expression syntax"); + + (*vp)++; + + return (putn(ccode)); + + } + + if (eq(**vp, "{")) { - int pid; + + register char **v; - +++ struct command faket; +++ char *fakecom[2]; +++ +++ faket.t_dtyp = TCOM; +++ faket.t_dflg = 0; +++ faket.t_dcar = faket.t_dcdr = faket.t_dspr = (struct command *)0; +++ faket.t_dcom = fakecom; +++ fakecom[0] = "{ ... }"; +++ fakecom[1] = NOSTR; + + (*vp)++; + + v = *vp; + + for (;;) { + + if (!**vp) + + bferr("Missing }"); + + if (eq(*(*vp)++, "}")) + + break; + + } - if (ignore) +++ if (ignore&IGNORE) + + return (""); - pid = fork(); - if (pid < 0) - Perror("fork"); - if (pid == 0) { - if (setintr) - signal(SIGINT, SIG_DFL); +++ psavejob(); +++ if (pfork(&faket, -1) == 0) { + + *--(*vp) = 0; + + evalav(v); + + exitstat(); + + } - cadd(pid, "{}"); - pwait(pid); +++ pwait(); +++ prestjob(); + +#ifdef EDEBUG + + etraci("exp6 {} status", egetn(value("status")), vp); + +#endif + + return (putn(egetn(value("status")) == 0)); + + } + + if (isa(**vp, ANYOP)) + + return (""); + + cp = *(*vp)++; + + if (*cp == '-' && any(cp[1], "erwxfdzo")) { + + struct stat stb; + + + + if (isa(**vp, ANYOP)) + + bferr("Missing file name"); + + dp = *(*vp)++; - if (ignore) +++ if (ignore&IGNORE) + + return (""); + + ep = globone(dp); + + switch (cp[1]) { + + + + case 'r': + + i = !access(ep, 4); + + break; + + + + case 'w': + + i = !access(ep, 2); + + break; + + + + case 'x': + + i = !access(ep, 1); + + break; + + + + default: + + if (stat(ep, &stb)) { + + xfree(ep); + + return ("0"); + + } + + switch (cp[1]) { + + + + case 'f': + + i = (stb.st_mode & S_IFMT) == S_IFREG; + + break; + + + + case 'd': + + i = (stb.st_mode & S_IFMT) == S_IFDIR; + + break; + + + + case 'z': + + i = stb.st_size == 0; + + break; + + + + case 'e': + + i = 1; + + break; + + + + case 'o': + + i = stb.st_uid == uid; + + break; + + } + + } + +#ifdef EDEBUG + + etraci("exp6 -? i", i, vp); + +#endif + + xfree(ep); + + return (putn(i)); + + } + +#ifdef EDEBUG + + etracc("exp6 default", cp, vp); + +#endif - return (globone(cp)); +++ return (ignore&NOGLOB ? cp : globone(cp)); + +} + + + +evalav(v) + + register char **v; + +{ + + struct wordent paraml; + + register struct wordent *hp = ¶ml; + + struct command *t; + + register struct wordent *wdp = hp; + + - child++; + + set("status", "0"); + + hp->prev = hp->next = hp; + + hp->word = ""; + + while (*v) { + + register struct wordent *new = (struct wordent *) calloc(1, sizeof *wdp); + + + + new->prev = wdp; + + new->next = hp; + + wdp->next = new; + + wdp = new; + + wdp->word = savestr(*v++); + + } + + hp->prev = wdp; + + alias(¶ml); - t = syntax(paraml.next, ¶ml); +++ t = syntax(paraml.next, ¶ml, 0); + + if (err) + + error(err); - execute(t); +++ execute(t, -1); + + freelex(¶ml), freesyn(t); + +} + + + +isa(cp, what) + + register char *cp; + + register int what; + +{ + + + + if (cp == 0) + + return ((what & RESTOP) != 0); + + if (cp[1] == 0) { + + if ((what & ADDOP) && any(cp[0], "+-")) + + return (1); + + if ((what & MULOP) && any(cp[0], "*/%")) + + return (1); + + if ((what & RESTOP) && any(cp[0], "()!~^")) + + return (1); + + } + + if ((what & RESTOP) && (any(cp[0], "|&") || eq(cp, "<<") || eq(cp, ">>"))) + + return (1); + + if (what & EQOP) { + + if (eq(cp, "==")) + + return (EQEQ); + + if (eq(cp, "!=")) + + return (NOTEQ); +++ if (eq(cp, "=~")) +++ return (EQMATCH); +++ if (eq(cp, "!~")) +++ return (NOTEQMATCH); + + } + + if (!(what & RELOP)) + + return (0); + + if (*cp == '<') + + return (LSS); + + if (*cp == '>') + + return (GTR); + + return (0); + +} + + + +egetn(cp) + + register char *cp; + +{ + + + + if (*cp && *cp != '-' && !digit(*cp)) + + bferr("Expression syntax"); + + return (getn(cp)); + +} + + + +/* Phew! */ + + + +#ifdef EDEBUG + +etraci(str, i, vp) + + char *str; + + int i; + + char ***vp; + +{ + + + + printf("%s=%d\t", str, i); + + blkpr(*vp); + + printf("\n"); + +} + + + +etracc(str, cp, vp) + + char *str, *cp; + + char ***vp; + +{ + + + + printf("%s=%s\t", str, cp); + + blkpr(*vp); + + printf("\n"); + +} + +#endif diff --cc usr/src/cmd/csh/sh.func.c index 0000000000,59062c53ae,0000000000..b353ddd384 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.func.c +++ b/usr/src/cmd/csh/sh.func.c @@@@ -1,0 -1,784 -1,0 +1,1066 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.func.c 4.1 10/9/80"; +++ + +#include "sh.h" +++#include + + + +/* + + * C shell + + */ + + + +struct biltins * - isbfunc(cp) - register char *cp; +++isbfunc(t) +++ register struct command *t; + +{ +++ register char *cp = t->t_dcom[0]; + + register char *dp; + + register struct biltins *bp; - - if (lastchr(cp) == ':') - return ((struct biltins *) 1); +++ int dolabel(), dofg1(), dobg1(); +++ static struct biltins label = { "", dolabel, 0, 0 }; +++ static struct biltins foregnd = { "%job", dofg1, 0, 0 }; +++ static struct biltins backgnd = { "%job &", dobg1, 0, 0 }; +++ +++ if (lastchr(cp) == ':') { +++ label.bname = cp; +++ return (&label); +++ } +++ if (*cp == '%') { +++ if (t->t_dflg & FAND) { +++ t->t_dflg &= ~FAND; +++ backgnd.bname = cp; +++ return (&backgnd); +++ } +++ foregnd.bname = cp; +++ return (&foregnd); +++ } + + for (bp = bfunc; dp = bp->bname; bp++) { + + if (dp[0] == cp[0] && eq(dp, cp)) + + return (bp); + + if (dp[0] > cp[0]) + + break; + + } + + return (0); + +} + + - func(t) +++func(t, bp) + + register struct command *t; - { + + register struct biltins *bp; +++{ + + int i; + + - bp = bfunc; - if (lastchr(t->t_dcom[0]) == ':') { - xechoit(t->t_dcom); - if (!eq(t->t_dcom[0], ":") && t->t_dcom[1]) - error("No args on labels"); - return (1); - } - bp = isbfunc(t->t_dcom[0]); - if (bp == 0) - return (0); - /* timed builtins must go in background if output is pipe, or &'ed */ - if (eq(bp->bname, "time")) - if ((t->t_dflg & FAND) || (t->t_dflg & FPOU)) - return (0); - if (eq(bp->bname, "nohup") && t->t_dcom[1]) - return (0); + + xechoit(t->t_dcom); + + setname(bp->bname); + + i = blklen(t->t_dcom) - 1; + + if (i < bp->minargs) + + bferr("Too few arguments"); + + if (i > bp->maxargs) + + bferr("Too many arguments"); - i = (*bp->bfunct)(t->t_dcom, t); - /* time and nice may not do their deeds, all others guarantee too */ - return (eq(bp->bname, "time") || eq(bp->bname, "nice") ? i : 1); +++ (*bp->bfunct)(t->t_dcom, t); +++} +++ +++dolabel() +++{ +++ + +} + + + +doonintr(v) + + char **v; + +{ + + register char *cp; + + register char *vv = v[1]; + + + + if (parintr == SIG_IGN) + + return; + + if (setintr && intty) + + bferr("Can't from terminal"); + + cp = gointr, gointr = 0, xfree(cp); + + if (vv == 0) { - signal(SIGINT, setintr ? SIG_IGN : SIG_DFL); +++ if (setintr) +++ sighold(SIGINT); +++ else +++ sigset(SIGINT, SIG_DFL); + + gointr = 0; + + } else if (eq((vv = strip(vv)), "-")) { - signal(SIGINT, SIG_IGN); +++ sigset(SIGINT, SIG_IGN); + + gointr = "-"; + + } else { + + gointr = savestr(vv); - signal(SIGINT, pintr); +++ sigset(SIGINT, pintr); + + } + +} + + + +donohup() + +{ + + + + if (intty) + + bferr("Can't from terminal"); + + if (setintr == 0) { + + signal(SIGHUP, SIG_IGN); + +#ifdef CC + + submit(getpid()); + +#endif + + } + +} + + + +dozip() + +{ + + + + ; + +} + + - chngd(vp) - register char **vp; - { - register int i; - register char *dp; - - vp++; - dp = *vp; - if (dp) - dp = globone(dp); - else { - dp = value("home"); - if (*dp == 0) - bferr("No home"); - } - i = chdir(dp); - if (*vp) - xfree(dp); - if (i < 0) - Perror(dp); - } - + +prvars() + +{ + + + + plist(&shvhed); + +} + + + +doalias(v) + + register char **v; + +{ + + register struct varent *vp; + + register char *p; + + + + v++; + + p = *v++; + + if (p == 0) + + plist(&aliases); + + else if (*v == 0) { + + vp = adrof1(strip(p), &aliases); + + if (vp) + + blkpr(vp->vec), printf("\n"); + + } else { + + if (eq(p, "alias") || eq(p, "unalias")) { + + setname(p); + + bferr("Too dangerous to alias that"); + + } + + set1(strip(p), saveblk(v), &aliases); + + } + +} + + + +unalias(v) + + char **v; + +{ + + + + unset1(v, &aliases); + +} + + + +dologout() + +{ + + + + islogin(); + + goodbye(); + +} + + + +dologin(v) + + char **v; + +{ + + + + islogin(); +++ signal(SIGTERM, parterm); + + execl("/bin/login", "login", v[1], 0); +++ untty(); + + exit(1); + +} + + + +donewgrp(v) + + char **v; + +{ + + +++ signal(SIGTERM, parterm); + + execl("/bin/newgrp", "newgrp", v[1], 0); + + execl("/usr/bin/newgrp", "newgrp", v[1], 0); +++ untty(); +++ exit(1); + +} + + + +islogin() + +{ + + +++ if (chkstop == 0 && setintr) +++ panystop(0); + + if (loginsh) + + return; + + error("Not login shell"); + +} + + + +doif(v, kp) + + char **v; + + struct command *kp; + +{ + + register int i; + + register char **vv; + + + + v++; + + i = exp(&v); + + vv = v; - if (*vv && eq(*vv, "then")) { - vv++; - if (*vv) +++ if (*vv == NOSTR) +++ bferr("Empty if"); +++ if (eq(*vv, "then")) { +++ if (*++vv) + + bferr("Improper then"); + + setname("then"); + + /* + + * If expression was zero, then scan to else, + + * otherwise just fall into following code. + + */ + + if (!i) + + search(ZIF, 0); + + return; + + } + + /* + + * Simple command attached to this if. + + * Left shift the node in this tree, munging it + + * so we can reexecute it. + + */ + + if (i) { + + lshift(kp->t_dcom, vv - kp->t_dcom); + + reexecute(kp); + + donefds(); + + } + +} + + + +/* + + * Reexecute a command, being careful not + + * to redo i/o redirection, which is already set up. + + */ + +reexecute(kp) + + register struct command *kp; + +{ + + - kp->t_dflg = FREDO; - execute(kp); +++ kp->t_dflg &= FSAVE; +++ kp->t_dflg |= FREDO; +++ /* +++ * If tty is still ours to arbitrate, arbitrate it; +++ * otherwise dont even set pgrp's as the jobs would +++ * then have no way to get the tty (we can't give it +++ * to them, and our parent wouldn't know their pgrp, etc. +++ */ +++ execute(kp, tpgrp > 0 ? tpgrp : -1); + +} + + + +doelse() + +{ + + + + search(ZELSE, 0); + +} + + + +dogoto(v) + + char **v; + +{ + + register struct whyle *wp; + + char *lp; + + + + /* + + * While we still can, locate any unknown ends of existing loops. + + * This obscure code is the WORST result of the fact that we + + * don't really parse. + + */ + + for (wp = whyles; wp; wp = wp->w_next) - if (wp->w_end == 0) - wp->w_end = search(ZBREAK, 0); - else +++ if (wp->w_end == 0) { +++ search(ZBREAK, 0); +++ wp->w_end = btell(); +++ } else + + bseek(wp->w_end); + + search(ZGOTO, 0, lp = globone(v[1])); + + xfree(lp); + + /* + + * Eliminate loops which were exited. + + */ + + wfree(); + +} + + + +doswitch(v) + + register char **v; + +{ + + register char *cp, *lp; + + + + v++; + + if (!*v || *(*v++) != '(') + + goto syntax; + + cp = **v == ')' ? "" : *v++; + + if (*(*v++) != ')') + + v--; + + if (*v) + +syntax: + + error("Syntax error"); + + search(ZSWITCH, 0, lp = globone(cp)); + + xfree(lp); + +} + + + +dobreak() + +{ + + + + if (whyles) + + toend(); + + else + + bferr("Not in while/foreach"); + +} + + + +doexit(v) + + char **v; + +{ + + +++ if (chkstop == 0) +++ panystop(0); + + /* + + * Don't DEMAND parentheses here either. + + */ + + v++; + + if (*v) { + + set("status", putn(exp(&v))); + + if (*v) + + bferr("Expression syntax"); + + } + + btoeof(); + + if (intty) + + close(SHIN); + +} + + + +doforeach(v) + + register char **v; + +{ + + register char *cp; + + register struct whyle *nwp; + + + + v++; + + cp = strip(*v); + + while (*cp && letter(*cp)) + + cp++; + + if (*cp || strlen(*v) >= 20) + + bferr("Invalid variable"); + + cp = *v++; + + if (v[0][0] != '(' || v[blklen(v) - 1][0] != ')') + + bferr("Words not ()'ed"); + + v++; + + gflag = 0, rscan(v, tglob); + + v = glob(v); + + if (v == 0) + + bferr("No match"); + + nwp = (struct whyle *) calloc(1, sizeof *nwp); + + nwp->w_fe = nwp->w_fe0 = v; gargv = 0; + + nwp->w_start = btell(); + + nwp->w_fename = savestr(cp); + + nwp->w_next = whyles; + + whyles = nwp; + + /* + + * Pre-read the loop so as to be more + + * comprehensible to a terminal user. + + */ + + if (intty) + + preread(); + + doagain(); + +} + + + +dowhile(v) + + char **v; + +{ + + register int status; - register bool again = whyles != 0 && whyles->w_start == lineloc; +++ register bool again = whyles != 0 && whyles->w_start == lineloc && +++ whyles->w_fename == 0; + + + + v++; + + /* + + * Implement prereading here also, taking care not to + + * evaluate the expression before the loop has been read up + + * from a terminal. + + */ + + if (intty && !again) + + status = !exp0(&v, 1); + + else + + status = !exp(&v); + + if (*v) + + bferr("Expression syntax"); + + if (!again) { + + register struct whyle *nwp = (struct whyle *) calloc(1, sizeof (*nwp)); + + + + nwp->w_start = lineloc; + + nwp->w_end = 0; + + nwp->w_next = whyles; + + whyles = nwp; + + if (intty) { + + /* + + * The tty preread + + */ + + preread(); + + doagain(); + + return; + + } + + } + + if (status) + + /* We ain't gonna loop no more, no more! */ + + toend(); + +} + + + +preread() + +{ - register int (*oldint)(); + + + + whyles->w_end = -1; + + if (setintr) - oldint = signal(SIGINT, pintr); +++ sigrelse(SIGINT); + + search(ZBREAK, 0); + + if (setintr) - signal(SIGINT, oldint); +++ sighold(SIGINT); + + whyles->w_end = btell(); + +} + + + +doend() + +{ + + + + if (!whyles) + + bferr("Not in while/foreach"); + + whyles->w_end = btell(); + + doagain(); + +} + + + +docontin() + +{ + + + + if (!whyles) + + bferr("Not in while/foreach"); + + doagain(); + +} + + + +doagain() + +{ + + + + /* Repeating a while is simple */ + + if (whyles->w_fename == 0) { + + bseek(whyles->w_start); + + return; + + } + + /* + + * The foreach variable list actually has a spurious word + + * ")" at the end of the w_fe list. Thus we are at the + + * of the list if one word beyond this is 0. + + */ + + if (!whyles->w_fe[1]) { + + dobreak(); + + return; + + } + + set(whyles->w_fename, savestr(*whyles->w_fe++)); + + bseek(whyles->w_start); + +} + + + +dorepeat(v, kp) + + char **v; + + struct command *kp; + +{ + + register int i; - register int (*saveintr)(); + + + + i = getn(v[1]); + + if (setintr) - saveintr = signal(SIGINT, SIG_IGN); +++ sighold(SIGINT); + + lshift(v, 2); + + while (i > 0) { + + if (setintr) - signal(SIGINT, pintr); +++ sigrelse(SIGINT); + + reexecute(kp); + + --i; + + } + + donefds(); + + if (setintr) - signal(SIGINT, saveintr); +++ sigrelse(SIGINT); + +} + + + +doswbrk() + +{ + + + + search(ZBRKSW, 0); + +} + + + +srchx(cp) + + register char *cp; + +{ + + register struct srch *sp; + + + + for (sp = srchn; sp->s_name; sp++) + + if (eq(cp, sp->s_name)) + + return (sp->s_value); + + return (-1); + +} + + + +char Stype; + +char *Sgoal; + + + +/*VARARGS2*/ + +search(type, level, goal) + + int type; + + register int level; + + char *goal; + +{ + + char wordbuf[BUFSIZ]; + + register char *aword = wordbuf; + + register char *cp; + + + + Stype = type; Sgoal = goal; + + if (type == ZGOTO) + + bseek(0l); + + do { + + if (intty && fseekp == feobp) + + printf("? "), flush(); + + aword[0] = 0, getword(aword); + + switch (srchx(aword)) { + + + + case ZELSE: + + if (level == 0 && type == ZIF) + + return; + + break; + + + + case ZIF: + + while (getword(aword)) + + continue; + + if ((type == ZIF || type == ZELSE) && eq(aword, "then")) + + level++; + + break; + + + + case ZENDIF: + + if (type == ZIF || type == ZELSE) + + level--; + + break; + + + + case ZFOREACH: + + case ZWHILE: + + if (type == ZBREAK) + + level++; + + break; + + + + case ZEND: + + if (type == ZBREAK) + + level--; + + break; + + + + case ZSWITCH: + + if (type == ZSWITCH || type == ZBRKSW) + + level++; + + break; + + + + case ZENDSW: + + if (type == ZSWITCH || type == ZBRKSW) + + level--; + + break; + + + + case ZLABEL: + + if (type == ZGOTO && getword(aword) && eq(aword, goal)) + + level = -1; + + break; + + + + default: + + if (type != ZGOTO && (type != ZSWITCH || level != 0)) + + break; + + if (lastchr(aword) != ':') + + break; + + aword[strlen(aword) - 1] = 0; + + if (type == ZGOTO && eq(aword, goal) || type == ZSWITCH && eq(aword, "default")) + + level = -1; + + break; + + + + case ZCASE: + + if (type != ZSWITCH || level != 0) + + break; + + getword(aword); + + if (lastchr(aword) == ':') + + aword[strlen(aword) - 1] = 0; + + cp = strip(Dfix1(aword)); + + if (Gmatch(goal, cp)) + + level = -1; + + xfree(cp); + + break; + + + + case ZDEFAULT: + + if (type == ZSWITCH && level == 0) + + level = -1; + + break; + + } - getword(0); +++ getword(NOSTR); + + } while (level >= 0); + +} + + + +getword(wp) + + register char *wp; + +{ + + register int found = 0; + + register int c, d; + + + + c = readc(1); + + d = 0; + + do { + + while (c == ' ' || c == '\t') + + c = readc(1); + + if (c < 0) + + goto past; + + if (c == '\n') { + + if (wp) + + break; + + return (0); + + } + + unreadc(c); + + found = 1; + + do { + + c = readc(1); + + if (c == '\\' && (c = readc(1)) == '\n') + + c = ' '; + + if (any(c, "'\"")) + + if (d == 0) + + d = c; + + else if (d == c) + + d = 0; + + if (c < 0) + + goto past; + + if (wp) + + *wp++ = c; + + } while ((d || c != ' ' && c != '\t') && c != '\n'); + + } while (wp == 0); + + unreadc(c); + + if (found) + + *--wp = 0; + + return (found); + + + +past: + + switch (Stype) { + + + + case ZIF: + + bferr("then/endif not found"); + + + + case ZELSE: + + bferr("endif not found"); + + + + case ZBRKSW: + + case ZSWITCH: + + bferr("endsw not found"); + + + + case ZBREAK: + + bferr("end not found"); + + + + case ZGOTO: + + setname(Sgoal); + + bferr("label not found"); + + } + + /*NOTREACHED*/ + +} + + + +toend() + +{ + + + + if (whyles->w_end == 0) { + + search(ZBREAK, 0); + + whyles->w_end = btell() - 1; + + } else + + bseek(whyles->w_end); + + wfree(); + +} + + + +wfree() + +{ + + long o = btell(); + + + + while (whyles) { + + register struct whyle *wp = whyles; + + register struct whyle *nwp = wp->w_next; + + + + if (o >= wp->w_start && (wp->w_end == 0 || o < wp->w_end)) + + break; + + if (wp->w_fe0) + + blkfree(wp->w_fe0); + + if (wp->w_fename) + + xfree(wp->w_fename); - xfree(wp); +++ xfree((char *)wp); + + whyles = nwp; + + } + +} + + + +doecho(v) + + char **v; + +{ + + + + echo(' ', v); + +} + + + +doglob(v) + + char **v; + +{ + + + + echo(0, v); + + flush(); + +} + + + +echo(sep, v) + + char sep; + + register char **v; + +{ + + register char *cp; - int (*saveintr)(); - if (setintr) - saveintr = signal(SIGINT, pintr); +++ int nonl = 0; + + +++ if (setintr) +++ sigrelse(SIGINT); + + v++; + + if (*v == 0) + + return; + + gflag = 0; rscan(v, tglob); + + if (gflag) { + + v = glob(v); + + if (v == 0) + + bferr("No match"); + + } else + + scan(v, trim); +++ if (sep == ' ' && !strcmp(*v, "-n")) +++ nonl++, v++; + + while (cp = *v++) { + + register int c; + + - while (c = *cp++) { - if (sep == ' ' && *cp && c == '\\') { - c = *cp++; - if (c == 'c') { - flush(); - return; - } else if (c == 'n') - c = '\n'; - else - putchar('\\'); - } +++ while (c = *cp++) + + putchar(c | QUOTE); - } + + if (*v) + + putchar(sep | QUOTE); + + } - if (sep) +++ if (sep && nonl == 0) + + putchar('\n'); +++ else +++ flush(); + + if (setintr) - signal(SIGINT, saveintr); +++ sighold(SIGINT); + + if (gargv) + + blkfree(gargv), gargv = 0; + +} + + - #ifndef V6 + +char **environ; + + + +dosetenv(v) + + register char **v; + +{ + + char *lp = globone(v[2]); + + + + setenv(v[1], lp); +++ if (eq(v[1], "PATH")) { +++ importpath(lp); +++ dohash(); +++ } + + xfree(lp); + +} + + +++dounsetenv(v) +++ register char **v; +++{ +++ +++ v++; +++ do +++ unsetenv(*v++); +++ while (*v); +++} +++ + +setenv(name, value) + + char *name, *value; + +{ + + register char **ep = environ; + + register char *cp, *dp; + + char *blk[2], **oep = ep; + + + + for (; *ep; ep++) { + + for (cp = name, dp = *ep; *cp && *cp == *dp; cp++, dp++) + + continue; + + if (*cp != 0 || *dp != '=') + + continue; + + cp = strspl("=", value); + + xfree(*ep); + + *ep = strspl(name, cp); + + xfree(cp); + + scan(ep, trim); + + return; + + } + + blk[0] = strspl(name, "="); blk[1] = 0; + + environ = blkspl(environ, blk); - xfree(oep); +++ xfree((char *)oep); + + setenv(name, value); + +} + + +++unsetenv(name) +++ char *name; +++{ +++ register char **ep = environ; +++ register char *cp, *dp; +++ char **oep = ep; +++ +++ for (; *ep; ep++) { +++ for (cp = name, dp = *ep; *cp && *cp == *dp; cp++, dp++) +++ continue; +++ if (*cp != 0 || *dp != '=') +++ continue; +++ cp = *ep; +++ *ep = 0; +++ environ = blkspl(environ, ep+1); +++ *ep = cp; +++ xfree(cp); +++ xfree((char *)oep); +++ return; +++ } +++} +++ + +doumask(v) + + register char **v; + +{ + + register char *cp = v[1]; + + register int i; + + + + if (cp == 0) { + + i = umask(0); + + umask(i); + + printf("%o\n", i); + + return; + + } + + i = 0; + + while (digit(*cp) && *cp != '8' && *cp != '9') + + i = i * 8 + *cp++ - '0'; + + if (*cp || i < 0 || i > 0777) + + bferr("Improper mask"); + + umask(i); + +} - #endif +++ +++#include +++ +++struct limits { +++ int limconst; +++ char *limname; +++ int limdiv; +++ char *limscale; +++} limits[] = { +++ LIM_NORAISE, "noraise", 1, "", +++ LIM_CPU, "cputime", 1, "seconds", +++ LIM_FSIZE, "filesize", 1024, "kbytes", +++ LIM_DATA, "datasize", 1024, "kbytes", +++ LIM_STACK, "stacksize", 1024, "kbytes", +++ LIM_CORE, "coredumpsize", 1024, "kbytes", +++ -1, 0, +++}; +++ +++struct limits * +++findlim(cp) +++ char *cp; +++{ +++ register struct limits *lp, *res; +++ +++ res = 0; +++ for (lp = limits; lp->limconst >= 0; lp++) +++ if (prefix(cp, lp->limname)) { +++ if (res) +++ bferr("Ambiguous"); +++ res = lp; +++ } +++ if (res) +++ return (res); +++ bferr("No such limit"); +++} +++ +++dolimit(v) +++ register char **v; +++{ +++ register struct limits *lp; +++ register int limit; +++ +++ v++; +++ if (*v == 0) { +++ for (lp = limits+1; lp->limconst >= 0; lp++) +++ plim(lp); +++ if (vlimit(LIM_NORAISE, -1) && getuid()) +++ printf("Limits cannot be raised\n"); +++ return; +++ } +++ lp = findlim(v[0]); +++ if (v[1] == 0) { +++ plim(lp); +++ return; +++ } +++ limit = getval(lp, v+1); +++ setlim(lp, limit); +++} +++ +++getval(lp, v) +++ register struct limits *lp; +++ char **v; +++{ +++ register float f; +++ double atof(); +++ char *cp = *v++; +++ +++ f = atof(cp); +++ while (digit(*cp) || *cp == '.' || *cp == 'e' || *cp == 'E') +++ cp++; +++ if (*cp == 0) { +++ if (*v == 0) +++ return ((int)(f+0.5) * lp->limdiv); +++ cp = *v; +++ } +++ if (lp->limconst == LIM_NORAISE) +++ goto badscal; +++ switch (*cp) { +++ +++ case ':': +++ if (lp->limconst != LIM_CPU) +++ goto badscal; +++ return ((int)(f * 60.0 + atof(cp+1))); +++ +++ case 'h': +++ if (lp->limconst != LIM_CPU) +++ goto badscal; +++ limtail(cp, "hours"); +++ f *= 3600.; +++ break; +++ +++ case 'm': +++ if (lp->limconst == LIM_CPU) { +++ limtail(cp, "minutes"); +++ f *= 60.; +++ break; +++ } +++ case 'M': +++ if (lp->limconst == LIM_CPU) +++ goto badscal; +++ *cp = 'm'; +++ limtail(cp, "megabytes"); +++ f *= 1024.*1024.; +++ break; +++ +++ case 's': +++ if (lp->limconst != LIM_CPU) +++ goto badscal; +++ limtail(cp, "seconds"); +++ break; +++ +++ case 'k': +++ if (lp->limconst == LIM_CPU) +++ goto badscal; +++ limtail(cp, "kbytes"); +++ f *= 1024; +++ break; +++ +++ case 'u': +++ limtail(cp, "unlimited"); +++ return (INFINITY); +++ +++ default: +++badscal: +++ bferr("Improper or unknown scale factor"); +++ } +++ return ((int)(f+0.5)); +++} +++ +++limtail(cp, str0) +++ char *cp, *str0; +++{ +++ register char *str = str0; +++ +++ while (*cp && *cp == *str) +++ cp++, str++; +++ if (*cp) +++ error("Bad scaling; did you mean ``%s''?", str0); +++} +++ +++plim(lp) +++ register struct limits *lp; +++{ +++ register int lim; +++ +++ printf("%s \t", lp->limname); +++ lim = vlimit(lp->limconst, -1); +++ if (lim == INFINITY) +++ printf("unlimited"); +++ else if (lp->limconst == LIM_CPU) +++ psecs((long)lim); +++ else +++ printf("%d %s", lim / lp->limdiv, lp->limscale); +++ printf("\n"); +++} +++ +++dounlimit(v) +++ register char **v; +++{ +++ register struct limits *lp; +++ +++ v++; +++ if (*v == 0) { +++ for (lp = limits+1; lp->limconst >= 0; lp++) +++ setlim(lp, INFINITY); +++ return; +++ } +++ while (*v) { +++ lp = findlim(*v++); +++ setlim(lp, INFINITY); +++ } +++} +++ +++setlim(lp, limit) +++ register struct limits *lp; +++{ +++ +++ if (vlimit(lp->limconst, limit) < 0) +++ Perror(bname); +++} +++ +++dosuspend() +++{ +++ int old, ldisc; +++ short ctpgrp; +++ +++ if (loginsh) +++ error("Can't suspend a login shell (yet)"); +++ untty(); +++ old = sigsys(SIGTSTP, SIG_DFL); +++ kill(0, SIGTSTP); +++ /* the shell stops here */ +++ sigsys(SIGTSTP, old); +++ if (tpgrp != -1) { +++retry: +++ ioctl(FSHTTY, TIOCGPGRP, &ctpgrp); +++ if (ctpgrp != opgrp) { +++ old = sigsys(SIGTTIN, SIG_DFL); +++ kill(0, SIGTTIN); +++ sigsys(SIGTTIN, old); +++ goto retry; +++ } +++ ioctl(FSHTTY, TIOCSPGRP, &shpgrp); +++ setpgrp(0, shpgrp); +++ } +++ ioctl(FSHTTY, TIOCGETD, &oldisc); +++ if (oldisc != NTTYDISC) { +++ printf("Switching to new tty driver...\n"); +++ ldisc = NTTYDISC; +++ ioctl(FSHTTY, TIOCSETD, &ldisc); +++ } +++} +++ +++doeval(v) +++ char **v; +++{ +++ char **oevalvec = evalvec; +++ char *oevalp = evalp; +++ jmp_buf osetexit; +++ int reenter; +++ char **gv = 0; +++ +++ v++; +++ if (*v == 0) +++ return; +++ gflag = 0; rscan(v, tglob); +++ if (gflag) { +++ gv = v = glob(v); +++ gargv = 0; +++ if (v == 0) +++ error("No match"); +++ v = copyblk(v); +++ } else +++ scan(v, trim); +++ getexit(osetexit); +++ reenter = 0; +++ setexit(); +++ reenter++; +++ if (reenter == 1) { +++ evalvec = v; +++ evalp = 0; +++ process(0); +++ } +++ evalvec = oevalvec; +++ evalp = oevalp; +++ doneinp = 0; +++ if (gv) +++ blkfree(gv); +++ resexit(osetexit); +++ if (reenter >= 2) +++ error(NOSTR); +++} diff --cc usr/src/cmd/csh/sh.glob.c index 0000000000,04306b25d4,0000000000..03ea8c7c7e mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.glob.c +++ b/usr/src/cmd/csh/sh.glob.c @@@@ -1,0 -1,726 -1,0 +1,758 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.glob.c 4.1 10/9/80"; + +#include "sh.h" + + + +/* + + * C Shell + + */ + + + +int globcnt; + + + +char *globchars = "`{[*?"; + + + +char *gpath, *gpathp, *lastgpathp; + +int globbed; + +bool noglob; + +bool nonomatch; + +char *entp; + +char **sortbas; + + + +char ** + +glob(v) + + register char **v; + +{ - char agpath[160]; +++ char agpath[BUFSIZ]; + + char *agargv[GAVSIZ]; + + + + gpath = agpath; gpathp = gpath; *gpathp = 0; + + lastgpathp = &gpath[sizeof agpath - 2]; + + ginit(agargv); globcnt = 0; + +#ifdef GDEBUG + + printf("glob entered: "); blkpr(v); printf("\n"); + +#endif + + noglob = adrof("noglob") != 0; + + nonomatch = adrof("nonomatch") != 0; + + globcnt = noglob | nonomatch; + + while (*v) + + collect(*v++); + +#ifdef GDEBUG + + printf("glob done, globcnt=%d, gflag=%d: ", globcnt, gflag); blkpr(gargv); printf("\n"); + +#endif + + if (globcnt == 0 && (gflag&1)) { + + blkfree(gargv), gargv = 0; + + return (0); + + } else + + return (gargv = copyblk(gargv)); + +} + + + +ginit(agargv) + + char **agargv; + +{ + + + + agargv[0] = 0; gargv = agargv; sortbas = agargv; gargc = 0; + + gnleft = NCARGS - 4; + +} + + + +collect(as) + + register char *as; + +{ + + register int i; + + + + if (any('`', as)) { + +#ifdef GDEBUG + + printf("doing backp of %s\n", as); + +#endif + + dobackp(as, 0); + +#ifdef GDEBUG + + printf("backp done, acollect'ing\n"); + +#endif + + for (i = 0; i < pargc; i++) + + if (noglob) + + Gcat(pargv[i], ""); + + else + + acollect(pargv[i]); + + if (pargv) + + blkfree(pargv), pargv = 0; + +#ifdef GDEBUG + + printf("acollect done\n"); + +#endif + + } else if (noglob) + + Gcat(as, ""); + + else + + acollect(as); + +} + + + +acollect(as) + + register char *as; + +{ + + register int ogargc = gargc; + + + + gpathp = gpath; *gpathp = 0; globbed = 0; + + expand(as); + + if (gargc == ogargc) { - if (nonomatch) +++ if (nonomatch) { + + Gcat(as, ""); +++ sort(); +++ } + + } else + + sort(); + +} + + + +sort() + +{ + + register char **p1, **p2, *c; + + char **Gvp = &gargv[gargc]; + + + + p1 = sortbas; + + while (p1 < Gvp-1) { + + p2 = p1; + + while (++p2 < Gvp) + + if (strcmp(*p1, *p2) > 0) + + c = *p1, *p1 = *p2, *p2 = c; + + p1++; + + } + + sortbas = Gvp; + +} + + + +expand(as) + + char *as; + +{ + + register char *cs; + + register char *sgpathp, *oldcs; + + struct stat stb; + + + + sgpathp = gpathp; + + cs = as; + + if (*cs == '~' && gpathp == gpath) { + + addpath('~'); + + for (cs++; letter(*cs) || digit(*cs) || *cs == '-';) + + addpath(*cs++); + + if (!*cs || *cs == '/') { + + if (gpathp != gpath + 1) { + + *gpathp = 0; + + if (gethdir(gpath + 1)) + + error("Unknown user: %s", gpath + 1); + + strcpy(gpath, gpath + 1); + + } else + + strcpy(gpath, value("home")); + + gpathp = strend(gpath); + + } + + } + + while (!any(*cs, globchars)) { + + if (*cs == 0) { + + if (!globbed) + + Gcat(gpath, ""); + + else if (stat(gpath, &stb) >= 0) { + + Gcat(gpath, ""); + + globcnt++; + + } + + goto endit; + + } + + addpath(*cs++); + + } + + oldcs = cs; + + while (cs > as && *cs != '/') + + cs--, gpathp--; + + if (*cs == '/') + + cs++, gpathp++; + + *gpathp = 0; + + if (*oldcs == '{') { - execbrc(cs, 0); +++ execbrc(cs, NOSTR); + + return; + + } + + matchdir(cs); + +endit: + + gpathp = sgpathp; + + *gpathp = 0; + +} + + + +matchdir(pattern) + + char *pattern; + +{ + + struct stat stb; + + struct direct dirbuf[BUFSIZ / sizeof (struct direct)]; + + char d_name[DIRSIZ+1]; + + register int dirf, cnt; + + + + dirf = open(gpath, 0); + + if (dirf < 0) { + + if (globbed) + + return; + + goto patherr; + + } + + if (fstat(dirf, &stb) < 0) + + goto patherr; + + if (!isdir(stb)) { + + errno = ENOTDIR; + + goto patherr; + + } + + while ((cnt = read(dirf, (char *) dirbuf, sizeof dirbuf)) >= sizeof dirbuf[0]) { + + register struct direct *ep = dirbuf; + + + + for (cnt /= sizeof (struct direct); cnt > 0; cnt--, ep++) { + + if (ep->d_ino == 0) + + continue; + + copdent(d_name, ep->d_name); + + if (match(d_name, pattern)) { + + Gcat(gpath, d_name); + + globcnt++; + + } + + } + + } + + close(dirf); + + return; + + + +patherr: + + Perror(gpath); + +} + + + +copdent(to, from) + + register char *to, *from; + +{ + + register int cnt = DIRSIZ; + + + + do + + *to++ = *from++; + + while (--cnt); + + *to = 0; + +} + + + +execbrc(p, s) + + char *p, *s; + +{ + + char restbuf[BUFSIZ + 2]; + + register char *pe, *pm, *pl; + + int brclev = 0; + + char *lm, savec, *sgpathp; + + + + for (lm = restbuf; *p != '{'; *lm++ = *p++) + + continue; + + for (pe = ++p; *pe; pe++) + + switch (*pe) { + + + + case '{': + + brclev++; + + continue; +++ + + case '}': + + if (brclev == 0) + + goto pend; + + brclev--; + + continue; +++ + + case '[': + + for (pe++; *pe && *pe != ']'; pe++) + + continue; + + if (!*pe) + + error("Missing ]"); + + continue; - + + } + +pend: + + if (brclev || !*pe) + + error("Missing }"); + + for (pl = pm = p; pm <= pe; pm++) - switch (*pm) { +++ switch (*pm & (QUOTE|TRIM)) { + + + + case '{': + + brclev++; + + continue; +++ + + case '}': + + if (brclev) { + + brclev--; + + continue; + + } + + goto doit; +++ +++ case ','|QUOTE: + + case ',': + + if (brclev) + + continue; + +doit: + + savec = *pm; + + *pm = 0; + + strcpy(lm, pl); + + strcat(restbuf, pe + 1); + + *pm = savec; + + if (s == 0) { + + sgpathp = gpathp; + + expand(restbuf); + + gpathp = sgpathp; + + *gpathp = 0; + + } else if (amatch(s, restbuf)) + + return (1); + + sort(); + + pl = pm + 1; + + continue; +++ + + case '[': + + for (pm++; *pm && *pm != ']'; pm++) + + continue; + + if (!*pm) + + error("Missing ]"); + + continue; + + } + + return (0); + +} + + + +match(s, p) + + char *s, *p; + +{ + + register int c; + + register char *sentp; + + char sglobbed = globbed; + + + + if (*s == '.' && *p != '.') + + return (0); + + sentp = entp; + + entp = s; + + c = amatch(s, p); + + entp = sentp; + + globbed = sglobbed; + + return (c); + +} + + + +amatch(s, p) + + register char *s, *p; + +{ + + register int scc; + + int ok, lc; + + char *sgpathp; + + struct stat stb; + + int c, cc; + + + + globbed = 1; + + for (;;) { + + scc = *s++ & TRIM; + + switch (c = *p++) { + + + + case '{': + + return (execbrc(p - 1, s - 1)); + + + + case '[': + + ok = 0; + + lc = 077777; + + while (cc = *p++) { + + if (cc == ']') { + + if (ok) + + break; + + return (0); + + } + + if (cc == '-') { + + if (lc <= scc && scc <= *p++) + + ok++; + + } else + + if (scc == (lc = cc)) + + ok++; + + } + + if (cc == 0) + + error("Missing ]"); + + continue; + + + + case '*': + + if (!*p) + + return (1); + + if (*p == '/') { + + p++; + + goto slash; + + } + + for (s--; *s; s++) + + if (amatch(s, p)) + + return (1); + + return (0); + + + + case 0: + + return (scc == 0); + + + + default: + + if (c != scc) + + return (0); + + continue; + + + + case '?': + + if (scc == 0) + + return (0); + + continue; + + + + case '/': + + if (scc) + + return (0); + +slash: + + s = entp; + + sgpathp = gpathp; + + while (*s) + + addpath(*s++); + + addpath('/'); + + if (stat(gpath, &stb) == 0 && isdir(stb)) + + if (*p == 0) { + + Gcat(gpath, ""); + + globcnt++; + + } else + + expand(p); + + gpathp = sgpathp; + + *gpathp = 0; + + return (0); + + } + + } + +} + + + +Gmatch(s, p) + + register char *s, *p; + +{ + + register int scc; + + int ok, lc; + + int c, cc; + + + + for (;;) { + + scc = *s++ & TRIM; + + switch (c = *p++) { + + + + case '[': + + ok = 0; + + lc = 077777; + + while (cc = *p++) { + + if (cc == ']') { + + if (ok) + + break; + + return (0); + + } + + if (cc == '-') { + + if (lc <= scc && scc <= *p++) + + ok++; + + } else + + if (scc == (lc = cc)) + + ok++; + + } + + if (cc == 0) + + bferr("Missing ]"); + + continue; + + + + case '*': + + if (!*p) + + return (1); + + for (s--; *s; s++) + + if (Gmatch(s, p)) + + return (1); + + return (0); + + + + case 0: + + return (scc == 0); + + + + default: + + if ((c & TRIM) != scc) + + return (0); + + continue; + + + + case '?': + + if (scc == 0) + + return (0); + + continue; + + + + } + + } + +} + + + +Gcat(s1, s2) + + register char *s1, *s2; + +{ + + + + gnleft -= strlen(s1) + strlen(s2) + 1; + + if (gnleft <= 0 || ++gargc >= GAVSIZ) + + error("Arguments too long"); + + gargv[gargc] = 0; + + gargv[gargc - 1] = strspl(s1, s2); + +} + + + +addpath(c) + + char c; + +{ + + + + if (gpathp >= lastgpathp) + + error("Pathname too long"); + + *gpathp++ = c; + + *gpathp = 0; + +} + + + +rscan(t, f) + + register char **t; + + int (*f)(); + +{ + + register char *p, c; + + + + while (p = *t++) { + + if (f == tglob) + + if (*p == '~') + + gflag |= 2; + + else if (eq(p, "{") || eq(p, "{}")) + + continue; + + while (c = *p++) + + (*f)(c); + + } + +} + + + +scan(t, f) + + register char **t; + + int (*f)(); + +{ + + register char *p, c; + + + + while (p = *t++) + + while (c = *p) + + *p++ = (*f)(c); + +} + + + +tglob(c) + + register char c; + +{ + + + + if (any(c, globchars)) + + gflag |= c == '{' ? 2 : 1; + + return (c); + +} + + + +trim(c) + + char c; + +{ + + + + return (c & TRIM); + +} + + +++tback(c) +++ char c; +++{ +++ +++ if (c == '`') +++ gflag = 1; +++} +++ + +char * + +globone(str) + + register char *str; + +{ + + char *gv[2]; + + register char **gvp; + + register char *cp; + + + + gv[0] = str; + + gv[1] = 0; + + gflag = 0; + + rscan(gv, tglob); + + if (gflag) { + + gvp = glob(gv); + + if (gvp == 0) { + + setname(str); + + bferr("No match"); + + } + + cp = *gvp++; + + if (cp == 0) + + cp = ""; + + else if (*gvp) { + + setname(str); + + bferr("Ambiguous"); - } +++ } else +++ cp = strip(cp); + +/* + + if (cp == 0 || *gvp) { + + setname(str); + + bferr(cp ? "Ambiguous" : "No output"); + + } + +*/ - xfree(gargv); gargv = 0; +++ xfree((char *)gargv); gargv = 0; + + } else { + + scan(gv, trim); + + cp = savestr(gv[0]); + + } + + return (cp); + +} + + + +/* + + * Command substitute cp. If literal, then this is + + * a substitution from a << redirection, and so we should + + * not crunch blanks and tabs, separating words only at newlines. + + */ + +char ** + +dobackp(cp, literal) + + char *cp; + + bool literal; + +{ + + register char *lp, *rp; + + char *ep; + + char word[BUFSIZ]; + + char *apargv[GAVSIZ + 2]; + + + + if (pargv) { + + abort(); + + blkfree(pargv); + + } + + pargv = apargv; + + pargv[0] = NOSTR; + + pargcp = pargs = word; + + pargc = 0; + + pnleft = BUFSIZ - 4; + + for (;;) { + + for (lp = cp; *lp != '`'; lp++) { + + if (*lp == 0) { + + if (pargcp != pargs) + + pword(); + +#ifdef GDEBUG + + printf("leaving dobackp\n"); + +#endif + + return (pargv = copyblk(pargv)); + + } + + psave(*lp); + + } + + lp++; + + for (rp = lp; *rp && *rp != '`'; rp++) + + if (*rp == '\\') { + + rp++; + + if (!*rp) + + goto oops; + + } + + if (!*rp) + +oops: + + error("Unmatched `"); + + ep = savestr(lp); + + ep[rp - lp] = 0; + + backeval(ep, literal); + +#ifdef GDEBUG + + printf("back from backeval\n"); + +#endif + + cp = rp + 1; + + } + +} + + + +backeval(cp, literal) + + char *cp; + + bool literal; + +{ - int pvec[2], pid; +++ int pvec[2]; + + int quoted = (literal || (cp[0] & QUOTE)) ? QUOTE : 0; - int (*oldint)(); + + char ibuf[BUFSIZ]; + + register int icnt = 0, c; + + register char *ip; + + bool hadnl = 0; - - oldint = signal(SIGINT, SIG_IGN); +++ char *fakecom[2]; +++ struct command faket; +++ +++ faket.t_dtyp = TCOM; +++ faket.t_dflg = 0; +++ faket.t_dlef = 0; +++ faket.t_drit = 0; +++ faket.t_dspr = 0; +++ faket.t_dcom = fakecom; +++ fakecom[0] = "` ... `"; +++ fakecom[1] = 0; +++ /* +++ * We do the psave job to temporarily change the current job +++ * so that the following fork is considered a separate job. +++ * This is so that when backquotes are used in a +++ * builtin function that calls glob the "current job" is not corrupted. +++ * We only need one level of pushed jobs as long as we are sure to +++ * fork here. +++ */ +++ psavejob(); +++ /* +++ * It would be nicer if we could integrate this redirection more +++ * with the routines in sh.sem.c by doing a fake execute on a builtin +++ * function that was piped out. +++ */ + + mypipe(pvec); - pid = fork(); - if (pid < 0) - bferr("No more processes"); - if (pid == 0) { +++ if (pfork(&faket, -1) == 0) { + + struct wordent paraml; + + struct command *t; + + - child++; - signal(SIGINT, oldint); + + close(pvec[0]); + + dmove(pvec[1], 1); + + dmove(SHDIAG, 2); + + initdesc(); + + arginp = cp; + + while (*cp) + + *cp++ &= TRIM; + + lex(¶ml); + + if (err) + + error(err); + + alias(¶ml); - t = syntax(paraml.next, ¶ml); +++ t = syntax(paraml.next, ¶ml, 0); + + if (err) + + error(err); + + if (t) + + t->t_dflg |= FPAR; - execute(t); +++ execute(t, -1); + + exitstat(); + + } - cadd(pid, "``"); + + xfree(cp); - signal(SIGINT, oldint); + + close(pvec[1]); + + do { + + int cnt = 0; + + for (;;) { + + if (icnt == 0) { + + ip = ibuf; + + icnt = read(pvec[0], ip, BUFSIZ); + + if (icnt <= 0) { + + c = -1; + + break; + + } + + } + + if (hadnl) + + break; + + --icnt; + + c = (*ip++ & TRIM); + + if (c == 0) + + break; + + if (c == '\n') { + + /* + + * Continue around the loop one + + * more time, so that we can eat + + * the last newline without terminating + + * this word. + + */ + + hadnl = 1; + + continue; + + } + + if (!quoted && (c == ' ' || c == '\t')) + + break; + + cnt++; + + psave(c | quoted); + + } + + /* + + * Unless at end-of-file, we will form a new word + + * here if there were characters in the word, or in + + * any case when we take text literally. If + + * we didn't make empty words here when literal was + + * set then we would lose blank lines. + + */ + + if (c != -1 && (cnt || literal)) + + pword(); + + hadnl = 0; + + } while (c >= 0); + +#ifdef GDEBUG + + printf("done in backeval, pvec: %d %d\n", pvec[0], pvec[1]); + + printf("also c = %c <%o>\n", c, c); + +#endif + + close(pvec[0]); - pwait(pid); +++ pwait(); +++ prestjob(); + +} + + + +psave(c) + + char c; + +{ + + + + if (--pnleft <= 0) + + error("Word too long"); + + *pargcp++ = c; + +} + + + +pword() + +{ + + + + psave(0); + + if (pargc == GAVSIZ) + + error("Too many words from ``"); + + pargv[pargc++] = savestr(pargs); + + pargv[pargc] = NOSTR; + +#ifdef GDEBUG + + printf("got word %s\n", pargv[pargc-1]); + +#endif + + pargcp = pargs; + + pnleft = BUFSIZ - 4; + +} diff --cc usr/src/cmd/csh/sh.hist.c index 0000000000,f3e40e911b,0000000000..eed9d9049a mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.hist.c +++ b/usr/src/cmd/csh/sh.hist.c @@@@ -1,0 -1,93 -1,0 +1,118 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.hist.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C shell + + */ + + + +savehist(sp) + + struct wordent *sp; + +{ + + register struct Hist *hp, *np; + + int histlen; + + register char *cp; + + + + cp = value("history"); + + if (*cp == 0) + + histlen = 0; + + else { + + while (*cp && digit(*cp)) + + cp++; + + /* avoid a looping snafu */ + + if (*cp) + + set("history", "10"); + + histlen = getn(value("history")); + + } + + /* throw away null lines */ + + if (sp->next->word[0] == '\n') + + return; + + for (hp = &Histlist; np = hp->Hnext;) + + if (eventno - np->Href >= histlen || histlen == 0) + + hp->Hnext = np->Hnext, hfree(np); + + else + + hp = np; + + enthist(++eventno, sp, 1); + +} + + + +struct Hist * + +enthist(event, lp, docopy) + + int event; + + register struct wordent *lp; + + bool docopy; + +{ + + register struct Hist *np; + + + + np = (struct Hist *) calloc(1, sizeof *np); + + np->Hnum = np->Href = event; + + if (docopy) + + copylex(&np->Hlex, lp); + + else { + + np->Hlex.next = lp->next; + + lp->next->prev = &np->Hlex; + + np->Hlex.prev = lp->prev; + + lp->prev->next = &np->Hlex; + + } + + np->Hnext = Histlist.Hnext; + + Histlist.Hnext = np; + + return (np); + +} + + + +hfree(hp) + + register struct Hist *hp; + +{ + + + + freelex(&hp->Hlex); - xfree(hp); +++ xfree((char *)hp); + +} + + - dohist() +++dohist(vp) +++ char **vp; + +{ +++ int n, rflg = 0; + + + + if (getn(value("history")) == 0) + + return; - dohist1(Histlist.Hnext); +++ if (setintr) +++ sigrelse(SIGINT); +++ vp++; +++ if (*vp && eq(*vp, "-r")) { +++ rflg++; +++ vp++; +++ } +++ if (*vp) +++ n = getn(*vp); +++ else +++ n = 1000; +++ dohist1(Histlist.Hnext, &n, rflg); + +} + + - dohist1(hp) - register struct Hist *hp; +++dohist1(hp, np, rflg) +++ struct Hist *hp; +++ int *np; + +{ - +++ bool print = (*np) > 0; +++top: + + if (hp == 0) + + return; +++ (*np)--; + + hp->Href++; - dohist1(hp->Hnext); - phist(hp); +++ if (rflg == 0) { +++ dohist1(hp->Hnext, np, rflg); +++ if (print) +++ phist(hp); +++ return; +++ } +++ if (*np >= 0) +++ phist(hp); +++ hp = hp->Hnext; +++ goto top; + +} + + + +phist(hp) + + register struct Hist *hp; + +{ + + + + printf("%6d\t", hp->Hnum); + + prlex(&hp->Hlex); + +} diff --cc usr/src/cmd/csh/sh.init.c index 0000000000,fbe00df99b,0000000000..fbb237302d mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.init.c +++ b/usr/src/cmd/csh/sh.init.c @@@@ -1,0 -1,172 -1,0 +1,229 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.init.c 4.1 10/9/80"; +++ + +#include "sh.local.h" +++ + +/* + + * C shell + + */ + + - extern int await(); - extern int chngd(); + +extern int doalias(); +++extern int dobg(); + +extern int dobreak(); +++extern int dochngd(); + +extern int docontin(); +++extern int dodirs(); + +extern int doecho(); + +extern int doelse(); + +extern int doend(); + +extern int doendif(); + +extern int doendsw(); +++extern int doeval(); + +extern int doexit(); +++extern int dofg(); + +extern int doforeach(); + +extern int doglob(); + +extern int dogoto(); + +extern int dohash(); - extern int hashstat(); + +extern int dohist(); + +extern int doif(); +++extern int dojobs(); +++extern int dokill(); + +extern int dolet(); +++extern int dolimit(); + +extern int dologin(); + +extern int dologout(); + +extern int donewgrp(); + +extern int donice(); +++extern int donotify(); + +extern int donohup(); + +extern int doonintr(); +++extern int dopopd(); +++extern int dopushd(); + +extern int dorepeat(); + +extern int doset(); + +extern int dosetenv(); + +extern int dosource(); +++extern int dostop(); +++extern int dosuspend(); + +extern int doswbrk(); + +extern int doswitch(); + +extern int dotime(); - #ifndef V6 +++extern int dounlimit(); + +extern int doumask(); - #endif +++extern int dowait(); + +extern int dowhile(); + +extern int dozip(); + +extern int execash(); + +extern int goodbye(); +++#ifdef VFORK +++extern int hashstat(); +++#endif + +extern int shift(); + +extern int showall(); + +extern int unalias(); + +extern int dounhash(); + +extern int unset(); +++extern int dounsetenv(); + + - #define INF 1000 +++#define INF 1000 + + + +struct biltins { + + char *bname; + + int (*bfunct)(); + + short minargs, maxargs; + +} bfunc[] = { + + "@", dolet, 0, INF, + + "alias", doalias, 0, INF, + +#ifdef debug + + "alloc", showall, 0, 1, + +#endif +++ "bg", dobg, 0, INF, + + "break", dobreak, 0, 0, + + "breaksw", doswbrk, 0, 0, +++#ifdef IIASA +++ "bye", goodbye, 0, 0, +++#endif + + "case", dozip, 0, 1, - "cd", chngd, 0, 1, - "chdir", chngd, 0, 1, +++ "cd", dochngd, 0, 1, +++ "chdir", dochngd, 0, 1, + + "continue", docontin, 0, 0, + + "default", dozip, 0, 0, +++ "dirs", dodirs, 0, 1, + + "echo", doecho, 0, INF, + + "else", doelse, 0, INF, + + "end", doend, 0, 0, + + "endif", dozip, 0, 0, + + "endsw", dozip, 0, 0, +++ "eval", doeval, 0, INF, + + "exec", execash, 1, INF, + + "exit", doexit, 0, INF, +++ "fg", dofg, 0, INF, + + "foreach", doforeach, 3, INF, +++#ifdef IIASA +++ "gd", dopushd, 0, 1, +++#endif + + "glob", doglob, 0, INF, + + "goto", dogoto, 1, 1, +++#ifdef VFORK + + "hashstat", hashstat, 0, 0, - "history", dohist, 0, 0, +++#endif +++ "history", dohist, 0, 2, + + "if", doif, 1, INF, +++ "jobs", dojobs, 0, 1, +++ "kill", dokill, 1, INF, +++ "limit", dolimit, 0, 3, + + "login", dologin, 0, 1, + + "logout", dologout, 0, 0, + + "newgrp", donewgrp, 1, 1, + + "nice", donice, 0, INF, + + "nohup", donohup, 0, INF, +++ "notify", donotify, 0, INF, + + "onintr", doonintr, 0, 2, +++ "popd", dopopd, 0, 1, +++ "pushd", dopushd, 0, 1, +++#ifdef IIASA +++ "rd", dopopd, 0, 1, +++#endif + + "rehash", dohash, 0, 0, + + "repeat", dorepeat, 2, INF, + + "set", doset, 0, INF, - #ifndef V6 + + "setenv", dosetenv, 2, 2, - #endif + + "shift", shift, 0, 1, + + "source", dosource, 1, 1, +++ "stop", dostop, 1, INF, +++ "suspend", dosuspend, 0, 0, + + "switch", doswitch, 1, INF, + + "time", dotime, 0, INF, - #ifndef V6 + + "umask", doumask, 0, 1, - #endif + + "unalias", unalias, 1, INF, - "unhash", dounhash, 0, 0, +++ "unhash", dounhash, 0, 0, +++ "unlimit", dounlimit, 0, INF, + + "unset", unset, 1, INF, - "wait", await, 0, 0, +++ "unsetenv", dounsetenv, 1, INF, +++ "wait", dowait, 0, 0, + + "while", dowhile, 1, INF, + + 0, 0, 0, 0, + +}; + + + +#define ZBREAK 0 + +#define ZBRKSW 1 + +#define ZCASE 2 + +#define ZDEFAULT 3 + +#define ZELSE 4 + +#define ZEND 5 + +#define ZENDIF 6 + +#define ZENDSW 7 + +#define ZEXIT 8 + +#define ZFOREACH 9 + +#define ZGOTO 10 + +#define ZIF 11 + +#define ZLABEL 12 + +#define ZLET 13 + +#define ZSET 14 + +#define ZSWITCH 15 + +#define ZTEST 16 + +#define ZTHEN 17 + +#define ZWHILE 18 + + + +struct srch { + + char *s_name; + + short s_value; + +} srchn[] = { + + "@", ZLET, + + "break", ZBREAK, + + "breaksw", ZBRKSW, + + "case", ZCASE, + + "default", ZDEFAULT, + + "else", ZELSE, + + "end", ZEND, + + "endif", ZENDIF, + + "endsw", ZENDSW, + + "exit", ZEXIT, + + "foreach", ZFOREACH, + + "goto", ZGOTO, + + "if", ZIF, + + "label", ZLABEL, + + "set", ZSET, + + "switch", ZSWITCH, + + "while", ZWHILE, + + 0, 0, + +}; + + - char *mesg[] = { - 0, - "Hangup", - 0, - "Quit", - "Illegal instruction", - "Trace/BPT trap", - "IOT trap", - "EMT trap", - "Floating exception", - "Killed", - "Bus error", - "Segmentation violation", - "Bad system call", - 0, - "Alarm clock", - "Terminated", +++struct mesg { +++ char *iname; +++ char *pname; +++} mesg[] = { +++ 0, 0, +++ "HUP", "Hangup", +++ "INT", "Interrupt", +++ "QUIT", "Quit", +++ "ILL", "Illegal instruction", +++ "TRAP", "Trace/BPT trap", +++ "IOT", "IOT trap", +++ "EMT", "EMT trap", +++ "FPE", "Floating exception", +++ "KILL", "Killed", +++ "BUS", "Bus error", +++ "SEGV", "Segmentation fault", +++ "SYS", "Bad system call", +++ "PIPE", "Broken pipe", +++ "ALRM", "Alarm clock", +++ "TERM", "Terminated", +++ 0, "Signal 16", +++ "STOP", "Stopped (signal)", +++ "TSTP", "Stopped", +++ "CONT", "Continued", +++ "CHLD", "Child exited", +++ "TTIN", "Stopped (tty input)", +++ "TTOU", "Stopped (tty output)", +++ "TINT", "Tty input interrupt", +++ "XCPU", "Cputime limit exceeded", +++ "XFSZ", "Filesize limit exceeded", +++ 0, "Signal 26", +++ 0, "Signal 27", +++ 0, "Signal 28", +++ 0, "Signal 29", +++ 0, "Signal 30", +++ 0, "Signal 31", +++ 0, "Signal 32" + +}; diff --cc usr/src/cmd/csh/sh.lex.c index 0000000000,4b39f040d9,0000000000..70f17e53b0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.lex.c +++ b/usr/src/cmd/csh/sh.lex.c @@@@ -1,0 -1,1240 -1,0 +1,1296 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.lex.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C shell + + */ + + + +/* + + * These lexical routines read input and form lists of words. + + * There is some involved processing here, because of the complications + + * of input buffering, and especially because of history substitution. + + */ + + + +char *word(); + + + +/* + + * Peekc is a peek characer for getC, peekread for readc. + + * There is a subtlety here in many places... history routines + + * will read ahead and then insert stuff into the input stream. + + * If they push back a character then they must push it behind + + * the text substituted by the history substitution. On the other + + * hand in several places we need 2 peek characters. To make this + + * all work, the history routines read with getC, and make use both + + * of ungetC and unreadc. The key observation is that the state + + * of getC at the call of a history reference is such that calls + + * to getC from the history routines will always yield calls of + + * readc, unless this peeking is involved. That is to say that during + + * getexcl the variables lap, exclp, and exclnxt are all zero. + + * + + * Getdol invokes history substitution, hence the extra peek, peekd, + + * which it can ungetD to be before history substitutions. + + */ + +char peekc, peekd; + +char peekread; + + + +char *exclp; /* (Tail of) current word from ! subst */ + +struct wordent *exclnxt; /* The rest of the ! subst words */ + +int exclc; /* Count of remainig words in ! subst */ + +char *alvecp; /* "Globp" for alias resubstitution */ + + + +/* + + * Lex returns to its caller not only a wordlist (as a "var" parameter) + + * but also whether a history substitution occurred. This is used in + + * the main (process) routine to determine whether to echo, and also + + * when called by the alias routine to determine whether to keep the + + * argument list. + + */ + +bool hadhist; + + + +#define ungetC(c) peekc = c + +#define ungetD(c) peekd = c + + + +lex(hp) + + register struct wordent *hp; + +{ + + register struct wordent *wdp; + + int c; + + + + lineloc = btell(); + + hp->next = hp->prev = hp; + + hp->word = ""; + + alvecp = 0, hadhist = 0; + + do + + c = readc(0); + + while (c == ' ' || c == '\t'); - if (c == '^' && intty) +++ if (c == HISTSUB && intty) + + /* ^lef^rit from tty is short !:s^lef^rit */ + + getexcl(c); + + else + + unreadc(c); + + wdp = hp; + + /* + + * The following loop is written so that the links needed + + * by freelex will be ready and rarin to go even if it is + + * interrupted. + + */ + + do { + + register struct wordent *new = (struct wordent *) calloc(1, sizeof *wdp); + + + + new->prev = wdp; + + new->next = hp; + + wdp->next = new; + + wdp = new; + + wdp->word = word(); + + } while (wdp->word[0] != '\n'); + + hp->prev = wdp; + + return (hadhist); + +} + + + +prlex(sp0) + + struct wordent *sp0; + +{ + + register struct wordent *sp = sp0->next; + + + + for (;;) { + + printf("%s", sp->word); + + sp = sp->next; + + if (sp == sp0) + + break; + + printf(" "); + + } + +} + + + +copylex(hp, fp) + + register struct wordent *hp; + + struct wordent *fp; + +{ + + register struct wordent *wdp; + + + + wdp = hp; + + fp = fp->next; + + do { + + register struct wordent *new = (struct wordent *) calloc(1, sizeof *wdp); + + + + new->prev = wdp; + + new->next = hp; + + wdp->next = new; + + wdp = new; + + wdp->word = savestr(fp->word); + + fp = fp->next; + + } while (wdp->word[0] != '\n'); + + hp->prev = wdp; + +} + + + +freelex(vp) + + register struct wordent *vp; + +{ + + register struct wordent *fp; + + + + while (vp->next != vp) { + + fp = vp->next; + + vp->next = fp->next; + + xfree(fp->word); - xfree(fp); +++ xfree((char *)fp); + + } + + vp->prev = vp; + +} + + + +char *WORDMETA = "# '`\"\t;&<>()|\n"; + + + +char * + +word() + +{ + + register char c, c1; + + register char *wp; + + char wbuf[BUFSIZ]; + + register bool dolflg; + + register int i; + + + + wp = wbuf; + + i = BUFSIZ - 4; + +loop: + + c = getC(DOALL); + + switch (c) { + + + + case ' ': + + case '\t': + + goto loop; + + + + case '`': + + case '\'': + + case '"': + + *wp++ = c, --i, c1 = c; + + dolflg = c == '"' ? DOALL : DOEXCL; + + for (;;) { + + c = getC(dolflg); + + if (c == c1) + + break; + + if (c == '\n') { + + seterrc("Unmatched ", c1); + + ungetC(c); + + goto ret; + + } + + if (c == '\\') { + + c = getC(0); - if (c == '!') +++ if (c == HIST) + + c |= QUOTE; + + else { + + if (c == '\n' && c1 != '`') + + c |= QUOTE; + + ungetC(c), c = '\\'; + + } + + } + + if (--i <= 0) + + goto toochars; + + *wp++ = c; + + } + + *wp++ = c, --i; + + goto pack; + + + + case '&': + + case '|': + + case '<': + + case '>': + + *wp++ = c; + + c1 = getC(DOALL); + + if (c1 == c) + + *wp++ = c1; + + else + + ungetC(c1); + + goto ret; + + + + case '#': + + if (intty) + + break; + + if (wp != wbuf) { + + ungetC(c); + + goto ret; + + } + + c = 0; + + do { + + c1 = c; + + c = getC(0); + + } while (c != '\n'); + + if (c1 == '\\') + + goto loop; + + /* fall into ... */ + + + + case ';': + + case '(': + + case ')': + + case '\n': + + *wp++ = c; + + goto ret; + + + +casebksl: + + case '\\': + + c = getC(0); + + if (c == '\n') { + + if (onelflg == 1) + + onelflg = 2; + + goto loop; + + } - if (c != '!') +++ if (c != HIST) + + *wp++ = '\\', --i; + + c |= QUOTE; + + break; + + } + + ungetC(c); + +pack: + + for (;;) { + + c = getC(DOALL); + + if (c == '\\') { + + c = getC(0); + + if (c == '\n') { + + if (onelflg == 1) + + onelflg = 2; + + goto ret; + + } - if (c != '!') +++ if (c != HIST) + + *wp++ = '\\', --i; + + c |= QUOTE; + + } + + if (any(c, WORDMETA + intty)) { + + ungetC(c); + + if (any(c, "\"'`")) + + goto loop; + + goto ret; + + } + + if (--i <= 0) + + goto toochars; + + *wp++ = c; + + } + +toochars: + + seterr("Word too long"); + + wp = &wbuf[1]; + +ret: + + *wp = 0; + + return (savestr(wbuf)); + +} + + + +getC(flag) + + register int flag; + +{ + + register char c; + + + +top: + + if (c = peekc) { + + peekc = 0; + + return (c); + + } + + if (lap) { + + c = *lap++; + + if (c == 0) { + + lap = 0; + + goto top; + + } + + if (any(c, WORDMETA + intty)) + + c |= QUOTE; + + return (c); + + } + + if (c = peekd) { + + peekd = 0; + + return (c); + + } + + if (exclp) { + + if (c = *exclp++) + + return (c); + + if (exclnxt && --exclc >= 0) { + + exclnxt = exclnxt->next; + + setexclp(exclnxt->word); + + return (' '); + + } + + exclp = 0; + + exclnxt = 0; + + } + + if (exclnxt) { + + exclnxt = exclnxt->next; + + if (--exclc < 0) + + exclnxt = 0; + + else + + setexclp(exclnxt->word); + + goto top; + + } + + c = readc(0); + + if (c == '$' && (flag & DODOL)) { + + getdol(); + + goto top; + + } - if (c == '!' && (flag & DOEXCL)) { +++ if (c == HIST && (flag & DOEXCL)) { + + getexcl(0); + + goto top; + + } + + return (c); + +} + + + +getdol() + +{ + + register char *np; + + char name[40]; + + register int c; + + int sc; + + bool special = 0; + + + + np = name, *np++ = '$'; + + c = sc = getC(DOEXCL); + + if (any(c, "\t \n")) { + + ungetD(c); + + ungetC('$' | QUOTE); + + return; + + } + + if (c == '{') + + *np++ = c, c = getC(DOEXCL); + + if (c == '#' || c == '?') + + special++, *np++ = c, c = getC(DOEXCL); + + *np++ = c; + + switch (c) { + + +++ case '<': + + case '$': + + if (special) + + goto vsyn; + + goto ret; + + + + case '\n': + + ungetD(c); + + np--; + + goto vsyn; + + + + case '*': + + if (special) + + goto vsyn; + + goto ret; + + + + default: + + if (digit(c)) { + +/* + + * let $?0 pass for now + + if (special) + + goto vsyn; + +*/ + + while (digit(c = getC(DOEXCL))) { + + if (np < &name[sizeof name / 2]) + + *np++ = c; + + } + + } else if (letter(c)) + + while (letter(c = getC(DOEXCL))) { + + if (np < &name[sizeof name / 2]) + + *np++ = c; + + } + + else + + goto vsyn; + + } + + if (c == '[') { + + *np++ = c; + + do { + + c = getC(DOEXCL); + + if (c == '\n') { + + ungetD(c); + + np--; + + goto vsyn; + + } + + if (np >= &name[sizeof name - 8]) + + goto vsyn; + + *np++ = c; + + } while (c != ']'); + + c = getC(DOEXCL); + + } + + if (c == ':') { + + *np++ = c, c = getC(DOEXCL); + + if (c == 'g') + + *np++ = c, c = getC(DOEXCL); + + *np++ = c; - if (!any(c, "htrqx")) +++ if (!any(c, "htrqxe")) + + goto vsyn; + + } else + + ungetD(c); + + if (sc == '{') { + + c = getC(DOEXCL); + + if (c != '}') { + + ungetC(c); + + goto vsyn; + + } + + *np++ = c; + + } + +ret: + + *np = 0; + + addla(name); + + return; + + + +vsyn: + + seterr("Variable syntax"); + + goto ret; + +} + + + +addla(cp) + + char *cp; + +{ + + char buf[BUFSIZ]; + + - if (lap != 0 && strlen(cp) + strlen(lap) >= BUFSIZ - 4) { +++ if (lap != 0 && strlen(cp) + strlen(lap) >= sizeof (labuf) - 4) { + + seterr("Expansion buf ovflo"); + + return; + + } + + if (lap) + + strcpy(buf, lap); + + strcpy(labuf, cp); + + if (lap) + + strcat(labuf, buf); + + lap = labuf; + +} + + + +char lhsb[32]; + +char slhs[32]; + +char rhsb[64]; + +int quesarg; + + + +getexcl(sc) + + char sc; + +{ + + register struct wordent *hp, *ip; + + int left, right, dol; + + register int c; + + + + if (sc == 0) { + + sc = getC(0); + + if (sc != '{') { + + ungetC(sc); + + sc = 0; + + } + + } + + quesarg = -1; + + lastev = eventno; + + hp = gethent(sc); + + if (hp == 0) + + return; + + hadhist = 1; + + dol = 0; + + if (hp == alhistp) + + for (ip = hp->next->next; ip != alhistt; ip = ip->next) + + dol++; + + else + + for (ip = hp->next->next; ip != hp->prev; ip = ip->next) + + dol++; + + left = 0, right = dol; - if (sc == '^') { - ungetC('s'), unreadc('^'), c = ':'; +++ if (sc == HISTSUB) { +++ ungetC('s'), unreadc(HISTSUB), c = ':'; + + goto subst; + + } + + c = getC(0); + + if (!any(c, ":^$*-%")) + + goto subst; + + left = right = -1; + + if (c == ':') { + + c = getC(0); + + unreadc(c); + + if (letter(c) || c == '&') { + + c = ':'; + + left = 0, right = dol; + + goto subst; + + } + + } else + + ungetC(c); + + if (!getsel(&left, &right, dol)) + + return; + + c = getC(0); + + if (c == '*') + + ungetC(c), c = '-'; + + if (c == '-') { + + if (!getsel(&left, &right, dol)) + + return; + + c = getC(0); + + } + +subst: + + exclc = right - left + 1; + + while (--left >= 0) + + hp = hp->next; - if (sc == '^' || c == ':') { +++ if (sc == HISTSUB || c == ':') { + + do { + + hp = getsub(hp); + + c = getC(0); + + } while (c == ':'); + + } + + unreadc(c); + + if (sc == '{') { + + c = getC(0); + + if (c != '}') + + seterr("Bad ! form"); + + } + + exclnxt = hp; + +} + + + +struct wordent * + +getsub(en) + + struct wordent *en; + +{ + + register char *cp; + + int delim; + + register int c; + + int sc; + + bool global = 0; + + char orhsb[sizeof rhsb]; + + + + exclnxt = 0; + + sc = c = getC(0); + + if (c == 'g') + + global++, c = getC(0); + + switch (c) { + + + + case 'p': + + justpr++; + + goto ret; + + + + case 'x': + + case 'q': + + global++; + + /* fall into ... */ + + + + case 'h': + + case 'r': + + case 't': +++ case 'e': + + break; + + + + case '&': + + if (slhs[0] == 0) { + + seterr("No prev sub"); + + goto ret; + + } + + strcpy(lhsb, slhs); + + break; + + + +/* + + case '~': + + if (lhsb[0] == 0) + + goto badlhs; + + break; + +*/ + + + + case 's': + + delim = getC(0); + + if (letter(delim) || digit(delim) || any(delim, " \t\n")) { + + unreadc(delim); + +bads: + + lhsb[0] = 0; + + seterr("Bad substitute"); + + goto ret; + + } + + cp = lhsb; + + for (;;) { + + c = getC(0); + + if (c == '\n') { + + unreadc(c); + + goto bads; + + } + + if (c == delim) + + break; + + if (cp > &lhsb[sizeof lhsb - 2]) + + goto bads; + + if (c == '\\') { + + c = getC(0); + + if (c != delim && c != '\\') + + *cp++ = '\\'; + + } + + *cp++ = c; + + } + + if (cp != lhsb) + + *cp++ = 0; + + else if (lhsb[0] == 0) { - badlhs: +++/*badlhs:*/ + + seterr("No prev lhs"); + + goto ret; + + } + + cp = rhsb; + + strcpy(orhsb, cp); + + for (;;) { + + c = getC(0); + + if (c == '\n') { + + unreadc(c); + + break; + + } + + if (c == delim) + + break; + +/* + + if (c == '~') { + + if (&cp[strlen(orhsb)] > &rhsb[sizeof rhsb - 2]) + + goto toorhs; - cp = strend(strcpy(cp, orhsb)); +++ strcpy(cp, orhsb); +++ cp = strend(cp); + + continue; + + } + +*/ + + if (cp > &rhsb[sizeof rhsb - 2]) { - toorhs: +++/*toorhs:*/ + + seterr("Rhs too long"); + + goto ret; + + } + + if (c == '\\') { + + c = getC(0); + + if (c != delim /* && c != '~' */) + + *cp++ = '\\'; + + } + + *cp++ = c; + + } + + *cp++ = 0; + + break; + + + + default: + + if (c == '\n') + + unreadc(c); + + seterrc("Bad ! modifier: ", c); + + goto ret; + + } + + strcpy(slhs, lhsb); + + if (exclc) + + en = dosub(sc, en, global); + +ret: + + return (en); + +} + + + +struct wordent * + +dosub(sc, en, global) + + int sc; + + struct wordent *en; + + bool global; + +{ + + struct wordent lex; + + bool didsub = 0; + + struct wordent *hp = &lex; + + register struct wordent *wdp; + + register int i = exclc; + + + + wdp = hp; + + while (--i >= 0) { + + register struct wordent *new = (struct wordent *) calloc(1, sizeof *wdp); + + + + new->prev = wdp; + + new->next = hp; + + wdp->next = new; + + wdp = new; + + en = en->next; + + wdp->word = global || didsub == 0 ? + + subword(en->word, sc, &didsub) : savestr(en->word); + + } + + if (didsub == 0) + + seterr("Modifier failed"); + + hp->prev = wdp; + + return (&enthist(-1000, &lex, 0)->Hlex); + +} + + + +char * + +subword(cp, type, adid) + + char *cp; + + int type; + + bool *adid; + +{ + + char wbuf[BUFSIZ]; + + register char *wp, *mp, *np; + + register int i; + + + + switch (type) { + + + + case 'r': + + case 'h': + + case 't': + + case 'q': + + case 'x': + + wp = domod(cp, type); + + if (wp == 0) + + return (savestr(cp)); + + *adid = 1; + + return (wp); + + + + default: + + wp = wbuf; + + i = BUFSIZ - 4; + + for (mp = cp; *mp; mp++) + + if (matchs(mp, lhsb)) { + + for (np = cp; np < mp;) + + *wp++ = *np++, --i; + + for (np = rhsb; *np; np++) switch (*np) { + + + + case '\\': + + if (np[1] == '&') + + np++; + + /* fall into ... */ + + + + default: + + if (--i < 0) + + goto ovflo; + + *wp++ = *np; + + continue; + + + + case '&': + + i -= strlen(lhsb); + + if (i < 0) + + goto ovflo; + + *wp = 0; + + strcat(wp, lhsb); + + wp = strend(wp); + + continue; + + } + + mp += strlen(lhsb); + + i -= strlen(mp); + + if (i < 0) { + +ovflo: + + seterr("Subst buf ovflo"); + + return (""); + + } + + *wp = 0; + + strcat(wp, mp); + + *adid = 1; + + return (savestr(wbuf)); + + } + + return (savestr(cp)); + + } + +} + + + +char * + +domod(cp, type) + + char *cp; + + int type; + +{ + + register char *wp, *xp; + + register int c; + + + + switch (type) { + + + + case 'x': + + case 'q': + + wp = savestr(cp); + + for (xp = wp; c = *xp; xp++) + + if ((c != ' ' && c != '\t') || type == 'q') + + *xp |= QUOTE; + + return (wp); + + + + case 'h': + + case 't': - if (!any('/', cp)) +++ if (!any('/', cp)) /* what if :h :t are both the same? */ + + return (0); + + wp = strend(cp); + + while (*--wp != '/') + + continue; + + if (type == 'h') + +take: + + xp = savestr(cp), xp[wp - cp] = 0; + + else + + xp = savestr(wp + 1); + + return (xp); + + +++ case 'e': + + case 'r': + + wp = strend(cp); - for (wp--; wp >= cp && *wp != '.'; wp--) - if (*wp == '/') - return (0); - if (wp < cp) - return (0); - goto take; +++ for (wp--; wp >= cp && *wp != '/'; wp--) +++ if (*wp == '.') { +++ if (type == 'e') +++ xp = savestr(wp + 1); +++ else +++ xp = savestr(cp), xp[wp - cp] = 0; +++ return (xp); +++ } +++ return (savestr(type == 'e' ? "" : cp)); + + } + + return (0); + +} + + + +matchs(str, pat) + + register char *str, *pat; + +{ + + + + while (*str && *pat && *str == *pat) + + str++, pat++; + + return (*pat == 0); + +} + + + +getsel(al, ar, dol) + + register int *al, *ar; + + int dol; + +{ + + register int c = getC(0); + + register int i; + + bool first = *al < 0; + + + + switch (c) { + + + + case '%': + + if (quesarg == -1) + + goto bad; + + if (*al < 0) + + *al = quesarg; + + *ar = quesarg; + + break; + + + + case '-': + + if (*al < 0) { + + *al = 0; + + *ar = dol - 1; + + unreadc(c); + + } + + return (1); + + + + case '^': + + if (*al < 0) + + *al = 1; + + *ar = 1; + + break; + + + + case '$': + + if (*al < 0) + + *al = dol; + + *ar = dol; + + break; + + + + case '*': + + if (*al < 0) + + *al = 1; + + *ar = dol; + + if (*ar < *al) { + + *ar = 0; + + *al = 1; + + return (1); + + } + + break; + + + + default: + + if (digit(c)) { + + i = 0; + + while (digit(c)) { + + i = i * 10 + c - '0'; + + c = getC(0); + + } + + if (i < 0) + + i = dol + 1; + + if (*al < 0) + + *al = i; + + *ar = i; + + } else + + if (*al < 0) + + *al = 0, *ar = dol; + + else + + *ar = dol - 1; + + unreadc(c); + + break; + + } + + if (first) { + + c = getC(0); + + unreadc(c); + + if (any(c, "-$*")) + + return (1); + + } + + if (*al > *ar || *ar > dol) { + +bad: + + seterr("Bad ! arg selector"); + + return (0); + + } + + return (1); +++ + +} + + + +struct wordent * + +gethent(sc) + + int sc; + +{ + + register struct Hist *hp; + + register char *np; + + register int c; + + int event; + + bool back = 0; + + - c = sc == '^' ? '!' : getC(0); +++ c = sc == HISTSUB ? HIST : getC(0); +++ if (c == HIST) { +++ if (alhistp) +++ return (alhistp); +++ event = eventno; +++ goto skip; +++ } + + switch (c) { + + + + case ':': + + case '^': + + case '$': + + case '*': + + case '%': + + ungetC(c); + + if (lastev == eventno && alhistp) + + return (alhistp); + + event = lastev; + + break; + + - case '!': - event = eventno; - break; - + + case '-': + + back = 1; + + c = getC(0); + + goto number; + + +++ case '#': /* !# is command being typed in (mrh) */ +++ return(¶ml); +++ + + default: - if (any(c, "(=")) { +++ if (any(c, "(=~")) { + + unreadc(c); - ungetC('!'); +++ ungetC(HIST); + + return (0); + + } + + if (digit(c)) + + goto number; + + np = lhsb; + + while (!any(c, ": \t\\\n}")) { + + if (np < &lhsb[sizeof lhsb - 2]) + + *np++ = c; + + c = getC(0); + + } + + unreadc(c); + + if (np == lhsb) { - ungetC('!'); +++ ungetC(HIST); + + return (0); + + } + + *np++ = 0; + + hp = findev(lhsb, 0); + + if (hp) + + lastev = hp->Hnum; + + return (&hp->Hlex); + + + + case '?': + + np = lhsb; + + for (;;) { + + c = getC(0); + + if (c == '\n') { + + unreadc(c); + + break; + + } + + if (c == '?') + + break; + + if (np < &lhsb[sizeof lhsb - 2]) + + *np++ = c; + + } + + if (np == lhsb) { + + if (lhsb[0] == 0) { + + seterr("No prev search"); + + return (0); + + } + + } else + + *np++ = 0; + + hp = findev(lhsb, 1); + + if (hp) + + lastev = hp->Hnum; + + return (&hp->Hlex); + + + + number: + + event = 0; + + while (digit(c)) { + + event = event * 10 + c - '0'; + + c = getC(0); + + } + + if (back) + + event = eventno + (alhistp == 0) - (event ? event : 0); + + unreadc(c); + + break; + + } +++skip: + + for (hp = Histlist.Hnext; hp; hp = hp->Hnext) + + if (hp->Hnum == event) { + + hp->Href = eventno; + + lastev = hp->Hnum; + + return (&hp->Hlex); + + } + + np = putn(event); + + noev(np); + + return (0); + +} + + + +struct Hist * + +findev(cp, anyarg) + + char *cp; + + bool anyarg; + +{ + + register struct Hist *hp; + + + + for (hp = Histlist.Hnext; hp; hp = hp->Hnext) + + if (matchev(hp, cp, anyarg)) + + return (hp); + + noev(cp); + + return (0); + +} + + + +noev(cp) + + char *cp; + +{ + + + + seterr2(cp, ": Event not found"); + +} + + + +matchev(hp, cp, anyarg) + + register struct Hist *hp; + + char *cp; + + bool anyarg; + +{ + + register char *dp; + + struct wordent *lp = &hp->Hlex; + + int argno = 0; - +++ + + for (;;) { + + lp = lp->next; + + if (lp->word[0] == '\n') + + return (0); + + for (dp = lp->word; *dp; dp++) { + + if (matchs(dp, cp)) { + + if (anyarg) + + quesarg = argno; + + return (1); + + } + + if (!anyarg) + + return (0); + + } + + argno++; + + } + +} + + + +setexclp(cp) + + register char *cp; + +{ + + + + if (cp[0] == '\n') + + return; + + exclp = cp; + +} + + + +unreadc(c) + + char c; + +{ + + + + peekread = c; + +} + + + +readc(wanteof) + + bool wanteof; + +{ + + register int c; +++ static sincereal; + + + + if (c = peekread) { + + peekread = 0; + + return (c); + + } + +top: + + if (alvecp) { + + if (c = *alvecp++) + + return (c); + + if (*alvec) { + + alvecp = *alvec++; + + return (' '); + + } + + } + + if (alvec) { + + if (alvecp = *alvec) { + + alvec++; + + goto top; + + } + + /* Infinite source! */ + + return ('\n'); + + } +++ if (evalp) { +++ if (c = *evalp++) +++ return (c); +++ if (*evalvec) { +++ evalp = *evalvec++; +++ return (' '); +++ } +++ evalp = 0; +++ } +++ if (evalvec) { +++ if (evalvec == (char **)1) { +++ doneinp = 1; +++ reset(); +++ } +++ if (evalp = *evalvec) { +++ evalvec++; +++ goto top; +++ } +++ evalvec = (char **)1; +++ return ('\n'); +++ } + + do { + + if (arginp == (char *) 1 || onelflg == 1) { + + if (wanteof) + + return (-1); + + exitstat(); + + } + + if (arginp) { + + if ((c = *arginp++) == 0) { + + arginp = (char *) 1; + + return ('\n'); + + } + + return (c); + + } +++reread: + + c = bgetc(); + + if (c < 0) { + +#include + + struct sgttyb tty; + + + + if (wanteof) + + return (-1); + + /* was isatty but raw with ignoreeof yields problems */ - if (adrof("ignoreeof") && gtty(SHIN, &tty)==0 && (tty.sg_flags & RAW) == 0) { - if (loginsh) - printf("\nUse \"logout\" to logout.\n"); - else - printf("\nUse \"exit\" to leave csh.\n"); - reset(); +++ if (ioctl(SHIN, TIOCGETP, &tty)==0 && (tty.sg_flags & RAW) == 0) { +++ short ctpgrp; +++ +++ if (++sincereal > 25) +++ goto oops; +++ if (tpgrp != -1 && +++ ioctl(FSHTTY, TIOCGPGRP, &ctpgrp) == 0 && +++ tpgrp != ctpgrp) { +++ ioctl(FSHTTY, TIOCSPGRP, &tpgrp); +++ killpg(ctpgrp, SIGHUP); +++printf("Reset tty pgrp from %d to %d\n", ctpgrp, tpgrp); +++ goto reread; +++ } +++ if (adrof("ignoreeof")) { +++ if (loginsh) +++ printf("\nUse \"logout\" to logout.\n"); +++ else +++ printf("\nUse \"exit\" to leave csh.\n"); +++ reset(); +++ } +++ if (chkstop == 0) +++ panystop(1); + + } +++oops: + + doneinp = 1; + + reset(); + + } +++ sincereal = 0; + + if (c == '\n' && onelflg) + + onelflg--; + + } while (c == 0); + + return (c); + +} + + + +bgetc() + +{ + + register int buf, off, c; + + + +#ifdef TELL + + if (cantell) { + + if (fseekp < fbobp || fseekp > feobp) { + + fbobp = feobp = fseekp; + + lseek(SHIN, fseekp, 0); + + } + + if (fseekp == feobp) { + + fbobp = feobp; + + do + + c = read(SHIN, fbuf[0], BUFSIZ); + + while (c < 0 && errno == EINTR); + + if (c <= 0) + + return (-1); + + feobp += c; + + } + + c = fbuf[0][fseekp - fbobp]; + + fseekp++; + + return (c); + + } + +#endif + +again: + + buf = (int) fseekp / BUFSIZ; + + if (buf >= fblocks) { + + register char **nfbuf = (char **) calloc(fblocks+2, sizeof (char **)); + + + + if (fbuf) { + + blkcpy(nfbuf, fbuf); - xfree(fbuf); +++ xfree((char *)fbuf); + + } + + fbuf = nfbuf; + + fbuf[fblocks] = calloc(BUFSIZ, sizeof (char)); + + fblocks++; + + goto again; + + } + + if (fseekp >= feobp) { + + buf = (int) feobp / BUFSIZ; + + off = (int) feobp % BUFSIZ; + + do + + c = read(SHIN, fbuf[buf] + off, BUFSIZ - off); + + while (c < 0 && errno == EINTR); + + if (c <= 0) + + return (-1); + + feobp += c; + + goto again; + + } + + c = fbuf[buf][(int) fseekp % BUFSIZ]; + + fseekp++; + + return (c); + +} + + + +bfree() + +{ + + register int sb, i; + + + +#ifdef TELL + + if (cantell) + + return; + +#endif + + if (whyles) + + return; + + sb = (int) (fseekp - 1) / BUFSIZ; + + if (sb > 0) { + + for (i = 0; i < sb; i++) + + xfree(fbuf[i]); + + blkcpy(fbuf, &fbuf[sb]); + + fseekp -= BUFSIZ * sb; + + feobp -= BUFSIZ * sb; + + fblocks -= sb; + + } + +} + + + +bseek(l) + + long l; + +{ + + register struct whyle *wp; + + + + fseekp = l; + +#ifdef TELL + + if (!cantell) { + +#endif + + if (!whyles) + + return; + + for (wp = whyles; wp->w_next; wp = wp->w_next) + + continue; + + if (wp->w_start > l) + + l = wp->w_start; + +#ifdef TELL + + } + +#endif + +} + + + +/* any similarity to bell telephone is purely accidental */ + +long + +btell() + +{ + + + + return (fseekp); + +} + + + +btoeof() + +{ + + + + lseek(SHIN, 0l, 2); + + fseekp = feobp; + + wfree(); + + bfree(); + +} + + + +#ifdef TELL + +settell() + +{ + + + + cantell = 0; + + if (arginp || onelflg || intty) + + return; + + if (lseek(SHIN, 0l, 1) < 0 || errno == ESPIPE) + + return; + + fbuf = (char **) calloc(2, sizeof (char **)); + + fblocks = 1; + + fbuf[0] = calloc(BUFSIZ, sizeof (char)); + + fseekp = fbobp = feobp = tell(SHIN); + + cantell = 1; + +} + +#endif diff --cc usr/src/cmd/csh/sh.misc.c index 0000000000,3382e678cb,0000000000..11210c2a00 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.misc.c +++ b/usr/src/cmd/csh/sh.misc.c @@@@ -1,0 -1,340 -1,0 +1,372 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.misc.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C Shell + + */ + + + +letter(c) + + register char c; + +{ + + + + return (c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' || c == '_'); + +} + + + +digit(c) + + register char c; + +{ + + + + return (c >= '0' && c <= '9'); + +} + + +++alnum(c) +++ register char c; +++{ +++ return (letter(c) || digit(c)); +++} +++ + +any(c, s) + + register int c; + + register char *s; + +{ + + + + while (*s) + + if (*s++ == c) + + return(1); + + return(0); + +} + + + +char * + +calloc(i, j) - register int i; - int j; +++ register unsigned i; +++ unsigned j; + +{ + + register char *cp, *dp; +++#ifdef debug +++ static char *av[2] = {0, 0}; +++#endif + + + + i *= j; + + cp = (char *) malloc(i); + + if (cp == 0) { + + child++; +++#ifndef debug + + error("Out of memory"); +++#else +++ showall(av); +++ printf("i=%d, j=%d: ", i/j, j); +++ printf("Out of memory\n"); + + chdir("/usr/bill/cshcore"); + + abort(); +++#endif + + } + + dp = cp; - if (i > 0) +++ if (i != 0) + + do + + *dp++ = 0; + + while (--i); + + return (cp); + +} + + + +cfree(p) + + char *p; + +{ + + + + free(p); + +} + + + +char ** + +blkend(up) + + register char **up; + +{ + + + + while (*up) + + up++; + + return (up); + +} + + + +blkpr(av) - register int *av; +++ register char **av; + +{ + + + + for (; *av; av++) { + + printf("%s", *av); + + if (av[1]) + + printf(" "); + + } + +} + + + +blklen(av) + + register char **av; + +{ + + register int i = 0; + + + + while (*av++) + + i++; + + return (i); + +} + + + +char ** + +blkcpy(oav, bv) + + char **oav; + + register char **bv; + +{ + + register char **av = oav; + + + + while (*av++ = *bv++) + + continue; + + return (oav); + +} + + + +char ** + +blkcat(up, vp) + + char **up, **vp; + +{ + + + + blkcpy(blkend(up), vp); + + return (up); + +} + + + +blkfree(av0) + + char **av0; + +{ + + register char **av = av0; + + + + while (*av) + + xfree(*av++); - xfree(av0); +++ xfree((char *)av0); + +} + + + +char ** + +saveblk(v) + + register char **v; + +{ + + register int len = blklen(v) + 1; + + register char **newv = (char **) calloc(len, sizeof (char **)); + + char **onewv = newv; + + + + while (*v) + + *newv++ = savestr(*v++); + + return (onewv); + +} + + + +char * + +strspl(cp, dp) + + register char *cp, *dp; + +{ + + register char *ep = calloc(1, strlen(cp) + strlen(dp) + 1); + + + + strcpy(ep, cp); - return (strcat(ep, dp)); +++ strcat(ep, dp); +++ return (ep); + +} + + + +char ** + +blkspl(up, vp) + + register char **up, **vp; + +{ + + register char **wp = (char **) calloc(blklen(up) + blklen(vp) + 1, sizeof (char **)); + + + + blkcpy(wp, up); + + return (blkcat(wp, vp)); + +} + + + +lastchr(cp) + + register char *cp; + +{ + + + + if (!*cp) + + return (0); + + while (cp[1]) + + cp++; + + return (*cp); + +} + + + +/* + + * This routine is called after an error to close up + + * any units which may have been left open accidentally. + + */ + +closem() + +{ + + register int f; + + + + for (f = 0; f < NOFILE; f++) - if (f != SHIN && f != SHOUT && f != SHDIAG && f != OLDSTD) +++ if (f != SHIN && f != SHOUT && f != SHDIAG && f != OLDSTD && +++ f != FSHTTY) + + close(f); + +} + + + +/* + + * Close files before executing a file. + + * We could be MUCH more intelligent, since (on a version 7 system) + + * we need only close files here during a source, the other + + * shell fd's being in units 16-19 which are closed automatically! + + */ + +closech() + +{ + + register int f; + + + + if (didcch) + + return; + + didcch = 1; + + SHIN = 0; SHOUT = 1; SHDIAG = 2; OLDSTD = 0; + + for (f = 3; f < NOFILE; f++) + + close(f); + +} + + + +donefds() + +{ + + + + close(0), close(1), close(2); + + didfds = 0; + +} + + + +/* + + * Move descriptor i to j. + + * If j is -1 then we just want to get i to a safe place, + + * i.e. to a unit > 2. This also happens in dcopy. + + */ + +dmove(i, j) + + register int i, j; + +{ + + + + if (i == j || i < 0) + + return (i); + +#ifdef V7 + + if (j >= 0) { + + dup2(i, j); + + return (j); + + } else + +#endif + + j = dcopy(i, j); + + if (j != i) + + close(i); + + return (j); + +} + + + +dcopy(i, j) + + register int i, j; + +{ + + + + if (i == j || i < 0 || j < 0 && i > 2) + + return (i); + +#ifdef V7 + + if (j >= 0) { + + dup2(i, j); + + return (j); + + } + +#endif + + close(j); + + return (renum(i, j)); + +} + + + +renum(i, j) + + register int i, j; + +{ + + register int k = dup(i); + + + + if (k < 0) + + return (-1); + + if (j == -1 && k > 2) + + return (k); + + if (k != j) { + + j = renum(k, j); + + close(k); + + return (j); + + } + + return (k); + +} + + + +copy(to, from, size) + + register char *to, *from; + + register int size; + +{ + + + + if (size) + + do + + *to++ = *from++; + + while (--size != 0); + +} + + + +/* + + * Left shift a command argument list, discarding + + * the first c arguments. Used in "shift" commands + + * as well as by commands like "repeat". + + */ + +lshift(v, c) + + register char **v; + + register int c; + +{ + + register char **u = v; + + + + while (*u && --c >= 0) + + xfree(*u++); + + blkcpy(v, u); + +} + + + +number(cp) + + char *cp; + +{ + + + + if (*cp == '-') { + + cp++; + + if (!digit(*cp++)) + + return (0); + + } + + while (*cp && digit(*cp)) + + cp++; + + return (*cp == 0); + +} + + + +char ** + +copyblk(v) + + register char **v; + +{ + + register char **nv = (char **) calloc(blklen(v) + 1, sizeof (char **)); + + + + return (blkcpy(nv, v)); + +} + + + +char * + +strend(cp) + + register char *cp; + +{ + + + + while (*cp) + + cp++; + + return (cp); + +} + + + +char * + +strip(cp) + + char *cp; + +{ + + register char *dp = cp; + + + + while (*dp++ &= TRIM) + + continue; + + return (cp); + +} + + + +udvar(name) + + char *name; + +{ + + + + setname(name); + + bferr("Undefined variable"); + +} +++ +++prefix(sub, str) +++ register char *sub, *str; +++{ +++ +++ for (;;) { +++ if (*sub == 0) +++ return (1); +++ if (*str == 0) +++ return (0); +++ if (*sub++ != *str++) +++ return (0); +++ } +++} diff --cc usr/src/cmd/csh/sh.parse.c index 0000000000,104de689d3,0000000000..3dc06261e9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.parse.c +++ b/usr/src/cmd/csh/sh.parse.c @@@@ -1,0 -1,621 -1,0 +1,622 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.parse.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C shell + + */ + + + +/* + + * Perform aliasing on the word list lex + + * Do a (very rudimentary) parse to separate into commands. + + * If word 0 of a command has an alias, do it. + + * Repeat a maximum of 20 times. + + */ + +alias(lex) + + register struct wordent *lex; + +{ + + int aleft = 21; + + jmp_buf osetexit; + + + + getexit(osetexit); + + setexit(); + + if (haderr) { + + resexit(osetexit); + + reset(); + + } + + if (--aleft == 0) + + error("Alias loop"); + + asyntax(lex->next, lex); + + resexit(osetexit); + +} + + + +asyntax(p1, p2) + + register struct wordent *p1, *p2; + +{ + + + + while (p1 != p2) + + if (any(p1->word[0], ";&\n")) + + p1 = p1->next; + + else { + + asyn0(p1, p2); + + return; + + } + +} + + + +asyn0(p1, p2) + + struct wordent *p1; + + register struct wordent *p2; + +{ + + register struct wordent *p; + + register int l = 0; + + + + for (p = p1; p != p2; p = p->next) + + switch (p->word[0]) { + + + + case '(': + + l++; + + continue; + + + + case ')': + + l--; + + if (l < 0) + + error("Too many )'s"); + + continue; + + + + case '>': + + if (p->next != p2 && eq(p->next->word, "&")) + + p = p->next; + + continue; + + + + case '&': + + case '|': + + case ';': + + case '\n': + + if (l != 0) + + continue; + + asyn3(p1, p); + + asyntax(p->next, p2); + + return; + + } + + if (l == 0) + + asyn3(p1, p2); + +} + + + +asyn3(p1, p2) + + struct wordent *p1; + + register struct wordent *p2; + +{ + + register struct varent *ap; + + struct wordent alout; + + register bool redid; + + + + if (p1 == p2) + + return; + + if (p1->word[0] == '(') { + + for (p2 = p2->prev; p2->word[0] != ')'; p2 = p2->prev) + + if (p2 == p1) + + return; + + if (p2 == p1->next) + + return; + + asyn0(p1->next, p2); + + return; + + } + + ap = adrof1(p1->word, &aliases); + + if (ap == 0) + + return; + + alhistp = p1->prev; + + alhistt = p2; + + alvec = ap->vec; + + redid = lex(&alout); + + alhistp = alhistt = 0; + + alvec = 0; + + if (err) { + + freelex(&alout); + + error(err); + + } + + if (p1->word[0] && eq(p1->word, alout.next->word)) { + + char *cp = alout.next->word; + + + + alout.next->word = strspl("\200", cp); + + xfree(cp); + + } + + p1 = freenod(p1, redid ? p2 : p1->next); + + if (alout.next != &alout) { + + p1->next->prev = alout.prev->prev; + + alout.prev->prev->next = p1->next; + + alout.next->prev = p1; + + p1->next = alout.next; + + xfree(alout.prev->word); - xfree(alout.prev); +++ xfree((char *)(alout.prev)); + + } + + reset(); /* throw! */ + +} + + + +struct wordent * + +freenod(p1, p2) + + register struct wordent *p1, *p2; + +{ + + register struct wordent *retp = p1->prev; + + + + while (p1 != p2) { + + xfree(p1->word); + + p1 = p1->next; - xfree(p1->prev); +++ xfree((char *)(p1->prev)); + + } + + retp->next = p2; + + p2->prev = retp; + + return (retp); + +} + + + +#define PHERE 1 + +#define PIN 2 + +#define POUT 4 + +#define PDIAG 8 + + + +/* + + * syntax + + * empty + + * syn0 + + */ + +struct command * + +syntax(p1, p2, flags) + + register struct wordent *p1, *p2; + + int flags; + +{ + + + + while (p1 != p2) + + if (any(p1->word[0], ";&\n")) + + p1 = p1->next; + + else + + return (syn0(p1, p2, flags)); + + return (0); + +} + + + +/* + + * syn0 + + * syn1 + + * syn1 & syntax + + */ + +struct command * + +syn0(p1, p2, flags) + + struct wordent *p1, *p2; + + int flags; + +{ + + register struct wordent *p; + + register struct command *t, *t1; + + int l; + + + + l = 0; + + for (p = p1; p != p2; p = p->next) + + switch (p->word[0]) { + + + + case '(': + + l++; + + continue; + + + + case ')': + + l--; + + if (l < 0) + + seterr("Too many )'s"); + + continue; + + + + case '|': + + if (p->word[1] == '|') + + continue; + + /* fall into ... */ + + + + case '>': + + if (p->next != p2 && eq(p->next->word, "&")) + + p = p->next; + + continue; + + + + case '&': + + if (l != 0) + + break; + + if (p->word[1] == '&') + + continue; + + t1 = syn1(p1, p, flags); + + if (t1->t_dtyp == TLST) { + + t = (struct command *) calloc(1, sizeof (*t)); + + t->t_dtyp = TPAR; - t->t_dflg = FAND|FPRS|FINT; +++ t->t_dflg = FAND|FINT; + + t->t_dspr = t1; + + t1 = t; + + } else - t1->t_dflg |= FAND|FPRS|FINT; +++ t1->t_dflg |= FAND|FINT; + + t = (struct command *) calloc(1, sizeof (*t)); + + t->t_dtyp = TLST; + + t->t_dflg = 0; + + t->t_dcar = t1; + + t->t_dcdr = syntax(p, p2, flags); + + return(t); + + } + + if (l == 0) + + return (syn1(p1, p2, flags)); + + seterr("Too many ('s"); + + return (0); + +} + + + +/* + + * syn1 + + * syn1a + + * syn1a ; syntax + + */ + +struct command * + +syn1(p1, p2, flags) + + struct wordent *p1, *p2; + + int flags; + +{ + + register struct wordent *p; + + register struct command *t; + + int l; + + + + l = 0; + + for (p = p1; p != p2; p = p->next) + + switch (p->word[0]) { + + + + case '(': + + l++; + + continue; + + + + case ')': + + l--; + + continue; + + + + case ';': + + case '\n': + + if (l != 0) + + break; + + t = (struct command *) calloc(1, sizeof (*t)); + + t->t_dtyp = TLST; + + t->t_dcar = syn1a(p1, p, flags); + + t->t_dcdr = syntax(p->next, p2, flags); + + if (t->t_dcdr == 0) + + t->t_dcdr = t->t_dcar, t->t_dcar = 0; + + return (t); + + } + + return (syn1a(p1, p2, flags)); + +} + + + +/* + + * syn1a + + * syn1b + + * syn1b || syn1a + + */ + +struct command * + +syn1a(p1, p2, flags) + + struct wordent *p1, *p2; + + int flags; + +{ + + register struct wordent *p; + + register struct command *t; + + register int l = 0; + + + + for (p = p1; p != p2; p = p->next) + + switch (p->word[0]) { + + + + case '(': + + l++; + + continue; + + + + case ')': + + l--; + + continue; + + + + case '|': + + if (p->word[1] != '|') + + continue; + + if (l == 0) { + + t = (struct command *) calloc(1, sizeof (*t)); + + t->t_dtyp = TOR; + + t->t_dcar = syn1b(p1, p, flags); + + t->t_dcdr = syn1a(p->next, p2, flags); + + t->t_dflg = 0; + + return (t); + + } + + continue; + + } + + return (syn1b(p1, p2, flags)); + +} + + + +/* + + * syn1b + + * syn2 + + * syn2 && syn1b + + */ + +struct command * + +syn1b(p1, p2, flags) + + struct wordent *p1, *p2; + + int flags; + +{ + + register struct wordent *p; + + register struct command *t; + + register int l = 0; + + + + l = 0; + + for (p = p1; p != p2; p = p->next) + + switch (p->word[0]) { + + + + case '(': + + l++; + + continue; + + + + case ')': + + l--; + + continue; + + + + case '&': + + if (p->word[1] == '&' && l == 0) { + + t = (struct command *) calloc(1, sizeof (*t)); + + t->t_dtyp = TAND; + + t->t_dcar = syn2(p1, p, flags); + + t->t_dcdr = syn1b(p->next, p2, flags); + + t->t_dflg = 0; + + return (t); + + } + + continue; + + } + + return (syn2(p1, p2, flags)); + +} + + + +/* + + * syn2 + + * syn3 + + * syn3 | syn2 + + * syn3 |& syn2 + + */ + +struct command * + +syn2(p1, p2, flags) + + struct wordent *p1, *p2; + + int flags; + +{ + + register struct wordent *p, *pn; + + register struct command *t; + + register int l = 0; + + int f; + + + + for (p = p1; p != p2; p = p->next) + + switch (p->word[0]) { + + + + case '(': + + l++; + + continue; + + + + case ')': + + l--; + + continue; + + + + case '|': + + if (l != 0) + + continue; + + t = (struct command *) calloc(1, sizeof (*t)); + + f = flags | POUT; + + pn = p->next; + + if (pn != p2 && pn->word[0] == '&') { + + f |= PDIAG; + + t->t_dflg |= FDIAG; + + } + + t->t_dtyp = TFIL; + + t->t_dcar = syn3(p1, p, f); + + if (pn != p2 && pn->word[0] == '&') + + p = pn; + + t->t_dcdr = syn2(p->next, p2, flags | PIN); + + return (t); + + } + + return (syn3(p1, p2, flags)); + +} + + + +char *RELPAR = "<>()"; + + + +/* + + * syn3 + + * ( syn0 ) [ < in ] [ > out ] + + * word word* [ < in ] [ > out ] + + * KEYWORD ( word* ) word* [ < in ] [ > out ] + + * + + * KEYWORD = (@ exit foreach if set switch test while) + + */ + +struct command * + +syn3(p1, p2, flags) + + struct wordent *p1, *p2; + + int flags; + +{ + + register struct wordent *p; + + struct wordent *lp, *rp; + + register struct command *t; + + register int l; + + char **av; + + int n, c; + + bool specp = 0; + + + + if (p1 != p2) { + + p = p1; + +again: + + switch (srchx(p->word)) { + + + + case ZELSE: + + p = p->next; + + if (p != p2) + + goto again; + + break; + + + + case ZEXIT: + + case ZFOREACH: + + case ZIF: + + case ZLET: + + case ZSET: + + case ZSWITCH: + + case ZWHILE: + + specp = 1; + + break; + + } + + } + + n = 0; + + l = 0; + + for (p = p1; p != p2; p = p->next) + + switch (p->word[0]) { + + + + case '(': + + if (specp) + + n++; + + l++; + + continue; + + + + case ')': + + if (specp) + + n++; + + l--; + + continue; + + + + case '>': + + case '<': + + if (l != 0) { + + if (specp) + + n++; + + continue; + + } + + if (p->next == p2) + + continue; + + if (any(p->next->word[0], RELPAR)) + + continue; + + n--; + + continue; + + + + default: + + if (!specp && l != 0) + + continue; + + n++; + + continue; + + } + + if (n < 0) + + n = 0; + + t = (struct command *) calloc(1, sizeof (*t)); + + av = (char **) calloc(n + 1, sizeof (char **)); + + t->t_dcom = av; + + n = 0; + + if (p2->word[0] == ')') + + t->t_dflg = FPAR; + + lp = 0; + + rp = 0; + + l = 0; + + for (p = p1; p != p2; p = p->next) { + + c = p->word[0]; + + switch (c) { + + + + case '(': + + if (l == 0) { + + if (lp != 0 && !specp) + + seterr("Badly placed ("); + + lp = p->next; + + } + + l++; + + goto savep; + + + + case ')': + + l--; + + if (l == 0) + + rp = p; + + goto savep; + + + + case '>': + + if (l != 0) + + goto savep; + + if (p->word[1] == '>') + + t->t_dflg |= FCAT; + + if (p->next != p2 && eq(p->next->word, "&")) { + + t->t_dflg |= FDIAG, p = p->next; + + if (flags & (POUT|PDIAG)) + + goto badout; + + } + + if (p->next != p2 && eq(p->next->word, "!")) + + t->t_dflg |= FANY, p = p->next; + + if (p->next == p2) { + +missfile: + + seterr("Missing name for redirect"); + + continue; + + } + + p = p->next; + + if (any(p->word[0], RELPAR)) + + goto missfile; + + if ((flags & POUT) && (flags & PDIAG) == 0 || t->t_drit) + +badout: + + seterr("Ambiguous output redirect"); + + else + + t->t_drit = savestr(p->word); + + continue; + + + + case '<': + + if (l != 0) + + goto savep; + + if (p->word[1] == '<') + + t->t_dflg |= FHERE; + + if (p->next == p2) + + goto missfile; + + p = p->next; + + if (any(p->word[0], RELPAR)) + + goto missfile; + + if ((flags & PHERE) && (t->t_dflg & FHERE)) + + seterr("Can't << within ()'s"); + + else if ((flags & PIN) || t->t_dlef) + + seterr("Ambiguous input redirect"); + + else + + t->t_dlef = savestr(p->word); + + continue; + + + +savep: + + if (!specp) + + continue; + + default: + + if (l != 0 && !specp) + + continue; + + if (err == 0) + + av[n] = savestr(p->word); + + n++; + + continue; + + } + + } + + if (lp != 0 && !specp) { + + if (n != 0) + + seterr("Badly placed ()'s"); + + t->t_dtyp = TPAR; + + t->t_dspr = syn0(lp, rp, PHERE); + + } else { + + if (n == 0) + + seterr("Invalid null command"); + + t->t_dtyp = TCOM; + + } + + return (t); + +} + + + +freesyn(t) + + register struct command *t; + +{ + + register char **v; + + + + if (t == 0) + + return; + + switch (t->t_dtyp) { + + + + case TCOM: + + for (v = t->t_dcom; *v; v++) + + xfree(*v); - xfree(t->t_dcom); +++ xfree((char *)(t->t_dcom)); + + goto lr; + + + + case TPAR: + + freesyn(t->t_dspr); + + /* fall into ... */ + + + +lr: + + xfree(t->t_dlef), xfree(t->t_drit); + + break; + + + + case TAND: + + case TOR: + + case TFIL: + + case TLST: + + freesyn(t->t_dcar), freesyn(t->t_dcdr); + + break; + + } - xfree(t); +++ xfree((char *)t); + +} diff --cc usr/src/cmd/csh/sh.print.c index 0000000000,9f900cebad,0000000000..c298448aba mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.print.c +++ b/usr/src/cmd/csh/sh.print.c @@@@ -1,0 -1,104 -1,0 +1,115 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.print.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C Shell + + */ + + + +p60ths(l) + + long l; + +{ + + + + l += 3; + + printf("%d.%d", (int) (l / 60), (int) ((l % 60) / 6)); + +} + + + +psecs(l) + + long l; + +{ + + register int i; + + + + i = l / 3600; + + if (i) { + + printf("%d:", i); + + i = l % 3600; + + p2dig(i / 60); + + goto minsec; + + } + + i = l; + + printf("%d", i / 60); + +minsec: + + i %= 60; + + printf(":"); + + p2dig(i); + +} + + + +p2dig(i) + + register int i; + +{ + + + + printf("%d%d", i / 10, i % 10); + +} + + - char linbuf[64]; +++char linbuf[128]; + +char *linp = linbuf; + + + +putchar(c) + + register int c; + +{ + + + + if ((c & QUOTE) == 0 && (c == 0177 || c < ' ' && c != '\t' && c != '\n')) { + + putchar('^'); + + if (c == 0177) + + c = '?'; + + else + + c |= 'A' - 1; + + } + + c &= TRIM; + + *linp++ = c; + + if (c == '\n' || linp >= &linbuf[sizeof linbuf - 2]) + + flush(); + +} + + + +draino() + +{ + + + + linp = linbuf; + +} + + + +flush() + +{ + + register int unit; +++ int lmode = 0; +++ +++#include + + +++ if (linp == linbuf) +++ return; + + if (haderr) + + unit = didfds ? 2 : SHDIAG; + + else + + unit = didfds ? 1 : SHOUT; - if (linp != linbuf) { - write(unit, linbuf, linp - linbuf); - linp = linbuf; +++#ifdef TIOCLGET +++ if (didfds==0 && ioctl(unit, TIOCLGET, &lmode)==0 && +++ lmode & LFLUSHO) { +++ lmode = LFLUSHO; +++ ioctl(unit, TIOCLBIC, &lmode); +++ write(unit, "\n", 1); + + } +++#endif +++ write(unit, linbuf, linp - linbuf); +++ linp = linbuf; + +} + + + +plist(vp) + + register struct varent *vp; + +{ - register int (*wasintr)(); + + + + if (setintr) - wasintr = signal(SIGINT, pintr); +++ sigrelse(SIGINT); + + for (vp = vp->link; vp != 0; vp = vp->link) { + + int len = blklen(vp->vec); + + + + printf(vp->name); + + printf("\t"); + + if (len != 1) + + putchar('('); + + blkpr(vp->vec); + + if (len != 1) + + putchar(')'); + + printf("\n"); + + } + + if (setintr) - signal(SIGINT, wasintr); +++ sigrelse(SIGINT); + +} diff --cc usr/src/cmd/csh/sh.proc.c index 0000000000,0000000000,0000000000..d39da82ac1 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/csh/sh.proc.c @@@@ -1,0 -1,0 -1,0 +1,1105 @@@@ +++static char *sccsid = "@(#)sh.proc.c 4.1 10/9/80"; +++ +++#include "sh.h" +++#include "sh.dir.h" +++#include "sh.proc.h" +++#include +++#include +++ +++/* +++ * C Shell - functions that manage processes, handling hanging, termination +++ */ +++ +++#define BIGINDEX 9 /* largest desirable job index */ +++ +++/* +++ * pchild - called at interrupt level by the SIGCHLD signal +++ * indicating that at least one child has terminated or stopped +++ * thus at least one wait system call will definitely return a +++ * childs status. Top level routines (like pwait) must be sure +++ * to mask interrupts when playing with the proclist data structures! +++ */ +++pchild() +++{ +++ register struct process *pp; +++ register struct process *fp; +++ register int pid; +++ union wait w; +++ int jobflags; +++#ifdef VMUNIX +++ struct vtimes vt; +++#endif +++ +++ if (!timesdone) +++ timesdone++, times(&shtimes); +++loop: +++ pid = wait3(&w.w_status, (setintr ? WNOHANG|WUNTRACED:WNOHANG), +++#ifndef VMUNIX +++ 0); +++#else +++ &vt); +++#endif +++ if (pid <= 0) { +++ if (errno == EINTR) { +++ errno = 0; +++ goto loop; +++ } +++ pnoprocesses = pid == -1; +++ return; +++ } +++ for (pp = proclist.p_next; pp != PNULL; pp = pp->p_next) +++ if (pid == pp->p_pid) +++ goto found; +++ goto loop; +++found: +++ if (pid == atoi(value("child"))) +++ unsetv("child"); +++ pp->p_flags &= ~(PRUNNING|PSTOPPED|PREPORTED); +++ if (WIFSTOPPED(w)) { +++ pp->p_flags |= PSTOPPED; +++ pp->p_reason = w.w_stopsig; +++ } else { +++ if (pp->p_flags & (PTIME|PPTIME) || adrof("time")) { +++ time_t oldcutimes, oldcstimes; +++ oldcutimes = shtimes.tms_cutime; +++ oldcstimes = shtimes.tms_cstime; +++ time(&pp->p_etime); +++ times(&shtimes); +++ pp->p_utime = shtimes.tms_cutime - oldcutimes; +++ pp->p_stime = shtimes.tms_cstime - oldcstimes; +++ } else +++ times(&shtimes); +++#ifdef VMUNIX +++ pp->p_vtimes = vt; +++#endif +++ if (WIFSIGNALED(w)) { +++ if (w.w_termsig == SIGINT) +++ pp->p_flags |= PINTERRUPTED; +++ else +++ pp->p_flags |= PSIGNALED; +++ if (w.w_coredump) +++ pp->p_flags |= PDUMPED; +++ pp->p_reason = w.w_termsig; +++ } else { +++ pp->p_reason = w.w_retcode; +++#ifdef IIASA +++ if (pp->p_reason >= 3) +++#else +++ if (pp->p_reason != 0) +++#endif +++ pp->p_flags |= PAEXITED; +++ else +++ pp->p_flags |= PNEXITED; +++ } +++ } +++ jobflags = 0; +++ fp = pp; +++ do { +++ if ((fp->p_flags & (PPTIME|PRUNNING|PSTOPPED)) == 0 && +++ !child && adrof("time") && +++ (fp->p_utime + fp->p_stime) / HZ >= +++ atoi(value("time"))) +++ fp->p_flags |= PTIME; +++ jobflags |= fp->p_flags; +++ } while ((fp = fp->p_friends) != pp); +++ pp->p_flags &= ~PFOREGND; +++ if (pp == pp->p_friends && (pp->p_flags & PPTIME)) { +++ pp->p_flags &= ~PPTIME; +++ pp->p_flags |= PTIME; +++ } +++ if ((jobflags & (PRUNNING|PREPORTED)) == 0) { +++ fp = pp; +++ do { +++ if (fp->p_flags&PSTOPPED) +++ fp->p_flags |= PREPORTED; +++ } while((fp = fp->p_friends) != pp); +++ while(fp->p_pid != fp->p_jobid) +++ fp = fp->p_friends; +++ if (jobflags&PFOREGND) { +++ if (jobflags&PSTOPPED) { +++ if (pcurrent && pcurrent != fp) +++ pprevious = pcurrent; +++ pcurrent = fp; +++ } else +++ pclrcurr(fp); +++ if (jobflags & (PSIGNALED|PSTOPPED|PPTIME) || +++#ifdef IIASA +++ jobflags & PAEXITED || +++#endif +++ !eq(dcwd->di_name, fp->p_cwd->di_name)) { +++ if (jobflags & PSTOPPED) +++ printf("\n"); +++ pprint(fp, AREASON|SHELLDIR); +++ } else if ((jobflags & (PTIME|PSTOPPED)) == PTIME) +++ ptprint(fp); +++ } else { +++ if (jobflags&PNOTIFY || adrof("notify")) { +++ printf("\215\n"); +++ pprint(pp, NUMBER|NAME|REASON); +++ if ((jobflags&PSTOPPED) == 0) +++ pflush(pp); +++ } else { +++ if ((jobflags&PSTOPPED) == 0) +++ pclrcurr(fp); +++ fp->p_flags |= PNEEDNOTE; +++ neednote++; +++ } +++ } +++ } +++ goto loop; +++} +++ +++pnote() +++{ +++ register struct process *pp; +++ int flags; +++ +++ neednote = 0; +++ for (pp = proclist.p_next; pp != PNULL; pp = pp->p_next) { +++ if (pp->p_flags & PNEEDNOTE) { +++ sighold(SIGCHLD); +++ pp->p_flags &= ~PNEEDNOTE; +++ flags = pprint(pp, NUMBER|NAME|REASON); +++ if ((flags&(PRUNNING|PSTOPPED)) == 0) +++ pflush(pp); +++ sigrelse(SIGCHLD); +++ } +++ } +++} +++ +++/* +++ * pwait - wait for current job to terminate, maintaining integrity +++ * of current and previous job indicators. +++ */ +++pwait() +++{ +++ register struct process *fp, *pp; +++ +++ /* +++ * Here's where dead procs get flushed. +++ */ +++ sighold(SIGCHLD); +++ for (pp = (fp = &proclist)->p_next; pp != PNULL; pp = (fp = pp)->p_next) +++ if (pp->p_pid == 0) { +++ fp->p_next = pp->p_next; +++ xfree(pp->p_command); +++ if (pp->p_cwd && --pp->p_cwd->di_count == 0) +++ if (pp->p_cwd->di_next == 0) +++ dfree(pp->p_cwd); +++ xfree((char *)pp); +++ pp = fp; +++ } +++ sigrelse(SIGCHLD); +++ if (setintr) +++ sigignore(SIGINT); +++ pjwait(pcurrjob); +++} +++ +++/* +++ * pjwait - wait for a job to finish or become stopped +++ * It is assumed to be in the foreground state (PFOREGND) +++ */ +++pjwait(pp) +++ register struct process *pp; +++{ +++ register struct process *fp; +++ int jobflags, reason; +++ +++ fp = pp; +++ do { +++ if ((fp->p_flags&(PFOREGND|PRUNNING)) == PRUNNING) +++ printf("BUG: waiting for background job!\n"); +++ } while ((fp = fp->p_friends) != pp); +++ /* +++ * Now keep pausing as long as we are not interrupted (SIGINT), +++ * and the target process, or any of its friends, are running +++ */ +++ fp = pp; +++ for (;;) { +++ sighold(SIGCHLD); +++ jobflags = 0; +++ do +++ jobflags |= fp->p_flags; +++ while((fp = (fp->p_friends)) != pp); +++ if ((jobflags & PRUNNING) == 0) +++ break; +++ sigpause(SIGCHLD); +++ } +++ sigrelse(SIGCHLD); +++ if (tpgrp > 0) +++ ioctl(FSHTTY, TIOCSPGRP, &tpgrp); /* get tty back */ +++ if (jobflags & PSTOPPED) +++ return; +++ if ((jobflags&PINTERRUPTED) && setintr && +++ (!gointr || !eq(gointr, "-"))) { +++ pflush(pp); +++ pintr(); +++ /*NOTREACHED*/ +++ } +++ reason = 0; +++ fp = pp; +++ do { +++ if (fp->p_reason) +++ reason = fp->p_flags & (PSIGNALED|PINTERRUPTED) ? +++ fp->p_reason | QUOTE : fp->p_reason; +++ } while ((fp = fp->p_friends) != pp); +++ set("status", putn(reason)); +++ if (reason && exiterr) +++ exitstat(); +++ pflush(pp); +++} +++ +++/* +++ * dowait - wait for all processes to finish +++ */ +++dowait() +++{ +++ register struct process *pp; +++ +++ pjobs++; +++ if (setintr) +++ sigrelse(SIGINT); +++loop: +++ sighold(SIGCHLD); +++ for (pp = proclist.p_next; pp; pp = pp->p_next) +++ if (pp->p_pid && pp->p_pid == pp->p_jobid && +++ pp->p_flags&PRUNNING) { +++ sigpause(SIGCHLD); +++ goto loop; +++ } +++ sigrelse(SIGCHLD); +++ pjobs = 0; +++} +++ +++/* +++ * pflushall - flush all jobs from list (e.g. at fork()) +++ */ +++pflushall() +++{ +++ register struct process *pp; +++ +++ for (pp = proclist.p_next; pp != PNULL; pp = pp->p_next) +++ if (pp->p_pid) +++ pflush(pp); +++} +++ +++/* +++ * pflush - flag all process structures in the same job as the +++ * the argument process for deletion. The actual free of the +++ * space is not done here since pflush is called at interrupt level. +++ */ +++pflush(pp) +++ register struct process *pp; +++{ +++ register struct process *np; +++ register int index; +++ +++ if (pp->p_pid == 0) { +++ printf("BUG: process flushed twice"); +++ return; +++ } +++ while (pp->p_pid != pp->p_jobid) +++ pp = pp->p_friends; +++ pclrcurr(pp); +++ if (pp == pcurrjob) +++ pcurrjob = 0; +++ index = pp->p_index; +++ np = pp; +++ do { +++ np->p_index = np->p_pid = 0; +++ np->p_flags &= ~PNEEDNOTE; +++ } while ((np = np->p_friends) != pp); +++ if (index == pmaxindex) { +++ for (np = proclist.p_next, index = 0; np; np = np->p_next) +++ if (np->p_index > index) +++ index = np->p_index; +++ pmaxindex = index; +++ } +++} +++ +++/* +++ * pclrcurr - make sure the given job is not the current or previous job; +++ * pp MUST be the job leader +++ */ +++pclrcurr(pp) +++ register struct process *pp; +++{ +++ +++ if (pp == pcurrent) +++ if (pprevious != PNULL) { +++ pcurrent = pprevious; +++ pprevious = pgetcurr(pp); +++ } else { +++ pcurrent = pgetcurr(pp); +++ pprevious = pgetcurr(pp); +++ } +++ else if (pp == pprevious) +++ pprevious = pgetcurr(pp); +++} +++ +++/* +4 here is 1 for '\0', 1 ea for << >& >> */ +++char command[PMAXLEN+4]; +++int cmdlen; +++char *cmdp; +++/* +++ * palloc - allocate a process structure and fill it up. +++ * an important assumption is made that the process is running. +++ */ +++palloc(pid, t) +++ int pid; +++ register struct command *t; +++{ +++ register struct process *pp; +++ int i; +++ +++ pp = (struct process *)calloc(1, sizeof(struct process)); +++ pp->p_pid = pid; +++ pp->p_flags = t->t_dflg & FAND ? PRUNNING : PRUNNING|PFOREGND; +++ if (t->t_dflg & FTIME) +++ pp->p_flags |= PPTIME; +++ cmdp = command; +++ cmdlen = 0; +++ padd(t); +++ *cmdp++ = 0; +++ if (t->t_dflg & FPOU) { +++ pp->p_flags |= PPOU; +++ if (t->t_dflg & FDIAG) +++ pp->p_flags |= PDIAG; +++ } +++ pp->p_command = savestr(command); +++ if (pcurrjob) { +++ struct process *fp; +++ /* careful here with interrupt level */ +++ pp->p_cwd = 0; +++ pp->p_index = pcurrjob->p_index; +++ pp->p_friends = pcurrjob; +++ pp->p_jobid = pcurrjob->p_pid; +++ for (fp = pcurrjob; fp->p_friends != pcurrjob; fp = fp->p_friends) +++ ; +++ fp->p_friends = pp; +++ } else { +++ pcurrjob = pp; +++ pp->p_jobid = pid; +++ pp->p_friends = pp; +++ pp->p_cwd = dcwd; +++ dcwd->di_count++; +++ if (pmaxindex < BIGINDEX) +++ pp->p_index = ++pmaxindex; +++ else { +++ struct process *np; +++ +++ for (i = 1; ; i++) { +++ for (np = proclist.p_next; np; np = np->p_next) +++ if (np->p_index == i) +++ goto tryagain; +++ pmaxindex = pp->p_index = i; +++ break; +++ tryagain:; +++ } +++ } +++ if (pcurrent == PNULL) +++ pcurrent = pp; +++ else if (pprevious == PNULL) +++ pprevious = pp; +++ } +++ pp->p_next = proclist.p_next; +++ proclist.p_next = pp; +++ time(&pp->p_btime); +++} +++ +++padd(t) +++ register struct command *t; +++{ +++ char **argp; +++ +++ if (t == 0) +++ return; +++ switch (t->t_dtyp) { +++ +++ case TPAR: +++ pads("( "); +++ padd(t->t_dspr); +++ pads(" )"); +++ break; +++ +++ case TCOM: +++ for (argp = t->t_dcom; *argp; argp++) { +++ pads(*argp); +++ if (argp[1]) +++ pads(" "); +++ } +++ break; +++ +++ case TFIL: +++ padd(t->t_dcar); +++ pads(" | "); +++ padd(t->t_dcdr); +++ return; +++ +++ case TLST: +++ padd(t->t_dcar); +++ pads("; "); +++ padd(t->t_dcdr); +++ return; +++ } +++ if ((t->t_dflg & FPIN) == 0 && t->t_dlef) { +++ pads((t->t_dflg & FHERE) ? " << " : " < "); +++ pads(t->t_dlef); +++ } +++ if ((t->t_dflg & FPOU) == 0 && t->t_drit) { +++ pads((t->t_dflg & FCAT) ? " >>" : " >"); +++ if (t->t_dflg & FDIAG) +++ pads("&"); +++ pads(" "); +++ pads(t->t_drit); +++ } +++} +++ +++pads(cp) +++ char *cp; +++{ +++ register int i = strlen(cp); +++ +++ if (cmdlen >= PMAXLEN) +++ return; +++ if (cmdlen + i >= PMAXLEN) { +++ strcpy(cmdp, " ..."); +++ cmdlen = PMAXLEN; +++ cmdp += 4; +++ return; +++ } +++ strcpy(cmdp, cp); +++ cmdp += i; +++ cmdlen += i; +++} +++ +++/* +++ * psavejob - temporarily save the current job on a one level stack +++ * so another job can be created. Used for { } in exp6 +++ * and `` in globbing. +++ */ +++psavejob() +++{ +++ +++ pholdjob = pcurrjob; +++ pcurrjob = PNULL; +++} +++ +++/* +++ * prestjob - opposite of psavejob. This may be missed if we are interrupted +++ * somewhere, but pendjob cleans up anyway. +++ */ +++prestjob() +++{ +++ +++ pcurrjob = pholdjob; +++ pholdjob = PNULL; +++} +++ +++/* +++ * pendjob - indicate that a job (set of commands) has been completed +++ * or is about to begin. +++ */ +++pendjob() +++{ +++ register struct process *pp, *tp; +++ +++ if (pcurrjob && (pcurrjob->p_flags&(PFOREGND|PSTOPPED)) == 0) { +++ pp = pcurrjob; +++ while (pp->p_pid != pp->p_jobid) +++ pp = pp->p_friends; +++ printf("[%d]", pp->p_index); +++ tp = pp; +++ do { +++ printf(" %d", pp->p_pid); +++ pp = pp->p_friends; +++ } while (pp != tp); +++ printf("\n"); +++ } +++ pholdjob = pcurrjob = 0; +++} +++ +++/* +++ * pprint - print a job +++ */ +++pprint(pp, flag) +++ register struct process *pp; +++{ +++ register status, reason; +++ struct process *tp; +++ extern char *linp, linbuf[]; +++ int jobflags, pstatus; +++ char *format; +++ +++ while (pp->p_pid != pp->p_jobid) +++ pp = pp->p_friends; +++ if (pp == pp->p_friends && (pp->p_flags & PPTIME)) { +++ pp->p_flags &= ~PPTIME; +++ pp->p_flags |= PTIME; +++ } +++ tp = pp; +++ status = reason = -1; +++ jobflags = 0; +++ do { +++ jobflags |= pp->p_flags; +++ pstatus = pp->p_flags & PALLSTATES; +++ if (tp != pp && linp != linbuf && !(flag&FANCY) && +++ (pstatus == status && pp->p_reason == reason || +++ !(flag&REASON))) +++ printf(" "); +++ else { +++ if (tp != pp && linp != linbuf) +++ printf("\n"); +++ if(flag&NUMBER) +++ if (pp == tp) +++ printf("[%d]%s %c ", pp->p_index, +++ pp->p_index < 10 ? " " : "", +++ pp==pcurrent ? '+' : +++ (pp == pprevious ? '-' : ' ')); +++ else +++ printf(" "); +++ if (flag&FANCY) +++ printf("%5d ", pp->p_pid); +++ if (flag&(REASON|AREASON)) { +++ if (flag&NAME) +++ format = "%-21s"; +++ else +++ format = "%s"; +++ if (pstatus == status) +++ if (pp->p_reason == reason) { +++ printf(format, ""); +++ goto prcomd; +++ } else +++ reason = pp->p_reason; +++ else { +++ status = pstatus; +++ reason = pp->p_reason; +++ } +++ switch (status) { +++ +++ case PRUNNING: +++ printf(format, "Running "); +++ break; +++ +++ case PINTERRUPTED: +++ case PSTOPPED: +++ case PSIGNALED: +++ if (flag&REASON || reason != SIGINT || +++ reason != SIGPIPE) +++ printf(format, mesg[pp->p_reason].pname); +++ break; +++ +++ case PNEXITED: +++ case PAEXITED: +++ if (flag & REASON) +++ if (pp->p_reason) +++ printf("Exit %-16d", pp->p_reason); +++ else +++ printf(format, "Done"); +++ break; +++ +++ default: +++ printf("BUG: status=%-9o", status); +++ } +++ } +++ } +++prcomd: +++ if (flag&NAME) { +++ printf("%s", pp->p_command); +++ if (pp->p_flags & PPOU) +++ printf(" |"); +++ if (pp->p_flags & PDIAG) +++ printf("&"); +++ } +++ if (flag&(REASON|AREASON) && pp->p_flags&PDUMPED) +++ printf(" (core dumped)"); +++ if (tp == pp->p_friends) { +++ if (flag&ERSAND) +++ printf(" &"); +++ if (flag&JOBDIR && +++ !eq(tp->p_cwd->di_name, dcwd->di_name)) { +++ printf(" (wd: "); +++ dtildepr(value("home"), tp->p_cwd->di_name); +++ printf(")"); +++ } +++ } +++ if (pp->p_flags&PPTIME && !(status&(PSTOPPED|PRUNNING))) { +++ if (linp != linbuf) +++ printf("\n\t"); +++#ifndef VMUNIX +++ ptimes(pp->p_utime, pp->p_stime, pp->p_etime-pp->p_btime); +++#else +++ pvtimes(&zvms, &pp->p_vtimes, pp->p_etime - pp->p_btime); +++#endif +++ } +++ if (tp == pp->p_friends) { +++ if (linp != linbuf) +++ printf("\n"); +++ if (flag&SHELLDIR && !eq(tp->p_cwd->di_name, dcwd->di_name)) { +++ printf("(wd now: "); +++ dtildepr(value("home"), dcwd->di_name); +++ printf(")\n"); +++ } +++ } +++ } while ((pp = pp->p_friends) != tp); +++ if (jobflags&PTIME && (jobflags&(PSTOPPED|PRUNNING)) == 0) { +++ if (jobflags & NUMBER) +++ printf(" "); +++ ptprint(tp); +++ } +++ return (jobflags); +++} +++ +++ptprint(tp) +++ register struct process *tp; +++{ +++ time_t tetime = 0; +++#ifdef VMUNIX +++ struct vtimes vmt; +++#else +++ time_t tutime = 0, tstime = 0; +++#endif +++ register struct process *pp = tp; +++ +++ vmt = zvms; +++ do { +++#ifdef VMUNIX +++ vmsadd(&vmt, &pp->p_vtimes); +++#else +++ tutime += pp->p_utime; +++ tstime += pp->p_stime; +++#endif +++ if (pp->p_etime - pp->p_btime > tetime) +++ tetime = pp->p_etime - pp->p_btime; +++ } while ((pp = pp->p_friends) != tp); +++#ifdef VMUNIX +++ pvtimes(&zvms, &vmt, tetime); +++#else +++ ptimes(tutime, tstime, tetime); +++#endif +++} +++ +++/* +++ * dojobs - print all jobs +++ */ +++dojobs(v) +++ char **v; +++{ +++ register struct process *pp; +++ register int flag = NUMBER|NAME|REASON; +++ int i; +++ +++ if (chkstop) +++ chkstop = 2; +++ if (*++v) { +++ if (v[1] || !eq(*v, "-l")) +++ error("Usage: jobs [ -l ]"); +++ flag |= FANCY|JOBDIR; +++ } +++ for (i = 1; i <= pmaxindex; i++) +++ for (pp = proclist.p_next; pp; pp = pp->p_next) +++ if (pp->p_index == i && pp->p_pid == pp->p_jobid) { +++ pp->p_flags &= ~PNEEDNOTE; +++ if (!(pprint(pp, flag) & (PRUNNING|PSTOPPED))) +++ pflush(pp); +++ break; +++ } +++} +++ +++/* +++ * dofg - builtin - put the job into the foreground +++ */ +++dofg(v) +++ char **v; +++{ +++ register struct process *pp; +++ +++ okpcntl(); +++ ++v; +++ do { +++ pp = pfind(*v); +++ pstart(pp, 1); +++ if (setintr) +++ sigignore(SIGINT); +++ pjwait(pp); +++ } while (*v && *++v); +++} +++ +++/* +++ * %... - builtin - put the job into the foreground +++ */ +++dofg1(v) +++ char **v; +++{ +++ register struct process *pp; +++ +++ okpcntl(); +++ pp = pfind(v[0]); +++ pstart(pp, 1); +++ if (setintr) +++ sigignore(SIGINT); +++ pjwait(pp); +++} +++ +++/* +++ * dobg - builtin - put the job into the background +++ */ +++dobg(v) +++ char **v; +++{ +++ register struct process *pp; +++ +++ okpcntl(); +++ ++v; +++ do { +++ pp = pfind(*v); +++ pstart(pp, 0); +++ } while (*v && *++v); +++} +++ +++/* +++ * %... & - builtin - put the job into the background +++ */ +++dobg1(v) +++ char **v; +++{ +++ register struct process *pp; +++ +++ pp = pfind(v[0]); +++ pstart(pp, 0); +++} +++ +++/* +++ * dostop - builtin - stop the job +++ */ +++dostop(v) +++ char **v; +++{ +++ +++ pkill(++v, SIGSTOP); +++} +++ +++/* +++ * dokill - builtin - superset of kill (1) +++ */ +++dokill(v) +++ char **v; +++{ +++ register int signum; +++ register char *name; +++ +++ v++; +++ if (v[0] && v[0][0] == '-') { +++ if (v[0][1] == 'l') { +++ for (signum = 1; signum <= NSIG; signum++) { +++ if (name = mesg[signum].iname) +++ printf("%s ", name); +++ if (signum == 16) +++ printf("\n"); +++ } +++ printf("\n"); +++ return; +++ } +++ if (digit(v[0][1])) { +++ signum = atoi(v[0]+1); +++ if (signum < 1 || signum > NSIG) +++ bferr("Bad signal number"); +++ } else { +++ name = &v[0][1]; +++ for (signum = 1; signum <= NSIG; signum++) +++ if (mesg[signum].iname && +++ eq(name, mesg[signum].iname)) +++ goto gotsig; +++ setname(name); +++ bferr("Unknown signal; kill -l lists signals"); +++ } +++gotsig: +++ v++; +++ } else +++ signum = SIGTERM; +++ pkill(v, signum); +++} +++ +++pkill(v, signum) +++ char **v; +++ int signum; +++{ +++ register struct process *pp, *np; +++ register int jobflags = 0; +++ int pid; +++ extern char *sys_errlist[]; +++ int err = 0; +++ +++ if (setintr) +++ sighold(SIGINT); +++ sighold(SIGCHLD); +++ while (*v) { +++ if (**v == '%') { +++ np = pp = pfind(*v); +++ do +++ jobflags |= np->p_flags; +++ while ((np = np->p_friends) != pp); +++ switch (signum) { +++ +++ case SIGSTOP: +++ case SIGTSTP: +++ case SIGTTIN: +++ case SIGTTOU: +++ if ((jobflags & PRUNNING) == 0) { +++ printf("%s: Already stopped\n", *v); +++ err++; +++ goto cont; +++ } +++ } +++ killpg(pp->p_jobid, signum); +++ if (signum == SIGTERM || signum == SIGHUP) +++ killpg(pp->p_jobid, SIGCONT); +++ } else if (!digit(**v)) +++ bferr("Arguments should be jobs or process id's"); +++ else { +++ pid = atoi(*v); +++ if (kill(pid, signum) < 0) { +++ printf("%d: ", pid); +++ printf("%s\n", sys_errlist[errno]); +++ err++; +++ goto cont; +++ } +++ if (signum == SIGTERM || signum == SIGHUP) +++ kill(pid, SIGCONT); +++ } +++cont: +++ v++; +++ } +++ sigrelse(SIGCHLD); +++ if (setintr) +++ sigrelse(SIGINT); +++ if (err) +++ error(NOSTR); +++} +++ +++/* +++ * pstart - start the job in foreground/background +++ */ +++pstart(pp, foregnd) +++ register struct process *pp; +++ int foregnd; +++{ +++ register struct process *np; +++ int jobflags = 0; +++ +++ sighold(SIGCHLD); +++ np = pp; +++ do { +++ jobflags |= np->p_flags; +++ if (np->p_flags&(PRUNNING|PSTOPPED)) { +++ np->p_flags |= PRUNNING; +++ np->p_flags &= ~PSTOPPED; +++ if (foregnd) +++ np->p_flags |= PFOREGND; +++ else +++ np->p_flags &= ~PFOREGND; +++ } +++ } while((np = np->p_friends) != pp); +++ pprint(pp, foregnd ? NAME|JOBDIR : NUMBER|NAME|AMPERSAND); +++ if (foregnd) +++ ioctl(FSHTTY, TIOCSPGRP, &pp->p_jobid); +++ if (jobflags&PSTOPPED) +++ killpg(pp->p_jobid, SIGCONT); +++ sigrelse(SIGCHLD); +++} +++ +++panystop(neednl) +++{ +++ register struct process *pp; +++ +++ chkstop = 2; +++ for (pp = proclist.p_next; pp; pp = pp->p_next) +++ if (pp->p_flags & PSTOPPED) +++ error("\nThere are stopped jobs" + 1 - neednl); +++} +++ +++struct process * +++pfind(cp) +++ char *cp; +++{ +++ register struct process *pp, *np; +++ +++ if (cp == 0 || cp[1] == 0 || eq(cp, "%%") || eq(cp, "%+")) { +++ if (pcurrent == PNULL) +++ bferr("No current job"); +++ return (pcurrent); +++ } +++ if (eq(cp, "%-") || eq(cp, "%#")) { +++ if (pprevious == PNULL) +++ bferr("No previous job"); +++ return (pprevious); +++ } +++ if (digit(cp[1])) { +++ int index = atoi(cp+1); +++ for (pp = proclist.p_next; pp; pp = pp->p_next) +++ if (pp->p_index == index && pp->p_pid == pp->p_jobid) +++ return (pp); +++ bferr("No such job"); +++ } +++ np = PNULL; +++ for (pp = proclist.p_next; pp; pp = pp->p_next) +++ if (pp->p_pid == pp->p_jobid) { +++ if (cp[1] == '?') { +++ register char *dp; +++ for (dp = pp->p_command; *dp; dp++) { +++ if (*dp != cp[2]) +++ continue; +++ if (prefix(cp+2, dp)) +++ goto match; +++ } +++ } else if (prefix(cp+1, pp->p_command)) { +++match: +++ if (np) +++ bferr("Ambiguous"); +++ np = pp; +++ } +++ } +++ if (np) +++ return (np); +++ if (cp[1] == '?') +++ bferr("No job matches pattern"); +++ else +++ bferr("No such job"); +++} +++ +++/* +++ * pgetcurr - find a job that is not pp and ``most recent'' +++ */ +++struct process * +++pgetcurr(pp) +++ register struct process *pp; +++{ +++ register struct process *np; +++ +++ for (np = proclist.p_next; np; np = np->p_next) +++ if (np != pcurrent && np != pp && np->p_pid && +++ np->p_pid == np->p_jobid) { +++ return (np); +++ } +++ return (PNULL); +++} +++ +++/* +++ * donotify - flag the job so as to report termination asynchronously +++ */ +++donotify(v) +++ char **v; +++{ +++ register struct process *pp; +++ +++ pp = pfind(*++v); +++ pp->p_flags |= PNOTIFY; +++} +++ +++/* +++ * Do the fork and whatever should be done in the child side that +++ * should not be done if we are not forking at all (like for simple builtin's) +++ * Also do everything that needs any signals fiddled with in the parent side +++ * +++ * Wanttty tells whether process and/or tty pgrps are to be manipulated: +++ * -1: leave tty alone; inherit pgrp from parent +++ * 0: already have tty; manipulate process pgrps only +++ * 1: want to claim tty; manipulate process and tty pgrps +++ * It is usually just the value of tpgrp. +++ */ +++pfork(t, wanttty) +++ struct command *t; /* command we are forking for */ +++ int wanttty; +++{ +++ register int pid; +++ bool ignint = 0; +++ int pgrp; +++ +++ /* +++ * A child will be uninterruptible only under very special +++ * conditions. Remember that the semantics of '&' is +++ * implemented by disconnecting the process from the tty so +++ * signals do not need to ignored just for '&'. +++ * Thus signals are set to default action for children unless: +++ * we have had an "onintr -" (then specifically ignored) +++ * we are not playing with signals (inherit action) +++ */ +++ if (setintr) +++ ignint = (tpgrp == -1 && (t->t_dflg&FINT)) +++ || (gointr && eq(gointr, "-")); +++ /* +++ * Hold SIGCHLD until we have the process installed in our table. +++ */ +++ sighold(SIGCHLD); +++ while ((pid = fork()) < 0) +++ if (setintr == 0) +++ sleep(FORKSLEEP); +++ else { +++ sigrelse(SIGINT); +++ sigrelse(SIGCHLD); +++ error("No more processes"); +++ } +++ if (pid == 0) { +++ settimes(); +++ pgrp = pcurrjob ? pcurrjob->p_jobid : getpid(); +++ pflushall(); +++ pcurrjob = PNULL; +++ timesdone = 0; +++ child++; +++ if (setintr) { +++ setintr = 0; /* until I think otherwise */ +++ sigrelse(SIGCHLD); +++ /* +++ * Children just get blown away on SIGINT, SIGQUIT +++ * unless "onintr -" seen. +++ */ +++ signal(SIGINT, ignint ? SIG_IGN : SIG_DFL); +++ signal(SIGQUIT, ignint ? SIG_IGN : SIG_DFL); +++ if (wanttty >= 0) { +++ /* make stoppable */ +++ signal(SIGTSTP, SIG_DFL); +++ signal(SIGTTIN, SIG_DFL); +++ signal(SIGTTOU, SIG_DFL); +++ } +++ signal(SIGTERM, parterm); +++ } else if (tpgrp == -1 && (t->t_dflg&FINT)) { +++ signal(SIGINT, SIG_IGN); +++ signal(SIGQUIT, SIG_IGN); +++ } +++ if (wanttty > 0) +++ ioctl(FSHTTY, TIOCSPGRP, &pgrp); +++ if (wanttty >= 0 && tpgrp >= 0) +++ setpgrp(0, pgrp); +++ if (tpgrp > 0) +++ tpgrp = 0; /* gave tty away */ +++ /* +++ * Nohup and nice apply only to TCOM's but it would be +++ * nice (?!?) if you could say "nohup (foo;bar)" +++ * Then the parser would have to know about nice/nohup/time +++ */ +++ if (t->t_dflg & FNOHUP) +++ signal(SIGHUP, SIG_IGN); +++ if (t->t_dflg & FNICE) { +++/* sigh... +++ nice(20); +++ nice(-10); +++*/ +++ nice(t->t_nice); +++ } +++ +++ } else { +++ palloc(pid, t); +++ sigrelse(SIGCHLD); +++ } +++ +++ return (pid); +++} +++ +++okpcntl() +++{ +++ +++ if (tpgrp == -1) +++ error("No job control in this shell"); +++ if (tpgrp == 0) +++ error("No job control in subshells"); +++} diff --cc usr/src/cmd/csh/sh.sem.c index 0000000000,591214436c,0000000000..f29027afa9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.sem.c +++ b/usr/src/cmd/csh/sh.sem.c @@@@ -1,0 -1,400 -1,0 +1,369 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.sem.c 4.1 10/9/80"; +++ + +#include "sh.h" +++#include "sh.proc.h" +++#include + + + +/* + + * C shell + + */ + + - execute(t, pipein, pipeout) +++/*VARARGS 1*/ +++execute(t, wanttty, pipein, pipeout) + + register struct command *t; - int *pipein, *pipeout; +++ int wanttty, *pipein, *pipeout; + +{ - int pid, flags, pv[2]; - register struct command *t1; - register char *cp; + + bool forked = 0; - bool shudint, shudhup; - #ifdef VFORK - int (*savint)(), vffree(); - int ochild, osetintr, ohaderr, otimflg, odidfds, odidcch; - int oSHIN, oSHOUT, oSHDIAG, oOLDSTD; - int isvfork = 0; - #endif +++ struct biltins *bifunc; +++ int pid = 0; +++ int pv[2]; + + + + if (t == 0) + + return; +++ if ((t->t_dflg & FAND) && wanttty > 0) +++ wanttty = 0; + + switch (t->t_dtyp) { + + + + case TCOM: - cp = t->t_dcom[0]; - if ((cp[0] & (QUOTE|TRIM)) == QUOTE) - strcpy(cp, cp + 1); +++ if ((t->t_dcom[0][0] & (QUOTE|TRIM)) == QUOTE) +++ strcpy(t->t_dcom[0], t->t_dcom[0] + 1); + + if ((t->t_dflg & FREDO) == 0) + + Dfix(t); /* $ " ' \ */ +++ if (t->t_dcom[0] == 0) +++ return; + + /* fall into... */ + + + + case TPAR: - flags = t->t_dflg; - if (flags & FPOU) +++ if (t->t_dflg & FPOU) + + mypipe(pipeout); - /* - * A child will be interruptible only under very - * certain conditions: - * we must be monkeying with interrupts - * the child must not be &'ed - * we must not have had an "onintr -" - */ - shudint = setintr && (flags & FINT) == 0 && (!gointr || !eq(gointr, "-")); - shudhup = (flags & FAND) == 0; - + + /* + + * Must do << early so parent will know - * where input pointer should be +++ * where input pointer should be. +++ * If noexec then this is all we do. + + */ - if (flags & FHERE) - close(0), heredoc(t->t_dlef); - - /* - * If not executing commands then - * all we must do is read forward in the input to - * account for << redirection if present. - */ - if (noexec) { - if (flags & FHERE) +++ if (t->t_dflg & FHERE) { +++ close(0); +++ heredoc(t->t_dlef); +++ if (noexec) + + close(0); - return; + + } +++ if (noexec) +++ break; + + + + set("status", "0"); - pid = 0; + + + + /* - * Built-in functions +++ * This mess is the necessary kludge to handle the prefix +++ * builtins: nice, nohup, time. These commands can also +++ * be used by themselves, and this is not handled here. +++ * This will also work when loops are parsed. + + */ - if (t->t_dtyp == TCOM && isbfunc(t->t_dcom[0])) { - /* - * If output is piped, or running & and we would - * eventually fork for non-builtin commands, - * then do it now, so we won't block. - */ - if ((flags & (FPOU|FAND)) && (flags & FPAR) == 0) - pid = dofork(shudint, shudhup), forked++; - - /* - * If the builtin is actually executed (some, e.g. - * time and nice may refuse to execute here) - * then either exit (if we forked) or close i/o - * and continue execution (if we didn't). - */ - if (pid == 0) { - doio(t, pipein, pipeout); - if (flags & FPOU) { - close(pipeout[0]), close(pipeout[1]); - pipeout[0] = pipeout[1] = -1; - } - if (setintr && forked) { - if (shudint) - signal(SIGINT, SIG_DFL), signal(SIGQUIT, SIG_DFL); - signal(SIGTERM, parterm); - if (flags & FINT) - setintr = 0; - } - if (func(t, pipein, pipeout)) { - if (forked) - exitstat(); - if (didfds && !(t->t_dflg & FREDO)) - donefds(); - return; - } - } - } +++ while (t->t_dtyp == TCOM) +++ if (eq(t->t_dcom[0], "nice")) +++ if (t->t_dcom[1]) +++ if (any(t->t_dcom[1][0], "+-")) +++ if (t->t_dcom[2]) { +++ setname("nice"); +++ t->t_nice = getn(t->t_dcom[1]); +++ lshift(t->t_dcom, 2); +++ t->t_dflg |= FNICE; +++ } else +++ break; +++ else { +++ t->t_nice = 4; +++ lshift(t->t_dcom, 1); +++ t->t_dflg |= FNICE; +++ } +++ else +++ break; +++ else if (eq(t->t_dcom[0], "nohup")) +++ if (t->t_dcom[1]) { +++ t->t_dflg |= FNOHUP; +++ lshift(t->t_dcom, 1); +++ } else +++ break; +++ else if (eq(t->t_dcom[0], "time")) +++ if (t->t_dcom[1]) { +++ t->t_dflg |= FTIME; +++ lshift(t->t_dcom, 1); +++ } else +++ break; +++ else +++ break; +++ /* +++ * Check if we have a builtin function and remember which one. +++ */ +++ bifunc = t->t_dtyp == TCOM ? isbfunc(t) : (struct biltins *) 0; + + + + /* - * Now, we must make a new process since either the - * command is non-builtin, a parenthesized list, - * or builtin such as time or nice which really - * requires a child. +++ * We fork only if we are timed, or are not the end of +++ * a parenthesized list and not a simple builtin function. +++ * Simple meaning one that is not pipedout, niced, nohupped, +++ * or &'d. +++ * It would be nice(?) to not fork in some of these cases. + + */ - if (!forked && (flags & FPAR) == 0) +++ if (((t->t_dflg & FTIME) || (t->t_dflg & FPAR) == 0 && +++ (!bifunc || t->t_dflg & (FPOU|FAND|FNICE|FNOHUP)))) + +#ifdef VFORK - if (t->t_dtyp == TPAR || (flags&FREDO) || - eq(t->t_dcom[0], "nice") || eq(t->t_dcom[0], "nohup")) +++ if (t->t_dtyp == TPAR || t->t_dflg&(FREDO|FAND) || bifunc) + +#endif - pid = dofork(shudint, shudhup); +++ { forked++; pid = pfork(t, wanttty); } + +#ifdef VFORK - else { - savint = signal(SIGINT, SIG_IGN); - ochild = child; osetintr = setintr; - ohaderr = haderr; otimflg = timflg; - odidfds = didfds; odidcch = didcch; - oSHIN = SHIN; oSHOUT = SHOUT; - oSHDIAG = SHDIAG; oOLDSTD = OLDSTD; - Vsav = Vdp = 0; Vav = 0; - isvfork++; - pid = vfork(); - if (pid < 0) { - signal(SIGINT, savint); - error("No more processes"); - } - if (pid == 0) { - child++; - signal(SIGINT, shudint ? SIG_DFL : savint); - if (!shudhup) - signal(SIGHUP, SIG_IGN); - } else { - child = ochild; setintr = osetintr; - haderr = ohaderr; timflg = otimflg; - didfds = odidfds; didcch = odidcch; - SHIN = oSHIN; SHOUT = oSHOUT; - SHDIAG = oSHDIAG; OLDSTD = oOLDSTD; - xfree(Vsav), Vsav = 0; - xfree(Vdp), Vdp = 0; - xfree(Vav), Vav = 0; - signal(SIGINT, savint); +++ else { +++ int vffree(); +++ int ochild, osetintr, ohaderr, odidfds, odidcch; +++ int oSHIN, oSHOUT, oSHDIAG, oOLDSTD, otpgrp; +++ +++ sighold(SIGCHLD); +++ ochild = child; osetintr = setintr; +++ ohaderr = haderr; odidfds = didfds; odidcch = didcch; +++ oSHIN = SHIN; oSHOUT = SHOUT; +++ oSHDIAG = SHDIAG; oOLDSTD = OLDSTD; otpgrp = tpgrp; +++ Vsav = Vdp = 0; Vav = 0; +++ pid = vfork(); +++ if (pid < 0) { +++ sigrelse(SIGCHLD); +++ error("No more processes"); +++ } +++ forked++; +++ if (pid) { +++ child = ochild; setintr = osetintr; +++ haderr = ohaderr; didfds = odidfds; +++ didcch = odidcch; SHIN = oSHIN; +++ SHOUT = oSHOUT; SHDIAG = oSHDIAG; +++ OLDSTD = oOLDSTD; tpgrp = otpgrp; +++ xfree(Vsav); Vsav = 0; +++ xfree(Vdp); Vdp = 0; +++ xfree(Vav); Vav = 0; +++ /* this is from pfork() */ +++ palloc(pid, t); +++ sigrelse(SIGCHLD); +++ } else { +++ /* this is from pfork() */ +++ int pgrp; +++ bool ignint = 0; +++ +++ if (setintr) +++ ignint = +++ (tpgrp == -1 && (t->t_dflg&FINT)) +++ || gointr && eq(gointr, "-"); +++ pgrp = pcurrjob ? pcurrjob->p_jobid : getpid(); +++ child++; +++ if (setintr) { +++ setintr = 0; +++ sigsys(SIGCHLD, SIG_DFL); +++ sigsys(SIGINT, ignint ? SIG_IGN : vffree); +++ sigsys(SIGQUIT, ignint ? SIG_IGN : SIG_DFL); +++ if (wanttty >= 0) { +++ sigsys(SIGTSTP, SIG_DFL); +++ sigsys(SIGTTIN, SIG_DFL); +++ sigsys(SIGTTOU, SIG_DFL); +++ } +++ sigsys(SIGTERM, parterm); +++ } else if (tpgrp == -1 && (t->t_dflg&FINT)) { +++ sigsys(SIGINT, SIG_IGN); +++ sigsys(SIGQUIT, SIG_IGN); + + } +++ if (wanttty > 0) +++ ioctl(FSHTTY, TIOCSPGRP, &pgrp); +++ if (wanttty >= 0 && tpgrp >= 0) +++ setpgrp(0, pgrp); +++ if (tpgrp > 0) +++ tpgrp = 0; +++ if (t->t_dflg & FNOHUP) +++ sigsys(SIGHUP, SIG_IGN); +++ if (t->t_dflg & FNICE) +++ nice(t->t_nice); + + } +++ +++ } + +#endif + + if (pid != 0) { + + /* - * The parent path (or nobody does this if - * (flags & FPAR), i.e. date in (set;date)) +++ * It would be better if we could wait for the +++ * whole job when we knew the last process +++ * had been started. Pwait, in fact, does +++ * wait for the whole job anyway, but this test +++ * doesn't really express our intentions. + + */ - if (didfds == 0 && (flags & FPIN)) +++ if (didfds==0 && t->t_dflg&FPIN) + + close(pipein[0]), close(pipein[1]); - if (didfds && !(t->t_dflg & FREDO)) - donefds(); - if (flags & FPRS) - printf("%d\n", pid), set("child", putn(pid)); - /* - * Unless output is piped or command is & - * wait for it. - */ - if (t->t_dtyp == TCOM) - cadd(pid, t->t_dcom[0]); - else - cadd(pid, "()"); - if ((flags & (FPOU|FAND)) == 0) - pwait(pid); - return; +++ if ((t->t_dflg & (FPOU|FAND)) == 0) +++ pwait(); +++ break; + + } - - /* - * Insure that this (child) shell doesn't muck on - */ - child++; - - /* - * If havent yet, finally set up the file descriptors. - */ + + doio(t, pipein, pipeout); - if (flags & FPOU) +++ if (t->t_dflg & FPOU) + + close(pipeout[0]), close(pipeout[1]); + + + + /* - * If mucking with interrupts fix interrupt, quit, - * and terminate handling ... in any case set setintr - * to 0 if we are not interruptible so that no further - * interrupt mucking occurs. +++ * Perform a builtin function. +++ * If we are not forked, arrange for possible stopping + + */ - if (setintr) { - if (shudint) { - signal(SIGQUIT, SIG_DFL); - #ifdef VFORK - if (isvfork) - signal(SIGINT, vffree); - else - #endif - signal(SIGINT, SIG_DFL); - } - signal(SIGTERM, parterm); - if (flags & FINT) - setintr = 0; +++ if (bifunc) { +++ func(t, bifunc); +++ if (forked) +++ exitstat(); +++ break; +++ } +++ if (t->t_dtyp != TPAR) { +++ doexec(t); +++ /*NOTREACHED*/ + + } - + + /* + + * For () commands must put new 0,1,2 in FSH* and recurse + + */ - if (t->t_dtyp == TPAR) { - t1 = t->t_dspr; - t1->t_dflg |= flags & FINT; - OLDSTD = dcopy(0, FOLDSTD); - SHOUT = dcopy(1, FSHOUT); - SHDIAG = dcopy(2, FSHDIAG); - close(SHIN), SHIN = -1; - didcch = 0, didfds = 0; - execute(t1); - exitstat(); - } - if (eq(t->t_dcom[0], "nice")) { - /* sigh... - nice(20); - nice(-10); - */ - cp = t->t_dcom[1]; - if (any(cp[0], "+-")) - nice(getn(cp)), lshift(t->t_dcom, 2); - else - nice(4), lshift(t->t_dcom, 1); - t->t_dflg = FPAR | FREDO; - execute(t); - exitstat(); - } - if (eq(t->t_dcom[0], "nohup")) { - if (setintr == 0) - signal(SIGHUP, SIG_IGN); - signal(SIGTERM, SIG_IGN); - lshift(t->t_dcom, 1); - t->t_dflg = FPAR | FREDO; - execute(t); - exitstat(); - } - doexec(t); - /* no return */ +++ OLDSTD = dcopy(0, FOLDSTD); +++ SHOUT = dcopy(1, FSHOUT); +++ SHDIAG = dcopy(2, FSHDIAG); +++ close(SHIN), SHIN = -1; +++ didcch = 0, didfds = 0; +++ wanttty = -1; +++ t->t_dspr->t_dflg |= t->t_dflg & FINT; +++ execute(t->t_dspr, wanttty); +++ exitstat(); + + + + case TFIL: - flags = t->t_dflg; - t1 = t->t_dcar; - t1->t_dflg |= FPOU | (flags & (FPIN|FINT|FPRS|FDIAG)); - execute(t1, pipein, pv); - t1 = t->t_dcdr; - t1->t_dflg |= FPIN | (flags & (FPOU|FINT|FAND|FPRS|FPAR)); - execute(t1, pv, pipeout); - return; +++ t->t_dcar->t_dflg |= FPOU | +++ (t->t_dflg & (FPIN|FAND|FDIAG|FINT)); +++ execute(t->t_dcar, wanttty, pipein, pv); +++ t->t_dcdr->t_dflg |= FPIN | +++ (t->t_dflg & (FPOU|FAND|FPAR|FINT)); +++ if (wanttty > 0) +++ wanttty = 0; /* got tty already */ +++ execute(t->t_dcdr, wanttty, pv, pipeout); +++ break; + + + + case TLST: - flags = t->t_dflg & FINT; - if (t1 = t->t_dcar) - t1->t_dflg |= flags, execute(t1); - if (t1 = t->t_dcdr) - t1->t_dflg |= t->t_dflg & (FINT|FPAR), execute(t1); - return; +++ if (t->t_dcar) { +++ t->t_dcar->t_dflg |= t->t_dflg & FINT; +++ execute(t->t_dcar, wanttty); +++ /* +++ * In strange case of A&B make a new job after A +++ */ +++ if (t->t_dcar->t_dflg&FAND && t->t_dcdr && +++ (t->t_dcdr->t_dflg&FAND) == 0) +++ pendjob(); +++ } +++ if (t->t_dcdr) { +++ t->t_dcdr->t_dflg |= t->t_dflg & (FPAR|FINT); +++ execute(t->t_dcdr, wanttty); +++ } +++ break; + + + + case TOR: + + case TAND: - flags = t->t_dflg & FINT; - if (t1 = t->t_dcar) { - t1->t_dflg |= flags, execute(t1); - if ((getn(value("status")) == 0) == (t->t_dtyp == TAND)) +++ if (t->t_dcar) { +++ t->t_dcar->t_dflg |= t->t_dflg & FINT; +++ execute(t->t_dcar, wanttty); +++ if ((getn(value("status")) == 0) != (t->t_dtyp == TAND)) + + return; + + } - if (t1 = t->t_dcdr) - t1->t_dflg |= t->t_dflg & (FINT|FPAR), execute(t1); - return; +++ if (t->t_dcdr) { +++ t->t_dcdr->t_dflg |= t->t_dflg & (FPAR|FINT); +++ execute(t->t_dcdr, wanttty); +++ } +++ break; + + } +++ /* +++ * Fall through for all breaks from switch +++ * +++ * If there will be no more executions of this +++ * command, flush all file descriptors. +++ * Places that turn on the FREDO bit are responsible +++ * for doing donefds after the last re-execution +++ */ +++ if (didfds && !(t->t_dflg & FREDO)) +++ donefds(); + +} + + + +#ifdef VFORK + +vffree() + +{ + + register char **v; + + + + if (v = gargv) + + gargv = 0, xfree(gargv); + + if (v = pargv) + + pargv = 0, xfree(pargv); + + _exit(1); + +} + +#endif + + +++/* +++ * Perform io redirection. +++ * We may or maynot be forked here. +++ */ + +doio(t, pipein, pipeout) + + register struct command *t; + + int *pipein, *pipeout; + +{ + + register char *cp; + + register int flags = t->t_dflg; - char *dp; + + + + if (didfds || (flags & FREDO)) + + return; - if (flags & FHERE) - goto skipin; - close(0); - if (cp = t->t_dlef) { - cp = globone(dp = Dfix1(cp)); - xfree(dp); - xfree(cp); - if (open(cp, 0) < 0) - Perror(cp); - } else if (flags & FPIN) - dup(pipein[0]), close(pipein[0]), close(pipein[1]); - else if (flags & FINT) - close(0), open("/dev/null", 0); - else - dup(OLDSTD); - - skipin: +++ if ((flags & FHERE) == 0) { /* FHERE already done */ +++ close(0); +++ if (cp = t->t_dlef) { +++ cp = globone(Dfix1(cp)); +++ xfree(cp); +++ if (open(cp, 0) < 0) +++ Perror(cp); +++ } else if (flags & FPIN) +++ dup(pipein[0]), close(pipein[0]), close(pipein[1]); +++ else if ((flags & FINT) && tpgrp == -1) +++ close(0), open("/dev/null", 0); +++ else +++ dup(OLDSTD); +++ } + + close(1); + + if (cp = t->t_drit) { - cp = globone(dp = Dfix1(cp)); - xfree(dp); +++ cp = globone(Dfix1(cp)); + + xfree(cp); + + if ((flags & FCAT) && open(cp, 1) >= 0) + + lseek(1, 0l, 2); + + else { + + if (!(flags & FANY) && adrof("noclobber")) { + + if (flags & FCAT) + + Perror(cp); + + chkclob(cp); + + } - #ifdef V6 - if (creat(cp, 0644) < 0) - Perror(cp); - #else + + if (creat(cp, 0666) < 0) + + Perror(cp); - #endif + + } - } else - dup((flags & FPOU) ? pipeout[1] : SHOUT); +++ } else if (flags & FPOU) +++ dup(pipeout[1]); +++ else +++ dup(SHOUT); + + + + close(2); + + dup((flags & FDIAG) ? 1 : SHDIAG); + + didfds = 1; + +} + + - dofork(shudint, shudhup) - bool shudint, shudhup; - { - register int pid, (*savint)(); - - savint = signal(SIGINT, SIG_IGN); - pid = fork(); - if (pid < 0) { - signal(SIGINT, savint); - error("No more processes"); - } - if (pid == 0) { - child++; - signal(SIGINT, shudint ? SIG_DFL : savint); - if (!shudhup) - signal(SIGHUP, SIG_IGN); - } else - signal(SIGINT, savint); - return (pid); - } - + +mypipe(pv) + + register int *pv; + +{ + + + + if (pipe(pv) < 0) + + goto oops; + + pv[0] = dmove(pv[0], -1); + + pv[1] = dmove(pv[1], -1); + + if (pv[0] >= 0 && pv[1] >= 0) + + return; + +oops: + + error("Can't make pipe"); + +} + + + +chkclob(cp) + + register char *cp; + +{ + + struct stat stb; + + + + if (stat(cp, &stb) < 0) + + return; + + if ((stb.st_mode & S_IFMT) == S_IFCHR) + + return; + + error("%s: File exists", cp); + +} diff --cc usr/src/cmd/csh/sh.set.c index 0000000000,b849c95cdb,0000000000..9228f54587 mode 000000,100644,000000..100644 --- a/usr/src/cmd/csh/sh.set.c +++ b/usr/src/cmd/csh/sh.set.c @@@@ -1,0 -1,520 -1,0 +1,555 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)sh.set.c 4.1 10/9/80"; +++ + +#include "sh.h" + + + +/* + + * C Shell + + */ + + + +doset(v) + + register char **v; + +{ + + register char *p; + + char *vp, op; +++ char **vecp; + + bool hadsub; + + int subscr; + + + + v++; + + p = *v++; + + if (p == 0) { + + prvars(); + + return; + + } + + do { + + hadsub = 0; - for (vp = p; letter(*p); p++) +++ for (vp = p; alnum(*p); p++) + + continue; + + if (vp == p) + + goto setsyn; + + if (*p == '[') { + + hadsub++; + + p = getinx(p, &subscr); + + } + + if (op = *p) { + + *p++ = 0; + + if (*p == 0 && *v && **v == '(') + + p = *v++; + + } else if (*v && eq(*v, "=")) { + + op = '=', v++; + + if (*v) + + p = *v++; + + } + + if (op && op != '=') + +setsyn: + + bferr("Syntax error"); + + if (eq(p, "(")) { + + register char **e = v; + + + + if (hadsub) + + goto setsyn; + + for (;;) { + + if (!*e) + + bferr("Missing )"); + + if (**e == ')') + + break; + + e++; + + } - p = *e, *e = 0, set1(vp, saveblk(v), &shvhed), *e = p; +++ p = *e; +++ *e = 0; +++ vecp = saveblk(v); +++ set1(vp, vecp, &shvhed); +++ *e = p; + + v = e + 1; + + } else if (hadsub) + + asx(vp, subscr, savestr(p)); + + else + + set(vp, savestr(p)); - if (strcmp(vp, "path") == 0) +++ if (eq(vp, "path")) { +++ exportpath(adrof("path")->vec); + + dohash(); +++ } else if (eq(vp, "histchars")) { +++ register char *p = value("histchars"); +++ +++ HIST = *p++; +++ HISTSUB = *p; +++ } else if (eq(vp, "user")) +++ setenv("USER", value(vp)); +++ else if (eq(vp, "term")) +++ setenv("TERM", value(vp)); +++ else if (eq(vp, "home")) +++ setenv("HOME", value(vp)); + + } while (p = *v++); + +} + + + +char * + +getinx(cp, ip) + + register char *cp; + + register int *ip; + +{ + + + + *ip = 0; + + *cp++ = 0; + + while (*cp && digit(*cp)) + + *ip = *ip * 10 + *cp++ - '0'; + + if (*cp++ != ']') + + bferr("Subscript error"); + + return (cp); + +} + + + +asx(vp, subscr, p) + + char *vp; + + int subscr; + + char *p; + +{ + + register struct varent *v = getvx(vp, subscr); + + + + xfree(v->vec[subscr - 1]); + + v->vec[subscr - 1] = globone(p); + +} + + + +struct varent * + +getvx(vp, subscr) + +{ + + register struct varent *v = adrof(vp); + + + + if (v == 0) + + udvar(vp); + + if (subscr < 1 || subscr > blklen(v->vec)) + + bferr("Subscript out of range"); + + return (v); + +} + + + +char plusplus[2] = { '1', 0 }; + + + + + +dolet(v) + + char **v; + +{ + + register char *p; + + char *vp, c, op; + + bool hadsub; + + int subscr; + + + + v++; + + p = *v++; + + if (p == 0) { + + prvars(); + + return; + + } + + do { + + hadsub = 0; + + for (vp = p; letter(*p); p++) + + continue; + + if (vp == p) + + goto letsyn; + + if (*p == '[') { + + hadsub++; + + p = getinx(p, &subscr); + + } + + if (*p == 0 && *v) + + p = *v++; + + if (op = *p) + + *p++ = 0; + + else + + goto letsyn; + + vp = savestr(vp); + + if (op == '=') { + + c = '='; + + p = xset(p, &v); + + } else { + + c = *p++; + + if (any(c, "+-")) { + + if (c != op || *p) + + goto letsyn; + + p = plusplus; + + } else { + + if (any(op, "<>")) { + + if (c != op) + + goto letsyn; + + c = *p++; + +letsyn: + + bferr("Syntax error"); + + } + + if (c != '=') + + goto letsyn; + + p = xset(p, &v); + + } + + } + + if (op == '=') + + if (hadsub) + + asx(vp, subscr, p); + + else + + set(vp, p); + + else + + if (hadsub) + +#ifndef V6 + + /* avoid bug in vax CC */ + + { + + struct varent *gv = getvx(vp, subscr); + + + + asx(vp, subscr, operate(op, gv->vec[subscr - 1], p)); + + } + +#else + + asx(vp, subscr, operate(op, getvx(vp, subscr)->vec[subscr - 1], p)); + +#endif + + else + + set(vp, operate(op, value(vp), p)); + + if (strcmp(vp, "path") == 0) + + dohash(); + + xfree(vp); + + if (c != '=') + + xfree(p); + + } while (p = *v++); + +} + + + +char * + +xset(cp, vp) + + char *cp, ***vp; + +{ + + register char *dp; + + + + if (*cp) { + + dp = savestr(cp); + + --(*vp); + + xfree(**vp); + + **vp = dp; + + } + + return (putn(exp(vp))); + +} + + + +char * + +operate(op, vp, p) + + char op, *vp, *p; + +{ + + char opr[2]; + + char *vec[5]; + + register char **v = vec; + + char **vecp = v; + + register int i; + + + + if (op != '=') { + + if (*vp) + + *v++ = vp; + + opr[0] = op; + + opr[1] = 0; + + *v++ = opr; + + if (op == '<' || op == '>') + + *v++ = opr; + + } + + *v++ = p; + + *v++ = 0; + + i = exp(&vecp); + + if (*vecp) + + bferr("Expression syntax"); + + return (putn(i)); + +} + + + +onlyread(cp) + + char *cp; + +{ + + extern char end[]; + + + + return (cp < end); + +} + + + +xfree(cp) + + char *cp; + +{ + + extern char end[]; + + + + if (cp >= end && cp < (char *) &cp) + + cfree(cp); + +} + + + +char * + +savestr(s) + + register char *s; + +{ +++ register char *n; + + + + if (s == 0) + + s = ""; - return (strcpy(calloc(1, strlen(s) + 1), s)); +++ strcpy(n = calloc(1, strlen(s) + 1), s); +++ return (n); + +} + + + +static char *putp; + + + +char * + +putn(n) + + register int n; + +{ + + static char number[15]; + + + + putp = number; + + if (n < 0) { + + n = -n; + + *putp++ = '-'; + + } + + if (sizeof (int) == 2 && n == -32768) { + + *putp++ = '3'; + + n = 2768; + +#ifdef pdp11 + + } + +#else + + } else if (sizeof (int) == 4 && n == -2147483648) { + + *putp++ = '2'; + + n = 147483648; + + } + +#endif + + putn1(n); + + *putp = 0; + + return (savestr(number)); + +} + + + +putn1(n) + + register int n; + +{ + + if (n > 9) + + putn1(n / 10); + + *putp++ = n % 10 + '0'; + +} + + + +getn(cp) + + register char *cp; + +{ + + register int n; + + int sign; + + + + sign = 0; + + if (cp[0] == '+' && cp[1]) + + cp++; + + if (*cp == '-') { + + sign++; + + cp++; + + if (!digit(*cp)) + + goto badnum; + + } + + n = 0; + + while (digit(*cp)) + + n = n * 10 + *cp++ - '0'; + + if (*cp) + + goto badnum; + + return (sign ? -n : n); + +badnum: + + bferr("Badly formed number"); + + return (0); + +} + + + +char * + +value(var) + + char *var; + +{ + + + + return (value1(var, &shvhed)); + +} + + + +char * + +value1(var, head) + + char *var; + + struct varent *head; + +{ + + register struct varent *vp; + + + + vp = adrof1(var, head); + + return (vp == 0 || vp->vec[0] == 0 ? "" : vp->vec[0]); + +} + + + +static struct varent *shprev; + + + +struct varent * + +adrof(var) + + char *var; + +{ + + + + return (adrof1(var, &shvhed)); + +} + + + +struct varent * + +madrof(pat, head) + + char *pat; + + struct varent *head; + +{ + + register struct varent *vp; + + + + shprev = head; + + for (vp = shprev->link; vp != 0; vp = vp->link) { + + if (Gmatch(vp->name, pat)) + + return (vp); + + shprev = vp; + + } + + return (0); + +} + + + +struct varent * + +adrof1(var, head) + + char *var; + + struct varent *head; + +{ + + register struct varent *vp; + + int cmp; + + + + shprev = head; + + for (vp = shprev->link; vp != 0; vp = vp->link) { + + cmp = strcmp(vp->name, var); + + if (cmp == 0) + + return (vp); + + else if (cmp > 0) + + return (0); + + shprev = vp; + + } + + return (0); + +} + + + +/* + + * The caller is responsible for putting value in a safe place + + */ + +set(var, value) + + char *var, *value; + +{ + + register char **vec = (char **) calloc(2, sizeof (char **)); + + + + vec[0] = onlyread(value) ? savestr(value) : value; + + set1(var, vec, &shvhed); + +} + + + +set1(var, vec, head) + + char *var, **vec; + + struct varent *head; + +{ + + + + register char **oldv = vec; + + + + gflag = 0; rscan(oldv, tglob); + + if (gflag) { + + vec = glob(oldv); + + if (vec == 0) { + + bferr("No match"); + + blkfree(oldv); + + return; + + } + + blkfree(oldv); + + gargv = 0; + + } + + setq(var, vec, head); + +} + + + +setq(var, vec, head) + + char *var, **vec; + + struct varent *head; + +{ + + register struct varent *vp; + + + + vp = adrof1(var, head); + + if (vp == 0) { + + vp = (struct varent *) calloc(1, sizeof *vp); + + vp->name = savestr(var); + + vp->link = shprev->link; + + shprev->link = vp; + + } + + if (vp->vec) + + blkfree(vp->vec); + + scan(vec, trim); + + vp->vec = vec; + +} + + + +unset(v) + + register char *v[]; + +{ + + + + unset1(v, &shvhed); +++ if (adrof("histchars") == 0) { +++ HIST = '!'; +++ HISTSUB = '^'; +++ } + +} + + + +unset1(v, head) + + register char *v[]; + + struct varent *head; + +{ + + register char *var; + + register struct varent *vp; + + register int cnt; + + + + v++; + + while (var = *v++) { + + cnt = 0; + + while (vp = madrof(var, head)) + + unsetv1(vp->name, head), cnt++; - /* + + if (cnt == 0) - setname(var), bferr("No match"); - */ +++ setname(var); + + } + +} + + + +unsetv(var) + + char *var; + +{ + + + + unsetv1(var, &shvhed); + +} + + + +unsetv1(var, head) + + char *var; + + struct varent *head; + +{ + + register struct varent *vp; + + + + vp = adrof1(var, head); + + if (vp == 0) + + udvar(var); + + vp = shprev->link; + + shprev->link = vp->link; + + blkfree(vp->vec); + + xfree(vp->name); - xfree(vp); +++ xfree((char *)vp); + +} + + + +setNS(cp) + + char *cp; + +{ + + + + set(cp, ""); + +} + + + +shift(v) + + register char **v; + +{ + + register struct varent *argv; + + register char *name; + + + + v++; + + name = *v; + + if (name == 0) + + name = "argv"; + + else + + strip(name); + + argv = adrof(name); + + if (argv == 0) + + udvar(name); + + if (argv->vec[0] == 0) + + bferr("No more words"); + + lshift(argv->vec, 1); + +} + + - deletev(cp) - register char *cp; +++exportpath(val) +++char **val; + +{ - - if (adrof(cp)) - unsetv(cp); +++ char exppath[BUFSIZ]; +++ register char *dir; +++ +++ exppath[0] = 0; +++ if (val) +++ while (*val) { +++ if (strlen(*val) + strlen(exppath) + 2 > BUFSIZ) { +++ printf("Warning: ridiculously long PATH truncated\n"); +++ break; +++ } +++ strcat(exppath, *val++); +++ if (*val == 0 || eq(*val, ")")) +++ break; +++ strcat(exppath, ":"); +++ } +++ setenv("PATH", exppath); + +} diff --cc usr/src/cmd/csh/sh.time.c index 0000000000,0000000000,0000000000..5f8fda5191 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/csh/sh.time.c @@@@ -1,0 -1,0 -1,0 +1,180 @@@@ +++static char *sccsid = "@(#)sh.time.c 4.1 10/9/80"; +++ +++#include "sh.h" +++ +++/* +++ * C Shell - routines handling process timing and niceing +++ */ +++#ifdef VMUNIX +++struct vtimes vm0; +++#else +++struct tms times0; +++struct tms timesdol; +++#endif +++ +++settimes() +++{ +++ +++ time(&time0); +++#ifdef VMUNIX +++ vtimes(&vm0, 0); +++#else +++ times(×0); +++#endif +++} +++ +++/* +++ * dotime is only called if it is truly a builtin function and not a +++ * prefix to another command +++ */ +++dotime() +++{ +++ time_t timedol; +++#ifdef VMUNIX +++ struct vtimes vm1, vmch; +++ +++ vtimes(&vm1, &vmch); +++ vmsadd(&vm1, &vmch); +++#endif +++ +++ time(&timedol); +++#ifdef VMUNIX +++ pvtimes(&vm0, &vm1, timedol - time0); +++#else +++ times(×dol); +++ ptimes(timedol - time0, ×0, ×dol); +++#endif +++} +++ +++/* +++ * donice is only called when it on the line by itself or with a +- value +++ */ +++donice(v) +++ register char **v; +++{ +++ register char *cp; +++ +++ v++, cp = *v++; +++ if (cp == 0) { +++#ifndef V6 +++ nice(20); +++ nice(-10); +++#endif +++ nice(4); +++ } else if (*v == 0 && any(cp[0], "+-")) { +++#ifndef V6 +++ nice(20); +++ nice(-10); +++#endif +++ nice(getn(cp)); +++ } +++} +++ +++#ifndef VMUNIX +++ptimes(utime, stime, etime) +++ register time_t utime, stime, etime; +++{ +++ +++ p60ths(utime); +++ printf("u "); +++ p60ths(stime); +++ printf("s "); +++ psecs(etime); +++ printf(" %d%%\n", (int) (100 * (utime+stime) / +++ (60 * (etime ? etime : 1)))); +++} +++ +++#else +++vmsadd(vp, wp) +++ register struct vtimes *vp, *wp; +++{ +++ +++ vp->vm_utime += wp->vm_utime; +++ vp->vm_stime += wp->vm_stime; +++ vp->vm_nswap += wp->vm_nswap; +++ vp->vm_idsrss += wp->vm_idsrss; +++ vp->vm_ixrss += wp->vm_ixrss; +++ if (vp->vm_maxrss < wp->vm_maxrss) +++ vp->vm_maxrss = wp->vm_maxrss; +++ vp->vm_majflt += wp->vm_majflt; +++ vp->vm_minflt += wp->vm_minflt; +++ vp->vm_inblk += wp->vm_inblk; +++ vp->vm_oublk += wp->vm_oublk; +++} +++ +++pvtimes(v0, v1, sec) +++ register struct vtimes *v0, *v1; +++ time_t sec; +++{ +++ register time_t t = +++ (v1->vm_utime-v0->vm_utime)+(v1->vm_stime-v0->vm_stime); +++ register char *cp; +++ register int i; +++ register struct varent *vp = adrof("time"); +++ +++ cp = "%Uu %Ss %E %P %X+%Dk %I+%Oio %Fpf+%Ww"; +++ if (vp && vp->vec[0] && vp->vec[1]) +++ cp = vp->vec[1]; +++ for (; *cp; cp++) +++ if (*cp != '%') +++ putchar(*cp); +++ else if (cp[1]) switch(*++cp) { +++ +++ case 'U': +++ p60ths(v1->vm_utime - v0->vm_utime); +++ break; +++ +++ case 'S': +++ p60ths(v1->vm_stime - v0->vm_stime); +++ break; +++ +++ case 'E': +++ psecs(sec); +++ break; +++ +++ case 'P': +++ printf("%d%%", (int) ((100 * t) / (60 * (sec ? sec : 1)))); +++ break; +++ +++ case 'W': +++ i = v1->vm_nswap - v0->vm_nswap; +++ printf("%d", i); +++ break; +++ +++ case 'X': +++ printf("%d", t == 0 ? 0 : (v1->vm_ixrss-v0->vm_ixrss)/(2*t)); +++ break; +++ +++ case 'D': +++ printf("%d", t == 0 ? 0 : (v1->vm_idsrss-v0->vm_idsrss)/(2*t)); +++ break; +++ +++ case 'K': +++ printf("%d", t == 0 ? 0 : ((v1->vm_ixrss+v1->vm_idsrss) - +++ (v0->vm_ixrss+v0->vm_idsrss))/(2*t)); +++ break; +++ +++ case 'M': +++ printf("%d", v1->vm_maxrss/2); +++ break; +++ +++ case 'F': +++ printf("%d", v1->vm_majflt-v0->vm_majflt); +++ break; +++ +++ case 'R': +++ printf("%d", v1->vm_minflt-v0->vm_minflt); +++ break; +++ +++ case 'I': +++ printf("%d", v1->vm_inblk-v0->vm_inblk); +++ break; +++ +++ case 'O': +++ printf("%d", v1->vm_oublk-v0->vm_oublk); +++ break; +++ +++ } +++ putchar('\n'); +++} +++#endif diff --cc usr/src/cmd/ctags.c index 0000000000,dcb89cfa80,0000000000..dc4220e2b6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ctags.c +++ b/usr/src/cmd/ctags.c @@@@ -1,0 -1,615 -1,0 +1,664 @@@@ - #include +++static char *sccsid = "@(#)ctags.c 4.2 (Berkeley) 10/3/80"; +++#include +++#include + + + +/* - * This program examines each of its arguments for C function - * definitions, and puts them in a file "tags" for use by the editor - * (and anyone else who wants to). - */ - - /* - * program history: - * ken arnold wrote this program. ask him. - * brought over to the vax by peter b. kessler 7/79 - * who disavows any knowledge of its actions, - * except for the stuff related to the construction - * of the search patterns. - * Some additional enhancements made by Mark Horton, involving - * the options and special treatment of "main", "}" at beginning - * of line, and a few bug fixes. +++ * ctags + + */ + + + +#define reg register + +#define logical char + + + +#define TRUE (1) + +#define FALSE (0) + + + +#define iswhite(arg) (_wht[arg]) /* T if char is white */ + +#define begtoken(arg) (_btk[arg]) /* T if char can start token */ + +#define intoken(arg) (_itk[arg]) /* T if char can be in token */ + +#define endtoken(arg) (_etk[arg]) /* T if char ends tokens */ + +#define isgood(arg) (_gd[arg]) /* T if char can be after ')' */ + + + +#define max(I1,I2) (I1 > I2 ? I1 : I2) + + + +struct nd_st { /* sorting structure */ + + char *func; /* function name */ + + char *file; /* file name */ +++ int lno; /* for -x option */ + + char *pat; /* search pattern */ + + logical been_warned; /* set if noticed dup */ + + struct nd_st *left,*right; /* left and right sons */ + +}; + + + +long ftell(); - #ifdef DEBUG - char *unctrl(); - #endif + +typedef struct nd_st NODE; + + + +logical number, /* T if on line starting with # */ + + term = FALSE, /* T if print on terminal */ + + makefile= TRUE, /* T if to creat "tags" file */ + + gotone, /* found a func already on line */ + + /* boolean "func" (see init) */ + + _wht[0177],_etk[0177],_itk[0177],_btk[0177],_gd[0177]; + + + +char searchar = '?'; /* use ?...? searches */ - #define MAXPATTERN 50 /* according to bill */ + + + +int lineno; /* line number of current line */ - char line[256], /* current input line */ +++char line[4*BUFSIZ], /* current input line */ + + *curfile, /* current input file name */ + + *outfile= "tags", /* output file */ + + *white = " \f\t\n", /* white chars */ + + *endtk = " \t\n\"'#()[]{}=-+%*/&|^~!<>;,.:?", + + /* token ending chars */ + + *begtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz", + + /* token starting chars */ + + *intk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz0123456789", /* valid in-token chars */ + + *notgd = ",;"; /* non-valid after-function chars */ + + + +int file_num; /* current file number */ + +int aflag; /* -a: append to tags */ + +int uflag; /* -u: update tags */ + +int wflag; /* -w: suppress warnings */ +++int xflag; /* -x: create cxref style output */ +++ +++char lbuf[BUFSIZ]; + + + +FILE *inf, /* ioptr for current input file */ + + *outf; /* ioptr for tags file */ + + + +long lineftell; /* ftell after getc( inf ) == '\n' */ + + + +NODE *head; /* the head of the sorted binary tree */ + + +++char *savestr(); +++char *rindex(); + +main(ac,av) + +int ac; + +char *av[]; + +{ + + char cmd[100]; + + int i; + + + + while (ac > 1 && av[1][0] == '-') { + + for (i=1; av[1][i]; i++) { + + switch(av[1][i]) { + + case 'a': + + aflag++; + + break; + + case 'u': + + uflag++; + + break; + + case 'w': + + wflag++; + + break; - +++ case 'x': +++ xflag++; +++ break; + + default: + + goto usage; + + } + + } + + ac--; av++; + + } + + + + if (ac <= 1) { + + usage: printf("Usage: ctags [-au] file ...\n"); + + exit(1); + + } + + + + init(); /* set up boolean "functions" */ + + /* + + * loop through files finding functions + + */ + + for (file_num = 1; file_num < ac; file_num++) + + find_funcs(av[file_num]); + + +++ if (xflag) { +++ put_funcs(head); +++ exit(0); +++ } + + if (uflag) { + + for (i=1; i %s ; rm OTAGS", outfile, av[i], outfile); +++ sprintf(cmd, +++ "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS", +++ outfile, av[i], outfile); + + system(cmd); + + } + + aflag++; + + } - - if ((outf = fopen(outfile, aflag ? "a" : "w")) == NULL) { +++ outf = fopen(outfile, aflag ? "a" : "w"); +++ if (outf == NULL) { + + perror(outfile); + + exit(1); + + } - put_funcs(head); /* put the data in "tags" */ +++ put_funcs(head); +++ fclose(outf); +++ if (uflag) { +++ sprintf(cmd, "sort %s -o %s", outfile, outfile); +++ system(cmd); +++ } + + exit(0); + +} + + + +/* - * This routine sets up the boolean psuedo-functions which work +++ * This routine sets up the boolean psuedo-functions which work + + * by seting boolean flags dependent upon the corresponding character - + + * Every char which is NOT in that string is not a white char. Therefore, + + * all of the array "_wht" is set to FALSE, and then the elements + + * subscripted by the chars in "white" are set to TRUE. Thus "_wht" + + * of a char is TRUE if it is the string "white", else FALSE. - * It also open up the "tags" output file. + + */ + +init() + +{ + + + + reg char *sp; + + reg int i; + + + + for (i = 0; i < 0177; i++) { + + _wht[i] = _etk[i] = _itk[i] = _btk[i] = FALSE; + + _gd[i] = TRUE; + + } + + for (sp = white; *sp; sp++) + + _wht[*sp] = TRUE; + + for (sp = endtk; *sp; sp++) + + _etk[*sp] = TRUE; + + for (sp = intk; *sp; sp++) + + _itk[*sp] = TRUE; + + for (sp = begtk; *sp; sp++) + + _btk[*sp] = TRUE; + + for (sp = notgd; *sp; sp++) + + _gd[*sp] = FALSE; + +} + + + +/* - * This program opens the specified file and calls the function - * which finds the function defenitions. +++ * This routine opens the specified file and calls the function +++ * which finds the function definitions. + + */ + +find_funcs(file) + +char *file; + +{ +++ char *cp; + + + + if ((inf=fopen(file,"r")) == NULL) { + + perror(file); + + return; + + } - - curfile = (char *) calloc(strlen(file)+1,1); - strcpy(curfile, file); - lineno = 1; - C_funcs(); /* find the C-style functions */ +++ curfile = savestr(file); +++ cp = rindex(file, '.'); +++ if (cp && (cp[1] != 'c' || cp[1] != 'h') && cp[2] == 0) { +++ if (PF_funcs(inf) == 0) { +++ rewind(inf); +++ C_funcs(); +++ } +++ } else +++ C_funcs(); + + fclose(inf); + +} + + +++pfnote(name, ln) +++ char *name; +++{ +++ register char *fp; +++ register NODE *np; +++ char nbuf[BUFSIZ]; +++ +++ if ((np = (NODE *) malloc(sizeof (NODE))) == NULL) { +++ fprintf(stderr, "ctags: too many functions to sort\n"); +++ put_funcs(head); +++ free_tree(head); +++ head = np = (NODE *) malloc(sizeof (NODE)); +++ } +++ if (xflag == 0 && !strcmp(name, "main")) { +++ fp = rindex(curfile, '/'); +++ if (fp == 0) +++ fp = curfile; +++ else +++ fp++; +++ sprintf(nbuf, "M%s", fp); +++ fp = rindex(nbuf, '.'); +++ if (fp && fp[2] == 0) +++ *fp = 0; +++ name = nbuf; +++ } +++ np->func = savestr(name); +++ np->file = curfile; +++ np->lno = ln; +++ np->left = np->right = 0; +++ if (xflag == 0) { +++ lbuf[50] = 0; +++ strcat(lbuf, "$"); +++ lbuf[50] = 0; +++ } +++ np->pat = savestr(lbuf); +++ if (head == NULL) +++ head = np; +++ else +++ add_node(np, head); +++} +++ + +/* - * This routine finds functions in C syntax and adds them +++ * This routine finds functions in C syntax and adds them + + * to the list. + + */ + +C_funcs() + +{ +++ register int c; +++ register char *token, *tp; +++ int incomm, inquote, inchar, midtoken, level; +++ char *sp; +++ char tok[BUFSIZ]; + + - reg char c, /* current input char */ - *token, /* start of current token */ - *tp; /* end of current token */ - logical incom, /* T if inside a comment */ - inquote, /* T if inside a quoted string */ - inchar, /* T if inside a single char ' */ - midtoken; /* T if in middle of token */ - char *sp; /* current input char */ - char tok[100]; - long insub; /* level of "{}"s deep */ - - /* - * init boolean flags, counters, and pointers - */ - - number = gotone = midtoken = inquote = inchar = incom = FALSE; - insub = 0L; +++ lineno = 1; +++ number = gotone = midtoken = inquote = inchar = incomm = FALSE; +++ level = 0; + + sp = tp = token = line; - #ifdef DEBUG - printf(" t s c m q c g n\n"); - printf(" s t k u o i u h o u\n"); - printf(" c p p n b m d o r t m\n"); - #endif - while ((*sp=c=getc(inf)) != EOF) { - #ifdef DEBUG - printf("%2.2s: ",unctrl(c)); - printf("%2.2s ",unctrl(*sp)); - printf("%2.2s ",unctrl(*tp)); - printf("%2.2s ",unctrl(*token)); - printf("%2ld %d %d %d %d %d %d\n",insub,incom,midtoken,inquote,inchar,gotone,number); - #endif - /* - * action based on mixture of character type, *sp, - * and logical flags - */ - +++ for (;;) { +++ *sp=c=getc(inf); +++ if (feof(inf)) +++ break; +++ if (c == '\n') +++ lineno++; + + if (c == '\\') { + + c = *++sp = getc(inf); - /* - * Handling of backslash is very naive. - * We do, however, turn escaped newlines - * into spaces. - */ + + if (c = '\n') + + c = ' '; - } - else if (incom) { +++ } else if (incomm) { + + if (c == '*') { - while ((*++sp=c=getc(inf)) == '*') { - #ifdef DEBUG - printf("%2.2s- ",unctrl(c)); - printf("%2.2s ",unctrl(*sp)); - printf("%2.2s ",unctrl(*tp)); - printf("%2.2s ",unctrl(*token)); - printf("%2ld %d %d %d %d %d %d\n",insub,incom,midtoken,inquote,inchar,gotone,number); - #endif +++ while ((*++sp=c=getc(inf)) == '*') + + continue; - } - #ifdef DEBUG - printf("%2.2s- ",unctrl(c)); - printf("%2.2s ",unctrl(*sp)); - printf("%2.2s ",unctrl(*tp)); - printf("%2.2s ",unctrl(*token)); - printf("%2ld %d %d %d %d %d %d\n",insub,incom,midtoken,inquote,inchar,gotone,number); - #endif +++ if (c == '\n') +++ lineno++; + + if (c == '/') - incom = FALSE; +++ incomm = FALSE; + + } - } - else if (inquote) { +++ } else if (inquote) { + + /* + + * Too dumb to know about \" not being magic, but + + * they usually occur in pairs anyway. + + */ - if ( c == '"' ) +++ if (c == '"') + + inquote = FALSE; + + continue; - } - else if (inchar) { - if ( c == '\'' ) +++ } else if (inchar) { +++ if (c == '\'') + + inchar = FALSE; + + continue; - } - else if (c == '"') +++ } else switch (c) { +++ case '"': + + inquote = TRUE; - else if (c == '\'') +++ continue; +++ case '\'': + + inchar = TRUE; - else if (c == '/') +++ continue; +++ case '/': + + if ((*++sp=c=getc(inf)) == '*') - incom = TRUE; +++ incomm = TRUE; + + else - ungetc(*sp,inf); - else if (c == '#' && sp == line) - number = TRUE; - else if (c == '{') - insub++; - else if (c == '}') +++ ungetc(*sp, inf); +++ continue; +++ case '#': + + if (sp == line) - /* - * Kludge to get back in sync after getting confused. - * We really shouldn't be looking at indenting style, - * but tricking with the preprocessor can get us off, - * and most people indent this way anyway. - * This resets level of indenting to zero if '}' is - * found at beginning of line. - */ - insub = 0; +++ number = TRUE; +++ continue; +++ case '{': +++ level++; +++ continue; +++ case '}': +++ if (sp == line) +++ level = 0; /* reset */ + + else - insub--; - else if (!insub && !inquote && !inchar && !gotone) { +++ level--; +++ continue; +++ } +++ if (!level && !inquote && !incomm && gotone == 0) { + + if (midtoken) { + + if (endtoken(c)) { +++ int pfline = lineno; + + if (start_func(&sp,token,tp)) { + + strncpy(tok,token,tp-token+1); + + tok[tp-token+1] = 0; - add_func(tok); +++ getline(); +++ pfnote(tok, pfline); + + gotone = TRUE; + + } + + midtoken = FALSE; + + token = sp; - } - else if (intoken(c)) +++ } else if (intoken(c)) + + tp++; - } - else if (begtoken(c)) { +++ } else if (begtoken(c)) { + + token = tp = sp; + + midtoken = TRUE; + + } + + } - - /* - * move on to next char, and set flags accordingly - */ - + + sp++; - if (c == '\n') { +++ if (c == '\n' || sp > &line[sizeof (line) - BUFSIZ]) { + + tp = token = sp = line; - lineftell = ftell( inf ); - #ifdef DEBUG - printf("lineftell saved as %ld\n",lineftell); - #endif +++ lineftell = ftell(inf); + + number = gotone = midtoken = inquote = inchar = FALSE; - lineno++; + + } + + } + +} + + + +/* + + * This routine checks to see if the current token is + + * at the start of a function. It updates the input line + + * so that the '(' will be in it when it returns. + + */ + +start_func(lp,token,tp) + +char **lp,*token,*tp; + +{ + + + + reg char c,*sp,*tsp; + + static logical found; + + logical firsttok; /* T if have seen first token in ()'s */ + + int bad; + + + + sp = *lp; + + c = *sp; + + bad = FALSE; - if (!number) /* space is not allowed in macro defs */ +++ if (!number) { /* space is not allowed in macro defs */ + + while (iswhite(c)) { + + *++sp = c = getc(inf); - #ifdef DEBUG - printf("%2.2s:\n",unctrl(c)); - #endif +++ if (c == '\n') { +++ lineno++; +++ if (sp > &line[sizeof (line) - BUFSIZ]) +++ goto ret; +++ } + + } + + /* the following tries to make it so that a #define a b(c) */ + + /* doesn't count as a define of b. */ - else { +++ } else { + + logical define; + + + + define = TRUE; + + for (tsp = "define"; *tsp && token < tp; tsp++) + + if (*tsp != *token++) { + + define = FALSE; + + break; + + } + + if (define) + + found = 0; + + else + + found++; + + if (found >= 2) { + + gotone = TRUE; + +badone: bad = TRUE; + + goto ret; + + } + + } + + if (c != '(') + + goto badone; + + firsttok = FALSE; + + while ((*++sp=c=getc(inf)) != ')') { +++ if (c == '\n') { +++ lineno++; +++ if (sp > &line[sizeof (line) - BUFSIZ]) +++ goto ret; +++ } + + /* + + * This line used to confuse ctags: + + * int (*oldhup)(); + + * This fixes it. A nonwhite char before the first + + * token, other than a / (in case of a comment in there) + + * makes this not a declaration. + + */ + + if (begtoken(c) || c=='/') firsttok++; + + else if (!iswhite(c) && !firsttok) goto badone; - #ifdef DEBUG - printf("%2.2s:\n",unctrl(c)); - #endif + + } - #ifdef DEBUG - printf("%2.2s:\n",unctrl(c)); - #endif + + while (iswhite(*++sp=c=getc(inf))) - #ifdef DEBUG - printf("%2.2s:\n",unctrl(c)) - #endif - ; - #ifdef DEBUG - printf("%2.2s:\n",unctrl(c)); - #endif +++ if (c == '\n') { +++ lineno++; +++ if (sp > &line[sizeof (line) - BUFSIZ]) +++ break; +++ } + +ret: + + *lp = --sp; +++ if (c == '\n') +++ lineno--; + + ungetc(c,inf); + + return !bad && isgood(c); + +} + + - /* - * This routine adds a function to the list - */ - add_func(token) - char *token; +++getline() + +{ - reg char *fp,*pp; - reg NODE *np; - - if ((np = (NODE *) calloc(1,sizeof (NODE))) == NULL) { - printf("too many functions to sort\n"); - put_funcs(head); - free_tree(head); - head = np = (NODE *) calloc(1,sizeof (NODE)); - } - if (strcmp(token,"main") == 0) { - /* - * Since there are so many directories with lots of - * misc. complete programs in them, main tends to get - * redefined a lot. So we change all mains to instead - * refer to the name of the file, without leading - * pathname components and without a trailing .c. - */ - fp = curfile; - for (pp=curfile; *pp; pp++) - if (*pp == '/') - fp = pp+1; - *token = 'M'; - strcpy(token+1, fp); - pp = &token[strlen(token)-2]; - if (*pp == '.') - *pp = 0; - } - fp = np->func = (char *) calloc(strlen(token)+1,sizeof (char)); - np->file = curfile; - strcpy(fp, token); - { /* - * this change to make the whole line the pattern - */ - long saveftell = ftell( inf ); - int patlen; - char ch; - - patlen = 0; - fseek( inf , lineftell , 0 ); - #ifdef DEBUG - printf("saveftell=%ld, lseek back to %ld\n",saveftell,lineftell); - #endif - ch = getc( inf ); - while ( ch != '\n' && ch != searchar && patlen < MAXPATTERN ) { - patlen ++; - ch = getc( inf ); - } - pp = np -> pat = (char *) calloc( patlen + 2 , sizeof( char ) ); - fseek( inf , lineftell , 0 ); - ch = getc( inf ); - while ( patlen -- ) { - *pp ++ = ch; - ch = getc( inf ); - } - if ( ch == '\n' ) - *pp ++ = '$'; - *pp = '\0'; - fseek( inf , saveftell , 0 ); - #ifdef DEBUG - printf("seek back to %ld, ftell is now %ld\n",saveftell,ftell(inf)); - #endif - } - #ifdef DEBUG - printf("\"%s\"\t\"%s\"\t\"%s\"\n",np->func,np->file,np->pat); - #endif - if (head == NULL) - head = np; - else - add_node(np,head); +++ long saveftell = ftell( inf ); +++ register char *cp; +++ +++ fseek( inf , lineftell , 0 ); +++ fgets(lbuf, sizeof lbuf, inf); +++ cp = rindex(lbuf, '\n'); +++ if (cp) +++ *cp = 0; +++ fseek(inf, saveftell, 0); + +} + + - /* - * This routine cfrees the entire tree from the node down. - */ + +free_tree(node) + +NODE *node; + +{ + + + + while (node) { + + free_tree(node->right); + + cfree(node); + + node = node->left; + + } + +} + + - /* - * This routine finds the node where the new function node - * should be added. - */ - add_node(node,cur_node) - NODE *node,*cur_node; +++add_node(node, cur_node) +++ NODE *node,*cur_node; + +{ - - reg int dif; +++ register int dif; + + + + dif = strcmp(node->func,cur_node->func); - #ifdef DEBUG - printf("strcmp(\"%s\",\"%s\") == %d\n",node->func,cur_node->func,dif); - #endif + + if (dif == 0) { + + if (node->file == cur_node->file) { + + if (!wflag) { - fprintf(stderr,"Duplicate function in file \"%s\", line %d: %s\n",node->file,lineno,node->func); - fprintf(stderr,"Second entry ignored\n"); +++fprintf(stderr,"Duplicate function in file %s, line %d: %s\n", +++ node->file,lineno,node->func); +++fprintf(stderr,"Second entry ignored\n"); + + } + + return; + + } - else { - if (!cur_node->been_warned) - if (!wflag) - fprintf(stderr,"Duplicate function name in files %s and %s: %s (Warning only)\n", - node->file, cur_node->file, node->func); - cur_node->been_warned = TRUE; - } - } - if (dif < 0) +++ if (!cur_node->been_warned) +++ if (!wflag) +++fprintf(stderr,"Duplicate function in files %s and %s: %s (Warning only)\n", +++ node->file, cur_node->file, node->func); +++ cur_node->been_warned = TRUE; +++ return; +++ } +++ if (dif < 0) { + + if (cur_node->left != NULL) + + add_node(node,cur_node->left); - else { - #ifdef DEBUG - printf("adding to left branch\n"); - #endif +++ else + + cur_node->left = node; - } +++ return; +++ } +++ if (cur_node->right != NULL) +++ add_node(node,cur_node->right); + + else - if (cur_node->right != NULL) - add_node(node,cur_node->right); - else { - #ifdef DEBUG - printf("adding to right branch\n"); - #endif - cur_node->right = node; - } +++ cur_node->right = node; + +} + + - /* - * This routine puts the functions in the file. - */ + +put_funcs(node) - NODE *node; +++reg NODE *node; + +{ +++ reg char *sp; + + + + if (node == NULL) + + return; + + put_funcs(node->left); - fprintf(outf,"%s\t%s\t%c^%s%c\n",node->func,node->file - ,searchar,node->pat,searchar); +++ if (xflag == 0) { +++ fprintf(outf, "%s\t%s\t%c^", node->func, node->file ,searchar); +++ for (sp = node->pat; *sp; sp++) +++ if (*sp == '\\') +++ fprintf(outf, "\\\\"); +++ else +++ putc(*sp, outf); +++ fprintf(outf, "%c\n", searchar); +++ } +++ else +++ fprintf(stdout, "%-16s%4d %-16s %s\n", +++ node->func, node->lno, node->file, node->pat); + + put_funcs(node->right); + +} + + - #ifdef DEBUG - char * - unctrl(c) - char c; +++char *dbp = lbuf; +++int pfcnt; +++ +++PF_funcs(fi) +++ FILE *fi; + +{ - static char buf[3]; - if (c>=' ' && c<='~') { - buf[0] = c; - buf[1] = 0; - } else if (c > '~') { - buf[0] = '^'; - buf[1] = '?'; - buf[2] = 0; - } else if (c < 0) { - buf[0] = buf[1] = '?'; - buf[2] = 0; - } else { - buf[0] = '\\'; - buf[2] = 0; - switch(c) { - case '\b': - buf[1] = 'b'; +++ +++ lineno = 0; +++ pfcnt = 0; +++ while (fgets(lbuf, sizeof(lbuf), fi)) { +++ lineno++; +++ dbp = lbuf; +++ if ( *dbp == '%' ) dbp++ ; /* Ratfor escape to fortran */ +++ while (isspace(*dbp)) +++ dbp++; +++ if (*dbp == 0) +++ continue; +++ switch (*dbp |' ') { +++ +++ case 'i': +++ if (tail("integer")) +++ takeprec(); +++ break; +++ case 'r': +++ if (tail("real")) +++ takeprec(); + + break; - case '\t': - buf[1] = 't'; +++ case 'l': +++ if (tail("logical")) +++ takeprec(); + + break; - case '\n': - buf[1] = 'n'; +++ case 'c': +++ if (tail("complex") || tail("character")) +++ takeprec(); +++ break; +++ case 'd': +++ if (tail("double")) { +++ while (isspace(*dbp)) +++ dbp++; +++ if (*dbp == 0) +++ continue; +++ if (tail("precision")) +++ break; +++ continue; +++ } + + break; - default: - buf[0] = '^'; - buf[1] = c + 64; + + } +++ while (isspace(*dbp)) +++ dbp++; +++ if (*dbp == 0) +++ continue; +++ switch (*dbp|' ') { +++ +++ case 'f': +++ if (tail("function")) +++ getit(); +++ continue; +++ case 's': +++ if (tail("subroutine")) +++ getit(); +++ continue; +++ case 'p': +++ if (tail("program")) { +++ getit(); +++ continue; +++ } +++ if (tail("procedure")) +++ getit(); +++ continue; +++ } +++ } +++ return (pfcnt); +++} +++ +++tail(cp) +++ char *cp; +++{ +++ register int len = 0; +++ +++ while (*cp && (*cp&~' ') == ((*(dbp+len))&~' ')) +++ cp++, len++; +++ if (*cp == 0) { +++ dbp += len; +++ return (1); +++ } +++ return (0); +++} +++ +++takeprec() +++{ +++ +++ while (isspace(*dbp)) +++ dbp++; +++ if (*dbp != '*') +++ return; +++ dbp++; +++ while (isspace(*dbp)) +++ dbp++; +++ if (!isdigit(*dbp)) { +++ --dbp; /* force failure */ +++ return; + + } - return(buf); +++ do +++ dbp++; +++ while (isdigit(*dbp)); +++} +++ +++getit() +++{ +++ register char *cp; +++ char c; +++ char nambuf[BUFSIZ]; +++ +++ for (cp = lbuf; *cp; cp++) +++ ; +++ *--cp = 0; /* zap newline */ +++ while (isspace(*dbp)) +++ dbp++; +++ if (*dbp == 0 || !isalpha(*dbp)) +++ return; +++ for (cp = dbp+1; *cp && (isalpha(*cp) || isdigit(*cp)); cp++) +++ continue; +++ c = cp[0]; +++ cp[0] = 0; +++ strcpy(nambuf, dbp); +++ cp[0] = c; +++ pfnote(nambuf, lineno); +++ pfcnt++; +++} +++ +++char * +++savestr(cp) +++ char *cp; +++{ +++ register int len; +++ register char *dp; +++ +++ len = strlen(cp); +++ dp = (char *)malloc(len+1); +++ strcpy(dp, cp); +++ return (dp); +++} +++ +++/* +++ * Return the ptr in sp at which the character c last +++ * appears; NULL if not found +++ * +++ * Identical to v7 rindex, included for portability. +++ */ +++ +++char * +++rindex(sp, c) +++register char *sp, c; +++{ +++ register char *r; +++ +++ r = NULL; +++ do { +++ if (*sp == c) +++ r = sp; +++ } while (*sp++); +++ return(r); + +} - #endif diff --cc usr/src/cmd/cu.c index 0000000000,308e3c9434,0000000000..00c7883e99 mode 000000,100644,000000..100644 --- a/usr/src/cmd/cu.c +++ b/usr/src/cmd/cu.c @@@@ -1,0 -1,622 -1,0 +1,650 @@@@ +++static char *sccsid = "@(#)cu.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +/* + + * cu telno [-t] [-s speed] [-l line] [-a acu] + + * + + * -t is for dial-out to terminal. + + * speeds are: 110, 134, 150, 300, 1200. 300 is default. + + * + + * Escape with `~' at beginning of line. + + * Ordinary diversions are ~<, ~> and ~>>. + + * Silent output diversions are ~>: and ~>>:. + + * Terminate output diversion with ~> alone. + + * Quit is ~. and ~! gives local command or shell. + + * Also ~$ for canned procedure pumping remote. + + * ~%put from [to] and ~%take from [to] invoke builtins + + */ + + + +#define CRLF "\r\n" + +#define wrc(ds) write(ds,&c,1) + + + + + +char *devcul = "/dev/cul0"; + +char *devcua = "/dev/cua0"; + +char *lspeed = "300"; + + + +int ln; /* fd for comm line */ + +char tkill, terase; /* current input kill & erase */ + +int efk; /* process of id of listener */ + +char c; +++char oc; + + + +char *connmsg[] = { + + "", + + "line busy", + + "call dropped", + + "no carrier", + + "can't fork", + + "acu access", + + "tty access", + + "tty hung", + + "usage: cu telno [-t] [-s speed] [-l line] [-a acu]" + +}; + + + +rdc(ds) { + + + + ds=read(ds,&c,1); - c&= 0177; +++ oc = c; +++ c &= 0177; + + return (ds); + +} + + + +int intr; + + + +sig2() + +{ + + signal(SIGINT, SIG_IGN); + + intr = 1; + +} + + + +int set14; + + + +xsleep(n) + +{ + + xalarm(n); + + pause(); + + xalarm(0); + +} + + + +xalarm(n) + +{ + + set14=n; + + alarm(n); + +} + + + +sig14() + +{ + + signal(SIGALRM, sig14); + + if (set14) alarm(1); + +} + + + +int dout; + +int nhup; + +int dbflag; + + + +/* + + * main: get connection, set speed for line. + + * spawn child to invoke rd to read from line, output to fd 1 + + * main line invokes wr to read tty, write to line + + */ + +main(ac,av) + +char *av[]; + +{ + + int fk; + + int speed; + + char *telno; + + struct sgttyb stbuf; + + + + signal(SIGALRM, sig14); + + if (ac < 2) { + + prf(connmsg[8]); + + exit(8); + + } - telno = av[1]; - av += 2; - ac -= 2; - for (; ac > 0; av++) { - if (equal(*av, "-t")) { +++ for (; ac > 1; av++,ac--) { +++ if (av[1][0] != '-') +++ telno = av[1]; +++ else switch(av[1][1]) { +++ case 't': + + dout = 1; + + --ac; + + continue; - } - if (equal(*av, "-d")) { +++ case 'd': + + dbflag++; + + continue; - } - if (ac < 2) +++ case 's': +++ lspeed = av[2]; ++av; --ac; +++ break; +++ case 'l': +++ devcul = av[2]; ++av; --ac; + + break; - if (equal(*av, "-s")) - lspeed = *++av; - else if (equal(*av, "-l")) - devcul = *++av; - else if (equal(*av, "-a")) - devcua = *++av; - else +++ case 'a': +++ devcua = av[2]; ++av; --ac; +++ break; +++ case '0': case '1': case '2': case '3': case '4': +++ case '5': case '6': case '7': case '8': case '9': +++ devcua[strlen(devcua)-1] = av[1][1]; +++ devcul[strlen(devcul)-1] = av[1][1]; +++ break; +++ default: +++ prf("Bad flag %s", av[1]); + + break; - ac -= 2; +++ } + + } + + if (!exists(devcua) || !exists(devcul)) + + exit(9); + + ln = conn(devcul, devcua, telno); + + if (ln < 0) { + + prf("Connect failed: %s",connmsg[-ln]); + + exit(-ln); + + } + + switch(atoi(lspeed)) { + + case 110: + + speed = B110;break; + + case 150: + + speed = B150;break; + + default: + + case 300: + + speed = B300;break; + + case 1200: + + speed = B1200;break; + + } + + stbuf.sg_ispeed = speed; + + stbuf.sg_ospeed = speed; + + stbuf.sg_flags = EVENP|ODDP; - if (!dout) +++ if (!dout) { + + stbuf.sg_flags |= RAW; - ioctl(TIOCSETP, ln, &stbuf); - ioctl(TIOCEXCL, ln, (struct sgttyb *)NULL); - ioctl(TIOCHPCL, ln, (struct sgttyb *)NULL); +++ stbuf.sg_flags &= ~ECHO; +++ } +++ ioctl(ln, TIOCSETP, &stbuf); +++ ioctl(ln, TIOCEXCL, (struct sgttyb *)NULL); +++ ioctl(ln, TIOCHPCL, (struct sgttyb *)NULL); + + prf("Connected"); + + if (dout) + + fk = -1; + + else + + fk = fork(); + + nhup = (int)signal(SIGINT, SIG_IGN); + + if (fk == 0) { + + chwrsig(); + + rd(); + + prf("\007Lost carrier"); + + exit(3); + + } + + mode(1); + + efk = fk; + + wr(); + + mode(0); + + kill(fk, SIGKILL); + + wait((int *)NULL); + + stbuf.sg_ispeed = 0; + + stbuf.sg_ospeed = 0; - ioctl(TIOCSETP, ln, &stbuf); +++ ioctl(ln, TIOCSETP, &stbuf); + + prf("Disconnected"); + + exit(0); + +} + + + +/* + + * conn: establish dial-out connection. + + * Example: fd = conn("/dev/ttyh","/dev/dn1","4500"); + + * Returns descriptor open to tty for reading and writing. + + * Negative values (-1...-7) denote errors in connmsg. + + * Uses alarm and fork/wait; requires sig14 handler. + + * Be sure to disconnect tty when done, via HUPCL or stty 0. + + */ + + + +conn(dev,acu,telno) + +char *dev, *acu, *telno; + +{ + + struct sgttyb stbuf; + + extern errno; + + char *p, *q, b[30]; + + int er, fk, dn, dh, t; + + er=0; + + fk=(-1); + + if ((dn=open(acu,1))<0) { + + er=(errno == 6? 1:5); + + goto X; + + } + + if ((fk=fork()) == (-1)) { + + er=4; + + goto X; + + } + + if (fk == 0) { + + open(dev,2); + + for (;;) pause(); + + } + + xsleep(2); + + /* + + * copy phone #, assure EON + + */ + + p=b; + + q=telno; + + while (*p++=(*q++)) + + ; + + p--; + + if (*(p-1)!='<') { - if (*(p-1)!='-') *p++='-'; +++ /*if (*(p-1)!='-') *p++='-';*/ + + *p++='<'; + + } + + t=p-b; + + xalarm(5*t); + + t=write(dn,b,t); + + xalarm(0); + + if (t<0) { + + er=2; + + goto X; + + } + + /* close(dn) */ + + xalarm(40); /* was 5; sometimes missed carrier */ + + dh = open(dev,2); + + xalarm(0); + + if (dh<0) { + + er=(errno == 4? 3:6); + + goto X; + + } - ioctl(TIOCGETP, ln, &stbuf); +++ ioctl(ln, TIOCGETP, &stbuf); + + stbuf.sg_flags &= ~ECHO; + + xalarm(10); - ioctl(TIOCSETP, dh, &stbuf); - ioctl(TIOCHPCL, dh, (struct sgttyb *)NULL); +++ ioctl(dh, TIOCSETP, &stbuf); +++ ioctl(dh, TIOCHPCL, (struct sgttyb *)NULL); + + xalarm(0); + +X: + + if (er) close(dn); + + if (fk!=(-1)) { + + kill(fk, SIGKILL); + + xalarm(10); + + while ((t=wait((int *)NULL))!=(-1) && t!=fk); + + xalarm(0); + + } + + return (er? -er:dh); + +} + + + +/* + + * wr: write to remote: 0 -> line. + + * ~. terminate + + * ~': + + case ':': + + { + + FILE *fp; char tbuff[128]; register char *q; + + sprintf(tbuff,"/tmp/cu%d",efk); + + if(NULL==(fp = fopen(tbuff,"w"))) { + + prf("Can't tell other demon to divert"); + + break; + + } + + fprintf(fp,"%s\n",(b[1]=='>'?&b[2]: &b[1] )); + + if(dbflag) prf("name to be written in temporary:"),prf(&b[2]); + + fclose(fp); + + kill(efk,SIGEMT); + + } + + break; +++#ifdef SIGTSTP +++#define CTRLZ 26 +++ case CTRLZ: +++ mode(0); +++ kill(getpid(), SIGTSTP); +++ mode(1); +++ break; +++#endif + + case '%': + + dopercen(&b[2]); + + break; + + default: + + prf("Use `~~' to start line with `~'"); + + } + + continue; + + } + +} + + + +dopercen(line) + +register char *line; + +{ + + char *args[10]; + + register narg, f; + + int rcount; + + for (narg = 0; narg < 10;) { + + while(*line == ' ' || *line == '\t') + + line++; + + if (*line == '\0') + + break; + + args[narg++] = line; + + while(*line != '\0' && *line != ' ' && *line != '\t') + + line++; + + if (*line == '\0') + + break; + + *line++ = '\0'; + + } + + if (equal(args[0], "take")) { + + if (narg < 2) { + + prf("usage: ~%%take from [to]"); + + return; + + } + + if (narg < 3) + + args[2] = args[1]; + + wrln("echo '~>:'"); + + wrln(args[2]); + + wrln(";tee /dev/null <"); + + wrln(args[1]); + + wrln(";echo '~>'\n"); + + return; + + } else if (equal(args[0], "put")) { + + if (narg < 2) { + + prf("usage: ~%%put from [to]"); + + return; + + } + + if (narg < 3) + + args[2] = args[1]; + + if ((f = open(args[1], 0)) < 0) { + + prf("cannot open: %s", args[1]); + + return; + + } + + wrln("stty -echo;cat >"); + + wrln(args[2]); + + wrln(";stty echo\n"); + + xsleep(5); + + intr = 0; + + if (!nhup) + + signal(SIGINT, sig2); + + mode(2); + + rcount = 0; + + while(!intr && rdc(f) == 1) { + + rcount++; + + if (c == tkill || c == terase) + + wrln("\\"); + + if (wrc(ln) != 1) { + + xsleep(2); + + if (wrc(ln) != 1) { + + prf("character missed"); + + intr = 1; + + break; + + } + + } + + } + + signal(SIGINT, SIG_IGN); + + close(f); + + if (intr) { + + wrln("\n"); + + prf("stopped after %d bytes", rcount); + + } + + wrln("\004"); + + xsleep(5); + + mode(1); + + return; + + } + + prf("~%%%s unknown\n", args[0]); + +} + + + +equal(s1, s2) + +register char *s1, *s2; + +{ + + while (*s1++ == *s2) + + if (*s2++ == '\0') + + return(1); + + return(0); + +} + + + +wrln(s) + +register char *s; + +{ + + while (*s) + + write(ln, s++, 1); + +} + +/* chwrsig: Catch orders from wr process + + * to instigate diversion + + */ + +int whoami; + +chwrsig(){ + + int dodiver(); + + whoami = getpid(); + + signal(SIGEMT,dodiver); + +} + +int ds,slnt; + +int justrung; + +dodiver(){ + + static char dobuff[128], morejunk[256]; register char *cp; + + FILE *fp; + + justrung = 1; + + signal(SIGEMT,dodiver); + + sprintf(dobuff,"/tmp/cu%d",whoami); + + fp = fopen(dobuff,"r"); + + if(fp==NULL) prf("Couldn't open temporary"); + + unlink(dobuff); + + if(dbflag) { + + prf("Name of temporary:"); + + prf(dobuff); + + } + + fgets(dobuff,128,fp); fclose(fp); + + if(dbflag) { + + prf("Name of target file:"); + + prf(dobuff); + + } + + for(cp = dobuff-1; *++cp; ) /* squash newline */ + + if(*cp=='\n') *cp=0; + + cp = dobuff; + + if (*cp=='>') cp++; + + if (*cp==':') { + + cp++; + + if(*cp==0) { + + slnt ^= 1; + + return; + + } else { + + slnt = 1; + + } + + } + + if (ds >= 0) close(ds); + + if (*cp==0) { + + slnt = 0; + + ds = -1; + + return; + + } + + if (*dobuff!='>' || (ds=open(cp,1))<0) ds=creat(cp,0644); + + lseek(ds, (long)0, 2); + + if(ds < 0) prf("Creat failed:"), prf(cp); + + if (ds<0) prf("Can't divert %s",cp+1); + +} + + + + + +/* + + * rd: read from remote: line -> 1 + + * catch: + + * ~>[>][:][file] + + * stuff from file... + + * ~> (ends diversion) + + */ + + + +rd() + +{ + + extern int ds,slnt; + + char *p,*q,b[600]; + + p=b; + + ds=(-1); + +agin: + + while (rdc(ln) == 1) { + + if (!slnt) wrc(1); + + *p++=c; + + if (c!='\n') continue; + + q=p; + + p=b; + + if (b[0]!='~' || b[1]!='>') { + + if (*(q-2) == '\r') { + + q--; + + *(q-1)=(*q); + + } + + if (ds>=0) write(ds,b,q-b); + + continue; + + } + + if (ds>=0) close(ds); + + if (slnt) { + + write(1, b, q - b); + + write(1, CRLF, sizeof(CRLF)); + + } + + if (*(q-2) == '\r') q--; + + *(q-1)=0; + + slnt=0; + + q=b+2; + + if (*q == '>') q++; + + if (*q == ':') { + + slnt=1; + + q++; + + } + + if (*q == 0) { + + ds=(-1); + + continue; + + } + + if (b[2]!='>' || (ds=open(q,1))<0) ds=creat(q,0644); + + lseek(ds, (long)0, 2); + + if (ds<0) prf("Can't divert %s",b+1); + + } + + if(justrung) { + + justrung = 0; + + goto agin; + + } + +} + + + +struct {char lobyte; char hibyte;}; + +mode(f) + +{ + + struct sgttyb stbuf; + + if (dout) return; - ioctl(TIOCGETP, 0, &stbuf); +++ ioctl(0, TIOCGETP, &stbuf); + + tkill = stbuf.sg_kill; + + terase = stbuf.sg_erase; + + if (f == 0) { + + stbuf.sg_flags &= ~RAW; + + stbuf.sg_flags |= ECHO|CRMOD; + + } + + if (f == 1) { + + stbuf.sg_flags |= RAW; - stbuf.sg_flags &= ECHO|CRMOD; +++ stbuf.sg_flags &= ~(ECHO|CRMOD); + + } + + if (f == 2) { + + stbuf.sg_flags &= ~RAW; + + stbuf.sg_flags &= ~(ECHO|CRMOD); + + } - ioctl(TIOCSETP, 0, &stbuf); +++ ioctl(0, TIOCSETP, &stbuf); + +} + + + +echo(s) + +char *s; + +{ + + char *p; + + for (p=s;*p;p++); + + if (p>s) write(0,s,p-s); + + write(0,CRLF, sizeof(CRLF)); + +} + + + +prf(f, s) + +char *f; + +char *s; + +{ + + fprintf(stderr, f, s); + + fprintf(stderr, CRLF); + +} + + + +exists(devname) + +char *devname; + +{ + + if (access(devname, 0)==0) + + return(1); + + prf("%s does not exist", devname); + + return(0); + +} diff --cc usr/src/cmd/date.c index 0000000000,a0057654a7,0000000000..6950366ace mode 000000,100644,000000..100644 --- a/usr/src/cmd/date.c +++ b/usr/src/cmd/date.c @@@@ -1,0 -1,163 -1,0 +1,167 @@@@ +++static char *sccsid = "@(#)date.c 4.1 (Berkeley) 10/1/80"; +++#include + +/* + + * date : print date + + * date YYMMDDHHMM[.SS] : set date, if allowed + + * date -u ... : date in GMT + + */ + +#include + +#include + +#include + +#include + +long timbuf; + +char *ap, *ep, *sp; + +int uflag; + + + +char *timezone(); + +static int dmsize[12] = + +{ + + 31, + + 28, + + 31, + + 30, + + 31, + + 30, + + 31, + + 31, + + 30, + + 31, + + 30, + + 31 + +}; + + + +struct utmp wtmp[2] = { {"|", "", 0}, {"{", "", 0}}; + + + +char *ctime(); + +char *asctime(); + +struct tm *localtime(); + +struct tm *gmtime(); + + + +main(argc, argv) + +char *argv[]; + +{ + + register char *tzn; + + struct timeb info; + + int wf, rc; +++ extern char _sobuf[]; + + +++ setbuf(stdout, _sobuf); + + rc = 0; + + ftime(&info); + + if (argc>1 && argv[1][0]=='-' && argv[1][1]=='u') { + + argc--; + + argv++; + + uflag++; + + } + + if(argc > 1) { + + ap = argv[1]; + + if (gtime()) { + + printf("date: bad conversion\n"); + + exit(1); + + } + + /* convert to GMT assuming local time */ + + if (uflag==0) { + + timbuf += (long)info.timezone*60; + + /* now fix up local daylight time */ + + if(localtime(&timbuf)->tm_isdst) + + timbuf -= 60*60; + + } + + time(&wtmp[0].ut_time); + + if(stime(&timbuf) < 0) { + + rc++; + + printf("date: no permission\n"); + + } else if ((wf = open("/usr/adm/wtmp", 1)) >= 0) { + + time(&wtmp[1].ut_time); + + lseek(wf, 0L, 2); + + write(wf, (char *)wtmp, sizeof(wtmp)); + + close(wf); + + } + + } + + if (rc==0) + + time(&timbuf); + + if(uflag) { + + ap = asctime(gmtime(&timbuf)); + + tzn = "GMT"; + + } else { + + struct tm *tp; + + tp = localtime(&timbuf); + + ap = asctime(tp); + + tzn = timezone(info.timezone, tp->tm_isdst); + + } + + printf("%.20s", ap); + + if (tzn) + + printf("%s", tzn); + + printf("%s", ap+19); + + exit(rc); + +} + + + +gtime() + +{ + + register int i, year, month; + + int day, hour, mins, secs; + + struct tm *L; + + char x; + + + + ep=ap; + + while(*ep) ep++; + + sp=ap; + + while(sptm_mday); + + month = gp(L->tm_mon+1); + + year = gp(L->tm_year); + + if(*sp) + + return(1); + + if( month<1 || month>12 || + + day<1 || day>31 || + + mins<0 || mins>59 || + + secs<0 || secs>59) + + return(1); + + if (hour==24) { + + hour=0; day++; + + } + + if (hour<0 || hour>23) + + return(1); + + timbuf = 0; + + year += 1900; + + for(i=1970; i= 3) + + timbuf++; + + while(--month) + + timbuf += dmsize[month-1]; + + timbuf += day-1; + + timbuf = 24*timbuf + hour; + + timbuf = 60*timbuf + mins; + + timbuf = 60*timbuf + secs; + + return(0); + + + +} + + + +gp(dfault) + +{ + + register int c, d; + + + + if(*sp==0) + + return(dfault); + + c = (*sp++)-'0'; + + d = (*sp ? (*sp++)-'0' : 0); + + if(c<0 || c>9 || d<0 || d>9) + + return(-1); + + return(c+10*d); + +} diff --cc usr/src/cmd/dcheck.c index 0000000000,b479a83d93,0000000000..8514caa353 mode 000000,100644,000000..100644 --- a/usr/src/cmd/dcheck.c +++ b/usr/src/cmd/dcheck.c @@@@ -1,0 -1,214 -1,0 +1,215 @@@@ +++static char *sccsid = "@(#)dcheck.c 4.1 (Berkeley) 10/1/80"; + +/* + + * dcheck - check directory consistency + + */ + +#define NI 16 + +#define NB 10 + +#define NDIR (BSIZE/sizeof(struct direct)) + + + +#include + +#include + +#include + +#include + +#include + +#include + +#include + + + + + +struct filsys sblock; + +struct dinode itab[INOPB*NI]; + +daddr_t iaddr[NADDR]; + +ino_t ilist[NB]; + + + +int fi; + +ino_t ino; + +char *ecount; + +int headpr; + +unsigned nfiles; + + + +int nerror; + +daddr_t bmap(); + +long atol(); + +char *malloc(); + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + long n; + + + + while (--argc) { + + argv++; + + if (**argv=='-') + + switch ((*argv)[1]) { + + + + case 'i': + + for(i=0; i 250000) { + + printf("Only doing 250000 files\n"); + + nfiles = 250000; + + } + + ecount = malloc(nfiles+1); + + if (ecount==NULL) { + + printf("Not enough core\n"); + + exit(04); + + } + + for (i=0; i<=nfiles; i++) + + ecount[i] = 0; + + ino = 0; + + for(i=2;; i+=NI) { + + if(ino >= nfiles) + + break; + + bread((daddr_t)i, (char *)itab, sizeof(itab)); + + for(j=0; j= nfiles) + + break; + + ino++; + + pass1(&itab[j]); + + } + + } + + ino = 0; + + for(i=2;; i+=NI) { + + if(ino >= nfiles) + + break; + + bread((daddr_t)i, (char *)itab, sizeof(itab)); + + for(j=0; j= nfiles) + + break; + + ino++; + + pass2(&itab[j]); + + } + + } + + free(ecount); + +} + + + +pass1(ip) + +register struct dinode *ip; + +{ + + struct direct dbuf[NDIR]; + + long doff; + + struct direct *dp; + + register i, j; + + int k; + + daddr_t d; + + ino_t kno; + + + + if((ip->di_mode&IFMT) != IFDIR) + + return; + + l3tol(iaddr, ip->di_addr, NADDR); + + doff = 0; + + for(i=0;; i++) { + + if(doff >= ip->di_size) + + break; + + d = bmap(i); + + if(d == 0) + + break; + + bread(d, (char *)dbuf, BSIZE); + + for(j=0; j= ip->di_size) + + break; + + doff += sizeof(struct direct); + + dp = &dbuf[j]; + + kno = dp->d_ino; + + if(kno == 0) + + continue; + + if(kno > nfiles || kno <= 1) { + + printf("%5u bad; %u/%.14s\n", kno, ino, dp->d_name); + + nerror++; + + continue; + + } + + for (k=0; ilist[k] != 0; k++) + + if (ilist[k]==kno) { + + printf("%5u arg; %u/%.14s\n", kno, ino, dp->d_name); + + nerror++; + + } + + ecount[kno]++; + + if (ecount[kno] == 0) + + ecount[kno] = 0377; + + } + + } + +} + + + +pass2(ip) + +register struct dinode *ip; + +{ + + register i; + + + + i = ino; + + if ((ip->di_mode&IFMT)==0 && ecount[i]==0) + + return; + + if (ip->di_nlink==((ecount[i])&0377) && ip->di_nlink!=0) + + return; + + if (headpr==0) { + + printf(" entries link cnt\n"); + + headpr++; + + } + + printf("%u %d %d\n", ino, + + ecount[i]&0377, ip->di_nlink); + +} + + + +bread(bno, buf, cnt) + +daddr_t bno; + +char *buf; + +{ + + register i; + + + + lseek(fi, bno*BSIZE, 0); + + if (read(fi, buf, cnt) != cnt) { + + printf("read error %d\n", bno); + + for(i=0; i NINDIR) { + + printf("%u - huge directory\n", ino); + + return((daddr_t)0); + + } + + bread(iaddr[NADDR-3], (char *)ibuf, sizeof(ibuf)); + + return(ibuf[i]); + +} diff --cc usr/src/cmd/dd.c index 0000000000,85d5c03fef,0000000000..b68bc1ef09 mode 000000,100644,000000..100644 --- a/usr/src/cmd/dd.c +++ b/usr/src/cmd/dd.c @@@@ -1,0 -1,541 -1,0 +1,606 @@@@ +++static char *sccsid = "@(#)dd.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + + + +#define BIG 2147483647 + +#define LCASE 01 + +#define UCASE 02 + +#define SWAB 04 + +#define NERR 010 + +#define SYNC 020 + +int cflag; + +int fflag; + +int skip; + +int seekn; + +int count; + +int files = 1; + +char *string; + +char *ifile; + +char *ofile; + +char *ibuf; + +char *obuf; + +char *sbrk(); + +int ibs = 512; + +int obs = 512; + +int bs; + +int cbs; + +int ibc; + +int obc; + +int cbc; + +int nifr; + +int nipr; + +int nofr; + +int nopr; + +int ntrunc; + +int ibf; + +int obf; + +char *op; + +int nspace; + +char etoa[] = { + + 0000,0001,0002,0003,0234,0011,0206,0177, + + 0227,0215,0216,0013,0014,0015,0016,0017, + + 0020,0021,0022,0023,0235,0205,0010,0207, + + 0030,0031,0222,0217,0034,0035,0036,0037, + + 0200,0201,0202,0203,0204,0012,0027,0033, + + 0210,0211,0212,0213,0214,0005,0006,0007, + + 0220,0221,0026,0223,0224,0225,0226,0004, + + 0230,0231,0232,0233,0024,0025,0236,0032, + + 0040,0240,0241,0242,0243,0244,0245,0246, + + 0247,0250,0133,0056,0074,0050,0053,0041, + + 0046,0251,0252,0253,0254,0255,0256,0257, + + 0260,0261,0135,0044,0052,0051,0073,0136, + + 0055,0057,0262,0263,0264,0265,0266,0267, + + 0270,0271,0174,0054,0045,0137,0076,0077, + + 0272,0273,0274,0275,0276,0277,0300,0301, + + 0302,0140,0072,0043,0100,0047,0075,0042, + + 0303,0141,0142,0143,0144,0145,0146,0147, + + 0150,0151,0304,0305,0306,0307,0310,0311, + + 0312,0152,0153,0154,0155,0156,0157,0160, + + 0161,0162,0313,0314,0315,0316,0317,0320, + + 0321,0176,0163,0164,0165,0166,0167,0170, + + 0171,0172,0322,0323,0324,0325,0326,0327, + + 0330,0331,0332,0333,0334,0335,0336,0337, + + 0340,0341,0342,0343,0344,0345,0346,0347, + + 0173,0101,0102,0103,0104,0105,0106,0107, + + 0110,0111,0350,0351,0352,0353,0354,0355, + + 0175,0112,0113,0114,0115,0116,0117,0120, + + 0121,0122,0356,0357,0360,0361,0362,0363, + + 0134,0237,0123,0124,0125,0126,0127,0130, + + 0131,0132,0364,0365,0366,0367,0370,0371, + + 0060,0061,0062,0063,0064,0065,0066,0067, + + 0070,0071,0372,0373,0374,0375,0376,0377, + +}; + +char atoe[] = { + + 0000,0001,0002,0003,0067,0055,0056,0057, + + 0026,0005,0045,0013,0014,0015,0016,0017, + + 0020,0021,0022,0023,0074,0075,0062,0046, + + 0030,0031,0077,0047,0034,0035,0036,0037, + + 0100,0117,0177,0173,0133,0154,0120,0175, + + 0115,0135,0134,0116,0153,0140,0113,0141, + + 0360,0361,0362,0363,0364,0365,0366,0367, + + 0370,0371,0172,0136,0114,0176,0156,0157, + + 0174,0301,0302,0303,0304,0305,0306,0307, + + 0310,0311,0321,0322,0323,0324,0325,0326, + + 0327,0330,0331,0342,0343,0344,0345,0346, + + 0347,0350,0351,0112,0340,0132,0137,0155, + + 0171,0201,0202,0203,0204,0205,0206,0207, + + 0210,0211,0221,0222,0223,0224,0225,0226, + + 0227,0230,0231,0242,0243,0244,0245,0246, + + 0247,0250,0251,0300,0152,0320,0241,0007, + + 0040,0041,0042,0043,0044,0025,0006,0027, + + 0050,0051,0052,0053,0054,0011,0012,0033, + + 0060,0061,0032,0063,0064,0065,0066,0010, + + 0070,0071,0072,0073,0004,0024,0076,0341, + + 0101,0102,0103,0104,0105,0106,0107,0110, + + 0111,0121,0122,0123,0124,0125,0126,0127, + + 0130,0131,0142,0143,0144,0145,0146,0147, + + 0150,0151,0160,0161,0162,0163,0164,0165, + + 0166,0167,0170,0200,0212,0213,0214,0215, + + 0216,0217,0220,0232,0233,0234,0235,0236, + + 0237,0240,0252,0253,0254,0255,0256,0257, + + 0260,0261,0262,0263,0264,0265,0266,0267, + + 0270,0271,0272,0273,0274,0275,0276,0277, + + 0312,0313,0314,0315,0316,0317,0332,0333, + + 0334,0335,0336,0337,0352,0353,0354,0355, + + 0356,0357,0372,0373,0374,0375,0376,0377, + +}; + +char atoibm[] = + +{ + + 0000,0001,0002,0003,0067,0055,0056,0057, + + 0026,0005,0045,0013,0014,0015,0016,0017, + + 0020,0021,0022,0023,0074,0075,0062,0046, + + 0030,0031,0077,0047,0034,0035,0036,0037, + + 0100,0132,0177,0173,0133,0154,0120,0175, + + 0115,0135,0134,0116,0153,0140,0113,0141, + + 0360,0361,0362,0363,0364,0365,0366,0367, + + 0370,0371,0172,0136,0114,0176,0156,0157, + + 0174,0301,0302,0303,0304,0305,0306,0307, + + 0310,0311,0321,0322,0323,0324,0325,0326, + + 0327,0330,0331,0342,0343,0344,0345,0346, + + 0347,0350,0351,0255,0340,0275,0137,0155, + + 0171,0201,0202,0203,0204,0205,0206,0207, + + 0210,0211,0221,0222,0223,0224,0225,0226, + + 0227,0230,0231,0242,0243,0244,0245,0246, + + 0247,0250,0251,0300,0117,0320,0241,0007, + + 0040,0041,0042,0043,0044,0025,0006,0027, + + 0050,0051,0052,0053,0054,0011,0012,0033, + + 0060,0061,0032,0063,0064,0065,0066,0010, + + 0070,0071,0072,0073,0004,0024,0076,0341, + + 0101,0102,0103,0104,0105,0106,0107,0110, + + 0111,0121,0122,0123,0124,0125,0126,0127, + + 0130,0131,0142,0143,0144,0145,0146,0147, + + 0150,0151,0160,0161,0162,0163,0164,0165, + + 0166,0167,0170,0200,0212,0213,0214,0215, + + 0216,0217,0220,0232,0233,0234,0235,0236, + + 0237,0240,0252,0253,0254,0255,0256,0257, + + 0260,0261,0262,0263,0264,0265,0266,0267, + + 0270,0271,0272,0273,0274,0275,0276,0277, + + 0312,0313,0314,0315,0316,0317,0332,0333, + + 0334,0335,0336,0337,0352,0353,0354,0355, + + 0356,0357,0372,0373,0374,0375,0376,0377, + +}; + + + + + +main(argc, argv) + +int argc; + +char **argv; + +{ + + int (*conv)(); + + register char *ip; + + register c; - int ebcdic(), ibm(), ascii(), null(), cnull(), term(); +++ int ebcdic(), ibm(), ascii(), null(), cnull(), term(), block(), unblock(); + + int a; + + + + conv = null; + + for(c=1; cibuf;) + + *--ip = 0; + + ibc = read(ibf, ibuf, ibs); + + } + + if(ibc == -1) { + + perror("read"); + + if((cflag&NERR) == 0) { + + flsh(); + + term(); + + } + + ibc = 0; + + for(c=0; c>1) & ~1; + + if(cflag&SWAB && c) + + do { + + a = *ip++; + + ip[-1] = *ip; + + *ip++ = a; + + } while(--c); + + ip = ibuf; + + if (fflag) { + + obc = ibc; + + flsh(); + + ibc = 0; + + } + + goto loop; + + } + + c = 0; + + c |= *ip++; + + c &= 0377; + + (*conv)(c); + + goto loop; + +} + + + +flsh() + +{ + + register c; + + + + if(obc) { + + if(obc == obs) + + nofr++; else + + nopr++; + + c = write(obf, obuf, obc); + + if(c != obc) { + + perror("write"); + + term(); + + } + + obc = 0; + + } + +} + + + +match(s) + +char *s; + +{ + + register char *cs; + + + + cs = string; + + while(*cs++ == *s) + + if(*s++ == '\0') + + goto true; + + if(*s != '\0') + + return(0); + + + +true: + + cs--; + + string = cs; + + return(1); + +} + + + +number(big) + +{ + + register char *cs; + + long n; + + + + cs = string; + + n = 0; + + while(*cs >= '0' && *cs <= '9') + + n = n*10 + *cs++ - '0'; + + for(;;) + + switch(*cs++) { + + + + case 'k': + + n *= 1024; + + continue; + + + + case 'w': + + n *= sizeof(int); + + continue; + + + + case 'b': + + n *= 512; + + continue; + + + + case '*': + + case 'x': + + string = cs; + + n *= number(BIG); + + + + case '\0': + + if (n>=big || n<0) { + + fprintf(stderr, "dd: argument %D out of range\n", n); + + exit(1); + + } + + return(n); + + } + + /* never gets here */ + +} + + + +cnull(cc) + +{ + + register c; + + + + c = cc; + + if(cflag&UCASE && c>='a' && c<='z') + + c += 'A'-'a'; + + if(cflag&LCASE && c>='A' && c<='Z') + + c += 'a'-'A'; + + null(c); + +} + + + +null(c) + +{ + + + + *op = c; + + op++; + + if(++obc >= obs) { + + flsh(); + + op = obuf; + + } + +} + + + +ascii(cc) + +{ + + register c; + + + + c = etoa[cc] & 0377; + + if(cbs == 0) { + + cnull(c); + + return; + + } + + if(c == ' ') { + + nspace++; + + goto out; + + } + + while(nspace > 0) { + + null(' '); + + nspace--; + + } + + cnull(c); + + + +out: + + if(++cbc >= cbs) { + + null('\n'); + + cbc = 0; + + nspace = 0; + + } + +} + + +++unblock(cc) +++{ +++ register c; +++ +++ c = cc & 0377; +++ if(cbs == 0) { +++ cnull(c); +++ return; +++ } +++ if(c == ' ') { +++ nspace++; +++ goto out; +++ } +++ while(nspace > 0) { +++ null(' '); +++ nspace--; +++ } +++ cnull(c); +++ +++out: +++ if(++cbc >= cbs) { +++ null('\n'); +++ cbc = 0; +++ nspace = 0; +++ } +++} +++ + +ebcdic(cc) + +{ + + register c; + + + + c = cc; + + if(cflag&UCASE && c>='a' && c<='z') + + c += 'A'-'a'; + + if(cflag&LCASE && c>='A' && c<='Z') + + c += 'a'-'A'; + + c = atoe[c] & 0377; + + if(cbs == 0) { + + null(c); + + return; + + } + + if(cc == '\n') { + + while(cbc < cbs) { + + null(atoe[' ']); + + cbc++; + + } + + cbc = 0; + + return; + + } + + if(cbc == cbs) + + ntrunc++; + + cbc++; + + if(cbc <= cbs) + + null(c); + +} + + + +ibm(cc) + +{ + + register c; + + + + c = cc; + + if(cflag&UCASE && c>='a' && c<='z') + + c += 'A'-'a'; + + if(cflag&LCASE && c>='A' && c<='Z') + + c += 'a'-'A'; + + c = atoibm[c] & 0377; + + if(cbs == 0) { + + null(c); + + return; + + } + + if(cc == '\n') { + + while(cbc < cbs) { + + null(atoibm[' ']); + + cbc++; + + } + + cbc = 0; + + return; + + } + + if(cbc == cbs) + + ntrunc++; + + cbc++; + + if(cbc <= cbs) + + null(c); + +} + + +++block(cc) +++{ +++ register c; +++ +++ c = cc; +++ if(cflag&UCASE && c>='a' && c<='z') +++ c += 'A'-'a'; +++ if(cflag&LCASE && c>='A' && c<='Z') +++ c += 'a'-'A'; +++ c &= 0377; +++ if(cbs == 0) { +++ null(c); +++ return; +++ } +++ if(cc == '\n') { +++ while(cbc < cbs) { +++ null(' '); +++ cbc++; +++ } +++ cbc = 0; +++ return; +++ } +++ if(cbc == cbs) +++ ntrunc++; +++ cbc++; +++ if(cbc <= cbs) +++ null(c); +++} +++ + +term() + +{ + + + + stats(); + + exit(0); + +} + + + +stats() + +{ + + + + fprintf(stderr,"%u+%u records in\n", nifr, nipr); + + fprintf(stderr,"%u+%u records out\n", nofr, nopr); + + if(ntrunc) + + fprintf(stderr,"%u truncated records\n", ntrunc); + +} diff --cc usr/src/cmd/delivermail/addr.c index 0000000000,0000000000,0000000000..75fd1b9841 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/addr.c @@@@ -1,0 -1,0 -1,0 +1,120 @@@@ +++# include "dlvrmail.h" +++ +++static char SccsId[] = "@(#)addr.c 1.3 8/2/80"; +++ +++/* +++** PUTONQ -- put an address node on the end of a queue +++** +++** Parameters: +++** a -- the address to put on the queue. +++** q -- the queue to put it on. +++** +++** Returns: +++** none +++** +++** Side Effects: +++** none +++** +++** Called By: +++** alias +++** recipient +++*/ +++ +++putonq(a, q) +++ register addrq *a; +++ register addrq *q; +++{ +++ if (q->q_prev == NULL) +++ { +++ q->q_prev = q->q_next = a; +++ a->q_prev = NULL; +++ } +++ else +++ { +++ a->q_prev = q->q_prev; +++ q->q_prev->q_next = a; +++ q->q_prev = a; +++ } +++ a->q_next = NULL; +++} +++ /* +++** TKOFFQ -- remove address node from queue +++** +++** Takes a node off of a queue, from anyplace in the queue. +++** +++** Parameters: +++** a -- the node to remove. +++** q -- the queue to remove it from. +++** +++** Returns: +++** none +++** +++** Side Effects: +++** none +++** +++** Called By: +++** alias +++*/ +++ +++tkoffq(a, q) +++ register addrq *a; +++ register addrq *q; +++{ +++ if (a->q_prev != NULL) +++ a->q_prev->q_next = a->q_next; +++ else +++ q->q_next = a->q_next; +++ if (a->q_next != NULL) +++ a->q_next->q_prev = a->q_prev; +++ else +++ q->q_prev = a->q_prev; +++} +++ /* +++** SAMEADDR -- Determine if tow addresses are the same +++** +++** This is not just a straight comparison -- if the mailer doesn't +++** care about the host we just ignore it, etc. +++** +++** Parameters: +++** a, b -- pointers to the internal forms to compare. +++** wildflg -- if TRUE, 'a' may have no user specified, +++** in which case it is to match anything. +++** +++** Returns: +++** TRUE -- they represent the same mailbox. +++** FALSE -- they don't. +++** +++** Side Effects: +++** none. +++** +++** Called By: +++** recipient +++** alias +++*/ +++ +++bool +++sameaddr(a, b, wildflg) +++ register addrq *a; +++ register addrq *b; +++ bool wildflg; +++{ +++ /* if they don't have the same mailer, forget it */ +++ if (a->q_mailer != b->q_mailer) +++ return (FALSE); +++ +++ /* if the user isn't the same, we can drop out */ +++ if ((!wildflg || a->q_user[0] != '\0') && strcmp(a->q_user, b->q_user) != 0) +++ return (FALSE); +++ +++ /* if the mailer ignores hosts, we have succeeded! */ +++ if (flagset(M_NOHOST, a->q_mailer->m_flags)) +++ return (TRUE); +++ +++ /* otherwise compare hosts (but be careful for NULL ptrs) */ +++ if (a->q_host == NULL || b->q_host == NULL) +++ return (FALSE); +++ if (strcmp(a->q_host, b->q_host) != 0) +++ return (FALSE); +++ +++ return (TRUE); +++} diff --cc usr/src/cmd/delivermail/alias.c index 0000000000,0000000000,0000000000..7ca45faec3 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/alias.c @@@@ -1,0 -1,0 -1,0 +1,269 @@@@ +++# include +++# include +++# include +++# include "dlvrmail.h" +++ +++static char SccsId[] = "@(#)alias.c 1.8 10/28/80"; +++ +++/* +++** ALIAS -- Compute aliases. +++** +++** Scans the file ALIASFILE for a set of aliases. +++** If found, it arranges to deliver to them by inserting the +++** new names onto the SendQ queue. Uses libdbm database if -DDBM. +++** +++** Parameters: +++** none +++** +++** Returns: +++** none +++** +++** Side Effects: +++** Aliases found on SendQ are removed and put onto +++** AliasQ; replacements are added to SendQ. This is +++** done until no such replacement occurs. +++** +++** Defined Constants: +++** MAXRCRSN -- the maximum recursion depth. +++** +++** Called By: +++** main +++** +++** Files: +++** ALIASFILE -- the mail aliases. The format is +++** a series of lines of the form: +++** alias:name1,name2,name3,... +++** where 'alias' expands to all of +++** 'name[i]'. Continuations begin with +++** space or tab. +++** ALIASFILE.pag, ALIASFILE.dir: libdbm version +++** of alias file. Keys are aliases, datums +++** (data?) are name1,name2, ... +++** +++** Notes: +++** If NoAlias (the "-n" flag) is set, no aliasing is +++** done. +++** +++** Deficiencies: +++** It should complain about names that are aliased to +++** nothing. +++** It is unsophisticated about line overflows. +++*/ +++ +++ +++# define MAXRCRSN 10 +++ +++#ifdef DBM +++typedef struct {char *dptr; int dsize;} datum; +++datum lhs, rhs; +++extern datum fetch(); +++#endif DBM +++ +++alias() +++{ +++ register addrq *q; +++ addrq *q2; +++ FILE *af; +++ char line[MAXLINE+1]; +++ register char *p; +++ extern int errno; +++ bool didalias; +++ bool gotmatch; +++ auto addrq al; +++ extern bool sameaddr(); +++ extern addrq *parse(); +++ +++ if (NoAlias) +++ return; +++# ifdef DEBUG +++ if (Debug) +++ printf("--- alias ---\n"); +++# endif +++ +++ /* open alias file if not already open */ +++#ifndef DBM +++# ifdef DEBUG +++ if (Debug && (af = fopen("mailaliases", "r")) != NULL) +++ printf(" [using local alias file]\n"); +++ else +++# endif +++ if ((af = fopen(ALIASFILE, "r")) == NULL) +++ { +++# ifdef DEBUG +++ if (Debug) +++ printf("Can't open %s\n", ALIASFILE); +++# endif +++ errno = 0; +++ return; +++ } +++#else DBM +++ dbminit(ALIASFILE); +++#endif DBM +++ +++#ifndef DBM +++ /* +++ ** Scan alias file. +++ ** If we find any user that any line matches any user, we +++ ** will send to the line rather than to the user. +++ ** +++ ** We pass through the file several times. Didalias tells +++ ** us if we took some alias on this pass through the file; +++ ** when it goes false at the top of the loop we don't have +++ ** to scan any more. Gotmatch tells the same thing, but +++ ** on a line-by-line basis; it is used for processing +++ ** continuation lines. +++ */ +++ +++ do +++ { +++ didalias = FALSE; +++ gotmatch = FALSE; +++ rewind(af); +++ while (fgets(line, sizeof line, af) != NULL) +++ { +++ /* comments begin with `#' */ +++ if (line[0] == '#') +++ continue; +++ +++ /* check for continuation lines */ +++ if (isspace(line[0])) +++ { +++ if (gotmatch) +++ { +++ sendto(line, 1); +++ } +++ continue; +++ } +++ gotmatch = FALSE; +++ +++ /* +++ ** Check to see if this pseudonym exists in SendQ. +++ ** Turn the alias into canonical form. +++ ** Then scan SendQ until you do (or do not) +++ ** find that address. +++ */ +++ +++ /* Get a canonical form for the alias. */ +++ for (p = line; *p != '\0' && *p != ':' && *p != '\n'; p++) +++ continue; +++ if (*p == '\0' || *p == '\n') +++ { +++ syntaxerr: +++ syserr("Bad alias line `%s'", line); +++ continue; +++ } +++ *p++ = '\0'; +++ if (parse(line, &al, -1) == NULL) +++ { +++ *--p = ':'; +++ goto syntaxerr; +++ } +++ +++ /* Scan SendQ for that canonical form. */ +++ for (q = &SendQ; (q = nxtinq(q)) != NULL; ) +++ { +++ if (sameaddr(&al, q, TRUE)) +++ break; +++ } +++ if (q != NULL) +++ { +++ /* +++ ** Match on Alias. +++ ** Deliver to the target list. +++ ** Remove the alias from the send queue +++ ** and put it on the Alias queue. +++ */ +++ +++# ifdef DEBUG +++ if (Debug) +++ printf("%s (%s, %s) aliased to %s (%s,%s,%s)\n", +++ q->q_paddr, q->q_host, q->q_user, +++ p, al.q_paddr, al.q_host, al.q_user); +++# endif +++ tkoffq(q, &SendQ); +++ putonq(q, &AliasQ); +++ didalias++; +++ gotmatch++; +++ sendto(p, 1); +++ } +++ } +++ } while (didalias); +++ fclose(af); +++#else DBM +++ /* +++ ** Scan SendQ +++ ** We only have to do this once, since anything we alias +++ ** two is being put at the end of the queue we are +++ ** scanning. +++ */ +++ +++ for (q2 = nxtinq(&SendQ); (q = q2) != NULL; ) +++ { +++ /* save ptr to next address */ +++ q2 = nxtinq(q); +++ +++ /* only alias local users */ +++ if (q->q_mailer != &Mailer[0]) +++ continue; +++ +++ /* create a key for fetch */ +++ lhs.dptr = q->q_user; +++ lhs.dsize = strlen(q->q_user) + 1; +++ rhs = fetch(lhs); +++ +++ /* find this alias? */ +++ p = rhs.dptr; +++ if (p == NULL) +++ continue; +++ +++ /* +++ ** Match on Alias. +++ ** Deliver to the target list. +++ ** Remove the alias from the send queue +++ ** and put it on the Alias queue. +++ */ +++ +++# ifdef DEBUG +++ if (Debug) +++ printf("%s (%s, %s) aliased to %s\n", +++ q->q_paddr, q->q_host, q->q_user, p); +++# endif +++ tkoffq(q, &SendQ); +++ putonq(q, &AliasQ); +++ sendto(p, 1); +++ +++ /* if our last entry had an alias, process them */ +++ if (q2 == NULL) +++ q2 = nxtinq(&SendQ); +++ } +++#endif DBM +++} +++ /* +++** FORWARD -- Try to forward mail +++** +++** This is similar but not identical to aliasing. +++** +++** Currently it is undefined, until the protocol for userinfo +++** databases is finalized. +++** +++** Parameters: +++** user -- the name of the user who's mail we +++** would like to forward to. +++** +++** Returns: +++** TRUE -- we have forwarded it somewhere. +++** FALSE -- not forwarded; go ahead & deliver. +++** +++** Side Effects: +++** New names are added to SendQ. +++** +++** Called By: +++** recipient +++*/ +++ +++bool +++forward(user) +++ addrq *user; +++{ +++ return (FALSE); +++} diff --cc usr/src/cmd/delivermail/arpa.c index 0000000000,0000000000,0000000000..8724fbe5d0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/arpa.c @@@@ -1,0 -1,0 -1,0 +1,602 @@@@ +++# include +++# include +++# include +++# include +++# include "useful.h" +++ +++static char SccsId[] = "@(#)arpa.c 1.10 10/21/80"; +++char Version[] = "@(#)Arpa-mailer version 1.10 of 10/21/80"; +++ +++ +++/* +++** ARPA MAILER -- Queue ARPANET mail for eventual delivery +++** +++** The standard input is stuck away in the outgoing arpanet +++** mail queue for delivery by the true arpanet mailer. +++** +++** Usage: +++** /usr/lib/mailers/arpa from host user +++** +++** Positional Parameters: +++** from -- the person sending the mail. +++** host -- the host to send the mail to. +++** user -- the user to send the mail to. +++** +++** Flags: +++** -T -- debug flag. +++** +++** Files: +++** /usr/spool/netmail/* -- the queue file. +++** +++** Return Codes: +++** 0 -- all messages successfully mailed. +++** 2 -- user or host unknown. +++** 3 -- service unavailable, probably temporary +++** file system condition. +++** 4 -- syntax error in address. +++** +++** Compilation Flags: +++** SPOOLDIR -- the spool directory +++** +++** Compilation Instructions: +++** cc -n -O -s arpa-mailer.c -o arpa-mailer -lX +++** chmod 755 arpa-mailer +++** mv arpa-mailer /usr/lib/mailers/arpa +++** +++** Author: +++** Eric Allman, UCB/INGRES (eric@berkeley) +++*/ +++ +++# define SPOOLDIR "/usr/spool/netmail" +++ +++ +++ +++ +++char *From; /* person sending this mail */ +++char *To; /* current "To:" person */ +++int State; /* the current state (for exit codes) */ +++# ifdef DEBUG +++bool Tflag; /* -T given */ +++# endif DEBUG +++char FromHost[200]; /* string to prepend to addresses */ +++ /* +++** MAIN -- Main program for arpa mailer +++** +++** Processes arguments, and calls sendmail successively on +++** the To: list. +++** +++** Algorithm: +++** Scan for debug flag. +++** Catch interrupt signals. +++** Collect input file name and from person. +++** If more than one person in the to list, and +++** if the input file is not a real file, +++** collect input into a temp file. +++** For each person in the to list +++** Send to that person. +++** +++** Parameters: +++** argc +++** argv -- as usual +++** +++** Returns: +++** via exit +++** +++** Side Effects: +++** Mail gets sent. +++** +++** Called By: +++** /etc/delivermail +++** +++** Author: +++** Eric Allman UCB/INGRES. +++*/ +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ register int i; +++ register char *p; +++ register int ifd; +++ char buf[512]; +++ extern int finis(); +++ extern char *locv(); +++ register char *q; +++ char *lastmark; +++ +++ State = 3; +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) +++ signal(SIGINT, finis); +++ +++ /* process flags */ +++ argv[argc] = 0; +++# ifdef DEBUG +++ if (strcmp(argv[1], "-T") == 0) +++ { +++ Tflag++; +++ argv++; +++ argc--; +++ printf("%s\n", Version); +++ } +++# endif DEBUG +++ +++ if (argc != 4) +++ { +++ rexit (EX_SOFTWARE); +++ } +++ +++ /* decode parameters */ +++ From = argv[1]; +++ lastmark = &FromHost[-1]; +++ for (p = From, q = FromHost; (*q = *p) != '\0'; p++, q++) +++ { +++ if (*p == ':') +++ *q = *p = '.'; +++ if (*q == '.' || *q == '!' || *q == '@') +++ lastmark = q; +++ } +++ lastmark[1] = '\0'; +++ +++ /* start sending mail */ +++ State = sendmail(argv[2], argv[3]); +++ +++ /* all done, clean up */ +++ finis(); +++} +++ /* +++** FINIS -- Finish up, remove temp files, etc. +++** +++** This does basic cleanup on interrupt, error, or +++** normal termination. It uses "State" to tell which +++** is happening. +++** +++** Parameters: +++** none +++** +++** Returns: +++** none +++** +++** Side Effects: +++** Exit(State). +++** +++** Called By: +++** interrupt signal. +++** main +++*/ +++ +++finis() +++{ +++ rexit(State); +++} +++ +++/* +++** REXIT -- exit, reporting error code if -T given +++** +++** Parameters: +++** e -- error code to exit with; see sysexits.h +++** +++** Returns: +++** none +++** +++** Side Effects: +++** Exit(e). +++** +++** Called By: +++** main +++** finis +++** sendmail +++*/ +++rexit(e) +++{ +++ +++# ifdef DEBUG +++ if (Tflag) +++ fprintf(stderr, "arpa-mail: return code %d\n", e); +++# endif +++ exit(e); +++} +++ /* +++** SENDMAIL -- Queue up mail for the arpanet mailer. +++** +++** The mail is inserted with proper headers into the +++** arpanet queue directory. +++** +++** Algorithm: +++** decode "to" address +++** if error, exit. +++** create a spool file name. +++** output the header information to spool file, +++** separate names in To:, CC: fields with commas. +++** copy the mail to the spool file. +++** +++** Parameters: +++** host -- the host to send to. +++** user -- the user to send to. +++** +++** Returns: +++** none +++** +++** Side Effects: +++** the mail is copied into a file in the network +++** queue directory (/usr/spool/netmail). +++** +++** Called By: +++** main +++*/ +++ +++sendmail(host, user) +++ char *host; +++ char *user; +++{ +++ char spoolfile[50]; /* gets the spool file name */ +++ register int i; +++ register char *p; +++ static int callnum; /* for the final letter on spoolfile */ +++ char buf[512]; +++ register FILE *sfp; /* spool file */ +++ register int c; +++ extern char *matchhdr(); +++ +++ /* verify that the host exists */ +++#ifndef TESTING +++ strcpy(buf, "/dev/net/"); +++ strcat(buf, host); +++ if (host[0] == '\0' || access(buf, 0) < 0) +++ return (EX_NOHOST); +++#endif TESTING +++ +++ /* +++ ** Create spool file name. +++ ** Format is "username000nnX", where username is +++ ** padded on the right with zeros and nn (the process +++ ** id) is padded on the left with zeros; X is a unique +++ ** sequence character. +++ */ +++ +++# ifdef DEBUG +++ if (Tflag) +++ strcpy(spoolfile, "test.out"); +++# endif DEBUG +++ else +++ sprintf(spoolfile, "%s/arpamail%05d%c", SPOOLDIR, getpid(), 'a' + callnum++); +++ +++ /* create spool file */ +++ sfp = fopen(spoolfile, "w"); +++ if (sfp == NULL) +++ { +++ spoolerr: +++ return (EX_OSERR); +++ } +++# ifdef DEBUG +++ if (!Tflag) +++# endif DEBUG +++ chmod(spoolfile, 0400); +++ +++ /* +++ ** Output mailer control lines. +++ ** These lines are as follows: +++ ** /dev/net/ {target host} +++ ** user-name {at target host} +++ ** /mnt/eric {pathname of sender; not used} +++ ** eric {name of user who is sending} +++ */ +++ +++ fputs(buf, sfp); +++ fputs("\n", sfp); +++ fputs(user, sfp); +++ fputs("\n\n", sfp); +++ fputs(From, sfp); +++ fputs("\n", sfp); +++ +++ /* +++ ** Output the mail +++ ** Check the first line for the date. If not found, +++ ** assume the message is not in arpanet standard format +++ ** and output a "Date:" and "From:" header. +++ */ +++ +++ if (fgets(buf, sizeof buf, stdin) == NULL) +++ { +++ /* no message */ +++ unlink(spoolfile); +++ return (EX_OK); +++ } +++ if (matchhdr(buf, "date") == NULL) +++ putdate(sfp); +++ if (!ishdr(buf)) +++ { +++ putc('\n', sfp); +++ goto hdrdone; +++ } +++ +++ /* +++ ** At this point, we have a message with REAL headers. +++ ** We look at each head line and insert commas if it +++ ** is a To: or Cc: field. +++ */ +++ +++ do +++ { +++ if (!ishdr(buf)) +++ break; +++ if (!matchhdr(buf, "to") && !matchhdr(buf, "cc")) +++ { +++ fputs(buf, sfp); +++ continue; +++ } +++ /* gotcha! */ +++ rewrite(buf, 1, sfp); +++ while (isspace(c = peekc(stdin)) && c != '\n') +++ { +++ fgets(buf, BUFSIZ, stdin); +++ rewrite(buf, 0, sfp); +++ } +++ } while (fgets(buf, BUFSIZ, stdin) != NULL); +++ +++hdrdone: +++ /* output the rest of the header & the body of the letter */ +++ do +++ { +++ fputs(buf, sfp); +++ if (ferror(sfp)) +++ goto spoolerr; +++ } while (fgets(buf, sizeof buf, stdin) != NULL); +++ +++ /* all done! */ +++ fclose(sfp); +++ return (EX_OK); +++} +++ /* +++** REWRITE -- Output header line with needed commas. +++** +++** Parameters: +++** buf -- header line +++** first -- true if this is not a continuation +++** +++** Returns: +++** none +++** +++** Side effects: +++** The contents of buf is copied onto the spool file with +++** with the right commas interlaced +++** +++** Called by: +++** sendmail +++*/ +++ +++rewrite(buf, first, spf) +++ char buf[]; +++ register FILE *spf; +++{ +++ register char *cp; +++ register int c; +++ char word[BUFSIZ], word2[BUFSIZ]; +++ char *gword(); +++ static char wsep[] = ", "; +++ +++ cp = buf; +++ if (first) +++ { +++ while (*cp != ':' && *cp) +++ putc(*cp++, spf); +++ if (*cp == ':') +++ { +++ fputs(": ", spf); +++ cp++; +++ } +++ } +++ else +++ while (*cp && isspace(*cp)) +++ putc(*cp++, spf); +++ cp = gword(word, cp); +++ if (strlen(word) == 0) +++ { +++ putc('\n', spf); +++ goto test; +++ } +++ for (;;) +++ { +++ cp = gword(word2, cp); +++ if (strlen(word2) == 0) +++ { +++ putaddr(word, spf); +++ break; +++ } +++ if (strcmp(word2, "%") == 0) +++ word2[0] = '@'; +++ if (strcmp(word2, "@") && strcmp(word2, "at")) +++ { +++ putaddr(word, spf); +++ fputs(wsep, spf); +++ strcpy(word, word2); +++ continue; +++ } +++ fputs(word, spf); +++ if (word2[0] == '@') +++ putc('@', spf); +++ else +++ fputs(" at ", spf); +++ cp = gword(word, cp); +++ fputs(word, spf); +++ cp = gword(word, cp); +++ if (strlen(word)) +++ fputs(wsep, spf); +++ } +++ +++test: +++ c = peekc(stdin); +++ if (isspace(c) && c != '\n') +++ fputs(",\n", spf); +++ else +++ putc('\n', spf); +++} +++ /* +++** PUTADDR -- output address onto file +++** +++** Putaddr prepends the network header onto the address +++** unless one already exists. +++** +++** Parameters: +++** name -- the name to output. +++** fp -- the file to put it on. +++** +++** Returns: +++** none. +++** +++** Side Effects: +++** name is put onto fp. +++*/ +++ +++putaddr(name, fp) +++ char *name; +++ FILE *fp; +++{ +++ register char *p; +++ +++ if (strlen(name) == 0) +++ return; +++ for (p = name; *p != '\0' && *p != ':' && *p != '.' && *p != '@' && +++ *p != '!' && *p != '^'; p++) +++ continue; +++ if (*p == ':') +++ *p = '.'; +++ else if (*p == '\0') +++ fputs(FromHost, fp); +++ fputs(name, fp); +++ if (*p != '@') +++ fputs("@Berkeley", fp); +++} +++ /* +++** PEEKC -- peek at next character in input file +++** +++** Parameters: +++** fp -- stdio file buffer +++** +++** Returns: +++** the next character in the input or EOF +++** +++** Side effects: +++** None. +++** +++** Called by: +++** sendmail +++** rewrite +++*/ +++peekc(fp) +++ register FILE *fp; +++{ +++ register int c; +++ +++ c = getc(fp); +++ ungetc(c, fp); +++ return(c); +++} +++ +++ /* +++** GWORD -- get the next liberal word from a string +++** +++** Parameters: +++** buf -- place to put scanned word +++** p -- place to start looking for word +++** +++** Returns: +++** updated value of p or 0 if no more left after this +++** +++** Side effects: +++** buf gets the liberal word scanned. +++** buf will be length 0 if there is no more input, +++** or if p was passed as 0 +++** +++** Called by: +++** rewrite +++*/ +++char * +++gword(buf, p) +++ char buf[]; +++ register char *p; +++{ +++ register char *sp, *dp; +++ +++ strcpy(buf, ""); +++ if (p == 0) +++ return(0); +++ sp = p; +++ while (*sp && (isspace(*sp) || *sp == ',')) +++ sp++; +++ dp = buf; +++ if (*sp != '%' && *sp != '@') +++ { +++ while (*sp && !isspace(*sp) && *sp != ',' && *sp != '%' && *sp != '@') +++ *dp++ = *sp++; +++ } +++ else +++ *dp++ = *sp++; +++ *dp = 0; +++ if (*sp == 0) +++ return(0); +++ return(sp); +++} +++ /* +++** ISHDR -- see if the passed line is a ARPA style header line +++** +++** Parameters: +++** buf -- header line +++** +++** Returns: +++** non-zero if the line is a header line, else zero +++** +++** Side effects: +++** none +++** +++** Called by: +++** sendmail +++*/ +++ishdr(buf) +++ char buf[]; +++{ +++ register char *p; +++ +++ p = buf; +++ if (isspace(*p)) +++ p = 0; +++ else +++ { +++ while (*p != ':' && !isspace(*p)) +++ p++; +++ while (isspace(*p)) +++ p++; +++ if (*p != ':') +++ p = 0; +++ } +++ return(p != 0); +++} +++ /* +++** PUTDATE -- Put the date & from field into the message. +++** +++** Parameters: +++** fp -- file to put them onto. +++** +++** Returns: +++** none +++** +++** Side Effects: +++** output onto fp. +++** +++** Called By: +++** sendmail +++*/ +++ +++putdate(fp) +++ register FILE *fp; +++{ +++ register char *p; +++ +++ fputs("Date: ", fp); +++ fputs(arpadate(), fp); +++ +++ /* output from field */ +++ fputs("\nFrom: ", fp); +++ fputs(From, fp); +++ fputs(" at Berkeley\n", fp); +++} diff --cc usr/src/cmd/delivermail/arpadate.c index 0000000000,0000000000,0000000000..0acc51656a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/arpadate.c @@@@ -1,0 -1,0 -1,0 +1,51 @@@@ +++# include +++ +++static char SccsId[] = "@(#)arpadate.c 1.4 10/21/80"; +++ +++/* +++** ARPADATE -- Create date in ARPANET format +++** +++** Parameters: +++** none +++** +++** Returns: +++** pointer to an ARPANET date field +++** +++** Side Effects: +++** none +++** +++** WARNING: +++** date is stored in a local buffer -- subsequent +++** calls will overwrite. +++*/ +++ +++char * +++arpadate() +++{ +++ register char *ud; /* the unix date */ +++ long t; +++ extern struct tm *localtime(); +++ register char *p; +++ static char b[40]; +++ extern char *ctime(); +++ +++ time(&t); +++ ud = ctime(&t); +++ +++ ud[3] = ud[7] = ud[10] = ud[19] = ud[24] = '\0'; +++ p = &ud[8]; /* 16 */ +++ if (*p == ' ') +++ p++; +++ strcpy(b, p); +++ strcat(b, " "); +++ strcat(b, &ud[4]); /* Sep */ +++ strcat(b, " "); +++ strcat(b, &ud[20]); /* 1979 */ +++ strcat(b, " "); +++ strcat(b, &ud[11]); /* 01:03:52 */ +++ if (localtime(&t)->tm_isdst) +++ strcat(b, "-PDT"); +++ else +++ strcat(b, "-PST"); +++ return (b); +++} diff --cc usr/src/cmd/delivermail/bmove.c index 0000000000,0000000000,0000000000..9cf77956b9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/bmove.c @@@@ -1,0 -1,0 -1,0 +1,9 @@@@ +++/* @(#)bmove.c 1.3 8/2/80 */ +++ +++bmove(s, d, l) +++ register char *s, *d; +++ register int l; +++{ +++ while (l-- > 0) +++ *d++ = *s++; +++} diff --cc usr/src/cmd/delivermail/bmove.vax.s index 0000000000,0000000000,0000000000..2621c496bc new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/bmove.vax.s @@@@ -1,0 -1,0 -1,0 +1,10 @@@@ +++# +++# BMOVE.S -- optimized block move routine. +++# +++# @(#)bmove.vax.s 1.2 7/25/80 +++# +++.globl _bmove +++_bmove: +++ .word 0x0030 +++ movc3 12(ap),*4(ap),*8(ap) +++ ret diff --cc usr/src/cmd/delivermail/conf.c index 0000000000,0000000000,0000000000..caf62eee23 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/conf.c @@@@ -1,0 -1,0 -1,0 +1,433 @@@@ +++# include +++# include +++# include "dlvrmail.h" +++ +++/* +++** CONF.C -- Delivermail Configuration Tables. +++** +++** Defines the configuration of this installation. +++** +++** Compilation Flags: +++** HASARPA -- set if this machine has a connection to +++** the Arpanet. +++** HASUUCP -- set if this machine has a connection to +++** the UUCP network. +++** NETV6MAIL -- set if you want to use "v6mail" that +++** comes with the Berkeley network. Normally +++** /bin/mail will work fine, but around Berkeley +++** we use v6mail because it is a "fixed target". +++** V6 -- running on a version 6 system. This determines +++** whether to define certain routines between +++** the two systems. If you are running a funny +++** system, e.g., V6 with long tty names, this +++** should be checked carefully. +++** DUMBMAIL -- set if your /bin/mail doesn't have the +++** -d flag. +++** +++** Configuration Variables: +++** ArpaHost -- the arpanet name of the host through +++** which arpanet mail will be sent. +++** MyLocName -- the name of the host on a local network. +++** This is used to disambiguate the contents of +++** ArpaHost among many hosts who may be sharing +++** a gateway. +++** ArpaLocal -- a list of local names for this host on +++** the arpanet. Only functional if HASARPA set. +++** UucpLocal -- ditto for the Arpanet. +++** BerkLocal -- ditto for the Berknet. +++** Mailer -- a table of mailers known to the system. +++** The fields are: +++** - the pathname of the mailer. +++** - a list of flags describing the properties +++** of this mailer: +++** M_FOPT -- if set, the mailer has a picky "-f" +++** option. In this mode, the mailer will +++** only accept the "-f" option if the +++** sender is actually "root", "network", +++** and possibly (but not necessarily) if +++** the -f argument matches the real sender. +++** The effect is that if the "-f" option +++** is given to delivermail then it will be +++** passed through (as arguments 1 & 2) to +++** the mailer. +++** M_ROPT -- identical to M_FOPT, except uses +++** -r instead. +++** M_QUIET -- if set, don't print a message if +++** the mailer returns bad status. +++** M_RESTR -- if set, this mailer is restricted +++** to use by "daemon"; otherwise, we do a +++** setuid(getuid()) before calling the +++** mailer. +++** M_HDR -- if set, the mailer wants us to +++** insert a UNIX "From" line before +++** outputing. +++** M_NOHOST -- if set, this mailer doesn't care +++** about the host part (e.g., the local +++** mailer). +++** M_STRIPQ -- if set, strip quote (`"') +++** characters out of parameters as you +++** transliterate them into the argument +++** vector. For example, the local mailer +++** is called directly, so these should be +++** stripped, but the program-mailer (i.e., +++** csh) should leave them in. +++** - an exit status to use as the code for the +++** error message print if the mailer returns +++** something we don't understand. +++** - A list of names that are to be considered +++** "local" (and hence are stripped off) for +++** this mailer. +++** - An argument vector to be passed to the +++** mailer with the following substitutions: +++** $f - the from person name. +++** $u - the target user name. +++** $h - the target user host. +++** $c - the hop count. +++** >>>>>>>>>> Entry zero must be for the local +++** >> NOTE >> mailer and entry one must be for +++** >>>>>>>>>> the shell. +++** ParseTab -- a table driving the parsing process. Each +++** entry contains: +++** - a character that will trigger this entry. +++** - an index into the Mailer table. +++** - a word of flags, described in dlvrmail.h. +++** - an argument. If we have P_MAP, it is the +++** character to turn the trigger character into. +++** If we have P_MOVE, it is the site to send it +++** to, using the mailer specified above. +++** This table will almost certainly have to be +++** changed on your site if you have anything more +++** than the UUCP net. +++*/ +++ +++ +++ +++ +++static char SccsId[] = "@(#)conf.c 1.10 10/21/80"; +++ +++/************ BEGIN CONFIGURATION SECTION ************/ +++ +++bool UseMsgId = FALSE; /* don't put message id's in anywhere */ +++ +++# include /* definitions of machine id's at berkeley */ +++ +++char *ArpaHost = "[unknown]"; +++char *MyLocName = sysname; +++# define HASUUCP /* default to having UUCP net */ +++char *UucpLocal[] = { sysname, NULL }; +++/* if you define HASARPA you must include a declaration for ArpaLocal */ +++ +++/************ END CONFIGURATION SECTION ************/ +++ +++# ifndef HASARPA +++# define ArpaLocal NULL +++# endif HASARPA +++ +++# ifndef HASUUCP +++# define UucpLocal NULL +++# endif HASUUCP +++ +++# ifndef HASBERK +++# define BerkLocal NULL +++# endif HASBERK +++ +++ +++struct mailer Mailer[] = +++{ +++ /* local mail -- must be #0 */ +++ { +++# ifdef NETV6MAIL +++ "/usr/net/bin/v6mail", +++# else +++ "/bin/mail", +++# endif +++ M_ROPT|M_NOHOST|M_STRIPQ, EX_NOUSER, NULL, +++ { "...local%mail", "-d", "$u", NULL } +++ }, +++ /* pipes through programs -- must be #1 */ +++ { +++ "/bin/csh", +++ M_HDR|M_NOHOST, EX_UNAVAILABLE, NULL, +++ { "...prog%mail", "-fc", "$u", NULL } +++ }, +++ /* local berkeley mail */ +++ { +++ "/usr/net/bin/sendberkmail", +++ M_FOPT|M_HDR|M_STRIPQ, EX_UNAVAILABLE, BerkLocal, +++ { "...berk%mail", "-m", "$h", "-t", "$u", "-h", "$c", NULL } +++ }, +++ /* arpanet mail */ +++ { +++ "/usr/lib/mailers/arpa", +++ M_STRIPQ, 0, ArpaLocal, +++ { "...arpa%mail", "$f", "$h", "$u", NULL } +++ }, +++ /* uucp mail (cheat & use Bell's v7 mail) */ +++ { +++ "/bin/mail", +++ M_ROPT|M_STRIPQ, EX_NOUSER, UucpLocal, +++# ifdef DUMBMAIL +++ { "...uucp%mail", "$h!$u", NULL } +++# else +++ { "...uucp%mail", "-d", "$h!$u", NULL } +++# endif DUMBMAIL +++ }, +++}; +++ +++# define M_LOCAL 0 +++# define M_BERK 2 +++# define M_ARPA 3 +++# define M_UUCP 4 +++ +++ +++ +++struct parsetab ParseTab[] = +++{ +++# ifdef HASARPA +++ '@', M_ARPA, P_HLAST|P_USR_UPPER, NULL, +++# endif HASARPA +++# ifdef HASUUCP +++ '^', -1, P_MAP, "!", +++ '!', M_UUCP, 0, NULL, +++# endif HASUUCP +++ '\0', M_LOCAL, P_MOVE, "", +++}; +++ /* +++** GETNAME -- Get the current users login name. +++** +++** This is in config.c because it is somewhat machine dependent. +++** Examine it carefully for your installation. +++** +++** Algorithm: +++** See if the person is logged in. If so, return +++** the name s/he is logged in as. +++** Look up the user id in /etc/passwd. If found, +++** return that name. +++** Return NULL. +++** +++** Parameters: +++** none +++** +++** Returns: +++** The login name of this user. +++** NULL if this person is noone. +++** +++** Side Effects: +++** none +++** +++** Called By: +++** main +++*/ +++ +++char * +++getname() +++{ +++ register char *p; +++ register struct passwd *w; +++ extern char *getlogin(); +++ extern struct passwd *getpwuid(); +++ static char namebuf[9]; +++ +++ p = getlogin(); +++ if (p != NULL && p[0] != '\0') +++ return (p); +++# ifdef V6 +++ w = getpwuid(getuid() & 0377); +++# else +++ w = getpwuid(getuid()); +++# endif V6 +++ if (w != NULL) +++ { +++ strcpy(namebuf, w->pw_name); +++ return (namebuf); +++ } +++ return (NULL); +++} +++ +++# ifdef V6 +++/* +++** TTYPATH -- Get the path of the user's tty -- Version 6 version. +++** +++** Returns the pathname of the user's tty. Returns NULL if +++** the user is not logged in or if s/he has write permission +++** denied. +++** +++** Parameters: +++** none +++** +++** Returns: +++** pathname of the user's tty. +++** NULL if not logged in or write permission denied. +++** +++** Side Effects: +++** none. +++** +++** WARNING: +++** Return value is in a local buffer. +++** +++** Called By: +++** savemail +++*/ +++ +++# include +++# include +++ +++char * +++ttypath() +++{ +++ struct stat stbuf; +++ register int i; +++ static char pathn[] = "/dev/ttyx"; +++ extern int errno; +++ +++ /* compute the pathname of the controlling tty */ +++ if ((i = ttyn(2)) == 'x' && (i = ttyn(1)) == 'x' && (i = ttyn(0)) == 'x') +++ { +++ errno = 0; +++ return (NULL); +++ } +++ pathn[8] = i; +++ +++ /* see if we have write permission */ +++ if (stat(pathn, &stbuf) < 0 || !flagset(02, stbuf.st_mode)) +++ { +++ errno = 0; +++ return (NULL); +++ } +++ +++ /* see if the user is logged in */ +++ if (getlogin() == NULL) +++ return (NULL); +++ +++ /* looks good */ +++ return (pathn); +++} +++ /* +++** FDOPEN -- Open a stdio file given an open file descriptor. +++** +++** This is included here because it is standard in v7, but we +++** need it in v6. +++** +++** Algorithm: +++** Open /dev/null to create a descriptor. +++** Close that descriptor. +++** Copy the existing fd into the descriptor. +++** +++** Parameters: +++** fd -- the open file descriptor. +++** type -- "r", "w", or whatever. +++** +++** Returns: +++** The file descriptor it creates. +++** +++** Side Effects: +++** none +++** +++** Called By: +++** deliver +++** +++** Notes: +++** The mode of fd must match "type". +++*/ +++ +++FILE * +++fdopen(fd, type) +++ int fd; +++ char *type; +++{ +++ register FILE *f; +++ +++ f = fopen("/dev/null", type); +++ close(fileno(f)); +++ fileno(f) = fd; +++ return (f); +++} +++ /* +++** INDEX -- Return pointer to character in string +++** +++** For V7 compatibility. +++** +++** Parameters: +++** s -- a string to scan. +++** c -- a character to look for. +++** +++** Returns: +++** If c is in s, returns the address of the first +++** instance of c in s. +++** NULL if c is not in s. +++** +++** Side Effects: +++** none. +++*/ +++ +++index(s, c) +++ register char *s; +++ register char c; +++{ +++ while (*s != '\0') +++ { +++ if (*s++ == c) +++ return (--s); +++ } +++ return (NULL); +++} +++# endif V6 +++ +++# ifndef V6 +++/* +++** TTYPATH -- Get the path of the user's tty -- Version 7 version. +++** +++** Returns the pathname of the user's tty. Returns NULL if +++** the user is not logged in or if s/he has write permission +++** denied. +++** +++** Parameters: +++** none +++** +++** Returns: +++** pathname of the user's tty. +++** NULL if not logged in or write permission denied. +++** +++** Side Effects: +++** none. +++** +++** WARNING: +++** Return value is in a local buffer. +++** +++** Called By: +++** savemail +++*/ +++ +++# include +++# include +++ +++char * +++ttypath() +++{ +++ struct stat stbuf; +++ register char *pathn; +++ extern int errno; +++ extern char *ttyname(); +++ +++ /* compute the pathname of the controlling tty */ +++ if ((pathn = ttyname(2)) == NULL && (pathn = ttyname(1)) == NULL && (pathn = ttyname(0)) == NULL) +++ { +++ errno = 0; +++ return (NULL); +++ } +++ +++ /* see if we have write permission */ +++ if (stat(pathn, &stbuf) < 0 || !flagset(02, stbuf.st_mode)) +++ { +++ errno = 0; +++ return (NULL); +++ } +++ +++ /* see if the user is logged in */ +++ if (getlogin() == NULL) +++ return (NULL); +++ +++ /* looks good */ +++ return (pathn); +++} +++# endif V6 diff --cc usr/src/cmd/delivermail/conf.ucb.c index 0000000000,0000000000,0000000000..78d6d87050 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/conf.ucb.c @@@@ -1,0 -1,0 -1,0 +1,497 @@@@ +++# include +++# include +++# include "dlvrmail.h" +++ +++/* +++** CONF.C -- Delivermail Configuration Tables. +++** +++** Defines the configuration of this installation. +++** +++** Compilation Flags: +++** HASARPA -- set if this machine has a connection to +++** the Arpanet. +++** HASUUCP -- set if this machine has a connection to +++** the UUCP network. +++** NETV6MAIL -- set if you want to use "v6mail" that +++** comes with the Berkeley network. Normally +++** /bin/mail will work fine, but around Berkeley +++** we use v6mail because it is a "fixed target". +++** V6 -- running on a version 6 system. This determines +++** whether to define certain routines between +++** the two systems. If you are running a funny +++** system, e.g., V6 with long tty names, this +++** should be checked carefully. +++** DUMBMAIL -- set if your /bin/mail doesn't have the +++** -d flag. +++** +++** Configuration Variables: +++** ArpaHost -- the arpanet name of the host through +++** which arpanet mail will be sent. +++** MyLocName -- the name of the host on a local network. +++** This is used to disambiguate the contents of +++** ArpaHost among many hosts who may be sharing +++** a gateway. +++** ArpaLocal -- a list of local names for this host on +++** the arpanet. Only functional if HASARPA set. +++** UucpLocal -- ditto for the Arpanet. +++** BerkLocal -- ditto for the Berknet. +++** Mailer -- a table of mailers known to the system. +++** The fields are: +++** - the pathname of the mailer. +++** - a list of flags describing the properties +++** of this mailer: +++** M_FOPT -- if set, the mailer has a picky "-f" +++** option. In this mode, the mailer will +++** only accept the "-f" option if the +++** sender is actually "root", "network", +++** and possibly (but not necessarily) if +++** the -f argument matches the real sender. +++** The effect is that if the "-f" option +++** is given to delivermail then it will be +++** passed through (as arguments 1 & 2) to +++** the mailer. +++** M_ROPT -- identical to M_FOPT, except uses +++** -r instead. +++** M_QUIET -- if set, don't print a message if +++** the mailer returns bad status. +++** M_RESTR -- if set, this mailer is restricted +++** to use by "daemon"; otherwise, we do a +++** setuid(getuid()) before calling the +++** mailer. +++** M_HDR -- if set, the mailer wants us to +++** insert a UNIX "From" line before +++** outputing. +++** M_NOHOST -- if set, this mailer doesn't care +++** about the host part (e.g., the local +++** mailer). +++** M_STRIPQ -- if set, strip quote (`"') +++** characters out of parameters as you +++** transliterate them into the argument +++** vector. For example, the local mailer +++** is called directly, so these should be +++** stripped, but the program-mailer (i.e., +++** csh) should leave them in. +++** - an exit status to use as the code for the +++** error message print if the mailer returns +++** something we don't understand. +++** - A list of names that are to be considered +++** "local" (and hence are stripped off) for +++** this mailer. +++** - An argument vector to be passed to the +++** mailer with the following substitutions: +++** $f - the from person name. +++** $u - the target user name. +++** $h - the target user host. +++** $c - the hop count. +++** >>>>>>>>>> Entry zero must be for the local +++** >> NOTE >> mailer and entry one must be for +++** >>>>>>>>>> the shell. +++** ParseTab -- a table driving the parsing process. Each +++** entry contains: +++** - a character that will trigger this entry. +++** - an index into the Mailer table. +++** - a word of flags, described in dlvrmail.h. +++** - an argument. If we have P_MAP, it is the +++** character to turn the trigger character into. +++** If we have P_MOVE, it is the site to send it +++** to, using the mailer specified above. +++** This table will almost certainly have to be +++** changed on your site if you have anything more +++** than the UUCP net. +++*/ +++ +++ +++ +++ +++static char SccsId[] = "@(#)conf.c 1.10 10/21/80"; +++ +++ +++bool UseMsgId = FALSE; /* don't put message id's in anywhere */ +++ +++# include /* definitions of machine id's at berkeley */ +++ +++# ifdef BERKELEY +++char *ArpaHost = "Berkeley"; /* host name of gateway on Arpanet */ +++# else BERKELEY +++char *ArpaHost = "[unknown]"; +++char *MyLocName = sysname; +++# define HASUUCP /* default to having UUCP net */ +++char *UucpLocal[] = { sysname, NULL }; +++# endif BERKELEY +++ +++# ifdef ING70 +++static char *BerkLocal[] = { "i", "ingres", "ing70", NULL }; +++# define ArpaLocal NULL +++char *MyLocName = "Ing70"; +++# define HASARPA +++# define V6 +++# endif ING70 +++ +++# ifdef INGVAX +++static char *BerkLocal[] = { "j", "ingvax", NULL }; +++char *MyLocName = "IngVax"; +++# endif INGVAX +++ +++# ifdef CSVAX +++static char *BerkLocal[] = { "v", "csvax", "vax", NULL }; +++static char *UucpLocal[] = { "ucbvax", "ernie", NULL }; +++char *MyLocName = "CSVAX"; +++# define HASUUCP +++# define NETV6MAIL +++# endif CSVAX +++ +++# ifdef CORY +++/* untested */ +++static char *BerkLocal[] = { "y", "cory", NULL }; +++char *MyLocName = "Cory"; +++# endif CORY +++ +++# ifdef IMAGE +++/* untested */ +++static char *BerkLocal[] = { "m", "image", NULL }; +++char *MyLocName = "Image"; +++# define V6 +++# endif IMAGE +++ +++# ifdef ESVAX +++/* untested */ +++static char *BerkLocal[] = { "o", "esvax", NULL }; +++char *MyLocName = "ESVAX"; +++# endif ESVAX +++ +++# ifdef EECS40 +++/* untested */ +++static char *BerkLocal[] = { "z", "eecs40", NULL }; +++char *MyLocName = "EECS40"; +++# define V6 +++# endif EECS40 +++ +++ +++# ifndef HASARPA +++# define ArpaLocal NULL +++# endif HASARPA +++ +++# ifndef HASUUCP +++# define UucpLocal NULL +++# endif HASUUCP +++ +++ +++struct mailer Mailer[] = +++{ +++ /* local mail -- must be #0 */ +++ { +++# ifdef NETV6MAIL +++ "/usr/net/bin/v6mail", +++# else +++ "/bin/mail", +++# endif +++ M_ROPT|M_NOHOST|M_STRIPQ, EX_NOUSER, NULL, +++ { "...local%mail", "-d", "$u", NULL } +++ }, +++ /* pipes through programs -- must be #1 */ +++ { +++ "/bin/csh", +++ M_HDR|M_NOHOST, EX_UNAVAILABLE, NULL, +++ { "...prog%mail", "-fc", "$u", NULL } +++ }, +++ /* local berkeley mail */ +++ { +++ "/usr/net/bin/sendberkmail", +++ M_FOPT|M_HDR|M_STRIPQ, EX_UNAVAILABLE, BerkLocal, +++ { "...berk%mail", "-m", "$h", "-t", "$u", "-h", "$c", NULL } +++ }, +++ /* arpanet mail */ +++ { +++ "/usr/lib/mailers/arpa", +++ M_STRIPQ, 0, ArpaLocal, +++ { "...arpa%mail", "$f", "$h", "$u", NULL } +++ }, +++ /* uucp mail (cheat & use Bell's v7 mail) */ +++ { +++ "/bin/mail", +++ M_ROPT|M_STRIPQ, EX_NOUSER, UucpLocal, +++# ifdef DUMBMAIL +++ { "...uucp%mail", "$h!$u", NULL } +++# else +++ { "...uucp%mail", "-d", "$h!$u", NULL } +++# endif DUMBMAIL +++ }, +++}; +++ +++# define M_LOCAL 0 +++# define M_BERK 2 +++# define M_ARPA 3 +++# define M_UUCP 4 +++ +++ +++ +++# ifdef BERKELEY +++struct parsetab ParseTab[] = +++{ +++ ':', M_BERK, P_ONE, NULL, +++# ifdef HASARPA +++ '@', M_ARPA, P_HLAST|P_USR_UPPER, NULL, +++# else +++ '@', M_BERK, P_HLAST|P_USR_UPPER|P_MOVE, "ing70", +++# endif HASARPA +++ '^', -1, P_MAP, "!", +++# ifdef HASUUCP +++ '!', M_UUCP, 0, NULL, +++# else +++ '!', M_BERK, P_MOVE, "csvax", +++# endif HASUUCP +++ '.', -1, P_MAP|P_ONE, ":", +++ '\0', M_LOCAL, P_MOVE, "", +++}; +++# else BERKELEY +++struct parsetab ParseTab[] = +++{ +++# ifdef HASARPA +++ '@', M_ARPA, P_HLAST|P_USR_UPPER, NULL, +++# endif HASARPA +++# ifdef HASUUCP +++ '^', -1, P_MAP, "!", +++ '!', M_UUCP, 0, NULL, +++# endif HASUUCP +++ '\0', M_LOCAL, P_MOVE, "", +++}; +++# endif BERKELEY +++ /* +++** GETNAME -- Get the current users login name. +++** +++** This is in config.c because it is somewhat machine dependent. +++** Examine it carefully for your installation. +++** +++** Algorithm: +++** See if the person is logged in. If so, return +++** the name s/he is logged in as. +++** Look up the user id in /etc/passwd. If found, +++** return that name. +++** Return NULL. +++** +++** Parameters: +++** none +++** +++** Returns: +++** The login name of this user. +++** NULL if this person is noone. +++** +++** Side Effects: +++** none +++** +++** Called By: +++** main +++*/ +++ +++char * +++getname() +++{ +++ register char *p; +++ register struct passwd *w; +++ extern char *getlogin(); +++ extern struct passwd *getpwuid(); +++ static char namebuf[9]; +++ +++ p = getlogin(); +++ if (p != NULL && p[0] != '\0') +++ return (p); +++# ifdef V6 +++ w = getpwuid(getuid() & 0377); +++# else +++ w = getpwuid(getuid()); +++# endif V6 +++ if (w != NULL) +++ { +++ strcpy(namebuf, w->pw_name); +++ return (namebuf); +++ } +++ return (NULL); +++} +++ +++# ifdef V6 +++/* +++** TTYPATH -- Get the path of the user's tty -- Version 6 version. +++** +++** Returns the pathname of the user's tty. Returns NULL if +++** the user is not logged in or if s/he has write permission +++** denied. +++** +++** Parameters: +++** none +++** +++** Returns: +++** pathname of the user's tty. +++** NULL if not logged in or write permission denied. +++** +++** Side Effects: +++** none. +++** +++** WARNING: +++** Return value is in a local buffer. +++** +++** Called By: +++** savemail +++*/ +++ +++# include +++# include +++ +++char * +++ttypath() +++{ +++ struct stat stbuf; +++ register int i; +++ static char pathn[] = "/dev/ttyx"; +++ extern int errno; +++ +++ /* compute the pathname of the controlling tty */ +++ if ((i = ttyn(2)) == 'x' && (i = ttyn(1)) == 'x' && (i = ttyn(0)) == 'x') +++ { +++ errno = 0; +++ return (NULL); +++ } +++ pathn[8] = i; +++ +++ /* see if we have write permission */ +++ if (stat(pathn, &stbuf) < 0 || !flagset(02, stbuf.st_mode)) +++ { +++ errno = 0; +++ return (NULL); +++ } +++ +++ /* see if the user is logged in */ +++ if (getlogin() == NULL) +++ return (NULL); +++ +++ /* looks good */ +++ return (pathn); +++} +++ /* +++** FDOPEN -- Open a stdio file given an open file descriptor. +++** +++** This is included here because it is standard in v7, but we +++** need it in v6. +++** +++** Algorithm: +++** Open /dev/null to create a descriptor. +++** Close that descriptor. +++** Copy the existing fd into the descriptor. +++** +++** Parameters: +++** fd -- the open file descriptor. +++** type -- "r", "w", or whatever. +++** +++** Returns: +++** The file descriptor it creates. +++** +++** Side Effects: +++** none +++** +++** Called By: +++** deliver +++** +++** Notes: +++** The mode of fd must match "type". +++*/ +++ +++FILE * +++fdopen(fd, type) +++ int fd; +++ char *type; +++{ +++ register FILE *f; +++ +++ f = fopen("/dev/null", type); +++ close(fileno(f)); +++ fileno(f) = fd; +++ return (f); +++} +++ /* +++** INDEX -- Return pointer to character in string +++** +++** For V7 compatibility. +++** +++** Parameters: +++** s -- a string to scan. +++** c -- a character to look for. +++** +++** Returns: +++** If c is in s, returns the address of the first +++** instance of c in s. +++** NULL if c is not in s. +++** +++** Side Effects: +++** none. +++*/ +++ +++index(s, c) +++ register char *s; +++ register char c; +++{ +++ while (*s != '\0') +++ { +++ if (*s++ == c) +++ return (--s); +++ } +++ return (NULL); +++} +++# endif V6 +++ +++# ifndef V6 +++/* +++** TTYPATH -- Get the path of the user's tty -- Version 7 version. +++** +++** Returns the pathname of the user's tty. Returns NULL if +++** the user is not logged in or if s/he has write permission +++** denied. +++** +++** Parameters: +++** none +++** +++** Returns: +++** pathname of the user's tty. +++** NULL if not logged in or write permission denied. +++** +++** Side Effects: +++** none. +++** +++** WARNING: +++** Return value is in a local buffer. +++** +++** Called By: +++** savemail +++*/ +++ +++# include +++# include +++ +++char * +++ttypath() +++{ +++ struct stat stbuf; +++ register char *pathn; +++ extern int errno; +++ extern char *ttyname(); +++ +++ /* compute the pathname of the controlling tty */ +++ if ((pathn = ttyname(2)) == NULL && (pathn = ttyname(1)) == NULL && (pathn = ttyname(0)) == NULL) +++ { +++ errno = 0; +++ return (NULL); +++ } +++ +++ /* see if we have write permission */ +++ if (stat(pathn, &stbuf) < 0 || !flagset(02, stbuf.st_mode)) +++ { +++ errno = 0; +++ return (NULL); +++ } +++ +++ /* see if the user is logged in */ +++ if (getlogin() == NULL) +++ return (NULL); +++ +++ /* looks good */ +++ return (pathn); +++} +++# endif V6 diff --cc usr/src/cmd/delivermail/deliver.c index 0000000000,0000000000,0000000000..3fa732a538 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/deliver.c @@@@ -1,0 -1,0 -1,0 +1,761 @@@@ +++# include +++# include +++# include +++# include "dlvrmail.h" +++# ifdef LOG +++# include +++# endif LOG +++ +++static char SccsId[] = "@(#)deliver.c 1.11 10/27/80"; +++ +++/* +++** DELIVER -- Deliver a message to a particular address. +++** +++** Algorithm: +++** Compute receiving network (i.e., mailer), host, & user. +++** If local, see if this is really a program name. +++** Build argument for the mailer. +++** Create pipe through edit fcn if appropriate. +++** Fork. +++** Child: call mailer +++** Parent: call editfcn if specified. +++** Wait for mailer to finish. +++** Interpret exit status. +++** +++** Parameters: +++** to -- the address to deliver the message to. +++** editfcn -- if non-NULL, we want to call this function +++** to output the letter (instead of just out- +++** putting it raw). +++** +++** Returns: +++** zero -- successfully delivered. +++** else -- some failure, see ExitStat for more info. +++** +++** Side Effects: +++** The standard input is passed off to someone. +++** +++** WARNING: +++** The standard input is shared amongst all children, +++** including the file pointer. It is critical that the +++** parent waits for the child to finish before forking +++** another child. +++** +++** Called By: +++** main +++** savemail +++** +++** Files: +++** standard input -- must be opened to the message to +++** deliver. +++*/ +++ +++deliver(to, editfcn) +++ addrq *to; +++ int (*editfcn)(); +++{ +++ register struct mailer *m; +++ char *host; +++ char *user; +++ extern struct passwd *getpwnam(); +++ char **pvp; +++ extern char **buildargv(); +++ auto int st; +++ register int i; +++ register char *p; +++ int pid; +++ int pvect[2]; +++ extern FILE *fdopen(); +++ extern int errno; +++ FILE *mfile; +++ extern putheader(); +++ extern pipesig(); +++ +++ /* +++ ** Compute receiving mailer, host, and to addreses. +++ ** Do some initialization first. To is the to address +++ ** for error messages. +++ */ +++ +++ To = to->q_paddr; +++ m = to->q_mailer; +++ user = to->q_user; +++ host = to->q_host; +++ Errors = 0; +++ errno = 0; +++# ifdef DEBUG +++ if (Debug) +++ printf("deliver(%s [%d, `%s', `%s'])\n", To, m, host, user); +++# endif DEBUG +++ +++ /* +++ ** Remove quote bits from user/host. +++ */ +++ +++ for (p = user; (*p++ &= 0177) != '\0'; ) +++ continue; +++ if (host != NULL) +++ for (p = host; (*p++ &= 0177) != '\0'; ) +++ continue; +++ +++ /* +++ ** Strip quote bits from names if the mailer wants it. +++ */ +++ +++ if (flagset(M_STRIPQ, m->m_flags)) +++ { +++ stripquotes(user); +++ stripquotes(host); +++ } +++ +++ /* +++ ** See if this user name is "special". +++ ** If the user is a program, diddle with the mailer spec. +++ ** If the user name has a slash in it, assume that this +++ ** is a file -- send it off without further ado. +++ ** Note that this means that editfcn's will not +++ ** be applied to the message. +++ */ +++ +++ if (m == &Mailer[0]) +++ { +++ if (*user == '|') +++ { +++ user++; +++ m = &Mailer[1]; +++ } +++ else +++ { +++ if (index(user, '/') != NULL) +++ { +++ i = mailfile(user); +++ giveresponse(i, TRUE, m); +++ return (i); +++ } +++ } +++ } +++ +++ /* +++ ** See if the user exists. +++ ** Strictly, this is only needed to print a pretty +++ ** error message. +++ ** +++ ** >>>>>>>>>> This clause assumes that the local mailer +++ ** >> NOTE >> cannot do any further aliasing; that +++ ** >>>>>>>>>> function is subsumed by delivermail. +++ */ +++ +++ if (m == &Mailer[0]) +++ { +++ if (getpwnam(user) == NULL) +++ { +++ giveresponse(EX_NOUSER, TRUE, m); +++ return (EX_NOUSER); +++ } +++ } +++ +++ /* +++ ** If the mailer wants a From line, insert a new editfcn. +++ */ +++ +++ if (flagset(M_HDR, m->m_flags) && editfcn == NULL) +++ editfcn = putheader; +++ +++ /* +++ ** Call the mailer. +++ ** The argument vector gets built, pipes through 'editfcn' +++ ** are created as necessary, and we fork & exec as +++ ** appropriate. In the parent, we call 'editfcn'. +++ */ +++ +++ pvp = buildargv(m->m_argv, m->m_flags, host, user, From.q_paddr); +++ if (pvp == NULL) +++ { +++ usrerr("name too long"); +++ return (-1); +++ } +++ rewind(stdin); +++ +++ /* create a pipe if we will need one */ +++ if (editfcn != NULL && pipe(pvect) < 0) +++ { +++ syserr("pipe"); +++ return (-1); +++ } +++# ifdef VFORK +++ pid = vfork(); +++# else +++ pid = fork(); +++# endif +++ if (pid < 0) +++ { +++ syserr("Cannot fork"); +++ if (editfcn != NULL) +++ { +++ close(pvect[0]); +++ close(pvect[1]); +++ } +++ return (-1); +++ } +++ else if (pid == 0) +++ { +++ /* child -- set up input & exec mailer */ +++ /* make diagnostic output be standard output */ +++ close(2); +++ dup(1); +++ signal(SIGINT, SIG_IGN); +++ if (editfcn != NULL) +++ { +++ close(0); +++ if (dup(pvect[0]) < 0) +++ { +++ syserr("Cannot dup to zero!"); +++ _exit(EX_OSERR); +++ } +++ close(pvect[0]); +++ close(pvect[1]); +++ } +++ if (!flagset(M_RESTR, m->m_flags)) +++ setuid(getuid()); +++# ifdef LOG +++ initlog(NULL, 0, LOG_CLOSE); +++# endif LOG +++# ifndef VFORK +++ /* +++ * We have to be careful with vfork - we can't mung up the +++ * memory but we don't want the mailer to inherit any extra +++ * open files. Chances are the mailer won't +++ * care about an extra file, but then again you never know. +++ * Actually, we would like to close(fileno(pwf)), but it's +++ * declared static so we can't. But if we fclose(pwf), which +++ * is what endpwent does, it closes it in the parent too and +++ * the next getpwnam will be slower. If you have a weird mailer +++ * that chokes on the extra file you should do the endpwent(). +++ */ +++ endpwent(); +++# endif +++ execv(m->m_mailer, pvp); +++ /* syserr fails because log is closed */ +++ /* syserr("Cannot exec %s", m->m_mailer); */ +++ _exit(EX_UNAVAILABLE); +++ } +++ +++ /* arrange to write out header message if error */ +++ if (editfcn != NULL) +++ { +++ close(pvect[0]); +++ signal(SIGPIPE, pipesig); +++ mfile = fdopen(pvect[1], "w"); +++ (*editfcn)(mfile); +++ fclose(mfile); +++ } +++ +++ /* +++ ** Wait for child to die and report status. +++ ** We should never get fatal errors (e.g., segmentation +++ ** violation), so we report those specially. For other +++ ** errors, we choose a status message (into statmsg), +++ ** and if it represents an error, we print it. +++ */ +++ +++ while ((i = wait(&st)) > 0 && i != pid) +++ continue; +++ if (i < 0) +++ { +++ syserr("wait"); +++ return (-1); +++ } +++ if ((st & 0377) != 0) +++ { +++ syserr("%s: stat %o", pvp[0], st); +++ ExitStat = EX_UNAVAILABLE; +++ return (-1); +++ } +++ i = (st >> 8) & 0377; +++ giveresponse(i, FALSE, m); +++ return (i); +++} +++ /* +++** GIVERESPONSE -- Interpret an error response from a mailer +++** +++** Parameters: +++** stat -- the status code from the mailer (high byte +++** only; core dumps must have been taken care of +++** already). +++** force -- if set, force an error message output, even +++** if the mailer seems to like to print its own +++** messages. +++** m -- the mailer descriptor for this mailer. +++** +++** Returns: +++** none. +++** +++** Side Effects: +++** Errors may be incremented. +++** ExitStat may be set. +++** +++** Called By: +++** deliver +++*/ +++ +++giveresponse(stat, force, m) +++ int stat; +++ int force; +++ register struct mailer *m; +++{ +++ register char *statmsg; +++ extern char *SysExMsg[]; +++ register int i; +++ extern int N_SysEx; +++ extern long MsgSize; +++ char buf[30]; +++ +++ i = stat - EX__BASE; +++ if (i < 0 || i > N_SysEx) +++ statmsg = NULL; +++ else +++ statmsg = SysExMsg[i]; +++ if (stat == 0) +++ statmsg = "ok"; +++ else +++ { +++ Errors++; +++ if (statmsg == NULL && m->m_badstat != 0) +++ { +++ stat = m->m_badstat; +++ i = stat - EX__BASE; +++# ifdef DEBUG +++ if (i < 0 || i >= N_SysEx) +++ syserr("Bad m_badstat %d", stat); +++ else +++# endif DEBUG +++ statmsg = SysExMsg[i]; +++ } +++ if (statmsg == NULL) +++ usrerr("unknown mailer response %d", stat); +++ else if (force || !flagset(M_QUIET, m->m_flags)) +++ usrerr("%s", statmsg); +++ } +++ +++ /* +++ ** Final cleanup. +++ ** Log a record of the transaction. Compute the new +++ ** ExitStat -- if we already had an error, stick with +++ ** that. +++ */ +++ +++ if (statmsg == NULL) +++ { +++ sprintf(buf, "error %d", stat); +++ statmsg = buf; +++ } +++ +++# ifdef LOG +++ logmsg(LOG_INFO, "%s->%s: %ld: %s", From.q_paddr, To, MsgSize, statmsg); +++# endif LOG +++ setstat(stat); +++ return (stat); +++} +++ /* +++** PUTHEADER -- insert the From header into some mail +++** +++** For mailers such as 'msgs' that want the header inserted +++** into the mail, this edit filter inserts the From line and +++** then passes the rest of the message through. +++** +++** Parameters: +++** fp -- the file pointer for the output. +++** +++** Returns: +++** none +++** +++** Side Effects: +++** Puts a "From" line in UNIX format, and then +++** outputs the rest of the message. +++** +++** Called By: +++** deliver +++*/ +++ +++putheader(fp) +++ register FILE *fp; +++{ +++ char buf[MAXLINE + 1]; +++ long tim; +++ extern char *ctime(); +++ +++ time(&tim); +++ fprintf(fp, "From %s %s", From.q_paddr, ctime(&tim)); +++ while (fgets(buf, sizeof buf, stdin) != NULL && !ferror(fp)) +++ fputs(buf, fp); +++ if (ferror(fp)) +++ { +++ syserr("putheader: write error"); +++ setstat(EX_IOERR); +++ } +++} +++ /* +++** PIPESIG -- Handle broken pipe signals +++** +++** This just logs an error. +++** +++** Parameters: +++** none +++** +++** Returns: +++** none +++** +++** Side Effects: +++** logs an error message. +++*/ +++ +++pipesig() +++{ +++ syserr("Broken pipe"); +++ signal(SIGPIPE, SIG_IGN); +++} +++ /* +++** SENDTO -- Designate a send list. +++** +++** The parameter is a comma-separated list of people to send to. +++** This routine arranges to send to all of them. +++** +++** Parameters: +++** list -- the send list. +++** copyf -- the copy flag; passed to parse. +++** +++** Returns: +++** none +++** +++** Side Effects: +++** none. +++** +++** Called By: +++** main +++** alias +++*/ +++ +++sendto(list, copyf) +++ char *list; +++ int copyf; +++{ +++ register char *p; +++ register char *q; +++ register char c; +++ addrq *a; +++ extern addrq *parse(); +++ bool more; +++ +++ /* more keeps track of what the previous delimiter was */ +++ more = TRUE; +++ for (p = list; more; ) +++ { +++ /* find the end of this address */ +++ q = p; +++ while ((c = *p++) != '\0' && c != ',' && c != '\n') +++ continue; +++ more = c != '\0'; +++ *--p = '\0'; +++ if (more) +++ p++; +++ +++ /* parse the address */ +++ if ((a = parse(q, (addrq *) NULL, copyf)) == NULL) +++ continue; +++ +++ /* arrange to send to this person */ +++ recipient(a, &SendQ); +++ } +++ To = NULL; +++} +++ /* +++** RECIPIENT -- Designate a message recipient +++** +++** Saves the named person for future mailing. +++** +++** Designates a person as a recipient. This routine +++** does the initial parsing, and checks to see if +++** this person has already received the mail. +++** It also supresses local network names and turns them into +++** local names. +++** +++** Parameters: +++** a -- the (preparsed) address header for the recipient. +++** targetq -- the queue to add the name to. +++** +++** Returns: +++** none. +++** +++** Side Effects: +++** none. +++** +++** Called By: +++** sendto +++** main +++*/ +++ +++recipient(a, targetq) +++ register addrq *a; +++ addrq *targetq; +++{ +++ register addrq *q; +++ register struct mailer *m; +++ register char **pvp; +++ extern char *xalloc(); +++ extern bool forward(); +++ extern int errno; +++ extern bool sameaddr(); +++ +++ To = a->q_paddr; +++ m = a->q_mailer; +++ errno = 0; +++# ifdef DEBUG +++ if (Debug) +++ printf("recipient(%s)\n", To); +++# endif DEBUG +++ +++ /* +++ ** Look up this person in the recipient list. If they +++ ** are there already, return, otherwise continue. +++ */ +++ +++ if (!ForceMail) +++ { +++ for (q = &SendQ; (q = nxtinq(q)) != NULL; ) +++ if (sameaddr(q, a, FALSE)) +++ { +++# ifdef DEBUG +++ if (Debug) +++ printf("(%s in SendQ)\n", a->q_paddr); +++# endif DEBUG +++ return; +++ } +++ for (q = &AliasQ; (q = nxtinq(q)) != NULL; ) +++ if (sameaddr(q, a, FALSE)) +++ { +++# ifdef DEBUG +++ if (Debug) +++ printf("(%s in AliasQ)\n", a->q_paddr); +++# endif DEBUG +++ return; +++ } +++ } +++ +++ /* +++ ** See if the user wants hir mail forwarded. +++ ** `Forward' must do the forwarding recursively. +++ */ +++ +++ if (m == &Mailer[0] && !NoAlias && targetq == &SendQ && forward(a)) +++ return; +++ +++ /* +++ ** Put the user onto the target queue. +++ */ +++ +++ if (targetq != NULL) +++ { +++ putonq(a, targetq); +++ } +++ +++ return; +++} +++ /* +++** BUILDARGV -- Build an argument vector for a mail server. +++** +++** Using a template defined in config.c, an argv is built. +++** The format of the template is already a vector. The +++** items of this vector are copied, unless a dollar sign +++** is encountered. In this case, the next character +++** specifies something else to copy in. These can be +++** $f The from address. +++** $h The host. +++** $u The user. +++** $c The hop count. +++** The vector is built in a local buffer. A pointer to +++** the static argv is returned. +++** +++** Parameters: +++** tmplt -- a template for an argument vector. +++** flags -- the flags for this server. +++** host -- the host name to send to. +++** user -- the user name to send to. +++** from -- the person this mail is from. +++** +++** Returns: +++** A pointer to an argv. +++** +++** Side Effects: +++** none +++** +++** WARNING: +++** Since the argv is staticly allocated, any subsequent +++** calls will clobber the old argv. +++** +++** Called By: +++** deliver +++*/ +++ +++char ** +++buildargv(tmplt, flags, host, user, from) +++ char **tmplt; +++ int flags; +++ char *host; +++ char *user; +++ char *from; +++{ +++ register char *p; +++ register char *q; +++ static char *pv[MAXPV+1]; +++ char **pvp; +++ char **mvp; +++ static char buf[512]; +++ register char *bp; +++ char pbuf[30]; +++ +++ /* +++ ** Do initial argv setup. +++ ** Insert the mailer name. Notice that $x expansion is +++ ** NOT done on the mailer name. Then, if the mailer has +++ ** a picky -f flag, we insert it as appropriate. This +++ ** code does not check for 'pv' overflow; this places a +++ ** manifest lower limit of 4 for MAXPV. +++ */ +++ +++ pvp = pv; +++ bp = buf; +++ +++ *pvp++ = tmplt[0]; +++ +++ /* insert -f or -r flag as appropriate */ +++ if (flagset(M_FOPT|M_ROPT, flags) && FromFlag) +++ { +++ if (flagset(M_FOPT, flags)) +++ *pvp++ = "-f"; +++ else +++ *pvp++ = "-r"; +++ *pvp++ = From.q_paddr; +++ } +++ +++ /* +++ ** Build the rest of argv. +++ ** For each prototype parameter, the prototype is +++ ** scanned character at a time. If a dollar-sign is +++ ** found, 'q' is set to the appropriate expansion, +++ ** otherwise it is null. Then either the string +++ ** pointed to by q, or the original character, is +++ ** interpolated into the buffer. Buffer overflow is +++ ** checked. +++ */ +++ +++ for (mvp = tmplt; (p = *++mvp) != NULL; ) +++ { +++ if (pvp >= &pv[MAXPV]) +++ { +++ syserr("Too many parameters to %s", pv[0]); +++ return (NULL); +++ } +++ *pvp++ = bp; +++ for (; *p != '\0'; p++) +++ { +++ /* q will be the interpolated quantity */ +++ q = NULL; +++ if (*p == '$') +++ { +++ switch (*++p) +++ { +++ case 'f': /* from person */ +++ q = from; +++ break; +++ +++ case 'u': /* user */ +++ q = user; +++ break; +++ +++ case 'h': /* host */ +++ q = host; +++ break; +++ +++ case 'c': /* hop count */ +++ sprintf(pbuf, "%d", HopCount); +++ q = pbuf; +++ break; +++ } +++ } +++ +++ /* +++ ** Interpolate q or output one character +++ ** Strip quote bits as we proceed..... +++ */ +++ +++ if (q != NULL) +++ { +++ while (bp < &buf[sizeof buf - 1] && (*bp++ = *q++) != '\0') +++ continue; +++ bp--; +++ } +++ else if (bp < &buf[sizeof buf - 1]) +++ *bp++ = *p; +++ } +++ *bp++ = '\0'; +++ if (bp >= &buf[sizeof buf - 1]) +++ return (NULL); +++ } +++ *pvp = NULL; +++ +++# ifdef DEBUG +++ if (Debug) +++ { +++ printf("Interpolated argv is:\n"); +++ for (mvp = pv; *mvp != NULL; mvp++) +++ printf("\t%s\n", *mvp); +++ } +++# endif DEBUG +++ +++ return (pv); +++} +++ /* +++** MAILFILE -- Send a message to a file. +++** +++** Parameters: +++** filename -- the name of the file to send to. +++** +++** Returns: +++** The exit code associated with the operation. +++** +++** Side Effects: +++** none. +++** +++** Called By: +++** deliver +++*/ +++ +++mailfile(filename) +++ char *filename; +++{ +++ char buf[MAXLINE]; +++ register FILE *f; +++ auto long tim; +++ extern char *ctime(); +++ +++ f = fopen(filename, "a"); +++ if (f == NULL) +++ return (EX_CANTCREAT); +++ +++ /* output the timestamp */ +++ time(&tim); +++ fprintf(f, "From %s %s", From.q_paddr, ctime(&tim)); +++ rewind(stdin); +++ while (fgets(buf, sizeof buf, stdin) != NULL) +++ { +++ fputs(buf, f); +++ if (ferror(f)) +++ { +++ fclose(f); +++ return (EX_IOERR); +++ } +++ } +++ fputs("\n", f); +++ fclose(f); +++ return (EX_OK); +++} diff --cc usr/src/cmd/delivermail/dlvrmail.h index 0000000000,0000000000,0000000000..7029a66ae9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/dlvrmail.h @@@@ -1,0 -1,0 -1,0 +1,140 @@@@ +++/* +++** DLVRMAIL.H -- Global definitions for delivermail. +++** +++** Most of these are actually allocated in globals.c +++** +++** @(#)dlvrmail.h 1.6 10/18/80 +++*/ +++ +++ +++ +++ +++# include "useful.h" +++ +++/* +++** Manifest constants. +++*/ +++ +++# define MAXLINE 256 /* maximum line length */ +++# define MAXNAME 128 /* maximum length of a name */ +++# define MAXFIELD 2500 /* maximum total length of a header field */ +++# define MAXPV 15 /* maximum # of parms to mailers */ +++# define MAXHOP 30 /* maximum value of HopCount */ +++# define ALIASFILE "/usr/lib/aliases" /* location of alias file */ +++ +++ +++ +++ +++ +++/* +++** Mailer definition structure. +++** Every mailer known to the system is declared in this +++** structure. It defines the pathname of the mailer, some +++** flags associated with it, and the argument vector to +++** pass to it. The flags are defined in conf.c +++** +++** The argument vector is expanded before actual use. Every- +++** thing is passed through except for things starting with "$". +++** "$x" defines some interpolation, as described in conf.c +++** "$x" where x is unknown expands to "x", so use "$$" to get "$". +++*/ +++ +++struct mailer +++{ +++ char *m_mailer; /* pathname of the mailer to use */ +++ short m_flags; /* status flags, see below */ +++ short m_badstat; /* the status code to use on unknown error */ +++ char **m_local; /* list of local names for this host */ +++ char *m_argv[MAXPV]; /* template argument vector */ +++}; +++ +++# define M_FOPT 0001 /* mailer takes picky -f flag */ +++# define M_ROPT 0002 /* mailer takes picky -r flag */ +++# define M_QUIET 0004 /* don't print error on bad status */ +++# define M_RESTR 0010 /* must be daemon to execute */ +++# define M_HDR 0020 /* insert From line */ +++# define M_NOHOST 0040 /* ignore host in comparisons */ +++# define M_STRIPQ 0100 /* strip quote characters from user/host */ +++ +++extern struct mailer Mailer[]; +++ +++ +++/* +++** Address structure. +++** Addresses are stored internally in this structure. +++*/ +++ +++struct address +++{ +++ char *q_paddr; /* the printname for the address */ +++ char *q_user; /* user name */ +++ char *q_host; /* host name */ +++ struct mailer *q_mailer; /* mailer to use */ +++ struct address *q_next; /* chain */ +++ struct address *q_prev; /* back pointer */ +++}; +++ +++typedef struct address addrq; +++ +++/* some other primitives */ +++# define nxtinq(q) ((q)->q_next) +++# define clearq(q) (q)->q_next = (q)->q_prev = NULL +++ +++extern addrq SendQ; /* queue of people to send to */ +++extern addrq AliasQ; /* queue of people that are aliases */ +++ +++ +++/* +++** Parse structure. +++** This table drives the parser which determines the network +++** to send the mail to. +++*/ +++ +++struct parsetab +++{ +++ char p_char; /* trigger character */ +++ char p_mailer; /* the index of the mailer to call */ +++ short p_flags; /* see below */ +++ char *p_arg; /* extra info needed for some flags */ +++}; +++ +++# define P_MAP 0001 /* map p_char -> p_arg[0] */ +++# define P_HLAST 0002 /* host is last, & right associative */ +++# define P_ONE 0004 /* can only be one p_char in addr */ +++# define P_MOVE 0010 /* send untouched to host p_arg */ +++# define P_USR_UPPER 0020 /* don't map UPPER->lower in user names */ +++# define P_HST_UPPER 0040 /* don't map UPPER->lower in host names */ +++ +++ +++ +++ +++/* +++** Global variables. +++*/ +++ +++extern bool ArpaFmt; /* if set, message is in arpanet fmt */ +++extern bool FromFlag; /* if set, "From" person is explicit */ +++extern bool Debug; /* if set, debugging info */ +++extern bool MailBack; /* mail back response on error */ +++extern bool BerkNet; /* called from BerkNet */ +++extern bool WriteBack; /* write back response on error */ +++extern bool NoAlias; /* if set, don't do any aliasing */ +++extern bool ForceMail; /* if set, mail even if already got a copy */ +++extern bool MeToo; /* send to the sender also */ +++extern bool UseMsgId; /* put msg-id's in all msgs [conf.c] */ +++extern bool IgnrDot; /* don't let dot end messages */ +++extern bool SaveFrom; /* save leading "From" lines */ +++extern int Errors; /* set if errors */ +++extern int ExitStat; /* exit status code */ +++extern char InFileName[]; /* input file name */ +++extern char Transcript[]; /* the transcript file name */ +++extern char MsgId[]; /* the message id for this message */ +++extern addrq From; /* the person it is from */ +++extern char *To; /* the target person */ +++extern int HopCount; /* hop count */ +++ +++ +++# include +++ +++# define flagset(bits, word) ((bits) & (word)) +++# define setstat(s) { if (ExitStat == EX_OK) ExitStat = s; } diff --cc usr/src/cmd/delivermail/err.c index 0000000000,0000000000,0000000000..d386e43a7d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/err.c @@@@ -1,0 -1,0 -1,0 +1,94 @@@@ +++# include +++# include "dlvrmail.h" +++# ifdef LOG +++# include +++# endif LOG +++ +++static char SccsId[] = "@(#)err.c 1.5 10/21/80"; +++ +++/* +++** SYSERR -- Print error message. +++** +++** Prints an error message via printf to the diagnostic +++** output. If LOG is defined, it logs it also. +++** +++** Parameters: +++** f -- the format string +++** a, b, c, d, e -- parameters +++** +++** Returns: +++** -1 always +++** +++** Side Effects: +++** increments Errors. +++** sets ExitStat. +++*/ +++ +++/*VARARGS1*/ +++syserr(fmt, a, b, c, d, e) +++ char *fmt; +++{ +++ extern int errno; +++ static char errbuf[MAXLINE+1]; +++ register char *p; +++ extern char *sys_errlist[]; +++ extern int sys_nerr; +++ +++ sprintf(errbuf, fmt, a, b, c, d, e); +++ if (errno != 0) +++ { +++ p = &errbuf[strlen(errbuf)]; +++ if (errno < sys_nerr && errno > 0) +++ sprintf(p, ": %s", sys_errlist[errno]); +++ else +++ sprintf(p, ": error %d", errno); +++ } +++ printf("delivermail: %s\n", errbuf); +++ Errors++; +++ +++ /* determine exit status if not already set */ +++ if (ExitStat == EX_OK) +++ { +++ if (errno == 0) +++ ExitStat = EX_SOFTWARE; +++ else +++ ExitStat = EX_OSERR; +++ } +++ +++# ifdef LOG +++ logmsg(LOG_ERR, "%s->%s: %s", From.q_paddr, To, errbuf); +++# endif LOG +++ errno = 0; +++ return (-1); +++} +++ /* +++** USRERR -- Signal user error. +++** +++** This is much like syserr except it is for user errors. +++** +++** Parameters: +++** fmt, a, b, c, d -- printf strings +++** +++** Returns: +++** -1 +++** +++** Side Effects: +++** increments Errors. +++*/ +++ +++/*VARARGS1*/ +++usrerr(fmt, a, b, c, d, e) +++ char *fmt; +++{ +++ extern char SuprErrs; +++ +++ if (SuprErrs) +++ return; +++ +++ Errors++; +++ if (To != NULL) +++ printf("%s... ", To); +++ printf(fmt, a, b, c, d, e); +++ printf("\n"); +++ return (-1); +++} diff --cc usr/src/cmd/delivermail/main.c index 0000000000,0000000000,0000000000..b90ae9e6b7 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/main.c @@@@ -1,0 -1,0 -1,0 +1,488 @@@@ +++# include +++# include +++# include +++# include "dlvrmail.h" +++# ifdef LOG +++# include +++# endif LOG +++ +++static char SccsId[] = "@(#)main.c 1.11 10/18/80"; +++ +++/* +++** DELIVERMAIL -- Deliver mail to a set of destinations +++** +++** This is the basic mail router. All user mail programs should +++** call this routine to actually deliver mail. Delivermail in +++** turn calls a bunch of mail servers that do the real work of +++** delivering the mail. +++** +++** Delivermail is driven by tables defined in config.c. This +++** file will be different from system to system, but the rest +++** of the code will be the same. This table could be read in, +++** but it seemed nicer to have it compiled in, since deliver- +++** mail will potentially be exercised a lot. +++** +++** Usage: +++** /etc/delivermail [-f name] [-a] [-q] [-v] [-n] [-m] addr ... +++** +++** Positional Parameters: +++** addr -- the address to deliver the mail to. There +++** can be several. +++** +++** Flags: +++** -f name The mail is from "name" -- used for +++** the header in local mail, and to +++** deliver reports of failures to. +++** -r name Same as -f; however, this flag is +++** reserved to indicate special processing +++** for remote mail delivery as needed +++** in the future. So, network servers +++** should use -r. +++** -a This mail should be in ARPANET std +++** format (not used). +++** -n Don't do aliasing. This might be used +++** when delivering responses, for +++** instance. +++** -d Run in debug mode. +++** -em Mail back a response if there was an +++** error in processing. This should be +++** used when the origin of this message +++** is another machine. +++** -ew Write back a response if the user is +++** still logged in, otherwise, act like +++** -em. +++** -eq Don't print any error message (just +++** return exit status). +++** -ep (default) Print error messages +++** normally. +++** -ee Send BerkNet style errors. This +++** is equivalent to MailBack except +++** that it has gives zero return code +++** (unless there were errors during +++** returning). This used to be +++** "EchoBack", but you know how the old +++** software bounces. +++** -m In group expansion, send to the +++** sender also (stands for the Mail metoo +++** option. +++** -i Do not terminate mail on a line +++** containing just dot. +++** -s Save UNIX-like "From" lines on the +++** front of messages. +++** +++** Return Codes: +++** As defined in . +++** +++** These codes are actually returned from the auxiliary +++** mailers; it is their responsibility to make them +++** correct. +++** +++** Compilation Flags: +++** LOG -- if set, everything is logged. +++** +++** Compilation Instructions: +++** cc -c -O main.c config.c deliver.c parse.c +++** cc -n -s *.o -lS +++** chown root a.out +++** chmod 755 a.out +++** mv a.out delivermail +++** +++** Deficiencies: +++** It ought to collect together messages that are +++** destined for a single host and send these +++** to the auxiliary mail server together. +++** It should take "user at host" as three separate +++** parameters and combine them into one address. +++** +++** Author: +++** Eric Allman, UCB/INGRES +++*/ +++ +++ +++ +++ +++ +++bool ArpaFmt; /* mail is expected to be in ARPANET format */ +++bool FromFlag; /* from person is explicitly specified */ +++bool Debug; /* run in debug mode */ +++bool MailBack; /* mail back response on error */ +++bool BerkNet; /* called from BerkNet */ +++bool WriteBack; /* write back response on error */ +++bool HasXscrpt; /* if set, the transcript file exists */ +++bool NoAlias; /* don't do aliasing */ +++bool ForceMail; /* mail even if already sent a copy */ +++bool MeToo; /* send to the sender also if in a group expansion */ +++bool SaveFrom; /* save From lines on the front of messages */ +++bool IgnrDot; /* if set, ignore dot when collecting mail */ +++bool SuprErrs; /* supress errors if set */ +++int Errors; /* count of errors */ +++char InFileName[] = "/tmp/mailtXXXXXX"; +++char Transcript[] = "/tmp/mailxXXXXXX"; +++addrq From; /* the from person */ +++char *To; /* the target person */ +++int HopCount; /* hop count */ +++int ExitStat; /* the exit status byte */ +++addrq SendQ; /* queue of people to send to */ +++addrq AliasQ; /* queue of people who turned out to be aliases */ +++ +++ +++ +++ +++ +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ register char *p; +++ extern char *maketemp(); +++ extern char *getname(); +++ extern int finis(); +++ extern addrq *parse(); +++ register addrq *q; +++ extern char Version[]; +++ extern int errno; +++ char *from; +++ register int i; +++ typedef int (*fnptr)(); +++ +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) +++ signal(SIGINT, finis); +++ signal(SIGTERM, finis); +++ setbuf(stdout, (char *) NULL); +++# ifdef LOG +++ initlog("delivermail", 0, LOG_INDEP); +++# endif LOG +++# ifdef DEBUG +++# ifdef DEBUGFILE +++ if ((i = open(DEBUGFILE, 1)) > 0) +++ { +++ lseek(i, 0L, 2); +++ close(1); +++ dup(i); +++ close(i); +++ Debug++; +++ } +++# endif DEBUGFILE +++# endif +++ errno = 0; +++ from = NULL; +++ +++ /* +++ ** Crack argv. +++ */ +++ +++ while (--argc > 0 && (p = *++argv)[0] == '-') +++ { +++ switch (p[1]) +++ { +++ case 'r': /* obsolete -f flag */ +++ case 'f': /* from address */ +++ p += 2; +++ if (*p == '\0') +++ { +++ p = *++argv; +++ if (--argc <= 0 || *p == '-') +++ { +++ syserr("No \"from\" person"); +++ argc++; +++ argv--; +++ break; +++ } +++ } +++ if (from != NULL) +++ { +++ syserr("More than one \"from\" person"); +++ break; +++ } +++ from = p; +++ break; +++ +++ case 'h': /* hop count */ +++ p += 2; +++ if (*p == '\0') +++ { +++ p = *++argv; +++ if (--argc <= 0 || *p < '0' || *p > '9') +++ { +++ syserr("Bad hop count (%s)", p); +++ argc++; +++ argv--; +++ break; +++ } +++ } +++ HopCount = atoi(p); +++ break; +++ +++ case 'e': /* error message disposition */ +++ switch (p[2]) +++ { +++ case 'p': /* print errors normally */ +++ break; /* (default) */ +++ +++ case 'q': /* be silent about it */ +++ freopen("/dev/null", "w", stdout); +++ break; +++ +++ case 'm': /* mail back */ +++ MailBack++; +++ openxscrpt(); +++ break; +++ +++ case 'e': /* do berknet error processing */ +++ BerkNet++; +++ openxscrpt(); +++ break; +++ +++ case 'w': /* write back (or mail) */ +++ WriteBack++; +++ openxscrpt(); +++ break; +++ } +++ break; +++ +++# ifdef DEBUG +++ case 'd': /* debug */ +++ Debug++; +++ printf("%s\n", Version); +++ break; +++# endif DEBUG +++ +++ case 'n': /* don't alias */ +++ NoAlias++; +++ break; +++ +++ case 'm': /* send to me too */ +++ MeToo++; +++ break; +++ +++ case 'i': /* don't let dot stop me */ +++ IgnrDot++; +++ break; +++ +++ case 'a': /* arpanet format */ +++ ArpaFmt++; +++ break; +++ +++ case 's': /* save From lines in headers */ +++ SaveFrom++; +++ break; +++ +++ default: +++ /* at Eric Schmidt's suggestion, this will not be an error.... +++ syserr("Unknown flag %s", p); +++ ... seems that upward compatibility will be easier. */ +++ break; +++ } +++ } +++ +++ if (from != NULL && ArpaFmt) +++ syserr("-f and -a are mutually exclusive"); +++ +++ /* +++ ** Get a temp file. +++ */ +++ +++ p = maketemp(); +++ if (from == NULL) +++ from = p; +++# ifdef DEBUG +++ if (Debug) +++ printf("Message-Id: <%s>\n", MsgId); +++# endif DEBUG +++ +++ /* +++ ** Figure out who it's coming from. +++ ** Under certain circumstances allow the user to say who +++ ** s/he is (using -f or -r). These are: +++ ** 1. The user's uid is zero (root). +++ ** 2. The user's login name is "network" (mail from +++ ** a network server). +++ ** 3. The user's login name is "uucp" (mail from the +++ ** uucp network). +++ ** 4. The address the user is trying to claim has a +++ ** "!" character in it (since #3 doesn't do it for +++ ** us if we are dialing out). +++ ** A better check to replace #3 & #4 would be if the +++ ** effective uid is "UUCP" -- this would require me +++ ** to rewrite getpwent to "grab" uucp as it went by, +++ ** make getname more nasty, do another passwd file +++ ** scan, or compile the UID of "UUCP" into the code, +++ ** all of which are reprehensible. +++ ** +++ ** Assuming all of these fail, we figure out something +++ ** ourselves. +++ */ +++ +++ errno = 0; +++ p = getname(); +++ if (p == NULL || p[0] == '\0') +++ { +++ syserr("Who are you? (uid=%d)", getuid()); +++ finis(); +++ } +++ errno = 0; +++ if (from != NULL) +++ { +++ if (strcmp(p, "network") != 0 && strcmp(p, "uucp") != 0 && +++ index(from, '!') == NULL && getuid() != 0) +++ { +++ /* network sends -r regardless (why why why?) */ +++ /* syserr("%s, you cannot use the -f flag", p); */ +++ from = NULL; +++ } +++ } +++ if (from == NULL || from[0] == '\0') +++ from = p; +++ else +++ FromFlag++; +++ SuprErrs = TRUE; +++ if (parse(from, &From, 0) == NULL) +++ { +++ /* too many arpanet hosts generate garbage From addresses .... +++ syserr("Bad from address `%s'", from); +++ .... so we will just ignore this address */ +++ from = p; +++ FromFlag = FALSE; +++ } +++ SuprErrs = FALSE; +++ +++# ifdef DEBUG +++ if (Debug) +++ printf("From person = \"%s\"\n", From.q_paddr); +++# endif DEBUG +++ +++ if (argc <= 0) +++ usrerr("Usage: /etc/delivermail [flags] addr..."); +++ +++ /* +++ ** Process Hop count. +++ ** The Hop count tells us how many times this message has +++ ** been processed by delivermail. If it exceeds some +++ ** fairly large threshold, then we assume that we have +++ ** an infinite forwarding loop and die. +++ */ +++ +++ if (++HopCount > MAXHOP) +++ syserr("Infinite forwarding loop (%s->%s)", From.q_paddr, *argv); +++ +++ /* +++ ** Scan argv and deliver the message to everyone. +++ */ +++ +++ for (; argc-- > 0; argv++) +++ { +++ sendto(*argv, 0); +++ } +++ +++ /* if we have had errors sofar, drop out now */ +++ if (Errors > 0 && ExitStat == EX_OK) +++ ExitStat = EX_USAGE; +++ if (ExitStat != EX_OK) +++ finis(); +++ +++ /* +++ ** See if we have anyone to send to at all. +++ */ +++ +++ if (nxtinq(&SendQ) == NULL && ExitStat == EX_OK) +++ { +++ syserr("Noone to send to!"); +++ ExitStat = EX_USAGE; +++ finis(); +++ } +++ +++ /* +++ ** Do aliasing. +++ ** First arrange that the person who is sending the mail +++ ** will not be expanded (unless explicitly requested). +++ */ +++ +++ if (!MeToo) +++ recipient(&From, &AliasQ); +++ To = NULL; +++ alias(); +++ if (nxtinq(&SendQ) == NULL && ExitStat == EX_OK) +++ { +++/* +++ syserr("Vacant send queue; probably aliasing loop"); +++ ExitStat = EX_SOFTWARE; +++ finis(); +++*/ +++ recipient(&From, &SendQ); +++ } +++ +++ /* +++ ** Actually send everything. +++ */ +++ +++ for (q = &SendQ; (q = nxtinq(q)) != NULL; ) +++ deliver(q, (fnptr) NULL); +++ +++ /* +++ ** All done. +++ */ +++ +++ finis(); +++} +++ /* +++** FINIS -- Clean up and exit. +++** +++** Parameters: +++** none +++** +++** Returns: +++** never +++** +++** Side Effects: +++** exits delivermail +++** +++** Called By: +++** main +++** via signal on interrupt. +++** +++** Deficiencies: +++** It may be that it should only remove the input +++** file if there have been no errors. +++*/ +++ +++finis() +++{ +++ /* mail back the transcript on errors */ +++ if (ExitStat != EX_OK) +++ savemail(); +++ +++ if (HasXscrpt) +++ unlink(Transcript); +++ unlink(InFileName); +++ exit(ExitStat); +++} +++ /* +++** OPENXSCRPT -- Open transcript file +++** +++** Creates a transcript file for possible eventual mailing or +++** sending back. +++** +++** Parameters: +++** none +++** +++** Returns: +++** none +++** +++** Side Effects: +++** Turns the standard output into a special file +++** somewhere. +++** +++** Called By: +++** main +++*/ +++ +++openxscrpt() +++{ +++ mktemp(Transcript); +++ HasXscrpt++; +++ if (freopen(Transcript, "w", stdout) == NULL) +++ syserr("Can't create %s", Transcript); +++ chmod(Transcript, 0600); +++ setbuf(stdout, (char *) NULL); +++} diff --cc usr/src/cmd/delivermail/makefile index 0000000000,0000000000,0000000000..6f5880b924 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/makefile @@@@ -1,0 -1,0 -1,0 +1,118 @@@@ +++# +++# VAX Version +++# +++# @(#)makefile 1.10 10/28/80 +++# +++# Compilation Flags (in CFLAGS): +++# -DDEBUG -- compile in debug stuff. This is not enabled +++# unless the debug flag is given, so the only +++# advantage in not including this is that the +++# binaries will be smaller. +++# -DLOG -- include log information. This is probably +++# only useful on systems that include the logger. +++# -DVFORK -- use 'vfork' instead of 'fork'. +++# -DDBM -- use the dbm package instead of scanning the +++# ALIASFILE sequentially. LIBS must include +++# -ldbm for this to work. +++# +++ +++LIBS= -ldbm +++TARG= $(DESTDIR)/etc +++ +++OBJS1= conf.o main.o maketemp.o parse.o alias.o deliver.o \ +++ savemail.o addr.o err.o +++OBJS2= matchhdr.o sysexits.o util.o bmove.o +++SRCS= useful.h dlvrmail.h \ +++ conf.c deliver.c main.c parse.c err.c alias.c savemail.c addr.c \ +++ matchhdr.c sysexits.c util.c bmove.c bmove.11.s bmove.vax.s \ +++ arpa.c arpadate.c version.c maketemp.c \ +++ newaliases.c +++ALL= delivermail newaliases +++ +++CHOWN= -echo chown +++CHMOD= chmod +++CFLAGS= -O -DDBM -DVFORK -DDEBUG +++LDFLAGS= +++AR= -ar +++ARFLAGS=rvu +++LINT= lint +++LINTFLAGS=-bxa +++XREF= csh /usr/bin/xref +++CP= cp +++ +++GET= sccs get +++DELTA= sccs delta +++REL= +++ +++ROOT= root +++OBJMODE=755 +++ +++all: $(ALL) +++ +++delivermail: $(OBJS1) $(OBJS2) version.o +++ $(CC) $(LDFLAGS) -o delivermail version.o $(OBJS1) $(OBJS2) $(LIBS) +++ $(CHMOD) $(OBJMODE) delivermail +++ size delivermail; ls -l delivermail +++ +++install: $(OBJS1) $(OBJS2) all +++ $(CP) delivermail $(TARG)/delivermail +++ install -s newaliases $(DESTDIR)/usr/ucb +++ +++ +++$(OBJS1): dlvrmail.h +++ +++dlvrmail.h util.o: useful.h +++ +++# +++# Auxiliary stuff +++# +++ +++clean: +++ rm -f core delivermail arpa uucp a.out xref newaliases +++ rm -f *.o +++ +++archive: +++ ${AR} ${ARFLAGS} delivermail.a READ_ME TO_BE_DONE makefile makefl.* *.h *.c *.s makeversion *.[123456789u] +++ +++print: xref +++ @ls -l | pr -h "delivermail directory" +++ @pr -h "cross reference listing" xref +++ @size *.o | pr -h "object code sizes" +++ @pr *.h *.[cs] +++ +++lint: +++ $(LINT) $(LINTFLAGS) $(SRCS) +++ +++xref: *.c +++ ${XREF} *.c > xref +++ +++# +++# Data base maintenance routines +++# +++AOBJS= newaliases.o parse.o conf.o util.o +++ +++newaliases: $(AOBJS) +++ $(CC) $(LDFLAGS) $(AOBJS) -o newaliases $(LIBS) +++ +++praliases: praliases.c +++ $(CC) $(CFLAGS) praliases.c -o praliases $(LIBS) +++ +++$(AOBJS): dlvrmail.h +++ +++# +++# Auxiliary mailers +++# +++ +++arpa: arpa.o matchhdr.o arpadate.o +++ $(CC) $(LDFLAGS) -o arpa arpa.o matchhdr.o arpadate.o $(LIBS) +++ ${CHMOD} ${OBJMODE} arpa +++ size arpa; ls -l arpa +++ +++uucp: uucp.o +++ ${CC} ${LDFLAGS} -o uucp uucp.o ${LIBS} +++ ${CHMOD} ${OBJMODE} uucp +++ size uucp; ls -l uucp +++ +++mail: mail.o getname.o +++ $(CC) $(LDFLAGS) -o mail mail.o getname.o +++ size mail; ls -l mail diff --cc usr/src/cmd/delivermail/makefl.ing70 index 0000000000,0000000000,0000000000..ef0152c42c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/makefl.ing70 @@@@ -1,0 -1,0 -1,0 +1,84 @@@@ +++# +++# INGRES 11/70 Version +++# +++# @(#)makefl.ing70 1.3 7/25/80 +++# +++CPUTYPE=11 +++LIBS= -lX -lS +++ +++CHOWN= -echo chown +++CHMOD= chmod +++CFLAGS= -O -DDEBUG -DLOG +++LDFLAGS=-n +++AR= -ar +++ARFLAGS=rvu +++LINT= lint +++LINTFLAGS=-bxa +++XREF= csh /usr/bin/xref +++MAKEVERSION=csh -f makeversion +++VER= 0.0 +++ +++OBJS1= conf.o deliver.o main.o parse.o err.o alias.o savemail.o addr.o +++OBJS2= matchhdr.o sysexits.o util.o bmove.${CPUTYPE}.o +++SRCS= conf.c deliver.c main.c parse.c err.c alias.c savemail.c addr.c \ +++ matchhdr.c sysexits.c util.c bmove.${CPUTYPE}.c +++ +++ROOT= root +++OBJMODE=755 +++ +++delivermail: $(OBJS1) $(OBJS2) +++ $(MAKEVERSION) Delivermail $(VER) $(CC) +++ $(CC) $(LDFLAGS) -o delivermail version.o $(OBJS1) $(OBJS2) $(LIBS) +++ $(CHMOD) $(OBJMODE) delivermail +++ size delivermail; ls -l delivermail +++ +++main.o: main.c +++ $(CC) $(CFLAGS) -DDEBUGFILE=\"/mnt/eric/DEBUG.DLVRML\" -c $< +++ +++$(OBJS1): dlvrmail.h +++ +++dlvrmail.h util.o: useful.h +++ +++# +++# Auxiliary stuff +++# +++ +++clean: +++ rm -f core delivermail arpa uucp a.out xref version.c +++ rm -f *.o +++ +++archive: +++ ${AR} ${ARFLAGS} delivermail.a READ_ME TO_BE_DONE makefile makefl.* *.h *.c *.s makeversion *.[123456789u] +++ +++print: xref +++ @ls -l | pr -h "delivermail directory" +++ @pr -h "cross reference listing" xref +++ @size *.o | pr -h "object code sizes" +++ @pr *.h *.[cs] +++ +++lint: +++ $(LINT) $(LINTFLAGS) $(SRCS) +++ +++xref: *.c +++ ${XREF} *.c > xref +++ +++# +++# Auxiliary mailers +++# +++ +++arpa: arpa.o matchhdr.o arpadate.o +++ $(MAKEVERSION) Arpa-mailer 1.0 ${CC} +++ $(CC) $(LDFLAGS) -o arpa version.o arpa.o matchhdr.o arpadate.o $(LIBS) +++ ${CHMOD} ${OBJMODE} arpa +++ size arpa; ls -l arpa +++ +++uucp: uucp.o +++ $(MAKEVERSION) Uucp-mailer 1.0 ${CC} +++ ${CC} ${LDFLAGS} -o uucp version.o uucp.o ${LIBS} +++ ${CHMOD} ${OBJMODE} uucp +++ size uucp; ls -l uucp +++ +++mail: mail.o getname.o +++ $(MAKEVERSION) Local-mailer 1.0 ${CC} +++ $(CC) $(LDFLAGS) -o mail version.o mail.o getname.o +++ size mail; ls -l mail diff --cc usr/src/cmd/delivermail/makefl.vax index 0000000000,0000000000,0000000000..d8c80b4587 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/makefl.vax @@@@ -1,0 -1,0 -1,0 +1,81 @@@@ +++# +++# VAX Version +++# +++# @(#)makefl.vax 1.3 7/25/80 +++# +++CPUTYPE=vax +++LIBS= +++ +++CHOWN= -echo chown +++CHMOD= chmod +++CFLAGS= -O -DDEBUG +++LDFLAGS=-n +++AR= -ar +++ARFLAGS=rvu +++LINT= lint +++LINTFLAGS=-bxa +++XREF= csh /usr/bin/xref +++MAKEVERSION=csh -f makeversion +++VER= 0.0 +++ +++OBJS1= conf.o deliver.o main.o parse.o err.o alias.o savemail.o addr.o +++OBJS2= matchhdr.o sysexits.o util.o bmove.${CPUTYPE}.o +++SRCS= conf.c deliver.c main.c parse.c err.c alias.c savemail.c addr.c \ +++ matchhdr.c sysexits.c util.c bmove.${CPUTYPE}.c +++ +++ROOT= root +++OBJMODE=755 +++ +++delivermail: $(OBJS1) $(OBJS2) +++ $(MAKEVERSION) Delivermail $(VER) $(CC) +++ $(CC) $(LDFLAGS) -o delivermail version.o $(OBJS1) $(OBJS2) $(LIBS) +++ $(CHMOD) $(OBJMODE) delivermail +++ size delivermail; ls -l delivermail +++ +++$(OBJS1): dlvrmail.h +++ +++dlvrmail.h util.o: useful.h +++ +++# +++# Auxiliary stuff +++# +++ +++clean: +++ rm -f core delivermail arpa uucp a.out xref version.c +++ rm -f *.o +++ +++archive: +++ ${AR} ${ARFLAGS} delivermail.a READ_ME TO_BE_DONE makefile makefl.* *.h *.c bmove.*.s makeversion *.[123456789u] +++ +++print: xref +++ @ls -l | pr -h "delivermail directory" +++ @pr -h "cross reference listing" xref +++ @size *.o | pr -h "object code sizes" +++ @pr *.h *.[cs] +++ +++lint: +++ $(LINT) $(LINTFLAGS) $(SRCS) +++ +++xref: *.c +++ ${XREF} *.c > xref +++ +++# +++# Auxiliary mailers +++# +++ +++arpa: arpa.o matchhdr.o arpadate.o +++ $(MAKEVERSION) Arpa-mailer 1.0 ${CC} +++ $(CC) $(LDFLAGS) -o arpa version.o arpa.o matchhdr.o arpadate.o $(LIBS) +++ ${CHMOD} ${OBJMODE} arpa +++ size arpa; ls -l arpa +++ +++uucp: uucp.o +++ $(MAKEVERSION) Uucp-mailer 1.0 ${CC} +++ ${CC} ${LDFLAGS} -o uucp version.o uucp.o ${LIBS} +++ ${CHMOD} ${OBJMODE} uucp +++ size uucp; ls -l uucp +++ +++mail: mail.o getname.o +++ $(MAKEVERSION) Local-mailer 1.0 ${CC} +++ $(CC) $(LDFLAGS) -o mail version.o mail.o getname.o +++ size mail; ls -l mail diff --cc usr/src/cmd/delivermail/maketemp.c index 0000000000,0000000000,0000000000..3ff6999f98 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/maketemp.c @@@@ -1,0 -1,0 -1,0 +1,219 @@@@ +++# include +++# include +++# include +++# include "dlvrmail.h" +++ +++static char SccsId[] = "@(#)maketemp.c 1.6 10/27/80"; +++ +++/* +++** MAKETEMP -- read & parse message header & make temp file. +++** +++** Creates a temporary file name and copies the standard +++** input to that file. While it is doing it, it looks for +++** "From:" and "Sender:" fields to use as the from-person +++** (but only if the -a flag is specified). It prefers to +++** to use the "Sender:" field. +++** +++** MIT seems to like to produce "Sent-By:" fields instead +++** of "Sender:" fields. We used to catch this, but it turns +++** out that the "Sent-By:" field doesn't always correspond +++** to someone real ("___057", for instance), as required by +++** the protocol. So we limp by..... +++** +++** Parameters: +++** none +++** +++** Returns: +++** Name of temp file. +++** +++** Side Effects: +++** Temp file is created and filled. +++** +++** Called By: +++** main +++** +++** Notes: +++** This is broken off from main largely so that the +++** temp buffer can be deallocated. +++*/ +++ +++char MsgId[MAXNAME]; /* message-id, determined or created */ +++long MsgSize; /* size of message in bytes */ +++ +++char * +++maketemp() +++{ +++ register FILE *tf; +++ char buf[MAXFIELD+1]; +++ static char fbuf[sizeof buf]; +++ extern char *prescan(); +++ extern char *matchhdr(); +++ register char *p; +++ register bool inheader; +++ bool firstline; +++ char c; +++ extern int errno; +++ +++ /* +++ ** Create the temp file name and create the file. +++ */ +++ +++ mktemp(InFileName); +++ close(creat(InFileName, 0600)); +++ if ((tf = fopen(InFileName, "w")) == NULL) +++ { +++ syserr("Cannot create %s", InFileName); +++ return (NULL); +++ } +++ +++ /* +++ ** Copy stdin to temp file & do message editting. +++ ** From person gets copied into fbuf. At the end of +++ ** this loop, if fbuf[0] == '\0' then there was no +++ ** recognized from person in the message. We also +++ ** save the message id in MsgId. The +++ ** flag 'inheader' keeps track of whether we are +++ ** in the header or in the body of the message. +++ ** The flag 'firstline' is only true on the first +++ ** line of a message. +++ ** To keep certain mailers from getting confused, +++ ** and to keep the output clean, lines that look +++ ** like UNIX "From" lines are deleted in the header, +++ ** and prepended with ">" in the body. +++ */ +++ +++ inheader = TRUE; +++ firstline = TRUE; +++ fbuf[0] = '\0'; +++ while (fgets(buf, sizeof buf, stdin) != NULL) +++ { +++ if (inheader && isalnum(buf[0])) +++ { +++ /* get the rest of this field */ +++ while ((c = getc(stdin)) == ' ' || c == '\t') +++ { +++ p = &buf[strlen(buf)]; +++ *p++ = c; +++ if (fgets(p, sizeof buf - (p - buf), stdin) == NULL) +++ break; +++ } +++ if (c != EOF) +++ ungetc(c, stdin); +++ } +++ +++ if (!IgnrDot && buf[0] == '.' && (buf[1] == '\n' || buf[1] == '\0')) +++ break; +++ +++ /* are we still in the header? */ +++ if ((buf[0] == '\n' || buf[0] == '\0') && inheader) +++ { +++ inheader = FALSE; +++ if (MsgId[0] == '\0') +++ { +++ makemsgid(); +++ if (UseMsgId) +++ fprintf(tf, "Message-Id: <%s>\n", MsgId); +++ } +++# ifdef DEBUG +++ if (Debug) +++ printf("EOH\n"); +++# endif DEBUG +++ } +++ +++ /* Hide UNIX-like From lines */ +++ if (buf[0] == 'F' && buf[1] == 'r' && buf[2] == 'o' && +++ buf[3] == 'm' && buf[4] == ' ') +++ { +++ if (firstline && !SaveFrom) +++ continue; +++ fputs(">", tf); +++ MsgSize++; +++ } +++ +++ if (inheader && !isspace(buf[0])) +++ { +++ /* find out if this is really a header */ +++ for (p = buf; *p != ':' && *p != '\0' && !isspace(*p); p++) +++ continue; +++ while (*p != ':' && isspace(*p)) +++ p++; +++ if (*p != ':') +++ { +++ inheader = FALSE; +++# ifdef DEBUG +++ if (Debug) +++ printf("EOH?\n"); +++# endif DEBUG +++ } +++ } +++ +++ if (inheader) +++ { +++ /* find the sender */ +++ p = matchhdr(buf, "sender"); +++ if (p == NULL && fbuf[0] == '\0') +++ p = matchhdr(buf, "from"); +++ if (p != NULL) +++ prescan(p, fbuf, &fbuf[sizeof fbuf - 1], '\0'); +++ +++ /* find the message id */ +++ p = matchhdr(buf, "message-id"); +++ if (p != NULL && MsgId[0] == '\0') +++ prescan(p, MsgId, &MsgId[sizeof MsgId - 1], '\0'); +++ } +++ MsgSize += strlen(buf); +++ fputs(buf, tf); +++ firstline = FALSE; +++ if (ferror(tf)) +++ { +++ if (errno == ENOSPC) +++ { +++ freopen(InFileName, "w", tf); +++ fputs("\nMAIL DELETED BECAUSE OF LACK OF DISK SPACE\n\n", tf); +++ syserr("Out of disk space for temp file"); +++ } +++ else +++ syserr("Cannot write %s", InFileName); +++ freopen("/dev/null", "w", tf); +++ } +++ } +++ fclose(tf); +++ if (MsgId[0] == '\0') +++ makemsgid(); +++ if (freopen(InFileName, "r", stdin) == NULL) +++ syserr("Cannot reopen %s", InFileName); +++ return (ArpaFmt && fbuf[0] != '\0' ? fbuf : NULL); +++} +++ /* +++** MAKEMSGID -- Compute a message id for this process. +++** +++** This routine creates a message id for a message if +++** it did not have one already. If the MESSAGEID compile +++** flag is set, the messageid will be added to any message +++** that does not already have one. Currently it is more +++** of an artifact, but I suggest that if you are hacking, +++** you leave it in -- I may want to use it someday if +++** duplicate messages turn out to be a problem. +++** +++** Parameters: +++** none. +++** +++** Returns: +++** none. +++** +++** Side Effects: +++** Stores a message-id into MsgId. +++** +++** Called By: +++** maketemp +++*/ +++ +++makemsgid() +++{ +++ auto long t; +++ extern char *MyLocName; +++ extern char *ArpaHost; +++ +++ time(&t); +++ sprintf(MsgId, "%ld.%d.%s@%s", t, getpid(), MyLocName, ArpaHost); +++} diff --cc usr/src/cmd/delivermail/matchhdr.c index 0000000000,0000000000,0000000000..54b9f6aade new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/matchhdr.c @@@@ -1,0 -1,0 -1,0 +1,80 @@@@ +++# include +++# include +++ +++static char SccsId[] = "@(#)matchhdr.c 1.3 8/2/80"; +++ +++/* +++** MATCHHDR -- Match header line +++** +++** Matches a header line in arpanet format (case and white +++** space is ignored). +++** +++** This routine is used by arpa-mailer and delivermail. +++** +++** Parameters: +++** line -- the line to match against. +++** pat -- the pattern to match against; must be in +++** lower case. +++** +++** Returns: +++** address of the 'value' of the pattern (the beginning +++** of the non-white string following the delim). +++** NULL if none found. +++** +++** Side Effects: +++** none +++** +++** Called By: +++** maketemp +++** sendmail [arpa.c] +++** +++** Deficiencies: +++** It doesn't handle folded lines. +++*/ +++ +++char * +++matchhdr(line, pat) +++ char *line; +++ char *pat; +++{ +++ register char *p; +++ register char *q; +++ +++ for (q = pat, p = line; *q != '\0'; p++, q++) +++ if (lower(*p) != *q) +++ return (NULL); +++ while (isspace(*p)) +++ p++; +++ if (*p != ':') +++ return (NULL); +++ while (isspace(*++p)) +++ continue; +++ return (*p == '\0' ? NULL : p); +++} +++ /* +++** LOWER -- Convert a character to lower case +++** +++** If the argument is an upper case letter, it is converted +++** to a lower case letter, otherwise it is passed through +++** unchanged. +++** +++** Parameters: +++** c -- the character to check. +++** +++** Returns: +++** c converted to lower case. +++** +++** Side Effects: +++** none +++** +++** Called By: +++** matchhdr +++*/ +++ +++lower(c) +++ register char c; +++{ +++ if (isupper(c)) +++ c -= 'A' - 'a'; +++ return (c); +++} diff --cc usr/src/cmd/delivermail/newaliases.c index 0000000000,0000000000,0000000000..57a0edb966 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/newaliases.c @@@@ -1,0 -1,0 -1,0 +1,190 @@@@ +++# include +++# include +++# include "dlvrmail.h" +++ +++static char SccsId[] = "@(#)newaliases.c 1.2 10/18/80"; +++ +++typedef struct { char *dptr; int dsize; } datum; +++char *aliases = ALIASFILE; +++char dirbuf[100]; +++char pagbuf[100]; +++int LineNo; +++char *To; +++int ExitStat; +++int Errors; +++# ifdef DEBUG +++bool Debug; +++# endif DEBUG +++ +++main(argc, argv) +++ int argc; +++ char *argv[]; +++{ +++ int f; +++ char line[BUFSIZ]; +++ char line2[MAXLINE]; +++ register char *p; +++ char *cp, *p2; +++ char *rhs; +++ int naliases, bytes, longest; +++ datum key, content; +++ bool skipping; +++ addrq al, bl; +++ extern char *prescan(); +++ extern addrq *parse(); +++ bool contin; +++ +++# ifdef DEBUG +++ if (argc > 1 && strcmp(argv[1], "-T") == 0) +++ { +++ Debug++; +++ argc--; +++ argv++; +++ } +++# endif DEBUG +++ if (argc > 1) +++ aliases = argv[1]; +++ +++ strcpy(dirbuf, aliases); +++ strcat(dirbuf, ".dir"); +++ strcpy(pagbuf, aliases); +++ strcat(pagbuf, ".pag"); +++ f = creat(dirbuf, 0666); +++ if (f < 0) { +++ perror(dirbuf); +++ exit(1); +++ } +++ close(f); +++ f = creat(pagbuf, 0666); +++ if (f < 0) { +++ perror(pagbuf); +++ exit(1); +++ } +++ close(f); +++ if (dbminit(aliases) < 0) +++ exit(1); +++ if (freopen(aliases, "r", stdin) == 0) { +++ perror(aliases); +++ exit(1); +++ } +++ +++ /* read and interpret lines */ +++ LineNo = 0; +++ naliases = 0; +++ bytes = 0; +++ longest = 0; +++ skipping = FALSE; +++ while (fgets(line, sizeof (line), stdin) != NULL) +++ { +++ LineNo++; +++ switch (line[0]) +++ { +++ case '#': +++ case '\n': +++ case '\0': +++ skipping = FALSE; +++ continue; +++ +++ case ' ': +++ case '\t': +++ if (!skipping) +++ usrerr("Non-continuation line starts with space"); +++ skipping = TRUE; +++ continue; +++ } +++ skipping = FALSE; +++ +++ /* process the LHS */ +++ for (p = line; *p != '\0' && *p != ':' && *p != '\n'; p++) +++ continue; +++ if (*p == '\0' || *p == '\n') +++ { +++ syntaxerr: +++ usrerr("missing colon"); +++ continue; +++ } +++ *p++ = '\0'; +++ if (parse(line, &al, 1) == NULL) +++ { +++ *--p = ':'; +++ goto syntaxerr; +++ } +++ rhs = cp = p; +++ contin = FALSE; +++ for (;;) +++ { +++ register char c; +++ +++ /* do parsing & compression of addresses */ +++ c = *p; +++ while (c != '\0') +++ { +++ p2 = p; +++ while (*p != '\n' && *p != ',' && *p != '\0') +++ p++; +++ c = *p; +++ *p++ = '\0'; +++ if (prescan(p2, cp, &line[sizeof line - 1], ',') == NULL) +++ continue; +++ contin = FALSE; +++ if (parse(cp, &bl, -1) != NULL) +++ cp += strlen(cp); +++ if (c == ',') +++ { +++ *cp++ = ','; +++ contin = TRUE; +++ } +++ } +++ +++ /* see if there should be a continuation line */ +++ if (!contin) +++ break; +++ +++ /* read continuation line */ +++ if (fgets(line2, sizeof (line2), stdin) == NULL) +++ break; +++ LineNo++; +++ +++ if (!isspace(line2[0])) +++ usrerr("continuation line missing"); +++ +++ p = line2; +++ } +++ if (al.q_mailer != &Mailer[0]) +++ { +++ usrerr("cannot alias non-local names"); +++ continue; +++ } +++ naliases++; +++ key.dsize = strlen(al.q_user) + 1; +++ key.dptr = al.q_user; +++ content.dsize = strlen(rhs) + 1; +++ if (content.dsize > longest) +++ longest = content.dsize; +++ content.dptr = rhs; +++ bytes += key.dsize + content.dsize; +++ if (store(key, content), 0) +++ /* if (f = store(key, content)) */ +++ usrerr("Dbm internal error return %d from store\n", f); +++ } +++ fprintf(stderr, "%d aliases, %d bytes, longest %d bytes, %d errors\n", +++ naliases, bytes, longest, Errors); +++ +++ exit(ExitStat); +++} +++ +++usrerr(fmt, a, b, c, d, e) +++ char *fmt; +++{ +++ Errors++; +++ fprintf(stderr, "line %d: ", LineNo); +++ fprintf(stderr, fmt, a, b, c, d, e); +++ fprintf(stderr, "\n"); +++ return (-1); +++} +++ +++syserr(fmt, a, b, c, d, e) +++ char *fmt; +++{ +++ return (usrerr(fmt, a, b, c, d, e)); +++} diff --cc usr/src/cmd/delivermail/parse.c index 0000000000,0000000000,0000000000..72d42caaf9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/parse.c @@@@ -1,0 -1,0 -1,0 +1,472 @@@@ +++# include +++# include +++# include "dlvrmail.h" +++ +++static char SccsId[] = "@(#)parse.c 1.7 10/21/80"; +++ +++/* +++** PARSE -- Parse an address +++** +++** Parses an address and breaks it up into three parts: a +++** net to transmit the message on, the host to transmit it +++** to, and a user on that host. These are loaded into an +++** addrq header with the values squirreled away if necessary. +++** The "user" part may not be a real user; the process may +++** just reoccur on that machine. For example, on a machine +++** with an arpanet connection, the address +++** csvax.bill@berkeley +++** will break up to a "user" of 'csvax.bill' and a host +++** of 'berkeley' -- to be transmitted over the arpanet. +++** +++** Parameters: +++** addr -- the address to parse. +++** a -- a pointer to the address descriptor buffer. +++** If NULL, a header will be created. +++** copyf -- determines what shall be copied: +++** -1 -- don't copy anything. The printname +++** (q_paddr) is just addr, and the +++** user & host are allocated internally +++** to parse. +++** 0 -- copy out the parsed user & host, but +++** don't copy the printname. +++** +1 -- copy everything. +++** +++** Returns: +++** A pointer to the address descriptor header (`a' if +++** `a' is non-NULL). +++** NULL on error. +++** +++** Side Effects: +++** none +++** +++** Called By: +++** main +++** sendto +++** alias +++** savemail +++*/ +++ +++addrq * +++parse(addr, a, copyf) +++ char *addr; +++ register addrq *a; +++ int copyf; +++{ +++ register char *p; +++ register struct parsetab *t; +++ extern struct parsetab ParseTab[]; +++ static char buf[MAXNAME]; +++ register char c; +++ register char *q; +++ bool got_one; +++ extern char *prescan(); +++ extern char *xalloc(); +++ char **pvp; +++ +++ /* +++ ** Initialize and prescan address. +++ */ +++ +++ To = addr; +++ if (prescan(addr, buf, &buf[sizeof buf], '\0') == NULL) +++ return (NULL); +++ +++ /* +++ ** Scan parse table. +++ ** Look for the first entry designating a character +++ ** that is contained in the address. +++ ** Arrange for q to point to that character. +++ ** Check to see that there is only one of the char +++ ** if it must be unique. +++ ** Find the last one if the host is on the RHS. +++ ** Insist that the host name is atomic. +++ ** If just doing a map, do the map and then start all +++ ** over. +++ */ +++ +++ rescan: +++ got_one = FALSE; +++ for (t = ParseTab; t->p_char != '\0'; t++) +++ { +++ q = NULL; +++ for (p = buf; (c = *p) != '\0'; p++) +++ { +++ /* find the end of this token */ +++ while (isalnum(c) || c == '-' || c == '_') +++ c = *++p; +++ if (c == '\0') +++ break; +++ +++ if (c == t->p_char) +++ { +++ got_one = TRUE; +++ +++ /* do mapping as appropriate */ +++ if (flagset(P_MAP, t->p_flags)) +++ { +++ *p = t->p_arg[0]; +++ if (flagset(P_ONE, t->p_flags)) +++ goto rescan; +++ else +++ continue; +++ } +++ +++ /* arrange for q to point to it */ +++ if (q != NULL && flagset(P_ONE, t->p_flags)) +++ { +++ usrerr("multichar error"); +++ ExitStat = EX_USAGE; +++ return (NULL); +++ } +++ if (q == NULL || flagset(P_HLAST, t->p_flags)) +++ q = p; +++ } +++ else +++ { +++ /* insist that host name is atomic */ +++ if (flagset(P_HLAST, t->p_flags)) +++ q = NULL; +++ else +++ break; +++ } +++ } +++ +++ if (q != NULL) +++ break; +++ } +++ +++ /* +++ ** If we matched nothing cleanly, but we did match something +++ ** somewhere in the process of scanning, then we have a +++ ** syntax error. This can happen on things like a@b:c where +++ ** @ has a right host and : has a left host. +++ ** +++ ** We also set `q' to the null string, in case someone forgets +++ ** to put the P_MOVE bit in the local mailer entry of the +++ ** configuration table. +++ */ +++ +++ if (q == NULL) +++ { +++ q = ""; +++ if (got_one) +++ { +++ usrerr("syntax error"); +++ ExitStat = EX_USAGE; +++ return (NULL); +++ } +++ } +++ +++ /* +++ ** Interpret entry. +++ ** t points to the entry for the mailer we will use. +++ ** q points to the significant character. +++ */ +++ +++ if (a == NULL) +++ a = (addrq *) xalloc(sizeof *a); +++ if (copyf > 0) +++ { +++ p = xalloc((unsigned) strlen(addr) + 1); +++ strcpy(p, addr); +++ a->q_paddr = p; +++ } +++ else +++ a->q_paddr = addr; +++ a->q_mailer = &Mailer[t->p_mailer]; +++ +++ if (flagset(P_MOVE, t->p_flags)) +++ { +++ /* send the message to another host & retry */ +++ a->q_host = t->p_arg; +++ if (copyf >= 0) +++ { +++ p = xalloc((unsigned) strlen(buf) + 1); +++ strcpy(p, buf); +++ a->q_user = p; +++ } +++ else +++ a->q_user = buf; +++ } +++ else +++ { +++ /* +++ ** Make local copies of the host & user and then +++ ** transport them out. +++ */ +++ +++ *q++ = '\0'; +++ if (flagset(P_HLAST, t->p_flags)) +++ { +++ a->q_host = q; +++ a->q_user = buf; +++ } +++ else +++ { +++ a->q_host = buf; +++ a->q_user = q; +++ } +++ +++ /* +++ ** Don't go to the net if already on the target host. +++ ** This is important on the berkeley network, since +++ ** it get confused if we ask to send to ourselves. +++ ** For nets like the ARPANET, we probably will have +++ ** the local list set to NULL to simplify testing. +++ ** The canonical representation of the name is also set +++ ** to be just the local name so the duplicate letter +++ ** suppression algorithm will work. +++ */ +++ +++ if ((pvp = a->q_mailer->m_local) != NULL) +++ { +++ while (*pvp != NULL) +++ { +++ auto char buf2[MAXNAME]; +++ +++ strcpy(buf2, a->q_host); +++ if (!flagset(P_HST_UPPER, t->p_flags)) +++ makelower(buf2); +++ if (strcmp(*pvp++, buf2) == 0) +++ { +++ strcpy(buf2, a->q_user); +++ p = a->q_paddr; +++ if (parse(buf2, a, -1) == NULL) +++ { +++ To = addr; +++ return (NULL); +++ } +++ To = a->q_paddr = p; +++ break; +++ } +++ } +++ } +++ +++ /* make copies if specified */ +++ if (copyf >= 0) +++ { +++ p = xalloc((unsigned) strlen(a->q_host) + 1); +++ strcpy(p, a->q_host); +++ a->q_host = p; +++ p = xalloc((unsigned) strlen(a->q_user) + 1); +++ strcpy(p, a->q_user); +++ a->q_user = p; +++ } +++ } +++ +++ /* +++ ** Do UPPER->lower case mapping unless inhibited. +++ */ +++ +++ if (!flagset(P_HST_UPPER, t->p_flags)) +++ makelower(a->q_host); +++ if (!flagset(P_USR_UPPER, t->p_flags)) +++ makelower(a->q_user); +++ +++ /* +++ ** Compute return value. +++ */ +++ +++# ifdef DEBUG +++ if (Debug) +++ printf("parse(\"%s\"): host \"%s\" user \"%s\" mailer %d\n", +++ addr, a->q_host, a->q_user, t->p_mailer); +++# endif DEBUG +++ +++ return (a); +++} +++ /* +++** MAKELOWER -- Translate a line into lower case +++** +++** Parameters: +++** p -- the string to translate. If NULL, return is +++** immediate. +++** +++** Returns: +++** none. +++** +++** Side Effects: +++** String pointed to by p is translated to lower case. +++** +++** Called By: +++** parse +++*/ +++ +++makelower(p) +++ register char *p; +++{ +++ register char c; +++ +++ if (p == NULL) +++ return; +++ for (; (c = *p) != '\0'; p++) +++ if ((c & 0200) == 0 && isupper(c)) +++ *p = c - 'A' + 'a'; +++} +++ /* +++** PRESCAN -- Prescan name and make it canonical +++** +++** Scans a name and turns it into canonical form. This involves +++** deleting blanks, comments (in parentheses), and turning the +++** word "at" into an at-sign ("@"). The name is copied as this +++** is done; it is legal to copy a name onto itself, since this +++** process can only make things smaller. +++** +++** This routine knows about quoted strings and angle brackets. +++** +++** There are certain subtleties to this routine. The one that +++** comes to mind now is that backslashes on the ends of names +++** are silently stripped off; this is intentional. The problem +++** is that some versions of sndmsg (like at LBL) set the kill +++** character to something other than @ when reading addresses; +++** so people type "csvax.eric\@berkeley" -- which screws up the +++** berknet mailer. +++** +++** Parameters: +++** addr -- the name to chomp. +++** buf -- the buffer to copy it into. +++** buflim -- the last usable address in the buffer +++** (which will old a null byte). Normally +++** &buf[sizeof buf - 1]. +++** delim -- the delimiter for the address, normally +++** '\0' or ','; \0 is accepted in any case. +++** are moving in place; set buflim to high core. +++** +++** Returns: +++** A pointer to the terminator of buf. +++** NULL on error. +++** +++** Side Effects: +++** buf gets clobbered. +++** +++** Called By: +++** parse +++** maketemp +++*/ +++ +++char * +++prescan(addr, buf, buflim, delim) +++ char *addr; +++ char *buf; +++ char *buflim; +++ char delim; +++{ +++ register char *p; +++ bool space; +++ bool quotemode; +++ bool bslashmode; +++ int cmntcnt; +++ int brccnt; +++ register char c; +++ register char *q; +++ extern bool any(); +++ +++ space = TRUE; +++ q = buf; +++ bslashmode = quotemode = FALSE; +++ cmntcnt = brccnt = 0; +++ for (p = addr; (c = *p++) != '\0'; ) +++ { +++ /* chew up special characters */ +++ *q = '\0'; +++ if (bslashmode) +++ { +++ c |= 0200; +++ bslashmode = FALSE; +++ } +++ else if (c == '"') +++ quotemode = !quotemode; +++ else if (c == '\\') +++ { +++ bslashmode++; +++ continue; +++ } +++ else if (quotemode) +++ c |= 0200; +++ else if (c == delim) +++ break; +++ else if (c == '(') +++ { +++ cmntcnt++; +++ continue; +++ } +++ else if (c == ')') +++ { +++ if (cmntcnt <= 0) +++ { +++ usrerr("Unbalanced ')'"); +++ return (NULL); +++ } +++ else +++ { +++ cmntcnt--; +++ continue; +++ } +++ } +++ else if (c == '<') +++ { +++ brccnt++; +++ if (brccnt == 1) +++ { +++ /* we prefer using machine readable name */ +++ q = buf; +++ *q = '\0'; +++ continue; +++ } +++ } +++ else if (c == '>') +++ { +++ if (brccnt <= 0) +++ { +++ usrerr("Unbalanced `>'"); +++ return (NULL); +++ } +++ else +++ brccnt--; +++ if (brccnt <= 0) +++ continue; +++ } +++ +++ /* +++ ** Turn "at" into "@", +++ ** but only if "at" is a word. +++ ** By the way, I violate the ARPANET RFC-733 +++ ** standard here, by assuming that 'space' delimits +++ ** atoms. I assume that is just a mistake, since +++ ** it violates the spirit of the semantics +++ ** of the document..... +++ */ +++ +++ if (space && (c == 'a' || c == 'A') && +++ (p[0] == 't' || p[0] == 'T') && +++ (any(p[1], "()<>@,;:\\\"") || p[1] <= 040)) +++ { +++ c = '@'; +++ p++; +++ } +++ +++ /* skip blanks */ +++ if (((c & 0200) != 0 || !isspace(c)) && cmntcnt <= 0) +++ { +++ if (q >= buflim) +++ { +++ usrerr("Address too long"); +++ return (NULL); +++ } +++ *q++ = c; +++ } +++ space = isspace(c); +++ } +++ *q = '\0'; +++ if (c == '\0') +++ p--; +++ if (cmntcnt > 0) +++ usrerr("Unbalanced '('"); +++ else if (quotemode) +++ usrerr("Unbalanced '\"'"); +++ else if (brccnt > 0) +++ usrerr("Unbalanced '<'"); +++ else if (buf[0] != '\0') +++ return (p); +++ return (NULL); +++} diff --cc usr/src/cmd/delivermail/praliases.c index 0000000000,0000000000,0000000000..0c562b504b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/praliases.c @@@@ -1,0 -1,0 -1,0 +1,42 @@@@ +++# include "dlvrmail.h" +++ +++static char sccsid[] = "@(#)praliases.c 1.4 10/21/80"; +++ +++typedef struct { char *dptr; int dsize; } datum; +++datum firstkey(), nextkey(), fetch(); +++char *filename = ALIASFILE; +++ +++main(argc, argv) +++ char **argv; +++{ +++ datum content, key; +++ +++ if (argc > 2 && strcmp(argv[1], "-f") == 0) +++ { +++ argv++; +++ filename = *++argv; +++ argc -= 2; +++ } +++ +++ if (dbminit(filename) < 0) +++ exit(EX_OSFILE); +++ argc--, argv++; +++ if (argc == 0) { +++ for (key = firstkey(); key.dptr; key = nextkey(key)) { +++ content = fetch(key); +++ printf("\n%s:%s\n", key.dptr, content.dptr); +++ } +++ exit(EX_OK); +++ } +++ while (argc) { +++ key.dptr = *argv; +++ key.dsize = strlen(*argv)+1; +++ content = fetch(key); +++ if (content.dptr == 0) +++ printf("%s: No such key\n"); +++ else +++ printf("\n%s:%s\n", key.dptr, content.dptr); +++ argc--, argv++; +++ } +++ exit(EX_OK); +++} diff --cc usr/src/cmd/delivermail/savemail.c index 0000000000,0000000000,0000000000..af7df9c4de new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/savemail.c @@@@ -1,0 -1,0 -1,0 +1,249 @@@@ +++# include +++# include +++# include "dlvrmail.h" +++ +++static char SccsId[] = "@(#)savemail.c 1.4 8/2/80"; +++ +++/* +++** SAVEMAIL -- Save mail on error +++** +++** If the MailBack flag is set, mail it back to the originator +++** together with an error message; otherwise, just put it in +++** dead.letter in the user's home directory (if he exists on +++** this machine). +++** +++** Parameters: +++** none +++** +++** Returns: +++** none +++** +++** Side Effects: +++** Saves the letter, by writing or mailing it back to the +++** sender, or by putting it in dead.letter in her home +++** directory. +++** +++** WARNING: the user id is reset to the original user. +++*/ +++ +++# define MY_NAME "~MAILER~DAEMON~" +++ +++savemail() +++{ +++ register struct passwd *pw; +++ register FILE *xfile; +++ char buf[MAXLINE+1]; +++ extern errhdr(); +++ auto addrq to_addr; +++ extern struct passwd *getpwnam(); +++ register char *p; +++ register int i; +++ auto long tim; +++ extern int errno; +++ extern char *ttypath(); +++ extern char *ctime(); +++ extern addrq *parse(); +++ static int exclusive; +++ +++ if (exclusive++) +++ return; +++ +++ /* +++ ** In the unhappy event we don't know who to return the mail +++ ** to, make someone up. +++ */ +++ +++ if (From.q_paddr == NULL) +++ { +++ if (parse("root", &From, 0) == NULL) +++ { +++ syserr("Cannot parse root!"); +++ ExitStat = EX_SOFTWARE; +++ finis(); +++ } +++ } +++ +++ /* +++ ** If called from Eric Schmidt's network, do special mailback. +++ ** Fundamentally, this is the mailback case except that +++ ** it returns an OK exit status (assuming the return +++ ** worked). +++ */ +++ +++ if (BerkNet) +++ { +++ ExitStat = EX_OK; +++ MailBack++; +++ } +++ +++ /* +++ ** If writing back, do it. +++ ** If the user is still logged in on the same terminal, +++ ** then write the error messages back to hir (sic). +++ ** If not, set the MailBack flag so that it will get +++ ** mailed back instead. +++ */ +++ +++ if (WriteBack) +++ { +++ p = ttypath(); +++ if (p == NULL || freopen(p, "w", stdout) == NULL) +++ { +++ MailBack++; +++ errno = 0; +++ } +++ else +++ { +++ xfile = fopen(Transcript, "r"); +++ if (xfile == NULL) +++ syserr("Cannot open %s", Transcript); +++ printf("\r\nMessage from %s\r\n", MY_NAME); +++ printf("Errors occurred while sending mail, transcript follows:\r\n"); +++ while (fgets(buf, sizeof buf, xfile) && !ferror(stdout)) +++ fputs(buf, stdout); +++ if (ferror(stdout)) +++ syserr("savemail: stdout: write err"); +++ fclose(xfile); +++ } +++ } +++ +++ /* +++ ** If mailing back, do it. +++ ** Throw away all further output. Don't do aliases, since +++ ** this could cause loops, e.g., if joe mails to x:joe, +++ ** and for some reason the network for x: is down, then +++ ** the response gets sent to x:joe, which gives a +++ ** response, etc. Also force the mail to be delivered +++ ** even if a version of it has already been sent to the +++ ** sender. +++ */ +++ +++ if (MailBack || From.q_mailer != &Mailer[0]) +++ { +++ freopen("/dev/null", "w", stdout); +++ NoAlias++; +++ ForceMail++; +++ +++ /* fake up an address header for the from person */ +++ bmove((char *) &From, (char *) &to_addr, sizeof to_addr); +++ if (parse(MY_NAME, &From, -1) == NULL) +++ { +++ syserr("Can't parse myself!"); +++ ExitStat = EX_SOFTWARE; +++ finis(); +++ } +++ i = deliver(&to_addr, errhdr); +++ bmove((char *) &to_addr, (char *) &From, sizeof From); +++ if (i != 0) +++ syserr("Can't return mail to %s", p); +++ else +++ return; +++ } +++ +++ /* +++ ** Save the message in dead.letter. +++ ** If we weren't mailing back, and the user is local, we +++ ** should save the message in dead.letter so that the +++ ** poor person doesn't have to type it over again -- +++ ** and we all know what poor typists programmers are. +++ */ +++ +++ setuid(getuid()); +++ setgid(getgid()); +++ setpwent(); +++ if (From.q_mailer == &Mailer[0] && (pw = getpwnam(From.q_user)) != NULL) +++ { +++ /* user has a home directory */ +++ p = pw->pw_dir; +++ } +++ else +++ { +++ syserr("Can't return mail to %s (pw=%u)", From.q_paddr, pw); +++# ifdef DEBUG +++ p = "/usr/tmp"; +++# else +++ p = NULL; +++# endif +++ } +++ if (p != NULL) +++ { +++ /* we have a home directory; open dead.letter */ +++ strcpy(buf, p); +++ strcat(buf, "/dead.letter"); +++ xfile = fopen(buf, "a"); +++ if (xfile == NULL) +++ printf("Cannot save mail, sorry\n"); +++ else +++ { +++ rewind(stdin); +++ errno = 0; +++ time(&tim); +++ fprintf(xfile, "----- Mail saved at %s", ctime(&tim)); +++ while (fgets(buf, sizeof buf, stdin) && !ferror(xfile)) +++ fputs(buf, xfile); +++ fputs("\n", xfile); +++ if (ferror(xfile)) +++ syserr("savemail: dead.letter: write err"); +++ fclose(xfile); +++ printf("Letter saved in dead.letter\n"); +++ } +++ } +++ else +++ +++ /* add terminator to writeback message */ +++ if (WriteBack) +++ printf("-----\r\n"); +++} +++ /* +++** ERRHDR -- Output the header for error mail. +++** +++** This is the edit filter to error mailbacks. +++** +++** Algorithm: +++** Output fixed header. +++** Output the transcript part. +++** Output the original message. +++** +++** Parameters: +++** xfile -- the transcript file. +++** fp -- the output file. +++** +++** Returns: +++** none +++** +++** Side Effects: +++** input from xfile +++** output to fp +++** +++** Called By: +++** deliver +++*/ +++ +++ +++errhdr(fp) +++ register FILE *fp; +++{ +++ char copybuf[512]; +++ register int i; +++ register int xfile; +++ extern int errno; +++ +++ if ((xfile = open(Transcript, 0)) < 0) +++ syserr("Cannot open %s", Transcript); +++ fflush(stdout); +++ errno = 0; +++ fprintf(fp, "To: %s\n", To); +++ fprintf(fp, "Subject: Unable to deliver mail\n"); +++ fprintf(fp, "\n ----- Transcript of session follows -----\n"); +++ fflush(fp); +++ while ((i = read(xfile, copybuf, sizeof copybuf)) > 0) +++ write(fileno(fp), copybuf, i); +++ fprintf(fp, "\n ----- Unsent message follows -----\n"); +++ fflush(fp); +++ rewind(stdin); +++ while ((i = read(fileno(stdin), copybuf, sizeof copybuf)) > 0) +++ write(fileno(fp), copybuf, i); +++ close(xfile); +++ if (errno != 0) +++ syserr("errhdr: I/O error"); +++} diff --cc usr/src/cmd/delivermail/sysexits.c index 0000000000,0000000000,0000000000..bbc109165c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/sysexits.c @@@@ -1,0 -1,0 -1,0 +1,24 @@@@ +++# include +++ +++static char SccsId[] = "@(#)sysexits.c 1.3 8/2/80"; +++ +++/* +++** SYSEXITS.C -- error messages corresponding to sysexits.h +++*/ +++ +++char *SysExMsg[] = +++{ +++ /* 64 */ "Bad usage", +++ /* 65 */ "Data format error", +++ /* 66 */ "Cannot open input", +++ /* 67 */ "User unknown", +++ /* 68 */ "Host unknown", +++ /* 69 */ "Service unavailable", +++ /* 70 */ "Internal error", +++ /* 71 */ "Operating system error", +++ /* 72 */ "System file missing", +++ /* 73 */ "Can't create output", +++ /* 74 */ "I/O error", +++}; +++ +++int N_SysEx = sizeof SysExMsg / sizeof SysExMsg[0]; diff --cc usr/src/cmd/delivermail/useful.h index 0000000000,0000000000,0000000000..3797c13fcc new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/useful.h @@@@ -1,0 -1,0 -1,0 +1,13 @@@@ +++/* +++** USEFUL.H -- Some useful stuff. +++** +++** @(#)useful.h 1.3 10/11/80 +++*/ +++ +++# define bool char +++# define TRUE 1 +++# define FALSE 0 +++ +++# ifndef NULL +++# define NULL 0 +++# endif NULL diff --cc usr/src/cmd/delivermail/util.c index 0000000000,0000000000,0000000000..af2a3b643a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/util.c @@@@ -1,0 -1,0 -1,0 +1,102 @@@@ +++# include +++# include "useful.h" +++ +++static char SccsId[] = "@(#)util.c 1.4 10/21/80"; +++ +++/* +++** STRIPQUOTES -- Strip quotes & quote bits from a string. +++** +++** Runs through a string and strips off unquoted quote +++** characters and quote bits. This is done in place. +++** +++** Parameters: +++** s -- the string to strip. +++** +++** Returns: +++** none. +++** +++** Side Effects: +++** none. +++** +++** Called By: +++** deliver +++*/ +++ +++stripquotes(s) +++ char *s; +++{ +++ register char *p; +++ register char *q; +++ register char c; +++ +++ for (p = q = s; (c = *p++) != '\0'; ) +++ { +++ if (c != '"') +++ *q++ = c & 0177; +++ } +++ *q = '\0'; +++} +++ /* +++** XALLOC -- Allocate memory and bitch wildly on failure. +++** +++** THIS IS A CLUDGE. This should be made to give a proper +++** error -- but after all, what can we do? +++** +++** Parameters: +++** sz -- size of area to allocate. +++** +++** Returns: +++** pointer to data region. +++** +++** Side Effects: +++** Memory is allocated. +++** +++** Called By: +++** lots of people. +++*/ +++ +++char * +++xalloc(sz) +++ register unsigned int sz; +++{ +++ register char *p; +++ extern char *malloc(); +++ +++ p = malloc(sz); +++ if (p == NULL) +++ { +++ syserr("Out of memory!!"); +++ exit(EX_UNAVAILABLE); +++ } +++ return (p); +++} +++ /* +++** ANY -- Return TRUE if the character exists in the string. +++** +++** Parameters: +++** c -- the character. +++** s -- the string +++** (sounds like an avant garde script) +++** +++** Returns: +++** TRUE -- if c could be found in s. +++** FALSE -- otherwise. +++** +++** Side Effects: +++** none. +++** +++** Called By: +++** prescan +++*/ +++ +++any(c, s) +++ register char c; +++ register char *s; +++{ +++ register char c2; +++ +++ while ((c2 = *s++) != '\0') +++ if (c2 == c) +++ return (TRUE); +++ return (FALSE); +++} diff --cc usr/src/cmd/delivermail/vax-mail.c index 0000000000,0000000000,0000000000..9f6a2e1663 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/vax-mail.c @@@@ -1,0 -1,0 -1,0 +1,835 @@@@ +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++ +++static char SccsId[] = "@(#)mail.c 4.1 10/1/80"; +++ +++#define DELIVERMAIL "/etc/delivermail" +++ +++ +++/*copylet flags */ +++ /*remote mail, add rmtmsg */ +++#define REMOTE 1 +++ /* zap header and trailing empty line */ +++#define ZAP 3 +++#define ORDINARY 2 +++#define FORWARD 4 +++#define LSIZE 256 +++#define MAXLET 300 /* maximum number of letters */ +++#define MAILMODE (~0644) /* mode of created mail */ +++# ifndef DELIVERMAIL +++#define RMAIL "/usr/net/bin/sendberkmail" +++#define LOCNAM1 "csvax" +++#define LOCNAM2 "ucbvax" +++#define LOCNAM3 "vax" +++#define LOCNAM4 "v" +++# endif +++ +++char line[LSIZE]; +++char resp[LSIZE]; +++struct let { +++ long adr; +++ char change; +++} let[MAXLET]; +++int nlet = 0; +++char lfil[50]; +++long iop, time(); +++char *getenv(); +++char *index(); +++char lettmp[] = "/tmp/maXXXXX"; +++char maildir[] = "/usr/spool/mail/"; +++char mailfile[] = "/usr/spool/mail/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; +++char dead[] = "dead.letter"; +++char *thissys = sysname; +++char *netname = "vax"; +++char forwmsg[] = " forwarded\n"; +++FILE *tmpf; +++FILE *malf; +++char *my_name; +++char *getlogin(); +++struct passwd *getpwuid(); +++int error; +++int changed; +++int forward; +++char from[] = "From "; +++long ftell(); +++int delete(); +++char *ctime(); +++int flgf; +++int flgp; +++int delflg = 1; +++int hseqno; +++jmp_buf sjbuf; +++int rmail; +++ +++main(argc, argv) +++char **argv; +++{ +++ register i; +++ char sobuf[BUFSIZ]; +++ +++ setbuf(stdout, sobuf); +++ mktemp(lettmp); +++ unlink(lettmp); +++ my_name = getlogin(); +++ if (my_name == NULL || strlen(my_name) == 0) { +++ struct passwd *pwent; +++ pwent = getpwuid(getuid()); +++ if (pwent==NULL) +++ my_name = "???"; +++ else +++ my_name = pwent->pw_name; +++ } +++ if(setjmp(sjbuf)) done(); +++ for (i=0; i<20; i++) +++ setsig(i, delete); +++ tmpf = fopen(lettmp, "w"); +++ if (tmpf == NULL) { +++ fprintf(stderr, "mail: cannot open %s for writing\n", lettmp); +++ done(); +++ } +++ if (argv[0][0] == 'r') +++ rmail++; +++ if (argv[0][0] != 'r' && /* no favors for rmail*/ +++ (argc == 1 || argv[1][0] == '-' && !any(argv[1][1], "rhd"))) +++ printmail(argc, argv); +++ else +++ sendmail(argc, argv); +++ done(); +++} +++ +++setsig(i, f) +++int i; +++int (*f)(); +++{ +++ if(signal(i, SIG_IGN)!=SIG_IGN) +++ signal(i, f); +++} +++ +++any(c, str) +++ register int c; +++ register char *str; +++{ +++ +++ while (*str) +++ if (c == *str++) +++ return(1); +++ return(0); +++} +++ +++printmail(argc, argv) +++char **argv; +++{ +++ int flg, i, j, print; +++ char *p, *getarg(); +++ struct stat statb; +++ +++ setuid(getuid()); +++ cat(mailfile, maildir, my_name); +++ if (stat(mailfile, &statb) >= 0 +++ && (statb.st_mode & S_IFMT) == S_IFDIR) { +++ strcat(mailfile, "/"); +++ strcat(mailfile, my_name); +++ } +++ for (; argc>1; argv++, argc--) { +++ if (argv[1][0]=='-') { +++ if (argv[1][1]=='q') +++ delflg = 0; +++ else if (argv[1][1]=='p') { +++ flgp++; +++ delflg = 0; +++ } else if (argv[1][1]=='f') { +++ if (argc>=3) { +++ strcpy(mailfile, argv[2]); +++ argv++; +++ argc--; +++ } +++ } else if (argv[1][1]=='r') { +++ forward = 1; +++ } else if (argv[1][1]=='h') { +++ forward = 1; +++ } else { +++ fprintf(stderr, "mail: unknown option %c\n", argv[1][1]); +++ done(); +++ } +++ } else +++ break; +++ } +++ malf = fopen(mailfile, "r"); +++ if (malf == NULL) { +++ fprintf(stdout, "No mail.\n"); +++ return; +++ } +++ lock(mailfile); +++ copymt(malf, tmpf); +++ fclose(malf); +++ fclose(tmpf); +++ unlock(); +++ tmpf = fopen(lettmp, "r"); +++ +++ changed = 0; +++ print = 1; +++ for (i = 0; i < nlet; ) { +++ j = forward ? i : nlet - i - 1; +++ if(setjmp(sjbuf)) { +++ print=0; +++ } else { +++ if (print) +++ copylet(j, stdout, ORDINARY); +++ print = 1; +++ } +++ if (flgp) { +++ i++; +++ continue; +++ } +++ setjmp(sjbuf); +++ fprintf(stdout, "? "); +++ fflush(stdout); +++ if (fgets(resp, LSIZE, stdin) == NULL) +++ break; +++ switch (resp[0]) { +++ +++ default: +++ fprintf(stderr, "usage\n"); +++ case '?': +++ print = 0; +++ fprintf(stderr, "q\tquit\n"); +++ fprintf(stderr, "x\texit without changing mail\n"); +++ fprintf(stderr, "p\tprint\n"); +++ fprintf(stderr, "s[file]\tsave (default mbox)\n"); +++ fprintf(stderr, "w[file]\tsame without header\n"); +++ fprintf(stderr, "-\tprint previous\n"); +++ fprintf(stderr, "d\tdelete\n"); +++ fprintf(stderr, "+\tnext (no delete)\n"); +++ fprintf(stderr, "m user\tmail to user\n"); +++ fprintf(stderr, "! cmd\texecute cmd\n"); +++ break; +++ +++ case '+': +++ case 'n': +++ case '\n': +++ i++; +++ break; +++ case 'x': +++ changed = 0; +++ case 'q': +++ goto donep; +++ case 'p': +++ break; +++ case '^': +++ case '-': +++ if (--i < 0) +++ i = 0; +++ break; +++ case 'y': +++ case 'w': +++ case 's': +++ flg = 0; +++ if (resp[1] != '\n' && resp[1] != ' ') { +++ printf("illegal\n"); +++ flg++; +++ print = 0; +++ continue; +++ } +++ if (resp[1] == '\n' || resp[1] == '\0') { +++ p = getenv("HOME"); +++ if(p != 0) +++ cat(resp+1, p, "/mbox"); +++ else +++ cat(resp+1, "", "mbox"); +++ } +++ for (p = resp+1; (p = getarg(lfil, p)) != NULL; ) { +++ malf = fopen(lfil, "a"); +++ if (malf == NULL) { +++ fprintf(stdout, "mail: cannot append to %s\n", lfil); +++ flg++; +++ continue; +++ } +++ copylet(j, malf, resp[0]=='w'? ZAP: ORDINARY); +++ fclose(malf); +++ } +++ if (flg) +++ print = 0; +++ else { +++ let[j].change = 'd'; +++ changed++; +++ i++; +++ } +++ break; +++ case 'm': +++ flg = 0; +++ if (resp[1] == '\n' || resp[1] == '\0') { +++ i++; +++ continue; +++ } +++ if (resp[1] != ' ') { +++ printf("invalid command\n"); +++ flg++; +++ print = 0; +++ continue; +++ } +++ for (p = resp+1; (p = getarg(lfil, p)) != NULL; ) +++ if (!sendrmt(j, lfil, "/bin/mail")) /* couldn't send it */ +++ flg++; +++ if (flg) +++ print = 0; +++ else { +++ let[j].change = 'd'; +++ changed++; +++ i++; +++ } +++ break; +++ case '!': +++ system(resp+1); +++ printf("!\n"); +++ print = 0; +++ break; +++ case 'd': +++ let[j].change = 'd'; +++ changed++; +++ i++; +++ if (resp[1] == 'q') +++ goto donep; +++ break; +++ } +++ } +++ donep: +++ if (changed) +++ copyback(); +++} +++ +++copyback() /* copy temp or whatever back to /usr/spool/mail */ +++{ +++ register i, n, c; +++ int new = 0; +++ struct stat stbuf; +++ +++ signal(SIGINT, SIG_IGN); +++ signal(SIGHUP, SIG_IGN); +++ signal(SIGQUIT, SIG_IGN); +++ lock(mailfile); +++ stat(mailfile, &stbuf); +++ if (stbuf.st_size != let[nlet].adr) { /* new mail has arrived */ +++ malf = fopen(mailfile, "r"); +++ if (malf == NULL) { +++ fprintf(stdout, "mail: can't re-read %s\n", mailfile); +++ done(); +++ } +++ fseek(malf, let[nlet].adr, 0); +++ fclose(tmpf); +++ tmpf = fopen(lettmp, "a"); +++ fseek(tmpf, let[nlet].adr, 0); +++ while ((c = fgetc(malf)) != EOF) +++ fputc(c, tmpf); +++ fclose(malf); +++ fclose(tmpf); +++ tmpf = fopen(lettmp, "r"); +++ let[++nlet].adr = stbuf.st_size; +++ new = 1; +++ } +++ malf = fopen(mailfile, "w"); +++ if (malf == NULL) { +++ fprintf(stderr, "mail: can't rewrite %s\n", lfil); +++ done(); +++ } +++ n = 0; +++ for (i = 0; i < nlet; i++) +++ if (let[i].change != 'd') { +++ copylet(i, malf, ORDINARY); +++ n++; +++ } +++ fclose(malf); +++ if (new) +++ fprintf(stdout, "new mail arrived\n"); +++ unlock(); +++} +++ +++copymt(f1, f2) /* copy mail (f1) to temp (f2) */ +++FILE *f1, *f2; +++{ +++ long nextadr; +++ +++ nlet = nextadr = 0; +++ let[0].adr = 0; +++ while (fgets(line, LSIZE, f1) != NULL) { +++ if (isfrom(line)) +++ let[nlet++].adr = nextadr; +++ nextadr += strlen(line); +++ fputs(line, f2); +++ } +++ let[nlet].adr = nextadr; /* last plus 1 */ +++} +++ +++copylet(n, f, type) FILE *f; +++{ int ch, k; +++ fseek(tmpf, let[n].adr, 0); +++ k = let[n+1].adr - let[n].adr; +++ while(k-- > 1 && (ch=fgetc(tmpf))!='\n') +++ if(type!=ZAP) fputc(ch,f); +++ if(type==REMOTE) +++ fprintf(f, " remote from %s\n", thissys); +++ else if (type==FORWARD) +++ fprintf(f, forwmsg); +++ else if(type==ORDINARY) +++ fputc(ch,f); +++ while(k-->1) +++ fputc(ch=fgetc(tmpf), f); +++ if(type!=ZAP || ch!= '\n') +++ fputc(fgetc(tmpf), f); +++} +++ +++isfrom(lp) +++register char *lp; +++{ +++ register char *p; +++ +++ for (p = from; *p; ) +++ if (*lp++ != *p++) +++ return(0); +++ return(1); +++} +++ +++sendmail(argc, argv) +++char **argv; +++{ +++ char truename[100]; +++ int first; +++ register char *cp; +++ int gaver = 0; +++# ifdef DELIVERMAIL +++ char *newargv[1000]; +++ register char **ap; +++ register char **vp; +++ int dflag; +++ +++ dflag = 0; +++ if (argc < 1) +++ fprintf(stderr, "puke\n"); +++ for (vp = argv, ap = newargv + 1; (*ap = *vp++) != 0; ap++) +++ { +++ if (ap[0][0] == '-' && ap[0][1] == 'd') +++ dflag++; +++ } +++ if (!dflag) +++ { +++ /* give it to delivermail, rah rah! */ +++ unlink(lettmp); +++ ap = newargv+1; +++ if (rmail) +++ *ap-- = "-s"; +++ *ap = "-delivermail"; +++ execv(DELIVERMAIL, ap); +++ perror(DELIVERMAIL); +++ exit(EX_UNAVAILABLE); +++ } +++# endif DELIVERMAIL +++ +++ truename[0] = 0; +++ line[0] = '\0'; +++ +++ /* +++ * When we fall out of this, argv[1] should be first name, +++ * argc should be number of names + 1. +++ */ +++ +++ while (argc > 1 && *argv[1] == '-') { +++ cp = *++argv; +++ argc--; +++ switch (cp[1]) { +++ case 'r': +++ if (argc <= 0) { +++ usage(); +++ done(); +++ } +++ gaver++; +++ strcpy(truename, argv[1]); +++ fgets(line, LSIZE, stdin); +++ if (strcmpn("From", line, 4) == 0) +++ line[0] = '\0'; +++ argv++; +++ argc--; +++ break; +++ +++ case 'h': +++ if (argc <= 0) { +++ usage(); +++ done(); +++ } +++ hseqno = atoi(argv[1]); +++ argv++; +++ argc--; +++ break; +++ +++# ifdef DELIVERMAIL +++ case 'd': +++ break; +++# endif DELIVERMAIL +++ +++ default: +++ usage(); +++ done(); +++ } +++ } +++ if (argc <= 1) { +++ usage(); +++ done(); +++ } +++ if (gaver == 0) +++ strcpy(truename, my_name); +++ /* +++ if (argc > 4 && strcmp(argv[1], "-r") == 0) { +++ strcpy(truename, argv[2]); +++ argc -= 2; +++ argv += 2; +++ fgets(line, LSIZE, stdin); +++ if (strcmpn("From", line, 4) == 0) +++ line[0] = '\0'; +++ } else +++ strcpy(truename, my_name); +++ */ +++ time(&iop); +++ fprintf(tmpf, "%s%s %s", from, truename, ctime(&iop)); +++ iop = ftell(tmpf); +++ flgf = 1; +++ for (first = 1;; first = 0) { +++ if (first && line[0] == '\0' && fgets(line, LSIZE, stdin) == NULL) +++ break; +++ if (!first && fgets(line, LSIZE, stdin) == NULL) +++ break; +++ if (line[0] == '.' && line[1] == '\n' && isatty(fileno(stdin))) +++ break; +++ if (isfrom(line)) +++ fputs(">", tmpf); +++ fputs(line, tmpf); +++ flgf = 0; +++ } +++ fputs("\n", tmpf); +++ nlet = 1; +++ let[0].adr = 0; +++ let[1].adr = ftell(tmpf); +++ fclose(tmpf); +++ if (flgf) +++ return; +++ tmpf = fopen(lettmp, "r"); +++ if (tmpf == NULL) { +++ fprintf(stderr, "mail: cannot reopen %s for reading\n", lettmp); +++ return; +++ } +++ while (--argc > 0) +++ if (!send(0, *++argv, truename)) +++ error++; +++ if (error) { +++ setuid(getuid()); +++ malf = fopen(dead, "w"); +++ if (malf == NULL) { +++ fprintf(stdout, "mail: cannot open %s\n", dead); +++ fclose(tmpf); +++ return; +++ } +++ copylet(0, malf, ZAP); +++ fclose(malf); +++ fprintf(stdout, "Mail saved in %s\n", dead); +++ } +++ fclose(tmpf); +++} +++ +++sendrmt(n, name, rcmd) +++char *name; +++char *rcmd; +++{ +++ FILE *rmf, *popen(); +++ register char *p; +++ char rsys[64], cmd[64]; +++ register local, pid; +++ int sts; +++ +++ local = 0; +++ if (index(name, '^')) { +++ while (p = index(name, '^')) +++ *p = '!'; +++ if (strncmp(name, "researc", 7)) { +++ strcpy(rsys, "research"); +++ if (*name != '!') +++ --name; +++ goto skip; +++ } +++ } +++ if (*name=='!') +++ name++; +++ for(p=rsys; *name!='!'; *p++ = *name++) +++ if (*name=='\0') { +++ local++; +++ break; +++ } +++ *p = '\0'; +++ if ((!local && *name=='\0') || (local && *rsys=='\0')) { +++ fprintf(stdout, "null name\n"); +++ return(0); +++ } +++skip: +++ if ((pid = fork()) == -1) { +++ fprintf(stderr, "mail: can't create proc for remote\n"); +++ return(0); +++ } +++ if (pid) { +++ while (wait(&sts) != pid) { +++ if (wait(&sts)==-1) +++ return(0); +++ } +++ return(!sts); +++ } +++ setuid(getuid()); +++ if (local) +++ sprintf(cmd, "%s %s", rcmd, rsys); +++ else { +++ if (index(name+1, '!')) +++ sprintf(cmd, "uux - %s!rmail \\(%s\\)", rsys, name+1); +++ else +++ sprintf(cmd, "uux - %s!rmail %s", rsys, name+1); +++ } +++ if ((rmf=popen(cmd, "w")) == NULL) +++ exit(1); +++ copylet(n, rmf, local ? !strcmp(rcmd, "/bin/mail") ? FORWARD : ORDINARY : REMOTE); +++ pclose(rmf); +++ exit(0); +++} +++ +++# ifndef DELIVERMAIL +++/* +++ * Send mail on the Berkeley network. +++ * Sorry Bill, sendrmt() is so awful we just gave up. +++ */ +++ +++sendberkmail(n, name, fromaddr) +++ char name[]; +++ char fromaddr[]; +++{ +++ char cmd[200]; +++ register FILE *cmdf; +++ +++ sprintf(cmd, "%s -h %d -f %s -t %s", RMAIL, hseqno, fromaddr, name); +++ if ((cmdf = popen(cmd, "w")) == NULL) { +++ perror(RMAIL); +++ return(0); +++ } +++ copylet(n, cmdf, ORDINARY); +++ pclose(cmdf); +++ return(9); +++} +++# endif +++ +++usage() +++{ +++ +++ fprintf(stderr, "Usage: mail [ -f ] people . . .\n"); +++} +++ +++send(n, name, fromaddr) +++int n; +++char *name; +++char *fromaddr; +++{ +++ char file[100]; +++ register char *p; +++ register mask; +++ struct passwd *pw, *getpwnam(); +++ struct stat statb; +++ +++# ifndef DELIVERMAIL +++ stripfx(LOCNAM1, &name); +++ stripfx(LOCNAM2, &name); +++ stripfx(LOCNAM3, &name); +++ stripfx(LOCNAM4, &name); +++ if(*name == ':')name++; /* skip colon in to-name */ +++ for(p=name; *p!=':' && *p!='!' && *p!='^' &&*p!='\0'; p++); +++ /* if(*p == ':') return(sendrmt(n, name, RMAIL)); */ +++ if (*p == ':') +++ return(sendberkmail(n, name, fromaddr)); +++ else if (*p=='\0' && strcmp(name, "msgs") == 0) +++ return(sendrmt(n, "-s", "/usr/ucb/msgs")); +++# endif +++ for(p=name; *p!='!'&&*p!='^' &&*p!='\0'; p++) +++ ; +++ if (*p == '!'|| *p=='^') +++ return(sendrmt(n, name, 0)); +++ if ((pw = getpwnam(name)) == NULL) { +++ fprintf(stdout, "mail: can't send to %s\n", name); +++ return(0); +++ } +++ cat(file, maildir, name); +++ if (stat(file, &statb) >= 0 && (statb.st_mode & S_IFMT) == S_IFDIR) { +++ strcat(file, "/"); +++ strcat(file, name); +++ } +++ mask = umask(MAILMODE); +++ malf = fopen(file, "a"); +++ umask(mask); +++ if (malf == NULL) { +++ fprintf(stdout, "mail: cannot append to %s\n", file); +++ return(0); +++ } +++ lock(file); +++ chown(file, pw->pw_uid, pw->pw_gid); +++ copylet(n, malf, ORDINARY); +++ fclose(malf); +++ unlock(); +++ return(1); +++} +++ +++delete(i) +++{ +++ setsig(i, delete); +++ fprintf(stderr, "\n"); +++ if(delflg) +++ longjmp(sjbuf, 1); +++ done(); +++} +++ +++/* +++ * Lock the specified mail file by setting the file mailfile.lock. +++ * We must, of course, be careful to unlink the lock file by a call +++ * to unlock before we stop. The algorithm used here is to see if +++ * the lock exists, and if it does, to check its modify time. If it +++ * is older than 30 seconds, we assume error and set our own file. +++ * Otherwise, we wait for 5 seconds and try again. +++ */ +++ +++char *maillock = ".lock"; /* Lock suffix for mailname */ +++char *lockname = "/usr/spool/mail/tmXXXXXX"; +++char locktmp[30]; /* Usable lock temporary */ +++char curlock[50]; /* Last used name of lock */ +++int locked; /* To note that we locked it */ +++ +++lock(file) +++char *file; +++{ +++ register int f; +++ struct stat sbuf; +++ long curtime; +++ int statfailed; +++ +++ if (locked || flgf) +++ return(0); +++ strcpy(curlock, file); +++ strcat(curlock, maillock); +++ strcpy(locktmp, lockname); +++ mktemp(locktmp); +++ unlink(locktmp); +++ statfailed = 0; +++ for (;;) { +++ f = lock1(locktmp, curlock); +++ if (f == 0) { +++ locked = 1; +++ return(0); +++ } +++ if (stat(curlock, &sbuf) < 0) { +++ if (statfailed++ > 5) +++ return(-1); +++ sleep(5); +++ continue; +++ } +++ statfailed = 0; +++ time(&curtime); +++ if (curtime < sbuf.st_ctime + 30) { +++ sleep(5); +++ continue; +++ } +++ unlink(curlock); +++ } +++} +++ +++/* +++ * Remove the mail lock, and note that we no longer +++ * have it locked. +++ */ +++ +++unlock() +++{ +++ +++ unlink(curlock); +++ locked = 0; +++} +++ +++/* +++ * Attempt to set the lock by creating the temporary file, +++ * then doing a link/unlink. If it fails, return -1 else 0 +++ */ +++ +++lock1(tempfile, name) +++ char tempfile[], name[]; +++{ +++ register int fd; +++ +++ fd = creat(tempfile, 0); +++ if (fd < 0) +++ return(-1); +++ close(fd); +++ if (link(tempfile, name) < 0) { +++ unlink(tempfile); +++ return(-1); +++ } +++ unlink(tempfile); +++ return(0); +++} +++ +++done() +++{ +++ if(locked) +++ unlock(); +++ unlink(lettmp); +++ unlink(locktmp); +++ exit(error); +++} +++ +++cat(to, from1, from2) +++char *to, *from1, *from2; +++{ +++ int i, j; +++ +++ j = 0; +++ for (i=0; from1[i]; i++) +++ to[j++] = from1[i]; +++ for (i=0; from2[i]; i++) +++ to[j++] = from2[i]; +++ to[j] = 0; +++} +++ +++char *getarg(s, p) /* copy p... into s, update p */ +++register char *s, *p; +++{ +++ while (*p == ' ' || *p == '\t') +++ p++; +++ if (*p == '\n' || *p == '\0') +++ return(NULL); +++ while (*p != ' ' && *p != '\t' && *p != '\n' && *p != '\0') +++ *s++ = *p++; +++ *s = '\0'; +++ return(p); +++} +++# ifndef DELIVERMAIL +++/* +++ stripfx(prefix string, pointer to string) +++ +++ takes a ptr to string and compares it to prefix string. +++ may be called multiple times +++*/ +++stripfx(pfx, name) +++ char *pfx; +++ char **name; +++{ +++ register char *cp = *name; +++ +++ while (*pfx && (*cp == *pfx || *cp == toupper(*pfx))) +++ cp++, pfx++; +++ if (*cp != ':' || *pfx != 0) +++ return; +++ *name = cp; +++} +++# endif diff --cc usr/src/cmd/delivermail/version.c index 0000000000,0000000000,0000000000..54c0bac6fe new file mode 100644 --- /dev/null +++ b/usr/src/cmd/delivermail/version.c @@@@ -1,0 -1,0 -1,0 +1,1 @@@@ +++char Version[] = "@(#)Delivermail version 1.10 of 10/28/80"; diff --cc usr/src/cmd/deroff.c index 0000000000,692272abba,0000000000..c0cb3a0fbe mode 000000,100644,000000..100644 --- a/usr/src/cmd/deroff.c +++ b/usr/src/cmd/deroff.c @@@@ -1,0 -1,494 -1,0 +1,495 @@@@ +++static char *sccsid = "@(#)deroff.c 4.1 (Berkeley) 10/1/80"; + +char *xxxvers = "\nDeroff Version 1.02 24 July 1978\n"; + + + + + +#include + + + +/* Deroff command -- strip troff, eqn, and Tbl sequences from + +a file. Has one flag argument, -w, to cause output one word per line + +rather than in the original format. + +Deroff follows .so and .nx commands, removes contents of macro + +definitions, equations (both .EQ ... .EN and $...$), + +Tbl command sequences, and Troff backslash constructions. + + + +All input is through the C macro; the most recently read character is in c. + +*/ + + + +#define C ( (c=getc(infile)) == EOF ? eof() : ((c==ldelim)&&(filesp==files) ? skeqn() : c) ) + +#define C1 ( (c=getc(infile)) == EOF ? eof() : c) + +#define SKIP while(C != '\n') + + + +#define YES 1 + +#define NO 0 + + + +#define NOCHAR -2 + +#define SPECIAL 0 + +#define APOS 1 + +#define DIGIT 2 + +#define LETTER 3 + + + +int wordflag = NO; + +int inmacro = NO; + +int intable = NO; + + + +char chars[128]; /* SPECIAL, APOS, DIGIT, or LETTER */ + + + +char line[BUFSIZ]; + +char *lp; + + + +int c; + +int ldelim = NOCHAR; + +int rdelim = NOCHAR; + + + + + +int argc; + +char **argv; + + + +char fname[50]; + +FILE *files[15]; + +FILE **filesp; + +FILE *infile; + + + +char *calloc(); + + + + + + + +main(ac, av) + +int ac; + +char **av; + +{ + +register int i; + +register char *p; + +static char onechar[2] = "X"; + +FILE *opn(); + + + +argc = ac - 1; + +argv = av + 1; + + + +while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0') + + { + + for(p=argv[0]+1; *p; ++p) switch(*p) + + { + + case 'w': + + wordflag = YES; + + break; + + default: + + onechar[0] = *p; + + fatal("Invalid flag %s\n", onechar); + + } + + --argc; + + ++argv; + + } + + + +if(argc == 0) + + infile = stdin; + +else { + + infile = opn(argv[0]); + + --argc; + + ++argv; + + } + + + +files[0] = infile; + +filesp = &files[0]; + + + +for(i='a'; i<='z' ; ++i) + + chars[i] = LETTER; + +for(i='A'; i<='Z'; ++i) + + chars[i] = LETTER; + +for(i='0'; i<='9'; ++i) + + chars[i] = DIGIT; + +chars['\''] = APOS; + +chars['&'] = APOS; + + + +work(); + +} + + + + + + + +skeqn() + +{ + +while((c = getc(infile)) != rdelim) + + if(c == EOF) + + c = eof(); + + else if(c == '"') + + while( (c = getc(infile)) != '"') + + if(c == EOF) + + c = eof(); + + else if(c == '\\') + + if((c = getc(infile)) == EOF) + + c = eof(); + +return(C); + +} + + + + + +FILE *opn(p) + +register char *p; + +{ + +FILE *fd; + + + +if(p[0]=='-' && p[1]=='\0') + + fd = stdin; + +else if( (fd = fopen(p, "r")) == NULL) + + fatal("Cannot open file %s\n", p); + + + +return(fd); + +} + + + + + + + +eof() + +{ + +if(infile != stdin) + + fclose(infile); + +if(filesp > files) + + infile = *--filesp; + +else if(argc > 0) + + { + + infile = opn(argv[0]); + + --argc; + + ++argv; + + } + +else + + exit(0); + + + +return(C); + +} + + + + + + + +getfname() + +{ + +register char *p; + +struct chain { struct chain *nextp; char *datap; } *chainblock; + +register struct chain *q; + +static struct chain *namechain = NULL; + +char *copys(); + + + +while(C == ' ') ; + + + +for(p = fname ; (*p=c)!= '\n' && c!=' ' && c!='\t' && c!='\\' ; ++p) + + C; + +*p = '\0'; + +while(c != '\n') + + C; + + + +/* see if this name has already been used */ + + + +for(q = namechain ; q; q = q->nextp) + + if( ! strcmp(fname, q->datap)) + + { + + fname[0] = '\0'; + + return; + + } + + + +q = (struct chain *) calloc(1, sizeof(*chainblock)); + +q->nextp = namechain; + +q->datap = copys(fname); + +namechain = q; + +} + + + + + + + + + +fatal(s,p) + +char *s, *p; + +{ + +fprintf(stderr, "Deroff: "); + +fprintf(stderr, s, p); + +exit(1); + +} + + + +work() + +{ + + + +for( ;; ) + + { + + if(C == '.' || c == '\'') + + comline(); + + else + + regline(NO); + + } + +} + + + + + + + + + +regline(macline) + +int macline; + +{ + +line[0] = c; + +lp = line; + +for( ; ; ) + + { + + if(c == '\\') + + { + + *lp = ' '; + + backsl(); + + } + + if(c == '\n') break; + + if(intable && c=='T') + + { + + *++lp = C; + + if(c=='{' || c=='}') + + { + + lp[-1] = ' '; + + *lp = C; + + } + + } + + else *++lp = C; + + } + + + +*lp = '\0'; + + + +if(line[0] != '\0') + + if(wordflag) + + putwords(macline); + + else if(macline) + + putmac(line); + + else + + puts(line); + +} + + + + + + + + + +putmac(s) + +register char *s; + +{ + +register char *t; + + + +while(*s) + + { + + while(*s==' ' || *s=='\t') + + putchar(*s++); + + for(t = s ; *t!=' ' && *t!='\t' && *t!='\0' ; ++t) + + ; + + if(t>s+2 && chars[ s[0] ]==LETTER && chars[ s[1] ]==LETTER) + + while(s < t) + + putchar(*s++); + + else + + s = t; + + } + +putchar('\n'); + +} + + + + + + + +putwords(macline) /* break into words for -w option */ + +int macline; + +{ + +register char *p, *p1; + +int i, nlet; + + + + + +for(p1 = line ; ;) + + { + + /* skip initial specials ampersands and apostrophes */ + + while( chars[*p1] < DIGIT) + + if(*p1++ == '\0') return; + + nlet = 0; + + for(p = p1 ; (i=chars[*p]) != SPECIAL ; ++p) + + if(i == LETTER) ++nlet; + + + + if( (!macline && nlet>1) /* MDM definition of word */ + + || (macline && nlet>2 && chars[ p1[0] ]==LETTER && chars[ p1[1] ]==LETTER) ) + + { + + /* delete trailing ampersands and apostrophes */ + + while(p[-1]=='\'' || p[-1]=='&') + + --p; + + while(p1 < p) putchar(*p1++); + + putchar('\n'); + + } + + else + + p1 = p; + + } + +} + + + + + + + +comline() + +{ + +register int c1, c2; + + + +while(C==' ' || c=='\t') + + ; + +if( (c1=c) == '\n') + + return; + +if(c1 == '.') + + { + + inmacro = NO; + + SKIP; + + return; + + } + +if( (c2=C) == '\n') + + return; + + + +if(c1=='E' && c2=='Q' && filesp==files) + + eqn(); + +else if(c1=='T' && (c2=='S' || c2=='C' || c2=='&') && filesp==files) + + tbl(); + +else if(c1=='T' && c2=='E') + + intable = NO; + +else if(!inmacro && c1=='d' && c2=='e') + + macro(); + +else if(!inmacro && c1=='i' && c2=='g') + + macro(); + +else if(!inmacro && c1=='a' && c2 == 'm') + + macro(); + +else if(c1=='s' && c2=='o') + + { + + getfname(); + + if( fname[0] ) + + infile = *++filesp = opn( fname ); + + } + +else if(c1=='n' && c2=='x') + + { + + getfname(); + + if(fname[0] == '\0') exit(0); + + if(infile != stdin) + + fclose(infile); + + infile = *filesp = opn(fname); + + } + +else if(c1=='h' && c2=='w') + + { SKIP; } + +else + + { + + ++inmacro; + + regline(YES); + + --inmacro; + + } + +} + + + + + + + +macro() + +{ + +/* + +do { SKIP; } + + while(C!='.' || C!='.'); /* look for .EN */ + +SKIP; + +inmacro = YES; + +} + + + + + + + + + +tbl() + +{ + +while(C != '.'); + +SKIP; + +intable = YES; + +} + + + +eqn() + +{ + +register int c1, c2; + + + +SKIP; + + + +for( ;;) + + { + + if(C == '.' || c == '\'') + + { + + while(C==' ' || c=='\t') + + ; + + if(c=='E' && C=='N') + + { + + SKIP; + + return; + + } + + } + + else if(c == 'd') /* look for delim */ + + { + + if(C=='e' && C=='l') + + if( C=='i' && C=='m') + + { + + while(C1 == ' '); + + if((c1=c)=='\n' || (c2=C1)=='\n' + + || (c1=='o' && c2=='f' && C1=='f') ) + + { + + ldelim = NOCHAR; + + rdelim = NOCHAR; + + } + + else { + + ldelim = c1; + + rdelim = c2; + + } + + } + + } + + + + if(c != '\n') SKIP; + + } + +} + + + + + + + +backsl() /* skip over a complete backslash construction */ + +{ + +int bdelim; + + + +sw: switch(C) + + { + + case '"': + + SKIP; + + return; + + case 's': + + if(C == '\\') backsl(); + + else { + + while(C>='0' && c<='9') ; + + ungetc(c,infile); + + c = '0'; + + } + + --lp; + + return; + + + + case 'f': + + case 'n': + + case '*': + + if(C != '(') + + return; + + + + case '(': + + if(C != '\n') C; + + return; + + + + case '$': + + C; /* discard argument number */ + + return; + + + + case 'b': + + case 'x': + + case 'v': + + case 'h': + + case 'w': + + case 'o': + + case 'l': + + case 'L': + + if( (bdelim=C) == '\n') + + return; + + while(C!='\n' && c!=bdelim) + + if(c == '\\') backsl(); + + return; + + + + case '\\': + + if(inmacro) + + goto sw; + + default: + + return; + + } + +} + + + + + + + + + +char *copys(s) + +register char *s; + +{ + +register char *t, *t0; + + + +if( (t0 = t = calloc( strlen(s)+1, sizeof(*t) ) ) == NULL) + + fatal("Cannot allocate memory", (char *) NULL); + + + +while( *t++ = *s++ ) + + ; + +return(t0); + +} diff --cc usr/src/cmd/df.c index 0000000000,09b24f9625,0000000000..2dfd7b4c7b mode 000000,100644,000000..100644 --- a/usr/src/cmd/df.c +++ b/usr/src/cmd/df.c @@@@ -1,0 -1,97 -1,0 +1,228 @@@@ +++static char *sccsid = "@(#)df.c 4.3 (Berkeley) 10/15/80"; + +#include +++#include + +#include + +#include + +#include +++#include +++/* +++ * df +++ */ +++ +++#define NFS 20 /* Max number of filesystems */ +++ +++struct { +++ char path[32]; +++ char spec[32]; +++} mtab[NFS]; +++char root[32]; +++ +++char *mpath(); + + + +daddr_t blkno = 1; - char *dargv[] = { - 0, - "/dev/rp0a", - "/dev/rp2a", - "/dev/rp2h", - 0 - }; + + +++int lflag; +++int iflag; + + + +struct filsys sblock; + + + +int fi; + +daddr_t alloc(); + + + +main(argc, argv) + +char **argv; + +{ + + int i; +++ char buf[128]; +++ +++ while (argc >= 1 && argv[1][0]=='-') { +++ switch(argv[1][1]) { +++ +++ case 'l': +++ lflag++; +++ break; +++ +++ case 'i': +++ iflag++; +++ break; + + +++ default: +++ fprintf(stderr, "usage: df [ -il ] [ filsys... ]\n"); +++ exit(0); +++ } +++ argc--, argv++; +++ } +++ +++ if ((i=open("/etc/mtab", 0)) >= 0) { +++ read(i, mtab, sizeof mtab); /* Probably returns short */ +++ close(i); +++ } +++ printf("Filesystem Mounted on blocks\t used\t free"); +++ if (lflag) +++ printf("\thardway"); +++ printf("\t%% used"); +++ if (iflag) +++ printf("\tiused\tifree\t%%iused"); +++ putchar('\n'); + + if(argc <= 1) { - for(argc = 1; dargv[argc]; argc++); - argv = dargv; +++ struct fstab *fsp; +++ if (setfsent() == 0) +++ perror(FSTAB), exit(1); +++ while( (fsp = getfsent()) != 0){ +++ if ( (strcmp(fsp->fs_type, FSTAB_RW) != 0) +++ &&(strcmp(fsp->fs_type, FSTAB_RO) != 0) ) +++ continue; +++ if (root[0] == 0) +++ strcpy(root, fsp->fs_spec); +++ dfree(fsp->fs_spec); +++ } +++ endfsent(); +++ exit(0); + + } + + + + for(i=1; i=NICFREE) { + + printf("bad free count, b=%D\n", blkno); + + return(0); + + } + + b = sblock.s_free[i]; + + if(b == 0) + + return(0); + + if(b=sblock.s_fsize) { + + printf("bad free block (%D)\n", b); + + return(0); + + } + + if(sblock.s_nfree <= 0) { + + bread(b, (char *)&buf, sizeof(buf)); + + blkno = b; + + sblock.s_nfree = buf.df_nfree; + + for(i=0; i 2 && argv[0][0] == '-') { +++ argp = &argv[0][1]; +++ argv++, argc--; +++ while (*argp) switch(*argp++) { +++ +++#ifdef notdef +++ case 'I': +++ opt = D_IFDEF; +++ wantelses = 0; +++ continue; +++ case 'E': +++ opt = D_IFDEF; +++ wantelses = 1; +++ continue; +++ case '1': +++ opt = D_IFDEF; +++ ifdef1 = argp; +++ *--argp = 0; +++ continue; +++#endif +++ case 'D': +++ /* -Dfoo = -E -1 -2foo */ +++ wantelses = 1; +++ ifdef1 = ""; +++ /* fall through */ +++#ifdef notdef +++ case '2': +++#endif +++ opt = D_IFDEF; +++ ifdef2 = argp; +++ *--argp = 0; +++ continue; +++ case 'e': +++ opt = D_EDIT; +++ continue; +++ case 'f': +++ opt = D_REVERSE; +++ continue; +++ case 'b': +++ bflag = 1; +++ continue; +++ case 'c': +++ opt = D_CONTEXT; +++ if (isdigit(*argp)) { +++ context = atoi(argp); +++ while (isdigit(*argp)) +++ argp++; +++ if (*argp) { +++ fprintf(stderr, +++ "diff: -c: bad count\n"); +++ done(); +++ } +++ argp = ""; +++ } else +++ context = 3; +++ continue; +++ case 'h': +++ hflag++; +++ continue; +++ case 'S': +++ if (*argp == 0) { +++ fprintf(stderr, "diff: use -Sstart\n"); +++ done(); +++ } +++ start = argp; +++ *--argp = 0; /* don't pass it on */ +++ continue; +++ case 'r': +++ rflag++; +++ continue; +++ case 's': +++ sflag++; +++ continue; +++ case 'l': +++ lflag++; +++ continue; +++ default: +++ fprintf(stderr, "diff: -%s: unknown option\n", +++ --argp); +++ done(); +++ } +++ } +++ if (argc != 2) { +++ fprintf(stderr, "diff: two filename arguments required\n"); +++ done(); +++ } +++ file1 = argv[0]; +++ file2 = argv[1]; +++ if (hflag && opt) { +++ fprintf(stderr, +++ "diff: -h doesn't support -e, -f, -c, or -I\n"); +++ done(); +++ } +++ if (!strcmp(file1, "-")) +++ stb1.st_mode = S_IFREG; +++ else if (stat(file1, &stb1) < 0) { +++ fprintf(stderr, "diff: "); +++ perror(file1); +++ done(); +++ } +++ if (!strcmp(file2, "-")) +++ stb2.st_mode = S_IFREG; +++ else if (stat(file2, &stb2) < 0) { +++ fprintf(stderr, "diff: "); +++ perror(file2); +++ done(); +++ } +++ if ((stb1.st_mode & S_IFMT) == S_IFDIR && +++ (stb2.st_mode & S_IFMT) == S_IFDIR) { +++ diffdir(argv); +++ } else +++ diffreg(); +++ done(); +++} +++ +++char * +++savestr(cp) +++ register char *cp; +++{ +++ register char *dp = malloc(strlen(cp)+1); +++ +++ if (dp == 0) { +++ fprintf(stderr, "diff: ran out of memory\n"); +++ done(); +++ } +++ strcpy(dp, cp); +++ return (dp); +++} +++ +++min(a,b) +++ int a,b; +++{ +++ +++ return (a < b ? a : b); +++} +++ +++max(a,b) +++ int a,b; +++{ +++ +++ return (a > b ? a : b); +++} +++ +++done() +++{ +++ unlink(tempfile); +++ exit(status); +++} +++ +++char * +++talloc(n) +++{ +++ register char *p; +++ p = malloc((unsigned)n); +++ if(p!=NULL) +++ return(p); +++ noroom(); +++} +++ +++char * +++ralloc(p,n) /*compacting reallocation */ +++char *p; +++{ +++ register char *q; +++ char *realloc(); +++ free(p); +++ free(dummy); +++ dummy = malloc(1); +++ q = realloc(p, (unsigned)n); +++ if(q==NULL) +++ noroom(); +++ return(q); +++} +++ +++noroom() +++{ +++ fprintf(stderr, "diff: files too big, try -h\n"); +++ done(); +++} diff --cc usr/src/cmd/diff/diff.h index 0000000000,0000000000,0000000000..70405e0137 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/diff/diff.h @@@@ -1,0 -1,0 -1,0 +1,86 @@@@ +++/* @(#)diff.h 4.1 10/9/80" */ +++ +++/* +++ * diff - common declarations +++ */ +++ +++#include +++#include +++#include +++#include +++#include +++#include +++ +++/* +++ * Output format options +++ */ +++int opt; +++ +++#define D_NORMAL 0 /* Normal output */ +++#define D_EDIT -1 /* Editor script out */ +++#define D_REVERSE 1 /* Reverse editor script */ +++#define D_CONTEXT 2 /* Diff with context */ +++#define D_IFDEF 3 /* Diff with merged #ifdef's */ +++ +++/* +++ * Algorithm related options +++ */ +++int hflag; /* -h, use halfhearted DIFFH */ +++int bflag; /* ignore blanks in comparisions */ +++ +++/* +++ * Options on hierarchical diffs. +++ */ +++int lflag; /* long output format with header */ +++int rflag; /* recursively trace directories */ +++int sflag; /* announce files which are same */ +++char *start; /* do file only if name >= this */ +++ +++/* +++ * Variables for -I D_IFDEF option. +++ */ +++int wantelses; /* -E */ +++char *ifdef1; /* String for -1 */ +++char *ifdef2; /* String for -2 */ +++char *endifname; /* What we will print on next #endif */ +++int inifdef; +++ +++/* +++ * Variables for -c context option. +++ */ +++int context; /* lines of context to be printed */ +++ +++/* +++ * State for exit status. +++ */ +++int status; +++int anychange; +++char *tempfile; /* used when comparing against std input */ +++ +++/* +++ * Variables for diffdir. +++ */ +++char **diffargv; /* option list to pass to recursive diffs */ +++ +++/* +++ * Input file names. +++ * With diffdir, file1 and file2 are allocated BUFSIZ space, +++ * and padded with a '/', and then efile0 and efile1 point after +++ * the '/'. +++ */ +++char *file1, *file2, *efile1, *efile2; +++struct stat stb1, stb2; +++struct stat stb1, stb2; +++ +++/* +++ * This is allocated early, and used +++ * to reset the free storage pointer to effect space compaction. +++ */ +++char *dummy; +++ +++char *malloc(), *talloc(), *ralloc(); +++char *savestr(), *splice(), *splicen(); +++char *mktemp(), *copytemp(), *rindex(); +++int done(); +++ +++extern char diffh[], diff[], pr[]; diff --cc usr/src/cmd/diff/diffdir.c index 0000000000,0000000000,0000000000..de02af6f71 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/diff/diffdir.c @@@@ -1,0 -1,0 -1,0 +1,404 @@@@ +++static char sccsid[] = "@(#)diffdir.c 4.2 10/19/80"; +++ +++#include "diff.h" +++/* +++ * diff - directory comparison +++ */ +++#define d_flags d_ino +++ +++#define ONLY 1 /* Only in this directory */ +++#define SAME 2 /* Both places and same */ +++#define DIFFER 4 /* Both places and different */ +++#define DIRECT 8 /* Directory */ +++ +++struct direct *setupdir(); +++int header; +++char title[2*BUFSIZ], *etitle; +++ +++diffdir(argv) +++ char **argv; +++{ +++ register struct direct *d1, *d2; +++ struct direct *dir1, *dir2; +++ register int i; +++ int cmp; +++ +++ if (opt == D_IFDEF) { +++ fprintf(stderr, "diff: can't specify -I with directories\n"); +++ done(); +++ } +++ if (opt == D_EDIT && (sflag || lflag)) +++ fprintf(stderr, +++ "diff: warning: shouldn't give -s or -l with -e\n"); +++ title[0] = 0; +++ strcpy(title, "diff "); +++ for (i = 1; diffargv[i+2]; i++) { +++ if (!strcmp(diffargv[i], "-")) +++ continue; /* was -S, dont look silly */ +++ strcat(title, diffargv[i]); +++ strcat(title, " "); +++ } +++ for (etitle = title; *etitle; etitle++) +++ ; +++ setfile(&file1, &efile1, file1); +++ setfile(&file2, &efile2, file2); +++ argv[0] = file1; +++ argv[1] = file2; +++ dir1 = setupdir(file1); +++ dir2 = setupdir(file2); +++ d1 = dir1; d2 = dir2; +++ while (d1->d_name[0] != 0 || d2->d_name[0] != 0) { +++ if (d1->d_name[0] && useless(d1->d_name)) { +++ d1++; +++ continue; +++ } +++ if (d2->d_name[0] && useless(d2->d_name)) { +++ d2++; +++ continue; +++ } +++ if (d1->d_name[0] == 0) +++ cmp = 1; +++ else if (d2->d_name[0] == 0) +++ cmp = -1; +++ else +++ cmp = strncmp(d1->d_name, d2->d_name, DIRSIZ); +++ if (cmp < 0) { +++ if (lflag) +++ d1->d_flags |= ONLY; +++ else if (opt == 0 || opt == 2) { +++ only(d1, 1); +++ printf(": %.*s\n", DIRSIZ, d1->d_name); +++ } +++ d1++; +++ } else if (cmp == 0) { +++ compare(d1); +++ d1++; +++ d2++; +++ } else { +++ if (lflag) +++ d2->d_flags |= ONLY; +++ else if (opt == 0 || opt == 2) { +++ only(d2, 2); +++ printf(": %.*s\n", DIRSIZ, d2->d_name); +++ } +++ d2++; +++ } +++ } +++ if (lflag) { +++ scanpr(dir1, ONLY, "Only in %.*s", file1, efile1); +++ scanpr(dir2, ONLY, "Only in %.*s", file2, efile2); +++ scanpr(dir1, SAME, "Common identical files", 0, 0); +++ scanpr(dir1, DIFFER, "Binary files which differ", 0, 0); +++ scanpr(dir1, DIRECT, "Common subdirectories", 0, 0); +++ } +++ if (rflag) { +++ if (header && lflag) +++ printf("\f"); +++ for (d1 = dir1; d1->d_name[0]; d1++) { +++ if ((d1->d_flags & DIRECT) == 0) +++ continue; +++ strncpy(efile1, d1->d_name, DIRSIZ); +++ strncpy(efile2, d1->d_name, DIRSIZ); +++/* +++ if (opt != D_EDIT) { +++ *etitle = 0; +++ printf("%s%s %s\n", title, file1, file2); +++ } +++*/ +++ calldiff(0); +++ } +++ } +++} +++ +++setfile(fpp, epp, file) +++ char **fpp, **epp; +++ char *file; +++{ +++ register char *cp; +++ +++ *fpp = malloc(BUFSIZ); +++ if (*fpp == 0) { +++ fprintf(stderr, "diff: ran out of memory\n"); +++ exit(1); +++ } +++ strcpy(*fpp, file); +++ for (cp = *fpp; *cp; cp++) +++ continue; +++ *cp++ = '/'; +++ *epp = cp; +++} +++ +++scanpr(dp, test, title, file, efile) +++ register struct direct *dp; +++ int test; +++ char *title, *file, *efile; +++{ +++ int titled = 0; +++ +++ for (; dp->d_name[0]; dp++) +++ if (dp->d_flags & test) { +++ if (titled == 0) { +++ if (header == 0) { +++ if (anychange) +++ printf("\f"); +++ header = 1; +++ } else +++ printf("\n"); +++ printf(title, efile - file - 1, file); +++ printf(":\n"); +++ titled = 1; +++ } +++ ptname(dp); +++ } +++} +++ +++only(dp, which) +++ struct direct *dp; +++ int which; +++{ +++ char *file = which == 1 ? file1 : file2; +++ char *efile = which == 1 ? efile1 : efile2; +++ +++ printf("Only in %.*s", efile - file - 1, file, DIRSIZ, dp->d_name); +++} +++ +++ptname(dp) +++ struct direct *dp; +++{ +++ +++ printf("\t%.*s\n", DIRSIZ, dp->d_name); +++} +++ +++int entcmp(); +++ +++struct direct * +++setupdir(cp) +++ char *cp; +++{ +++ struct stat stb; +++ register struct direct *dp, *ep; +++ +++ close(0); +++ if (open(cp, 0) < 0) { +++ fprintf(stderr, "diff: "); +++ perror(cp); +++ done(); +++ } +++ fstat(0, &stb); +++ dp = (struct direct *)malloc(stb.st_size + sizeof (struct direct)); +++ if (dp == 0) { +++ fprintf(stderr, "diff: ran out of memory\n"); +++ done(); +++ } +++ if (read(0, (char *)dp, (short)stb.st_size) != (short)stb.st_size) { +++ fprintf(stderr, "diff: "); +++ perror(cp); +++ done(); +++ } +++ qsort(dp, stb.st_size / sizeof (struct direct), +++ sizeof (struct direct), entcmp); +++ ep = &dp[stb.st_size / sizeof (struct direct)]; +++ ep->d_name[0] = 0; +++ while (--ep >= dp && ep->d_ino == 0) +++ ep->d_name[0] = 0; +++ for (; ep >= dp; ep--) +++ ep->d_flags = 0; +++ return (dp); +++} +++ +++entcmp(d1, d2) +++ struct direct *d1, *d2; +++{ +++ +++ if (d1->d_ino == 0) +++ return (1); +++ if (d2->d_ino == 0) +++ return (-1); +++ return (strncmp(d1->d_name, d2->d_name, DIRSIZ)); +++} +++ +++compare(dp) +++ register struct direct *dp; +++{ +++ register int i, j; +++ int f1, f2, fmt1, fmt2; +++ struct stat stb1, stb2; +++ int flag = 0; +++ char buf1[BUFSIZ], buf2[BUFSIZ]; +++ +++ strncpy(efile1, dp->d_name, DIRSIZ); +++ strncpy(efile2, dp->d_name, DIRSIZ); +++ f1 = open(file1, 0); +++ if (f1 < 0) { +++ perror(file1); +++ return; +++ } +++ f2 = open(file2, 0); +++ if (f2 < 0) { +++ perror(file2); +++ close(f1); +++ return; +++ } +++ fstat(f1, &stb1); fstat(f2, &stb2); +++ fmt1 = stb1.st_mode & S_IFMT; +++ fmt2 = stb2.st_mode & S_IFMT; +++ if (fmt1 != S_IFREG || fmt2 != S_IFREG) { +++ if (fmt1 == fmt2) { +++ if (fmt1 != S_IFDIR && stb1.st_rdev == stb2.st_rdev) +++ goto same; +++ if (fmt1 == S_IFDIR) { +++ dp->d_flags = DIRECT; +++ if (lflag || opt == D_EDIT) +++ goto closem; +++ printf("Common subdirectories: %s and %s\n", +++ file1, file2); +++ goto closem; +++ } +++ } +++ goto notsame; +++ } +++ if (stb1.st_size != stb2.st_size) +++ goto notsame; +++ for (;;) { +++ i = read(f1, buf1, BUFSIZ); +++ j = read(f2, buf2, BUFSIZ); +++ if (i < 0 || j < 0 || i != j) +++ goto notsame; +++ if (i == 0 && j == 0) +++ goto same; +++ for (j = 0; j < i; j++) +++ if (buf1[j] != buf2[j]) +++ goto notsame; +++ } +++same: +++ if (sflag == 0) +++ goto closem; +++ if (lflag) +++ dp->d_flags = SAME; +++ else +++ printf("Files %s and %s are identical\n", file1, file2); +++ goto closem; +++notsame: +++ if (!ascii(f1) || !ascii(f2)) { +++ if (lflag) +++ dp->d_flags |= DIFFER; +++ else if (opt == D_NORMAL || opt == D_CONTEXT) +++ printf("Binary files %s and %s differ\n", +++ file1, file2); +++ goto closem; +++ } +++ close(f1); close(f2); +++ anychange = 1; +++ if (lflag) +++ calldiff(title); +++ else { +++ if (opt == D_EDIT) { +++ printf("ed - %.*s << '-*-END-*-'\n", +++ DIRSIZ, dp->d_name); +++ calldiff(0); +++ } else { +++ printf("%s%s %s\n", title, file1, file2); +++ calldiff(0); +++ } +++ if (opt == D_EDIT) +++ printf("w\nq\n-*-END-*-\n"); +++ } +++ return; +++closem: +++ close(f1); close(f2); +++} +++ +++char *prargs[] = { "pr", "-h", "-f", 0, 0 }; +++ +++calldiff(wantpr) +++ char *wantpr; +++{ +++ int pid, status, status2, pv[2]; +++ +++ prargs[3] = wantpr; +++ fflush(stdout); +++ if (wantpr) { +++ sprintf(etitle, "%s %s", file1, file2); +++ pipe(pv); +++ pid = fork(); +++ if (pid == -1) { +++ fprintf(stderr, "No more processes"); +++ done(); +++ } +++ if (pid == 0) { +++ close(0); +++ dup(pv[0]); +++ close(pv[0]); +++ close(pv[1]); +++ execv(pr+4, prargs); +++ execl(pr, prargs); +++ perror(pr); +++ done(); +++ } +++ } +++ pid = fork(); +++ if (pid == -1) { +++ fprintf(stderr, "diff: No more processes\n"); +++ done(); +++ } +++ if (pid == 0) { +++ if (wantpr) { +++ close(1); +++ dup(pv[1]); +++ close(pv[0]); +++ close(pv[1]); +++ } +++ execv(diff+4, diffargv); +++ execv(diff, diffargv); +++ perror(diff); +++ done(); +++ } +++ close(pv[0]); +++ close(pv[1]); +++ while (wait(&status) != pid) +++ continue; +++ while (wait(&status2) != -1) +++ continue; +++/* +++ if ((status >> 8) >= 2) +++ done(); +++*/ +++} +++ +++#include +++ +++ascii(f) +++ int f; +++{ +++ char buf[BUFSIZ]; +++ register int cnt; +++ register char *cp; +++ +++ lseek(f, (long)0, 0); +++ cnt = read(f, buf, BUFSIZ); +++ if (cnt >= sizeof (struct exec)) { +++ struct exec hdr; +++ hdr = *(struct exec *)buf; +++ if (!N_BADMAG(hdr)) +++ return (0); +++ } +++ cp = buf; +++ while (--cnt >= 0) +++ if (*cp++ & 0200) +++ return (0); +++ return (1); +++} +++ +++/* +++ * THIS IS CRUDE. +++ */ +++useless(cp) +++register char *cp; +++{ +++ +++ if (cp[0] == '.') +++ return (1); +++ if (start && strcmp(start, cp) > 0) +++ return (1); +++ return (0); +++} diff --cc usr/src/cmd/diff/diffh.c index 0000000000,0000000000,0000000000..525265cf95 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/diff/diffh.c @@@@ -1,0 -1,0 -1,0 +1,266 @@@@ +++static char sccsid[] = "@(#)diffh.c 4.1 10/9/80"; +++ +++#include +++#include +++#include +++#include +++ +++#define C 3 +++#define RANGE 30 +++#define LEN 255 +++#define INF 16384 +++ +++char *text[2][RANGE]; +++long lineno[2] = {1, 1}; /*no. of 1st stored line in each file*/ +++int ntext[2]; /*number of stored lines in each*/ +++long n0,n1; /*scan pointer in each*/ +++int bflag; +++int debug = 0; +++FILE *file[2]; +++ +++ /* return pointer to line n of file f*/ +++char *getl(f,n) +++long n; +++{ +++ register char *t; +++ char *malloc(); +++ register delta, nt; +++again: +++ delta = n - lineno[f]; +++ nt = ntext[f]; +++ if(delta<0) +++ progerr("1"); +++ if(deltant) +++ progerr("2"); +++ if(nt>=RANGE) +++ progerr("3"); +++ if(feof(file[f])) +++ return(NULL); +++ t = text[f][nt]; +++ if(t==0) { +++ t = text[f][nt] = malloc(LEN+1); +++ if(t==NULL) +++ if(hardsynch()) +++ goto again; +++ else +++ progerr("5"); +++ } +++ t = fgets(t,LEN,file[f]); +++ if(t!=NULL) +++ ntext[f]++; +++ return(t); +++} +++ +++ /*remove thru line n of file f from storage*/ +++clrl(f,n) +++long n; +++{ +++ register i,j; +++ j = n-lineno[f]+1; +++ for(i=0;i+j=0&&b>=0) +++ printf("---\n"); +++ for(i=0;i<=b;i++) { +++ s = getl(1,n1+i); +++ if(s==NULL) +++ break; +++ printf("> %s",s); +++ clrl(1,n1+i); +++ } +++ n1 += i-1; +++ return(1); +++} +++ +++change(a,b,c,d,s) +++long a,c; +++char *s; +++{ +++ range(a,b); +++ printf("%s",s); +++ range(c,d); +++ printf("\n"); +++} +++ +++range(a,b) +++long a; +++{ +++ if(b==INF) +++ printf("%ld,$",a); +++ else if(b==0) +++ printf("%ld",a); +++ else +++ printf("%ld,%ld",a,a+b); +++} +++ +++cmp(s,t) +++char *s,*t; +++{ +++ if(debug) +++ printf("%s:%s\n",s,t); +++ for(;;){ +++ if(bflag&&isspace(*s)&&isspace(*t)) { +++ while(isspace(*++s)) ; +++ while(isspace(*++t)) ; +++ } +++ if(*s!=*t||*s==0) +++ break; +++ s++; +++ t++; +++ } +++ return(*s-*t); +++} +++ +++FILE *dopen(f1,f2) +++char *f1,*f2; +++{ +++ FILE *f; +++ char b[100],*bptr,*eptr; +++ struct stat statbuf; +++ if(cmp(f1,"-")==0) +++ if(cmp(f2,"-")==0) +++ error("can't do - -",""); +++ else +++ return(stdin); +++ if(stat(f1,&statbuf)==-1) +++ error("can't access ",f1); +++ if((statbuf.st_mode&S_IFMT)==S_IFDIR) { +++ for(bptr=b;*bptr= *f1++;bptr++) ; +++ *bptr++ = '/'; +++ for(eptr=f2;*eptr;eptr++) +++ if(*eptr=='/'&&eptr[1]!=0&&eptr[1]!='/') +++ f2 = eptr+1; +++ while(*bptr++= *f2++) ; +++ f1 = b; +++ } +++ f = fopen(f1,"r"); +++ if(f==NULL) +++ error("can't open",f1); +++ return(f); +++} +++ +++ +++progerr(s) +++char *s; +++{ +++ error("program error ",s); +++} +++ +++error(s,t) +++char *s,*t; +++{ +++ fprintf(stderr,"diffh: %s%s\n",s,t); +++ exit(1); +++} +++ +++ /*stub for resychronization beyond limits of text buf*/ +++hardsynch() +++{ +++ change(n0,INF,n1,INF,"c"); +++ printf("---change record omitted\n"); +++ error("can't resynchronize",""); +++ return(0); +++} diff --cc usr/src/cmd/diff/diffreg.c index 0000000000,0000000000,0000000000..4363a383d4 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/diff/diffreg.c @@@@ -1,0 -1,0 -1,0 +1,715 @@@@ +++static char sccsid[] = "@(#)diffreg.c 4.1 10/9/80"; +++ +++#include "diff.h" +++/* +++ * diff - compare two files. +++ */ +++ +++/* +++ * Uses an algorithm due to Harold Stone, which finds +++ * a pair of longest identical subsequences in the two +++ * files. +++ * +++ * The major goal is to generate the match vector J. +++ * J[i] is the index of the line in file1 corresponding +++ * to line i file0. J[i] = 0 if there is no +++ * such line in file1. +++ * +++ * Lines are hashed so as to work in core. All potential +++ * matches are located by sorting the lines of each file +++ * on the hash (called ``value''). In particular, this +++ * collects the equivalence classes in file1 together. +++ * Subroutine equiv replaces the value of each line in +++ * file0 by the index of the first element of its +++ * matching equivalence in (the reordered) file1. +++ * To save space equiv squeezes file1 into a single +++ * array member in which the equivalence classes +++ * are simply concatenated, except that their first +++ * members are flagged by changing sign. +++ * +++ * Next the indices that point into member are unsorted into +++ * array class according to the original order of file0. +++ * +++ * The cleverness lies in routine stone. This marches +++ * through the lines of file0, developing a vector klist +++ * of "k-candidates". At step i a k-candidate is a matched +++ * pair of lines x,y (x in file0 y in file1) such that +++ * there is a common subsequence of length k +++ * between the first i lines of file0 and the first y +++ * lines of file1, but there is no such subsequence for +++ * any smaller y. x is the earliest possible mate to y +++ * that occurs in such a subsequence. +++ * +++ * Whenever any of the members of the equivalence class of +++ * lines in file1 matable to a line in file0 has serial number +++ * less than the y of some k-candidate, that k-candidate +++ * with the smallest such y is replaced. The new +++ * k-candidate is chained (via pred) to the current +++ * k-1 candidate so that the actual subsequence can +++ * be recovered. When a member has serial number greater +++ * that the y of all k-candidates, the klist is extended. +++ * At the end, the longest subsequence is pulled out +++ * and placed in the array J by unravel +++ * +++ * With J in hand, the matches there recorded are +++ * check'ed against reality to assure that no spurious +++ * matches have crept in due to hashing. If they have, +++ * they are broken, and "jackpot" is recorded--a harmless +++ * matter except that a true match for a spuriously +++ * mated line may now be unnecessarily reported as a change. +++ * +++ * Much of the complexity of the program comes simply +++ * from trying to minimize core utilization and +++ * maximize the range of doable problems by dynamically +++ * allocating what is needed and reusing what is not. +++ * The core requirements for problems larger than somewhat +++ * are (in words) 2*length(file0) + length(file1) + +++ * 3*(number of k-candidates installed), typically about +++ * 6n words for files of length n. +++ */ +++ +++#define prints(s) fputs(s,stdout) +++ +++FILE *input[2]; +++FILE *fopen(); +++ +++struct cand { +++ int x; +++ int y; +++ int pred; +++} cand; +++struct line { +++ int serial; +++ int value; +++} *file[2], line; +++int len[2]; +++struct line *sfile[2]; /* shortened by pruning common prefix and suffix */ +++int slen[2]; +++int pref, suff; /* length of prefix and suffix */ +++int *class; /* will be overlaid on file[0] */ +++int *member; /* will be overlaid on file[1] */ +++int *klist; /* will be overlaid on file[0] after class */ +++struct cand *clist; /* merely a free storage pot for candidates */ +++int clen = 0; +++int *J; /* will be overlaid on class */ +++long *ixold; /* will be overlaid on klist */ +++long *ixnew; /* will be overlaid on file[1] */ +++ +++diffreg() +++{ +++ register int k; +++ +++ if (hflag) { +++ diffargv[0] = "diffh"; +++ execv(diffh, diffargv); +++ fprintf(stderr, "diff: "); +++ perror(diffh); +++ done(); +++ } +++ dummy = malloc(1); +++ if ((stb1.st_mode & S_IFMT) == S_IFDIR) +++ file1 = splice(file1, file2); +++ else if ((stb2.st_mode & S_IFMT) == S_IFDIR) +++ file2 = splice(file2, file1); +++ else if (!strcmp(file1, "-")) { +++ if (!strcmp(file2, "-")) { +++ fprintf(stderr, "diff: can't specify - -\n"); +++ done(); +++ } +++ file1 = copytemp(); +++ } else if (!strcmp(file2, "-")) +++ file2 = copytemp(); +++ prepare(0, file1); +++ prepare(1, file2); +++ prune(); +++ sort(sfile[0],slen[0]); +++ sort(sfile[1],slen[1]); +++ +++ member = (int *)file[1]; +++ equiv(sfile[0], slen[0], sfile[1], slen[1], member); +++ member = (int *)ralloc((char *)member,(slen[1]+2)*sizeof(int)); +++ +++ class = (int *)file[0]; +++ unsort(sfile[0], slen[0], class); +++ class = (int *)ralloc((char *)class,(slen[0]+2)*sizeof(int)); +++ +++ klist = (int *)talloc((slen[0]+2)*sizeof(int)); +++ clist = (struct cand *)talloc(sizeof(cand)); +++ k = stone(class, slen[0], member, klist); +++ free((char *)member); +++ free((char *)class); +++ +++ J = (int *)talloc((len[0]+2)*sizeof(int)); +++ unravel(klist[k]); +++ free((char *)clist); +++ free((char *)klist); +++ +++ ixold = (long *)talloc((len[0]+2)*sizeof(long)); +++ ixnew = (long *)talloc((len[1]+2)*sizeof(long)); +++ check(); +++ output(); +++ status = anychange; +++ if (opt == D_CONTEXT && anychange == 0) +++ printf("No differences encountered\n"); +++ done(); +++} +++ +++char * +++copytemp() +++{ +++ char buf[BUFSIZ]; +++ register int i, f; +++ +++ signal(SIGHUP,done); +++ signal(SIGINT,done); +++ signal(SIGPIPE,done); +++ signal(SIGTERM,done); +++ tempfile = mktemp("/tmp/dXXXXX"); +++ f = creat(tempfile,0600); +++ if (f < 0) { +++ fprintf("diff: "); +++ perror(tempfile); +++ done(); +++ } +++ while ((i = read(0,buf,BUFSIZ)) > 0) +++ if (write(f,buf,i) != i) { +++ fprintf(stderr, "diff: "); +++ perror(tempfile); +++ done(); +++ } +++ close(f); +++ return (tempfile); +++} +++ +++char * +++splice(dir, file) +++ char *dir, *file; +++{ +++ char *tail; +++ char buf[BUFSIZ]; +++ +++ if (!strcmp(file, "-")) { +++ fprintf(stderr, "diff: can't specify - with other arg directory\n"); +++ done(); +++ } +++ tail = rindex(file, '/'); +++ if (tail == 0) +++ tail = file; +++ else +++ tail++; +++ sprintf(buf, "%s/%s", dir, tail); +++ return (savestr(buf)); +++} +++ +++prepare(i, arg) +++char *arg; +++{ +++ register struct line *p; +++ register j,h; +++ if((input[i] = fopen(arg,"r")) == NULL){ +++ fprintf(stderr, "diff: "); +++ perror(arg); +++ done(); +++ } +++ p = (struct line *)talloc(3*sizeof(line)); +++ for(j=0; h=readhash(input[i]);) { +++ p = (struct line *)ralloc((char *)p,(++j+3)*sizeof(line)); +++ p[j].value = h; +++ } +++ len[i] = j; +++ file[i] = p; +++ fclose(input[i]); +++} +++ +++prune() +++{ +++ register i,j; +++ for(pref=0;pref 0); +++ } +++ return(k); +++} +++ +++newcand(x,y,pred) +++{ +++ register struct cand *q; +++ clist = (struct cand *)ralloc((char *)clist,++clen*sizeof(cand)); +++ q = clist + clen -1; +++ q->x = x; +++ q->y = y; +++ q->pred = pred; +++ return(clen-1); +++} +++ +++search(c, k, y) +++int *c; +++{ +++ register int i, j, l; +++ int t; +++ if(clist[c[k]].y i) { +++ t = clist[c[l]].y; +++ if(t > y) +++ j = l; +++ else if(t < y) +++ i = l; +++ else +++ return(l); +++ } +++ return(l+1); +++} +++ +++unravel(p) +++{ +++ register int i; +++ register struct cand *q; +++ for(i=0; i<=len[0]; i++) +++ J[i] = i<=pref ? i: +++ i>len[0]-suff ? i+len[1]-len[0]: +++ 0; +++ for(q=clist+p;q->y!=0;q=clist+q->pred) +++ J[q->x+pref] = q->y+pref; +++} +++ +++/* check does double duty: +++1. ferret out any fortuitous correspondences due +++to confounding by hashing (which result in "jackpot") +++2. collect random access indexes to the two files */ +++ +++check() +++{ +++ register int i, j; +++ int jackpot; +++ long ctold, ctnew; +++ char c,d; +++ input[0] = fopen(file1,"r"); +++ input[1] = fopen(file2,"r"); +++ j = 1; +++ ixold[0] = ixnew[0] = 0; +++ jackpot = 0; +++ ctold = ctnew = 0; +++ for(i=1;i<=len[0];i++) { +++ if(J[i]==0) { +++ ixold[i] = ctold += skipline(0); +++ continue; +++ } +++ while(j a; ai -= m) { +++ aim = &ai[m]; +++ if(aim < ai) +++ break; /*wraparound*/ +++ if(aim->value > ai[0].value || +++ aim->value == ai[0].value && +++ aim->serial > ai[0].serial) +++ break; +++ w.value = ai[0].value; +++ ai[0].value = aim->value; +++ aim->value = w.value; +++ w.serial = ai[0].serial; +++ ai[0].serial = aim->serial; +++ aim->serial = w.serial; +++ } +++ } +++ } +++} +++ +++unsort(f, l, b) +++struct line *f; +++int *b; +++{ +++ register int *a; +++ register int i; +++ a = (int *)talloc((l+1)*sizeof(int)); +++ for(i=1;i<=l;i++) +++ a[f[i].serial] = f[i].value; +++ for(i=1;i<=l;i++) +++ b[i] = a[i]; +++ free((char *)a); +++} +++ +++skipline(f) +++{ +++ register i; +++ for(i=1;getc(input[f])!='\n';i++) ; +++ return(i); +++} +++ +++output() +++{ +++ int m; +++ register int i0, i1, j1; +++ int j0; +++ input[0] = fopen(file1,"r"); +++ input[1] = fopen(file2,"r"); +++ m = len[0]; +++ J[0] = 0; +++ J[m+1] = len[1]+1; +++ if(opt!=D_EDIT) for(i0=1;i0<=m;i0=i1+1) { +++ while(i0<=m&&J[i0]==J[i0-1]+1) i0++; +++ j0 = J[i0-1]+1; +++ i1 = i0-1; +++ while(i1=1;i0=i1-1) { +++ while(i0>=1&&J[i0]==J[i0+1]-1&&J[i0]!=0) i0--; +++ j0 = J[i0+1]-1; +++ i1 = i0+1; +++ while(i1>1&&J[i1-1]==0) i1--; +++ j1 = J[i1-1]+1; +++ J[i1] = j1; +++ change(i1,i0,j1,j0); +++ } +++ if(m==0) +++ change(1,0,1,len[1]); +++ if (opt==D_IFDEF) { +++ for (;;) { +++#define c i0 +++ c = getc(input[0]); +++ if (c < 0) +++ return; +++ putchar(c); +++ } +++#undef c +++ } +++} +++ +++/* indicate that there is a difference between lines a and b of the from file +++ to get to lines c to d of the to file. +++ If a is greater then b then there are no lines in the from file involved +++ and this means that there were lines appended (beginning at b). +++ If c is greater than d then there are lines missing from the to file. +++*/ +++change(a,b,c,d) +++{ +++ char ch; +++ int lowa,upb,lowc,upd; +++ struct stat stbuf; +++ +++ if (opt != D_IFDEF && a>b && c>d) +++ return; +++ if (anychange == 0) { +++ anychange = 1; +++ if(opt == D_CONTEXT) { +++ printf("*** %s ", file1); +++ stat(file1, &stbuf); +++ printf("%s--- %s ", +++ ctime(&stbuf.st_mtime), file2); +++ stat(file2, &stbuf); +++ printf("%s", ctime(&stbuf.st_mtime)); +++ } +++ } +++ if (a <= b && c <= d) +++ ch = 'c'; +++ else +++ ch = (a <= b) ? 'd' : 'a'; +++ if(opt == D_CONTEXT) { +++ lowa = max(1, a-context); +++ upb = min(len[0], b+context); +++ lowc = max(1, c-context); +++ upd = min(len[1], d+context); +++ +++ /* print out from file */ +++ printf("***************\n*** "); +++ range(lowa,upb,","); +++ printf("\n"); +++ if (ch == 'a') +++ fetch(ixold,lowa,upb,input[0]," "); +++ else { +++ fetch(ixold,lowa,a-1,input[0]," "); +++ fetch(ixold,a,b,input[0],ch == 'c' ? "! " : "- "); +++ fetch(ixold,b+1,upb,input[0]," "); +++ } +++ putchar('\n'); +++ printf("--- "); +++ range(lowc,upd,","); +++ printf(" -----\n"); +++ if (ch == 'd') +++ fetch(ixnew,lowc,upd,input[1]," "); +++ else { +++ fetch(ixnew,lowc,c-1,input[1]," "); +++ fetch(ixnew,c,d,input[1],ch == 'c' ? "! " : "+ "); +++ fetch(ixnew,d+1,upd,input[1]," "); +++ } +++ return; +++ } +++ switch (opt) { +++ +++ case D_NORMAL: +++ case D_EDIT: +++ range(a,b,","); +++ putchar(a>b?'a':c>d?'d':'c'); +++ if(opt==D_NORMAL) +++ range(c,d,","); +++ putchar('\n'); +++ break; +++ case D_REVERSE: +++ putchar(a>b?'a':c>d?'d':'c'); +++ range(a,b," "); +++ putchar('\n'); +++ break; +++ } +++ if(opt == D_NORMAL || opt == D_IFDEF) { +++ fetch(ixold,a,b,input[0],"< ", 1); +++ if(a<=b&&c<=d && opt == D_NORMAL) +++ prints("---\n"); +++ } +++ fetch(ixnew,c,d,input[1],opt==D_NORMAL?"> ":"", 0); +++ if ((opt ==D_EDIT || opt == D_REVERSE) && c<=d) +++ prints(".\n"); +++ if (inifdef) { +++ fprintf(stdout, "#endif %s\n", endifname); +++ inifdef = 0; +++ } +++} +++ +++range(a,b,separator) +++char *separator; +++{ +++ printf("%d", a>b?b:a); +++ if(ab), else to (nb: 0 vs 1 orig) */ +++ nc = f[a>b? b : a-1 ] - curpos; +++ for (i = 0; i < nc; i++) +++ putchar(getc(lb)); +++ } +++ if (a > b) +++ return; +++ if (opt == D_IFDEF) { +++ if (inifdef) +++ fprintf(stdout, "#else %s%s\n", oneflag && oldfile==1 ? "!" : "", ifdef2); +++ else { +++ if (oneflag) { +++ /* There was only one ifdef given */ +++ endifname = ifdef2; +++ if (oldfile) +++ fprintf(stdout, "#ifndef %s\n", endifname); +++ else +++ fprintf(stdout, "#ifdef %s\n", endifname); +++ } +++ else { +++ endifname = oldfile ? ifdef1 : ifdef2; +++ fprintf(stdout, "#ifdef %s\n", endifname); +++ } +++ } +++ inifdef = 1+oldfile; +++ } +++ for(i=a;i<=b;i++) { +++ fseek(lb,f[i-1],0); +++ nc = f[i]-f[i-1]; +++ if (opt != D_IFDEF) +++ prints(s); +++ for(j=0;j>HALFLONG) +++ +++/* +++ * hashing has the effect of +++ * arranging line in 7-bit bytes and then +++ * summing 1-s complement in 16-bit hunks +++ */ +++readhash(f) +++FILE *f; +++{ +++ long sum; +++ register unsigned shift; +++ register space; +++ register t; +++ sum = 1; +++ space = 0; +++ if(!bflag) for(shift=0;(t=getc(f))!='\n';shift+=7) { +++ if(t==-1) +++ return(0); +++ sum += (long)t << (shift%=HALFLONG); +++ } +++ else for(shift=0;;) { +++ switch(t=getc(f)) { +++ case -1: +++ return(0); +++ case '\t': +++ case ' ': +++ space++; +++ continue; +++ default: +++ if(space) { +++ shift += 7; +++ space = 0; +++ } +++ sum += (long)t << (shift%=HALFLONG); +++ shift += 7; +++ continue; +++ case '\n': +++ break; +++ } +++ break; +++ } +++ sum = low(sum) + high(sum); +++ return((short)low(sum) + (short)high(sum)); +++} diff --cc usr/src/cmd/dmesg.c index 0000000000,3b226479a4,0000000000..e929479e3d mode 000000,100755,000000..100644 --- a/usr/src/cmd/dmesg.c +++ b/usr/src/cmd/dmesg.c @@@@ -1,0 -1,126 -1,0 +1,128 @@@@ +++static char *sccsid = "@(#)dmesg.c 4.1 (Berkeley) 10/1/80"; + +/* + + * Suck up system messages + + * dmesg + + * print current buffer + + * dmesg - + + * print and update incremental history + + */ + + + +#include + +#include - #include +++#include + +#include + + + +char msgbuf[MSGBUFS]; + +char *msgbufp; + +int sflg; + +int of = -1; + + + +struct { + + char *omsgflg; + + int omindex; + + char omsgbuf[MSGBUFS]; + +} omesg; + +struct nlist nl[3] = { - {"_msgbuf"}, - {"_msgbufp"} +++ { "_msgbuf" }, +++ { "_msgbufp" }, +++ { 0 } + +}; + + + +main(argc, argv) + +char **argv; + +{ + + int mem; + + register char *mp, *omp, *mstart; + + int timeout(); + + int samef; + + + + signal(SIGALRM, timeout); + + alarm(30); + + if (argc>1 && argv[1][0] == '-') { + + sflg++; + + argc--; + + argv++; + + } + + if (sflg) + + of = open("/usr/adm/msgbuf", 2); + + read(of, (char *)&omesg, sizeof(omesg)); + + lseek(of, 0L, 0); + + sflg = 0; + + nlist(argc>2? argv[2]:"/vmunix", nl); + + if (nl[0].n_type==0) + + done("No namelist\n"); + + if ((mem = open((argc>1? argv[1]: "/dev/kmem"), 0)) < 0) + + done("No mem\n"); + + lseek(mem, (long)nl[0].n_value, 0); + + read(mem, msgbuf, MSGBUFS); + + lseek(mem, (long)nl[1].n_value, 0); + + read(mem, (char *)&msgbufp, sizeof(msgbufp)); + + if (msgbufp < (char *)nl[0].n_value || msgbufp >= (char *)nl[0].n_value+MSGBUFS) + + done("Namelist mismatch\n"); + + msgbufp += msgbuf - (char *)nl[0].n_value; + + mstart = &msgbuf[omesg.omindex]; + + omp = &omesg.omsgbuf[msgbufp-msgbuf]; + + mp = msgbufp; + + samef = 1; + + do { + + if (*mp++ != *omp++) { + + mstart = msgbufp; + + samef = 0; + + pdate(); + + printf("...\n"); + + break; + + } + + if (mp == &msgbuf[MSGBUFS]) + + mp = msgbuf; + + if (omp == &omesg.omsgbuf[MSGBUFS]) + + omp = omesg.omsgbuf; + + } while (mp != mstart); + + if (samef && mstart == msgbufp) + + exit(0); + + mp = mstart; + + do { + + pdate(); + + if (*mp) + + putchar(*mp); + + mp++; + + if (mp == &msgbuf[MSGBUFS]) + + mp = msgbuf; + + } while (mp != msgbufp); + + done((char *)NULL); + +} + + + +done(s) + +char *s; + +{ + + register char *p, *q; + + + + if (s && s!=omesg.omsgflg && sflg==0) { + + pdate(); + + printf(s); + + } + + omesg.omsgflg = s; + + q = omesg.omsgbuf; + + for (p = msgbuf; p < &msgbuf[MSGBUFS]; ) + + *q++ = *p++; + + omesg.omindex = msgbufp - msgbuf; + + write(of, (char *)&omesg, sizeof(omesg)); + + exit(s!=NULL); + +} + + + +pdate() + +{ + + extern char *ctime(); + + static firstime; + + time_t tbuf; + + + + if (firstime==0) { + + firstime++; + + time(&tbuf); + + printf("\n%.12s\n", ctime(&tbuf)+4); + + } + +} + + + +timeout() + +{ + + done("Buffer file screwed up\n"); + +} diff --cc usr/src/cmd/dnd.c index 0000000000,0000000000,0000000000..0f681e2428 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/dnd.c @@@@ -1,0 -1,0 -1,0 +1,403 @@@@ +++static char *sccsid ="@(#)dnd.c 4.3 (Berkeley) 11/4/80"; +++/* +++ * batch queue manager. by Greg Chesson. Modified to be +++ * a daemon managing requests to a multiple autodialers, by +++ * Keith Sklower. +++ */ +++#include +++#include +++#include +++#include +++#define QSIZE 16 +++#define DSIZE 40 +++ +++int xd; +++int dndebug = 1; /* we actually run debug = 1 */ +++int nactive; /* number running */ +++int max; /* max allowable */ +++int jobnum; +++char dialbuf[DSIZE]; +++char *dp = dialbuf; +++FILE *actfile; +++struct mx_leaves { +++ char *name; +++ char rack,modem; +++ short chan; +++ int file; +++} pdevs[] = {{"/dev/cua0",'4','0'}, {"/dev/cua1",'4','1'}, {0}}; +++/* the second line here is commented out because, +++ our 1200 baud dialer is being repaired, and if one attempts +++ to dial with a modem that is not capable, the dialer gets +++ hung and must be pulled out of the machine */ +++ +++struct actinfo { +++ short index; +++ short uid; +++} runq[QSIZE], xx; +++ +++#define INDEX(x) ((x&0xff00)>>4) +++ +++main(argc, argv) +++char **argv; +++{ +++register cc; +++char buf[512]; +++ +++ +++ setbuf(stdout, NULL); +++ umask(0); +++ /*if (argc<2) +++ quit("max jobs?"); +++ max = atoi(argv[1]);*/ max = 1; +++ if(fork()) +++ exit(0); +++ while(fork()) { +++ sleep(10); +++ wait(0); +++ } +++ strcpy(argv[0], "dnd-child"); +++ +++ xd = init(); +++ if (xd < 0) +++ quit("can't make node"); +++ +++ while( (cc=read(xd, buf, 512)) >= 0) { +++ unpack(buf, cc); +++ } +++ _exit(0); +++} +++ +++short noioctl = M_IOANS; +++control(x, cb, cc) +++register char *cb; +++{ +++register char *end; +++register struct chan *cp; +++int cmd, stat, ch; +++int uid; +++ +++ end = cb + cc; +++ while (cb < end ) { +++ cmd = *cb++; +++ cb++; +++ switch(cmd&0xff) { +++ case M_WATCH: +++ uid = *((short *)cb); +++ cb += sizeof(short); +++ putq(x,uid); +++ startjob(); +++ break; +++ case M_CLOSE: +++ stopjob(x); +++ break; +++ case M_IOCTL: +++ wctl(x,(char *)&noioctl,sizeof(noioctl)); +++ cb += sizeof(struct sgttyb); +++ } +++ } +++} +++ +++ +++ +++ +++startjob() +++{ +++register x, stat; +++ if (nactive >= max) +++ return; +++ +++ x = getq(); +++ if (x == 0) +++ return; +++ +++ stat = attach(x, xd); +++ if (stat == -1) +++ return; +++ nactive++; +++ printf("starting to dial on behalf of uid %d\n",xx.uid); +++ dp = dialbuf; +++} +++ +++stopjob(x) +++{ +++ detach(x, xd); +++ if (delq(x)) { +++ printf("channel %d aborted\n", INDEX(x)); +++ } else { +++ nactive--; +++ printf("channel %d finished\n", INDEX(x)); +++ } +++ startjob(); +++} +++ +++ +++/* +++ * make mpx node, open accounting file, and initialize queue. +++ */ +++init() +++{ +++register struct mx_leaves *lp; +++register int t; +++int xd; +++ +++ if(dndebug==0) +++ freopen(stdout,"/dev/null","w"); +++ if((actfile = fopen("/usr/adm/dnacct","a"))==NULL) +++ quit("Can't make accouting file"); +++ +++ for(t=QSIZE; --t>=0;) runq[t].uid = -1; +++ +++ xd = mpx("", 0666); +++ if(xd < 0) quit("Can't open master mpx node"); +++ +++ for(lp = pdevs; lp->name; lp++) { +++ t = mpx(lp->name, 0666); +++ if (t < 0) { +++ unlink(lp->name); +++ t = mpx(lp->name, 0666); +++ } +++ if(t < 0) quit("Can't make minor mpx node"); +++ lp->file = t; +++ if((t = join(t,xd)) == -1) quit("Can't attach to tree"); +++ else +++ printf("pseudo-device %s assigned channel %x\n",lp->name,t); +++ lp->chan = t; +++ } +++ return(xd); +++} +++ +++/* +++ * unpack an mpx buffer at +++ * bp of length cc. +++ */ +++unpack(bp, cc) +++register char *bp; +++{ +++register char *end; +++register struct rh *rp; +++ +++ end = bp + cc; +++ while (bp < end) { +++ rp = (struct rh *)bp; +++ bp += sizeof (struct rh); +++ +++ if (rp->count==0) { +++ control(rp->index, bp, rp->ccount); +++ } else +++ perform(rp,bp); +++ rp->count += rp->ccount; +++ if (rp->count & 1) +++ rp->count++; +++ bp += rp->count; +++ +++ } +++} +++/* transfer numbers to the unique dialer */ +++perform(rp,data) +++register struct rh *rp; +++register char *data; +++{ +++register char *lim; +++long clock; char c; +++char *mdata, *tmpt, *ctime(); +++struct passwd *getpwuid(); +++ if(rp->index!=xx.index) +++ printf("phase error: Writing data from chan %x on behalf of chan %x\n",rp->index,xx.index); +++ lim = rp->count + data; +++ mdata = data; +++ while(mdata< lim && dp < dialbuf+DSIZE) { +++ *dp++ = *mdata; +++ if(*mdata=='<') { +++ *dp++ = 0; +++ time(&clock); tmpt = ctime(&clock); tmpt[20] = 0; +++ if((c = dialit(dialbuf))=='A') +++ fprintf(actfile, "%s dialed %s at %s\n", +++ getpwuid(xx.uid)->pw_name,dialbuf,tmpt); +++ else printf("Dialer returns %c\n",c); +++ fflush(actfile); +++ dp = dialbuf; +++ stopjob(rp->index); +++ return; +++ } +++ mdata++; +++ } +++} +++quit(msg) +++char *msg; +++{ +++ printf("%s\n", msg); +++ exit(1); +++} +++ +++putq(x,uid) +++{ +++register i; +++ +++ for(i=0; ichan,xx.index)) +++ if(lp->name==0) { +++ printf("Unable to locate dialer, chan = %x\n",xx.index); +++ return('K'); +++ } else lp++; +++ pc(STX); pc(lp->rack); pc(lp->modem); +++ for(;*string && *string!='<'; string++) pc(*string); +++ /*for(;*string; string++) pc(*string);*/ +++ pc(SI); pc(ETX); +++ /*if(*string=='<') { +++ c = 'M'; +++ read(fd,&c,1); +++ if(c=='A'); +++ }*/ +++ if(read(fd,&c,1)!=1) c = 'M'; +++ if(c=='B'||c=='G') { +++ pc(ABORT); +++ read(fd,&cc,1); +++ } +++ out: +++ close(fd); +++ return(c); +++} +++char * +++sanitize(string) +++register char *string; +++{ +++ static char buf[512]; +++ register char *cp = buf; +++ for(;*string; string++) { +++ switch(*string) { +++ case '0': case '1': case '2': case '3': case '4': +++ case '5': case '6': case '7': case '8': case '9': case '<': +++ *cp++ = *string; +++ break; +++ case '_': +++ *cp++ = '='; +++ break; +++ } +++ } +++ *cp++ = 0; +++ return(buf); +++} +++/* Band-aid for hardware glitch - access forbidded to +++dialer while line in use */ +++char *DZ = "/dev/cul0"; +++#include +++#include +++jmp_buf handy; +++linebusy() { +++void catchit(); int fd; +++ signal(SIGALRM,catchit); +++ alarm(2); +++ if(setjmp(handy)==0) { +++ fd = open(DZ,2); +++ /* if we are there the open did not hang, so +++ we problem got the line was busy */ +++ if(fd > 0) { +++ alarm(0); +++ printf("open succeeded did not hang\n"); +++ close(fd); +++ } +++ printf("Line in use\n"); +++ return(1); /* line busy */ +++ } else +++ /* came in on interrupt */ +++ return(0); /* line is free, we did hang waiting for Carrier */ +++} +++void +++catchit(){ +++ longjmp(handy,1); +++} diff --cc usr/src/cmd/du.c index 0000000000,02656fdd69,0000000000..a9e33a139b mode 000000,100644,000000..100644 --- a/usr/src/cmd/du.c +++ b/usr/src/cmd/du.c @@@@ -1,0 -1,170 -1,0 +1,171 @@@@ +++static char *sccsid = "@(#)du.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +#include + +#define EQ(x,y) (strcmp(x,y)==0) + +#define ML 1000 + + + +struct stat Statb; + +char path[256], name[256]; + +int Aflag = 0, + + Sflag = 0, + + Noarg = 0; + +struct { + + int dev, + + ino; + +} ml[ML]; + +long descend(); + +char *rindex(); + +char *strcpy(); + + + +main(argc, argv) + +char **argv; + +{ + + register i = 1; + + long blocks = 0; + + register char *np; + + + + if (argc>1) { + + if(EQ(argv[i], "-s")) { + + ++i; + + ++Sflag; + + } else if(EQ(argv[i], "-a")) { + + ++i; + + ++Aflag; + + } + + } + + if(i == argc) + + ++Noarg; + + + + do { + + strcpy(path, Noarg? ".": argv[i]); + + strcpy(name, path); + + if(np = rindex(name, '/')) { + + *np++ = '\0'; + + if(chdir(*name? name: "/") == -1) { + + fprintf(stderr, "cannot chdir()\n"); + + exit(1); + + } + + } else + + np = path; + + blocks = descend(path, *np? np: "."); + + if(Sflag) + + printf("%ld %s\n", blocks, path); + + } while(++i < argc); + + + + exit(0); + +} + + + +long + +descend(np, fname) + +char *np, *fname; + +{ + + int dir = 0, /* open directory */ + + offset, + + dsize, + + entries, + + dirsize; + + + + struct direct dentry[BUFSIZ / sizeof (struct direct)]; + + register struct direct *dp; + + register char *c1, *c2; + + int i; + + char *endofname; + + long blocks = 0; + + + + if(stat(fname,&Statb)<0) { + + fprintf(stderr, "--bad status < %s >\n", name); + + return 0L; + + } + + if(Statb.st_nlink > 1 && (Statb.st_mode&S_IFMT)!=S_IFDIR) { + + static linked = 0; + + + + for(i = 0; i <= linked; ++i) { + + if(ml[i].ino==Statb.st_ino && ml[i].dev==Statb.st_dev) + + return 0; + + } + + if (linked < ML) { + + ml[linked].dev = Statb.st_dev; + + ml[linked].ino = Statb.st_ino; + + ++linked; + + } + + } + +/* + + blocks = (Statb.st_size + BSIZE-1) >> BSHIFT; + +*/ + + blocks = (Statb.st_size + 511) >> 9; + + + + if((Statb.st_mode&S_IFMT)!=S_IFDIR) { + + if(Aflag) + + printf("%ld %s\n", blocks, np); + + return(blocks); + + } + + + + for(c1 = np; *c1; ++c1); + + if(*(c1-1) == '/') + + --c1; + + endofname = c1; + + dirsize = Statb.st_size; + + if(chdir(fname) == -1) + + return 0; + + for(offset=0; offset < dirsize; offset += BUFSIZ) { /* each block */ + + dsize = BUFSIZ<(dirsize-offset)? BUFSIZ: (dirsize-offset); + + if(!dir) { + + if((dir=open(".",0))<0) { + + fprintf(stderr, "--cannot open < %s >\n", + + np); + + goto ret; + + } + + if(offset) lseek(dir, (long)offset, 0); + + if(read(dir, (char *)dentry, dsize)<0) { + + fprintf(stderr, "--cannot read < %s >\n", + + np); + + goto ret; + + } + + if(dir > 10) { + + close(dir); + + dir = 0; + + } + + } else + + if(read(dir, (char *)dentry, dsize)<0) { + + fprintf(stderr, "--cannot read < %s >\n", + + np); + + goto ret; + + } + + for(dp=dentry, entries=dsize>>4; entries; --entries, ++dp) { + + /* each directory entry */ + + if(dp->d_ino==0 + + || EQ(dp->d_name, ".") + + || EQ(dp->d_name, "..")) + + continue; + + c1 = endofname; + + *c1++ = '/'; + + c2 = dp->d_name; + + for(i=0; i\n", np); + + while(*--endofname != '/'); + + *endofname = '\0'; + + if(chdir(np) == -1) + + exit(1); + + } + + return(blocks); + +} diff --cc usr/src/cmd/dump/Makefile index 0000000000,0000000000,0000000000..0eef23412f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/dump/Makefile @@@@ -1,0 -1,0 -1,0 +1,41 @@@@ +++# sccsid = "@(#)Makefile 1.2 (Berkeley) 10/18/80" +++# +++# dump.h header file +++# dumpitime.c reads /etc/ddate +++# dumpmain.c driver +++# dumpoptr.c operator interface +++# dumptape.c handles the mag tape and opening/closing +++# dumptraverse.c traverses the file system +++# unctime.c undo ctime +++# +++# DEBUG use local directory to find ddate and dumpdates +++# TDEBUG trace out the process forking +++# +++PSRCS = \ +++ dump.h dumpmain.c dumptraverse.c dumptape.c dumpoptr.c dumpitime.c +++ +++SRCS = \ +++ dump.h dumpitime.c \ +++ dumpmain.c dumpoptr.c dumptape.c \ +++ dumptraverse.c unctime.c +++ +++OBJS = \ +++ dumpitime.o \ +++ dumpmain.o dumpoptr.o \ +++ dumptape.o dumptraverse.o unctime.o +++ +++DFLAGS = -DERNIE +++CFLAGS = -O $(DFLAGS) +++ +++dump: $(OBJS) +++ $(CC) $(CFLAGS) $(OBJS) -o dump +++install: +++ install -s dump $(DESTDIR)/etc +++clean: +++ rm -f *.o dump +++ +++lint: +++ lint $(DFLAGS) $(SRCS) +++ +++psrcs: +++ echo $(PSRCS) diff --cc usr/src/cmd/dump/dump.h index 0000000000,0000000000,0000000000..9acdb2aadb new file mode 100644 --- /dev/null +++ b/usr/src/cmd/dump/dump.h @@@@ -1,0 -1,0 -1,0 +1,131 @@@@ +++/* +++ * "@(#)dump.h 1.1 (Berkeley) 10/13/80" +++ */ +++#define NI 16 +++#define DIRPB (BSIZE/sizeof(struct direct)) +++ +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++ +++#define MWORD(m,i) (m[(unsigned)(i-1)/MLEN]) +++#define MBIT(i) (1<<((unsigned)(i-1)%MLEN)) +++#define BIS(i,w) (MWORD(w,i) |= MBIT(i)) +++#define BIC(i,w) (MWORD(w,i) &= ~MBIT(i)) +++#define BIT(i,w) (MWORD(w,i) & MBIT(i)) +++ +++short clrmap[MSIZ]; +++short dirmap[MSIZ]; +++short nodmap[MSIZ]; +++ +++/* +++ * All calculations done in 0.1" units! +++ */ +++ +++char *disk; /* name of the disk file */ +++char *tape; /* name of the tape file */ +++char *increm; /* name of the file containing incremental information*/ +++char incno; /* increment number */ +++int uflag; /* update flag */ +++int fi; /* disk file descriptor */ +++int to; /* tape file descriptor */ +++ino_t ino; /* current inumber; used globally */ +++int nsubdir; +++int newtape; /* new tape flag */ +++int nadded; /* number of added sub directories */ +++int dadded; /* directory added flag */ +++int density; /* density in 0.1" units */ +++long tsize; /* tape size in 0.1" units */ +++long esize; /* estimated tape size, blocks */ +++long asize; /* number of 0.1" units written on current tape */ +++int etapes; /* estimated number of tapes */ +++ +++int notify; /* notify operator flag */ +++int blockswritten; /* number of blocks written on current tape */ +++int tapeno; /* current tape number */ +++time_t tstart_writing; /* when started writing the first tape block */ +++char *processname; +++ +++char *ctime(); +++char *prdate(); +++long atol(); +++int mark(); +++int add(); +++int dump(); +++int tapsrec(); +++int dmpspc(); +++int dsrch(); +++int nullf(); +++char *getsuffix(); +++char *rawname(); +++ +++int interrupt(); /* in case operator bangs on console */ +++ +++#define HOUR (60L*60L) +++#define DAY (24L*HOUR) +++#define YEAR (365L*DAY) +++ +++/* +++ * Exit status codes +++ */ +++#define X_FINOK 1 /* normal exit */ +++#define X_REWRITE 2 /* restart writing from the check point */ +++#define X_ABORT 3 /* abort all of dump; don't attempt checkpointing*/ +++ +++#ifdef DEBUG +++#define OINCREM "./ddate" /*old format incremental info*/ +++#define NINCREM "./dumpdates" /*new format incremental info*/ +++#else not DEBUG +++#define OINCREM "/etc/ddate" /*old format incremental info*/ +++#define NINCREM "/etc/dumpdates" /*new format incremental info*/ +++#endif +++ +++#define TAPE "/dev/rmt8" /* default tape device */ +++#define DISK "/dev/rrp1g" /* default disk */ +++#define OPGRENT "operator" /* group entry to notify */ +++#define DIALUP "ttyd" /* prefix for dialups */ +++ +++#define MAXFSTAB 32 +++struct fstab fstab[MAXFSTAB]; +++struct fstab *fstabsearch(); /* search in fs_file and fs_spec */ +++int nfstab; +++ +++/* +++ * The contents of the file NINCREM is maintained both on +++ * a linked list, and then (eventually) arrayified. +++ */ +++struct itime{ +++ struct idates it_value; +++ struct itime *it_next; +++}; +++struct itime *ithead; /* head of the list version */ +++int nidates; /* number of records (might be zero) */ +++int idates_in; /* we have read the increment file */ +++struct idates **idatev; /* the arrayfied version */ +++#define ITITERATE(i, ip) for (i = 0,ip = idatev[0]; i < nidates; i++, ip = idatev[i]) +++ +++/* +++ * We catch these interrupts +++ */ +++int sighup(); +++int sigquit(); +++int sigill(); +++int sigtrap(); +++int sigfpe(); +++int sigkill(); +++int sigbus(); +++int sigsegv(); +++int sigsys(); +++int sigalrm(); +++int sigterm(); diff --cc usr/src/cmd/dump/dumpitime.c index 0000000000,0000000000,0000000000..956103df21 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/dump/dumpitime.c @@@@ -1,0 -1,0 -1,0 +1,245 @@@@ +++static char *sccsid = "@(#)dumpitime.c 1.1 (Berkeley) 10/13/80"; +++#include "dump.h" +++ +++char *prdate(d) +++ time_t d; +++{ +++ char *p; +++ +++ if(d == 0) +++ return("the epoch"); +++ p = ctime(&d); +++ p[24] = 0; +++ return(p); +++} +++ +++struct idates **idatev = 0; +++int nidates = 0; +++int idates_in = 0; +++struct itime *ithead = 0; +++ +++inititimes() +++{ +++ FILE *df; +++ register int i; +++ register struct itime *itwalk; +++ +++ if (idates_in) +++ return; +++ if ( (df = fopen(increm, "r")) == NULL){ +++ nidates = 0; +++ ithead = 0; +++ } else { +++ do{ +++ itwalk=(struct itime *)calloc(1,sizeof (struct itime)); +++ if (getrecord(df, &(itwalk->it_value)) < 0) +++ break; +++ nidates++; +++ itwalk->it_next = ithead; +++ ithead = itwalk; +++ } while (1); +++ fclose(df); +++ } +++ +++ idates_in = 1; +++ /* +++ * arrayify the list, leaving enough room for the additional +++ * record that we may have to add to the idate structure +++ */ +++ idatev = (struct idates **)calloc(nidates + 1,sizeof (struct idates *)); +++ for (i = nidates-1, itwalk = ithead; i >= 0; i--, itwalk = itwalk->it_next) +++ idatev[i] = &itwalk->it_value; +++} +++ +++getitime() +++{ +++ register struct idates *ip; +++ register int i; +++ char *fname; +++ +++ fname = disk; +++#ifdef FDEBUG +++ msg("Looking for name %s in increm = %s for delta = %c\n", +++ fname, increm, incno); +++#endif +++ spcl.c_ddate = 0; +++ +++ inititimes(); +++ /* +++ * Go find the entry with the same name for a lower increment +++ * and older date +++ */ +++ ITITERATE(i, ip){ +++ if(strncmp(fname, ip->id_name, +++ sizeof (ip->id_name)) != 0) +++ continue; +++ if (ip->id_incno >= incno) +++ continue; +++ if (ip->id_ddate <= spcl.c_ddate) +++ continue; +++ spcl.c_ddate = ip->id_ddate; +++ } +++} +++ +++putitime() +++{ +++ FILE *df; +++ register struct idates *itwalk; +++ register int i; +++ char *fname; +++ +++ if(uflag == 0) +++ return; +++ fname = disk; +++ +++ spcl.c_ddate = 0; +++ ITITERATE(i, itwalk){ +++ if (strncmp(fname, itwalk->id_name, +++ sizeof (itwalk->id_name)) != 0) +++ continue; +++ if (itwalk->id_incno != incno) +++ continue; +++ goto found; +++ } +++ /* +++ * construct the new upper bound; +++ * Enough room has been allocated. +++ */ +++ itwalk = idatev[nidates] = +++ (struct idates *)calloc(1, sizeof(struct idates)); +++ nidates += 1; +++ found: +++ strncpy(itwalk->id_name, fname, sizeof (itwalk->id_name)); +++ itwalk->id_incno = incno; +++ itwalk->id_ddate = spcl.c_date; +++ +++ if ( (df = fopen(increm, "w")) == NULL){ +++ msg("Cannot open %s\n", increm); +++ dumpabort(); +++ } +++ ITITERATE(i, itwalk){ +++ recout(df, itwalk); +++ } +++ fclose(df); +++ msg("level %c dump on %s\n", incno, prdate(spcl.c_date)); +++} +++ +++recout(file, what) +++ FILE *file; +++ struct idates *what; +++{ +++ fprintf(file, DUMPOUTFMT, +++ what->id_name, +++ what->id_incno, +++ ctime(&(what->id_ddate)) +++ ); +++} +++ +++int recno; +++int getrecord(df, idatep) +++ FILE *df; +++ struct idates *idatep; +++{ +++ char buf[BUFSIZ]; +++ +++ recno = 0; +++ if ( (fgets(buf, BUFSIZ, df)) != buf) +++ return(-1); +++ recno++; +++ if (makeidate(idatep, buf) < 0) +++ msg("Unknown intermediate format in %s, line %d\n", +++ NINCREM, recno); +++ +++#ifdef FDEBUG +++ msg("getrecord: %s %c %s\n", +++ idatep->id_name, idatep->id_incno, prdate(idatep->id_ddate)); +++#endif +++ return(0); +++} +++ +++/* +++ * Convert from old format to new format +++ * Convert from /etc/ddate to /etc/dumpdates format +++ */ +++o_nconvert() +++{ +++ FILE *oldfile; +++ FILE *newfile; +++ struct idates idate; +++ struct idates idatecopy; +++ +++ if( (newfile = fopen(NINCREM, "w")) == NULL){ +++ msg("%s: Can not open %s to update.\n", processname, NINCREM); +++ Exit(X_ABORT); +++ } +++ if ( (oldfile = fopen(OINCREM, "r")) != NULL){ +++ while(!feof(oldfile)){ +++ if (fread(&idate, sizeof(idate), 1, oldfile) != 1) +++ break; +++ /* +++ * The old format ddate did not have +++ * the full special path name on it; +++ * we add the prefix /dev/ to the +++ * special name, although this may not be +++ * always the right thing to do. +++ */ +++ idatecopy = idate; +++ strcpy(idatecopy.id_name, "/dev/"); +++ strncat(idatecopy.id_name, idate.id_name, +++ sizeof(idate.id_name) - sizeof ("/dev/")); +++ recout(newfile, &idatecopy); +++ } +++ } +++ fclose(oldfile); +++ fclose(newfile); +++} +++ +++time_t unctime(); +++ +++int makeidate(ip, buf) +++ struct idates *ip; +++ char *buf; +++{ +++ char un_buf[128]; +++ +++ sscanf(buf, DUMPINFMT, ip->id_name, &ip->id_incno, un_buf); +++ ip->id_ddate = unctime(un_buf); +++ if (ip->id_ddate < 0) +++ return(-1); +++ return(0); +++} +++ +++est(ip) +++ struct dinode *ip; +++{ +++ long s; +++ +++ esize++; +++ s = (ip->di_size + BSIZE-1) / BSIZE; +++ esize += s; +++ if(s > NADDR-3) { +++ /* +++ * This code is only appproximate. +++ * it totally estimates low on doubly and triply indirect +++ * files. +++ */ +++ s -= NADDR-3; +++ s = (s + (BSIZE/sizeof(daddr_t))-1) / (BSIZE/sizeof(daddr_t)); +++ esize += s; +++ } +++} +++ +++bmapest(map) +++short *map; +++{ +++ register i, n; +++ +++ n = -1; +++ for(i=0; i 1) { +++ argv++; +++ argc--; +++ arg = *argv; +++ if (*arg == '-') +++ argc++; +++ } +++ while(*arg) +++ switch (*arg++) { +++ case 'w': +++ lastdump('w'); /* tell us only what has to be done */ +++ exit(0); +++ break; +++ case 'W': /* what to do */ +++ lastdump('W'); /* tell us the current state of what has been done */ +++ exit(0); /* do nothing else */ +++ break; +++ +++ case 'J': /* update old to new */ +++ o_nconvert(); +++ exit(0); /* do nothing else */ +++ break; +++ +++ case 'f': /* output file */ +++ if(argc > 1) { +++ argv++; +++ argc--; +++ tape = *argv; +++ } +++ break; +++ +++ case 'd': /* density, in bits per inch */ +++ if (argc > 1) { +++ argv++; +++ argc--; +++ density = atoi(*argv) / 10; +++ } +++ break; +++ +++ case 's': /* tape size, feet */ +++ if(argc > 1) { +++ argv++; +++ argc--; +++ tsize = atol(*argv); +++ tsize *= 12L*10L; +++ } +++ break; +++ +++ case '0': /* dump level */ +++ case '1': +++ case '2': +++ case '3': +++ case '4': +++ case '5': +++ case '6': +++ case '7': +++ case '8': +++ case '9': +++ incno = arg[-1]; +++ break; +++ +++ case 'u': /* update /etc/dumpdates */ +++ uflag++; +++ break; +++ +++ case 'n': /* notify operators */ +++ notify++; +++ break; +++ +++ default: +++ printf("bad key '%c%'\n", arg[-1]); +++ Exit(X_ABORT); +++ } +++ if(argc > 1) { +++ argv++; +++ argc--; +++ disk = *argv; +++ } +++ +++ if (signal(SIGHUP, sighup) == SIG_IGN) +++ signal(SIGHUP, SIG_IGN); +++ if (signal(SIGTRAP, sigtrap) == SIG_IGN) +++ signal(SIGTRAP, SIG_IGN); +++ if (signal(SIGFPE, sigfpe) == SIG_IGN) +++ signal(SIGFPE, SIG_IGN); +++ if (signal(SIGBUS, sigbus) == SIG_IGN) +++ signal(SIGBUS, SIG_IGN); +++ if (signal(SIGSEGV, sigsegv) == SIG_IGN) +++ signal(SIGSEGV, SIG_IGN); +++ if (signal(SIGTERM, sigterm) == SIG_IGN) +++ signal(SIGTERM, SIG_IGN); +++ +++ +++ if (signal(SIGINT, interrupt) == SIG_IGN) +++ signal(SIGINT, SIG_IGN); +++ +++ set_operators(); /* /etc/group snarfed */ +++ getfstab(); /* /etc/fstab snarfed */ +++ /* +++ * disk can be either the full special file name, +++ * the suffix of the special file name, +++ * the special name missing the leading '/', +++ * the file system name with or without the leading '/'. +++ */ +++ dt = fstabsearch(disk); +++ if (dt != 0) +++ disk = rawname(dt->fs_spec); +++ getitime(); /* /etc/dumpdates snarfed */ +++ +++ msg("Date of this level %c dump: %s\n", incno, prdate(spcl.c_date)); +++ msg("Date of last level %c dump: %s\n", incno, prdate(spcl.c_ddate)); +++ msg("Dumping %s ", disk); +++ if (dt != 0) +++ msgtail("(%s) ", dt->fs_file); +++ msgtail("to %s\n", tape); +++ +++ fi = open(disk, 0); +++ if (fi < 0) { +++ msg("Cannot open %s\n", disk); +++ Exit(X_ABORT); +++ } +++ CLR(clrmap); +++ CLR(dirmap); +++ CLR(nodmap); +++ esize = 0; +++ +++ msg("mapping (Pass I) [regular files]\n"); +++ pass(mark, (short *)NULL); /* mark updates esize */ +++ +++ do { +++ msg("mapping (Pass II) [directories]\n"); +++ nadded = 0; +++ pass(add, dirmap); +++ } while(nadded); +++ +++ bmapest(clrmap); +++ bmapest(nodmap); +++ +++ fetapes = +++ ( esize /* blocks */ +++ *BSIZE /* bytes / block */ +++ *(1.0/density) /* 0.1" / byte */ +++ + +++ esize /* blocks */ +++ *(1.0/NTREC) /* IRG's / block */ +++ *7 /* 0.1" / IRG */ +++ ) * (1.0 / tsize ) /* tape / 0.1" */ +++ ; +++ etapes = fetapes; /* truncating assignment */ +++ etapes++; +++ /* +++ * esize is typically about 5% too low; we frob it here +++ */ +++ esize += ((5*esize)/100); +++ msg("estimated %ld tape blocks on %3.2f tape(s).\n", esize, fetapes); +++ +++ otape(); /* bitmap is the first to tape write */ +++ time(&(tstart_writing)); +++ bitmap(clrmap, TS_CLRI); +++ +++ msg("dumping (Pass III) [directories]\n"); +++ pass(dump, dirmap); +++ +++ msg("dumping (Pass IV) [regular files]\n"); +++ pass(dump, nodmap); +++ +++ spcl.c_type = TS_END; +++ for(i=0; i>>YOU<<< know what are you doing?\n"); +++ if (query("Do you really want to abort dump?")) +++ dumpabort(); +++ signal(SIGINT, interrupt); +++} +++ +++/* +++ * The following variables and routines manage alerting +++ * operators to the status of dump. +++ * This works much like wall(1) does. +++ */ +++struct Group *gp; +++ +++/* +++ * Get the names from the group entry "operator" to notify. +++ */ +++set_operators() +++{ +++ if (!notify) /*not going to notify*/ +++ return; +++ gp = getgrnam(OPGRENT); +++ endgrent(); +++ if (gp == (struct Group *)0){ +++ msg("No entry in /etc/group for %s.\n", +++ OPGRENT); +++ notify = 0; +++ return; +++ } +++} +++ +++struct tm *localtime(); +++struct tm *localclock; +++ +++/* +++ * We fork a child to do the actual broadcasting, so +++ * that the process control groups are not messed up +++ */ +++broadcast(message) +++ char *message; +++{ +++ time_t clock; +++ FILE *f_utmp; +++ struct utmp utmp; +++ int nusers; +++ char **np; +++ int pid, s; +++ +++ switch (pid = fork()) { +++ case -1: +++ return; +++ case 0: +++ break; +++ default: +++ while (wait(&s) != pid) +++ continue; +++ return; +++ } +++ +++ if (!notify || gp == 0) +++ return; +++ clock = time(0); +++ localclock = localtime(&clock); +++ +++ if((f_utmp = fopen("/etc/utmp", "r")) == NULL) { +++ msg("Cannot open /etc/utmp\n"); +++ return; +++ } +++ +++ nusers = 0; +++ while (!feof(f_utmp)){ +++ if (fread(&utmp, sizeof (struct utmp), 1, f_utmp) != 1) +++ break; +++ if (utmp.ut_name[0] == 0) +++ continue; +++ nusers++; +++ for (np = gp->gr_mem; *np; np++){ +++ if (strncmp(*np, utmp.ut_name, sizeof(utmp.ut_name)) != 0) +++ continue; +++ /* +++ * Do not send messages to operators on dialups +++ */ +++ if (strncmp(utmp.ut_line, DIALUP, strlen(DIALUP)) == 0) +++ continue; +++#ifdef DEBUG +++ msg("Message to %s at %s\n", +++ utmp.ut_name, utmp.ut_line); +++#endif DEBUG +++ sendmes(utmp.ut_line, message); +++ } +++ } +++ fclose(f_utmp); +++ Exit(0); /* the wait in this same routine will catch this */ +++ /* NOTREACHED */ +++} +++ +++sendmes(tty, message) +++char *tty, *message; +++{ +++ char t[50], buf[BUFSIZ]; +++ register char *cp; +++ register int c, ch; +++ int msize; +++ FILE *f_tty; +++ +++ msize = strlen(message); +++ strcpy(t, "/dev/"); +++ strcat(t, tty); +++ +++ if((f_tty = fopen(t, "w")) != NULL) { +++ setbuf(f_tty, buf); +++ fprintf(f_tty, "\nMessage from the dump program to all operators at %d:%02d ...\r\n\n" +++ ,localclock->tm_hour +++ ,localclock->tm_min); +++ for (cp = message, c = msize; c-- > 0; cp++) { +++ ch = *cp; +++ if (ch == '\n') +++ putc('\r', f_tty); +++ putc(ch, f_tty); +++ } +++ fclose(f_tty); +++ } +++} +++ +++/* +++ * print out an estimate of the amount of time left to do the dump +++ */ +++ +++time_t tschedule = 0; +++ +++timeest() +++{ +++ time_t tnow, deltat; +++ +++ time (&tnow); +++ if (tnow >= tschedule){ +++ tschedule = tnow + 300; +++ if (blockswritten < 500) +++ return; +++ deltat = tstart_writing - tnow + +++ (((1.0*(tnow - tstart_writing))/blockswritten) * esize); +++ msg("%3.2f%% done, finished in %d:%02d\n", +++ (blockswritten*100.0)/esize, +++ deltat/3600, (deltat%3600)/60); +++ } +++} +++ +++int blocksontape() +++{ +++ /* +++ * esize: total number of blocks estimated over all reels +++ * blockswritten: blocks actually written, over all reels +++ * etapes: estimated number of tapes to write +++ * +++ * tsize: blocks can write on this reel +++ * asize: blocks written on this reel +++ * tapeno: number of tapes written so far +++ */ +++ if (tapeno == etapes) +++ return(esize - (etapes - 1)*tsize); +++ return(tsize); +++} +++ +++ /* VARARGS1 */ +++ /* ARGSUSED */ +++msg(fmt, a1, a2, a3, a4, a5) +++ char *fmt; +++{ +++ fprintf(stderr," DUMP: "); +++#ifdef TDEBUG +++ fprintf(stderr,"pid=%d ", getpid()); +++#endif +++ fprintf(stderr, fmt, a1, a2, a3, a4, a5); +++ fflush(stdout); +++ fflush(stderr); +++} +++ +++ /* VARARGS1 */ +++ /* ARGSUSED */ +++msgtail(fmt, a1, a2, a3, a4, a5) +++ char *fmt; +++{ +++ fprintf(stderr, fmt, a1, a2, a3, a4, a5); +++} +++/* +++ * Tell the operator what has to be done; +++ * we don't actually do it +++ */ +++ +++getfstab() +++{ +++ register struct fstab *dt; +++ struct fstab *fsp; +++ +++ nfstab = 0; +++ if (setfsent() == 0) { +++ msg("Can't open %s for dump table information.\n", FSTAB); +++ } else { +++ for (nfstab = 0, dt = fstab; nfstab < MAXFSTAB;){ +++ if ( (fsp = getfsent()) == 0) +++ break; +++ if ( (strcmp(fsp->fs_type, FSTAB_RW) == 0) +++ || (strcmp(fsp->fs_type, FSTAB_RO) == 0) ){ +++ *dt = *fsp; +++ nfstab++; +++ dt++; +++ } +++ } +++ endfsent(); +++ } +++} +++ +++/* +++ * Search in the fstab for a file name. +++ * This file name can be either the special or the path file name. +++ * +++ * The entries in the fstab are the BLOCK special names, not the +++ * character special names. +++ * The caller of fstabsearch assures that the character device +++ * is dumped (that is much faster) +++ * +++ * The file name can omit the leading '/'. +++ */ +++struct fstab *fstabsearch(key) +++ char *key; +++{ +++ register struct fstab *dt; +++ int i; +++ int keylength; +++ char *rawname(); +++ +++ keylength = min(strlen(key), sizeof (dt->fs_file)); +++ for (i = 0, dt = fstab; i < nfstab; i++, dt++){ +++ if (strncmp(dt->fs_file, key, keylength) == 0) +++ return(dt); +++ if (strncmp(dt->fs_spec, key, keylength) == 0) +++ return(dt); +++ if (strncmp(rawname(dt->fs_spec), key, keylength) == 0) +++ return(dt); +++ +++ if (key[0] != '/'){ +++ if ( (dt->fs_spec[0] == '/') +++ && (strncmp(dt->fs_spec+1, key, keylength) == 0)) +++ return(dt); +++ if ( (dt->fs_file[0] == '/') +++ && (strncmp(dt->fs_file+1, key, keylength) == 0)) +++ return(dt); +++ } +++ } +++ return(0); +++} +++ +++/* +++ * Tell the operator what to do +++ */ +++lastdump(arg) +++ char arg; /* w ==> just what to do; W ==> most recent dumps */ +++{ +++ char *lastname; +++ char *date; +++ register int i; +++ time_t tnow; +++ register struct fstab *dt; +++ int dumpme; +++ register struct idates *itwalk; +++ +++ int idatesort(); +++ +++ time(&tnow); +++ getfstab(); /* /etc/fstab input */ +++ inititimes(); /* /etc/dumpdates input */ +++ qsort(idatev, nidates, sizeof(struct idates *), idatesort); +++ +++ if (arg == 'w') +++ fprintf(stdout, "Dump these file systems:\n"); +++ else +++ fprintf(stdout, "Last dump(s) done (Dump '>' file systems):\n"); +++ lastname = "??"; +++ ITITERATE(i, itwalk){ +++ if (strncmp(lastname, itwalk->id_name, sizeof(itwalk->id_name)) == 0) +++ continue; +++ date = (char *)ctime(&itwalk->id_ddate); +++ date[16] = '\0'; /* blast away seconds and year */ +++ lastname = itwalk->id_name; +++ dt = fstabsearch(itwalk->id_name); +++ dumpme = ( (dt != 0) +++ && (dt->fs_freq != 0) +++ && (itwalk->id_ddate < tnow - (dt->fs_freq*DAY))); +++ if ( (arg != 'w') || dumpme) +++ fprintf(stdout,"%c %8s\t(%6s) Last dump: Level %c, Date %s\n", +++ dumpme && (arg != 'w') ? '>' : ' ', +++ itwalk->id_name, +++ dt ? dt->fs_file : 0, +++ itwalk->id_incno, +++ date +++ ); +++ } +++} +++ +++int idatesort(p1, p2) +++ struct idates **p1, **p2; +++{ +++ int diff; +++ +++ diff = strncmp((*p1)->id_name, (*p2)->id_name, sizeof((*p1)->id_name)); +++ if (diff == 0) +++ return ((*p2)->id_ddate - (*p1)->id_ddate); +++ else +++ return (diff); +++} +++ +++int max(a,b) +++{ +++ return(a>b?a:b); +++} +++int min(a,b) +++{ +++ return(a= NTREC) +++ flusht(); +++} +++ +++tapsrec(d) +++daddr_t d; +++{ +++ +++ if(d == 0) +++ return; +++ tdaddr[trecno] = d; +++ trecno++; +++ spcl.c_tapea++; +++ if(trecno >= NTREC) +++ flusht(); +++} +++ +++int nogripe = 0; +++ +++flusht() +++{ +++ register i, si; +++ daddr_t d; +++ +++ while(trecno < NTREC) +++ tdaddr[trecno++] = 1; +++ +++loop: +++ d = 0; +++ for(i=0; i tsize) { +++ close_rewind(); +++ otape(); +++ } +++ timeest(); +++} +++ +++rewind() +++{ +++ int secs; +++#ifdef DEBUG +++ msg("Waiting 10 seconds to rewind.\n"); +++ sleep(10); +++#else +++ /* +++ * It takes about 3 minutes, 25secs to rewind 2300' of tape +++ */ +++ secs = (( (60*3) + 25)*asize)/(2300L*12L*10L); +++ msg("Waiting %d seconds to rewind.\n", secs); +++ sleep(secs); +++#endif +++} +++ +++close_rewind() +++{ +++ close(to); +++ if (!nogripe){ +++ rewind(); +++ msg("Change Tapes: Mount tape #%d\n", tapeno+1); +++ broadcast("CHANGE TAPES!\7\7\n"); +++ } +++ do{ +++ if (query ("Is the new tape mounted and ready to go?")) +++ break; +++ if (query ("Do you want to abort?")){ +++ dumpabort(); +++ /*NOTREACHED*/ +++ } +++ } while (1); +++} +++ +++/* +++ * We implement taking and restoring checkpoints on +++ * the tape level. +++ * When each tape is opened, a new process is created by forking; this +++ * saves all of the necessary context in the parent. The child +++ * continues the dump; the parent waits around, saving the context. +++ * If the child returns X_REWRITE, then it had problems writing that tape; +++ * this causes the parent to fork again, duplicating the context, and +++ * everything continues as if nothing had happened. +++ */ +++ +++otape() +++{ +++ int parentpid; +++ int childpid; +++ int status; +++ int waitpid; +++ int sig_ign_parent(); +++ int interrupt(); +++ +++ /* +++ * Force the tape to be closed +++ */ +++ close(to); +++ parentpid = getpid(); +++ +++ restore_check_point: +++ signal(SIGINT, interrupt); +++ /* +++ * All signals are inherited... +++ */ +++ childpid = fork(); +++ if (childpid < 0){ +++ msg("Context save fork fails in parent %d\n", parentpid); +++ Exit(X_ABORT); +++ } +++ if (childpid != 0){ +++ /* +++ * PARENT: +++ * save the context by waiting +++ * until the child doing all of the work returns. +++ * don't catch the interrupt +++ */ +++ signal(SIGINT, SIG_IGN); +++#ifdef TDEBUG +++ msg("Tape: %d; parent process: %d child process %d\n", +++ tapeno+1, parentpid, childpid); +++#endif TDEBUG +++ for (;;){ +++ waitpid = wait(&status); +++ if (waitpid != childpid){ +++ msg("Parent %d waiting for child %d has another child %d return\n", +++ parentpid, childpid, waitpid); +++ } else +++ break; +++ } +++ if (status & 0xFF){ +++ msg("Child %d returns LOB status %o\n", +++ childpid, status&0xFF); +++ } +++ status = (status >> 8) & 0xFF; +++#ifdef TDEBUG +++ switch(status){ +++ case X_FINOK: +++ msg("Child %d finishes X_FINOK\n", childpid); +++ break; +++ case X_ABORT: +++ msg("Child %d finishes X_ABORT\n", childpid); +++ break; +++ case X_REWRITE: +++ msg("Child %d finishes X_REWRITE\n", childpid); +++ break; +++ default: +++ msg("Child %d finishes unknown %d\n", childpid,status); +++ break; +++ } +++#endif TDEBUG +++ switch(status){ +++ case X_FINOK: +++ Exit(X_FINOK); +++ case X_ABORT: +++ Exit(X_ABORT); +++ case X_REWRITE: +++ goto restore_check_point; +++ default: +++ msg("Bad return code from dump: %d\n", status); +++ Exit(X_ABORT); +++ } +++ /*NOTREACHED*/ +++ } else { /* we are the child; just continue */ +++#ifdef TDEBUG +++ sleep(4); /* allow time for parent's message to get out */ +++ msg("Child on Tape %d has parent %d, my pid = %d\n", +++ tapeno+1, parentpid, getpid()); +++#endif +++ do{ +++ to = creat(tape, 0666); +++ if (to < 0) { +++ if (!query("Cannot open tape. Do you want to retry the open?")) +++ dumpabort(); +++ } else break; +++ } while (1); +++ +++ asize = 0; +++ tapeno++; /* current tape sequence */ +++ newtape++; /* new tape signal */ +++ spcl.c_volume++; +++ spcl.c_type = TS_TAPE; +++ spclrec(); +++ if (tapeno > 1) +++ msg("Tape %d begins with blocks from ino %d\n", +++ tapeno, ino); +++ } +++} +++ +++/* +++ * The parent still catches interrupts, but does nothing with them +++ */ +++sig_ign_parent() +++{ +++ msg("Waiting parent receives interrupt\n"); +++ signal(SIGINT, sig_ign_parent); +++} +++ +++dumpabort() +++{ +++ msg("The ENTIRE dump is aborted. NO second chances (tough luck sucker).\n"); +++ Exit(X_ABORT); +++} +++ +++Exit(status) +++{ +++#ifdef TDEBUG +++ msg("pid = %d exits with status %d\n", getpid(), status); +++#endif TDEBUG +++ henryexit(status); +++} +++ +++#ifdef TDEBUG +++exit(status) +++ /*ARGSUSED*/ +++{ +++ fflush(stdout); +++ fprintf(stderr, "Somebody called exit: halt executed\n"); +++ fflush(stderr); +++ abort(); +++} +++ +++_exit(status) +++ /*ARGSUSED*/ +++{ +++ fflush(stdout); +++ fprintf(stderr, "Somebody called _exit: halt executed\n"); +++ fflush(stderr); +++ abort(); +++} +++#endif TDEBUG +++ +++henryexit(status) +++ /* ARGSUSED */ +++{ +++ _cleanup(); +++ asm(" chmk $1"); +++ asm("halt"); +++} diff --cc usr/src/cmd/dump/dumptraverse.c index 0000000000,0000000000,0000000000..c16fa6281f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/dump/dumptraverse.c @@@@ -1,0 -1,0 -1,0 +1,284 @@@@ +++static char *sccsid = "@(#)dumptraverse.c 1.1 (Berkeley) 10/13/80"; +++#include "dump.h" +++ +++struct filsys sblock; +++struct dinode itab[INOPB * NI]; +++ +++pass(fn, map) +++int (*fn)(); +++short *map; +++{ +++ register i, j; +++ int bits; +++ ino_t mino; +++ daddr_t d; +++ +++ sync(); +++ bread((daddr_t)1, (char *)&sblock, sizeof(sblock)); +++ mino = (sblock.s_isize-2) * INOPB; +++ ino = 0; +++ for(i=2;; i+=NI) { +++ if(ino >= mino) +++ break; +++ d = (unsigned)i; +++ for(j=0; j= mino) +++ break; +++ if((ino % MLEN) == 0) { +++ bits = ~0; +++ if(map != NULL) +++ bits = *map++; +++ } +++ ino++; +++ if(bits & 1) { +++ if(d != 0) { +++ bread(d, (char *)itab, sizeof(itab)); +++ d = 0; +++ } +++ (*fn)(&itab[j]); +++ } +++ bits >>= 1; +++ } +++ } +++} +++ +++icat(ip, fn1, fn2) +++struct dinode *ip; +++int (*fn1)(), (*fn2)(); +++{ +++ register i; +++ daddr_t d[NADDR]; +++ +++ l3tol(&d[0], &ip->di_addr[0], NADDR); +++ (*fn2)(d, NADDR-3); +++ for(i=0; idi_mode & IFMT; +++ if(f == 0) +++ return; +++ BIS(ino, clrmap); +++ if(f == IFDIR) +++ BIS(ino, dirmap); +++ if(ip->di_mtime >= spcl.c_ddate || +++ ip->di_ctime >= spcl.c_ddate) { +++ BIS(ino, nodmap); +++ if (f != IFREG){ +++ esize += 1; +++ return; +++ } +++ est(ip); +++ } +++} +++ +++add(ip) +++struct dinode *ip; +++{ +++ +++ if(BIT(ino, nodmap)) +++ return; +++ nsubdir = 0; +++ dadded = 0; +++ icat(ip, dsrch, nullf); +++ if(dadded) { +++ BIS(ino, nodmap); +++ est(ip); +++ nadded++; +++ } +++ if(nsubdir == 0) +++ if(!BIT(ino, nodmap)) +++ BIC(ino, dirmap); +++} +++ +++dump(ip) +++struct dinode *ip; +++{ +++ register i; +++ +++ if(newtape) { +++ newtape = 0; +++ bitmap(nodmap, TS_BITS); +++ } +++ BIC(ino, nodmap); +++ spcl.c_dinode = *ip; +++ spcl.c_type = TS_INODE; +++ spcl.c_count = 0; +++ i = ip->di_mode & IFMT; +++ if(i != IFDIR && i != IFREG) { +++ spclrec(); +++ return; +++ } +++ icat(ip, tapsrec, dmpspc); +++} +++ +++dmpspc(dp, n) +++daddr_t *dp; +++{ +++ register i, t; +++ +++ spcl.c_count = n; +++ for(i=0; i BREADEMAX){ +++ msg("More than %d block read errors from %d\n", +++ BREADEMAX, disk); +++ broadcast("DUMP IS AILING!\n"); +++ msg("This is an unrecoverable error.\n"); +++ if (!query("Do you want to attempt to continue?")){ +++ dumpabort(); +++ /*NOTREACHED*/ +++ } else +++ breaderrors = 0; +++ } +++ } +++} +++ +++CLR(map) +++register short *map; +++{ +++ register n; +++ +++ n = MSIZ; +++ do +++ *map++ = 0; +++ while(--n); +++} +++ diff --cc usr/src/cmd/dump/unctime.c index 0000000000,0000000000,0000000000..2e308d021a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/dump/unctime.c @@@@ -1,0 -1,0 -1,0 +1,107 @@@@ +++static char *sccsid = "@(#)unctime.c 1.1 (Berkeley) 10/13/80"; +++#include +++#include +++/* +++ * Convert a ctime(3) format string into a system format date. +++ * Return the date thus calculated. +++ * +++ * Return -1 if the string is not in ctime format. +++ */ +++ +++/* +++ * Offsets into the ctime string to various parts. +++ */ +++ +++#define E_MONTH 4 +++#define E_DAY 8 +++#define E_HOUR 11 +++#define E_MINUTE 14 +++#define E_SECOND 17 +++#define E_YEAR 20 +++ +++time_t unctime(str) +++ char *str; +++{ +++ struct tm then; +++ char dbuf[30]; +++ time_t emitl(); +++ +++ if (strlen(str) != 25) +++ str[25] = 0; +++ strcpy(dbuf, str); +++ dbuf[E_MONTH+3] = 0; +++ if ( (then.tm_mon = lookup(&dbuf[E_MONTH])) < 0) +++ return(-1);; +++ then.tm_mday = atoi(&dbuf[E_DAY]); +++ then.tm_hour = atoi(&dbuf[E_HOUR]); +++ then.tm_min = atoi(&dbuf[E_MINUTE]); +++ then.tm_sec = atoi(&dbuf[E_SECOND]); +++ then.tm_year = atoi(&dbuf[E_YEAR]) - 1900; +++ return(emitl(&then)); +++} +++ +++static char months[] = +++ "JanFebMarAprMayJunJulAugSepOctNovDec"; +++ +++static +++lookup(str) +++ char *str; +++{ +++ register char *cp, *cp2; +++ +++ for (cp = months, cp2 = str; *cp != 0; cp += 3) +++ if (strncmp(cp, cp2, 3) == 0) +++ return((cp-months) / 3); +++ return(-1); +++} +++/* +++ * Routine to convert a localtime(3) format date back into +++ * a system format date. +++ * +++ * Use a binary search. +++ */ +++ +++struct tm *localtime(); +++ +++time_t emitl(dp) +++ struct tm *dp; +++{ +++ time_t conv; +++ register int i, bit; +++ struct tm dcopy; +++ +++ dcopy = *dp; +++ dp = &dcopy; +++ conv = 0; +++ for (i = 31; i >= 0; i--) { +++ bit = 1 << i; +++ conv |= bit; +++ if (dcmp(localtime(&conv), dp) > 0) +++ conv &= ~bit; +++ } +++ return(conv); +++} +++ +++/* +++ * Compare two localtime dates, return result. +++ */ +++ +++#define DECIDE(a) \ +++ if (dp->a > dp2->a) \ +++ return(1); \ +++ if (dp->a < dp2->a) \ +++ return(-1) +++ +++static +++dcmp(dp, dp2) +++ register struct tm *dp, *dp2; +++{ +++ +++ DECIDE(tm_year); +++ DECIDE(tm_mon); +++ DECIDE(tm_mday); +++ DECIDE(tm_hour); +++ DECIDE(tm_min); +++ DECIDE(tm_sec); +++ return(0); +++} diff --cc usr/src/cmd/dumpdir.c index 0000000000,8a5bb99700,0000000000..d091951c2d mode 000000,100644,000000..100644 --- a/usr/src/cmd/dumpdir.c +++ b/usr/src/cmd/dumpdir.c @@@@ -1,0 -1,473 -1,0 +1,474 @@@@ +++static char *sccsid = "@(#)dumpdir.c 4.2 (Berkeley) 11/15/80"; + +#define MAXINO 2000 + +#define BITS 8 + +#define MAXXTR 60 + +#define NCACHE 3 + + + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + + + +#define MWORD(m,i) (m[(unsigned)(i-1)/MLEN]) + +#define MBIT(i) (1<<((unsigned)(i-1)%MLEN)) + +#define BIS(i,w) (MWORD(w,i) |= MBIT(i)) + +#define BIC(i,w) (MWORD(w,i) &= ~MBIT(i)) + +#define BIT(i,w) (MWORD(w,i) & MBIT(i)) + + + +int mt; - char tapename[] = "/dev/rmt1"; +++char tapename[] = "/dev/rmt8"; + +char *magtape = tapename; + + + +daddr_t seekpt; + +int ofile; + +FILE *df; + +char dirfile[] = "rstXXXXXX"; + + + +struct { + + ino_t t_ino; + + daddr_t t_seekpt; + +} inotab[MAXINO]; + +int ipos; + + + +#define ONTAPE 1 + +#define XTRACTD 2 + +#define XINUSE 4 + + + +short dumpmap[MSIZ]; + +short clrimap[MSIZ]; + + + + + +int bct = NTREC+1; + +char tbf[NTREC*BSIZE]; + + + +char prebuf[BUFSIZ]; + + + +int volno; + + + +main(argc, argv) + +char *argv[]; + +{ + + extern char *ctime(); + + + + mktemp(dirfile); + + argv++; + + if (argc>=3 && *argv[0] == 'f') + + magtape = *++argv; + + df = fopen(dirfile, "w"); + + if (df == NULL) { + + printf("dumpdir: %s - cannot create directory temporary\n", dirfile); + + exit(1); + + } + + + + if ((mt = open(magtape, 0)) < 0) { + + printf("%s: cannot open tape\n", magtape); + + exit(1); + + } + + if (readhdr(&spcl) == 0) { + + printf("Tape is not a dump tape\n"); + + exit(1); + + } + + printf("Dump date: %s", ctime(&spcl.c_date)); + + printf("Dumped from: %s", ctime(&spcl.c_ddate)); + + if (checkvol(&spcl, 1) == 0) { + + printf("Tape is not volume 1 of the dump\n"); + + exit(1); + + } + + pass1(); /* This sets the various maps on the way by */ + + freopen(dirfile, "r", df); + + strcpy(prebuf, "/"); + + printem(prebuf, (ino_t) 2); + + exit(0); + +} + + i = 0; + +/* + + * Read the tape, bulding up a directory structure for extraction + + * by name + + */ + +pass1() + +{ + + register i; + + struct dinode *ip; + + int putdir(), null(); + + + + while (gethead(&spcl) == 0) { + + printf("Can't find directory header!\n"); + + } + + for (;;) { + + if (checktype(&spcl, TS_BITS) == 1) { + + readbits(dumpmap); + + continue; + + } + + if (checktype(&spcl, TS_CLRI) == 1) { + + readbits(clrimap); + + continue; + + } + + if (checktype(&spcl, TS_INODE) == 0) { + +finish: + + flsh(); + + close(mt); + + return; + + } + + ip = &spcl.c_dinode; + + i = ip->di_mode & IFMT; + + if (i != IFDIR) { + + goto finish; + + } + + inotab[ipos].t_ino = spcl.c_inumber; + + inotab[ipos++].t_seekpt = seekpt; + + getfile(spcl.c_inumber, putdir, null, spcl.c_dinode.di_size); + + putent("\000\000/"); + + } + +} + + + +printem(prefix, inum) + +char *prefix; + +ino_t inum; + +{ + + struct direct dir; + + register int i; + + + + for (i = 0; i < MAXINO; i++) + + if (inotab[i].t_ino == inum) { + + goto found; + + } + + printf("PANIC - can't find directory %d\n", inum); + + return; + +found: + + mseek(inotab[i].t_seekpt); + + for (;;) { + + getent((char *) &dir); + + if (direq(dir.d_name, "/")) + + return; + + if (search(dir.d_ino) != 0 && direq(dir.d_name, ".") == 0 && direq(dir.d_name, "..") == 0) { + + int len; + + FILE *tdf; + + + + tdf = df; + + df = fopen(dirfile, "r"); + + len = strlen(prefix); + + strncat(prefix, dir.d_name, sizeof(dir.d_name)); + + strcat(prefix, "/"); + + printem(prefix, dir.d_ino); + + prefix[len] = '\0'; + + fclose(df); + + df = tdf; + + } + + else + + if (BIT(dir.d_ino, dumpmap)) + + printf("%5d %s%-.14s\n", dir.d_ino, prefix, dir.d_name); + + } + +} + +/* + + * Do the file extraction, calling the supplied functions + + * with the blocks + + */ + +getfile(n, f1, f2, size) + +ino_t n; + +int (*f2)(), (*f1)(); + +long size; + +{ + + register i; + + struct spcl addrblock; + + char buf[BSIZE]; + + + + addrblock = spcl; + + goto start; + + for (;;) { + + if (gethead(&addrblock) == 0) { + + printf("Missing address (header) block\n"); + + goto eloop; + + } + + if (checktype(&addrblock, TS_ADDR) == 0) { + + spcl = addrblock; + + return; + + } + +start: + + for (i = 0; i < addrblock.c_count; i++) { + + if (addrblock.c_addr[i]) { + + readtape(buf); + + (*f1)(buf, size > BSIZE ? (long) BSIZE : size); + + } + + else { + + clearbuf(buf); + + (*f2)(buf, size > BSIZE ? (long) BSIZE : size); + + } + + if ((size -= BSIZE) <= 0) { + +eloop: + + while (gethead(&spcl) == 0) + + ; + + if (checktype(&spcl, TS_ADDR) == 1) + + goto eloop; + + return; + + } + + } + + } + +} + + + +/* + + * Do the tape i\/o, dealling with volume changes + + * etc.. + + */ + +readtape(b) + +char *b; + +{ + + register i; + + struct spcl tmpbuf; + + + + if (bct >= NTREC) { + + for (i = 0; i < NTREC; i++) + + ((struct spcl *)&tbf[i*BSIZE])->c_magic = 0; + + bct = 0; + + if ((i = read(mt, tbf, NTREC*BSIZE)) < 0) { + + exit(1); + + } + + if (i == 0) { + + bct = NTREC + 1; + + volno++; + +loop: + + flsht(); + + close(mt); + + printf("Mount volume %d\n", volno); + + while (getchar() != '\n') + + ; + + if ((mt = open(magtape, 0)) == -1) { + + printf("Cannot open tape!\n"); + + } + + if (readhdr(&tmpbuf) == 0) { + + printf("Not a dump tape.Try again\n"); + + goto loop; + + } + + if (checkvol(&tmpbuf, volno) == 0) { + + printf("Wrong tape. Try again\n"); + + goto loop; + + } + + readtape(b); + + return; + + } + + } + + copy(&tbf[(bct++*BSIZE)], b, BSIZE); + +} + + + +flsht() + +{ + + bct = NTREC+1; + +} + + + +copy(f, t, s) + +register char *f, *t; + +{ + + register i; + + + + i = s; + + do + + *t++ = *f++; + + while (--i); + +} + + + +clearbuf(cp) + +register char *cp; + +{ + + register i; + + + + i = BSIZE; + + do + + *cp++ = 0; + + while (--i); + +} + + + +/* + + * Put and get the directory entries from the compressed + + * directory file + + */ + +putent(cp) + +char *cp; + +{ + + register i; + + + + for (i = 0; i < sizeof(ino_t); i++) + + writec(*cp++); + + for (i = 0; i < DIRSIZ; i++) { + + writec(*cp); + + if (*cp++ == 0) + + return; + + } + + return; + +} + + + +getent(bf) + +register char *bf; + +{ + + register i; + + + + for (i = 0; i < sizeof(ino_t); i++) + + *bf++ = readc(); + + for (i = 0; i < DIRSIZ; i++) + + if ((*bf++ = readc()) == 0) + + return; + + return; + +} + + + +/* + + * read/write te directory file + + */ + +writec(c) + +char c; + +{ + + seekpt++; + + fwrite(&c, 1, 1, df); + +} + + + +readc() + +{ + + char c; + + + + fread(&c, 1, 1, df); + + return(c); + +} + + + +mseek(pt) + +daddr_t pt; + +{ + + fseek(df, pt, 0); + +} + + + +flsh() + +{ + + fflush(df); + +} + + + +/* + + * search the directory inode ino + + * looking for entry cp + + */ + +search(inum) + +ino_t inum; + +{ + + register low, high, probe; + + + + low = 0; + + high = ipos-1; + + + + while (low != high) { + + probe = (high - low + 1)/2 + low; + +/* + +printf("low = %d, high = %d, probe = %d, ino = %d, inum = %d\n", low, high, probe, inum, inotab[probe].t_ino); + +*/ + + if (inum >= inotab[probe].t_ino) + + low = probe; + + else + + high = probe - 1; + + } + + return(inum == inotab[low].t_ino); + +} + + + +direq(s1, s2) + +register char *s1, *s2; + +{ + + register i; + + + + for (i = 0; i < DIRSIZ; i++) + + if (*s1++ == *s2) { + + if (*s2++ == 0) + + return(1); + + } else + + return(0); + + return(1); + +} + + + +/* + + * read the tape into buf, then return whether or + + * or not it is a header block. + + */ + +gethead(buf) + +struct spcl *buf; + +{ + + readtape((char *)buf); + + if (buf->c_magic != MAGIC || checksum((int *) buf) == 0) + + return(0); + + return(1); + +} + + + +/* + + * return whether or not the buffer contains a header block + + */ + +checktype(b, t) + +struct spcl *b; + +int t; + +{ + + return(b->c_type == t); + +} + + + + + +checksum(b) + +int *b; + +{ + + register i, j; + + + + j = BSIZE/sizeof(int); + + i = 0; + + do + + i += *b++; + + while (--j); + + if (i != CHECKSUM) { + + printf("Checksum error %o\n", i); + + return(0); + + } + + return(1); + +} + + + +checkvol(b, t) + +struct spcl *b; + +int t; + +{ + + if (b->c_volume == t) + + return(1); + + return(0); + +} + + + +readhdr(b) + +struct spcl *b; + +{ + + if (gethead(b) == 0) + + return(0); + + if (checktype(b, TS_TAPE) == 0) + + return(0); + + return(1); + +} + + + +putdir(b) + +char *b; + +{ + + register struct direct *dp; + + register i; + + + + for (dp = (struct direct *) b, i = 0; i < BSIZE; dp++, i += sizeof(*dp)) { + + if (dp->d_ino == 0) + + continue; + + putent((char *) dp); + + } + +} + + + +/* + + * read a bit mask from the tape into m. + + */ + +readbits(m) + +short *m; + +{ + + register i; + + + + i = spcl.c_count; + + + + while (i--) { + + readtape((char *) m); + + m += (BSIZE/(MLEN/BITS)); + + } + + while (gethead(&spcl) == 0) + + ; + +} + + + +null() { ; } diff --cc usr/src/cmd/echo.c index 0000000000,c9ee03ca85,0000000000..813a852e27 mode 000000,100644,000000..100644 --- a/usr/src/cmd/echo.c +++ b/usr/src/cmd/echo.c @@@@ -1,0 -1,23 -1,0 +1,24 @@@@ +++static char *sccsid = "@(#)echo.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +main(argc, argv) + +int argc; + +char *argv[]; + +{ + + register int i, nflg; + + + + nflg = 0; + + if(argc > 1 && argv[1][0] == '-' && argv[1][1] == 'n') { + + nflg++; + + argc--; + + argv++; + + } + + for(i=1; i0 && ( (argv[0][0]=='-' && argv[0][1]!='\0') || eqlstrng(argv[0]) )) +++ { +++ if(argv[0][0] == '-') +++ for(p = argv[0]+1 ; *p ; ++p) switch(*p) +++ { +++ case ' ': +++ break; +++ +++ case 'd': +++ case 'D': +++ switch( *++p) +++ { +++ case '1': +++ dbgflag = YES; +++ break; +++ case '2': +++ setyydeb(); +++ break; +++ case '3': +++ dumpcore = YES; +++ break; +++ case '4': +++ dumpic = YES; +++ break; +++ case 'm': +++ case 'M': +++ memdump = YES; +++ break; +++ +++ default: +++ dbgflag = YES; +++ --p; +++ break; +++ } +++ break; +++ +++ case 'w': +++ case 'W': +++ nowarnflag = YES; +++ break; +++ +++ case 'v': +++ case 'V': +++ verbose = YES; +++ break; +++ +++ case '#': +++ nocommentflag = YES; +++ break; +++ +++ case 'C': +++ case 'c': +++ nocommentflag = NO; +++ break; +++ +++#ifdef gcos +++ case 'O': +++ case 'o': +++ compile |= OPTZ; +++ break; +++ +++ case 'E': +++ case 'e': +++ compile = 0; +++ break; +++#endif +++ +++ default: +++ fprintf(diagfile, "Illegal EFL flag %c\n", *p); +++ exit(1); +++ } +++ --argc; +++ ++argv; +++ } +++ +++kwinit(); +++geninit(); +++knowninit(); +++init(); +++implinit(); +++neflnm0 = neflnames; +++ +++#ifdef gcos +++ if( intss() ) +++ compile = 0; +++ else +++ gcoutf(); +++#endif +++ +++/* fprintf(diagfile, "EFL 1.10\n"); */ +++ +++if(argc==0) +++ { +++ filenames[0] = "-"; +++ dofile(stdin); +++ } +++else +++ while(argc>0) +++ { +++ if( eqlstrng(argv[0]) ) +++ { +++ --argc; +++ ++argv; +++ continue; +++ } +++ if(argv[0][0]=='-' && argv[0][1]=='\0') +++ { +++ basefile = ""; +++ fd = stdin; +++ } +++ else { +++ basefile = argv[0]; +++ fd = fopen(argv[0], "r"); +++ } +++ if(fd == NULL) +++ { +++ sprintf(msg, "Cannot open file %s", argv[0]); +++ fprintf(diagfile, "%s. Stop\n", msg); +++ done(2); +++ } +++ filenames[0] = argv[0]; +++ filedepth = 0; +++ +++ nftnames = 0; +++ nftnm0 = 0; +++ neflnames = neflnm0; +++ +++ dofile(fd); +++ if(fd != stdin) +++ fclose(fd); +++ --argc; +++ ++argv; +++ } +++p2flush(); +++if(verbose) +++ fprintf(diagfile, "End of compilation\n"); +++/* +++prhisto(); +++/* */ +++rmiis(); +++ +++#ifdef gcos +++ gccomp(); +++#endif +++ +++done(nbad); +++} +++ +++ +++dofile(fd) +++FILE *fd; +++{ +++int k; +++ +++fprintf(diagfile, "File %s:\n", filenames[0]); +++ +++#ifdef gcos +++ if( fd==stdin && intss() && inquire(stdin, _TTY) ) +++ freopen("*src", "rt", stdin); +++#endif +++ +++yyin = fileptrs[0] = fd; +++yylineno = filelines[0] = 1; +++filedepth = 0; +++ateof = 0; +++ +++do { +++ nerrs = 0; +++ nwarns = 0; +++ eofneed = 0; +++ forcerr = 0; +++ comneed = 0; +++ optneed = 0; +++ defneed = 0; +++ lettneed = 0; +++ iobrlevel = 0; +++ prevbg = 0; +++ +++ constno = 0; +++ labno = 0; +++ nxtstno = 0; +++ afterif = 0; +++ thisexec = 0; +++ thisctl = 0; +++ nxtindif = 0; +++ inproc = 0; +++ blklevel = 0; +++ +++ implinit(); +++ +++ opiis(); +++ swii(icfile); +++ +++ if(k = yyparse()) +++ fprintf(diagfile, "Error in source file.\n"); +++ else switch(graal) +++ { +++ case PARSERR: +++ /* +++ fprintf(diagfile, "error\n"); +++ */ +++ break; +++ +++ case PARSEOF: +++ break; +++ +++ case PARSOPT: +++ propts(); +++ break; +++ +++ case PARSDCL: +++ fprintf(diagfile, "external declaration\n"); +++ break; +++ +++ case PARSPROC: +++ /* work already done in endproc */ +++ break; +++ +++ case PARSDEF: +++ break; +++ } +++ +++ cliis(); +++ if(nerrs) ++nbad; +++ +++ } while(graal!=PARSEOF && !ateof); +++} +++ +++ptr bgnproc() +++{ +++ptr bgnexec(); +++ +++if(blklevel > 0) +++ { +++ execerr("procedure %s terminated prematurely", procnm() ); +++ endproc(); +++ } +++ctllevel = 0; +++procname = 0; +++procclass = 0; +++thisargs = 0; +++dclsect = 0; +++blklevel = 1; +++nftnm0 = nftnames; +++dclsect = 1; +++ndecl[1] = 0; +++nhid[1] = 0; +++ +++thisctl = allexcblock(); +++thisctl->tag = TCONTROL; +++thisctl->subtype = STPROC; +++inproc = 1; +++return( bgnexec() ); +++} +++ +++ +++endproc() +++{ +++char comline[50], *concat(); +++ptr p; +++ +++inproc = 0; +++ +++if(nerrs == 0) +++ { +++ pass2(); +++ unhide(); +++ cleanst(); +++ if(dumpic) +++ system( concat("od ", icfile->filename, comline) ); +++ if(memdump) +++ prmem(); +++ } +++else { +++ fprintf(diagfile, "**Procedure %s not generated\n", procnm()); +++ for( ; blklevel > 0 ; --blklevel) +++ unhide(); +++ cleanst(); +++ } +++ +++if(nerrs==0 && nwarns>0) +++ if(nwarns == 1) +++ fprintf(diagfile,"*1 warning\n"); +++ else fprintf(diagfile, "*%d warnings\n", nwarns); +++ +++blklevel = 0; +++thisargs = 0; +++procname = 0; +++procclass = 0; +++while(thisctl) +++ { +++ p = thisctl; +++ thisctl = thisctl->prevctl; +++ frexcblock(p); +++ } +++ +++while(thisexec) +++ { +++ p = thisexec; +++ thisexec = thisexec->prevexec; +++ frexcblock(p); +++ } +++ +++nftnames = nftnm0; +++if(verbose) +++ { +++ fprintf(diagfile, "Highwater mark %d words. ", nmemused); +++ fprintf(diagfile, "%ld words left over\n", totalloc-totfreed); +++ } +++} +++ +++ +++ +++ +++implinit() +++{ +++setimpl(TYREAL, 'a', 'z'); +++setimpl(TYINT, 'i', 'n'); +++} +++ +++ +++ +++init() +++{ +++eflftn[TYINT] = FTNINT; +++eflftn[TYREAL] = FTNREAL; +++eflftn[TYLREAL] = FTNDOUBLE; +++eflftn[TYLOG] = FTNLOG; +++eflftn[TYCOMPLEX] = FTNCOMPLEX; +++eflftn[TYCHAR] = FTNINT; +++eflftn[TYFIELD] = FTNINT; +++eflftn[TYLCOMPLEX] = FTNDOUBLE; +++} +++ +++ +++ +++ +++#ifdef gcos +++meter() +++{ +++FILE *mout; +++char *cuserid(), *datime(), *s; +++if(equals(s = cuserid(), "efl")) return; +++mout = fopen("efl/eflmeter", "a"); +++if(mout == NULL) +++ fprintf(diagfile,"cannot open meter file"); +++ +++else { +++ fprintf(mout, "%s user %s at %s\n", +++ ( rutss()? "tss " : "batch"), s, datime() ); +++ fclose(mout); +++ } +++} +++#endif +++ +++ +++ +++#ifdef unix +++meter() /* temporary metering of non-SIF usage */ +++{ +++FILE *mout; +++int tvec[2]; +++int uid; +++char *ctime(), *p; +++ +++uid = getuid() & 0377; +++if(uid == 91) return; /* ignore sif uses */ +++mout = fopen("/usr/sif/efl/Meter", "a"); +++if(mout == NULL) +++ fprintf(diagfile, "cannot open meter file"); +++else { +++ time(tvec); +++ p = ctime(tvec); +++ p[16] = '\0'; +++ fprintf(mout,"User %d, %s\n", uid, p+4); +++ fclose(mout); +++ } +++} +++ +++intrupt() +++{ +++done(0); +++} +++#endif +++ +++ +++done(k) +++int k; +++{ +++rmiis(); +++exit(k); +++} +++ +++ +++ +++ +++ +++/* if string has an embedded equal sign, set option with it*/ +++eqlstrng(s) +++char *s; +++{ +++register char *t; +++ +++for(t = s; *t; ++t) +++ if(*t == '=') +++ { +++ *t = '\0'; +++ while( *++t == ' ' ) +++ ; +++ setopt(s, t); +++ return(YES); +++ } +++ +++return(NO); +++} +++ +++#ifdef gcos +++ +++/* redirect output unit */ +++ +++gcoutf() +++{ +++if (!intss()) +++ { +++ fputs("\t\t Version 2.10 : read INFO/EFL (03/27/80)\n", stderr); +++ if (compile) +++ { +++ static char name[80] = "s*", opts[20] = "yw"; +++ char *opt = (char *)inquire(stdout, _OPTIONS); +++ if (!strchr(opt, 't')) +++ { /* if stdout is diverted */ +++ sprintf(name, "%s\"s*\"", +++ (char *)inquire(stdout, _FILENAME)); +++ strcpy(&opts[1], opt); +++ } +++ if (freopen(name, opts, stdout) == NULL) +++ cant(name); +++ } +++ } +++} +++ +++ +++ +++/* call in fortran compiler if necessary */ +++ +++gccomp() +++{ +++if (compile) +++ { +++ if (nbad > 0) /* abort */ +++ cretsw(EXEC); +++ +++ else { /* good: call forty */ +++ FILE *dstar; /* to intercept "gosys" action */ +++ +++ if ((dstar = fopen("d*", "wv")) == NULL) +++ cant("d*"); +++ fputs("$\tforty\tascii", dstar); +++ if (fopen("*1", "o") == NULL) +++ cant("*1"); +++ fclose(stdout, "rl"); +++ cretsw(FORM | LNO | BCD); +++ if (! tailor.ftncontnu) +++ compile |= FORM; +++ csetsw(compile); +++ gosys("forty"); +++ } +++ } +++} +++ +++ +++cant(s) +++char *s; +++{ +++ffiler(s); +++done(1); +++} +++#endif diff --cc usr/src/cmd/egrep.y index 0000000000,22de9fd996,0000000000..1a56a70558 mode 000000,100644,000000..100644 --- a/usr/src/cmd/egrep.y +++ b/usr/src/cmd/egrep.y @@@@ -1,0 -1,590 -1,0 +1,591 @@@@ + +/* + + * egrep -- print lines containing (or not containing) a regular expression + + * + + * status returns: + + * 0 - ok, and some matches + + * 1 - ok, but no matches + + * 2 - some error + + */ + +%token CHAR DOT CCL NCCL OR CAT STAR PLUS QUEST + +%left OR + +%left CHAR DOT CCL NCCL '(' + +%left CAT + +%left STAR PLUS QUEST + + + +%{ +++static char *sccsid = "@(#)egrep.y 4.1 (Berkeley) 10/1/80"; + +#include + + + +#define MAXLIN 350 + +#define MAXPOS 4000 + +#define NCHARS 128 + +#define NSTATES 128 + +#define FINAL -1 + +char gotofn[NSTATES][NCHARS]; + +int state[NSTATES]; + +char out[NSTATES]; + +int line = 1; + +int name[MAXLIN]; + +int left[MAXLIN]; + +int right[MAXLIN]; + +int parent[MAXLIN]; + +int foll[MAXLIN]; + +int positions[MAXPOS]; + +char chars[MAXLIN]; + +int nxtpos; + +int nxtchar = 0; + +int tmpstat[MAXLIN]; + +int initstat[MAXLIN]; + +int xstate; + +int count; + +int icount; + +char *input; + + + +long lnum; + +int bflag; + +int cflag; + +int fflag; + +int lflag; + +int nflag; + +int hflag = 1; + +int sflag; + +int vflag; + +int nfile; + +int blkno; + +long tln; + +int nsucc; + + + +int f; + +int fname; + +%} + + + +%% + +s: t + + ={ unary(FINAL, $1); + + line--; + + } + + ; + +t: b r + + ={ $$ = node(CAT, $1, $2); } + + | OR b r OR + + ={ $$ = node(CAT, $2, $3); } + + | OR b r + + ={ $$ = node(CAT, $2, $3); } + + | b r OR + + ={ $$ = node(CAT, $1, $2); } + + ; + +b: + + ={ $$ = enter(DOT); + + $$ = unary(STAR, $$); } + + ; + +r: CHAR + + ={ $$ = enter($1); } + + | DOT + + ={ $$ = enter(DOT); } + + | CCL + + ={ $$ = cclenter(CCL); } + + | NCCL + + ={ $$ = cclenter(NCCL); } + + ; + + + +r: r OR r + + ={ $$ = node(OR, $1, $3); } + + | r r %prec CAT + + ={ $$ = node(CAT, $1, $2); } + + | r STAR + + ={ $$ = unary(STAR, $1); } + + | r PLUS + + ={ $$ = unary(PLUS, $1); } + + | r QUEST + + ={ $$ = unary(QUEST, $1); } + + | '(' r ')' + + ={ $$ = $2; } + + | error + + ; + + + +%% + +yyerror(s) { + + fprintf(stderr, "egrep: %s\n", s); + + exit(2); + +} + + + +yylex() { + + extern int yylval; + + int cclcnt, x; + + register char c, d; + + switch(c = nextch()) { + + case '$': + + case '^': c = '\n'; + + goto defchar; + + case '|': return (OR); + + case '*': return (STAR); + + case '+': return (PLUS); + + case '?': return (QUEST); + + case '(': return (c); + + case ')': return (c); + + case '.': return (DOT); + + case '\0': return (0); + + case '\n': return (OR); + + case '[': + + x = CCL; + + cclcnt = 0; + + count = nxtchar++; + + if ((c = nextch()) == '^') { + + x = NCCL; + + c = nextch(); + + } + + do { + + if (c == '\0') synerror(); + + if (c == '-' && cclcnt > 0 && chars[nxtchar-1] != 0) { + + if ((d = nextch()) != 0) { + + c = chars[nxtchar-1]; + + while (c < d) { + + if (nxtchar >= MAXLIN) overflo(); + + chars[nxtchar++] = ++c; + + cclcnt++; + + } + + continue; + + } + + } + + if (nxtchar >= MAXLIN) overflo(); + + chars[nxtchar++] = c; + + cclcnt++; + + } while ((c = nextch()) != ']'); + + chars[count] = cclcnt; + + return (x); + + case '\\': + + if ((c = nextch()) == '\0') synerror(); + + defchar: + + default: yylval = c; return (CHAR); + + } + +} + +nextch() { + + register char c; + + if (fflag) { + + if ((c = getc(stdin)) == EOF) return(0); + + } + + else c = *input++; + + return(c); + +} + + + +synerror() { + + fprintf(stderr, "egrep: syntax error\n"); + + exit(2); + +} + + + +enter(x) int x; { + + if(line >= MAXLIN) overflo(); + + name[line] = x; + + left[line] = 0; + + right[line] = 0; + + return(line++); + +} + + + +cclenter(x) int x; { + + register linno; + + linno = enter(x); + + right[linno] = count; + + return (linno); + +} + + + +node(x, l, r) { + + if(line >= MAXLIN) overflo(); + + name[line] = x; + + left[line] = l; + + right[line] = r; + + parent[l] = line; + + parent[r] = line; + + return(line++); + +} + + + +unary(x, d) { + + if(line >= MAXLIN) overflo(); + + name[line] = x; + + left[line] = d; + + right[line] = 0; + + parent[d] = line; + + return(line++); + +} + +overflo() { + + fprintf(stderr, "egrep: regular expression too long\n"); + + exit(2); + +} + + + +cfoll(v) { + + register i; + + if (left[v] == 0) { + + count = 0; + + for (i=1; i<=line; i++) tmpstat[i] = 0; + + follow(v); + + add(foll, v); + + } + + else if (right[v] == 0) cfoll(left[v]); + + else { + + cfoll(left[v]); + + cfoll(right[v]); + + } + +} + +cgotofn() { + + register c, i, k; + + int n, s; + + char symbol[NCHARS]; + + int j, nc, pc, pos; + + int curpos, num; + + int number, newpos; + + count = 0; + + for (n=3; n<=line; n++) tmpstat[n] = 0; + + if (cstate(line-1)==0) { + + tmpstat[line] = 1; + + count++; + + out[0] = 1; + + } + + for (n=3; n<=line; n++) initstat[n] = tmpstat[n]; + + count--; /*leave out position 1 */ + + icount = count; + + tmpstat[1] = 0; + + add(state, 0); + + n = 0; + + for (s=0; s<=n; s++) { + + if (out[s] == 1) continue; + + for (i=0; i= 0) { + + if (c < NCHARS) symbol[c] = 1; + + else if (c == DOT) { + + for (k=0; k= 0) + + if ( + + (k == c) + + | (k == DOT) + + | (k == CCL && member(c, right[curpos], 1)) + + | (k == NCCL && member(c, right[curpos], 0)) + + ) { + + number = positions[foll[curpos]]; + + newpos = foll[curpos] + 1; + + for (k=0; k= NSTATES) overflo(); + + add(state, ++n); + + if (tmpstat[line] == 1) out[n] = 1; + + gotofn[s][c] = n; + + } + + else { + + gotofn[s][c] = xstate; + + } + + } + + } + + } + +} + + + +cstate(v) { + + register b; + + if (left[v] == 0) { + + if (tmpstat[v] != 1) { + + tmpstat[v] = 1; + + count++; + + } + + return(1); + + } + + else if (right[v] == 0) { + + if (cstate(left[v]) == 0) return (0); + + else if (name[v] == PLUS) return (1); + + else return (0); + + } + + else if (name[v] == CAT) { + + if (cstate(left[v]) == 0 && cstate(right[v]) == 0) return (0); + + else return (1); + + } + + else { /* name[v] == OR */ + + b = cstate(right[v]); + + if (cstate(left[v]) == 0 || b == 0) return (0); + + else return (1); + + } + +} + + + + + +member(symb, set, torf) { + + register i, num, pos; + + num = chars[set]; + + pos = set + 1; + + for (i=0; i MAXPOS) overflo(); + + array[n] = nxtpos; + + positions[nxtpos++] = count; + + for (i=3; i <= line; i++) { + + if (tmpstat[i] == 1) { + + positions[nxtpos++] = i; + + } + + } + +} + + + +follow(v) int v; { + + int p; + + if (v == line) return; + + p = parent[v]; + + switch(name[p]) { + + case STAR: + + case PLUS: cstate(v); + + follow(p); + + return; + + + + case OR: + + case QUEST: follow(p); + + return; + + + + case CAT: if (v == left[p]) { + + if (cstate(right[p]) == 0) { + + follow(p); + + return; + + } + + } + + else follow(p); + + return; + + case FINAL: if (tmpstat[line] != 1) { + + tmpstat[line] = 1; + + count++; + + } + + return; + + } + +} + + + + + +main(argc, argv) + +char **argv; + +{ + + while (--argc > 0 && (++argv)[0][0]=='-') + + switch (argv[0][1]) { + + + + case 's': + + sflag++; + + continue; + + + + case 'h': + + hflag = 0; + + continue; + + + + case 'b': + + bflag++; + + continue; + + + + case 'c': + + cflag++; + + continue; + + + + case 'e': + + argc--; + + argv++; + + goto out; + + + + case 'f': + + fflag++; + + continue; + + + + case 'l': + + lflag++; + + continue; + + + + case 'n': + + nflag++; + + continue; + + + + case 'v': + + vflag++; + + continue; + + + + default: + + fprintf(stderr, "egrep: unknown flag\n"); + + continue; + + } + +out: + + if (argc<=0) + + exit(2); + + if (fflag) { + + if (freopen(fname = *argv, "r", stdin) == NULL) { + + fprintf(stderr, "egrep: can't open %s\n", fname); + + exit(2); + + } + + } + + else input = *argv; + + argc--; + + argv++; + + + + yyparse(); + + + + cfoll(line-1); + + cgotofn(); + + nfile = argc; + + if (argc<=0) { + + if (lflag) exit(1); + + execute(0); + + } + + else while (--argc >= 0) { + + execute(*argv); + + argv++; + + } + + exit(nsucc == 0); + +} + + + +execute(file) + +char *file; + +{ + + register char *p; + + register cstat; + + register ccount; + + char buf[1024]; + + char *nlp; + + int istat; + + if (file) { + + if ((f = open(file, 0)) < 0) { + + fprintf(stderr, "egrep: can't open %s\n", file); + + exit(2); + + } + + } + + else f = 0; + + ccount = 0; + + lnum = 1; + + tln = 0; + + blkno = 0; + + p = buf; + + nlp = p; + + if ((ccount = read(f,p,512))<=0) goto done; + + istat = cstat = gotofn[0]['\n']; + + if (out[cstat]) goto found; + + for (;;) { + + cstat = gotofn[cstat][*p&0377]; /* all input chars made positive */ + + if (out[cstat]) { + + found: for(;;) { + + if (*p++ == '\n') { + + if (vflag == 0) { + + succeed: nsucc = 1; + + if (cflag) tln++; + + else if (sflag) + + ; /* ugh */ + + else if (lflag) { + + printf("%s\n", file); + + close(f); + + return; + + } + + else { + + if (nfile > 1 && hflag) printf("%s:", file); + + if (bflag) printf("%d:", blkno); + + if (nflag) printf("%ld:", lnum); + + if (p <= nlp) { + + while (nlp < &buf[1024]) putchar(*nlp++); + + nlp = buf; + + } + + while (nlp < p) putchar(*nlp++); + + } + + } + + lnum++; + + nlp = p; + + if ((out[(cstat=istat)]) == 0) goto brk2; + + } + + cfound: + + if (--ccount <= 0) { + + if (p <= &buf[512]) { + + if ((ccount = read(f, p, 512)) <= 0) goto done; + + } + + else if (p == &buf[1024]) { + + p = buf; + + if ((ccount = read(f, p, 512)) <= 0) goto done; + + } + + else { + + if ((ccount = read(f, p, &buf[1024]-p)) <= 0) goto done; + + } + + blkno++; + + } + + } + + } + + if (*p++ == '\n') { + + if (vflag) goto succeed; + + else { + + lnum++; + + nlp = p; + + if (out[(cstat=istat)]) goto cfound; + + } + + } + + brk2: + + if (--ccount <= 0) { + + if (p <= &buf[512]) { + + if ((ccount = read(f, p, 512)) <= 0) break; + + } + + else if (p == &buf[1024]) { + + p = buf; + + if ((ccount = read(f, p, 512)) <= 0) break; + + } + + else { + + if ((ccount = read(f, p, &buf[1024] - p)) <= 0) break; + + } + + blkno++; + + } + + } + +done: close(f); + + if (cflag) { + + if (nfile > 1) + + printf("%s:", file); + + printf("%ld\n", tln); + + } + +} diff --cc usr/src/cmd/error/Makefile index 0000000000,0000000000,0000000000..a902cd6175 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/Makefile @@@@ -1,0 -1,0 -1,0 +1,42 @@@@ +++# +++# @(#)Makefile 1.2 (Berkeley) 10/18/80 +++# +++# error.h error header file +++# errorinput.c does all of the input, and canonicalizes errors +++# errorpi.c canonicalizes pi errors +++# errormain.c main +++# errorsubr.c does grotty subroutine work +++# errorfilter.c "greps" out unwanted messages +++# errortouch.c touches all mentioned files +++# +++ +++HDRS = error.h +++PHDRS = $(HDRS) +++SRCS = errormain.c errorinput.c errorpi.c errorsubr.c errorfilter.c errortouch.c +++PSRCS = $(SRCS) +++OBJS = errormain.o errorinput.o errorpi.o errorsubr.o errorfilter.o errortouch.o +++ +++DFLAGS = -DDEBUG -DERNIE +++CFLAGS = -O $(DFLAGS) +++ +++LINTFLAGS = $(DFLAGS) +++ +++error: $(OBJS) +++ $(CC) $(CFLAGS) $(OBJS) -o error +++ +++$(OBJS): $(HDRS) +++ +++install: +++ install -s error $(DESTDIR)/usr/ucb +++ +++clean: +++ rm -f error $(OBJS) +++ +++lint: +++ lint $(LINTFLAGS) $(SRCS) +++ +++psrcs: +++ echo $(PHDRS) $(PSRCS) +++ +++print: +++ print $(PHDRS) $(PSRCS) diff --cc usr/src/cmd/error/error.h index 0000000000,0000000000,0000000000..707a4c07d8 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/error.h @@@@ -1,0 -1,0 -1,0 +1,160 @@@@ +++/* +++ * @(#)error.h 1.1 (Berkeley) 10/16/80 +++ */ +++typedef int boolean; +++ +++#define TRUE 1 +++#define FALSE 0 +++/* +++ * Descriptors for the various languages we know about. +++ * If you touch these, also touch lang_table +++ */ +++#define INUNKNOWN 0 +++#define INCPP 1 +++#define INCC 2 +++#define INAS 3 +++#define INLD 4 +++#define INLINT 5 +++#define INF77 6 +++#define INPI 7 +++#define INPC 8 +++#define INFRANZ 9 +++#define INLISP 10 +++#define INVAXIMA 11 +++#define INRATFOR 12 +++#define INLEX 13 +++#define INYACC 14 +++#define INAPL 15 +++#define INMAKE 16 +++#define INRI 17 +++ +++extern int language; +++/* +++ * We analyze each line in the error message file, and +++ * attempt to categorize it by type, as well as language. +++ * Here are the type descriptors. +++ */ +++typedef int Errorclass; +++ +++#define C_FIRST 0 /* first error category */ +++#define C_UNKNOWN 0 /* must be zero */ +++#define C_IGNORE 1 /* ignore the message; used for pi */ +++#define C_SYNC 2 /* synchronization errors */ +++#define C_DISCARD 3 /* touches dangerous files, so discard */ +++#define C_NONSPEC 4 /* not specific to any file */ +++#define C_THISFILE 5 /* specific to this file, but at no line */ +++#define C_NULLED 6 /* refers to special func; so null */ +++#define C_TRUE 7 /* fits into true error format */ +++#define C_DUPL 8 /* sub class only; duplicated error message */ +++#define C_LAST 9 /* last error category */ +++ +++#define SORTABLE(x) (!(NOTSORTABLE(x))) +++#define NOTSORTABLE(x) (x <= C_NONSPEC) +++/* +++ * Resources to count and print out the error categories +++ */ +++extern char *class_table[]; +++extern int class_count[]; +++ +++#define nunknown class_count[C_UNKNOWN] +++#define nignore class_count[C_IGNORE] +++#define nsyncerrors class_count[C_SYNC] +++#define ndiscard class_count[C_DISCARD] +++#define nnonspec class_count[C_NONSPEC] +++#define nthisfile class_count[C_THISFILE] +++#define nnulled class_count[C_NULLED] +++#define ntrue class_count[C_TRUE] +++#define ndupl class_count[C_DUPL] +++ +++/* places to put the error complaints */ +++ +++#define TOTHEFILE 1 /* touch the file */ +++#define TOSTDOUT 2 /* just print them out (ho-hum) */ +++ +++FILE *errorfile; /* where error file comes from */ +++FILE *queryfile; /* where the query responses from the user come from*/ +++ +++extern char *currentfilename; +++extern char *processname; +++extern char *scriptname; +++ +++extern boolean query; +++/* +++ * Describes attributes about a language +++ */ +++struct lang_desc{ +++ char *lang_name; +++ char *lang_incomment; /* one of the following defines */ +++ char *lang_outcomment; /* one of the following defines */ +++}; +++extern struct lang_desc lang_table[]; +++ +++#define CINCOMMENT "/*###" +++#define COUTCOMMENT "%%%*/\n" +++#define FINCOMMENT "C###" +++#define FOUTCOMMENT "%%%\n" +++#define NEWLINE "%%%\n" +++#define PIINCOMMENT "(*###" +++#define PIOUTCOMMENT "%%%*)\n" +++#define LISPINCOMMENT ";###" +++#define ASINCOMMENT "####" +++#define RIINCOMMENT CINCOMMENT +++#define RIOUTCOMMENT COUTCOMMENT +++/* +++ * Defines and resources for determing if a given line +++ * is to be discarded because it refers to a file not to +++ * be touched, or if the function reference is to a +++ * function the user doesn't want recorded. +++ */ +++#define IG_FILE1 "llib-lc" +++#define IG_FILE2 "llib-port" +++#define IG_FILE3 "/usr/lib/llib-lc" +++#define IG_FILE4 "/usr/lib/llib-port" +++ +++#define ERRORNAME "/.errorrc" +++int nignored; +++char **names_ignored; +++/* +++ * Structure definition for a full error +++ */ +++struct error_desc{ +++ struct error_desc *error_next; /*linked together*/ +++ int error_lgtext; /* how many on the right hand side*/ +++ char **error_text; /* the right hand side proper*/ +++ Errorclass error_e_class; /* error category of this error*/ +++ Errorclass error_s_class; /* sub descriptor of error_e_class*/ +++ int error_language; /* the language for this error*/ +++ int error_position; /* oridinal position */ +++ int error_line; /* discovered line number*/ +++ int error_no; /* sequence number on input */ +++}; +++/* +++ * Resources for the true errors +++ */ +++extern int nerrors; +++extern struct error_desc *er_head; +++extern struct error_desc **errors; +++/* +++ * Resources for each of the files mentioned +++ */ +++extern int nfiles; +++extern struct error_desc ***files; /* array of pointers into errors*/ +++boolean *touchedfiles; /* which files we touched */ +++/* +++ * The langauge the compilation is in, as intuited from +++ * the flavor of error messages analyzed. +++ */ +++extern int langauge; +++extern char *currentfilename; +++/* +++ * Functional forwards +++ */ +++char *Calloc(); +++char *strsave(); +++char *clobberfirst(); +++char lastchar(); +++char firstchar(); +++char next_lastchar(); +++char **wordvsplice(); +++int wordvcmp(); +++boolean persperdexplode(); diff --cc usr/src/cmd/error/errorfilter.c index 0000000000,0000000000,0000000000..7e3e0de8d9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/errorfilter.c @@@@ -1,0 -1,0 -1,0 +1,153 @@@@ +++static char *sccsid = "@(#)errorfilter.c 1.1 (Berkeley) 10/16/80"; +++#include +++#include +++#include +++#include "error.h" +++ +++char *lint_libs[] = { +++ IG_FILE1, +++ IG_FILE2, +++ IG_FILE3, +++ IG_FILE4, +++ 0 +++}; +++extern char* processname; +++int lexsort(); +++/* +++ * Read the file ERRORNAME of the names of functions in lint +++ * to ignore complaints about. +++ */ +++getignored(auxname) +++ char *auxname; +++{ +++ register int i; +++ FILE *fyle; +++ char inbuffer[256]; +++ int uid; +++ char filename[128]; +++ char *username; +++ struct passwd *passwdentry; +++ +++ nignored = 0; +++ if (auxname == 0){ /* use the default */ +++ if ( (username = (char *)getlogin()) == NULL){ +++ username = "Unknown"; +++ uid = getuid(); +++ if ( (passwdentry = (struct passwd *)getpwuid(uid)) == NULL){ +++ return; +++ } +++ } else { +++ if ( (passwdentry = (struct passwd *)getpwnam(username)) == NULL) +++ return; +++ } +++ strcpy(filename, passwdentry->pw_dir); +++ strcat(filename, ERRORNAME); +++ } else +++ strcpy(filename, auxname); +++#ifdef FULLDEBUG +++ printf("Opening file \"%s\" to read names to ignore.\n", +++ filename); +++#endif +++ if ( (fyle = fopen(filename, "r")) == NULL){ +++#ifdef FULLDEBUG +++ fprintf(stderr, "%s: Can't open file \"%s\"\n", +++ processname, filename); +++#endif +++ return; +++ } +++ /* +++ * Make the first pass through the file, counting lines +++ */ +++ for (nignored = 0; fgets(inbuffer, 255, fyle) != NULL; nignored++) +++ continue; +++ names_ignored = (char **)Calloc(nignored+1, sizeof (char *)); +++ fclose(fyle); +++ if (freopen(filename, "r", fyle) == NULL){ +++#ifdef FULLDEBUG +++ fprintf(stderr, "%s: Failure to open \"%s\" for second read.\n", +++ processname, filename); +++#endif +++ nignored = 0; +++ return; +++ } +++ for (i=0; i < nignored && (fgets (inbuffer, 255, fyle) != NULL); i++){ +++ names_ignored[i] = strsave(inbuffer); +++ substitute(names_ignored[i], '\n', '\0'); +++ } +++ qsort(names_ignored, nignored, sizeof *names_ignored, lexsort); +++#ifdef FULLDEBUG +++ printf("Names to ignore follow.\n"); +++ for (i=0; i < nignored; i++){ +++ printf("\tIgnore: %s\n", names_ignored[i]); +++ } +++#endif +++} +++ +++int lexsort(cpp1, cpp2) +++ char **cpp1, **cpp2; +++{ +++ return(strcmp(*cpp1, *cpp2)); +++} +++ +++int search_ignore(key) +++ char *key; +++{ +++ register int ub, lb; +++ register int halfway; +++ int order; +++ +++ if (nignored == 0) +++ return(-1); +++ for(lb = 0, ub = nignored - 1; ub >= lb; ){ +++ halfway = (ub + lb)/2; +++ if ( (order = strcmp(key, names_ignored[halfway])) == 0) +++ return(halfway); +++ if (order < 0) /*key is less than probe, throw away above*/ +++ ub = halfway - 1; +++ else +++ lb = halfway + 1; +++ } +++ return(-1); +++} +++ +++/* +++ * Tell if the error text is to be ignored. +++ * The error must have been canonicalized, with +++ * the file name the zeroth entry in the errorv, +++ * and the linenumber the second. +++ * Return the new categorization of the error class. +++ */ +++Errorclass discardit(errorp) +++ register struct error_desc *errorp; +++{ +++ int language; +++ register int i; +++ Errorclass errorclass = errorp->error_e_class; +++ +++ switch(errorclass){ +++ case C_SYNC: +++ case C_NONSPEC: +++ case C_UNKNOWN: return(errorclass); +++ default: ; +++ } +++ if(errorp->error_lgtext < 2){ +++ return(C_NONSPEC); +++ } +++ language = errorp->error_language; +++ if(language == INLINT){ +++ if (errorclass != C_NONSPEC){ /* no file */ +++ for(i=0; lint_libs[i] != 0; i++){ +++ if (strcmp(errorp->error_text[0], lint_libs[i]) == 0){ +++ return(C_DISCARD); +++ } +++ } +++ } +++ /* check if the argument to the error message is to be ignored*/ +++ if (ispunct(lastchar(errorp->error_text[2]))) +++ clob_last(errorp->error_text[2], '\0'); +++ if (search_ignore(errorp->error_text[errorclass == C_NONSPEC ? 0 : 2]) >= 0){ +++ return(C_NULLED); +++ } +++ } +++ return(errorclass); +++} diff --cc usr/src/cmd/error/errorinput.c index 0000000000,0000000000,0000000000..249aed421c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/errorinput.c @@@@ -1,0 -1,0 -1,0 +1,426 @@@@ +++static char *sccsid = "@(#)errorinput.c 1.1 (Berkeley) 10/16/80"; +++#include +++#include +++#include "error.h" +++ +++int wordc; /* how long the current error message is */ +++char **wordv; /* the actual error message */ +++ +++int nerrors; +++int language; +++ +++Errorclass onelong(); +++Errorclass cpp(); +++Errorclass ccom(); +++Errorclass lint0(); +++Errorclass lint1(); +++Errorclass lint2(); +++Errorclass lint3(); +++Errorclass make(); +++Errorclass f77(); +++Errorclass pi(); +++Errorclass ri(); +++/* +++ * Eat all of the lines in the input file, attempting to categorize +++ * them by their various flavors +++ */ +++static char inbuffer[BUFSIZ]; +++ +++eaterrors(r_errorc, r_errorv) +++ int *r_errorc; +++ struct error_desc ***r_errorv; +++{ +++ extern boolean piflag; +++ Errorclass errorclass = C_SYNC; +++ +++ for (;;){ +++ if (fgets(inbuffer, BUFSIZ, errorfile) == NULL) +++ break; +++ wordvbuild(inbuffer, &wordc, &wordv); +++ /* +++ * for convience, convert wordv to be 1 based, instead +++ * of 0 based. +++ */ +++ wordv -= 1; +++ if ( 0 +++#ifndef ERNIE +++ || (piflag && ( (errorclass = pi() ) != C_UNKNOWN)) +++#endif +++ || (( errorclass = onelong() ) != C_UNKNOWN) +++ || (( errorclass = cpp() ) != C_UNKNOWN) +++ || (( errorclass = ccom() ) != C_UNKNOWN) +++ || (( errorclass = lint0() ) != C_UNKNOWN) +++ || (( errorclass = lint1() ) != C_UNKNOWN) +++ || (( errorclass = lint2() ) != C_UNKNOWN) +++ || (( errorclass = lint3() ) != C_UNKNOWN) +++ || (( errorclass = make() ) != C_UNKNOWN) +++ || (( errorclass = f77() ) != C_UNKNOWN) +++#ifdef ERNIE +++ || ((errorclass = pi() ) != C_UNKNOWN) +++ || (( errorclass = ri() )!= C_UNKNOWN) +++#endif +++ ) ; +++ else +++ errorclass = catchall(); +++ if (wordc) +++ erroradd(wordc, wordv+1, errorclass, C_UNKNOWN); +++ } +++#ifdef FULLDEBUG +++ printf("%d errorentrys\n", nerrors); +++#endif +++ arrayify(r_errorc, r_errorv, er_head); +++} +++ +++/* +++ * create a new error entry, given a zero based array and count +++ */ +++erroradd(errorlength, errorv, errorclass, errorsubclass) +++ int errorlength; +++ char **errorv; +++ Errorclass errorclass; +++ Errorclass errorsubclass; +++{ +++ register struct error_desc *newerror; +++ register char *cp; +++ +++ if (errorclass == C_TRUE){ +++ /* check canonicalization of the second argument*/ +++ for(cp = errorv[1]; *cp && isdigit(*cp); cp++) +++ continue; +++ errorclass = (*cp == '\0') ? C_TRUE : C_NONSPEC; +++#ifdef FULLDEBUG +++ if (errorclass != C_TRUE) +++ printf("The 2nd word, \"%s\" is not a number.\n", +++ errorv[1]); +++#endif +++ } +++ if (errorlength > 0){ +++ newerror = (struct error_desc *)Calloc(1, sizeof(struct error_desc)); +++ newerror->error_language = language; /* language is global */ +++ newerror->error_text = errorv; +++ newerror->error_lgtext = errorlength; +++ if (errorclass == C_TRUE) +++ newerror->error_line = atoi(errorv[1]); +++ newerror->error_e_class = errorclass; +++ newerror->error_s_class = errorsubclass; +++ switch(newerror->error_e_class = discardit(newerror)){ +++ case C_SYNC: nsyncerrors++; break; +++ case C_DISCARD: ndiscard++; break; +++ case C_NULLED: nnulled++; break; +++ case C_NONSPEC: nnonspec++; break; +++ case C_THISFILE: nthisfile++; break; +++ case C_TRUE: ntrue++; break; +++ case C_UNKNOWN: nunknown++; break; +++ case C_IGNORE: nignore++; break; +++ } +++ newerror->error_next = er_head; +++ er_head = newerror; +++ newerror->error_no = nerrors++; +++ } /* length > 0 */ +++} +++ +++Errorclass onelong() +++{ +++ char **nwordv; +++ if ( (wordc == 1) && (language != INLD) ){ +++ /* +++ * We have either: +++ * a) file name from cc +++ * b) Assembler telling world that it is complaining +++ * c) Noise from make ("Stop.") +++ * c) Random noise +++ */ +++ wordc = 0; +++ if (strcmp(wordv[2], "Stop.") == 0){ +++ language = INMAKE; return(C_SYNC); +++ } +++ if (strcmp(wordv[1], "Assembler:") == 0){ +++ /* assembler always alerts us to what happened*/ +++ language = INAS; return(C_SYNC); +++ } else +++ if (strcmp(wordv[1], "Undefined:") == 0){ +++ /* loader complains about unknown symbols*/ +++ language = INLD; return(C_SYNC); +++ } +++ if (lastchar(wordv[1]) == ':'){ +++ /* cc tells us what file we are in */ +++ currentfilename = wordv[1]; +++ substitute(currentfilename, ':', '\0'); +++ language = INCC; return(C_SYNC); +++ } +++ } else +++ if ( (wordc == 1) && (language == INLD) ){ +++ nwordv = (char **)Calloc(4, sizeof(char *)); +++ nwordv[0] = "ld:"; +++ nwordv[1] = wordv[1]; +++ nwordv[2] = "is"; +++ nwordv[3] = "undefined."; +++ wordc = 4; +++ wordv = nwordv - 1; +++ return(C_NONSPEC); +++ } else +++ if (wordc == 1){ +++ return(C_SYNC); +++ } +++ return(C_UNKNOWN); +++} /* end of one long */ +++ +++Errorclass cpp() +++{ +++ /* +++ * Now attempt a cpp error message match +++ * Examples: +++ * ./morse.h: 23: undefined control +++ * morsesend.c: 229: MAGNIBBL: argument mismatch +++ * morsesend.c: 237: MAGNIBBL: argument mismatch +++ * test1.c: 6: undefined control +++ */ +++ if ( (language != INLD) /* loader errors have almost same fmt*/ +++ && (lastchar(wordv[1]) == ':') +++ && (isdigit(firstchar(wordv[2]))) +++ && (lastchar(wordv[2]) == ':') ){ +++ language = INCPP; +++ clob_last(wordv[1], '\0'); +++ clob_last(wordv[2], '\0'); +++ return(C_TRUE); +++ } +++ return(C_UNKNOWN); +++} /*end of cpp*/ +++ +++Errorclass ccom() +++{ +++ /* +++ * Now attempt a ccom error message match: +++ * Examples: +++ * "morsesend.c", line 237: operands of & have incompatible types +++ * "test.c", line 7: warning: old-fashioned initialization: use = +++ * "subdir.d/foo2.h", line 1: illegal initialization +++ */ +++ if ( (firstchar(wordv[1]) == '"') +++ && (lastchar(wordv[1]) == ',') +++ && (next_lastchar(wordv[1]) == '"') +++ && (strcmp(wordv[2],"line") == 0) +++ && (isdigit(firstchar(wordv[3]))) +++ && (lastchar(wordv[3]) == ':') ){ +++ clob_last(wordv[1], '\0'); /* drop last , */ +++ clob_last(wordv[1], '\0'); /* drop last " */ +++ wordv[1]++; /* drop first " */ +++ clob_last(wordv[3], '\0'); /* drop : on line number */ +++ wordv[2] = wordv[1]; /* overwrite "line" */ +++ wordv++; /*compensate*/ +++ if (language == INAS){ +++ if (strcmp(currentfilename, "???") != 0) +++ wordv[1] = currentfilename; +++ return(C_NULLED); +++ } else { +++ currentfilename = wordv[1]; +++ language = INCC; +++ return(C_TRUE); +++ } +++ } +++ return(C_UNKNOWN); +++} /* end of ccom */ +++ +++Errorclass lint0() +++{ +++ register char *cp; +++ register char **nwordv; +++ char *line, *file; +++ /* +++ * Attempt a match for the new lint style normal compiler +++ * error messages, of the form +++ * +++ * printf("%s(%d): %s\n", filename, linenumber, message); +++ */ +++ if (wordc >= 2){ +++ if ( (lastchar(wordv[1]) == ':') +++ && (next_lastchar(wordv[1]) == ')') +++ ) { +++ clob_last(wordv[1], '\0'); /* colon */ +++ if (persperdexplode(wordv[1], &line, &file)){ +++ nwordv = wordvsplice(1, wordc, wordv+1); +++ nwordv[0] = file; /* file name */ +++ nwordv[1] = line; /* line number */ +++ wordc += 1; +++ wordv = nwordv - 1; +++ language = INLINT; +++ return(C_TRUE); +++ } +++ wordv[1][strlen(wordv[1])] = ':'; +++ } +++ } +++ return (C_UNKNOWN); +++} +++ +++Errorclass lint1() +++{ +++ char *line1, *line2; +++ char *file1, *file2; +++ char **nwordv1, **nwordv2; +++ +++ /* +++ * Now, attempt a match for the various errors that lint +++ * can complain about. +++ * +++ * Look first for type 1 lint errors +++ */ +++ if (strcmp(wordv[wordc-1], "::") == 0){ +++ /* +++ * %.7s, arg. %d used inconsistently %s(%d) :: %s(%d) +++ * %.7s value used inconsistently %s(%d) :: %s(%d) +++ * %.7s multiply declared %s(%d) :: %s(%d) +++ * %.7s value declared inconsistently %s(%d) :: %s(%d) +++ * %.7s function value type must be declared before use %s(%d) :: %s(%d) +++ */ +++ language = INLINT; +++ if ( (persperdexplode(wordv[wordc], &line2, &file2)) +++ && (persperdexplode(wordv[wordc-2], &line1, &file1)) ){ +++ nwordv1 = wordvsplice(2, wordc, wordv+1); +++ nwordv2 = wordvsplice(2, wordc, wordv+1); +++ nwordv1[0] = file1; nwordv1[1] = line1; +++ erroradd(wordc+2, nwordv1, C_TRUE, C_DUPL); /* takes 0 based*/ +++ nwordv2[0] = file2; nwordv2[1] = line2; +++ wordc = wordc + 2; +++ wordv = nwordv2 - 1; /* 1 based */ +++ return(C_TRUE); +++ } +++ } +++ return(C_UNKNOWN); +++} /* end of lint 1*/ +++ +++Errorclass lint2() +++{ +++ char *file; +++ char *line; +++ char **nwordv; +++ /* +++ * Look for type 2 lint errors +++ * +++ * %.7s used( %s(%d) ), but not defined +++ * %.7s defined( %s(%d) ), but never used +++ * %.7s declared( %s(%d) ), but never used or defined +++ * +++ * bufp defined( "./metric.h"(10) ), but never used +++ */ +++ if ( (lastchar(wordv[2]) == '(' /* ')' */ ) +++ && (strcmp(wordv[4], "),") == 0) ){ +++ language = INLINT; +++ if (persperdexplode(wordv[3], &line, &file)){ +++ nwordv = wordvsplice(2, wordc, wordv+1); +++ nwordv[0] = file; nwordv[1] = line; +++ wordc = wordc + 2; +++ wordv = nwordv - 1; /* 1 based */ +++ return(C_TRUE); +++ } +++ } +++ return(C_UNKNOWN); +++} /* end of lint 2*/ +++ +++char *Lint31[4] = {"returns", "value", "which", "is"}; +++char *Lint32[6] = {"value", "is", "used,", "but", "none", "returned"}; +++Errorclass lint3() +++{ +++ if ( (wordvcmp(wordv+2, 4, Lint31) == 0) +++ || (wordvcmp(wordv+2, 6, Lint32) == 0) ){ +++ language = INLINT; +++ return(C_NONSPEC); +++ } +++ return(C_UNKNOWN); +++} +++ +++/* +++ * Special word vectors for use by F77 recognition +++ */ +++char *F77_fatal[3] = {"Compiler", "error", "line"}; +++char *F77_error[3] = {"Error", "on", "line"}; +++char *F77_warning[3] = {"Warning", "on", "line"}; +++f77() +++{ +++ char **nwordv; +++ /* +++ * look for f77 errors: +++ * Error messages from /usr/src/cmd/f77/error.c, with +++ * these printf formats: +++ * +++ * Compiler error line %d of %s: %s +++ * Error on line %d of %s: %s +++ * Warning on line %d of %s: %s +++ */ +++ if (wordc < 6) +++ return(C_UNKNOWN); +++ if ( (lastchar(wordv[6]) == ':') +++ &&( +++ (wordvcmp(wordv+1, 3, F77_fatal) == 0) +++ || (wordvcmp(wordv+1, 3, F77_error) == 0) +++ || (wordvcmp(wordv+1, 3, F77_warning) == 0) ) +++ ){ +++ language = INF77; +++ nwordv = wordvsplice(2, wordc, wordv+1); +++ nwordv[0] = wordv[6]; +++ clob_last(nwordv[0],'\0'); +++ nwordv[1] = wordv[4]; +++ wordc += 2; +++ wordv = nwordv - 1; /* 1 based */ +++ return(C_TRUE); +++ } +++ return(C_UNKNOWN); +++} /* end of f77 */ +++ +++char *Make_Croak[3] = {"***", "Error", "code"}; +++char *Make_NotRemade[5] = {"not", "remade", "because", "of", "errors"}; +++Errorclass make() +++{ +++ if (wordvcmp(wordv+1, 3, Make_Croak) == 0){ +++ language = INMAKE; +++ return(C_SYNC); +++ } +++ if (wordvcmp(wordv+2, 5, Make_NotRemade) == 0){ +++ language = INMAKE; +++ return(C_SYNC); +++ } +++ return(C_UNKNOWN); +++} +++Errorclass ri() +++{ +++ char **nwordv; +++/* +++ * Match an error message produced by ri; here is the +++ * procedure yanked from the distributed version of ri +++ * April 24, 1980. +++ * +++ * serror(str, x1, x2, x3) +++ * char str[]; +++ * char *x1, *x2, *x3; +++ * { +++ * extern int yylineno; +++ * +++ * putc('"', stdout); +++ * fputs(srcfile, stdout); +++ * putc('"', stdout); +++ * fprintf(stdout, " %d: ", yylineno); +++ * fprintf(stdout, str, x1, x2, x3); +++ * fprintf(stdout, "\n"); +++ * synerrs++; +++ * } +++ */ +++ if ( (firstchar(wordv[1]) == '"') +++ &&(lastchar(wordv[1]) == '"') +++ &&(lastchar(wordv[2]) == ':') +++ &&(isdigit(firstchar(wordv[2]))) ){ +++ clob_last(wordv[1], '\0'); /* drop the last " */ +++ wordv[1]++; /* skip over the first " */ +++ clob_last(wordv[2], '\0'); +++ language = INRI; +++ return(C_TRUE); +++ } +++ return(C_UNKNOWN); +++} +++ +++Errorclass catchall() +++{ +++ /* +++ * Catches random things. +++ */ +++ language = INUNKNOWN; +++ return(C_NONSPEC); +++} /* end of catch all*/ diff --cc usr/src/cmd/error/errormain.c index 0000000000,0000000000,0000000000..59c1f133a1 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/errormain.c @@@@ -1,0 -1,0 -1,0 +1,243 @@@@ +++static char *sccsid = "@(#)errormain.c 1.2 (Berkeley) 10/16/80"; +++#include +++#include +++#include +++#include "error.h" +++ +++int nerrors = 0; +++struct error_desc *er_head; +++struct error_desc **errors; +++ +++int nfiles = 0; +++struct error_desc ***files; /* array of pointers into errors*/ +++int language = INCC; +++ +++char *currentfilename = "????"; +++char *processname; +++char *im_on; /* my tty name */ +++ +++boolean query = FALSE; /* query the operator if touch files */ +++boolean notouch = FALSE; /* don't touch ANY files */ +++boolean piflag = FALSE; /* this is not pi */ +++ +++char *suffixlist = ".*"; /* initially, can touch any file */ +++ +++int errorsort(); +++int onintr(); +++/* +++ * error [-I ignorename] [-n] [-q] [-t suffixlist] [-s] [-v] [infile] +++ * +++ * -I: the following name, `ignorename' contains a list of +++ * function names that are not to be treated as hard errors. +++ * Default: ~/.errorsrc +++ * +++ * -n: don't touch ANY files! +++ * +++ * -q: The user is to be queried before touching each +++ * file; if not specified, all files with hard, non +++ * ignorable errors are touched (assuming they can be). +++ * +++ * -t: touch only files ending with the list of suffices, each +++ * suffix preceded by a dot. +++ * eg, -t .c.y.l +++ * will touch only files ending with .c, .y or .l +++ * +++ * -s: print a summary of the error's categories. +++ * +++ * -v: after touching all files, overlay vi(1), ex(1) or ed(1) +++ * on top of error, entered in the first file with +++ * an error in it, with the appropriate editor +++ * set up to use the "next" command to get the other +++ * files containing errors. +++ * +++ * -p: (obsolete: for older versions of pi without bug +++ * fix regarding printing out the name of the main file +++ * with an error in it) +++ * Take the following argument and use it as the name of +++ * the pascal source file, suffix .p +++ * +++ * -E: show the errors in sorted order; intended for +++ * debugging. +++ * +++ * -S: show the errors in unsorted order +++ * (as they come from the error file) +++ * +++ * infile: The error messages come from this file. +++ * Default: stdin +++ */ +++main(argc, argv) +++ int argc; +++ char *argv[]; +++{ +++ char *cp; +++ char *ignorename = 0; +++ int ed_argc; +++ char **ed_argv; /*return from touchfiles*/ +++ boolean show_errors = FALSE; +++ boolean Show_Errors = FALSE; +++ boolean pr_summary = FALSE; +++ boolean edit_files = FALSE; +++ +++ processname = argv[0]; +++ +++ errorfile = stdin; +++ if (argc > 1){ +++ for(; (argc > 1) && (argv[1][0] == '-'); argc--, argv++){ +++ for (cp = argv[1] + 1; *cp; cp++){ +++ switch(*cp){ +++ default: +++ fprintf(stderr, "%s: -%c: Unknown flag\n", +++ processname, *cp); +++ break; +++ case 'n': /* no touch */ +++ notouch = TRUE; +++ break; +++ case 'q': /* query */ +++ query = TRUE; +++ break; +++ case 'S': +++ Show_Errors = TRUE; +++ break; +++ case 's': /* show summary */ +++ pr_summary = TRUE; +++ break; +++ case 'v': /* edit files */ +++ edit_files = TRUE; +++ break; +++#ifndef ERNIE +++ case 'p': +++ *cp-- = 0; argv++; argc--; +++ if (argc > 1){ +++ currentfilename=argv[1]; +++ piflag = TRUE; +++ } +++ break; +++#endif +++ case 't': +++ *cp-- = 0; argv++; argc--; +++ if (argc > 1){ +++ suffixlist = argv[1]; +++ } +++ break; +++ case 'I': /*ignore file name*/ +++ *cp-- = 0; argv++; argc--; +++ if (argc > 1) +++ ignorename = argv[1]; +++ break; +++ } /*end of the argument switch*/ +++ } /*end of loop to consume characters after '-'*/ +++ } +++ } /* end of being at least one argument */ +++ if (notouch) +++ suffixlist = 0; +++ if (argc > 1){ +++ if (argc > 3){ +++ fprintf(stderr, "%s: Only takes 0 or 1 arguments\n", +++ processname); +++ exit(3); +++ } +++ if ( (errorfile = fopen(argv[1], "r")) == NULL){ +++ fprintf(stderr, "%s: %s: No such file or directory for reading errors.\n", +++ processname, argv[1]); +++ exit(4); +++ } +++ } +++ im_on = "/dev/tty"; +++ if ( (queryfile = fopen(im_on, "r")) == NULL){ +++ fprintf(stderr,"%s: Can't open \"%s\" to query the user.\n", +++ processname, im_on); +++ exit(9); +++ } +++ if (signal(SIGINT, onintr) == SIG_IGN) +++ signal(SIGINT, SIG_IGN); +++ if (signal(SIGTERM, onintr) == SIG_IGN) +++ signal(SIGTERM, SIG_IGN); +++ getignored(ignorename); +++ eaterrors(&nerrors, &errors); +++ if (Show_Errors) +++ printerrors(TRUE, nerrors, errors); +++ qsort(errors, nerrors, sizeof (struct error_desc *), errorsort); +++ if (show_errors) +++ printerrors(FALSE, nerrors, errors); +++ findfiles(nerrors, errors, &nfiles, &files); +++#define P(msg, arg) fprintf(stdout, msg, arg) +++ if (pr_summary){ +++ if (nunknown) +++ P("%d Errors are unclassifiable.\n", nunknown); +++ if (nignore) +++ P("%d Errors are classifiable, but totally discarded.\n",nignore); +++ if (nsyncerrors) +++ P("%d Errors are synchronization errors.\n", nsyncerrors); +++ if (nignore) +++ P("%d Errors are discarded because they refer to sacrosinct files.\n", ndiscard); +++ if (nnulled) +++ P("%d Errors are nulled because they refer to specific functions.\n", nnulled); +++ if (nnonspec) +++ P("%d Errors are not specific to any file.\n", nnonspec); +++ if (nthisfile) +++ P("%d Errors are specific to a given file, but not to a line.\n", nthisfile); +++ if (ntrue) +++ P("%d Errors are true errors, and can be inserted into the files.\n", ntrue); +++ } +++ filenames(nfiles, files); +++ fflush(stdout); +++ if (touchfiles(nfiles, files, &ed_argc, &ed_argv) && edit_files){ +++ if (!query || +++ inquire("Do you still want to edit the files you touched? ")){ +++ /* +++ * ed_agument's first argument is +++ * a vi/ex compatabile search argument +++ * to find the first occurance of ### +++ */ +++ try("vi", ed_argc, ed_argv); +++ try("ex", ed_argc, ed_argv); +++ try("ed", ed_argc-1, ed_argv+1); +++ fprintf(stdout, "Can't find any editors.\n"); +++ } +++ } +++} +++ +++try(name, argc, argv) +++ char *name; +++ int argc; +++ char **argv; +++{ +++ argv[0] = name; +++ wordvprint(stdout, argc, argv); +++ fprintf(stdout, "\n"); +++ fflush(stderr); +++ fflush(stdout); +++ sleep(2); +++ if (freopen(im_on, "r", stdin) == NULL) +++ return; +++ if (freopen(im_on, "w", stdout) == NULL) +++ return; +++ execvp(name, argv); +++} +++ +++int errorsort(epp1, epp2) +++ struct error_desc **epp1, **epp2; +++{ +++ register struct error_desc *ep1, *ep2; +++ int order; +++ /* +++ * Sort by: +++ * 1) synchronization, non specific, discarded errors first; +++ * 2) nulled and true errors last +++ * a) grouped by similar file names +++ * 1) grouped in ascending line number +++ */ +++ ep1 = *epp1; ep2 = *epp2; +++ if (ep1 == 0 || ep2 == 0) +++ return(0); +++ if ( (NOTSORTABLE(ep1->error_e_class)) ^ (NOTSORTABLE(ep2->error_e_class))){ +++ return(NOTSORTABLE(ep1->error_e_class) ? -1 : 1); +++ } +++ if (NOTSORTABLE(ep1->error_e_class)) /* then both are */ +++ return(ep1->error_no - ep2->error_no); +++ order = strcmp(ep1->error_text[0], ep2->error_text[0]); +++ if (order == 0){ +++ return(ep1->error_line - ep2->error_line); +++ } +++ return(order); +++} diff --cc usr/src/cmd/error/errorpi.c index 0000000000,0000000000,0000000000..8d3191b42a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/errorpi.c @@@@ -1,0 -1,0 -1,0 +1,367 @@@@ +++static char *sccsid = "@(#)errorpi.c 1.1 (Berkeley) 10/16/80"; +++#include +++#include +++#include "error.h" +++ +++extern char *currentfilename; +++static char *c_linenumber; +++static char *unk_hdr[] = {"In", "program", "???"}; +++static char **c_header = &unk_hdr[0]; +++ +++/* +++ * Attempt to handle error messages produced by pi (and by pc) +++ * +++ * problem #1: There is no file name available when a file does not +++ * use a #include; this will have to be given to error +++ * in the command line. +++ * problem #2: pi doesn't always tell you what line number +++ * a error refers to; for example during the tree +++ * walk phase of code generation and error detection, +++ * an error can refer to "variable foo in procedure bletch" +++ * without giving a line number +++ * problem #3: line numbers, when available, are attached to +++ * the source line, along with the source line itself +++ * These line numbers must be extracted, and +++ * the source line thrown away. +++ * problem #4: Some error messages produce more than one line number +++ * on the same message. +++ * There are only two (I think): +++ * %s undefined on line%s +++ * %s improperly used on line%s +++ * here, the %s makes line plural or singular. +++ * +++ * Here are the error strings used in pi version 1.2 that can refer +++ * to a file name or line number: +++ * +++ * Multiply defined label in case, lines %d and %d +++ * Goto %s from line %d is into a structured statement +++ * End matched %s on line %d +++ * Inserted keyword end matching %s on line %d +++ * +++ * Here are the general pi patterns recognized: +++ * define piptr == -.*^-.* +++ * define msg = .* +++ * define digit = [0-9] +++ * definename = .* +++ * define date_format letter*3 letter*3 (digit | (digit digit)) +++ * (digit | (digit digit)):digit*2 digit*4 +++ * +++ * {e,E} (piptr) (msg) Encounter an error during textual scan +++ * E {digit}* - (msg) Have an error message that refers to a new line +++ * E - msg Have an error message that refers to current +++ * function, program or procedure +++ * (date_format) (name): When switch compilation files +++ * ... (msg) When refer to the previous line +++ * 'In' ('procedure'|'function'|'program') (name): +++ * pi is now complaining about 2nd pass errors. +++ * +++ * Here is the output from a compilation +++ * +++ * +++ * 2 var i:integer; +++ * e --------------^--- Inserted ';' +++ * E 2 - All variables must be declared in one var part +++ * E 5 - Include filename must end in .i +++ * Mon Apr 21 15:56 1980 test.h: +++ * 2 begin +++ * e ------^--- Inserted ';' +++ * Mon Apr 21 16:06 1980 test.p: +++ * E 2 - Function type must be specified +++ * 6 procedure foo(var x:real); +++ * e ------^--- Inserted ';' +++ * In function bletch: +++ * E - No assignment to the function variable +++ * w - variable x is never used +++ * E 6 - foo is already defined in this block +++ * In procedure foo: +++ * w - variable x is neither used nor set +++ * 9 z : = 23; +++ * E --------------^--- Undefined variable +++ * 10 y = [1]; +++ * e ----------------^--- Inserted ':' +++ * 13 z := 345.; +++ * e -----------------------^--- Digits required after decimal point +++ * E 10 - Constant set involved in non set context +++ * E 11 - Type clash: real is incompatible with integer +++ * ... Type of expression clashed with type of variable in assignment +++ * E 12 - Parameter type not identical to type of var parameter x of foo +++ * In program mung: +++ * w - variable y is never used +++ * w - type foo is never used +++ * w - function bletch is never used +++ * E - z undefined on lines 9 13 +++ */ +++char *Months[] = { +++ "Jan", "Feb", "Mar", "Apr", "May", "Jun", +++ "Jul", "Aug", "Sep", "Oct","Nov", "Dec", +++ 0 +++}; +++char *Days[] = { +++ "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", 0 +++}; +++char *Piroutines[] = { +++ "program", "function", "procedure", 0 +++}; +++ +++ +++static boolean structured, multiple; +++ +++char *pi_Endmatched[] = {"End", "matched"}; +++char *pi_Inserted[] = {"Inserted", "keyword", "end", "matching"}; +++ +++char *pi_multiple[] = {"Mutiply", "defined", "label", "in", "case,", "line"}; +++char *pi_structured[] = {"is", "into", "a", "structured", "statement"}; +++ +++char *pi_und1[] = {"undefined", "on", "line"}; +++char *pi_und2[] = {"undefined", "on", "lines"}; +++char *pi_imp1[] = {"improperly", "used", "on", "line"}; +++char *pi_imp2[] = {"improperly", "used", "on", "lines"}; +++ +++boolean alldigits(string) +++ register char *string; +++{ +++ for (; *string && isdigit(*string); string++) +++ continue; +++ return(*string == '\0'); +++} +++boolean instringset(member, set) +++ char *member; +++ register char **set; +++{ +++ for(; *set; set++){ +++ if (strcmp(*set, member) == 0) +++ return(TRUE); +++ } +++ return(FALSE); +++} +++ +++boolean isdateformat(wordc, wordv) +++ int wordc; +++ char **wordv; +++{ +++ return( +++ (wordc == 5) +++ && (instringset(wordv[0], Days)) +++ && (instringset(wordv[1], Months)) +++ && (alldigits(wordv[2])) +++ && (alldigits(wordv[4])) ); +++} +++ +++boolean piptr(string) +++ register char *string; +++{ +++ int state = 0; +++ if (*string != '-') +++ return(FALSE); +++ while (*string && *string == '-') +++ string++; +++ if (*string != '^') +++ return(FALSE); +++ string++; +++ while (*string && *string == '-') +++ string++; +++ return(*string == '\0'); +++} +++ +++extern int wordc; +++extern char **wordv; +++ +++Errorclass pi() +++{ +++ char **nwordv; +++ char buffer[128]; +++ +++ if ( ( strlen(wordv[1]) == 1) +++ && ( (wordv[1][0] == 'e') || (wordv[1][0] == 'E') ) +++ && ( piptr(wordv[2]) ) +++ ) { +++ boolean longpiptr = 0; +++ /* +++ * We have recognized a first pass error of the form: +++ * letter ------^---- message +++ * +++ * turn into an error message of the form: +++ * +++ * file line 'pascal errortype' letter \n |---- message +++ * or of the form: +++ * file line letter |---- message +++ * when there are strlen("(*[pi]") or more +++ * preceding '-' on the error pointer. +++ * +++ * Where the | is intended to be a down arrow, so that +++ * the pi error messages can be inserted above the +++ * line in error, instead of below. (All of the other +++ * langauges put thier messages before the source line, +++ * instead of after it as does pi.) +++ * +++ * where the pointer to the error has been truncated +++ * by 6 characters to account for the fact that +++ * the pointer points into a tab preceded input line. +++ */ +++ language = INPI; +++ substitute(wordv[2], '^', '|'); +++ longpiptr = position(wordv[2],'|') > (6+8); +++ nwordv = wordvsplice(longpiptr ? 2 : 4, wordc, wordv+1); +++ nwordv[0] = strsave(currentfilename); +++ nwordv[1] = strsave(c_linenumber); +++ if (!longpiptr){ +++ nwordv[2] = "pascal errortype"; +++ nwordv[3] = wordv[1]; +++ nwordv[4] = strsave("%%%\n"); +++ if (strlen(nwordv[5]) > (8-2)) /* this is the pointer */ +++ nwordv[5] += (8-2); /* bump over 6 characters */ +++ } +++ wordv = nwordv - 1; /* convert to 1 based */ +++ wordc += longpiptr ? 2 : 4; +++ return(C_TRUE); +++ } +++ if ( (wordc >= 4) +++ && (strlen(wordv[1]) == 1) +++ && ( (*wordv[1] == 'E') || (*wordv[1] == 'w') || (*wordv[1] == 'e') ) +++ && (alldigits(wordv[2])) +++ && (strlen(wordv[3]) == 1) +++ && (wordv[3][0] == '-') +++ ){ +++ /* +++ * Message of the form: letter linenumber - message +++ * Turn into form: filename linenumber letter - message +++ */ +++ language = INPI; +++ nwordv = wordvsplice(1, wordc, wordv + 1); +++ nwordv[0] = strsave(currentfilename); +++ nwordv[1] = wordv[2]; +++ nwordv[2] = wordv[1]; +++ c_linenumber = wordv[2]; +++ wordc += 1; +++ wordv = nwordv - 1; +++ return(C_TRUE); +++ } +++ if ( (wordc >= 3) +++ && (strlen(wordv[1]) == 1) +++ && ( (*(wordv[1]) == 'E') || (*(wordv[1]) == 'w') || (*(wordv[1]) == 'e') ) +++ && (strlen(wordv[2]) == 1) +++ && (wordv[2][0] == '-') +++ ) { +++ /* +++ * Message of the form: letter - message +++ * This happens only when we are traversing the tree +++ * during the second pass of pi, and discover semantic +++ * errors. +++ * +++ * We have already (presumably) saved the header message +++ * and can now construct a nulled error message for the +++ * current file. +++ * +++ * Turns into a message of the form: +++ * filename (header) letter - message +++ * +++ * First, see if it is a message referring to more than +++ * one line number. Only of the form: +++ * %s undefined on line%s +++ * %s improperly used on line%s +++ */ +++ boolean undefined = 0; +++ int wordindex; +++ +++ language = INPI; +++ if ( (undefined = (wordvcmp(wordv+2, 3, pi_und1) == 0) ) +++ || (undefined = (wordvcmp(wordv+2, 3, pi_und2) == 0) ) +++ || (wordvcmp(wordv+2, 4, pi_imp1) == 0) +++ || (wordvcmp(wordv+2, 4, pi_imp2) == 0) +++ ){ +++ for (wordindex = undefined ? 5 : 6; wordindex <= wordc; +++ wordindex++){ +++ nwordv = wordvsplice(2, undefined ? 2 : 3, wordv+1); +++ nwordv[0] = strsave(currentfilename); +++ nwordv[1] = wordv[wordindex]; +++ if (wordindex != wordc) +++ erroradd(undefined ? 4 : 5, nwordv, +++ C_TRUE, C_UNKNOWN); +++ } +++ wordc = undefined ? 4 : 5; +++ wordv = nwordv - 1; +++ return(C_TRUE); +++ } +++ +++ nwordv = wordvsplice(1+3, wordc, wordv+1); +++ nwordv[0] = strsave(currentfilename); +++ nwordv[1] = strsave(c_header[0]); +++ nwordv[2] = strsave(c_header[1]); +++ nwordv[3] = strsave(c_header[2]); +++ wordv = nwordv - 1; +++ wordc += 1 + 3; +++ return(C_THISFILE); +++ } +++ if (strcmp(wordv[1], "...") == 0){ +++ /* +++ * have a continuation error message +++ * of the form: ... message +++ * Turn into form : filename linenumber message +++ */ +++ language = INPI; +++ nwordv = wordvsplice(1, wordc, wordv+1); +++ nwordv[0] = strsave(currentfilename); +++ nwordv[1] = strsave(c_linenumber); +++ wordv = nwordv - 1; +++ wordc += 1; +++ return(C_TRUE); +++ } +++ if( (wordc == 6) +++ && (lastchar(wordv[6]) == ':') +++ && (isdateformat(5, wordv + 1)) +++ ){ +++ /* +++ * Have message that tells us we have changed files +++ */ +++ language = INPI; +++ currentfilename = strsave(wordv[6]); +++ clob_last(currentfilename, '\0'); +++ return(C_SYNC); +++ } +++ if( (wordc == 3) +++ && (strcmp(wordv[1], "In") == 0) +++ && (lastchar(wordv[3]) == ':') +++ && (instringset(wordv[2], Piroutines)) +++ ) { +++ language = INPI; +++ c_header = wordvsplice(0, wordc, wordv+1); +++ return(C_SYNC); +++ } +++ /* +++ * now, check for just the line number followed by the text +++ */ +++ if (alldigits(wordv[1])){ +++ language = INPI; +++ c_linenumber = wordv[1]; +++ return(C_IGNORE); +++ } +++ /* +++ * Attempt to match messages refering to a line number +++ * +++ * Multiply defined label in case, lines %d and %d +++ * Goto %s from line %d is into a structured statement +++ * End matched %s on line %d +++ * Inserted keyword end matching %s on line %d +++ */ +++ multiple = structured = 0; +++ if ( +++ ( (wordc == 6) && (wordvcmp(wordv+1, 2, pi_Endmatched) == 0)) +++ || ( (wordc == 8) && (wordvcmp(wordv+1, 4, pi_Inserted) == 0)) +++ || ( multiple = ((wordc == 9) && (wordvcmp(wordv+1,6, pi_multiple) == 0) ) ) +++ || ( structured = ((wordc == 10) && (wordvcmp(wordv+6,5, pi_structured) == 0 ) )) +++ ){ +++ language = INPI; +++ nwordv = wordvsplice(2, wordc, wordv+1); +++ nwordv[0] = strsave(currentfilename); +++ nwordv[1] = structured ? wordv [5] : wordv[wordc]; +++ wordc += 2; +++ wordv = nwordv - 1; +++ if (!multiple) +++ return(C_TRUE); +++ erroradd(wordc, nwordv, C_TRUE, C_UNKNOWN); +++ nwordv = wordvsplice(0, wordc, nwordv); +++ nwordv[1] = wordv[wordc - 2]; +++ return(C_TRUE); +++ } +++ return(C_UNKNOWN); +++} diff --cc usr/src/cmd/error/errorsubr.c index 0000000000,0000000000,0000000000..c13e5ed0c0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/errorsubr.c @@@@ -1,0 -1,0 -1,0 +1,347 @@@@ +++static char *sccsid = "@(#)errorsubr.c 1.1 (Berkeley) 10/16/80"; +++#include +++#include +++#include "error.h" +++/* +++ * go through and arrayify a list of rules +++ */ +++arrayify(e_length, e_array, header) +++ int *e_length; +++ struct error_desc ***e_array; +++ struct error_desc *header; +++{ +++ register struct error_desc *errorp; +++ register struct error_desc **array; +++ register int listlength; +++ register int listindex; +++ +++ for (errorp = header, listlength = 0; +++ errorp; errorp = errorp->error_next, listlength++) +++ continue; +++ array = (struct error_desc **)Calloc(listlength+1,sizeof (struct error_desc*)); +++ for(listindex = 0, errorp = header; +++ listindex < listlength; +++ listindex++, errorp = errorp->error_next){ +++ array[listindex] = errorp; +++ errorp->error_position = listindex; +++ } +++ array[listindex] = (struct error_desc *)0; +++ *e_length = listlength; +++ *e_array = array; +++} +++ +++/*VARARGS1*/ +++error(msg, a1, a2, a3) +++ char *msg; +++{ +++ fprintf(stderr, "Error: "); +++ fprintf(stderr, msg, a1, a2, a3); +++ fprintf(stderr, "\n"); +++ fflush(stdout); +++ fflush(stderr); +++ exit(6); +++} +++/*ARGSUSED*/ +++char *Calloc(nelements, size) +++ int nelements; +++ int size; +++{ +++ char *back; +++ if ( (back = (char *)calloc(nelements, size)) == (char *)NULL){ +++ error("Ran out of memory.\n"); +++ exit(1); +++ } +++ return(back); +++} +++ +++char *strsave(instring) +++ char *instring; +++{ +++ char *outstring; +++ strcpy(outstring = (char *)Calloc(1, strlen(instring) + 1), instring); +++ return(outstring); +++} +++/* +++ * find the position of a given character in a string +++ * (one based) +++ */ +++int position(string, ch) +++ register char *string; +++ register char ch; +++{ +++ register int i; +++ for (i=1; *string; string++, i++){ +++ if (*string == ch) +++ return(i); +++ } +++ return(-1); +++} +++/* +++ * clobber the first occurance of ch in string by the new character +++ */ +++char *substitute(string, chold, chnew) +++ char *string; +++ char chold, chnew; +++{ +++ register char *cp = string; +++ +++ while (*cp){ +++ if (*cp == chold){ +++ *cp = chnew; +++ break; +++ } +++ cp++; +++ } +++ return(string); +++} +++ +++char lastchar(string) +++ char *string; +++{ +++ int length; +++ length = strlen(string); +++ if (length >= 1) +++ return(string[length-1]); +++ else +++ return('\0'); +++} +++ +++char firstchar(string) +++ char *string; +++{ +++ return(string[0]); +++} +++ +++char next_lastchar(string) +++ char *string; +++{ +++ int length; +++ length = strlen(string); +++ if (length >= 2) +++ return(string[length - 2]); +++ else +++ return('\0'); +++} +++ +++clob_last(string, newstuff) +++ char *string, newstuff; +++{ +++ int length; +++ length = strlen(string); +++ if (length >= 1) +++ string[length - 1] = newstuff; +++} +++ +++/* +++ * parse a string that is the result of a format %s(%d) +++ * return TRUE if this is of the proper format +++ */ +++boolean persperdexplode(string, r_perd, r_pers) +++ char *string; +++ char **r_perd, **r_pers; +++{ +++ register char *cp; +++ int length; +++ +++ length = strlen(string); +++ if ( (length >= 4) +++ && (string[length - 1] == ')' ) ){ +++ for (cp = &string[length - 2]; +++ (isdigit(*cp)) && (*cp != '('); +++ --cp) +++ continue; +++ if (*cp == '('){ +++ string[length - 1] = '\0'; /* clobber the ) */ +++ *r_perd = strsave(cp+1); +++ string[length - 1] = ')'; +++ *cp = '\0'; /* clobber the ( */ +++ *r_pers = strsave(string); +++ *cp = '('; +++ return(TRUE); +++ } +++ } +++ return(FALSE); +++} +++/* +++ * parse a quoted string that is the result of a format \"%s\"(%d) +++ * return TRUE if this is of the proper format +++ */ +++boolean qpersperdexplode(string, r_perd, r_pers) +++ char *string; +++ char **r_perd, **r_pers; +++{ +++ register char *cp; +++ int length; +++ +++ length = strlen(string); +++ if ( (length >= 4) +++ && (string[length - 1] == ')' ) ){ +++ for (cp = &string[length - 2]; +++ (isdigit(*cp)) && (*cp != '('); +++ --cp) +++ continue; +++ if (*cp == '(' && *(cp - 1) == '"'){ +++ string[length - 1] = '\0'; +++ *r_perd = strsave(cp+1); +++ string[length - 1] = ')'; +++ *(cp - 1) = '\0'; /* clobber the " */ +++ *r_pers = strsave(string + 1); +++ *(cp - 1) = '"'; +++ return(TRUE); +++ } +++ } +++ return(FALSE); +++} +++ +++static char cincomment[] = CINCOMMENT; +++static char coutcomment[] = COUTCOMMENT; +++static char fincomment[] = FINCOMMENT; +++static char foutcomment[] = FOUTCOMMENT; +++static char newline[] = NEWLINE; +++static char piincomment[] = PIINCOMMENT; +++static char pioutcomment[] = PIOUTCOMMENT; +++static char lispincomment[] = LISPINCOMMENT; +++static char riincomment[] = RIINCOMMENT; +++static char rioutcomment[] = RIOUTCOMMENT; +++ +++struct lang_desc lang_table[] = { +++ /*INUNKNOWN 0*/ "unknown", cincomment, coutcomment, +++ /*INCPP 1*/ "cpp", cincomment, coutcomment, +++ /*INCC 2*/ "cc", cincomment, coutcomment, +++ /*INAS 3*/ "as", ASINCOMMENT, newline, +++ /*INLD 4*/ "ld", cincomment, coutcomment, +++ /*INLINT 5*/ "lint", cincomment, coutcomment, +++ /*INF77 6*/ "f77", fincomment, foutcomment, +++ /*INPI 7*/ "pi", piincomment, pioutcomment, +++ /*INPC 8*/ "pc", piincomment, pioutcomment, +++ /*INFRANZ 9*/ "franz",lispincomment, newline, +++ /*INLISP 10*/ "lisp", lispincomment, newline, +++ /*INVAXIMA 11*/ "vaxima",lispincomment,newline, +++ /*INRATFOR 12*/ "ratfor",fincomment, foutcomment, +++ /*INLEX 13*/ "lex", cincomment, coutcomment, +++ /*INYACC 14*/ "yacc", cincomment, coutcomment, +++ /*INAPL 15*/ "apl", ".lm", newline, +++ /*INMAKE 16*/ "make", ASINCOMMENT, newline, +++ /*INRI 17*/ "ri", riincomment, rioutcomment, +++ 0, 0, 0 +++}; +++ +++printerrors(look_at_subclass, errorc, errorv) +++ boolean look_at_subclass; +++ int errorc; +++ struct error_desc *errorv[]; +++{ +++ register int i; +++ register struct error_desc *errorp; +++ for (errorp = errorv[i = 0]; i < errorc; errorp = errorv[++i]){ +++ if (errorp->error_e_class == C_IGNORE) +++ continue; +++ if (look_at_subclass && errorp->error_s_class == C_DUPL) +++ continue; +++ printf("Error %d, (%s error) [%s], text = \"", +++ i, +++ class_table[errorp->error_e_class], +++ lang_table[errorp->error_language].lang_name); +++ wordvprint(stdout,errorp->error_lgtext,errorp->error_text); +++ printf("\"\n"); +++ } +++} +++ +++wordvprint(fyle, wordc, wordv) +++ FILE *fyle; +++ int wordc; +++ char *wordv[]; +++{ +++ int i; +++ for(i = 0; i < wordc; i++){ +++ fprintf(fyle, "%s",wordv[i]); +++ if (i != wordc - 1) +++ fprintf(fyle, " "); +++ } +++} +++ +++/* +++ * Given a string, parse it into a number of words, and build +++ * a wordc wordv combination pointing into it. +++ */ +++wordvbuild(string, r_wordc, r_wordv) +++ char *string; +++ int *r_wordc; +++ char ***r_wordv; +++{ +++ register char *cp; +++ char *saltedbuffer; +++ char **wordv; +++ int wordcount; +++ int wordindex; +++ +++ saltedbuffer = strsave(string); +++ for (wordcount = 0, cp = saltedbuffer; *cp; wordcount++){ +++ while (*cp && isspace(*cp)) +++ cp++; +++ if (*cp == 0) +++ break; +++ while (!isspace(*cp)) +++ cp++; +++ } +++ wordv = (char **)Calloc(wordcount + 1, sizeof (char *)); +++ for (cp=saltedbuffer,wordindex=0; wordcount; wordindex++,--wordcount){ +++ while (*cp && isspace(*cp)) +++ cp++; +++ if (*cp == 0) +++ break; +++ wordv[wordindex] = cp; +++ while(!isspace(*cp)) +++ cp++; +++ *cp++ = '\0'; +++ } +++ if (wordcount != 0) +++ error("Initial miscount of the number of words in a line\n"); +++ wordv[wordindex] = (char *)0; +++#ifdef FULLDEBUG +++ for (wordcount = 0; wordcount < wordindex; wordcount++) +++ printf("Word %d = \"%s\"\n", wordcount, wordv[wordcount]); +++ printf("\n"); +++#endif +++ *r_wordc = wordindex; +++ *r_wordv = wordv; +++} +++/* +++ * Compare two 0 based wordvectors +++ */ +++int wordvcmp(wordv1, wordc, wordv2) +++ char **wordv1; +++ int wordc; +++ char **wordv2; +++{ +++ register int i; +++ int back; +++ for (i = 0; i < wordc; i++){ +++ if (back = strcmp(wordv1[i], wordv2[i])){ +++ return(back); +++ } +++ } +++ return(0); /* they are equal */ +++} +++ +++/* +++ * splice a 0 basedword vector onto the tail of a +++ * new wordv, allowing the first emptyhead slots to be empty +++ */ +++char **wordvsplice(emptyhead, wordc, wordv) +++ int emptyhead; +++ int wordc; +++ char **wordv; +++{ +++ register char **nwordv; +++ int nwordc = emptyhead + wordc; +++ register int i; +++ +++ nwordv = (char **)Calloc(nwordc, sizeof (char *)); +++ for (i = 0; i < emptyhead; i++) +++ nwordv[i] = 0; +++ for(i = emptyhead; i < nwordc; i++){ +++ nwordv[i] = wordv[i-emptyhead]; +++ } +++ return(nwordv); +++} diff --cc usr/src/cmd/error/errortouch.c index 0000000000,0000000000,0000000000..c255ed6c84 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/error/errortouch.c @@@@ -1,0 -1,0 -1,0 +1,448 @@@@ +++static char *sccsid = "@(#)errortouch.c 1.2 (Berkeley) 10/16/80"; +++#include +++#include +++#include +++#include +++#include +++#include "error.h" +++ +++findfiles(nerrors, errors, r_nfiles, r_files) +++ int nerrors; +++ struct error_desc **errors; +++ int *r_nfiles; +++ struct error_desc ****r_files; +++{ +++ int nfiles; +++ struct error_desc ***files; +++ +++ char *currentfilename; +++ register int errorindex; +++ int fileindex; +++ register struct error_desc *errorp; +++ /* +++ * First, go through and count all of the filenames +++ */ +++ for (errorp = errors[errorindex = 0],nfiles = 0, currentfilename = "\1"; +++ errorindex < nerrors; +++ errorp = errors[++errorindex]){ +++ if (SORTABLE(errorp->error_e_class)){ +++ if (strcmp(errorp->error_text[0],currentfilename) != 0){ +++ nfiles++; +++ currentfilename = errorp->error_text[0]; +++ } +++ } +++ } +++ files = (struct error_desc ***)Calloc(nfiles + 3, +++ sizeof (struct error_desc**)); +++ touchedfiles = (boolean *)Calloc(nfiles+3, sizeof(boolean)); +++ /* +++ * Now, go through and partition off the error messages +++ * into those that are synchronization, discarded or +++ * not specific to any file, and those that were +++ * nulled or true errors. +++ */ +++ files[0] = &errors[0]; +++ for (errorp = errors[errorindex = 0], fileindex = 0; +++ (errorindex < nerrors) && +++ (NOTSORTABLE(errorp->error_e_class)); +++ errorp = errors[++errorindex]){ +++ continue; +++ } +++ /* +++ * Now, go through and partition off all error messages +++ * for a given file. +++ */ +++ files[1] = &errors[errorindex]; +++ touchedfiles[0] = touchedfiles[1] = FALSE; +++ for (errorp = errors[errorindex], currentfilename = "\1", fileindex = 1; +++ errorindex < nerrors; errorp = errors[++errorindex]){ +++ if ( (errorp->error_e_class == C_NULLED) || (errorp->error_e_class == C_TRUE) ){ +++ if (strcmp(errorp->error_text[0],currentfilename) != 0){ +++ currentfilename = errorp->error_text[0]; +++ touchedfiles[fileindex] = FALSE; +++ files[fileindex++] = &errors[errorindex]; +++ } +++ } +++ } +++ files[fileindex] = &errors[nerrors]; +++ *r_nfiles = nfiles; +++ *r_files = files; +++} +++ +++char *class_table[] = { +++ /*C_UNKNOWN 0 */ "Unknown", +++ /*C_IGNORE 1 */ "ignore", +++ /*C_SYNC 2 */ "synchronization", +++ /*C_DISCARD 3 */ "discarded", +++ /*C_NONSPEC 4 */ "non specific", +++ /*C_THISFILE 5 */ "specific to this file", +++ /*C_NULLED 6 */ "nulled", +++ /*C_TRUE 7 */ "true", +++ /*C_DUPL 8 */ "duplicated" +++}; +++ +++int class_count[C_LAST - C_FIRST] = {0}; +++ +++filenames(nfiles, files) +++ int nfiles; +++ struct error_desc ***files; +++{ +++ register int fileindex; +++ register struct error_desc *errorp; +++ register struct error_desc **erpp; +++ char *sep = " "; +++ register int errortype; +++ extern char *class_table[]; +++ int someerrors = 0; +++ +++ /* +++ * first, go through and simply dump out errors that +++ * don't pertain to any file +++ */ +++ if (files[1] - files[0] > 0){ +++ for(errortype = C_UNKNOWN; NOTSORTABLE(errortype); errortype++){ +++ if (class_count[errortype] > 0){ +++ if (errortype > C_SYNC) +++ someerrors++; +++ fprintf(stdout, "\n\t%d %s errors follow:\n", +++ class_count[errortype], class_table[errortype]); +++ for (errorp = *(erpp = files[0]); +++ erpp < files[1]; +++ errorp = (*++erpp)){ +++ if (errorp->error_e_class == errortype) +++ errorprint(stdout, errorp, TRUE); +++ } +++ } +++ } +++ } +++ if (nfiles){ +++ someerrors++; +++ fprintf(stdout, "%d files contain errors:", nfiles); +++ for (fileindex = 1; fileindex <= nfiles; fileindex++){ +++ fprintf(stdout, "%s\"%s\" (%d)", +++ sep, (*files[fileindex])->error_text[0], +++ files[fileindex+1] - files[fileindex]); +++ sep = ", "; +++ } +++ fprintf(stdout, "\n"); +++ } +++ if (!someerrors) +++ fprintf(stdout, "No errors.\n"); +++} +++ +++extern boolean notouch; +++ +++boolean touchfiles(nfiles, files, r_edargc, r_edargv) +++ int nfiles; +++ struct error_desc ***files; +++ int *r_edargc; +++ char ***r_edargv; +++{ +++ char *currentfilename; +++ register struct error_desc *errorp; +++ register int fileindex; +++ register struct error_desc **erpp; +++ int ntrueerrors; +++ int errordest; /* where errors go*/ +++ char *sep; +++ boolean scribbled; +++ int n_pissed_on; /* # of file touched*/ +++ int previewed; +++ +++ for (fileindex = 1; fileindex <= nfiles; fileindex++){ +++ fprintf(stdout, "\nFile \"%s\" has %d total error messages.\n", +++ currentfilename = (*files[fileindex])->error_text[0], +++ files[fileindex+1] - files[fileindex]); +++ /* +++ * First, iterate through all error messages in this file +++ * to see how many of the error messages really will +++ * get inserted into the file. +++ */ +++ for (erpp = files[fileindex], ntrueerrors = 0; +++ erpp < files[fileindex+1]; +++ erpp++){ +++ errorp = *erpp; +++ if (errorp->error_e_class == C_TRUE) +++ ntrueerrors++; +++ } +++ fprintf(stdout,"\t%d of these errors can be inserted into the file.\n", +++ ntrueerrors); +++ +++ /* +++ * What does the operator want? +++ */ +++ previewed = 0; +++ errordest = TOSTDOUT; +++ if (oktotouch(currentfilename) && (ntrueerrors > 0) ){ +++ if (query && inquire("Do you want to preview the errors first?")){ +++ previewed = 1; +++ for (erpp = files[fileindex]; +++ erpp < files[fileindex + 1]; +++ erpp++){ +++ errorprint(stdout, *erpp, TRUE); +++ } +++ fprintf(stdout, "\n"); +++ } +++ if ( !query +++ || inquire("Do you want to touch file \"%s\"? ", +++ currentfilename) +++ ){ +++ errordest = TOTHEFILE; +++ if (!probethisfile(currentfilename)){ +++ errordest = TOSTDOUT; +++ fprintf(stdout, +++ "Can't find file \"%s\" to insert error messages into.\n", +++ currentfilename); +++ } else { +++ if (edit(currentfilename)) +++ errordest = TOSTDOUT; +++ else +++ touchedfiles[fileindex] = TRUE; +++ } +++ } +++ } +++ if (previewed && (errordest == TOSTDOUT)) +++ continue; /* with the next file */ +++ /* +++ * go through and print each error message, +++ * diverting to the right place +++ */ +++ if ( (files[fileindex+1] - files[fileindex]) != ntrueerrors) +++ if (!previewed) fprintf(stdout, +++ ">>Uninserted error messages for file \"%s\" follow.\n", +++ currentfilename); +++ for (erpp = files[fileindex];erpp < files[fileindex+1];erpp++){ +++ errorp = *erpp; +++ if (errorp->error_e_class == C_TRUE){ +++ switch (errordest){ +++ case TOSTDOUT: +++ if (!previewed) +++ errorprint(stdout,errorp, TRUE); +++ break; +++ case TOTHEFILE: +++ insert(errorp->error_line); +++ text(errorp, FALSE); +++ break; +++ } /* switch */ +++ } else { +++ if (!previewed) +++ errorprint(stdout, errorp, TRUE); +++ } +++ } /* end of walking through all errors*/ +++ if (errordest == TOTHEFILE){ +++ writetouched(); +++ } +++ } /* end of walking through all files*/ +++ scribbled = FALSE; +++ for (n_pissed_on = 0, fileindex = 1; fileindex <= nfiles; fileindex++){ +++ scribbled |= touchedfiles[fileindex]; +++ n_pissed_on++; +++ } +++ if (scribbled){ +++ /* +++ * Construct an execv argument +++ * We need 1 argument for the editor's name +++ * We need 1 argument for the initial search string +++ * We need n_pissed_on arguments for the file names +++ * We need 1 argument that is a null for execv. +++ * The caller fills in the editor's name. +++ * We fill in the initial search string. +++ * We fill in the arguments, and the null. +++ */ +++ (*r_edargv) = (char **)Calloc(n_pissed_on + 3, sizeof(char *)); +++ (*r_edargc) = n_pissed_on + 2; +++ (*r_edargv)[1] = "+/###/"; +++ n_pissed_on = 2; +++ fprintf(stdout, "You touched file(s):"); +++ sep = " "; +++ for (fileindex = 1; fileindex <= nfiles; fileindex++){ +++ if (!touchedfiles[fileindex]) +++ continue; +++ errorp = *(files[fileindex]); +++ fprintf(stdout,"%s\"%s\"", sep, errorp->error_text[0]); +++ sep = ", "; +++ (*r_edargv)[n_pissed_on++] = errorp->error_text[0]; +++ } +++ fprintf(stdout, "\n"); +++ (*r_edargv)[n_pissed_on] = 0; +++ return(TRUE); +++ } else { +++ fprintf(stdout, "You didn't touch any files.\n"); +++ return(FALSE); +++ } +++ +++} /* end of touchfiles*/ +++int oktotouch(filename) +++ char *filename; +++{ +++ extern char *suffixlist; +++ register char *src; +++ register char *pat; +++ char *osrc; +++ +++ pat = suffixlist; +++ if (pat == 0) +++ return(0); +++ if (*pat == '*') +++ return(1); +++ while (*pat++ != '.') +++ continue; +++ --pat; /* point to the period */ +++ +++ for (src = &filename[strlen(filename)], --src; +++ (src > filename) && (*src != '.'); --src) +++ continue; +++ if (*src != '.') +++ return(0); +++ +++ for (src++, pat++, osrc = src; *src && *pat; src = osrc, pat++){ +++ for (; *src /* not at end of the source */ +++ && *pat /* not off end of pattern */ +++ && *pat != '.' /* not off end of sub pattern */ +++ && *pat != '*' /* not wild card */ +++ && *src == *pat; /* and equal... */ +++ src++, pat++) +++ continue; +++ if (*src == 0 && (*pat == 0 || *pat == '.' || *pat == '*')) +++ return(1); +++ if (*src != 0 && *pat == '*') +++ return(1); +++ while (*pat && *pat != '.') +++ pat++; +++ if (! *pat) +++ return(0); +++ } +++ return(0); +++} +++ +++FILE *o_touchedfile; /* the old file */ +++FILE *n_touchedfile; /* the new file */ +++char *o_name; +++char n_name[32]; +++char *canon_name = "ErrorXXXXXX"; +++int o_lineno; +++int n_lineno; +++boolean tempfileopen = FALSE; +++/* +++ * open the file; guaranteed to be both readable and writable +++ * Well, if it isn't, then return TRUE if something failed +++ */ +++boolean edit(name) +++ char *name; +++{ +++ o_name = name; +++ if ( (o_touchedfile = fopen(name, "r")) == NULL){ +++ fprintf(stderr, "%s: Can't open file \"%s\" to touch (read).\n", +++ processname, name); +++ return(TRUE); +++ } +++ strcpy(n_name, canon_name); +++ mktemp(n_name); +++ if ( (n_touchedfile = fopen(n_name, "w")) == NULL){ +++ fprintf(stderr,"%s: Can't open file \"%s\" to touch (write).\n", +++ processname, name); +++ return(TRUE); +++ } +++ tempfileopen = TRUE; +++ n_lineno = 0; +++ o_lineno = 0; +++ return(FALSE); +++} +++/* +++ * Position to the line (before, after) the line given by place +++ */ +++char edbuffer[BUFSIZ]; +++insert(place) +++ int place; +++{ +++ --place; /* always insert messages before the offending line*/ +++ for(; o_lineno < place; o_lineno++, n_lineno++){ +++ if(fgets(edbuffer, BUFSIZ, o_touchedfile) == NULL) +++ return; +++ fputs(edbuffer, n_touchedfile); +++ } +++} +++ +++text(errorp, use_all) +++ register struct error_desc *errorp; +++ boolean use_all; +++{ +++ int offset = use_all ? 0 : 2; +++ fputs(lang_table[errorp->error_language].lang_incomment, n_touchedfile); +++ fprintf(n_touchedfile, "%d [%s] ", +++ errorp->error_line, +++ lang_table[errorp->error_language].lang_name); +++ wordvprint(n_touchedfile, +++ errorp->error_lgtext-offset, errorp->error_text+offset); +++ fputs(lang_table[errorp->error_language].lang_outcomment,n_touchedfile); +++ n_lineno++; +++} +++ +++writetouched() +++{ +++ int bytes_read; +++ for(; (bytes_read = fread(edbuffer, 1, sizeof(edbuffer), o_touchedfile))!= NULL; ){ +++ fwrite(edbuffer, 1, bytes_read, n_touchedfile); +++ } +++ fclose(n_touchedfile); +++ fclose(o_touchedfile); +++ unlink(o_name); +++ link(n_name, o_name); +++ unlink(n_name); +++ tempfileopen = FALSE; +++} +++onintr() +++{ +++ if (inquire("\nInterrupt: Do you want to continue?")){ +++ signal(SIGINT, onintr); +++ return; +++ } +++ if (tempfileopen) +++ writetouched(); +++ exit(1); +++} +++errorprint(place, errorp, print_all) +++ FILE *place; +++ struct error_desc *errorp; +++ boolean print_all; +++{ +++ int offset = print_all ? 0 : 2; +++ +++ if (errorp->error_e_class == C_IGNORE) +++ return; +++ fprintf(place, "[%s] ", lang_table[errorp->error_language].lang_name); +++ wordvprint(place,errorp->error_lgtext-offset,errorp->error_text+offset); +++ putc('\n', place); +++} +++ +++boolean inquire(fmt, a1, a2) +++ char *fmt; +++ /*VARARGS1*/ +++{ +++ char buffer[128]; +++ char ch; +++ for(;;){ +++ do{ +++ fflush(stdout); +++ fprintf(stderr, fmt, a1, a2); +++ fflush(stderr); +++ } while (fgets(buffer, 127, queryfile) == NULL); +++ ch = buffer[0]; +++ if (ch == 'Y' || ch == 'y') +++ return(TRUE); +++ if (ch == 'N' || ch == 'n') +++ return(FALSE); +++ fprintf(stderr, "Yes or No only!\n"); +++ } +++} +++ +++boolean probethisfile(currentfilename) +++ char *currentfilename; +++{ +++ struct stat statbuf; +++ if (stat(currentfilename, &statbuf) != 0) +++ return(FALSE); +++ if ( (statbuf.st_mode&S_IREAD) && (statbuf.st_mode&S_IWRITE)) +++ return(TRUE); +++ return(FALSE); +++} diff --cc usr/src/cmd/ex/bcopy.c index 0000000000,0000000000,0000000000..2c0ab4a895 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/ex/bcopy.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* block copy from from to to, count bytes */ +++static char *sccsid = "@(#)bcopy.c 6.1 10/18/80"; +++bcopy(from, to, count) +++#ifdef vax +++ char *from, *to; +++ int count; +++{ +++ +++ asm(" movc3 12(ap),*4(ap),*8(ap)"); +++} +++#else +++ register char *from, *to; +++ register int count; +++{ +++ while (count--) +++ *to++ = *from++; +++} +++#endif diff --cc usr/src/cmd/ex/ex.h index 0000000000,9493541ce1,0000000000..0a7cbb6904 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex.h +++ b/usr/src/cmd/ex/ex.h @@@@ -1,0 -1,351 -1,0 +1,396 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* sccs id: @(#)ex.h 6.1 10/18/80 */ + +#ifdef V6 + +#include + +#endif + + + +/* - * Ex version 3.1 +++ * Ex version 3 (see exact version in ex_cmds.c, search for /Version/) + + * + + * Mark Horton, UC Berkeley + + * Bill Joy, UC Berkeley + + * November 1979 + + * + + * This file contains most of the declarations common to a large number + + * of routines. The file ex_vis.h contains declarations + + * which are used only inside the screen editor. + + * The file ex_tune.h contains parameters which can be diddled per installation. + + * + + * The declarations relating to the argument list, regular expressions, + + * the temporary file data structure used by the editor + + * and the data describing terminals are each fairly substantial and + + * are kept in the files ex_{argv,re,temp,tty}.h which + + * we #include separately. + + * + + * If you are going to dig into ex, you should look at the outline of the + + * distribution of the code into files at the beginning of ex.c and ex_v.c. + + * Code which is similar to that of ed is lightly or undocumented in spots + + * (e.g. the regular expression code). Newer code (e.g. open and visual) + + * is much more carefully documented, and still rough in spots. + + * + + * Please forward bug reports to + + * - * Bill Joy +++ * Mark Horton + + * Computer Science Division, EECS + + * EVANS HALL + + * U.C. Berkeley 94704 + + * (415) 642-4948 + + * (415) 642-1024 (dept. office) + + * - * or to wnj@mit-mc on the ARPA-net. I would particularly like to hear +++ * or to csvax.mark@berkeley on the ARPA-net. I would particularly like to hear + + * of additional terminal descriptions you add to the termcap data base. + + */ + + + +#include + +#include + +#include - #include + +#include + +#include + +#include + + +++/* +++ * The following little dance copes with the new USG tty handling. +++ * This stuff has the advantage of considerable flexibility, and +++ * the disadvantage of being incompatible with anything else. +++ * The presence of the symbol USG3TTY will indicate the new code: +++ * in this case, we define CBREAK (because we can simulate it exactly), +++ * but we won't actually use it, so we set it to a value that will +++ * probably blow the compilation if we goof up. +++ */ +++#ifdef USG3TTY +++#include +++#define CBREAK xxxxx +++#else +++#include +++#endif +++ + +extern int errno; + + + +#ifndef VMUNIX + +typedef short line; + +#else + +typedef int line; + +#endif + +typedef short bool; + + + +#include "ex_tune.h" + +#include "ex_vars.h" + +/* + + * Options in the editor are referred to usually by "value(name)" where + + * name is all uppercase, i.e. "value(PROMPT)". This is actually a macro + + * which expands to a fixed field in a static structure and so generates + + * very little code. The offsets for the option names in the structure + + * are generated automagically from the structure initializing them in + + * ex_data.c... see the shell script "makeoptions". + + */ + +struct option { + + char *oname; + + char *oabbrev; + + short otype; /* Types -- see below */ + + short odefault; /* Default value */ + + short ovalue; /* Current value */ + + char *osvalue; + +}; + + + +#define ONOFF 0 + +#define NUMERIC 1 + +#define STRING 2 /* SHELL or DIRECTORY */ + +#define OTERM 3 + + + +#define value(a) options[a].ovalue + +#define svalue(a) options[a].osvalue + + + +struct option options[NOPTS + 1]; + + + + + +/* + + * The editor does not normally use the standard i/o library. Because + + * we expect the editor to be a heavily used program and because it + + * does a substantial amount of input/output processing it is appropriate + + * for it to call low level read/write primitives directly. In fact, + + * when debugging the editor we use the standard i/o library. In any + + * case the editor needs a printf which prints through "putchar" ala the + + * old version 6 printf. Thus we normally steal a copy of the "printf.c" + + * and "strout" code from the standard i/o library and mung it for our + + * purposes to avoid dragging in the stdio library headers, etc if we + + * are not debugging. Such a modified printf exists in "printf.c" here. + + */ + +#ifdef TRACE + +# include + + FILE *trace; + + bool trubble; + + bool techoin; + + char tracbuf[BUFSIZ]; + +# undef putchar + +# undef getchar + +#else - #ifdef VMUNIX +++# ifdef VMUNIX + +# define BUFSIZ 1024 - #else +++# else + +# define BUFSIZ 512 - #endif +++# endif + +# define NULL 0 + +# define EOF -1 + +#endif + + + +/* + + * Character constants and bits + + * + + * The editor uses the QUOTE bit as a flag to pass on with characters + + * e.g. to the putchar routine. The editor never uses a simple char variable. + + * Only arrays of and pointers to characters are used and parameters and + + * registers are never declared character. + + */ + +#define QUOTE 0200 + +#define TRIM 0177 + +#define CTRL(c) ('c' & 037) + +#define NL CTRL(j) + +#define CR CTRL(m) + +#define DELETE 0177 /* See also ATTN, QUIT in ex_tune.h */ + +#define ESCAPE 033 + + + +/* + + * Miscellaneous random variables used in more than one place + + */ + +bool aiflag; /* Append/change/insert with autoindent */ + +bool anymarks; /* We have used '[a-z] */ + +int chng; /* Warn "No write" */ + +char *Command; + +short defwind; /* -w# change default window size */ + +int dirtcnt; /* When >= MAXDIRT, should sync temporary */ +++#ifdef TIOCLGET +++bool dosusp; /* Do SIGTSTP in visual when ^Z typed */ +++#endif + +bool edited; /* Current file is [Edited] */ + +line *endcore; /* Last available core location */ + +bool endline; /* Last cmd mode command ended with \n */ + +#ifndef VMUNIX + +short erfile; /* Error message file unit */ + +#endif + +line *fendcore; /* First address in line pointer space */ + +char file[FNSIZE]; /* Working file name */ + +char genbuf[LBSIZE]; /* Working buffer when manipulating linebuf */ + +bool hush; /* Command line option - was given, hush up! */ + +char *globp; /* (Untyped) input string to command mode */ + +bool holdcm; /* Don't cursor address */ +++bool inappend; /* in ex command append mode */ + +bool inglobal; /* Inside g//... or v//... */ + +char *initev; /* Initial : escape for visual */ + +bool inopen; /* Inside open or visual */ + +char *input; /* Current position in cmd line input buffer */ + +bool intty; /* Input is a tty */ + +short io; /* General i/o unit (auto-closed on error!) */ + +short lastc; /* Last character ret'd from cmd input */ + +bool laste; /* Last command was an "e" (or "rec") */ + +char lastmac; /* Last macro called for ** */ + +char lasttag[TAGSIZE]; /* Last argument to a tag command */ + +char *linebp; /* Used in substituting in \n */ + +char linebuf[LBSIZE]; /* The primary line buffer */ + +bool listf; /* Command should run in list mode */ + +char *loc1; /* Where re began to match (in linebuf) */ + +char *loc2; /* First char after re match (") */ + +line names['z'-'a'+2]; /* Mark registers a-z,' */ + +int notecnt; /* Count for notify (to visual from cmd) */ + +bool numberf; /* Command should run in number mode */ + +char obuf[BUFSIZ]; /* Buffer for tty output */ +++short oprompt; /* Saved during source */ + +short ospeed; /* Output speed (from gtty) */ + +int otchng; /* Backup tchng to find changes in macros */ + +short peekc; /* Peek ahead character (cmd mode input) */ + +char *pkill[2]; /* Trim for put with ragged (LISP) delete */ + +bool pfast; /* Have stty -nl'ed to go faster */ + +int pid; /* Process id of child */ + +int ppid; /* Process id of parent (e.g. main ex proc) */ + +jmp_buf resetlab; /* For error throws to top level (cmd mode) */ + +int rpid; /* Pid returned from wait() */ + +bool ruptible; /* Interruptible is normal state */ +++bool seenprompt; /* 1 if have gotten user input */ + +bool shudclob; /* Have a prompt to clobber (e.g. on ^D) */ + +int status; /* Status returned from wait() */ + +int tchng; /* If nonzero, then [Modified] */ + +short tfile; /* Temporary file unit */ + +bool vcatch; /* Want to catch an error (open/visual) */ + +jmp_buf vreslab; /* For error throws to a visual catch */ +++bool writing; /* 1 if in middle of a file write */ + +int xchng; /* Suppresses multiple "No writes" in !cmd */ + + + +/* + + * Macros + + */ + +#define CP(a, b) (ignore(strcpy(a, b))) +++ /* +++ * FIXUNDO: do we want to mung undo vars? +++ * Usually yes unless in a macro or global. +++ */ +++#define FIXUNDO (inopen >= 0 && (inopen || !inglobal)) + +#define ckaw() {if (chng && value(AUTOWRITE)) wop(0);} + +#define copy(a,b,c) Copy((char *) a, (char *) b, c) + +#define eq(a, b) ((a) && (b) && strcmp(a, b) == 0) + +#define getexit(a) copy(a, resetlab, sizeof (jmp_buf)) + +#define lastchar() lastc + +#define outchar(c) (*Outchar)(c) + +#define pastwh() (ignore(skipwh())) + +#define pline(no) (*Pline)(no) + +#define reset() longjmp(resetlab,1) + +#define resexit(a) copy(resetlab, a, sizeof (jmp_buf)) + +#define setexit() setjmp(resetlab) + +#define setlastchar(c) lastc = c + +#define ungetchar(c) peekc = c + + + +#define CATCH vcatch = 1; if (setjmp(vreslab) == 0) { + +#define ONERR } else { vcatch = 0; + +#define ENDCATCH } vcatch = 0; + + + +/* + + * Environment like memory + + */ + +char altfile[FNSIZE]; /* Alternate file name */ - char direct[32]; /* Temp file goes here */ - char shell[32]; /* Copied to be settable */ - char ttytype[16]; /* A long and pretty name */ +++char direct[ONMSZ]; /* Temp file goes here */ +++char shell[ONMSZ]; /* Copied to be settable */ +++char ttytype[ONMSZ]; /* A long and pretty name */ + +char uxb[UXBSIZE + 2]; /* Last !command for !! */ + + + +/* + + * The editor data structure for accessing the current file consists + + * of an incore array of pointers into the temporary file tfile. + + * Each pointer is 15 bits (the low bit is used by global) and is + + * padded with zeroes to make an index into the temp file where the + + * actual text of the line is stored. + + * + + * To effect undo, copies of affected lines are saved after the last + + * line considered to be in the buffer, between dol and unddol. + + * During an open or visual, which uses the command mode undo between + + * dol and unddol, a copy of the entire, pre-command buffer state + + * is saved between unddol and truedol. + + */ + +line *addr1; /* First addressed line in a command */ + +line *addr2; /* Second addressed line */ + +line *dol; /* Last line in buffer */ + +line *dot; /* Current line */ + +line *one; /* First line */ + +line *truedol; /* End of all lines, including saves */ + +line *unddol; /* End of undo saved lines */ + +line *zero; /* Points to empty slot before one */ + + + +/* + + * Undo information + + * + + * For most commands we save lines changed by salting them away between + + * dol and unddol before they are changed (i.e. we save the descriptors + + * into the temp file tfile which is never garbage collected). The + + * lines put here go back after unddel, and to complete the undo + + * we delete the lines [undap1,undap2). + + * + + * Undoing a move is much easier and we treat this as a special case. + + * Similarly undoing a "put" is a special case for although there + + * are lines saved between dol and unddol we don't stick these back + + * into the buffer. + + */ + +short undkind; + + + +line *unddel; /* Saved deleted lines go after here */ + +line *undap1; /* Beginning of new lines */ + +line *undap2; /* New lines end before undap2 */ + +line *undadot; /* If we saved all lines, dot reverts here */ + + + +#define UNDCHANGE 0 + +#define UNDMOVE 1 + +#define UNDALL 2 + +#define UNDNONE 3 + +#define UNDPUT 4 + + +++#ifdef CRYPT +++/* +++ * Various miscellaneous flags and buffers needed by the encryption routines. +++ */ +++#define KSIZE 9 /* key size for encryption */ +++#define KEYPROMPT "Key: " +++int xflag; /* True if we are in encryption mode */ +++int xtflag; /* True if the temp file is being encrypted */ +++int kflag; /* True if the key has been accepted */ +++char perm[768]; +++char tperm[768]; +++char *key; +++char crbuf[CRSIZE]; +++char *getpass(); +++#endif +++ + +/* + + * Function type definitions + + */ + +#define NOSTR (char *) 0 + +#define NOLINE (line *) 0 + + + +int (*Outchar)(); + +int (*Pline)(); + +int (*Putchar)(); + +int (*oldhup)(); + +int (*setlist())(); + +int (*setnorm())(); + +int (*setnorm())(); + +int (*setnumb())(); + +line *address(); + +char *cgoto(); + +char *genindent(); + +char *getblock(); + +char *getenv(); + +line *getmark(); + +char *longname(); + +char *mesg(); + +char *place(); + +char *plural(); + +line *scanfor(); + +line *setin(); + +char *strcat(); + +char *strcpy(); + +char *strend(); + +char *tailpath(); + +char *tgetstr(); + +char *tgoto(); + +char *ttyname(); + +line *vback(); + +char *vfindcol(); + +char *vgetline(); + +char *vinit(); + +char *vpastwh(); + +char *vskipwh(); + +int put(); + +int putreg(); + +int YANKreg(); + +int delete(); + +int execl(); + +int filter(); + +int getfile(); + +int getsub(); + +int gettty(); + +int join(); + +int listchar(); + +off_t lseek(); + +int normchar(); + +int normline(); + +int numbline(); + +int (*oldquit)(); + +int onhup(); + +int onintr(); +++int onsusp(); + +int putch(); + +int shift(); + +int termchar(); + +int vfilter(); + +#ifdef CBREAK + +int vintr(); + +#endif + +int vputch(); + +int vshftop(); + +int yank(); + + + +/* + + * C doesn't have a (void) cast, so we have to fake it for lint's sake. + + */ + +#ifdef lint + +# define ignore(a) Ignore((char *) (a)) + +# define ignorf(a) Ignorf((int (*) ()) (a)) + +#else + +# define ignore(a) a + +# define ignorf(a) a + +#endif diff --cc usr/src/cmd/ex/ex_addr.c index 0000000000,5621e5e590,0000000000..89cfe03025 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_addr.c +++ b/usr/src/cmd/ex/ex_addr.c @@@@ -1,0 -1,299 -1,0 +1,305 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)ex_addr.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_re.h" + + + +/* + + * Routines for address parsing and assignment and checking of address bounds + + * in command mode. The routine address is called from ex_cmds.c + + * to parse each component of a command (terminated by , ; or the beginning + + * of the command itself. It is also called by the scanning routine + + * in ex_voperate.c from within open/visual. + + * + + * Other routines here manipulate the externals addr1 and addr2. + + * These are the first and last lines for the current command. + + * + + * The variable bigmove remembers whether a non-local glitch of . was + + * involved in an address expression, so we can set the previous context + + * mark '' when such a motion occurs. + + */ + + + +static bool bigmove; + + + +/* + + * Set up addr1 and addr2 for commands whose default address is dot. + + */ + +setdot() + +{ + + + + setdot1(); + + if (bigmove) + + markDOT(); + +} + + + +/* + + * Call setdot1 to set up default addresses without ever + + * setting the previous context mark. + + */ + +setdot1() + +{ + + + + if (addr2 == 0) + + addr1 = addr2 = dot; + + if (addr1 > addr2) { + + notempty(); + + error("Addr1 > addr2|First address exceeds second"); + + } + +} + + + +/* + + * Ex allows you to say + + * delete 5 + + * to delete 5 lines, etc. + + * Such nonsense is implemented by setcount. + + */ + +setcount() + +{ + + register int cnt; + + + + pastwh(); + + if (!isdigit(peekchar())) { + + setdot(); + + return; + + } + + addr1 = addr2; + + setdot(); + + cnt = getnum(); + + if (cnt <= 0) + + error("Bad count|Nonzero count required"); + + addr2 += cnt - 1; + + if (addr2 > dol) + + addr2 = dol; + + nonzero(); + +} + + + +/* + + * Parse a number out of the command input stream. + + */ + +getnum() + +{ + + register int cnt; + + + + for (cnt = 0; isdigit(peekcd());) + + cnt = cnt * 10 + getchar() - '0'; + + return (cnt); + +} + + + +/* + + * Set the default addresses for commands which use the whole + + * buffer as default, notably write. + + */ + +setall() + +{ + + + + if (addr2 == 0) { + + addr1 = one; + + addr2 = dol; + + if (dol == zero) { + + dot = zero; + + return; + + } + + } + + /* + + * Don't want to set previous context mark so use setdot1(). + + */ + + setdot1(); + +} + + + +/* + + * No address allowed on, e.g. the file command. + + */ + +setnoaddr() + +{ + + + + if (addr2 != 0) + + error("No address allowed@on this command"); + +} + + + +/* + + * Parse an address. + + * Just about any sequence of address characters is legal. + + * + + * If you are tricky you can use this routine and the = command + + * to do simple addition and subtraction of cardinals less + + * than the number of lines in the file. + + */ + +line * + +address(inline) + + char *inline; + +{ + + register line *addr; + + register int offset, c; + + short lastsign; + + + + bigmove = 0; + + lastsign = 0; + + offset = 0; + + addr = 0; + + for (;;) { + + if (isdigit(peekcd())) { + + if (addr == 0) { + + addr = zero; + + bigmove = 1; + + } + + loc1 = 0; + + addr += offset; + + offset = getnum(); + + if (lastsign >= 0) + + addr += offset; + + else + + addr -= offset; + + lastsign = 0; + + offset = 0; + + } + + switch (c = getcd()) { + + + + case '?': + + case '/': + + case '$': + + case '\'': + + case '\\': + + bigmove++; + + case '.': + + if (addr || offset) + + error("Badly formed address"); + + } + + offset += lastsign; + + lastsign = 0; + + switch (c) { + + + + case ' ': + + case '\t': + + continue; + + + + case '+': + + lastsign = 1; + + if (addr == 0) + + addr = dot; + + continue; + + + + case '^': + + case '-': + + lastsign = -1; + + if (addr == 0) + + addr = dot; + + continue; + + + + case '\\': + + case '?': + + case '/': + + c = compile(c, 1); + + notempty(); + + savere(scanre); + + addr = dot; + + if (inline && execute(0, dot)) { + + if (c == '/') { - while (loc1 <= inline) +++ while (loc1 <= inline) { +++ if (loc1 == loc2) +++ loc2++; + + if (!execute(1)) + + goto nope; +++ } + + break; + + } else if (loc1 < inline) { + + char *last; + +doques: + + + + do { + + last = loc1; +++ if (loc1 == loc2) +++ loc2++; + + if (!execute(1)) + + break; + + } while (loc1 < inline); + + loc1 = last; + + break; + + } + + } + +nope: + + for (;;) { + + if (c == '/') { + + addr++; + + if (addr > dol) { + + if (value(WRAPSCAN) == 0) + +error("No match to BOTTOM|Address search hit BOTTOM without matching pattern"); + + addr = zero; + + } + + } else { + + addr--; + + if (addr < zero) { + + if (value(WRAPSCAN) == 0) + +error("No match to TOP|Address search hit TOP without matching pattern"); + + addr = dol; + + } + + } + + if (execute(0, addr)) { + + if (inline && c == '?') { + + inline = &linebuf[LBSIZE]; + + goto doques; + + } + + break; + + } + + if (addr == dot) + + error("Fail|Pattern not found"); + + } + + continue; + + + + case '$': + + addr = dol; + + continue; + + + + case '.': + + addr = dot; + + continue; + + + + case '\'': + + c = markreg(getchar()); + + if (c == 0) + + error("Marks are ' and a-z"); + + addr = getmark(c); + + if (addr == 0) + + error("Undefined mark@referenced"); + + break; + + + + default: + + ungetchar(c); + + if (offset) { + + if (addr == 0) + + addr = dot; + + addr += offset; + + loc1 = 0; + + } + + if (addr == 0) { + + bigmove = 0; + + return (0); + + } + + if (addr != zero) + + notempty(); + + addr += lastsign; + + if (addr < zero) + + error("Negative address@- first buffer line is 1"); + + if (addr > dol) + + error("Not that many lines@in buffer"); + + return (addr); + + } + + } + +} + + + +/* + + * Abbreviations to make code smaller + + * Left over from squashing ex version 1.1 into + + * 11/34's and 11/40's. + + */ + +setCNL() + +{ + + + + setcount(); + + newline(); + +} + + + +setNAEOL() + +{ + + + + setnoaddr(); + + eol(); + +} diff --cc usr/src/cmd/ex/ex_argv.h index 0000000000,666045b3a5,0000000000..10fff2afd7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_argv.h +++ b/usr/src/cmd/ex/ex_argv.h @@@@ -1,0 -1,26 -1,0 +1,27 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* sccs id: @(#)ex_argv.h 6.1 10/18/80 */ + +/* + + * The current implementation of the argument list is poor, + + * using an argv even for internally done "next" commands. + + * It is not hard to see that this is restrictive and a waste of + + * space. The statically allocated glob structure could be replaced + + * by a dynamically allocated argument area space. + + */ + +char **argv; + +char **argv0; + +char *args; + +char *args0; + +short argc; + +short argc0; + +short morargc; /* Used with "More files to edit..." */ + + + +int firstln; /* From +lineno */ + +char *firstpat; /* From +/pat */ + + + +/* Yech... */ + +struct glob { + + short argc; /* Index of current file in argv */ + + short argc0; /* Number of arguments in argv */ + + char *argv[NARGS + 1]; /* WHAT A WASTE! */ + + char argspac[NCARGS + sizeof (int)]; + +} frob; diff --cc usr/src/cmd/ex/ex_cmds.c index 0000000000,d577f8976c,0000000000..19014a1bed mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_cmds.c +++ b/usr/src/cmd/ex/ex_cmds.c @@@@ -1,0 -1,791 -1,0 +1,871 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_cmds.c 6.3 11/3/80"; + +#include "ex.h" + +#include "ex_argv.h" + +#include "ex_temp.h" + +#include "ex_tty.h" + + + +bool pflag, nflag; + +int poffset; + + + +#define nochng() lchng = chng + + + +/* + + * Main loop for command mode command decoding. + + * A few commands are executed here, but main function + + * is to strip command addresses, do a little address oriented + + * processing and call command routines to do the real work. + + */ + +commands(noprompt, exitoneof) + + bool noprompt, exitoneof; + +{ + + register line *addr; + + register int c; + + register int lchng; + + int given; + + int seensemi; + + int cnt; + + bool hadpr; + + + + resetflav(); + + nochng(); + + for (;;) { + + /* + + * If dot at last command + + * ended up at zero, advance to one if there is a such. + + */ + + if (dot <= zero) { + + dot = zero; + + if (dol > zero) + + dot = one; + + } + + shudclob = 0; + + + + /* + + * If autoprint or trailing print flags, + + * print the line at the specified offset + + * before the next command. + + */ + + if (pflag || + + lchng != chng && value(AUTOPRINT) && !inglobal && !inopen && endline) { + + pflag = 0; + + nochng(); + + if (dol != zero) { + + addr1 = addr2 = dot + poffset; + + if (addr1 < one || addr1 > dol) + +error("Offset out-of-bounds|Offset after command too large"); + + setdot1(); + + goto print; + + } + + } + + nochng(); + + + + /* + + * Print prompt if appropriate. + + * If not in global flush output first to prevent + + * going into pfast mode unreasonably. + + */ + + if (inglobal == 0) { + + flush(); + + if (!hush && value(PROMPT) && !globp && !noprompt && endline) { + + putchar(':'); + + hadpr = 1; + + } + + TSYNC(); + + } + + + + /* + + * Gobble up the address. + + * Degenerate addresses yield ".". + + */ + + addr2 = 0; + + given = seensemi = 0; + + do { + + addr1 = addr2; + + addr = address(0); + + c = getcd(); + + if (addr == 0) + + if (c == ',') + + addr = dot; + + else if (addr1 != 0) { + + addr2 = dot; + + break; + + } else + + break; + + addr2 = addr; + + given++; + + if (c == ';') { + + c = ','; + + dot = addr; + + seensemi = 1; + + } + + } while (c == ','); + + if (c == '%') { + + /* %: same as 1,$ */ + + addr1 = one; + + addr2 = dol; + + given = 2; + + c = getchar(); + + } + + if (addr1 == 0) + + addr1 = addr2; + + if (c == ':') + + c = getchar(); + + + + /* + + * Set command name for special character commands. + + */ + + tailspec(c); + + + + /* + + * If called via : escape from open or visual, limit + + * the set of available commands here to save work below. + + */ + + if (inopen) { + + if (c=='\n' || c=='\r' || c==CTRL(d) || c==EOF) { + + if (addr2) + + dot = addr2; + + if (c == EOF) + + return; + + continue; + + } + + if (any(c, "o")) + +notinvis: + + tailprim(Command, 1, 1); + + } + +choice: + + switch (c) { + + + + case 'a': + + - if (peekchar() == 'r') { +++ switch(peekchar()) { +++ case 'b': +++/* abbreviate */ +++ tail("abbreviate"); +++ setnoaddr(); +++ mapcmd(0, 1); +++ anyabbrs = 1; +++ continue; +++ case 'r': + +/* args */ + + tail("args"); + + setnoaddr(); + + eol(); + + pargs(); + + continue; + + } + + + +/* append */ + + if (inopen) + + goto notinvis; + + tail("append"); + + setdot(); + + aiflag = exclam(); + + newline(); +++ vmacchng(0); + + deletenone(); + + setin(addr2); +++ inappend = 1; + + ignore(append(gettty, addr2)); +++ inappend = 0; + + nochng(); + + continue; + + + + case 'c': + + switch (peekchar()) { + + + +/* copy */ + + case 'o': + + tail("copy"); +++ vmacchng(0); + + move(); + + continue; + + + +#ifdef CHDIR + +/* cd */ + + case 'd': + + tail("cd"); + + goto changdir; + + + +/* chdir */ + + case 'h': + + ignchar(); + + if (peekchar() == 'd') { + + register char *p; + + tail2of("chdir"); + +changdir: + + if (savedfile[0] == '/' || !value(WARN)) + + ignore(exclam()); + + else + + ignore(quickly()); + + if (skipend()) { + + p = getenv("HOME"); + + if (p == NULL) + + error("Home directory unknown"); + + } else + + getone(), p = file; + + eol(); + + if (chdir(p) < 0) + + filioerr(p); + + if (savedfile[0] != '/') + + edited = 0; + + continue; + + } + + if (inopen) + + tailprim("change", 2, 1); + + tail2of("change"); + + break; + + + +#endif + + default: + + if (inopen) + + goto notinvis; + + tail("change"); + + break; + + } + +/* change */ + + aiflag = exclam(); + + setCNL(); +++ vmacchng(0); + + setin(addr1); + + delete(0); +++ inappend = 1; + + ignore(append(gettty, addr1 - 1)); +++ inappend = 0; + + nochng(); + + continue; + + + +/* delete */ + + case 'd': + + /* + + * Caution: dp and dl have special meaning already. + + */ + + tail("delete"); + + c = cmdreg(); + + setCNL(); +++ vmacchng(0); + + if (c) + + YANKreg(c); + + delete(0); + + appendnone(); + + continue; + + + +/* edit */ + +/* ex */ + + case 'e': + + tail(peekchar() == 'x' ? "ex" : "edit"); +++editcmd: + + if (!exclam() && chng) + + c = 'E'; + + filename(c); + + if (c == 'E') { + + ungetchar(lastchar()); + + ignore(quickly()); + + } + + setnoaddr(); + +doecmd: + + init(); + + addr2 = zero; + + laste++; + + sync(); + + rop(c); + + nochng(); + + continue; + + + +/* file */ + + case 'f': + + tail("file"); + + setnoaddr(); + + filename(c); + + noonl(); + +/* + + synctmp(); + +*/ + + continue; + + + +/* global */ + + case 'g': + + tail("global"); + + global(!exclam()); + + nochng(); + + continue; + + + +/* insert */ + + case 'i': + + if (inopen) + + goto notinvis; + + tail("insert"); + + setdot(); + + nonzero(); + + aiflag = exclam(); + + newline(); +++ vmacchng(0); + + deletenone(); + + setin(addr2); +++ inappend = 1; + + ignore(append(gettty, addr2 - 1)); +++ inappend = 0; + + if (dot == zero && dol > zero) + + dot = one; + + nochng(); + + continue; + + + +/* join */ + + case 'j': + + tail("join"); + + c = exclam(); + + setcount(); + + nonzero(); + + newline(); +++ vmacchng(0); + + if (given < 2 && addr2 != dol) + + addr2++; + + join(c); + + continue; + + + +/* k */ + + case 'k': + +casek: + + pastwh(); + + c = getchar(); + + if (endcmd(c)) + + serror("Mark what?|%s requires following letter", Command); + + newline(); + + if (!islower(c)) + + error("Bad mark|Mark must specify a letter"); + + setdot(); + + nonzero(); + + names[c - 'a'] = *addr2 &~ 01; + + anymarks = 1; + + continue; + + + +/* list */ + + case 'l': + + tail("list"); + + setCNL(); + + ignorf(setlist(1)); + + pflag = 0; + + goto print; + + + + case 'm': + + if (peekchar() == 'a') { + + ignchar(); + + if (peekchar() == 'p') { + +/* map */ + + tail2of("map"); + + setnoaddr(); - mapcmd(0); +++ mapcmd(0, 0); + + continue; + + } + +/* mark */ + + tail2of("mark"); + + goto casek; + + } + +/* move */ + + tail("move"); +++ vmacchng(0); + + move(); + + continue; + + + + case 'n': + + if (peekchar() == 'u') { + + tail("number"); + + goto numberit; + + } + +/* next */ + + tail("next"); + + setnoaddr(); + + ckaw(); + + ignore(quickly()); + + if (getargs()) + + makargs(); + + next(); + + c = 'e'; + + filename(c); + + goto doecmd; + + + +/* open */ + + case 'o': + + tail("open"); + + oop(); + + pflag = 0; + + nochng(); + + continue; + + + + case 'p': + + case 'P': + + switch (peekchar()) { + + + +/* put */ + + case 'u': + + tail("put"); + + setdot(); + + c = cmdreg(); + + eol(); +++ vmacchng(0); + + if (c) + + putreg(c); + + else + + put(); + + continue; + + + + case 'r': + + ignchar(); + + if (peekchar() == 'e') { + +/* preserve */ + + tail2of("preserve"); + + eol(); + + if (preserve() == 0) + + error("Preserve failed!"); + + else + + error("File preserved."); + + } + + tail2of("print"); + + break; + + + + default: + + tail("print"); + + break; + + } + +/* print */ + + setCNL(); + + pflag = 0; + +print: + + nonzero(); + + if (CL && span() > LINES) { + + flush1(); + + vclear(); + + } + + plines(addr1, addr2, 1); + + continue; + + + +/* quit */ + + case 'q': + + tail("quit"); + + setnoaddr(); + + c = quickly(); + + eol(); + + if (!c) + +quit: + + nomore(); + + if (inopen) { + + vgoto(WECHO, 0); + + if (!ateopr()) + + vnfl(); + + else { - putpad(VE); - putpad(KE); +++ tostop(); + + } + + flush(); + + setty(normf); + + } + + cleanup(1); + + exit(0); + + + + case 'r': + + if (peekchar() == 'e') { + + ignchar(); + + switch (peekchar()) { + + + +/* rewind */ + + case 'w': + + tail2of("rewind"); + + setnoaddr(); - ignore(quickly()); +++ if (!exclam()) { +++ ckaw(); +++ if (chng && dol > zero) +++ error("No write@since last chage (:rewind! overrides)"); +++ } + + eol(); + + erewind(); + + next(); + + c = 'e'; + + ungetchar(lastchar()); + + filename(c); + + goto doecmd; + + + +/* recover */ + + case 'c': + + tail2of("recover"); + + setnoaddr(); + + c = 'e'; + + if (!exclam() && chng) + + c = 'E'; + + filename(c); + + if (c == 'E') { + + ungetchar(lastchar()); + + ignore(quickly()); + + } + + init(); + + addr2 = zero; + + laste++; + + sync(); + + recover(); + + rop2(); + + revocer(); + + if (status == 0) + + rop3(c); + + if (dol != zero) + + change(); + + nochng(); + + continue; + + } + + tail2of("read"); + + } else + + tail("read"); + +/* read */ + + if (savedfile[0] == 0 && dol == zero) + + c = 'e'; + + pastwh(); +++ vmacchng(0); + + if (peekchar() == '!') { + + setdot(); + + ignchar(); + + unix0(0); + + filter(0); + + continue; + + } + + filename(c); + + rop(c); + + nochng(); + + if (inopen && endline && addr1 > zero && addr1 < dol) + + dot = addr1 + 1; + + continue; + + + + case 's': + + switch (peekchar()) { + + /* + + * Caution: 2nd char cannot be c, g, or r + + * because these have meaning to substitute. + + */ + + + +/* set */ + + case 'e': + + tail("set"); + + setnoaddr(); + + set(); + + continue; + + + +/* shell */ + + case 'h': + + tail("shell"); + + setNAEOL(); + + vnfl(); + + putpad(TE); + + flush(); + + unixwt(1, unixex("-i", (char *) 0, 0, 0)); + + vcontin(0); - putpad(TI); + + continue; + + + +/* source */ + + case 'o': +++#ifdef notdef + + if (inopen) + + goto notinvis; +++#endif + + tail("source"); + + setnoaddr(); + + getone(); + + eol(); + + source(file, 0); + + continue; +++#ifdef SIGTSTP +++/* stop, suspend */ +++ case 't': +++ tail("stop"); +++ goto suspend; +++ case 'u': +++ tail("suspend"); +++suspend: +++ if (!ldisc) +++ error("Old tty driver|Not using new tty driver/shell"); +++ c = exclam(); +++ eol(); +++ if (!c) +++ ckaw(); +++ onsusp(); +++ continue; +++#endif +++ + + } + + /* fall into ... */ + + + +/* & */ + +/* ~ */ + +/* substitute */ + + case '&': + + case '~': + + Command = "substitute"; + + if (c == 's') + + tail(Command); +++ vmacchng(0); + + if (!substitute(c)) + + pflag = 0; + + continue; + + + +/* t */ + + case 't': + + if (peekchar() == 'a') { + + tail("tag"); + + tagfind(exclam()); + + if (!inopen) + + lchng = chng - 1; + + else + + nochng(); + + continue; + + } + + tail("t"); +++ vmacchng(0); + + move(); + + continue; + + + + case 'u': + + if (peekchar() == 'n') { - /* unmap */ + + ignchar(); - if (peekchar() == 'm') { +++ switch(peekchar()) { +++/* unmap */ +++ case 'm': + + tail2of("unmap"); + + setnoaddr(); - mapcmd(1); +++ mapcmd(1, 0); +++ continue; +++/* unabbreviate */ +++ case 'a': +++ tail2of("unabbreviate"); +++ setnoaddr(); +++ mapcmd(1, 1); +++ anyabbrs = 1; + + continue; + + } + +/* undo */ + + tail2of("undo"); + + } else + + tail("undo"); + + setnoaddr(); + + markDOT(); + + c = exclam(); + + newline(); + + undo(c); + + continue; + + + + case 'v': + + switch (peekchar()) { + + + + case 'e': + +/* version */ + + tail("version"); + + setNAEOL(); - /* should use SCCS subst here */ - printf("Version 3.2, January 4, 1980"); +++ printf("@(#) Version 3.6, 11/3/80."+5); + + noonl(); + + continue; + + + +/* visual */ + + case 'i': + + tail("visual"); +++ if (inopen) { +++ c = 'e'; +++ goto editcmd; +++ } + + vop(); + + pflag = 0; + + nochng(); + + continue; + + } + +/* v */ + + tail("v"); + + global(0); + + nochng(); + + continue; + + + +/* write */ + + case 'w': + + c = peekchar(); + + tail(c == 'q' ? "wq" : "write"); +++wq: + + if (skipwh() && peekchar() == '!') { +++ pofix(); + + ignchar(); + + setall(); + + unix0(0); + + filter(1); + + } else { + + setall(); + + wop(1); + + nochng(); + + } + + if (c == 'q') + + goto quit; + + continue; + + +++/* xit */ +++ case 'x': +++ tail("xit"); +++ if (!chng) +++ goto quit; +++ c = 'q'; +++ goto wq; +++ + +/* yank */ + + case 'y': + + tail("yank"); + + c = cmdreg(); + + setcount(); + + eol(); +++ vmacchng(0); + + if (c) + + YANKreg(c); + + else + + yank(); + + continue; + + + +/* z */ + + case 'z': + + zop(0); + + pflag = 0; + + continue; + + + +/* * */ + +/* @ */ + + case '*': + + case '@': + + c = getchar(); + + if (c=='\n' || c=='\r') + + ungetchar(c); + + if (any(c, "@*\n\r")) + + c = lastmac; + + if (isupper(c)) + + c = tolower(c); + + if (!islower(c)) + + error("Bad register"); + + newline(); + + setdot(); + + cmdmac(c); + + continue; + + + +/* | */ + + case '|': + + endline = 0; + + goto caseline; + + + +/* \n */ + + case '\n': + + endline = 1; + +caseline: + + notempty(); + + if (addr2 == 0) { - if (dot == dol) - error("At EOF|At end-of-file"); + + if (UP != NOSTR && c == '\n' && !inglobal) + + c = CTRL(k); + + if (inglobal) + + addr1 = addr2 = dot; - else +++ else { +++ if (dot == dol) +++ error("At EOF|At end-of-file"); + + addr1 = addr2 = dot + 1; +++ } + + } + + setdot(); + + nonzero(); + + if (seensemi) + + addr1 = addr2; + + getline(*addr1); + + if (c == CTRL(k)) { + + flush1(); + + destline--; + + if (hadpr) + + shudclob = 1; + + } + + plines(addr1, addr2, 1); + + continue; + + +++/* " */ +++ case '"': +++ comment(); +++ continue; +++ + +/* # */ + + case '#': + +numberit: + + setCNL(); + + ignorf(setnumb(1)); + + pflag = 0; + + goto print; + + + +/* = */ + + case '=': + + newline(); + + setall(); +++ if (inglobal == 2) +++ pofix(); + + printf("%d", lineno(addr2)); + + noonl(); + + continue; + + + +/* ! */ + + case '!': + + if (addr2 != 0) { +++ vmacchng(0); + + unix0(0); + + setdot(); + + filter(2); + + } else { + + unix0(1); - vnfl(); +++ pofix(); + + putpad(TE); + + flush(); + + unixwt(1, unixex("-c", uxb, 0, 0)); - vcontin(1); - putpad(TI); +++ vclrech(1); /* vcontin(0); */ + + nochng(); + + } + + continue; + + + +/* < */ + +/* > */ + + case '<': + + case '>': + + for (cnt = 1; peekchar() == c; cnt++) + + ignchar(); + + setCNL(); +++ vmacchng(0); + + shift(c, cnt); + + continue; + + + +/* ^D */ + +/* EOF */ + + case CTRL(d): + + case EOF: + + if (exitoneof) { + + if (addr2 != 0) + + dot = addr2; + + return; + + } + + if (!isatty(0)) { + + if (intty) + + /* + + * Chtty sys call at UCB may cause a + + * input which was a tty to suddenly be + + * turned into /dev/null. + + */ + + onhup(); + + return; + + } + + if (addr2 != 0) { + + setlastchar('\n'); + + putnl(); + + } + + if (dol == zero) { + + if (addr2 == 0) + + putnl(); + + notempty(); + + } + + ungetchar(EOF); + + zop(hadpr); + + continue; + + + + default: + + if (!isalpha(c)) + + break; + + ungetchar(c); + + tailprim("", 0, 0); + + } + + error("What?|Unknown command character '%c'", c); + + } + +} diff --cc usr/src/cmd/ex/ex_cmds2.c index 0000000000,95deb537d4,0000000000..86dbca8b01 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_cmds2.c +++ b/usr/src/cmd/ex/ex_cmds2.c @@@@ -1,0 -1,508 -1,0 +1,556 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_cmds2.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_argv.h" + +#include "ex_temp.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +bool pflag, nflag; + +int poffset; + + + +/* + + * Subroutines for major command loop. + + */ + + + +/* + + * Is there a single letter indicating a named buffer next? + + */ + +cmdreg() + +{ + + register int c = 0; + + register int wh = skipwh(); + + + + if (wh && isalpha(peekchar())) + + c = getchar(); + + return (c); + +} + + + +/* + + * Tell whether the character ends a command + + */ + +endcmd(ch) + + int ch; + +{ + + switch (ch) { + + + + case '\n': + + case EOF: + + endline = 1; + + return (1); + + + + case '|': +++ case '"': + + endline = 0; + + return (1); + + } + + return (0); + +} + + + +/* + + * Insist on the end of the command. + + */ + +eol() + +{ + + + + if (!skipend()) + + error("Extra chars|Extra characters at end of command"); + + ignnEOF(); + +} + + + +/* + + * Print out the message in the error message file at str, + + * with i an integer argument to printf. + + */ + +/*VARARGS2*/ + +error(str, i) + +#ifdef lint + + register char *str; + +#else + + register int str; + +#endif + + int i; + +{ + + + + error0(); + + merror(str, i); +++ if (writing) { +++ serror(" [Warning - %s is incomplete]", file); +++ writing = 0; +++ } + + error1(str); + +} + + + +/* + + * Rewind the argument list. + + */ + +erewind() + +{ + + + + argc = argc0; + + argv = argv0; + + args = args0; + + if (argc > 1 && !hush) { + + printf(mesg("%d files@to edit"), argc); + + if (inopen) + + putchar(' '); + + else + + putNFL(); + + } + +} + + + +/* + + * Guts of the pre-printing error processing. + + * If in visual and catching errors, then we dont mung up the internals, + + * just fixing up the echo area for the print. + + * Otherwise we reset a number of externals, and discard unused input. + + */ + +error0() + +{ + + +++ if (laste) { +++#ifdef VMUNIX +++ tlaste(); +++#endif +++ laste = 0; +++ sync(); +++ } + + if (vcatch) { + + if (splitw == 0) + + fixech(); + + if (!SO || !SE) + + dingdong(); + + return; + + } + + if (input) { + + input = strend(input) - 1; + + if (*input == '\n') + + setlastchar('\n'); + + input = 0; + + } + + setoutt(); + + flush(); + + resetflav(); - if (laste) { - laste = 0; - sync(); - } + + if (!SO || !SE) + + dingdong(); + + if (inopen) { + + /* + + * We are coming out of open/visual ungracefully. + + * Restore COLUMNS, undo, and fix tty mode. + + */ + + COLUMNS = OCOLUMNS; + + undvis(); + + ostop(normf); +++ /* ostop should be doing this + + putpad(VE); + + putpad(KE); +++ */ + + putnl(); + + } + + inopen = 0; + + holdcm = 0; + +} + + + +/* + + * Post error printing processing. + + * Close the i/o file if left open. + + * If catching in visual then throw to the visual catch, + + * else if a child after a fork, then exit. + + * Otherwise, in the normal command mode error case, + + * finish state reset, and throw to top. + + */ + +error1(str) + + char *str; + +{ + + bool die; + + + + if (io > 0) { + + close(io); + + io = -1; + + } + + die = (getpid() != ppid); /* Only children die */ +++ inappend = inglobal = 0; +++ globp = vglobp = vmacp = 0; + + if (vcatch && !die) { - inglobal = 0; - vglobp = vmacp = 0; + + inopen = 1; + + vcatch = 0; +++ if (str) +++ noonl(); + + fixol(); + + longjmp(vreslab,1); + + } + + if (str && !vcatch) + + putNFL(); + + if (die) + + exit(1); + + lseek(0, 0L, 2); + + if (inglobal) + + setlastchar('\n'); - inglobal = 0; - globp = 0; + + while (lastchar() != '\n' && lastchar() != EOF) + + ignchar(); + + ungetchar(0); + + endline = 1; + + reset(); + +} + + + +fixol() + +{ + + if (Outchar != vputchar) { + + flush(); + + if (state == ONEOPEN || state == HARDOPEN) + + outline = destline = 0; + + Outchar = vputchar; + + vcontin(1); + + } else { + + if (destcol) + + vclreol(); + + vclean(); + + } + +} + + + +/* + + * Does an ! character follow in the command stream? + + */ + +exclam() + +{ + + + + if (peekchar() == '!') { + + ignchar(); + + return (1); + + } + + return (0); + +} + + + +/* + + * Make an argument list for e.g. next. + + */ + +makargs() + +{ + + + + glob(&frob); + + argc0 = frob.argc0; + + argv0 = frob.argv; + + args0 = argv0[0]; + + erewind(); + +} + + + +/* + + * Advance to next file in argument list. + + */ + +next() + +{ +++ extern short isalt; /* defined in ex_io.c */ + + + + if (argc == 0) + + error("No more files@to edit"); + + morargc = argc; +++ isalt = (strcmp(altfile, args)==0) + 1; + + if (savedfile[0]) + + CP(altfile, savedfile); + + CP(savedfile, args); + + argc--; + + args = argv ? *++argv : strend(args) + 1; + +} + + + +/* + + * Eat trailing flags and offsets after a command, + + * saving for possible later post-command prints. + + */ + +newline() + +{ + + register int c; + + + + resetflav(); + + for (;;) { + + c = getchar(); + + switch (c) { + + + + case '^': + + case '-': + + poffset--; + + break; + + + + case '+': + + poffset++; + + break; + + + + case 'l': + + listf++; + + break; + + + + case '#': + + nflag++; + + break; + + + + case 'p': + + listf = 0; + + break; + + + + case ' ': + + case '\t': + + continue; + + +++ case '"': +++ comment(); +++ setflav(); +++ return; +++ + + default: + + if (!endcmd(c)) + +serror("Extra chars|Extra characters at end of \"%s\" command", Command); + + if (c == EOF) + + ungetchar(c); + + setflav(); + + return; + + } + + pflag++; + + } + +} + + + +/* + + * Before quit or respec of arg list, check that there are + + * no more files in the arg list. + + */ + +nomore() + +{ + + + + if (argc == 0 || morargc == argc) + + return; + + morargc = argc; + + merror("%d more file", argc); + + serror("%s@to edit", plural((long) argc)); + +} + + + +/* + + * Before edit of new file check that either an ! follows + + * or the file has not been changed. + + */ + +quickly() + +{ + + + + if (exclam()) + + return (1); + + if (chng && dol > zero) { + +/* + + chng = 0; + +*/ + + xchng = 0; + + error("No write@since last change (:%s! overrides)", Command); + + } + + return (0); + +} + + + +/* + + * Reset the flavor of the output to print mode with no numbering. + + */ + +resetflav() + +{ + + + + if (inopen) + + return; + + listf = 0; + + nflag = 0; + + pflag = 0; + + poffset = 0; + + setflav(); + +} + + + +/* + + * Print an error message with a %s type argument to printf. + + * Message text comes from error message file. + + */ + +serror(str, cp) + +#ifdef lint + + register char *str; + +#else + + register int str; + +#endif + + char *cp; + +{ + + + + error0(); + + smerror(str, cp); + + error1(str); + +} + + + +/* + + * Set the flavor of the output based on the flags given + + * and the number and list options to either number or not number lines + + * and either use normally decoded (ARPAnet standard) characters or list mode, + + * where end of lines are marked and tabs print as ^I. + + */ + +setflav() + +{ + + + + if (inopen) + + return; + + setnumb(nflag || value(NUMBER)); + + setlist(listf || value(LIST)); + + setoutt(); + +} + + + +/* + + * Skip white space and tell whether command ends then. + + */ + +skipend() + +{ + + + + pastwh(); - return (endcmd(peekchar())); +++ return (endcmd(peekchar()) && peekchar() != '"'); + +} + + + +/* + + * Set the command name for non-word commands. + + */ + +tailspec(c) + + int c; + +{ + + static char foocmd[2]; + + + + foocmd[0] = c; + + Command = foocmd; + +} + + + +/* + + * Try to read off the rest of the command word. + + * If alphabetics follow, then this is not the command we seek. + + */ + +tail(comm) + + char *comm; + +{ + + + + tailprim(comm, 1, 0); + +} + + + +tail2of(comm) + + char *comm; + +{ + + + + tailprim(comm, 2, 0); + +} + + + +char tcommand[20]; + + + +tailprim(comm, i, notinvis) + + register char *comm; + + int i; + + bool notinvis; + +{ + + register char *cp; + + register int c; + + + + Command = comm; + + for (cp = tcommand; i > 0; i--) + + *cp++ = *comm++; + + while (*comm && peekchar() == *comm) + + *cp++ = getchar(), comm++; + + c = peekchar(); + + if (notinvis || isalpha(c)) { + + /* + + * Of the trailing lp funny business, only dl and dp + + * survive the move from ed to ex. + + */ + + if (tcommand[0] == 'd' && any(c, "lp")) + + goto ret; + + if (tcommand[0] == 's' && any(c, "gcr")) + + goto ret; + + while (cp < &tcommand[19] && isalpha(peekchar())) + + *cp++ = getchar(); + + *cp = 0; + + if (notinvis) + + serror("What?|%s: No such command from open/visual", tcommand); + + else + + serror("What?|%s: Not an editor command", tcommand); + + } + +ret: + + *cp = 0; + +} + + + +/* - * Continue after a shell escape from open/visual. +++ * Continue after a : command from open/visual. + + */ + +vcontin(ask) + + bool ask; + +{ + + + + if (vcnt > 0) + + vcnt = -vcnt; + + if (inopen) { + + if (state != VISUAL) { - /* - vtube[WECHO][0] = '*'; - vnfl(); - */ +++ /* +++ * We don't know what a shell command may have left on +++ * the screen, so we move the cursor to the right place +++ * and then put out a newline. But this makes an extra +++ * blank line most of the time so we only do it for :sh +++ * since the prompt gets left on the screen. +++ * +++ * BUG: :!echo longer than current line \\c +++ * will screw it up, but be reasonable! +++ */ +++ if (state == CRTOPEN) { +++ termreset(); +++ vgoto(WECHO, 0); +++ } +++ if (!ask) { +++ putch('\r'); +++ putch('\n'); +++ } + + return; + + } + + if (ask) { + + merror("[Hit return to continue] "); + + flush(); + + } + +#ifndef CBREAK + + vraw(); + +#endif + + if (ask) { +++#ifdef EATQS + + /* + + * Gobble ^Q/^S since the tty driver should be eating + + * them (as far as the user can see) + + */ + + while (peekkey() == CTRL(Q) || peekkey() == CTRL(S)) + + ignore(getkey()); - if(getkey() == ':') +++#endif +++ if(getkey() == ':') { +++ /* Ugh. Extra newlines, but no other way */ +++ putch('\n'); +++ outline = WECHO; + + ungetkey(':'); +++ } +++ } +++ vclrech(1); +++ if (Peekkey != ':') { +++ putpad(TI); +++ tostart(); +++ /* replaced by ostart. +++ putpad(VS); +++ putpad(KS); +++ */ + + } - putpad(VS); - putpad(KS); + + } + +} + + + +/* + + * Put out a newline (before a shell escape) + + * if in open/visual. + + */ + +vnfl() + +{ + + + + if (inopen) { + + if (state != VISUAL && state != CRTOPEN && destline <= WECHO) + + vclean(); + + else + + vmoveitup(1, 0); + + vgoto(WECHO, 0); + + vclrbyte(vtube[WECHO], WCOLS); +++ tostop(); +++ /* replaced by the ostop above + + putpad(VE); + + putpad(KE); +++ */ + + } + + flush(); + +} diff --cc usr/src/cmd/ex/ex_cmdsub.c index 0000000000,09c01d9d2f,0000000000..90e0ae963a mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_cmdsub.c +++ b/usr/src/cmd/ex/ex_cmdsub.c @@@@ -1,0 -1,1143 -1,0 +1,1283 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_cmdsub.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_argv.h" + +#include "ex_temp.h" + +#include "ex_tty.h" +++#include "ex_vis.h" + + + +/* + + * Command mode subroutines implementing + + * append, args, copy, delete, join, move, put, + + * shift, tag, yank, z and undo + + */ + + + +bool endline = 1; + +line *tad1; +++static jnoop(); + + + +/* + + * Append after line a lines returned by function f. + + * Be careful about intermediate states to avoid scramble + + * if an interrupt comes in. + + */ + +append(f, a) + + int (*f)(); + + line *a; + +{ + + register line *a1, *a2, *rdot; + + int nline; + + + + nline = 0; + + dot = a; - /* - * This is probably a bug, since it's different than the other tests - * in appendnone, delete, and deletenone. It is known to fail for - * the command :g/foo/r xxx (where there is one foo and the file - * xxx exists) and you try to undo it. I'm leaving it in for now - * because I'm afraid if I change it I'll break something. - */ - if (!inglobal && !inopen && f != getsub) { +++ if(FIXUNDO && !inopen && f!=getsub) { + + undap1 = undap2 = dot + 1; + + undkind = UNDCHANGE; + + } + + while ((*f)() == 0) { + + if (truedol >= endcore) { + + if (morelines() < 0) { - if (!inglobal && f == getsub) { +++ if (FIXUNDO && f == getsub) { + + undap1 = addr1; + + undap2 = addr2 + 1; + + } + + error("Out of memory@- too many lines in file"); + + } + + } + + nline++; + + a1 = truedol + 1; + + a2 = a1 + 1; + + dot++; + + undap2++; + + dol++; + + unddol++; + + truedol++; + + for (rdot = dot; a1 > rdot;) + + *--a2 = *--a1; + + *rdot = 0; + + putmark(rdot); + + if (f == gettty) { + + dirtcnt++; + + TSYNC(); + + } + + } + + return (nline); + +} + + + +appendnone() + +{ + + - if (inopen >= 0 && (inopen || !inglobal)) { +++ if(FIXUNDO) { + + undkind = UNDCHANGE; + + undap1 = undap2 = addr1; + + } + +} + + + +/* + + * Print out the argument list, with []'s around the current name. + + */ + +pargs() + +{ + + register char **av = argv0, *as = args0; + + register int ac; + + + + for (ac = 0; ac < argc0; ac++) { + + if (ac != 0) + + putchar(' '); + + if (ac + argc == argc0 - 1) + + printf("["); + + lprintf("%s", as); + + if (ac + argc == argc0 - 1) + + printf("]"); + + as = av ? *++av : strend(as) + 1; + + } + + noonl(); + +} + + + +/* + + * Delete lines; two cases are if we are really deleting, + + * more commonly we are just moving lines to the undo save area. + + */ + +delete(hush) + + bool hush; + +{ + + register line *a1, *a2; + + + + nonzero(); - if (inopen >= 0 && (inopen || !inglobal)) { +++ if(FIXUNDO) { + + register int (*dsavint)(); + + +++#ifdef TRACE +++ if (trace) +++ vudump("before delete"); +++#endif + + change(); + + dsavint = signal(SIGINT, SIG_IGN); + + undkind = UNDCHANGE; + + a1 = addr1; + + squish(); + + a2 = addr2; + + if (a2++ != dol) { + + reverse(a1, a2); + + reverse(a2, dol + 1); + + reverse(a1, dol + 1); + + } + + dol -= a2 - a1; + + unddel = a1 - 1; + + if (a1 > dol) + + a1 = dol; + + dot = a1; + + pkill[0] = pkill[1] = 0; + + signal(SIGINT, dsavint); +++#ifdef TRACE +++ if (trace) +++ vudump("after delete"); +++#endif + + } else { + + register line *a3; + + register int i; + + + + change(); + + a1 = addr1; + + a2 = addr2 + 1; + + a3 = truedol; + + i = a2 - a1; + + unddol -= i; + + undap2 -= i; + + dol -= i; + + truedol -= i; + + do + + *a1++ = *a2++; + + while (a2 <= a3); + + a1 = addr1; + + if (a1 > dol) + + a1 = dol; + + dot = a1; + + } + + if (!hush) + + killed(); + +} + + + +deletenone() + +{ + + - if (inopen >= 0 && (inopen || !inglobal)) { +++ if(FIXUNDO) { + + undkind = UNDCHANGE; + + squish(); + + unddel = addr1; + + } + +} + + + +/* + + * Crush out the undo save area, moving the open/visual + + * save area down in its place. + + */ + +squish() + +{ + + register line *a1 = dol + 1, *a2 = unddol + 1, *a3 = truedol + 1; + + - if (inopen == -1) - return; - if (a1 < a2 && a2 < a3) - do - *a1++ = *a2++; - while (a2 < a3); - truedol -= unddol - dol; - unddol = dol; +++ if(FIXUNDO) { +++ if (inopen == -1) +++ return; +++ if (a1 < a2 && a2 < a3) +++ do +++ *a1++ = *a2++; +++ while (a2 < a3); +++ truedol -= unddol - dol; +++ unddol = dol; +++ } + +} + + + +/* + + * Join lines. Special hacks put in spaces, two spaces if + + * preceding line ends with '.', or no spaces if next line starts with ). + + */ + +static int jcount, jnoop(); + + + +join(c) + + int c; + +{ + + register line *a1; + + register char *cp, *cp1; + + + + cp = genbuf; + + *cp = 0; + + for (a1 = addr1; a1 <= addr2; a1++) { + + getline(*a1); + + cp1 = linebuf; + + if (a1 != addr1 && c == 0) { + + while (*cp1 == ' ' || *cp1 == '\t') + + cp1++; + + if (*cp1 && cp > genbuf && cp[-1] != ' ' && cp[-1] != '\t') { + + if (*cp1 != ')') { + + *cp++ = ' '; + + if (cp[-2] == '.') + + *cp++ = ' '; + + } + + } + + } + + while (*cp++ = *cp1++) + + if (cp > &genbuf[LBSIZE-2]) + + error("Line overflow|Result line of join would be too long"); + + cp--; + + } + + strcLIN(genbuf); + + delete(0); + + jcount = 1; +++ if (FIXUNDO) +++ undap1 = undap2 = addr1; + + ignore(append(jnoop, --addr1)); +++ if (FIXUNDO) +++ vundkind = VMANY; + +} + + + +static + +jnoop() + +{ + + + + return(--jcount); + +} + + + +/* + + * Move and copy lines. Hard work is done by move1 which + + * is also called by undo. + + */ + +int getcopy(); + + + +move() + +{ + + register line *adt; + + bool iscopy = 0; + + + + if (Command[0] == 'm') { + + setdot1(); + + markpr(addr2 == dot ? addr1 - 1 : addr2 + 1); + + } else { + + iscopy++; + + setdot(); + + } + + nonzero(); + + adt = address(0); + + if (adt == 0) + + serror("%s where?|%s requires a trailing address", Command); + + newline(); + + move1(iscopy, adt); + + killed(); + +} + + + +move1(cflag, addrt) + + int cflag; + + line *addrt; + +{ + + register line *adt, *ad1, *ad2; + + int lines; + + + + adt = addrt; + + lines = (addr2 - addr1) + 1; + + if (cflag) { + + tad1 = addr1; + + ad1 = dol; + + ignore(append(getcopy, ad1++)); + + ad2 = dol; + + } else { + + ad2 = addr2; + + for (ad1 = addr1; ad1 <= ad2;) + + *ad1++ &= ~01; + + ad1 = addr1; + + } + + ad2++; + + if (adt < ad1) { + + if (adt + 1 == ad1 && !cflag && !inglobal) + + error("That move would do nothing!"); + + dot = adt + (ad2 - ad1); + + if (++adt != ad1) { + + reverse(adt, ad1); + + reverse(ad1, ad2); + + reverse(adt, ad2); + + } + + } else if (adt >= ad2) { + + dot = adt++; + + reverse(ad1, ad2); + + reverse(ad2, adt); + + reverse(ad1, adt); + + } else + + error("Move to a moved line"); + + change(); + + if (!inglobal) - if (cflag) { - undap1 = addrt + 1; - undap2 = undap1 + lines; - deletenone(); - } else { - undkind = UNDMOVE; - undap1 = addr1; - undap2 = addr2; - unddel = addrt; - squish(); +++ if(FIXUNDO) { +++ if (cflag) { +++ undap1 = addrt + 1; +++ undap2 = undap1 + lines; +++ deletenone(); +++ } else { +++ undkind = UNDMOVE; +++ undap1 = addr1; +++ undap2 = addr2; +++ unddel = addrt; +++ squish(); +++ } + + } + +} + + + +getcopy() + +{ + + + + if (tad1 > addr2) + + return (EOF); + + getline(*tad1++); + + return (0); + +} + + + +/* + + * Put lines in the buffer from the undo save area. + + */ + +getput() + +{ + + + + if (tad1 > unddol) + + return (EOF); + + getline(*tad1++); + + tad1++; + + return (0); + +} + + + +put() + +{ + + register int cnt; + + +++ if (!FIXUNDO) +++ error("Cannot put inside global/macro"); + + cnt = unddol - dol; + + if (cnt && inopen && pkill[0] && pkill[1]) { + + pragged(1); + + return; + + } + + tad1 = dol + 1; + + ignore(append(getput, addr2)); + + undkind = UNDPUT; + + notecnt = cnt; + + netchange(cnt); + +} + + + +/* + + * A tricky put, of a group of lines in the middle + + * of an existing line. Only from open/visual. + + * Argument says pkills have meaning, e.g. called from + + * put; it is 0 on calls from putreg. + + */ + +pragged(kill) + + bool kill; + +{ + + extern char *cursor; + + register char *gp = &genbuf[cursor - linebuf]; + + + + /* + + * This kind of stuff is TECO's forte. + + * We just grunge along, since it cuts + + * across our line-oriented model of the world + + * almost scrambling our addled brain. + + */ + + if (!kill) + + getDOT(); + + strcpy(genbuf, linebuf); + + getline(*unddol); + + if (kill) + + *pkill[1] = 0; + + strcat(linebuf, gp); + + putmark(unddol); + + getline(dol[1]); + + if (kill) + + strcLIN(pkill[0]); + + strcpy(gp, linebuf); + + strcLIN(genbuf); + + putmark(dol+1); + + undkind = UNDCHANGE; + + undap1 = dot; + + undap2 = dot + 1; + + unddel = dot - 1; + + undo(1); + +} + + + +/* + + * Shift lines, based on c. + + * If c is neither < nor >, then this is a lisp aligning =. + + */ + +shift(c, cnt) + + int c; + + int cnt; + +{ + + register line *addr; + + register char *cp; + + char *dp; + + register int i; + + - if (!inglobal) +++ if(FIXUNDO) + + save12(), undkind = UNDCHANGE; + + cnt *= value(SHIFTWIDTH); + + for (addr = addr1; addr <= addr2; addr++) { + + dot = addr; + +#ifdef LISPCODE + + if (c == '=' && addr == addr1 && addr != addr2) + + continue; + +#endif + + getDOT(); + + i = whitecnt(linebuf); + + switch (c) { + + + + case '>': + + if (linebuf[0] == 0) + + continue; + + cp = genindent(i + cnt); + + break; + + + + case '<': + + if (i == 0) + + continue; + + i -= cnt; + + cp = i > 0 ? genindent(i) : genbuf; + + break; + + + +#ifdef LISPCODE + + default: + + i = lindent(addr); + + getDOT(); + + cp = genindent(i); + + break; + +#endif + + } + + if (cp + strlen(dp = vpastwh(linebuf)) >= &genbuf[LBSIZE - 2]) + + error("Line too long|Result line after shift would be too long"); + + CP(cp, dp); + + strcLIN(genbuf); + + putmark(addr); + + } + + killed(); + +} + + + +/* + + * Find a tag in the tags file. + + * Most work here is in parsing the tags file itself. + + */ + +tagfind(quick) + + bool quick; + +{ + + char cmdbuf[BUFSIZ]; + + char filebuf[FNSIZE]; +++ char tagfbuf[128]; + + register int c, d; + + bool samef = 1; - bool notagsfile = 0; - short master = -1; - short omagic; +++ int tfcount = 0; +++ int omagic; +++ char *fn, *fne; +++#ifdef VMUNIX +++ /* +++ * We have lots of room so we bring in stdio and do +++ * a binary search on the tags file. +++ */ +++# undef EOF +++# include +++# undef getchar +++# undef putchar +++ FILE *iof; +++ char iofbuf[BUFSIZ]; +++ long mid; /* assumed byte offset */ +++ long top, bot; /* length of tag file */ +++ struct stat sbuf; +++#endif + + + + omagic = value(MAGIC); + + if (!skipend()) { + + register char *lp = lasttag; + + + + while (!iswhite(peekchar()) && !endcmd(peekchar())) + + if (lp < &lasttag[sizeof lasttag - 2]) + + *lp++ = getchar(); + + else + + ignchar(); + + *lp++ = 0; + + if (!endcmd(peekchar())) + +badtag: + + error("Bad tag|Give one tag per line"); + + } else if (lasttag[0] == 0) + + error("No previous tag"); + + c = getchar(); + + if (!endcmd(c)) + + goto badtag; + + if (c == EOF) + + ungetchar(c); + + clrstats(); - do { - io = open(master ? "tags" : MASTERTAGS, 0); - if (master && io < 0) - notagsfile = 1; +++ +++ /* +++ * Loop once for each file in tags "path". +++ */ +++ CP(tagfbuf, svalue(TAGS)); +++ fne = tagfbuf - 1; +++ while (fne) { +++ fn = ++fne; +++ while (*fne && *fne != ' ') +++ fne++; +++ if (*fne == 0) +++ fne = 0; /* done, quit after this time */ +++ else +++ *fne = 0; /* null terminate filename */ +++#ifdef VMUNIX +++ iof = fopen(fn, "r"); +++ if (iof == NULL) +++ continue; +++ tfcount++; +++ setbuf(iof, iofbuf); +++ fstat(fileno(iof), &sbuf); +++ top = sbuf.st_size; +++ if (top == 0L || iof == NULL) +++ top = -1L; +++ bot = 0L; +++ while (top >= bot) { +++#else +++ /* +++ * Avoid stdio and scan tag file linearly. +++ */ +++ io = open(fn, 0); +++ if (io<0) +++ continue; +++ tfcount++; + + while (getfile() == 0) { +++#endif +++ /* loop for each tags file entry */ + + register char *cp = linebuf; + + register char *lp = lasttag; + + char *oglobp; + + +++#ifdef VMUNIX +++ mid = (top + bot) / 2; +++ fseek(iof, mid, 0); +++ if (mid > 0) /* to get first tag in file to work */ +++ /* scan to next \n */ +++ if(fgets(linebuf, sizeof linebuf, iof)==NULL) +++ goto goleft; +++ /* get the line itself */ +++ if(fgets(linebuf, sizeof linebuf, iof)==NULL) +++ goto goleft; +++ linebuf[strlen(linebuf)-1] = 0; /* was '\n' */ +++#endif + + while (*cp && *lp == *cp) + + cp++, lp++; - if (*lp || !iswhite(*cp)) +++ if ((*lp || !iswhite(*cp)) && (value(TAGLENGTH)==0 || lp-lasttag < value(TAGLENGTH))) { +++#ifdef VMUNIX +++ if (*lp > *cp) +++ bot = mid + 1; +++ else +++goleft: +++ top = mid - 1; +++#endif +++ /* Not this tag. Try the next */ + + continue; +++ } +++ +++ /* +++ * We found the tag. Decode the line in the file. +++ */ +++#ifdef VMUNIX +++ fclose(iof); +++#else + + close(io); +++#endif +++ /* Rest of tag if abbreviated */ +++ while (!iswhite(*cp)) +++ cp++; +++ +++ /* name of file */ + + while (*cp && iswhite(*cp)) + + cp++; + + if (!*cp) + +badtags: + + serror("%s: Bad tags file entry", lasttag); + + lp = filebuf; + + while (*cp && *cp != ' ' && *cp != '\t') { + + if (lp < &filebuf[sizeof filebuf - 2]) + + *lp++ = *cp; + + cp++; + + } + + *lp++ = 0; +++ + + if (*cp == 0) + + goto badtags; + + if (dol != zero) { + + /* + + * Save current position in 't for ^^ in visual. + + */ + + names['t'-'a'] = *dot &~ 01; + + if (inopen) { - extern char *ncols['z'-'a'+1]; +++ extern char *ncols['z'-'a'+2]; + + extern char *cursor; + + + + ncols['t'-'a'] = cursor; + + } + + } + + strcpy(cmdbuf, cp); + + if (strcmp(filebuf, savedfile) || !edited) { + + char cmdbuf2[sizeof filebuf + 10]; + + +++ /* Different file. Do autowrite & get it. */ + + if (!quick) { + + ckaw(); + + if (chng && dol > zero) + + error("No write@since last change (:tag! overrides)"); + + } + + oglobp = globp; + + strcpy(cmdbuf2, "e! "); + + strcat(cmdbuf2, filebuf); + + globp = cmdbuf2; + + d = peekc; ungetchar(0); - /* - * BUG: if it isn't found (user edited header - * line) we get left in nomagic mode. - */ - value(MAGIC) = 0; + + commands(1, 1); + + peekc = d; + + globp = oglobp; + + value(MAGIC) = omagic; + + samef = 0; + + } +++ +++ /* +++ * Look for pattern in the current file. +++ */ + + oglobp = globp; + + globp = cmdbuf; + + d = peekc; ungetchar(0); + + if (samef) + + markpr(dot); +++ /* +++ * BUG: if it isn't found (user edited header +++ * line) we get left in nomagic mode. +++ */ + + value(MAGIC) = 0; + + commands(1, 1); + + peekc = d; + + globp = oglobp; + + value(MAGIC) = omagic; + + return; - } - } while (++master == 0); - if (notagsfile) +++ } /* end of "for each tag in file" */ +++ +++ /* +++ * No such tag in this file. Close it and try the next. +++ */ +++#ifdef VMUNIX +++ fclose(iof); +++#else +++ close(io); +++#endif +++ } /* end of "for each file in path" */ +++ if (tfcount <= 0) + + error("No tags file"); - serror("%s: No such tag@in tags file", lasttag); +++ else +++ serror("%s: No such tag@in tags file", lasttag); + +} + + + +/* + + * Save lines from addr1 thru addr2 as though + + * they had been deleted. + + */ + +yank() + +{ + + +++ if (!FIXUNDO) +++ error("Can't yank inside global/macro"); + + save12(); + + undkind = UNDNONE; + + killcnt(addr2 - addr1 + 1); + +} + + + +/* + + * z command; print windows of text in the file. + + * + + * If this seems unreasonably arcane, the reasons + + * are historical. This is one of the first commands + + * added to the first ex (then called en) and the + + * number of facilities here were the major advantage + + * of en over ed since they allowed more use to be + + * made of fast terminals w/o typing .,.22p all the time. + + */ + +bool zhadpr; + +bool znoclear; + +short zweight; + + + +zop(hadpr) + + int hadpr; + +{ + + register int c, lines, op; + + bool excl; + + + + zhadpr = hadpr; + + notempty(); + + znoclear = 0; + + zweight = 0; + + excl = exclam(); + + switch (c = op = getchar()) { + + + + case '^': + + zweight = 1; + + case '-': + + case '+': + + while (peekchar() == op) { + + ignchar(); + + zweight++; + + } + + case '=': + + case '.': + + c = getchar(); + + break; + + + + case EOF: + + znoclear++; + + break; + + + + default: + + op = 0; + + break; + + } + + if (isdigit(c)) { + + lines = c - '0'; + + for(;;) { + + c = getchar(); + + if (!isdigit(c)) + + break; + + lines *= 10; + + lines += c - '0'; + + } + + if (lines < LINES) + + znoclear++; + + value(WINDOW) = lines; + + if (op == '=') + + lines += 2; + + } else + + lines = op == EOF ? value(SCROLL) : excl ? LINES - 1 : 2*value(SCROLL); + + if (inopen || c != EOF) { + + ungetchar(c); + + newline(); + + } + + addr1 = addr2; + + if (addr2 == 0 && dot < dol && op == 0) + + addr1 = addr2 = dot+1; + + setdot(); + + zop2(lines, op); + +} + + + +zop2(lines, op) + + register int lines; + + register int op; + +{ + + register line *split; + + + + split = NULL; + + switch (op) { + + + + case EOF: + + if (addr2 == dol) + + error("\nAt EOF"); + + case '+': + + if (addr2 == dol) + + error("At EOF"); + + addr2 += lines * zweight; + + if (addr2 > dol) + + error("Hit BOTTOM"); + + addr2++; + + default: + + addr1 = addr2; + + addr2 += lines-1; + + dot = addr2; + + break; + + + + case '=': + + case '.': + + znoclear = 0; + + lines--; + + lines >>= 1; + + if (op == '=') + + lines--; + + addr1 = addr2 - lines; + + if (op == '=') + + dot = split = addr2; + + addr2 += lines; + + if (op == '.') { + + markDOT(); + + dot = addr2; + + } + + break; + + + + case '^': + + case '-': + + addr2 -= lines * zweight; + + if (addr2 < one) + + error("Hit TOP"); + + lines--; + + addr1 = addr2 - lines; + + dot = addr2; + + break; + + } + + if (addr1 <= zero) + + addr1 = one; + + if (addr2 > dol) + + addr2 = dol; + + if (dot > dol) + + dot = dol; + + if (addr1 > addr2) + + return; + + if (op == EOF && zhadpr) { + + getline(*addr1); + + putchar('\r' | QUOTE); + + shudclob = 1; + + } else if (znoclear == 0 && CL != NOSTR && !inopen) { + + flush1(); + + vclear(); + + } + + if (addr2 - addr1 > 1) + + pstart(); + + if (split) { + + plines(addr1, split - 1, 0); + + splitit(); + + plines(split, split, 0); + + splitit(); + + addr1 = split + 1; + + } + + plines(addr1, addr2, 0); + +} + + + +static + +splitit() + +{ + + register int l; + + + + for (l = COLUMNS > 80 ? 40 : COLUMNS / 2; l > 0; l--) + + putchar('-'); + + putnl(); + +} + + + +plines(adr1, adr2, movedot) + + line *adr1; + + register line *adr2; + + bool movedot; + +{ + + register line *addr; + + + + pofix(); + + for (addr = adr1; addr <= adr2; addr++) { + + getline(*addr); + + pline(lineno(addr)); + + if (inopen) + + putchar('\n' | QUOTE); + + if (movedot) + + dot = addr; + + } + +} + + + +pofix() + +{ + + + + if (inopen && Outchar != termchar) { + + vnfl(); + + setoutt(); + + } + +} + + + +/* + + * Dudley doright to the rescue. + + * Undo saves the day again. + + * A tip of the hatlo hat to Warren Teitleman + + * who made undo as useful as do. + + * + + * Command level undo works easily because + + * the editor has a unique temporary file + + * index for every line which ever existed. + + * We don't have to save large blocks of text, + + * only the indices which are small. We do this + + * by moving them to after the last line in the + + * line buffer array, and marking down info + + * about whence they came. + + * + + * Undo is its own inverse. + + */ + +undo(c) + + bool c; + +{ + + register int i; + + register line *jp, *kp; + + line *dolp1, *newdol, *newadot; + + +++#ifdef TRACE +++ if (trace) +++ vudump("before undo"); +++#endif + + if (inglobal && inopen <= 0) + + error("Can't undo in global@commands"); + + if (!c) + + somechange(); + + pkill[0] = pkill[1] = 0; + + change(); + + if (undkind == UNDMOVE) { + + /* + + * Command to be undone is a move command. + + * This is handled as a special case by noting that + + * a move "a,b m c" can be inverted by another move. + + */ + + if ((i = (jp = unddel) - undap2) > 0) { + + /* + + * when c > b inverse is a+(c-b),c m a-1 + + */ + + addr2 = jp; + + addr1 = (jp = undap1) + i; + + unddel = jp-1; + + } else { + + /* + + * when b > c inverse is c+1,c+1+(b-a) m b + + */ + + addr1 = ++jp; + + addr2 = jp + ((unddel = undap2) - undap1); + + } + + kp = undap1; + + move1(0, unddel); + + dot = kp; + + Command = "move"; + + killed(); + + } else { + + int cnt; + + + + newadot = dot; + + cnt = lineDOL(); + + newdol = dol; + + dolp1 = dol + 1; + + /* + + * Command to be undone is a non-move. + + * All such commands are treated as a combination of + + * a delete command and a append command. + + * We first move the lines appended by the last command + + * from undap1 to undap2-1 so that they are just before the + + * saved deleted lines. + + */ + + if ((i = (kp = undap2) - (jp = undap1)) > 0) { + + if (kp != dolp1) { + + reverse(jp, kp); + + reverse(kp, dolp1); + + reverse(jp, dolp1); + + } + + /* + + * Account for possible backward motion of target + + * for restoration of saved deleted lines. + + */ + + if (unddel >= jp) + + unddel -= i; + + newdol -= i; + + /* + + * For the case where no lines are restored, dot + + * is the line before the first line deleted. + + */ + + dot = jp-1; + + } + + /* + + * Now put the deleted lines, if any, back where they were. + + * Basic operation is: dol+1,unddol m unddel + + */ + + if (undkind == UNDPUT) { + + unddel = undap1 - 1; + + squish(); + + } + + jp = unddel + 1; + + if ((i = (kp = unddol) - dol) > 0) { + + if (jp != dolp1) { + + reverse(jp, dolp1); + + reverse(dolp1, ++kp); + + reverse(jp, kp); + + } + + /* + + * Account for possible forward motion of the target + + * for restoration of the deleted lines. + + */ + + if (undap1 >= jp) + + undap1 += i; + + /* + + * Dot is the first resurrected line. + + */ + + dot = jp; + + newdol += i; + + } + + /* + + * Clean up so we are invertible + + */ + + unddel = undap1 - 1; + + undap1 = jp; + + undap2 = jp + i; + + dol = newdol; + + netchHAD(cnt); + + if (undkind == UNDALL) { + + dot = undadot; + + undadot = newadot; - } - undkind = UNDCHANGE; +++ } else +++ undkind = UNDCHANGE; + + } - if (dot == zero && dot != dol) +++ /* +++ * Defensive programming - after a munged undadot. +++ * Also handle empty buffer case. +++ */ +++ if ((dot <= zero || dot > dol) && dot != dol) + + dot = one; +++#ifdef TRACE +++ if (trace) +++ vudump("after undo"); +++#endif + +} + + + +/* + + * Be (almost completely) sure there really + + * was a change, before claiming to undo. + + */ + +somechange() + +{ + + register line *ip, *jp; + + + + switch (undkind) { + + + + case UNDMOVE: + + return; + + + + case UNDCHANGE: + + if (undap1 == undap2 && dol == unddol) + + break; + + return; + + + + case UNDPUT: + + if (undap1 != undap2) + + return; + + break; + + + + case UNDALL: + + if (unddol - dol != lineDOL()) + + return; + + for (ip = one, jp = dol + 1; ip <= dol; ip++, jp++) + + if ((*ip &~ 01) != (*jp &~ 01)) + + return; + + break; + + + + case UNDNONE: + + error("Nothing to undo"); + + } + + error("Nothing changed|Last undoable command didn't change anything"); + +} + + + +/* + + * Map command: + + * map src dest + + */ - mapcmd(un) +++mapcmd(un, ab) + + int un; /* true if this is unmap command */ +++ int ab; /* true if this is abbr command */ + +{ - char lhs[10], rhs[100]; /* max sizes resp. */ +++ char lhs[100], rhs[100]; /* max sizes resp. */ + + register char *p; + + register char c; + + char *dname; +++ struct maps *mp; /* the map structure we are working on */ + + +++ mp = ab ? abbrevs : exclam() ? immacs : arrows; + + if (skipend()) { + + int i; + + + + /* print current mapping values */ + + if (peekchar() != EOF) + + ignchar(); +++ if (un) +++ error("Missing lhs"); + + if (inopen) + + pofix(); - for (i=0; arrows[i].mapto; i++) - if (arrows[i].cap) { - lprintf("%s", arrows[i].descr); +++ for (i=0; mp[i].mapto; i++) +++ if (mp[i].cap) { +++ lprintf("%s", mp[i].descr); + + putchar('\t'); - lprintf("%s", arrows[i].cap); +++ lprintf("%s", mp[i].cap); + + putchar('\t'); - lprintf("%s", arrows[i].mapto); +++ lprintf("%s", mp[i].mapto); + + putNFL(); + + } + + return; + + } + + + + ignore(skipwh()); + + for (p=lhs; ; ) { + + c = getchar(); + + if (c == CTRL(v)) { + + c = getchar(); - } else if (any(c, " \t")) { - if (un) - eol(); /* will usually cause an error */ - else - break; - } else if (endcmd(c)) { +++ } else if (!un && any(c, " \t")) { +++ /* End of lhs */ +++ break; +++ } else if (endcmd(c) && c!='"') { + + ungetchar(c); + + if (un) { + + newline(); - addmac(lhs, NOSTR, NOSTR); +++ *p = 0; +++ addmac(lhs, NOSTR, NOSTR, mp); + + return; + + } else + + error("Missing rhs"); + + } + + *p++ = c; + + } + + *p = 0; + + + + if (skipend()) + + error("Missing rhs"); + + for (p=rhs; ; ) { + + c = getchar(); + + if (c == CTRL(v)) { + + c = getchar(); - } else if (endcmd(c)) { +++ } else if (endcmd(c) && c!='"') { + + ungetchar(c); + + break; + + } + + *p++ = c; + + } + + *p = 0; + + newline(); + + /* + + * Special hack for function keys: #1 means key f1, etc. + + * If the terminal doesn't have function keys, we just use #1. + + */ + + if (lhs[0] == '#') { + + char *fnkey; + + char *fkey(); + + char funkey[3]; + + + + fnkey = fkey(lhs[1] - '0'); + + funkey[0] = 'f'; funkey[1] = lhs[1]; funkey[2] = 0; + + if (fnkey) + + strcpy(lhs, fnkey); + + dname = funkey; + + } else { + + dname = lhs; + + } - addmac(lhs,rhs,dname); +++ addmac(lhs,rhs,dname,mp); + +} + + + +/* + + * Add a macro definition to those that already exist. The sequence of + + * chars "src" is mapped into "dest". If src is already mapped into something + + * this overrides the mapping. There is no recursion. Unmap is done by - * using NOSTR for dest. +++ * using NOSTR for dest. Dname is what to show in listings. mp is +++ * the structure to affect (arrows, etc). + + */ - addmac(src,dest,dname) +++addmac(src,dest,dname,mp) + + register char *src, *dest, *dname; +++ register struct maps *mp; + +{ + + register int slot, zer; + + - if (dest) { +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "addmac(src='%s', dest='%s', dname='%s', mp=%x\n", src, dest, dname, mp); +++#endif +++ if (dest && mp==arrows) { + + /* Make sure user doesn't screw himself */ + + /* + + * Prevent tail recursion. We really should be + + * checking to see if src is a suffix of dest - * but we are too lazy here, so we don't bother unless - * src is only 1 char long. +++ * but this makes mapping involving escapes that +++ * is reasonable mess up. + + */ + + if (src[1] == 0 && src[0] == dest[strlen(dest)-1]) + + error("No tail recursion"); + + /* + + * We don't let the user rob himself of ":", and making + + * multi char words is a bad idea so we don't allow it. + + * Note that if user sets mapinput and maps all of return, + + * linefeed, and escape, he can screw himself. This is + + * so weird I don't bother to check for it. + + */ + + if (isalpha(src[0]) && src[1] || any(src[0],":")) + + error("Too dangerous to map that"); - /* - * If the src were null it would cause the dest to - * be mapped always forever. This is not good. - */ - if (src[0] == 0) - error("Null lhs"); + + } +++ else if (dest) { +++ /* check for tail recursion in input mode: fussier */ +++ if (eq(src, dest+strlen(dest)-strlen(src))) +++ error("No tail recursion"); +++ } +++ /* +++ * If the src were null it would cause the dest to +++ * be mapped always forever. This is not good. +++ */ +++ if (src == NOSTR || src[0] == 0) +++ error("Missing lhs"); + + + + /* see if we already have a def for src */ + + zer = -1; - for (slot=0; arrows[slot].mapto; slot++) { - if (arrows[slot].cap) { - if (eq(src, arrows[slot].cap)) +++ for (slot=0; mp[slot].mapto; slot++) { +++ if (mp[slot].cap) { +++ if (eq(src, mp[slot].cap) || eq(src, mp[slot].mapto)) + + break; /* if so, reuse slot */ + + } else { + + zer = slot; /* remember an empty slot */ + + } + + } + + + + if (dest == NOSTR) { + + /* unmap */ - if (arrows[slot].cap) { - arrows[slot].cap = NOSTR; - arrows[slot].descr = NOSTR; +++ if (mp[slot].cap) { +++ mp[slot].cap = NOSTR; +++ mp[slot].descr = NOSTR; + + } else { + + error("Not mapped|That macro wasn't mapped"); + + } + + return; + + } + + + + /* reuse empty slot, if we found one and src isn't already defined */ - if (zer >= 0 && arrows[slot].mapto == 0) +++ if (zer >= 0 && mp[slot].mapto == 0) + + slot = zer; + + + + /* if not, append to end */ + + if (slot >= MAXNOMACS) + + error("Too many macros"); + + if (msnext == 0) /* first time */ + + msnext = mapspace; + + /* Check is a bit conservative, we charge for dname even if reusing src */ + + if (msnext - mapspace + strlen(dest) + strlen(src) + strlen(dname) + 3 > MAXCHARMACS) + + error("Too much macro text"); + + CP(msnext, src); - arrows[slot].cap = msnext; +++ mp[slot].cap = msnext; + + msnext += strlen(src) + 1; /* plus 1 for null on the end */ + + CP(msnext, dest); - arrows[slot].mapto = msnext; +++ mp[slot].mapto = msnext; + + msnext += strlen(dest) + 1; + + if (dname) { + + CP(msnext, dname); - arrows[slot].descr = msnext; +++ mp[slot].descr = msnext; + + msnext += strlen(dname) + 1; + + } else { + + /* default descr to string user enters */ - arrows[slot].descr = src; +++ mp[slot].descr = src; + + } + +} + + + +/* + + * Implements macros from command mode. c is the buffer to + + * get the macro from. + + */ + +cmdmac(c) + +char c; + +{ + + char macbuf[BUFSIZ]; + + line *ad, *a1, *a2; + + char *oglobp; + + char pk; + + bool oinglobal; + + + + lastmac = c; + + oglobp = globp; + + oinglobal = inglobal; + + pk = peekc; peekc = 0; + + if (inglobal < 2) + + inglobal = 1; + + regbuf(c, macbuf, sizeof(macbuf)); + + a1 = addr1; a2 = addr2; + + for (ad=a1; ad<=a2; ad++) { + + globp = macbuf; + + dot = ad; + + commands(1,1); + + } + + globp = oglobp; + + inglobal = oinglobal; + + peekc = pk; + +} diff --cc usr/src/cmd/ex/ex_data.c index 0000000000,402d208b28,0000000000..44bf2bf2be mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_data.c +++ b/usr/src/cmd/ex/ex_data.c @@@@ -1,0 -1,66 -1,0 +1,79 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_data.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_tty.h" + + + +/* + + * Initialization of option values. + + * The option #defines in ex_vars.h are made + + * from this file by the script makeoptions. +++ * +++ * These initializations are done char by char instead of as strings +++ * to confuse xstr so it will leave them alone. + + */ - char direct[32] = +++char direct[ONMSZ] = + + { '/', 't', 'm', 'p' }; - char sections[32] = { - 'N', 'H', 'S', 'H', /* -ms macros */ - 'H', ' ', 'H', 'U' /* -mm macros */ - }; - char paragraphs[32] = { +++char paragraphs[ONMSZ] = { + + 'I', 'P', 'L', 'P', 'P', 'P', 'Q', 'P', /* -ms macros */ + + 'P', ' ', 'L', 'I', /* -mm macros */ + + 'b', 'p' /* bare nroff */ + +}; - char shell[32] = +++char sections[ONMSZ] = { +++ 'N', 'H', 'S', 'H', /* -ms macros */ +++ 'H', ' ', 'H', 'U' /* -mm macros */ +++}; +++char shell[ONMSZ] = + + { '/', 'b', 'i', 'n', '/', 's', 'h' }; - char ttytype[16] = +++char tags[ONMSZ] = { +++ 't', 'a', 'g', 's', ' ', +++ '/', 'u', 's', 'r', '/', 'l', 'i', 'b', '/', 't', 'a', 'g', 's' +++}; +++char ttytype[ONMSZ] = + + { 'd', 'u', 'm', 'b' }; + + + +short COLUMNS = 80; + +short LINES = 24; + + + +struct option options[NOPTS + 1] = { + + "autoindent", "ai", ONOFF, 0, 0, 0, + + "autoprint", "ap", ONOFF, 1, 1, 0, + + "autowrite", "aw", ONOFF, 0, 0, 0, + + "beautify", "bf", ONOFF, 0, 0, 0, + + "directory", "dir", STRING, 0, 0, direct, + + "edcompatible", "ed", ONOFF, 0, 0, 0, + + "errorbells", "eb", ONOFF, 0, 0, 0, + + "hardtabs", "ht", NUMERIC, 8, 8, 0, + + "ignorecase", "ic", ONOFF, 0, 0, 0, + + "lisp", 0, ONOFF, 0, 0, 0, + + "list", 0, ONOFF, 0, 0, 0, + + "magic", 0, ONOFF, 1, 1, 0, - "mapinput", "mi", ONOFF, 0, 0, 0, +++ "mesg", 0, ONOFF, 1, 1, 0, + + "number", "nu", ONOFF, 0, 0, 0, + + "open", 0, ONOFF, 1, 1, 0, + + "optimize", "opt", ONOFF, 0, 0, 0, + + "paragraphs", "para", STRING, 0, 0, paragraphs, + + "prompt", 0, ONOFF, 1, 1, 0, +++ "readonly", "ro", ONOFF, 0, 0, 0, + + "redraw", 0, ONOFF, 0, 0, 0, +++ "remap", 0, ONOFF, 1, 1, 0, + + "report", 0, NUMERIC, 5, 5, 0, + + "scroll", "scr", NUMERIC, 12, 12, 0, + + "sections", "sect", STRING, 0, 0, sections, + + "shell", "sh", STRING, 0, 0, shell, + + "shiftwidth", "sw", NUMERIC, TABS, TABS, 0, + + "showmatch", "sm", ONOFF, 0, 0, 0, + + "slowopen", "slow", ONOFF, 0, 0, 0, + + "tabstop", "ts", NUMERIC, TABS, TABS, 0, - "ttytype", "tty", OTERM, 0, 0, ttytype, +++ "taglength", "tl", NUMERIC, 0, 0, 0, +++ "tags", "tag", STRING, 0, 0, tags, + + "term", 0, OTERM, 0, 0, ttytype, + + "terse", 0, ONOFF, 0, 0, 0, +++ "timeout", "to", ONOFF, 1, 1, 0, +++ "ttytype", "tty", OTERM, 0, 0, ttytype, + + "warn", 0, ONOFF, 1, 1, 0, + + "window", "wi", NUMERIC, 23, 23, 0, + + "wrapscan", "ws", ONOFF, 1, 1, 0, + + "wrapmargin", "wm", NUMERIC, 0, 0, 0, + + "writeany", "wa", ONOFF, 0, 0, 0, + + 0, 0, 0, 0, 0, 0, + +}; diff --cc usr/src/cmd/ex/ex_get.c index 0000000000,4d19535174,0000000000..77d199fe88 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_get.c +++ b/usr/src/cmd/ex/ex_get.c @@@@ -1,0 -1,269 -1,0 +1,266 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_get.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_tty.h" + + + +/* + + * Input routines for command mode. + + * Since we translate the end of reads into the implied ^D's + + * we have different flavors of routines which do/don't return such. + + */ + +static bool junkbs; + +short lastc = '\n'; + + + +ignchar() + +{ - register int c; - - do - c = getcd(); - while (c == CTRL(d)); +++ ignore(getchar()); + +} + + + +getchar() + +{ + + register int c; + + + + do + + c = getcd(); - while (c == CTRL(d)); +++ while (!globp && c == CTRL(d)); + + return (c); + +} + + + +getcd() + +{ + + register int c; + + + +again: + + c = getach(); + + if (c == EOF) + + return (c); + + c &= TRIM; + + if (!inopen) - if (c == CTRL(d)) +++ if (!globp && c == CTRL(d)) + + setlastchar('\n'); + + else if (junk(c)) { + + checkjunk(c); + + goto again; + + } + + return (c); + +} + + + +peekchar() + +{ + + + + if (peekc == 0) + + peekc = getchar(); + + return (peekc); + +} + + + +peekcd() + +{ + + + + if (peekc == 0) + + peekc = getcd(); + + return (peekc); + +} + + + +getach() + +{ + + register int c; + + static char inline[128]; + + + + c = peekc; + + if (c != 0) { + + peekc = 0; + + return (c); + + } + + if (globp) { + + if (*globp) + + return (*globp++); + + globp = 0; + + return (lastc = EOF); + + } + +top: + + if (input) { + + if (c = *input++) { + + if (c &= TRIM) + + return (lastc = c); + + goto top; + + } + + input = 0; + + } + + flush(); + + if (intty) { + + c = read(0, inline, sizeof inline - 4); + + if (c < 0) + + return (lastc = EOF); + + if (c == 0 || inline[c-1] != '\n') + + inline[c++] = CTRL(d); + + if (inline[c-1] == '\n') + + noteinp(); + + inline[c] = 0; + + for (c--; c >= 0; c--) + + if (inline[c] == 0) + + inline[c] = QUOTE; + + input = inline; + + goto top; + + } + + if (read(0, (char *) &lastc, 1) != 1) + + lastc = EOF; + + return (lastc); + +} + + + +/* + + * Input routine for insert/append/change in command mode. + + * Most work here is in handling autoindent. + + */ + +static short lastin; + + + +gettty() + +{ + + register int c = 0; + + register char *cp = genbuf; + + char hadup = 0; + + int numbline(); + + extern int (*Pline)(); + + int offset = Pline == numbline ? 8 : 0; + + int ch; + + + + if (intty && !inglobal) { + + if (offset) { + + holdcm = 1; + + printf(" %4d ", lineDOT() + 1); + + flush(); + + holdcm = 0; + + } + + if (value(AUTOINDENT) ^ aiflag) { + + holdcm = 1; + +#ifdef LISPCODE + + if (value(LISP)) + + lastin = lindent(dot + 1); + +#endif + + tab(lastin + offset); + + while ((c = getcd()) == CTRL(d)) { + + if (lastin == 0 && isatty(0) == -1) { + + holdcm = 0; + + return (EOF); + + } + + lastin = backtab(lastin); + + tab(lastin + offset); + + } + + switch (c) { + + + + case '^': + + case '0': + + ch = getcd(); + + if (ch == CTRL(d)) { + + if (c == '0') + + lastin = 0; + + if (!OS) { + + putchar('\b' | QUOTE); + + putchar(' ' | QUOTE); + + putchar('\b' | QUOTE); + + } + + tab(offset); + + hadup = 1; + + c = getchar(); + + } else + + ungetchar(ch); + + break; + + + + case '.': + + if (peekchar() == '\n') { + + ignchar(); + + noteinp(); + + holdcm = 0; + + return (EOF); + + } + + break; + + + + case '\n': + + hadup = 1; + + break; + + } + + } + + flush(); + + holdcm = 0; + + } + + if (c == 0) + + c = getchar(); + + while (c != EOF && c != '\n') { + + if (cp > &genbuf[LBSIZE - 2]) + + error("Input line too long"); + + *cp++ = c; + + c = getchar(); + + } + + if (c == EOF) { + + if (inglobal) + + ungetchar(EOF); + + return (EOF); + + } + + *cp = 0; + + cp = linebuf; + + if ((value(AUTOINDENT) ^ aiflag) && hadup == 0 && intty && !inglobal) { + + lastin = c = smunch(lastin, genbuf); + + for (c = lastin; c >= value(TABSTOP); c -= value(TABSTOP)) + + *cp++ = '\t'; + + for (; c > 0; c--) + + *cp++ = ' '; + + } + + CP(cp, genbuf); + + if (linebuf[0] == '.' && linebuf[1] == 0) + + return (EOF); + + return (0); + +} + + + +/* + + * Crunch the indent. + + * Hard thing here is that in command mode some of the indent + + * is only implicit, so we must seed the column counter. + + * This should really be done differently so as to use the whitecnt routine + + * and also to hack indenting for LISP. + + */ + +smunch(col, ocp) + + register int col; + + char *ocp; + +{ + + register char *cp; + + + + cp = ocp; + + for (;;) + + switch (*cp++) { + + + + case ' ': + + col++; + + continue; + + + + case '\t': + + col += value(TABSTOP) - (col % value(TABSTOP)); + + continue; + + + + default: + + cp--; + + CP(ocp, cp); + + return (col); + + } + +} + + + +char *cntrlhm = "^H discarded\n"; + + + +checkjunk(c) + + char c; + +{ + + + + if (junkbs == 0 && c == '\b') { + + write(2, cntrlhm, 13); + + junkbs = 1; + + } + +} + + + +line * + +setin(addr) + + line *addr; + +{ + + + + if (addr == zero) + + lastin = 0; + + else + + getline(*addr), lastin = smunch(0, linebuf); + +} diff --cc usr/src/cmd/ex/ex_io.c index 0000000000,d22f82ef87,0000000000..e4fbb20845 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_io.c +++ b/usr/src/cmd/ex/ex_io.c @@@@ -1,0 -1,1047 -1,0 +1,832 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_io.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_argv.h" + +#include "ex_temp.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* - * File input/output, unix escapes, source, filtering preserve and recover +++ * File input/output, source, preserve and recover + + */ + + + +/* + + * Following remember where . was in the previous file for return + + * on file switching. + + */ + +int altdot; + +int oldadot; + +bool wasalt; +++short isalt; + + + +long cntch; /* Count of characters on unit io */ + +#ifndef VMUNIX + +short cntln; /* Count of lines " */ + +#else + +int cntln; + +#endif + +long cntnull; /* Count of nulls " */ + +long cntodd; /* Count of non-ascii characters " */ + + + +/* + + * Parse file name for command encoded by comm. + + * If comm is E then command is doomed and we are + + * parsing just so user won't have to retype the name. + + */ + +filename(comm) + + int comm; + +{ + + register int c = comm, d; + + register int i; + + + + d = getchar(); + + if (endcmd(d)) { + + if (savedfile[0] == 0 && comm != 'f') + + error("No file|No current filename"); + + CP(file, savedfile); - wasalt = 0; +++ wasalt = (isalt > 0) ? isalt-1 : 0; +++ isalt = 0; + + oldadot = altdot; +++ if (c == 'e' || c == 'E') +++ altdot = lineDOT(); + + if (d == EOF) + + ungetchar(d); + + } else { + + ungetchar(d); + + getone(); + + eol(); + + if (savedfile[0] == 0 && c != 'E' && c != 'e') { + + c = 'e'; + + edited = 0; + + } + + wasalt = strcmp(file, altfile) == 0; + + oldadot = altdot; + + switch (c) { + + + + case 'f': + + edited = 0; + + /* fall into ... */ + + + + case 'e': + + if (savedfile[0]) { + + altdot = lineDOT(); + + CP(altfile, savedfile); + + } + + CP(savedfile, file); + + break; + + + + default: + + if (file[0]) { + + if (c != 'E') + + altdot = lineDOT(); + + CP(altfile, file); + + } + + break; + + } + + } + + if (hush && comm != 'f' || comm == 'E') + + return; + + if (file[0] != 0) { + + lprintf("\"%s\"", file); + + if (comm == 'f') { +++ if (value(READONLY)) +++ printf(" [Read only]"); + + if (!edited) + + printf(" [Not edited]"); + + if (tchng) + + printf(" [Modified]"); + + } + + flush(); + + } else + + printf("No file "); + + if (comm == 'f') { + + if (!(i = lineDOL())) + + i++; + + printf(" line %d of %d --%ld%%--", lineDOT(), lineDOL(), + + (long) 100 * lineDOT() / i); + + } + +} + + + +/* + + * Get the argument words for a command into genbuf + + * expanding # and %. + + */ + +getargs() + +{ + + register int c; + + register char *cp, *fp; + + static char fpatbuf[32]; /* hence limit on :next +/pat */ + + + + pastwh(); + + if (peekchar() == '+') { + + for (cp = fpatbuf;;) { + + c = *cp++ = getchar(); + + if (cp >= &fpatbuf[sizeof(fpatbuf)]) + + error("Pattern too long"); + + if (c == '\\' && isspace(peekchar())) + + c = getchar(); + + if (c == EOF || isspace(c)) { + + ungetchar(c); + + *--cp = 0; + + firstpat = &fpatbuf[1]; + + break; + + } + + } + + } + + if (skipend()) + + return (0); + + CP(genbuf, "echo "); cp = &genbuf[5]; + + for (;;) { + + c = getchar(); + + if (endcmd(c)) { + + ungetchar(c); + + break; + + } + + switch (c) { + + + + case '\\': - if (any(peekchar(), "#%")) +++ if (any(peekchar(), "#%|")) + + c = getchar(); + + /* fall into... */ + + + + default: + + if (cp > &genbuf[LBSIZE - 2]) + +flong: + + error("Argument buffer overflow"); + + *cp++ = c; + + break; + + + + case '#': + + fp = altfile; + + if (*fp == 0) + + error("No alternate filename@to substitute for #"); + + goto filexp; + + + + case '%': + + fp = savedfile; + + if (*fp == 0) + + error("No current filename@to substitute for %%"); + +filexp: + + while (*fp) { + + if (cp > &genbuf[LBSIZE - 2]) + + goto flong; + + *cp++ = *fp++; + + } + + break; + + } + + } + + *cp = 0; + + return (1); + +} + + + +/* + + * Glob the argument words in genbuf, or if no globbing + + * is implied, just split them up directly. + + */ + +glob(gp) + + struct glob *gp; + +{ + + int pvec[2]; + + register char **argv = gp->argv; + + register char *cp = gp->argspac; + + register int c; + + char ch; + + int nleft = NCARGS; + + + + gp->argc0 = 0; + + if (gscan() == 0) { + + register char *v = genbuf + 5; /* strlen("echo ") */ + + + + for (;;) { + + while (isspace(*v)) + + v++; + + if (!*v) + + break; + + *argv++ = cp; + + while (*v && !isspace(*v)) + + *cp++ = *v++; + + *cp++ = 0; + + gp->argc0++; + + } + + *argv = 0; + + return; + + } + + if (pipe(pvec) < 0) + + error("Can't make pipe to glob"); + + pid = fork(); + + io = pvec[0]; + + if (pid < 0) { + + close(pvec[1]); + + error("Can't fork to do glob"); + + } + + if (pid == 0) { + + int oerrno; + + + + close(1); + + dup(pvec[1]); + + close(pvec[0]); +++ close(2); /* so errors don't mess up the screen */ +++ open("/dev/null", 1); + + execl(svalue(SHELL), "sh", "-c", genbuf, 0); + + oerrno = errno; close(1); dup(2); errno = oerrno; + + filioerr(svalue(SHELL)); + + } + + close(pvec[1]); + + do { + + *argv = cp; + + for (;;) { + + if (read(io, &ch, 1) != 1) { + + close(io); + + c = -1; + + } else + + c = ch & TRIM; + + if (c <= 0 || isspace(c)) + + break; + + *cp++ = c; + + if (--nleft <= 0) + + error("Arg list too long"); + + } + + if (cp != *argv) { + + --nleft; + + *cp++ = 0; + + gp->argc0++; + + if (gp->argc0 >= NARGS) + + error("Arg list too long"); + + argv++; + + } + + } while (c >= 0); + + waitfor(); + + if (gp->argc0 == 0) - error(NOSTR); +++ error("No match"); + +} + + + +/* + + * Scan genbuf for shell metacharacters. + + * Set is union of v7 shell and csh metas. + + */ + +gscan() + +{ + + register char *cp; + + + + for (cp = genbuf; *cp; cp++) + + if (any(*cp, "~{[*?$`'\"\\")) + + return (1); + + return (0); + +} + + + +/* + + * Parse one filename into file. + + */ + +getone() + +{ + + register char *str; + + struct glob G; + + + + if (getargs() == 0) + + error("Missing filename"); + + glob(&G); + + if (G.argc0 > 1) + + error("Ambiguous|Too many file names"); + + str = G.argv[G.argc0 - 1]; + + if (strlen(str) > FNSIZE - 4) + + error("Filename too long"); + +samef: + + CP(file, str); + +} + + + +/* + + * Read a file from the world. + + * C is command, 'e' if this really an edit (or a recover). + + */ + +rop(c) + + int c; + +{ + + register int i; + + struct stat stbuf; + + short magic; +++ static int ovro; /* old value(READONLY) */ +++ static int denied; /* 1 if READONLY was set due to file permissions */ + + + + io = open(file, 0); + + if (io < 0) { - if (c == 'e' && errno == ENOENT) +++ if (c == 'e' && errno == ENOENT) { + + edited++; +++ /* +++ * If the user just did "ex foo" he is probably +++ * creating a new file. Don't be an error, since +++ * this is ugly, and it screws up the + option. +++ */ +++ if (!seenprompt) { +++ printf(" [New file]"); +++ noonl(); +++ return; +++ } +++ } + + syserror(); + + } + + if (fstat(io, &stbuf)) + + syserror(); + + switch (stbuf.st_mode & S_IFMT) { + + + + case S_IFBLK: + + error(" Block special file"); + + + + case S_IFCHR: + + if (isatty(io)) + + error(" Teletype"); + + if (samei(&stbuf, "/dev/null")) + + break; + + error(" Character special file"); + + + + case S_IFDIR: + + error(" Directory"); + + + + case S_IFREG: +++#ifdef CRYPT +++ if (xflag) +++ break; +++#endif + + i = read(io, (char *) &magic, sizeof(magic)); + + lseek(io, 0l, 0); + + if (i != sizeof(magic)) + + break; + + switch (magic) { + + - case 0405: - case 0407: - case 0410: - case 0411: +++ case 0405: /* Interdata? overlay */ +++ case 0407: /* unshared */ +++ case 0410: /* shared text */ +++ case 0411: /* separate I/D */ +++ case 0413: /* VM/Unix demand paged */ +++ case 0430: /* PDP-11 Overlay shared */ +++ case 0431: /* PDP-11 Overlay sep I/D */ + + error(" Executable"); + + +++ /* +++ * We do not forbid the editing of portable archives +++ * because it is reasonable to edit them, especially +++ * if they are archives of text files. This is +++ * especially useful if you archive source files together +++ * and copy them to another system with ~%take, since +++ * the files sometimes show up munged and must be fixed. +++ */ + + case 0177545: + + case 0177555: + + error(" Archive"); + + + + default: + + if (magic & 0100200) + + error(" Non-ascii file"); + + break; + + } + + } +++ if (c != 'r') { +++ if (value(READONLY) && denied) { +++ value(READONLY) = ovro; +++ denied = 0; +++ } +++ if ((stbuf.st_mode & 0222) == 0 || access(file, 2) < 0) { +++ ovro = value(READONLY); +++ denied = 1; +++ value(READONLY) = 1; +++ } +++ } +++ if (value(READONLY)) { +++ printf(" [Read only]"); +++ flush(); +++ } + + if (c == 'r') + + setdot(); + + else + + setall(); - if (inopen && c == 'r') +++ if (FIXUNDO && inopen && c == 'r') + + undap1 = undap2 = dot + 1; + + rop2(); + + rop3(c); + +} + + + +rop2() + +{ + + + + deletenone(); + + clrstats(); + + ignore(append(getfile, addr2)); + +} + + + +rop3(c) + + int c; + +{ + + + + if (iostats() == 0 && c == 'e') + + edited++; + + if (c == 'e') { + + if (wasalt || firstpat) { + + register line *addr = zero + oldadot; + + + + if (addr > dol) + + addr = dol; + + if (firstpat) { + + globp = (*firstpat) ? firstpat : "$"; + + commands(1,1); + + firstpat = 0; + + } else if (addr >= one) { + + if (inopen) + + dot = addr; + + markpr(addr); + + } else + + goto other; + + } else + +other: + + if (dol > zero) { + + if (inopen) + + dot = one; + + markpr(one); + + } - undkind = UNDNONE; +++ if(FIXUNDO) +++ undkind = UNDNONE; + + if (inopen) { + + vcline = 0; + + vreplace(0, LINES, lineDOL()); + + } + + } + + if (laste) { +++#ifdef VMUNIX +++ tlaste(); +++#endif + + laste = 0; + + sync(); + + } + +} + + + +/* + + * Are these two really the same inode? + + */ + +samei(sp, cp) + + struct stat *sp; + + char *cp; + +{ + + struct stat stb; + + + + if (stat(cp, &stb) < 0 || sp->st_dev != stb.st_dev) + + return (0); + + return (sp->st_ino == stb.st_ino); + +} + + + +/* Returns from edited() */ + +#define EDF 0 /* Edited file */ + +#define NOTEDF -1 /* Not edited file */ + +#define PARTBUF 1 /* Write of partial buffer to Edited file */ + + + +/* + + * Write a file. + + */ + +wop(dofname) + +bool dofname; /* if 1 call filename, else use savedfile */ + +{ + + register int c, exclam, nonexist; + + line *saddr1, *saddr2; + + struct stat stbuf; + + + + c = 0; + + exclam = 0; + + if (dofname) { + + if (peekchar() == '!') + + exclam++, ignchar(); + + ignore(skipwh()); + + while (peekchar() == '>') + + ignchar(), c++, ignore(skipwh()); + + if (c != 0 && c != 2) + + error("Write forms are 'w' and 'w>>'"); + + filename('w'); + + } else { +++ if (savedfile[0] == 0) +++ error("No file|No current filename"); + + saddr1=addr1; + + saddr2=addr2; + + addr1=one; + + addr2=dol; + + CP(file, savedfile); + + if (inopen) { + + vclrech(0); + + splitw++; + + } + + lprintf("\"%s\"", file); + + } + + nonexist = stat(file, &stbuf); + + switch (c) { + + + + case 0: - if (!exclam && !value(WRITEANY)) switch (edfile()) { +++ if (!exclam && (!value(WRITEANY) || value(READONLY))) +++ switch (edfile()) { + + + + case NOTEDF: + + if (nonexist) + + break; + + if ((stbuf.st_mode & S_IFMT) == S_IFCHR) { + + if (samei(&stbuf, "/dev/null")) + + break; + + if (samei(&stbuf, "/dev/tty")) + + break; + + } + + io = open(file, 1); + + if (io < 0) + + syserror(); + + if (!isatty(io)) + + serror(" File exists| File exists - use \"w! %s\" to overwrite", file); + + close(io); + + break; + + +++ case EDF: +++ if (value(READONLY)) +++ error(" File is read only"); +++ break; +++ + + case PARTBUF: +++ if (value(READONLY)) +++ error(" File is read only"); + + error(" Use \"w!\" to write partial buffer"); + + } + +cre: + +/* + + synctmp(); + +*/ + +#ifdef V6 + + io = creat(file, 0644); + +#else + + io = creat(file, 0666); + +#endif + + if (io < 0) + + syserror(); +++ writing = 1; + + if (hush == 0) + + if (nonexist) + + printf(" [New file]"); + + else if (value(WRITEANY) && edfile() != EDF) + + printf(" [Existing file]"); + + break; + + + + case 2: + + io = open(file, 1); + + if (io < 0) { + + if (exclam || value(WRITEANY)) + + goto cre; + + syserror(); + + } + + lseek(io, 0l, 2); + + break; + + } + + putfile(); + + ignore(iostats()); + + if (c != 2 && addr1 == one && addr2 == dol) { + + if (eq(file, savedfile)) + + edited = 1; + + sync(); + + } + + if (!dofname) { + + addr1 = saddr1; + + addr2 = saddr2; + + } +++ writing = 0; + +} + + + +/* + + * Is file the edited file? + + * Work here is that it is not considered edited + + * if this is a partial buffer, and distinguish + + * all cases. + + */ + +edfile() + +{ + + + + if (!edited || !eq(file, savedfile)) + + return (NOTEDF); + + return (addr1 == one && addr2 == dol ? EDF : PARTBUF); + +} + + - /* - * First part of a shell escape, - * parse the line, expanding # and % and ! and printing if implied. - */ - unix0(warn) - bool warn; - { - register char *up, *fp; - register short c; - char printub, puxb[UXBSIZE + sizeof (int)]; - - printub = 0; - CP(puxb, uxb); - c = getchar(); - if (c == '\n' || c == EOF) - error("Incomplete shell escape command@- use 'shell' to get a shell"); - up = uxb; - do { - switch (c) { - - case '\\': - if (any(peekchar(), "%#!")) - c = getchar(); - default: - if (up >= &uxb[UXBSIZE]) { - tunix: - uxb[0] = 0; - error("Command too long"); - } - *up++ = c; - break; - - case '!': - fp = puxb; - if (*fp == 0) { - uxb[0] = 0; - error("No previous command@to substitute for !"); - } - printub++; - while (*fp) { - if (up >= &uxb[UXBSIZE]) - goto tunix; - *up++ = *fp++; - } - break; - - case '#': - fp = altfile; - if (*fp == 0) { - uxb[0] = 0; - error("No alternate filename@to substitute for #"); - } - goto uexp; - - case '%': - fp = savedfile; - if (*fp == 0) { - uxb[0] = 0; - error("No filename@to substitute for %%"); - } - uexp: - printub++; - while (*fp) { - if (up >= &uxb[UXBSIZE]) - goto tunix; - *up++ = *fp++ | QUOTE; - } - break; - } - c = getchar(); - } while (c == '|' || !endcmd(c)); - if (c == EOF) - ungetchar(c); - *up = 0; - if (!inopen) - resetflav(); - if (warn) - ckaw(); - if (warn && hush == 0 && chng && xchng != chng && value(WARN) && dol > zero) { - xchng = chng; - vnfl(); - printf(mesg("[No write]|[No write since last change]")); - noonl(); - flush(); - } else - warn = 0; - if (printub) { - if (uxb[0] == 0) - error("No previous command@to repeat"); - if (inopen) { - splitw++; - vclean(); - vgoto(WECHO, 0); - } - if (warn) - vnfl(); - if (hush == 0) - lprintf("!%s", uxb); - if (inopen) { - vclreol(); - vgoto(WECHO, 0); - } else - putnl(); - flush(); - } - } - - /* - * Do the real work for execution of a shell escape. - * Mode is like the number passed to open system calls - * and indicates filtering. If input is implied, newstdin - * must have been setup already. - */ - unixex(opt, up, newstdin, mode) - char *opt, *up; - int newstdin, mode; - { - int pvec[2], f; - - signal(SIGINT, SIG_IGN); - if (inopen) - f = setty(normf); - if ((mode & 1) && pipe(pvec) < 0) { - /* Newstdin should be io so it will be closed */ - if (inopen) - setty(f); - error("Can't make pipe for filter"); - } - #ifndef VFORK - pid = fork(); - #else - pid = vfork(); - #endif - if (pid < 0) { - if (mode & 1) { - close(pvec[0]); - close(pvec[1]); - } - setrupt(); - error("No more processes"); - } - if (pid == 0) { - if (mode & 2) { - close(0); - dup(newstdin); - close(newstdin); - } - if (mode & 1) { - close(pvec[0]); - close(1); - dup(pvec[1]); - if (inopen) { - close(2); - dup(1); - } - close(pvec[1]); - } - if (io) - close(io); - if (tfile) - close(tfile); - #ifndef VMUNIX - close(erfile); - #endif - signal(SIGHUP, oldhup); - signal(SIGQUIT, oldquit); - if (ruptible) - signal(SIGINT, SIG_DFL); - execl(svalue(SHELL), "sh", opt, up, (char *) 0); - printf("No %s!\n", svalue(SHELL)); - error(NOSTR); - } - if (mode & 1) { - io = pvec[0]; - close(pvec[1]); - } - if (newstdin) - close(newstdin); - return (f); - } - - /* - * Wait for the command to complete. - * F is for restoration of tty mode if from open/visual. - * C flags suppression of printing. - */ - unixwt(c, f) - bool c; - int f; - { - - waitfor(); - if (inopen) - setty(f); - setrupt(); - if (!inopen && c && hush == 0) { - printf("!\n"); - flush(); - termreset(); - gettmode(); - } - } - - /* - * Setup a pipeline for the filtration implied by mode - * which is like a open number. If input is required to - * the filter, then a child editor is created to write it. - * If output is catch it from io which is created by unixex. - */ - filter(mode) - register int mode; - { - static int pvec[2]; - register int f; - register int lines = lineDOL(); - - mode++; - if (mode & 2) { - signal(SIGINT, SIG_IGN); - if (pipe(pvec) < 0) - error("Can't make pipe"); - pid = fork(); - io = pvec[0]; - if (pid < 0) { - setrupt(); - close(pvec[1]); - error("No more processes"); - } - if (pid == 0) { - setrupt(); - io = pvec[1]; - close(pvec[0]); - putfile(); - exit(0); - } - close(pvec[1]); - io = pvec[0]; - setrupt(); - } - f = unixex("-c", uxb, (mode & 2) ? pvec[0] : 0, mode); - if (mode == 3) { - delete(0); - addr2 = addr1 - 1; - } - if (mode & 1) { - undap1 = undap2 = addr2+1; - ignore(append(getfile, addr2)); - } - close(io); - io = -1; - unixwt(!inopen, f); - netchHAD(lines); - } - - /* - * Set up to do a recover, getting io to be a pipe from - * the recover process. - */ - recover() - { - static int pvec[2]; - - if (pipe(pvec) < 0) - error(" Can't make pipe for recovery"); - pid = fork(); - io = pvec[0]; - if (pid < 0) { - close(pvec[1]); - error(" Can't fork to execute recovery"); - } - if (pid == 0) { - close(2); - dup(1); - close(1); - dup(pvec[1]); - close(pvec[1]); - execl(EXRECOVER, "exrecover", svalue(DIRECTORY), file, (char *) 0); - close(1); - dup(2); - error(" No recovery routine"); - } - close(pvec[1]); - } - - /* - * Wait for the process (pid an external) to complete. - */ - waitfor() - { - - do - rpid = wait(&status); - while (rpid != pid && rpid != -1); - status = (status >> 8) & 0377; - } - - /* - * The end of a recover operation. If the process - * exits non-zero, force not edited; otherwise force - * a write. - */ - revocer() - { - - waitfor(); - if (pid == rpid && status != 0) - edited = 0; - else - change(); - } - + +/* + + * Extract the next line from the io stream. + + */ + +static char *nextip; + + + +getfile() + +{ + + register short c; + + register char *lp, *fp; + + + + lp = linebuf; + + fp = nextip; + + do { + + if (--ninbuf < 0) { + + ninbuf = read(io, genbuf, LBSIZE) - 1; + + if (ninbuf < 0) { + + if (lp != linebuf) { +++ lp++; + + printf(" [Incomplete last line]"); + + break; + + } + + return (EOF); + + } +++#ifdef CRYPT + + fp = genbuf; +++ while(fp < &genbuf[ninbuf]) { +++ if (*fp++ & 0200) { +++ if (kflag) +++ crblock(perm, genbuf, ninbuf+1, +++cntch); +++ break; +++ } +++ } +++#endif +++ fp = genbuf; +++ cntch += ninbuf+1; + + } + + if (lp >= &linebuf[LBSIZE]) { + + error(" Line too long"); + + } + + c = *fp++; + + if (c == 0) { + + cntnull++; + + continue; + + } + + if (c & QUOTE) { + + cntodd++; + + c &= TRIM; + + if (c == 0) + + continue; + + } + + *lp++ = c; + + } while (c != '\n'); - cntch += lp - linebuf; + + *--lp = 0; + + nextip = fp; + + cntln++; + + return (0); + +} + + + +/* + + * Write a range onto the io stream. + + */ + +putfile() + +{ + + line *a1; + + register char *fp, *lp; + + register int nib; + + + + a1 = addr1; + + clrstats(); + + cntln = addr2 - a1 + 1; + + if (cntln == 0) + + return; + + nib = BUFSIZ; + + fp = genbuf; + + do { + + getline(*a1++); + + lp = linebuf; + + for (;;) { + + if (--nib < 0) { + + nib = fp - genbuf; +++#ifdef CRYPT +++ if(kflag) +++ crblock(perm, genbuf, nib, cntch); +++#endif + + if (write(io, genbuf, nib) != nib) { + + wrerror(); + + } + + cntch += nib; + + nib = BUFSIZ - 1; + + fp = genbuf; + + } + + if ((*fp++ = *lp++) == 0) { + + fp[-1] = '\n'; + + break; + + } + + } + + } while (a1 <= addr2); + + nib = fp - genbuf; +++#ifdef CRYPT +++ if(kflag) +++ crblock(perm, genbuf, nib, cntch); +++#endif + + if (write(io, genbuf, nib) != nib) { + + wrerror(); + + } + + cntch += nib; + +} + + + +/* + + * A write error has occurred; if the file being written was + + * the edited file then we consider it to have changed since it is + + * now likely scrambled. + + */ + +wrerror() + +{ + + + + if (eq(file, savedfile) && edited) + + change(); + + syserror(); + +} + + + +/* + + * Source command, handles nested sources. + + * Traps errors since it mungs unit 0 during the source. + + */ - static short slevel; +++short slevel; +++short ttyindes; + + + +source(fil, okfail) + + char *fil; + + bool okfail; + +{ + + jmp_buf osetexit; + + register int saveinp, ointty, oerrno; - int oprompt; +++ char savepeekc, *saveglobp; + + + + signal(SIGINT, SIG_IGN); + + saveinp = dup(0); +++ savepeekc = peekc; +++ saveglobp = globp; +++ peekc = 0; globp = 0; + + if (saveinp < 0) + + error("Too many nested sources"); +++ if (slevel <= 0) +++ ttyindes = saveinp; + + close(0); + + if (open(fil, 0) < 0) { + + oerrno = errno; + + setrupt(); + + dup(saveinp); + + close(saveinp); + + errno = oerrno; + + if (!okfail) + + filioerr(fil); + + return; + + } + + slevel++; + + ointty = intty; + + intty = isatty(0); + + oprompt = value(PROMPT); + + value(PROMPT) &= intty; + + getexit(osetexit); + + setrupt(); + + if (setexit() == 0) + + commands(1, 1); + + else if (slevel > 1) { + + close(0); + + dup(saveinp); + + close(saveinp); + + slevel--; + + resexit(osetexit); + + reset(); + + } + + intty = ointty; + + value(PROMPT) = oprompt; + + close(0); + + dup(saveinp); + + close(saveinp); +++ globp = saveglobp; +++ peekc = savepeekc; + + slevel--; + + resexit(osetexit); + +} + + + +/* + + * Clear io statistics before a read or write. + + */ + +clrstats() + +{ + + + + ninbuf = 0; + + cntch = 0; + + cntln = 0; + + cntnull = 0; + + cntodd = 0; + +} + + + +/* + + * Io is finished, close the unit and print statistics. + + */ + +iostats() + +{ + + + + close(io); + + io = -1; + + if (hush == 0) { + + if (value(TERSE)) + + printf(" %d/%D", cntln, cntch); + + else + + printf(" %d line%s, %D character%s", cntln, plural((long) cntln), + + cntch, plural(cntch)); + + if (cntnull || cntodd) { + + printf(" ("); + + if (cntnull) { + + printf("%D null", cntnull); + + if (cntodd) + + printf(", "); + + } + + if (cntodd) + + printf("%D non-ASCII", cntodd); + + putchar(')'); + + } + + noonl(); + + flush(); + + } + + return (cntnull != 0 || cntodd != 0); + +} diff --cc usr/src/cmd/ex/ex_put.c index 0000000000,c184d883e5,0000000000..4ca6902d37 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_put.c +++ b/usr/src/cmd/ex/ex_put.c @@@@ -1,0 -1,888 -1,0 +1,1138 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_put.c 6.3 11/3/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Terminal driving and line formatting routines. + + * Basic motion optimizations are done here as well + + * as formatting of lines (printing of control characters, + + * line numbering and the like). + + */ + + + +/* + + * The routines outchar, putchar and pline are actually + + * variables, and these variables point at the current definitions + + * of the routines. See the routine setflav. + + * We sometimes make outchar be routines which catch the characters + + * to be printed, e.g. if we want to see how long a line is. + + * During open/visual, outchar and putchar will be set to + + * routines in the file ex_vput.c (vputchar, vinschar, etc.). + + */ + +int (*Outchar)() = termchar; + +int (*Putchar)() = normchar; + +int (*Pline)() = normline; + + + +int (* + +setlist(t))() + + bool t; + +{ + + register int (*P)(); + + + + listf = t; + + P = Putchar; + + Putchar = t ? listchar : normchar; + + return (P); + +} + + + +int (* + +setnumb(t))() + + bool t; + +{ + + register int (*P)(); + + + + numberf = t; + + P = Pline; + + Pline = t ? numbline : normline; + + return (P); + +} + + + +/* + + * Format c for list mode; leave things in common + + * with normal print mode to be done by normchar. + + */ + +listchar(c) + + register short c; + +{ + + + + c &= (TRIM|QUOTE); + + switch (c) { + + + + case '\t': + + case '\b': + + outchar('^'); + + c = ctlof(c); + + break; + + + + case '\n': + + break; + + + + case '\n' | QUOTE: + + outchar('$'); + + break; + + + + default: + + if (c & QUOTE) + + break; + + if (c < ' ' && c != '\n' || c == DELETE) + + outchar('^'), c = ctlof(c); + + break; + + } + + normchar(c); + +} + + + +/* + + * Format c for printing. Handle funnies of upper case terminals + + * and crocky hazeltines which don't have ~. + + */ + +normchar(c) + + register short c; + +{ + + register char *colp; + + + + c &= (TRIM|QUOTE); + + if (c == '~' && HZ) { + + normchar('\\'); + + c = '^'; + + } + + if (c & QUOTE) + + switch (c) { + + + + case ' ' | QUOTE: + + case '\b' | QUOTE: + + break; + + + + case QUOTE: + + return; + + + + default: + + c &= TRIM; + + } + + else if (c < ' ' && (c != '\b' || !OS) && c != '\n' && c != '\t' || c == DELETE) + + putchar('^'), c = ctlof(c); + + else if (UPPERCASE) + + if (isupper(c)) { + + outchar('\\'); + + c = tolower(c); + + } else { + + colp = "({)}!|^~'`"; + + while (*colp++) + + if (c == *colp++) { + + outchar('\\'); + + c = colp[-2]; + + break; + + } + + } + + outchar(c); + +} + + + +/* + + * Print a line with a number. + + */ + +numbline(i) + + int i; + +{ + + + + if (shudclob) + + slobber(' '); + + printf("%6d ", i); + + normline(); + +} + + + +/* + + * Normal line output, no numbering. + + */ + +normline() + +{ + + register char *cp; + + + + if (shudclob) + + slobber(linebuf[0]); + + /* pdp-11 doprnt is not reentrant so can't use "printf" here + + in case we are tracing */ + + for (cp = linebuf; *cp;) + + putchar(*cp++); + + if (!inopen) + + putchar('\n' | QUOTE); + +} + + + +/* + + * Given c at the beginning of a line, determine whether + + * the printing of the line will erase or otherwise obliterate + + * the prompt which was printed before. If it won't, do it now. + + */ + +slobber(c) + + int c; + +{ + + + + shudclob = 0; + + switch (c) { + + + + case '\t': + + if (Putchar == listchar) + + return; + + break; + + + + default: + + return; + + + + case ' ': + + case 0: + + break; + + } + + if (OS) + + return; + + flush(); + + putch(' '); + + if (BC) + + tputs(BC, 0, putch); + + else + + putch('\b'); + +} + + + +/* + + * The output buffer is initialized with a useful error + + * message so we don't have to keep it in data space. + + */ - static char linb[66] = { - 'E', 'r', 'r', 'o', 'r', ' ', 'm', 'e', 's', 's', 'a', 'g', 'e', ' ', - 'f', 'i', 'l', 'e', ' ', 'n', 'o', 't', ' ', - 'a', 'v', 'a', 'i', 'l', 'a', 'b', 'l', 'e', '\n', 0 - }; - static char *linp = linb + 33; +++static char linb[66]; +++static char *linp = linb; + + + +/* + + * Phadnl records when we have already had a complete line ending with \n. + + * If another line starts without a flush, and the terminal suggests it, + + * we switch into -nl mode so that we can send lineffeeds to avoid + + * a lot of spacing. + + */ + +static bool phadnl; + + + +/* + + * Indirect to current definition of putchar. + + */ + +putchar(c) + + int c; + +{ + + + + (*Putchar)(c); + +} + + + +/* + + * Termchar routine for command mode. + + * Watch for possible switching to -nl mode. + + * Otherwise flush into next level of buffering when + + * small buffer fills or at a newline. + + */ + +termchar(c) + + int c; + +{ + + + + if (pfast == 0 && phadnl) + + pstart(); + + if (c == '\n') + + phadnl = 1; + + else if (linp >= &linb[63]) + + flush1(); + + *linp++ = c; + + if (linp >= &linb[63]) { + + fgoto(); + + flush1(); + + } + +} + + + +flush() + +{ + + + + flush1(); + + flush2(); + +} + + + +/* + + * Flush from small line buffer into output buffer. + + * Work here is destroying motion into positions, and then + + * letting fgoto do the optimized motion. + + */ + +flush1() + +{ + + register char *lp; + + register short c; + + + + *linp = 0; + + lp = linb; + + while (*lp) + + switch (c = *lp++) { + + + + case '\r': + + destline += destcol / COLUMNS; + + destcol = 0; + + continue; + + + + case '\b': + + if (destcol) + + destcol--; + + continue; + + + + case ' ': + + destcol++; + + continue; + + + + case '\t': + + destcol += value(TABSTOP) - destcol % value(TABSTOP); + + continue; + + + + case '\n': + + destline += destcol / COLUMNS + 1; + + if (destcol != 0 && destcol % COLUMNS == 0) + + destline--; + + destcol = 0; + + continue; + + + + default: + + fgoto(); + + for (;;) { + + if (AM == 0 && outcol == COLUMNS) + + fgoto(); + + c &= TRIM; + + putch(c); + + if (c == '\b') { + + outcol--; + + destcol--; + + } else if (c >= ' ' && c != DELETE) { + + outcol++; + + destcol++; + + if (XN && outcol % COLUMNS == 0) + + putch('\n'); + + } + + c = *lp++; + + if (c <= ' ') + + break; + + } + + --lp; + + continue; + + } + + linp = linb; + +} + + + +flush2() + +{ + + + + fgoto(); + + flusho(); + + pstop(); + +} + + + +/* + + * Sync the position of the output cursor. + + * Most work here is rounding for terminal boundaries getting the + + * column position implied by wraparound or the lack thereof and + + * rolling up the screen to get destline on the screen. + + */ + +fgoto() + +{ + + register int l, c; + + + + if (destcol > COLUMNS - 1) { + + destline += destcol / COLUMNS; + + destcol %= COLUMNS; + + } + + if (outcol > COLUMNS - 1) { + + l = (outcol + 1) / COLUMNS; + + outline += l; + + outcol %= COLUMNS; + + if (AM == 0) { + + while (l > 0) { + + if (pfast) - putch('\r'); - putch('\n'); +++ if (xCR) +++ tputs(xCR, 0, putch); +++ else +++ putch('\r'); +++ if (xNL) +++ tputs(xNL, 0, putch); +++ else +++ putch('\n'); + + l--; + + } + + outcol = 0; + + } + + if (outline > LINES - 1) { + + destline -= outline - (LINES - 1); + + outline = LINES - 1; + + } + + } + + if (destline > LINES - 1) { + + l = destline; + + destline = LINES - 1; + + if (outline < LINES - 1) { + + c = destcol; + + if (pfast == 0 && (!CA || holdcm)) + + destcol = 0; + + fgoto(); + + destcol = c; + + } + + while (l > LINES - 1) { - putch('\n'); +++ /* +++ * The following linefeed (or simulation thereof) +++ * is supposed to scroll up the screen, since we +++ * are on the bottom line. We make the assumption +++ * that linefeed will scroll. If ns is in the +++ * capability list this won't work. We should +++ * probably have an sc capability but sf will +++ * generally take the place if it works. +++ * +++ * Superbee glitch: in the middle of the screen we +++ * have to use esc B (down) because linefeed screws up +++ * in "Efficient Paging" (what a joke) mode (which is +++ * essential in some SB's because CRLF mode puts garbage +++ * in at end of memory), but you must use linefeed to +++ * scroll since down arrow won't go past memory end. +++ * I turned this off after recieving Paul Eggert's +++ * Superbee description which wins better. +++ */ +++ if (xNL /* && !XB */ && pfast) +++ tputs(xNL, 0, putch); +++ else +++ putch('\n'); + + l--; + + if (pfast == 0) + + outcol = 0; + + } + + } + + if (destline < outline && !(CA && !holdcm || UP != NOSTR)) + + destline = outline; + + if (CA && !holdcm) + + if (plod(costCM) > 0) + + plod(0); + + else + + tputs(tgoto(CM, destcol, destline), 0, putch); + + else + + plod(0); + + outline = destline; + + outcol = destcol; + +} + + + +/* + + * Tab to column col by flushing and then setting destcol. + + * Used by "set all". + + */ + +tab(col) + + int col; + +{ + + + + flush1(); + + destcol = col; + +} + + + +/* + + * Move (slowly) to destination. + + * Hard thing here is using home cursor on really deficient terminals. + + * Otherwise just use cursor motions, hacking use of tabs and overtabbing + + * and backspace. + + */ + + + +static int plodcnt, plodflg; + + + +plodput(c) + +{ + + + + if (plodflg) + + plodcnt--; + + else + + putch(c); + +} + + + +plod(cnt) + +{ + + register int i, j, k; + + register int soutcol, soutline; + + + + plodcnt = plodflg = cnt; + + soutcol = outcol; + + soutline = outline; +++ /* +++ * Consider homing and moving down/right from there, vs moving +++ * directly with local motions to the right spot. +++ */ + + if (HO) { +++ /* +++ * i is the cost to home and tab/space to the right to +++ * get to the proper column. This assumes ND space costs +++ * 1 char. So i+destcol is cost of motion with home. +++ */ + + if (GT) - i = (destcol / value(HARDTABS)) + (destcol % value(HARDTABS)); +++ i = (destcol / value(HARDTABS)) + (destcol % value(HARDTABS)); + + else + + i = destcol; - if (destcol >= outcol) { - j = destcol / value(HARDTABS) - outcol / value(HARDTABS); - if (GT && j) - j += destcol % value(HARDTABS); +++ /* +++ * j is cost to move locally without homing +++ */ +++ if (destcol >= outcol) { /* if motion is to the right */ +++ j = destcol / value(HARDTABS) - outcol / value(HARDTABS); +++ if (GT && j) +++ j += destcol % value(HARDTABS); + + else + + j = destcol - outcol; - } else +++ } else +++ /* leftward motion only works if we can backspace. */ + + if (outcol - destcol <= i && (BS || BC)) - i = j = outcol - destcol; +++ i = j = outcol - destcol; /* cheaper to backspace */ + + else - j = i + 1; +++ j = i + 1; /* impossibly expensive */ +++ +++ /* k is the absolute value of vertical distance */ + + k = outline - destline; + + if (k < 0) + + k = -k; + + j += k; - if (i + destline < j) { +++ +++ /* +++ * Decision. We may not have a choice if no UP. +++ */ +++ if (i + destline < j || (!UP && destline < outline)) { +++ /* +++ * Cheaper to home. Do it now and pretend it's a +++ * regular local motion. +++ */ + + tputs(HO, 0, plodput); + + outcol = outline = 0; + + } else if (LL) { +++ /* +++ * Quickly consider homing down and moving from there. +++ * Assume cost of LL is 2. +++ */ + + k = (LINES - 1) - destline; - if (i + k + 2 < j) { +++ if (i + k + 2 < j && (k<=0 || UP)) { + + tputs(LL, 0, plodput); + + outcol = 0; + + outline = LINES - 1; + + } + + } - } +++ } else +++ /* +++ * No home and no up means it's impossible, so we return an +++ * incredibly big number to make cursor motion win out. +++ */ +++ if (!UP && destline < outline) +++ return (500); + + if (GT) - i = destcol % value(HARDTABS) + destcol / value(HARDTABS); +++ i = destcol % value(HARDTABS) +++ + destcol / value(HARDTABS); + + else + + i = destcol; + +/* + + if (BT && outcol > destcol && (j = (((outcol+7) & ~7) - destcol - 1) >> 3)) { + + j *= (k = strlen(BT)); + + if ((k += (destcol&7)) > 4) + + j += 8 - (destcol&7); + + else + + j += k; + + } else + +*/ + + j = outcol - destcol; + + /* + + * If we will later need a \n which will turn into a \r\n by + + * the system or the terminal, then don't bother to try to \r. + + */ + + if ((NONL || !pfast) && outline < destline) + + goto dontcr; + + /* + + * If the terminal will do a \r\n and there isn't room for it, + + * then we can't afford a \r. + + */ + + if (NC && outline >= destline) + + goto dontcr; + + /* + + * If it will be cheaper, or if we can't back up, then send + + * a return preliminarily. + + */ + + if (j > i + 1 || outcol > destcol && !BS && !BC) { - plodput('\r'); +++ /* +++ * BUG: this doesn't take the (possibly long) length +++ * of xCR into account. +++ */ +++ if (xCR) +++ tputs(xCR, 0, plodput); +++ else +++ plodput('\r'); + + if (NC) { - plodput('\n'); +++ if (xNL) +++ tputs(xNL, 0, plodput); +++ else +++ plodput('\n'); + + outline++; + + } + + outcol = 0; + + } + +dontcr: + + while (outline < destline) { + + outline++; - plodput('\n'); +++ if (xNL && pfast) +++ tputs(xNL, 0, plodput); +++ else +++ plodput('\n'); + + if (plodcnt < 0) + + goto out; + + if (NONL || pfast == 0) + + outcol = 0; + + } + + if (BT) + + k = strlen(BT); + + while (outcol > destcol) { + + if (plodcnt < 0) + + goto out; + +/* + + if (BT && !insmode && outcol - destcol > 4+k) { + + tputs(BT, 0, plodput); + + outcol--; + + outcol &= ~7; + + continue; + + } + +*/ + + outcol--; + + if (BC) + + tputs(BC, 0, plodput); + + else + + plodput('\b'); + + } + + while (outline > destline) { + + outline--; + + tputs(UP, 0, plodput); + + if (plodcnt < 0) + + goto out; + + } + + if (GT && !insmode && destcol - outcol > 1) { + + for (;;) { - i = (outcol / value(HARDTABS) + 1) * value(HARDTABS); +++ i = tabcol(outcol, value(HARDTABS)); + + if (i > destcol) + + break; + + if (TA) + + tputs(TA, 0, plodput); + + else + + plodput('\t'); + + outcol = i; + + } + + if (destcol - outcol > 4 && i < COLUMNS && (BC || BS)) { + + if (TA) + + tputs(TA, 0, plodput); + + else + + plodput('\t'); + + outcol = i; + + while (outcol > destcol) { + + outcol--; + + if (BC) + + tputs(BC, 0, plodput); + + else + + plodput('\b'); + + } + + } + + } + + while (outcol < destcol) { - if (inopen && ND) +++ /* +++ * move one char to the right. We don't use ND space +++ * because it's better to just print the char we are +++ * moving over. There are various exceptions, however. +++ * If !inopen, vtube contains garbage. If the char is +++ * a null or a tab we want to print a space. Other random +++ * chars we use space for instead, too. +++ */ +++ if (!inopen || vtube[outline]==NULL || +++ (i=vtube[outline][outcol]) < ' ') +++ i = ' '; +++ if (insmode && ND) + + tputs(ND, 0, plodput); + + else - plodput(' '); +++ plodput(i); + + outcol++; + + if (plodcnt < 0) + + goto out; + + } + +out: + + if (plodflg) { + + outcol = soutcol; + + outline = soutline; + + } + + return(plodcnt); + +} + + + +/* + + * An input line arrived. + + * Calculate new (approximate) screen line position. + + * Approximate because kill character echoes newline with + + * no feedback and also because of long input lines. + + */ + +noteinp() + +{ + + + + outline++; + + if (outline > LINES - 1) + + outline = LINES - 1; + + destline = outline; + + destcol = outcol = 0; + +} + + + +/* + + * Something weird just happened and we + + * lost track of whats happening out there. + + * Since we cant, in general, read where we are + + * we just reset to some known state. + + * On cursor addressible terminals setting to unknown + + * will force a cursor address soon. + + */ + +termreset() + +{ + + + + endim(); + + if (TI) /* otherwise it flushes anyway, and 'set tty=dumb' vomits */ + + putpad(TI); /*adb change -- emit terminal initial sequence */ + + destcol = 0; + + destline = LINES - 1; + + if (CA) { + + outcol = UKCOL; + + outline = UKCOL; + + } else { + + outcol = destcol; + + outline = destline; + + } + +} + + + +/* + + * Low level buffering, with the ability to drain + + * buffered output without printing it. + + */ + +char *obp = obuf; + + + +draino() + +{ + + + + obp = obuf; + +} + + + +flusho() + +{ + + + + if (obp != obuf) { + + write(1, obuf, obp - obuf); + + obp = obuf; + + } + +} + + + +putnl() + +{ + + + + putchar('\n'); + +} + + + +putS(cp) + + char *cp; + +{ + + + + if (cp == NULL) + + return; + + while (*cp) + + putch(*cp++); + +} + + + + + +putch(c) + + int c; + +{ + + - *obp++ = c; +++ *obp++ = c & 0177; + + if (obp >= &obuf[sizeof obuf]) + + flusho(); + +} + + + +/* + + * Miscellaneous routines related to output. + + */ + + - /* - * Cursor motion. - */ - char * - cgoto() - { - - return (tgoto(CM, destcol, destline)); - } - + +/* + + * Put with padding + + */ + +putpad(cp) + + char *cp; + +{ + + + + flush(); + + tputs(cp, 0, putch); + +} + + + +/* + + * Set output through normal command mode routine. + + */ + +setoutt() + +{ + + + + Outchar = termchar; + +} + + + +/* + + * Printf (temporarily) in list mode. + + */ + +/*VARARGS2*/ + +lprintf(cp, dp) + + char *cp, *dp; + +{ + + register int (*P)(); + + + + P = setlist(1); + + printf(cp, dp); + + Putchar = P; + +} + + + +/* + + * Newline + flush. + + */ + +putNFL() + +{ + + + + putnl(); + + flush(); + +} + + + +/* + + * Try to start -nl mode. + + */ + +pstart() + +{ + + + + if (NONL) + + return; + + if (!value(OPTIMIZE)) + + return; + + if (ruptible == 0 || pfast) + + return; + + fgoto(); + + flusho(); + + pfast = 1; + + normtty++; +++#ifndef USG3TTY + + tty.sg_flags = normf & ~(ECHO|XTABS|CRMOD); +++#else +++ tty = normf; +++ tty.c_oflag &= ~(ONLCR|TAB3); +++ tty.c_lflag &= ~ECHO; +++#endif + + sTTY(1); + +} + + + +/* + + * Stop -nl mode. + + */ + +pstop() + +{ + + + + if (inopen) + + return; + + phadnl = 0; + + linp = linb; + + draino(); + + normal(normf); + + pfast &= ~1; + +} + + + +/* + + * Prep tty for open mode. + + */ +++ttymode + +ostart() + +{ - int f; +++ ttymode f; + + + + if (!intty) + + error("Open and visual must be used interactively"); + + gTTY(1); + + normtty++; +++#ifndef USG3TTY + + f = tty.sg_flags; - #ifdef CBREAK - tty.sg_flags = (normf &~ (ECHO|XTABS|CRMOD)) | CBREAK; +++ tty.sg_flags = (normf &~ (ECHO|XTABS|CRMOD)) | +++# ifdef CBREAK +++ CBREAK; +++# else +++ RAW; +++# endif +++# ifdef TIOCGETC +++ ttcharoff(); +++# endif + +#else - tty.sg_flags = (normf &~ (ECHO|XTABS|CRMOD)) | RAW; - #endif - #ifdef TIOCGETC - nttyc.t_quitc = nttyc.t_startc = nttyc.t_stopc = '\377'; +++ f = tty; +++ tty = normf; +++ tty.c_iflag &= ~ICRNL; +++ tty.c_lflag &= ~(ECHO|ICANON); +++ tty.c_oflag &= ~TAB3; +++ tty.c_cc[VMIN] = 1; +++ tty.c_cc[VTIME] = 1; +++ ttcharoff(); + +#endif + + sTTY(1); - putpad(VS); - putpad(KS); +++ tostart(); + + pfast |= 2; + + return (f); + +} + + +++/* actions associated with putting the terminal in open mode */ +++tostart() +++{ +++ putpad(VS); +++ putpad(KS); +++ if (!value(MESG)) { +++ if (ttynbuf[0] == 0) { +++ register char *tn; +++ if ((tn=ttyname(2)) == NULL && +++ (tn=ttyname(1)) == NULL && +++ (tn=ttyname(0)) == NULL) +++ ttynbuf[0] = 1; +++ else +++ strcpy(ttynbuf, tn); +++ } +++ if (ttynbuf[0] != 1) { +++ struct stat sbuf; +++ stat(ttynbuf, &sbuf); +++ ttymesg = sbuf.st_mode & 0777; +++ chmod(ttynbuf, +++#ifdef UCBV7 +++ /* +++ * This applies to the UCB V7 Pdp-11 system with the +++ * -u write option only. +++ */ +++ 0611 /* 11 = urgent only allowed */ +++#else +++ 0600 +++#endif +++ ); +++ } +++ } +++} +++ +++/* +++ * Turn off start/stop chars if they aren't the default ^S/^Q. +++ * This is so idiots who make esc their start/stop don't lose. +++ * We always turn off quit since datamedias send ^\ for their +++ * right arrow key. +++ */ +++#ifdef TIOCGETC +++ttcharoff() +++{ +++ nttyc.t_quitc = '\377'; +++ if (nttyc.t_startc != CTRL(q)) +++ nttyc.t_startc = '\377'; +++ if (nttyc.t_stopc != CTRL(s)) +++ nttyc.t_stopc = '\377'; +++# ifdef TIOCLGET +++ nlttyc.t_suspc = '\377'; /* ^Z */ +++ nlttyc.t_dsuspc = '\377'; /* ^Y */ +++ nlttyc.t_flushc = '\377'; /* ^O */ +++ nlttyc.t_lnextc = '\377'; /* ^V */ +++# endif +++} +++#endif +++ +++#ifdef USG3TTY +++ttcharoff() +++{ +++ tty.c_cc[VQUIT] = '\377'; +++# ifdef VSTART +++ /* +++ * The following is sample code if USG ever lets people change +++ * their start/stop chars. As long as they can't we can't get +++ * into trouble so we just leave them alone. +++ */ +++ if (tty.c_cc[VSTART] != CTRL(q)) +++ tty.c_cc[VSTART] = '\377'; +++ if (tty.c_cc[VSTOP] != CTRL(s)) +++ tty.c_cc[VSTOP] = '\377'; +++# endif +++} +++#endif +++ + +/* + + * Stop open, restoring tty modes. + + */ + +ostop(f) - int f; +++ ttymode f; + +{ + + +++#ifndef USG3TTY + + pfast = (f & CRMOD) == 0; +++#else +++ pfast = (f.c_oflag & OCRNL) == 0; +++#endif + + termreset(), fgoto(), flusho(); + + normal(f); +++ tostop(); +++} +++ +++/* Actions associated with putting the terminal in the right mode. */ +++tostop() +++{ + + putpad(VE); + + putpad(KE); +++ if (!value(MESG)) +++ chmod(ttynbuf, ttymesg); + +} + + + +#ifndef CBREAK + +/* + + * Into cooked mode for interruptibility. + + */ + +vcook() + +{ + + + + tty.sg_flags &= ~RAW; + + sTTY(1); + +} + + + +/* + + * Back into raw mode. + + */ + +vraw() + +{ + + + + tty.sg_flags |= RAW; + + sTTY(1); + +} + +#endif + + + +/* + + * Restore flags to normal state f. + + */ + +normal(f) - int f; +++ ttymode f; + +{ + + + + if (normtty > 0) { + + setty(f); + + normtty--; + + } + +} + + + +/* + + * Straight set of flags to state f. + + */ +++ttymode + +setty(f) - int f; +++ ttymode f; + +{ +++#ifndef USG3TTY + + register int ot = tty.sg_flags; +++#else +++ ttymode ot; +++ ot = tty; +++#endif + + - #ifdef TIOCGETC - if (f == normf) +++#ifndef USG3TTY +++ if (f == normf) { + + nttyc = ottyc; - else - nttyc.t_quitc = nttyc.t_startc = nttyc.t_stopc = '\377'; - #endif +++# ifdef TIOCLGET +++ nlttyc = olttyc; +++# endif +++ } else +++ ttcharoff(); + + tty.sg_flags = f; +++#else +++ if (tty.c_lflag & ICANON) +++ ttcharoff(); +++ tty = f; +++#endif + + sTTY(1); + + return (ot); + +} + + + +gTTY(i) + + int i; + +{ + + +++#ifndef USG3TTY + + ignore(gtty(i, &tty)); - #ifdef TIOCGETC +++# ifdef TIOCGETC + + ioctl(i, TIOCGETC, &ottyc); + + nttyc = ottyc; +++# endif +++# ifdef TIOCGLTC +++ ioctl(i, TIOCGLTC, &olttyc); +++ nlttyc = olttyc; +++# endif +++#else +++ ioctl(i, TCGETA, &tty); + +#endif + +} + + +++/* +++ * sTTY: set the tty modes on file descriptor i to be what's +++ * currently in global "tty". (Also use nttyc if needed.) +++ */ + +sTTY(i) + + int i; + +{ + + - /* - * Bug in USG tty driver, put out a null char as a patch. - */ - #ifdef USG - if (tty.sg_ospeed == B1200) - write(1, "", 1); - #endif - #ifdef TIOCSETN +++#ifndef USG3TTY +++# ifdef USG +++ /* Bug in USG tty driver, put out a DEL as a patch. */ +++ if (tty.sg_ospeed >= B1200) +++ write(1, "\377", 1); +++# endif +++ +++# ifdef TIOCSETN +++ /* Don't flush typeahead if we don't have to */ + + ioctl(i, TIOCSETN, &tty); - #else +++# else +++ /* We have to. Too bad. */ + + stty(i, &tty); - #endif - #ifdef TIOCSETC +++# endif +++ +++# ifdef TIOCGETC +++ /* Update the other random chars while we're at it. */ + + ioctl(i, TIOCSETC, &nttyc); +++# endif +++# ifdef TIOCSLTC +++ ioctl(i, TIOCSLTC, &nlttyc); +++# endif +++ +++#else +++ /* USG 3 very simple: just set everything */ +++ ioctl(i, TCSETAW, &tty); + +#endif + +} + + + +/* + + * Print newline, or blank if in open/visual + + */ + +noonl() + +{ + + + + putchar(Outchar != termchar ? ' ' : '\n'); + +} +++ +++#ifdef SIGTSTP +++/* +++ * We have just gotten a susp. Suspend and prepare to resume. +++ */ +++onsusp() +++{ +++ ttymode f; +++ +++ f = setty(normf); +++ vnfl(); +++ putpad(TE); +++ flush(); +++ +++ signal(SIGTSTP, SIG_DFL); +++ kill(0, SIGTSTP); +++ +++ /* the pc stops here */ +++ +++ signal(SIGTSTP, onsusp); +++ vcontin(0); +++ setty(f); +++ if (!inopen) +++ error(0); +++ else { +++ if (vcnt < 0) { +++ vcnt = -vcnt; +++ if (state == VISUAL) +++ vclear(); +++ else if (state == CRTOPEN) +++ vcnt = 0; +++ } +++ vdirty(0, LINES); +++ vrepaint(cursor); +++ } +++} diff --cc usr/src/cmd/ex/ex_re.c index 0000000000,93abfaa00b,0000000000..5f0665b762 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_re.c +++ b/usr/src/cmd/ex/ex_re.c @@@@ -1,0 -1,880 -1,0 +1,935 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_re.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_re.h" + + + +/* + + * Global, substitute and regular expressions. + + * Very similar to ed, with some re extensions and + + * confirmed substitute. + + */ + +global(k) + + bool k; + +{ + + register char *gp; + + register int c; + + register line *a1; + + char globuf[GBSIZE], *Cwas; + + int lines = lineDOL(); + + int oinglobal = inglobal; + + char *oglobp = globp; + + + + Cwas = Command; + + /* + + * States of inglobal: + + * 0: ordinary - not in a global command. + + * 1: text coming from some buffer, not tty. + + * 2: like 1, but the source of the buffer is a global command. + + * Hence you're only in a global command if inglobal==2. This + + * strange sounding convention is historically derived from + + * everybody simulating a global command. + + */ + + if (inglobal==2) + + error("Global within global@not allowed"); + + markDOT(); + + setall(); + + nonzero(); + + if (skipend()) + + error("Global needs re|Missing regular expression for global"); + + c = getchar(); + + ignore(compile(c, 1)); + + savere(scanre); + + gp = globuf; + + while ((c = getchar()) != '\n') { + + switch (c) { + + + + case EOF: + + c = '\n'; + + goto brkwh; + + + + case '\\': + + c = getchar(); + + switch (c) { + + + + case '\\': + + ungetchar(c); + + break; + + + + case '\n': + + break; + + + + default: + + *gp++ = '\\'; + + break; + + } + + break; + + } + + *gp++ = c; + + if (gp >= &globuf[GBSIZE - 2]) + + error("Global command too long"); + + } + +brkwh: + + ungetchar(c); + +out: + + newline(); + + *gp++ = c; + + *gp++ = 0; +++ saveall(); + + inglobal = 2; + + for (a1 = one; a1 <= dol; a1++) { + + *a1 &= ~01; + + if (a1 >= addr1 && a1 <= addr2 && execute(0, a1) == k) + + *a1 |= 01; + + } - /* should use gdelete from ed to avoid n**2 here on g/.../d */ - saveall(); +++#ifdef notdef +++/* +++ * This code is commented out for now. The problem is that we don't +++ * fix up the undo area the way we should. Basically, I think what has +++ * to be done is to copy the undo area down (since we shrunk everything) +++ * and move the various pointers into it down too. I will do this later +++ * when I have time. (Mark, 10-20-80) +++ */ +++ /* +++ * Special case: g/.../d (avoid n^2 algorithm) +++ */ +++ if (globuf[0]=='d' && globuf[1]=='\n' && globuf[2]=='\0') { +++ gdelete(); +++ return; +++ } +++#endif + + if (inopen) + + inopen = -1; +++ /* +++ * Now for each marked line, set dot there and do the commands. +++ * Note the n^2 behavior here for lots of lines matching. +++ * This is really needed: in some cases you could delete lines, +++ * causing a marked line to be moved before a1 and missed if +++ * we didn't restart at zero each time. +++ */ + + for (a1 = one; a1 <= dol; a1++) { + + if (*a1 & 01) { + + *a1 &= ~01; + + dot = a1; + + globp = globuf; + + commands(1, 1); + + a1 = zero; + + } + + } + + globp = oglobp; + + inglobal = oinglobal; + + endline = 1; + + Command = Cwas; + + netchHAD(lines); + + setlastchar(EOF); + + if (inopen) { + + ungetchar(EOF); + + inopen = 1; + + } + +} + + - bool xflag; +++/* +++ * gdelete: delete inside a global command. Handles the +++ * special case g/r.e./d. All lines to be deleted have +++ * already been marked. Squeeze the remaining lines together. +++ * Note that other cases such as g/r.e./p, g/r.e./s/r.e.2/rhs/, +++ * and g/r.e./.,/r.e.2/d are not treated specially. There is no +++ * good reason for this except the question: where to you draw the line? +++ */ +++gdelete() +++{ +++ register line *a1, *a2, *a3; +++ +++ a3 = dol; +++ /* find first marked line. can skip all before it */ +++ for (a1=zero; (*a1&01)==0; a1++) +++ if (a1>=a3) +++ return; +++ /* copy down unmarked lines, compacting as we go. */ +++ for (a2=a1+1; a2<=a3;) { +++ if (*a2&01) { +++ a2++; /* line is marked, skip it */ +++ dot = a1; /* dot left after line deletion */ +++ } else +++ *a1++ = *a2++; /* unmarked, copy it */ +++ } +++ dol = a1-1; +++ if (dot>dol) +++ dot = dol; +++ change(); +++} +++ +++bool cflag; + +int scount, slines, stotal; + + + +substitute(c) + + int c; + +{ + + register line *addr; + + register int n; - int gsubf; +++ int gsubf, hopcount = 0; + + + + gsubf = compsub(c); - if (!inglobal) +++ if(FIXUNDO) + + save12(), undkind = UNDCHANGE; + + stotal = 0; + + slines = 0; + + for (addr = addr1; addr <= addr2; addr++) { + + scount = 0; + + if (dosubcon(0, addr) == 0) + + continue; + + if (gsubf) { - #ifdef notdef + + /* - * should check but loc2 is already munged. - * This needs a fancier check later. +++ * The loop can happen from s/\ sizeof linebuf) +++ error("substitution loop"); + + if (dosubcon(1, addr) == 0) + + break; +++ } + + } + + if (scount) { + + stotal += scount; + + slines++; + + putmark(addr); + + n = append(getsub, addr); + + addr += n; + + addr2 += n; + + } + + } - if (stotal == 0 && !inglobal && !xflag) +++ if (stotal == 0 && !inglobal && !cflag) + + error("Fail|Substitute pattern match failed"); + + snote(stotal, slines); + + return (stotal); + +} + + + +compsub(ch) + +{ + + register int seof, c, uselastre; + + static int gsubf; + + + + if (!value(EDCOMPATIBLE)) - gsubf = xflag = 0; +++ gsubf = cflag = 0; + + uselastre = 0; + + switch (ch) { + + + + case 's': + + ignore(skipwh()); + + seof = getchar(); + + if (endcmd(seof) || any(seof, "gcr")) { + + ungetchar(seof); + + goto redo; + + } + + if (isalpha(seof) || isdigit(seof)) + + error("Substitute needs re|Missing regular expression for substitute"); + + seof = compile(seof, 1); + + uselastre = 1; + + comprhs(seof); + + gsubf = 0; - xflag = 0; +++ cflag = 0; + + break; + + + + case '~': + + uselastre = 1; + + /* fall into ... */ + + case '&': + + redo: + + if (re.Expbuf[0] == 0) + + error("No previous re|No previous regular expression"); +++ if (subre.Expbuf[0] == 0) +++ error("No previous substitute re|No previous substitute to repeat"); + + break; + + } + + for (;;) { + + c = getchar(); + + switch (c) { + + + + case 'g': + + gsubf = !gsubf; + + continue; + + + + case 'c': - xflag = !xflag; +++ cflag = !cflag; + + continue; + + + + case 'r': + + uselastre = 1; + + continue; + + + + default: + + ungetchar(c); + + setcount(); + + newline(); + + if (uselastre) + + savere(subre); + + else + + resre(subre); + + return (gsubf); + + } + + } + +} + + + +comprhs(seof) + + int seof; + +{ + + register char *rp, *orp; + + register int c; - char orhsbuf[LBSIZE / 2]; +++ char orhsbuf[RHSSIZE]; + + + + rp = rhsbuf; + + CP(orhsbuf, rp); + + for (;;) { + + c = getchar(); + + if (c == seof) + + break; + + switch (c) { + + + + case '\\': + + c = getchar(); + + if (c == EOF) { + + ungetchar(c); + + break; + + } + + if (value(MAGIC)) { + + /* + + * When "magic", \& turns into a plain &, + + * and all other chars work fine quoted. + + */ + + if (c != '&') + + c |= QUOTE; + + break; + + } + +magic: + + if (c == '~') { + + for (orp = orhsbuf; *orp; *rp++ = *orp++) - if (rp >= &rhsbuf[LBSIZE / 2 + 1]) +++ if (rp >= &rhsbuf[RHSSIZE - 1]) + + goto toobig; + + continue; + + } + + c |= QUOTE; + + break; + + + + case '\n': + + case EOF: - ungetchar(c); - goto endrhs; +++ if (!(globp && globp[0])) { +++ ungetchar(c); +++ goto endrhs; +++ } + + + + case '~': + + case '&': + + if (value(MAGIC)) + + goto magic; + + break; + + } - if (rp >= &rhsbuf[LBSIZE / 2 - 1]) +++ if (rp >= &rhsbuf[RHSSIZE - 1]) { + +toobig: +++ *rp = 0; + + error("Replacement pattern too long@- limit 256 characters"); +++ } + + *rp++ = c; + + } + +endrhs: + + *rp++ = 0; + +} + + + +getsub() + +{ + + register char *p; + + + + if ((p = linebp) == 0) + + return (EOF); + + strcLIN(p); + + linebp = 0; + + return (0); + +} + + + +dosubcon(f, a) + + bool f; + + line *a; + +{ + + + + if (execute(f, a) == 0) + + return (0); + + if (confirmed(a)) { + + dosub(); + + scount++; + + } + + return (1); + +} + + + +confirmed(a) + + line *a; + +{ + + register int c, ch; + + - if (xflag == 0) +++ if (cflag == 0) + + return (1); + + pofix(); + + pline(lineno(a)); + + if (inopen) + + putchar('\n' | QUOTE); + + c = column(loc1 - 1); + + ugo(c - 1 + (inopen ? 1 : 0), ' '); + + ugo(column(loc2 - 1) - c, '^'); + + flush(); + + ch = c = getkey(); + +again: + + if (c == '\r') + + c = '\n'; + + if (inopen) + + putchar(c), flush(); + + if (c != '\n' && c != EOF) { + + c = getkey(); + + goto again; + + } + + noteinp(); + + return (ch == 'y'); + +} + + + +getch() + +{ + + char c; + + + + if (read(2, &c, 1) != 1) + + return (EOF); + + return (c & TRIM); + +} + + + +ugo(cnt, with) + + int with; + + int cnt; + +{ + + + + if (cnt > 0) + + do + + putchar(with); + + while (--cnt > 0); + +} + + + +int casecnt; + +bool destuc; + + + +dosub() + +{ + + register char *lp, *sp, *rp; + + int c; + + + + lp = linebuf; + + sp = genbuf; + + rp = rhsbuf; + + while (lp < loc1) + + *sp++ = *lp++; + + casecnt = 0; + + while (c = *rp++) { + + if (c & QUOTE) + + switch (c & TRIM) { + + + + case '&': + + sp = place(sp, loc1, loc2); + + if (sp == 0) + + goto ovflo; + + continue; + + + + case 'l': + + casecnt = 1; + + destuc = 0; + + continue; + + + + case 'L': + + casecnt = LBSIZE; + + destuc = 0; + + continue; + + + + case 'u': + + casecnt = 1; + + destuc = 1; + + continue; + + + + case 'U': + + casecnt = LBSIZE; + + destuc = 1; + + continue; + + + + case 'E': + + case 'e': + + casecnt = 0; + + continue; + + } + + if (c < 0 && (c &= TRIM) >= '1' && c < nbra + '1') { + + sp = place(sp, braslist[c - '1'], braelist[c - '1']); + + if (sp == 0) + + goto ovflo; + + continue; + + } + + if (casecnt) + + *sp++ = fixcase(c & TRIM); + + else + + *sp++ = c & TRIM; + + if (sp >= &genbuf[LBSIZE]) + +ovflo: + + error("Line overflow@in substitute"); + + } + + lp = loc2; + + loc2 = sp + (linebuf - genbuf); + + while (*sp++ = *lp++) + + if (sp >= &genbuf[LBSIZE]) + + goto ovflo; + + strcLIN(genbuf); + +} + + + +fixcase(c) + + register int c; + +{ + + + + if (casecnt == 0) + + return (c); + + casecnt--; + + if (destuc) { + + if (islower(c)) + + c = toupper(c); + + } else + + if (isupper(c)) + + c = tolower(c); + + return (c); + +} + + + +char * + +place(sp, l1, l2) + + register char *sp, *l1, *l2; + +{ + + + + while (l1 < l2) { + + *sp++ = fixcase(*l1++); + + if (sp >= &genbuf[LBSIZE]) + + return (0); + + } + + return (sp); + +} + + + +snote(total, lines) + + register int total, lines; + +{ + + + + if (!notable(total)) + + return; + + printf(mesg("%d subs|%d substitutions"), total); + + if (lines != 1 && lines != total) + + printf(" on %d lines", lines); + + noonl(); + + flush(); + +} + + + +compile(eof, oknl) + + int eof; + + int oknl; + +{ + + register int c; + + register char *ep; + + char *lastep; + + char bracket[NBRA], *bracketp, *rhsp; + + int cclcnt; + + + + if (isalpha(eof) || isdigit(eof)) + + error("Regular expressions cannot be delimited by letters or digits"); + + ep = expbuf; + + c = getchar(); + + if (eof == '\\') + + switch (c) { + + + + case '/': + + case '?': + + if (scanre.Expbuf[0] == 0) + +error("No previous scan re|No previous scanning regular expression"); + + resre(scanre); + + return (c); + + + + case '&': + + if (subre.Expbuf[0] == 0) + +error("No previous substitute re|No previous substitute regular expression"); + + resre(subre); + + return (c); + + + + default: + + error("Badly formed re|Regular expression \\ must be followed by / or ?"); + + } + + if (c == eof || c == '\n' || c == EOF) { + + if (*ep == 0) + + error("No previous re|No previous regular expression"); + + if (c == '\n' && oknl == 0) + + error("Missing closing delimiter@for regular expression"); + + if (c != eof) + + ungetchar(c); + + return (eof); + + } + + bracketp = bracket; + + nbra = 0; + + circfl = 0; + + if (c == '^') { + + c = getchar(); + + circfl++; + + } + + ungetchar(c); + + for (;;) { + + if (ep >= &expbuf[ESIZE - 2]) + +complex: + + cerror("Re too complex|Regular expression too complicated"); + + c = getchar(); + + if (c == eof || c == EOF) { + + if (bracketp != bracket) + +cerror("Unmatched \\(|More \\('s than \\)'s in regular expression"); - *ep++ = CEOF; +++ *ep++ = CEOFC; + + if (c == EOF) + + ungetchar(c); + + return (eof); + + } + + if (value(MAGIC)) { + + if (c != '*' || ep == expbuf) + + lastep = ep; + + } else + + if (c != '\\' || peekchar() != '*' || ep == expbuf) + + lastep = ep; + + switch (c) { + + + + case '\\': + + c = getchar(); + + switch (c) { + + + + case '(': + + if (nbra >= NBRA) + +cerror("Awash in \\('s!|Too many \\('d subexressions in a regular expression"); + + *bracketp++ = nbra; + + *ep++ = CBRA; + + *ep++ = nbra++; + + continue; + + + + case ')': + + if (bracketp <= bracket) + +cerror("Extra \\)|More \\)'s than \\('s in regular expression"); + + *ep++ = CKET; + + *ep++ = *--bracketp; + + continue; + + + + case '<': + + *ep++ = CBRC; + + continue; + + + + case '>': + + *ep++ = CLET; + + continue; + + } + + if (value(MAGIC) == 0) + +magic: + + switch (c) { + + + + case '.': + + *ep++ = CDOT; + + continue; + + + + case '~': + + rhsp = rhsbuf; + + while (*rhsp) { + + if (*rhsp & QUOTE) { + + c = *rhsp & TRIM; + + if (c == '&') + +error("Replacement pattern contains &@- cannot use in re"); + + if (c >= '1' && c <= '9') + +error("Replacement pattern contains \\d@- cannot use in re"); + + } + + if (ep >= &expbuf[ESIZE-2]) + + goto complex; + + *ep++ = CCHR; + + *ep++ = *rhsp++ & TRIM; + + } + + continue; + + + + case '*': + + if (ep == expbuf) + + break; + + if (*lastep == CBRA || *lastep == CKET) + +cerror("Illegal *|Can't * a \\( ... \\) in regular expression"); + + if (*lastep == CCHR && (lastep[1] & QUOTE)) + +cerror("Illegal *|Can't * a \\n in regular expression"); + + *lastep |= STAR; + + continue; + + + + case '[': + + *ep++ = CCL; + + *ep++ = 0; + + cclcnt = 1; + + c = getchar(); + + if (c == '^') { + + c = getchar(); + + ep[-2] = NCCL; + + } + + if (c == ']') + +cerror("Bad character class|Empty character class '[]' or '[^]' cannot match"); + + while (c != ']') { + + if (c == '\\' && any(peekchar(), "]-^\\")) + + c = getchar() | QUOTE; + + if (c == '\n' || c == EOF) + + cerror("Missing ]"); + + *ep++ = c; + + cclcnt++; + + if (ep >= &expbuf[ESIZE]) + + goto complex; + + c = getchar(); + + } + + lastep[1] = cclcnt; + + continue; + + } + + if (c == EOF) { + + ungetchar(EOF); + + c = '\\'; + + goto defchar; + + } + + *ep++ = CCHR; + + if (c == '\n') + +cerror("No newlines in re's|Can't escape newlines into regular expressions"); + +/* + + if (c < '1' || c > NBRA + '1') { + +*/ + + *ep++ = c; + + continue; + +/* + + } + + c -= '1'; + + if (c >= nbra) + +cerror("Bad \\n|\\n in regular expression with n greater than the number of \\('s"); + + *ep++ = c | QUOTE; + + continue; + +*/ + + + + case '\n': + + if (oknl) { + + ungetchar(c); - *ep++ = CEOF; +++ *ep++ = CEOFC; + + return (eof); + + } + +cerror("Badly formed re|Missing closing delimiter for regular expression"); + + + + case '$': + + if (peekchar() == eof || peekchar() == EOF || oknl && peekchar() == '\n') { + + *ep++ = CDOL; + + continue; + + } + + goto defchar; + + + + case '.': + + case '~': + + case '*': + + case '[': + + if (value(MAGIC)) + + goto magic; + +defchar: + + default: + + *ep++ = CCHR; + + *ep++ = c; + + continue; + + } + + } + +} + + + +cerror(s) + + char *s; + +{ + + + + expbuf[0] = 0; + + error(s); + +} + + + +same(a, b) + + register int a, b; + +{ + + + + return (a == b || value(IGNORECASE) && + + ((islower(a) && toupper(a) == b) || (islower(b) && toupper(b) == a))); + +} + + + +char *locs; + + + +execute(gf, addr) + + line *addr; + +{ + + register char *p1, *p2; + + register int c; + + + + if (gf) { + + if (circfl) + + return (0); - #ifdef notdef - if (loc1 == loc2) - loc2++; - #endif + + locs = p1 = loc2; + + } else { + + if (addr == zero) + + return (0); + + p1 = linebuf; + + getline(*addr); + + locs = 0; + + } + + p2 = expbuf; + + if (circfl) { + + loc1 = p1; + + return (advance(p1, p2)); + + } + + /* fast check for first character */ + + if (*p2 == CCHR) { + + c = p2[1]; + + do { + + if (c != *p1 && (!value(IGNORECASE) || + + !((islower(c) && toupper(c) == *p1) || + + (islower(*p1) && toupper(*p1) == c)))) + + continue; + + if (advance(p1, p2)) { + + loc1 = p1; + + return (1); + + } + + } while (*p1++); + + return (0); + + } + + /* regular algorithm */ + + do { + + if (advance(p1, p2)) { + + loc1 = p1; + + return (1); + + } + + } while (*p1++); + + return (0); + +} + + + +#define uletter(c) (isalpha(c) || c == '_') + + + +advance(lp, ep) + + register char *lp, *ep; + +{ + + register char *curlp; + + char *sp, *sp1; + + int c; + + + + for (;;) switch (*ep++) { + + + + case CCHR: + +/* useless + + if (*ep & QUOTE) { + + c = *ep++ & TRIM; + + sp = braslist[c]; + + sp1 = braelist[c]; + + while (sp < sp1) { + + if (!same(*sp, *lp)) + + return (0); + + sp++, lp++; + + } + + continue; + + } + +*/ + + if (!same(*ep, *lp)) + + return (0); + + ep++, lp++; + + continue; + + + + case CDOT: + + if (*lp++) + + continue; + + return (0); + + + + case CDOL: + + if (*lp == 0) + + continue; + + return (0); + + - case CEOF: +++ case CEOFC: + + loc2 = lp; + + return (1); + + + + case CCL: + + if (cclass(ep, *lp++, 1)) { + + ep += *ep; + + continue; + + } + + return (0); + + + + case NCCL: + + if (cclass(ep, *lp++, 0)) { + + ep += *ep; + + continue; + + } + + return (0); + + + + case CBRA: + + braslist[*ep++] = lp; + + continue; + + + + case CKET: + + braelist[*ep++] = lp; + + continue; + + + + case CDOT|STAR: + + curlp = lp; + + while (*lp++) + + continue; + + goto star; + + + + case CCHR|STAR: + + curlp = lp; + + while (same(*lp, *ep)) + + lp++; + + lp++; + + ep++; + + goto star; + + + + case CCL|STAR: + + case NCCL|STAR: + + curlp = lp; + + while (cclass(ep, *lp++, ep[-1] == (CCL|STAR))) + + continue; + + ep += *ep; + + goto star; + +star: + + do { + + lp--; + + if (lp == locs) + + break; + + if (advance(lp, ep)) + + return (1); + + } while (lp > curlp); + + return (0); + + + + case CBRC: + + if (lp == expbuf) + + continue; + + if ((isdigit(*lp) || uletter(*lp)) && !uletter(lp[-1]) && !isdigit(lp[-1])) + + continue; + + return (0); + + + + case CLET: + + if (!uletter(*lp) && !isdigit(*lp)) + + continue; + + return (0); + + + + default: + + error("Re internal error"); + + } + +} + + + +cclass(set, c, af) + + register char *set; + + register int c; + + int af; + +{ + + register int n; + + + + if (c == 0) + + return (0); + + if (value(IGNORECASE) && isupper(c)) + + c = tolower(c); + + n = *set++; + + while (--n) + + if (n > 2 && set[1] == '-') { + + if (c >= (set[0] & TRIM) && c <= (set[2] & TRIM)) + + return (af); + + set += 3; + + n -= 2; + + } else + + if ((*set++ & TRIM) == c) + + return (af); + + return (!af); + +} diff --cc usr/src/cmd/ex/ex_re.h index 0000000000,500d5d5a96,0000000000..bc4f651faf mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_re.h +++ b/usr/src/cmd/ex/ex_re.h @@@@ -1,0 -1,66 -1,0 +1,67 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* sccs id: @(#)ex_re.h 6.1 10/18/80 */ + +/* + + * Regular expression definitions. + + * The regular expressions in ex are similar to those in ed, + + * with the addition of the word boundaries from Toronto ed + + * and allowing character classes to have [a-b] as in the shell. + + * The numbers for the nodes below are spaced further apart then + + * necessary because I at one time partially put in + and | (one or + + * more and alternation.) + + */ + +struct regexp { + + char Expbuf[ESIZE + 2]; + + bool Circfl; + + short Nbra; + +}; + + + +/* + + * There are three regular expressions here, the previous (in re), + + * the previous substitute (in subre) and the previous scanning (in scanre). + + * It would be possible to get rid of "re" by making it a stack parameter + + * to the appropriate routines. + + */ + +struct regexp re; /* Last re */ + +struct regexp scanre; /* Last scanning re */ + +struct regexp subre; /* Last substitute re */ + + + +/* + + * Defining circfl and expbuf like this saves us from having to change + + * old code in the ex_re.c stuff. + + */ + +#define expbuf re.Expbuf + +#define circfl re.Circfl + +#define nbra re.Nbra + + + +/* + + * Since the phototypesetter v7-epsilon + + * C compiler doesn't have structure assignment... + + */ + +#define savere(a) copy(&a, &re, sizeof (struct regexp)) + +#define resre(a) copy(&re, &a, sizeof (struct regexp)) + + + +/* + + * Definitions for substitute + + */ + +char *braslist[NBRA]; /* Starts of \(\)'ed text in lhs */ + +char *braelist[NBRA]; /* Ends... */ + +char rhsbuf[RHSSIZE]; /* Rhs of last substitute */ + + + +/* + + * Definitions of codes for the compiled re's. + + * The re algorithm is described in a paper + + * by K. Thompson in the CACM about 10 years ago + + * and is the same as in ed. + + */ + +#define STAR 1 + + + +#define CBRA 1 + +#define CDOT 4 + +#define CCL 8 + +#define NCCL 12 + +#define CDOL 16 - #define CEOF 17 +++#define CEOFC 17 + +#define CKET 18 + +#define CCHR 20 + +#define CBRC 24 + +#define CLET 25 diff --cc usr/src/cmd/ex/ex_set.c index 0000000000,721836c551,0000000000..0ae557d0be mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_set.c +++ b/usr/src/cmd/ex/ex_set.c @@@@ -1,0 -1,197 -1,0 +1,225 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_set.c 6.3 10/30/80"; + +#include "ex.h" + +#include "ex_temp.h" +++#include "ex_tty.h" + + + +/* + + * Set command. + + */ + +char optname[ONMSZ]; + + + +set() + +{ + + register char *cp; + + register struct option *op; + + register int c; + + bool no; +++ extern short ospeed; + + + + setnoaddr(); + + if (skipend()) { + + if (peekchar() != EOF) + + ignchar(); + + propts(); + + return; + + } + + do { + + cp = optname; + + do { + + if (cp < &optname[ONMSZ - 2]) + + *cp++ = getchar(); - } while (isalpha(peekchar())); +++ } while (isalnum(peekchar())); + + *cp = 0; + + cp = optname; + + if (eq("all", cp)) { + + if (inopen) + + pofix(); + + prall(); + + goto next; + + } + + no = 0; + + if (cp[0] == 'n' && cp[1] == 'o') { + + cp += 2; + + no++; + + } +++ /* Implement w300, w1200, and w9600 specially */ +++ if (eq(cp, "w300")) { +++ if (ospeed >= B1200) { +++dontset: +++ ignore(getchar()); /* = */ +++ ignore(getnum()); /* value */ +++ continue; +++ } +++ cp = "window"; +++ } else if (eq(cp, "w1200")) { +++ if (ospeed < B1200 || ospeed >= B2400) +++ goto dontset; +++ cp = "window"; +++ } else if (eq(cp, "w9600")) { +++ if (ospeed < B2400) +++ goto dontset; +++ cp = "window"; +++ } + + for (op = options; op < &options[NOPTS]; op++) + + if (eq(op->oname, cp) || op->oabbrev && eq(op->oabbrev, cp)) + + break; + + if (op->oname == 0) + + serror("%s: No such option@- 'set all' gives all option values", cp); + + c = skipwh(); + + if (peekchar() == '?') { + + ignchar(); + +printone: + + propt(op); + + noonl(); + + goto next; + + } + + if (op->otype == ONOFF) { + + op->ovalue = 1 - no; +++ if (op == &options[PROMPT]) +++ oprompt = 1 - no; + + goto next; + + } + + if (no) + + serror("Option %s is not a toggle", op->oname); + + if (c != 0 || setend()) + + goto printone; + + if (getchar() != '=') + + serror("Missing =@in assignment to option %s", op->oname); + + switch (op->otype) { + + + + case NUMERIC: + + if (!isdigit(peekchar())) - error("Digits required@after = when assigning numeric option"); +++ error("Digits required@after ="); + + op->ovalue = getnum(); + + if (value(TABSTOP) <= 0) + + value(TABSTOP) = TABS; +++ if (op == &options[WINDOW]) { +++ if (value(WINDOW) >= LINES) +++ value(WINDOW) = LINES-1; +++ vsetsiz(value(WINDOW)); +++ } + + break; + + + + case STRING: + + case OTERM: + + cp = optname; + + while (!setend()) { + + if (cp >= &optname[ONMSZ]) + + error("String too long@in option assignment"); + + /* adb change: allow whitepace in strings */ + + if( (*cp = getchar()) == '\\') + + if( peekchar() != EOF) + + *cp = getchar(); + + cp++; + + } + + *cp = 0; + + if (op->otype == OTERM) { + +/* + + * At first glance it seems like we shouldn't care if the terminal type + + * is changed inside visual mode, as long as we assume the screen is + + * a mess and redraw it. However, it's a much harder problem than that. + + * If you happen to change from 1 crt to another that both have the same + + * size screen, it's OK. But if the screen size if different, the stuff + + * that gets initialized in vop() will be wrong. This could be overcome + + * by redoing the initialization, e.g. making the first 90% of vop into + + * a subroutine. However, the most useful case is where you forgot to do + + * a setenv before you went into the editor and it thinks you're on a dumb + + * terminal. Ex treats this like hardcopy and goes into HARDOPEN mode. + + * This loses because the first part of vop calls oop in this case. + + * The problem is so hard I gave up. I'm not saying it can't be done, + + * but I am saying it probably isn't worth the effort. + + */ + + if (inopen) + +error("Can't change type of terminal from within open/visual"); + + setterm(optname); + + } else { + + CP(op->osvalue, optname); + + op->odefault = 1; + + } + + break; + + } + +next: + + flush(); + + } while (!skipend()); + + eol(); + +} + + + +setend() + +{ + + + + return (iswhite(peekchar()) || endcmd(peekchar())); + +} + + + +prall() + +{ + + register int incr = (NOPTS + 2) / 3; + + register int rows = incr; + + register struct option *op = options; + + + + for (; rows; rows--, op++) { + + propt(op); + + tab(24); + + propt(&op[incr]); + + if (&op[2*incr] < &options[NOPTS]) { + + tab(56); + + propt(&op[2 * incr]); + + } + + putNFL(); + + } + +} + + + +propts() + +{ + + register struct option *op; + + + + for (op = options; op < &options[NOPTS]; op++) { + +#ifdef V6 + + if (op == &options[TERM]) + +#else + + if (op == &options[TTYTYPE]) + +#endif + + continue; + + switch (op->otype) { + + + + case ONOFF: + + case NUMERIC: + + if (op->ovalue == op->odefault) + + continue; + + break; + + + + case STRING: + + if (op->odefault == 0) + + continue; + + break; + + } + + propt(op); + + putchar(' '); + + } + + noonl(); + + flush(); + +} + + + +propt(op) + + register struct option *op; + +{ + + register char *name; + + + + name = op->oname; + + + + switch (op->otype) { + + + + case ONOFF: + + printf("%s%s", op->ovalue ? "" : "no", name); + + break; + + + + case NUMERIC: + + printf("%s=%d", name, op->ovalue); + + break; + + + + case STRING: + + case OTERM: + + printf("%s=%s", name, op->osvalue); + + break; + + } + +} diff --cc usr/src/cmd/ex/ex_subr.c index 0000000000,1e17f4cb29,0000000000..74b81bb7ba mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_subr.c +++ b/usr/src/cmd/ex/ex_subr.c @@@@ -1,0 -1,760 -1,0 +1,829 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_subr.c 6.2 11/6/80"; + +#include "ex.h" + +#include "ex_re.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Random routines, in alphabetical order. + + */ + + + +any(c, s) + + int c; + + register char *s; + +{ + + register int x; + + + + while (x = *s++) + + if (x == c) + + return (1); + + return (0); + +} + + + +backtab(i) + + register int i; + +{ + + register int j; + + + + j = i % value(SHIFTWIDTH); + + if (j == 0) + + j = value(SHIFTWIDTH); + + i -= j; + + if (i < 0) + + i = 0; + + return (i); + +} + + + +change() + +{ + + + + tchng++; + + chng = tchng; + +} + + + +/* + + * Column returns the number of + + * columns occupied by printing the + + * characters through position cp of the + + * current line. + + */ + +column(cp) + + register char *cp; + +{ + + + + if (cp == 0) + + cp = &linebuf[LBSIZE - 2]; + + return (qcolumn(cp, (char *) 0)); + +} + + +++/* +++ * Ignore a comment to the end of the line. +++ * This routine eats the trailing newline so don't call newline(). +++ */ +++comment() +++{ +++ register int c; +++ +++ do { +++ c = getchar(); +++ } while (c != '\n' && c != EOF); +++ if (c == EOF) +++ ungetchar(c); +++} +++ + +Copy(to, from, size) + + register char *from, *to; + + register int size; + +{ + + + + if (size > 0) + + do + + *to++ = *from++; + + while (--size > 0); + +} + + + +copyw(to, from, size) + + register line *from, *to; + + register int size; + +{ + + + + if (size > 0) + + do + + *to++ = *from++; + + while (--size > 0); + +} + + + +copywR(to, from, size) + + register line *from, *to; + + register int size; + +{ + + + + while (--size >= 0) + + to[size] = from[size]; + +} + + + +ctlof(c) + + int c; + +{ + + + + return (c == TRIM ? '?' : c | ('A' - 1)); + +} + + + +dingdong() + +{ + + + + if (VB) + + putpad(VB); + + else if (value(ERRORBELLS)) + + putch('\207'); + +} + + + +fixindent(indent) + + int indent; + +{ + + register int i; + + register char *cp; + + + + i = whitecnt(genbuf); + + cp = vpastwh(genbuf); + + if (*cp == 0 && i == indent && linebuf[0] == 0) { + + genbuf[0] = 0; + + return (i); + + } + + CP(genindent(i), cp); + + return (i); + +} + + + +filioerr(cp) + + char *cp; + +{ + + register int oerrno = errno; + + + + lprintf("\"%s\"", cp); + + errno = oerrno; + + syserror(); + +} + + + +char * + +genindent(indent) + + register int indent; + +{ + + register char *cp; + + + + for (cp = genbuf; indent >= value(TABSTOP); indent -= value(TABSTOP)) + + *cp++ = '\t'; + + for (; indent > 0; indent--) + + *cp++ = ' '; + + return (cp); + +} + + + +getDOT() + +{ + + + + getline(*dot); + +} + + + +line * + +getmark(c) + + register int c; + +{ + + register line *addr; + + + + for (addr = one; addr <= dol; addr++) + + if (names[c - 'a'] == (*addr &~ 01)) { + + return (addr); + + } + + return (0); + +} + + + +getn(cp) + + register char *cp; + +{ + + register int i = 0; + + + + while (isdigit(*cp)) + + i = i * 10 + *cp++ - '0'; + + if (*cp) + + return (0); + + return (i); + +} + + + +ignnEOF() + +{ + + register int c = getchar(); + + + + if (c == EOF) + + ungetchar(c); +++ else if (c=='"') +++ comment(); + +} + + + +iswhite(c) + + int c; + +{ + + + + return (c == ' ' || c == '\t'); + +} + + + +junk(c) + + register int c; + +{ + + + + if (c && !value(BEAUTIFY)) + + return (0); + + if (c >= ' ' && c != TRIM) + + return (0); + + switch (c) { + + + + case '\t': + + case '\n': + + case '\f': + + return (0); + + + + default: + + return (1); + + } + +} + + + +killed() + +{ + + + + killcnt(addr2 - addr1 + 1); + +} + + + +killcnt(cnt) + + register int cnt; + +{ + + + + if (inopen) { + + notecnt = cnt; + + notenam = notesgn = ""; + + return; + + } + + if (!notable(cnt)) + + return; + + printf("%d lines", cnt); + + if (value(TERSE) == 0) { + + printf(" %c%s", Command[0] | ' ', Command + 1); + + if (Command[strlen(Command) - 1] != 'e') + + putchar('e'); + + putchar('d'); + + } + + putNFL(); + +} + + + +lineno(a) + + line *a; + +{ + + + + return (a - zero); + +} + + + +lineDOL() + +{ + + + + return (lineno(dol)); + +} + + + +lineDOT() + +{ + + + + return (lineno(dot)); + +} + + + +markDOT() + +{ + + + + markpr(dot); + +} + + + +markpr(which) + + line *which; + +{ + + + + if ((inglobal == 0 || inopen) && which <= endcore) { + + names['z'-'a'+1] = *which & ~01; + + if (inopen) + + ncols['z'-'a'+1] = cursor; + + } + +} + + + +markreg(c) + + register int c; + +{ + + + + if (c == '\'' || c == '`') + + return ('z' + 1); + + if (c >= 'a' && c <= 'z') + + return (c); + + return (0); + +} + + + +/* + + * Mesg decodes the terse/verbose strings. Thus + + * 'xxx@yyy' -> 'xxx' if terse, else 'xxx yyy' + + * 'xxx|yyy' -> 'xxx' if terse, else 'yyy' + + * All others map to themselves. + + */ + +char * + +mesg(str) + + register char *str; + +{ + + register char *cp; + + + + str = strcpy(genbuf, str); + + for (cp = str; *cp; cp++) + + switch (*cp) { + + + + case '@': + + if (value(TERSE)) + + *cp = 0; + + else + + *cp = ' '; + + break; + + + + case '|': + + if (value(TERSE) == 0) + + return (cp + 1); + + *cp = 0; + + break; + + } + + return (str); + +} + + + +/*VARARGS2*/ + +merror(seekpt, i) + +#ifdef VMUNIX + + char *seekpt; + +#else + +# ifdef lint + + char *seekpt; + +# else + + int seekpt; + +# endif + +#endif + + int i; + +{ + + register char *cp = linebuf; + + + + if (seekpt == 0) + + return; + + merror1(seekpt); + + if (*cp == '\n') + + putnl(), cp++; + + if (inopen && CE) + + vclreol(); + + if (SO && SE) + + putpad(SO); + + printf(mesg(cp), i); + + if (SO && SE) + + putpad(SE); + +} + + + +merror1(seekpt) + +#ifdef VMUNIX + + char *seekpt; + +#else + +# ifdef lint + + char *seekpt; + +# else + + int seekpt; + +# endif + +#endif + +{ + + + +#ifdef VMUNIX + + strcpy(linebuf, seekpt); + +#else + + lseek(erfile, (long) seekpt, 0); + + if (read(erfile, linebuf, 128) < 2) + + CP(linebuf, "ERROR"); + +#endif + +} + + + +morelines() + +{ + + + + if ((int) sbrk(1024 * sizeof (line)) == -1) + + return (-1); + + endcore += 1024; + + return (0); + +} + + + +nonzero() + +{ + + + + if (addr1 == zero) { + + notempty(); + + error("Nonzero address required@on this command"); + + } + +} + + + +notable(i) + + int i; + +{ + + + + return (hush == 0 && !inglobal && i > value(REPORT)); + +} + + + + + +notempty() + +{ + + + + if (dol == zero) + + error("No lines@in the buffer"); + +} + + + + + +netchHAD(cnt) + + int cnt; + +{ + + + + netchange(lineDOL() - cnt); + +} + + + +netchange(i) + + register int i; + +{ + + register char *cp; + + + + if (i > 0) + + notesgn = cp = "more "; + + else + + notesgn = cp = "fewer ", i = -i; + + if (inopen) { + + notecnt = i; + + notenam = ""; + + return; + + } + + if (!notable(i)) + + return; + + printf(mesg("%d %slines@in file after %s"), i, cp, Command); + + putNFL(); + +} + + + +putmark(addr) + + line *addr; + +{ + + + + putmk1(addr, putline()); + +} + + + +putmk1(addr, n) + + register line *addr; + + int n; + +{ + + register line *markp; +++ register oldglobmk; + + +++ oldglobmk = *addr & 1; + + *addr &= ~1; + + for (markp = (anymarks ? names : &names['z'-'a'+1]); + + markp <= &names['z'-'a'+1]; markp++) + + if (*markp == *addr) + + *markp = n; - *addr = n; +++ *addr = n | oldglobmk; + +} + + + +char * + +plural(i) + + long i; + +{ + + + + return (i == 1 ? "" : "s"); + +} + + + +int qcount(); + +short vcntcol; + + + +qcolumn(lim, gp) + + register char *lim, *gp; + +{ + + register int x; + + int (*OO)(); + + + + OO = Outchar; + + Outchar = qcount; + + vcntcol = 0; + + if (lim != NULL) + + x = lim[1], lim[1] = 0; + + pline(0); + + if (lim != NULL) + + lim[1] = x; + + if (gp) + + while (*gp) + + putchar(*gp++); + + Outchar = OO; + + return (vcntcol); + +} + + + +int + +qcount(c) + + int c; + +{ + + + + if (c == '\t') { + + vcntcol += value(TABSTOP) - vcntcol % value(TABSTOP); + + return; + + } + + vcntcol++; + +} + + + +reverse(a1, a2) + + register line *a1, *a2; + +{ + + register line t; + + + + for (;;) { + + t = *--a2; + + if (a2 <= a1) + + return; + + *a2 = *a1; + + *a1++ = t; + + } + +} + + + +save(a1, a2) + + line *a1; + + register line *a2; + +{ + + register int more; + + +++ if (!FIXUNDO) +++ return; +++#ifdef TRACE +++ if (trace) +++ vudump("before save"); +++#endif + + undkind = UNDNONE; + + undadot = dot; + + more = (a2 - a1 + 1) - (unddol - dol); + + while (more > (endcore - truedol)) + + if (morelines() < 0) - error("Out of memory@saving lines for undo - try using ed or re"); +++ error("Out of memory@saving lines for undo - try using ed"); + + if (more) + + (*(more > 0 ? copywR : copyw))(unddol + more + 1, unddol + 1, + + (truedol - unddol)); + + unddol += more; + + truedol += more; + + copyw(dol + 1, a1, a2 - a1 + 1); + + undkind = UNDALL; + + unddel = a1 - 1; + + undap1 = a1; + + undap2 = a2 + 1; +++#ifdef TRACE +++ if (trace) +++ vudump("after save"); +++#endif + +} + + + +save12() + +{ + + + + save(addr1, addr2); + +} + + + +saveall() + +{ + + + + save(one, dol); + +} + + + +span() + +{ + + + + return (addr2 - addr1 + 1); + +} + + + +sync() + +{ + + + + chng = 0; + + tchng = 0; + + xchng = 0; + +} + + + + + +skipwh() + +{ + + register int wh; + + + + wh = 0; + + while (iswhite(peekchar())) { + + wh++; + + ignchar(); + + } + + return (wh); + +} + + + +/*VARARGS2*/ + +smerror(seekpt, cp) + +#ifdef lint + + char *seekpt; + +#else + + int seekpt; + +#endif + + char *cp; + +{ + + + + if (seekpt == 0) + + return; + + merror1(seekpt); + + if (inopen && CE) + + vclreol(); + + if (SO && SE) + + putpad(SO); + + lprintf(mesg(linebuf), cp); + + if (SO && SE) + + putpad(SE); + +} + + + +#define std_nerrs (sizeof std_errlist / sizeof std_errlist[0]) + + + +#define error(i) i + + + +#ifdef lint + +char *std_errlist[] = { + +#else - #ifdef VMUNIX +++# ifdef VMUNIX + +char *std_errlist[] = { - #else +++# else + +short std_errlist[] = { - #endif +++# endif + +#endif + + error("Error 0"), + + error("Not super-user"), + + error("No such file or directory"), + + error("No such process"), + + error("Interrupted system call"), + + error("Physical I/O error"), + + error("No such device or address"), + + error("Argument list too long"), + + error("Exec format error"), + + error("Bad file number"), + + error("No children"), + + error("No more processes"), + + error("Not enough core"), + + error("Permission denied"), + + error("Bad address"), + + error("Block device required"), + + error("Mount device busy"), + + error("File exists"), + + error("Cross-device link"), + + error("No such device"), + + error("Not a directory"), + + error("Is a directory"), + + error("Invalid argument"), + + error("File table overflow"), + + error("Too many open files"), + + error("Not a typewriter"), + + error("Text file busy"), + + error("File too large"), + + error("No space left on device"), + + error("Illegal seek"), + + error("Read-only file system"), + + error("Too many links"), - error("Broken pipe") - #ifndef QUOTA - , error("Math argument") - , error("Result too large") - #else - , error("Quota exceeded") +++ error("Broken pipe"), +++#ifndef V6 +++ error("Math argument"), +++ error("Result too large"), + +#endif +++ error("Quota exceeded") /* Berkeley quota systems only */ + +}; + + + +#undef error + + + +char * + +strend(cp) + + register char *cp; + +{ + + + + while (*cp) + + cp++; + + return (cp); + +} + + + +strcLIN(dp) + + char *dp; + +{ + + + + CP(linebuf, dp); + +} + + + +syserror() + +{ + + register int e = errno; + + + + dirtcnt = 0; + + putchar(' '); +++ edited = 0; /* for temp file errors, for example */ + + if (e >= 0 && errno <= std_nerrs) + + error(std_errlist[e]); + + else + + error("System error %d", e); + +} + + +++/* +++ * Return the column number that results from being in column col and +++ * hitting a tab, where tabs are set every ts columns. Work right for +++ * the case where col > COLUMNS, even if ts does not divide COLUMNS. +++ */ +++tabcol(col, ts) +++int col, ts; +++{ +++ int offset, result; +++ +++ if (col >= COLUMNS) { +++ offset = COLUMNS * (col/COLUMNS); +++ col -= offset; +++ } else +++ offset = 0; +++ result = col + ts - (col % ts) + offset; +++ return (result); +++} +++ + +char * + +vfindcol(i) + + int i; + +{ + + register char *cp; + + register int (*OO)() = Outchar; + + + + Outchar = qcount; + + ignore(qcolumn(linebuf - 1, NOSTR)); + + for (cp = linebuf; *cp && vcntcol < i; cp++) + + putchar(*cp); + + if (cp != linebuf) + + cp--; + + Outchar = OO; + + return (cp); + +} + + + +char * + +vskipwh(cp) + + register char *cp; + +{ + + + + while (iswhite(*cp) && cp[1]) + + cp++; + + return (cp); + +} + + + + + +char * + +vpastwh(cp) + + register char *cp; + +{ + + + + while (iswhite(*cp)) + + cp++; + + return (cp); + +} + + + +whitecnt(cp) + + register char *cp; + +{ + + register int i; + + + + i = 0; + + for (;;) + + switch (*cp++) { + + + + case '\t': + + i += value(TABSTOP) - i % value(TABSTOP); + + break; + + + + case ' ': + + i++; + + break; + + + + default: + + return (i); + + } + +} + + + +#ifdef lint + +Ignore(a) + + char *a; + +{ + + + + a = a; + +} + + + +Ignorf(a) + + int (*a)(); + +{ + + + + a = a; + +} + +#endif + + + +markit(addr) + + line *addr; + +{ + + + + if (addr != dot && addr >= one && addr <= dol) + + markDOT(); + +} + + +++/* +++ * The following code is defensive programming against a bug in the +++ * pdp-11 overlay implementation. Sometimes it goes nuts and asks +++ * for an overlay with some garbage number, which generates an emt +++ * trap. This is a less than elegant solution, but it is somewhat +++ * better than core dumping and losing your work, leaving your tty +++ * in a weird state, etc. +++ */ +++int _ovno; +++onemt() +++{ +++ int oovno; +++ +++ signal(SIGEMT, onemt); +++ oovno = _ovno; +++ /* 2 and 3 are valid on 11/40 type vi, so */ +++ if (_ovno < 0 || _ovno > 3) +++ _ovno = 0; +++ error("emt trap, _ovno is %d @ - try again"); +++} diff --cc usr/src/cmd/ex/ex_temp.c index 0000000000,e8f87804f3,0000000000..c33225dc0e mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_temp.c +++ b/usr/src/cmd/ex/ex_temp.c @@@@ -1,0 -1,568 -1,0 +1,818 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_temp.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_temp.h" + +#include "ex_vis.h" + +#include "ex_tty.h" + + + +/* + + * Editor temporary file routines. + + * Very similar to those of ed, except uses 2 input buffers. + + */ + +#define READ 0 + +#define WRITE 1 + + + +char tfname[40]; + +char rfname[40]; + +int havetmp; + +short tfile = -1; + +short rfile = -1; + + + +fileinit() + +{ + + register char *p; + + register int i, j; + + struct stat stbuf; + + + + if (tline == INCRMT * (HBLKS+2)) + + return; + + cleanup(0); + + close(tfile); + + tline = INCRMT * (HBLKS+2); + + blocks[0] = HBLKS; + + blocks[1] = HBLKS+1; + + blocks[2] = -1; + + dirtcnt = 0; + + iblock = -1; + + iblock2 = -1; + + oblock = -1; + + CP(tfname, svalue(DIRECTORY)); + + if (stat(tfname, &stbuf)) { + +dumbness: + + if (setexit() == 0) + + filioerr(tfname); + + else + + putNFL(); + + cleanup(1); + + exit(1); + + } + + if ((stbuf.st_mode & S_IFMT) != S_IFDIR) { + + errno = ENOTDIR; + + goto dumbness; + + } + + ichanged = 0; + + ichang2 = 0; + + ignore(strcat(tfname, "/ExXXXXX")); + + for (p = strend(tfname), i = 5, j = getpid(); i > 0; i--, j /= 10) + + *--p = j % 10 | '0'; + + tfile = creat(tfname, 0600); + + if (tfile < 0) + + goto dumbness; +++#ifdef VMUNIX +++ { +++ extern stilinc; /* see below */ +++ stilinc = 0; +++ } +++#endif + + havetmp = 1; + + close(tfile); + + tfile = open(tfname, 2); + + if (tfile < 0) + + goto dumbness; + +/* brk((char *)fendcore); */ + +} + + + +cleanup(all) + + bool all; + +{ + + if (all) { + + putpad(TE); + + flush(); + + } + + if (havetmp) + + unlink(tfname); + + havetmp = 0; + + if (all && rfile >= 0) { + + unlink(rfname); + + close(rfile); + + rfile = -1; + + } + +} + + + +getline(tl) + + line tl; + +{ + + register char *bp, *lp; + + register int nl; + + + + lp = linebuf; + + bp = getblock(tl, READ); + + nl = nleft; + + tl &= ~OFFMSK; + + while (*lp++ = *bp++) + + if (--nl == 0) { + + bp = getblock(tl += INCRMT, READ); + + nl = nleft; + + } + +} + + + +putline() + +{ + + register char *bp, *lp; + + register int nl; + + line tl; + + + + dirtcnt++; + + lp = linebuf; + + change(); + + tl = tline; + + bp = getblock(tl, WRITE); + + nl = nleft; + + tl &= ~OFFMSK; + + while (*bp = *lp++) { + + if (*bp++ == '\n') { + + *--bp = 0; + + linebp = lp; + + break; + + } + + if (--nl == 0) { + + bp = getblock(tl += INCRMT, WRITE); + + nl = nleft; + + } + + } + + tl = tline; + + tline += (((lp - linebuf) + BNDRY - 1) >> SHFT) & 077776; + + return (tl); + +} + + + +int read(); + +int write(); + + + +char * + +getblock(atl, iof) + + line atl; + + int iof; + +{ + + register int bno, off; +++ register char *p1, *p2; +++ register int n; + + + + bno = (atl >> OFFBTS) & BLKMSK; + + off = (atl << SHFT) & LBTMSK; + + if (bno >= NMBLKS) + + error(" Tmp file too large"); + + nleft = BUFSIZ - off; + + if (bno == iblock) { + + ichanged |= iof; + + hitin2 = 0; + + return (ibuff + off); + + } + + if (bno == iblock2) { + + ichang2 |= iof; + + hitin2 = 1; + + return (ibuff2 + off); + + } + + if (bno == oblock) + + return (obuff + off); + + if (iof == READ) { + + if (hitin2 == 0) { - if (ichang2) +++ if (ichang2) { +++#ifdef CRYPT +++ if(xtflag) +++ crblock(tperm, ibuff2, CRSIZE, (long)0); +++#endif + + blkio(iblock2, ibuff2, write); +++ } + + ichang2 = 0; + + iblock2 = bno; + + blkio(bno, ibuff2, read); +++#ifdef CRYPT +++ if(xtflag) +++ crblock(tperm, ibuff2, CRSIZE, (long)0); +++#endif + + hitin2 = 1; + + return (ibuff2 + off); + + } + + hitin2 = 0; - if (ichanged) +++ if (ichanged) { +++#ifdef CRYPT +++ if(xtflag) +++ crblock(tperm, ibuff, CRSIZE, (long)0); +++#endif + + blkio(iblock, ibuff, write); +++ } + + ichanged = 0; + + iblock = bno; + + blkio(bno, ibuff, read); +++#ifdef CRYPT +++ if(xtflag) +++ crblock(tperm, ibuff, CRSIZE, (long)0); +++#endif + + return (ibuff + off); + + } - if (oblock >= 0) - blkio(oblock, obuff, write); +++ if (oblock >= 0) { +++#ifdef CRYPT +++ if(xtflag) { +++ /* +++ * Encrypt block before writing, so some devious +++ * person can't look at temp file while editing. +++ */ +++ p1 = obuff; +++ p2 = crbuf; +++ n = CRSIZE; +++ while(n--) +++ *p2++ = *p1++; +++ crblock(tperm, crbuf, CRSIZE, (long)0); +++ blkio(oblock, crbuf, write); +++ } else +++#endif +++ blkio(oblock, obuff, write); +++ } + + oblock = bno; + + return (obuff + off); + +} + + +++#ifdef VMUNIX +++#define INCORB 64 +++char incorb[INCORB+1][BUFSIZ]; +++#define pagrnd(a) ((char *)(((int)a)&~(BUFSIZ-1))) +++int stilinc; /* up to here not written yet */ +++#endif +++ + +blkio(b, buf, iofcn) + + short b; + + char *buf; + + int (*iofcn)(); + +{ + + +++#ifdef VMUNIX +++ if (b < INCORB) { +++ if (iofcn == read) { +++ bcopy(pagrnd(incorb[b+1]), buf, BUFSIZ); +++ return; +++ } +++ bcopy(buf, pagrnd(incorb[b+1]), BUFSIZ); +++ if (laste) { +++ if (b >= stilinc) +++ stilinc = b + 1; +++ return; +++ } +++ } else if (stilinc) +++ tflush(); +++#endif + + lseek(tfile, (long) (unsigned) b * BUFSIZ, 0); + + if ((*iofcn)(tfile, buf, BUFSIZ) != BUFSIZ) + + filioerr(tfname); + +} + + +++#ifdef VMUNIX +++tlaste() +++{ +++ +++ if (stilinc) +++ dirtcnt = 0; +++} +++ +++tflush() +++{ +++ int i = stilinc; +++ +++ stilinc = 0; +++ lseek(tfile, (long) 0, 0); +++ if (write(tfile, pagrnd(incorb[1]), i * BUFSIZ) != (i * BUFSIZ)) +++ filioerr(tfname); +++} +++#endif +++ + +/* + + * Synchronize the state of the temporary file in case + + * a crash occurs. + + */ + +synctmp() + +{ + + register int cnt; + + register line *a; + + register short *bp; + + +++#ifdef VMUNIX +++ if (stilinc) +++ return; +++#endif + + if (dol == zero) + + return; + + if (ichanged) + + blkio(iblock, ibuff, write); + + ichanged = 0; + + if (ichang2) + + blkio(iblock2, ibuff2, write); + + ichang2 = 0; + + if (oblock != -1) + + blkio(oblock, obuff, write); + + time(&H.Time); + + uid = getuid(); + + *zero = (line) H.Time; + + for (a = zero, bp = blocks; a <= dol; a += BUFSIZ / sizeof *a, bp++) { + + if (*bp < 0) { + + tline = (tline + OFFMSK) &~ OFFMSK; + + *bp = ((tline >> OFFBTS) & BLKMSK); +++ if (*bp > NMBLKS) +++ error(" Tmp file too large"); + + tline += INCRMT; + + oblock = *bp + 1; + + bp[1] = -1; + + } + + lseek(tfile, (long) (unsigned) *bp * BUFSIZ, 0); + + cnt = ((dol - a) + 2) * sizeof (line); + + if (cnt > BUFSIZ) + + cnt = BUFSIZ; + + if (write(tfile, (char *) a, cnt) != cnt) { + +oops: + + *zero = 0; + + filioerr(tfname); + + } + + *zero = 0; + + } + + flines = lineDOL(); + + lseek(tfile, 0l, 0); + + if (write(tfile, (char *) &H, sizeof H) != sizeof H) + + goto oops; + +} + + + +TSYNC() + +{ + + + + if (dirtcnt > 12) { +++#ifdef VMUNIX +++ if (stilinc) +++ tflush(); +++#endif + + dirtcnt = 0; + + synctmp(); + + } + +} + + + +/* + + * Named buffer routines. + + * These are implemented differently than the main buffer. + + * Each named buffer has a chain of blocks in the register file. + + * Each block contains roughly 508 chars of text, + + * and a previous and next block number. We also have information + + * about which blocks came from deletes of multiple partial lines, + + * e.g. deleting a sentence or a LISP object. + + * + + * We maintain a free map for the temp file. To free the blocks + + * in a register we must read the blocks to find how they are chained + + * together. + + * + + * BUG: The default savind of deleted lines in numbered + + * buffers may be rather inefficient; it hasn't been profiled. + + */ + +struct strreg { + + short rg_flags; + + short rg_nleft; + + short rg_first; + + short rg_last; + +} strregs[('z'-'a'+1) + ('9'-'0'+1)], *strp; + + + +struct rbuf { + + short rb_prev; + + short rb_next; + + char rb_text[BUFSIZ - 2 * sizeof (short)]; + +} *rbuf; +++#ifdef VMUNIX +++short rused[256]; +++#else + +short rused[32]; +++#endif + +short rnleft; + +short rblock; + +short rnext; + +char *rbufcp; + + + +regio(b, iofcn) + + short b; + + int (*iofcn)(); + +{ + + + + if (rfile == -1) { + + CP(rfname, tfname); + + *(strend(rfname) - 7) = 'R'; + + rfile = creat(rfname, 0600); + + if (rfile < 0) + +oops: + + filioerr(rfname); + + close(rfile); + + rfile = open(rfname, 2); + + if (rfile < 0) + + goto oops; + + } + + lseek(rfile, (long) b * BUFSIZ, 0); + + if ((*iofcn)(rfile, rbuf, BUFSIZ) != BUFSIZ) + + goto oops; + + rblock = b; + +} + + + +REGblk() + +{ + + register int i, j, m; + + + + for (i = 0; i < sizeof rused / sizeof rused[0]; i++) { + + m = (rused[i] ^ 0177777) & 0177777; + + if (i == 0) + + m &= ~1; + + if (m != 0) { + + j = 0; + + while ((m & 1) == 0) + + j++, m >>= 1; + + rused[i] |= (1 << j); + +#ifdef RDEBUG + + printf("allocating block %d\n", i * 16 + j); + +#endif + + return (i * 16 + j); + + } + + } + + error("Out of register space (ugh)"); + + /*NOTREACHED*/ + +} + + + +struct strreg * + +mapreg(c) + + register int c; + +{ + + + + if (isupper(c)) + + c = tolower(c); + + return (isdigit(c) ? &strregs[('z'-'a'+1)+(c-'0')] : &strregs[c-'a']); + +} + + + +int shread(); + + + +KILLreg(c) + + register int c; + +{ + + struct rbuf arbuf; + + register struct strreg *sp; + + + + rbuf = &arbuf; + + sp = mapreg(c); + + rblock = sp->rg_first; + + sp->rg_first = sp->rg_last = 0; + + sp->rg_flags = sp->rg_nleft = 0; + + while (rblock != 0) { + +#ifdef RDEBUG + + printf("freeing block %d\n", rblock); + +#endif + + rused[rblock / 16] &= ~(1 << (rblock % 16)); + + regio(rblock, shread); + + rblock = rbuf->rb_next; + + } + +} + + + +/*VARARGS*/ + +shread() + +{ + + struct front { short a; short b; }; + + + + if (read(rfile, (char *) rbuf, sizeof (struct front)) == sizeof (struct front)) + + return (sizeof (struct rbuf)); + + return (0); + +} + + + +int getREG(); + + + +putreg(c) + + char c; + +{ + + struct rbuf arbuf; + + register line *odot = dot; + + register line *odol = dol; + + register int cnt; + + + + deletenone(); + + appendnone(); + + rbuf = &arbuf; + + rnleft = 0; + + rblock = 0; + + rnext = mapreg(c)->rg_first; + + if (rnext == 0) { + + if (inopen) { + + splitw++; + + vclean(); + + vgoto(WECHO, 0); + + } + + vreg = -1; + + error("Nothing in register %c", c); + + } + + if (inopen && partreg(c)) { +++ if (!FIXUNDO) { +++ splitw++; vclean(); vgoto(WECHO, 0); vreg = -1; +++ error("Can't put partial line inside macro"); +++ } + + squish(); + + addr1 = addr2 = dol; + + } - ignore(append(getREG, addr2)); +++ cnt = append(getREG, addr2); + + if (inopen && partreg(c)) { + + unddol = dol; + + dol = odol; + + dot = odot; + + pragged(0); + + } - cnt = undap2 - undap1; + + killcnt(cnt); + + notecnt = cnt; + +} + + + +partreg(c) + + char c; + +{ + + + + return (mapreg(c)->rg_flags); + +} + + + +notpart(c) + + register int c; + +{ + + + + if (c) + + mapreg(c)->rg_flags = 0; + +} + + + +getREG() + +{ + + register char *lp = linebuf; + + register int c; + + + + for (;;) { + + if (rnleft == 0) { + + if (rnext == 0) + + return (EOF); + + regio(rnext, read); + + rnext = rbuf->rb_next; + + rbufcp = rbuf->rb_text; + + rnleft = sizeof rbuf->rb_text; + + } + + c = *rbufcp; + + if (c == 0) + + return (EOF); + + rbufcp++, --rnleft; + + if (c == '\n') { + + *lp++ = 0; + + return (0); + + } + + *lp++ = c; + + } + +} + + + +YANKreg(c) + + register int c; + +{ + + struct rbuf arbuf; + + register line *addr; + + register struct strreg *sp; +++ char savelb[LBSIZE]; + + + + if (isdigit(c)) + + kshift(); + + if (islower(c)) + + KILLreg(c); + + strp = sp = mapreg(c); + + sp->rg_flags = inopen && cursor && wcursor; + + rbuf = &arbuf; + + if (sp->rg_last) { + + regio(sp->rg_last, read); + + rnleft = sp->rg_nleft; + + rbufcp = &rbuf->rb_text[sizeof rbuf->rb_text - rnleft]; + + } else { + + rblock = 0; + + rnleft = 0; + + } +++ CP(savelb,linebuf); + + for (addr = addr1; addr <= addr2; addr++) { + + getline(*addr); + + if (sp->rg_flags) { + + if (addr == addr2) + + *wcursor = 0; + + if (addr == addr1) + + strcpy(linebuf, cursor); + + } + + YANKline(); + + } + + rbflush(); + + killed(); +++ CP(linebuf,savelb); + +} + + + +kshift() + +{ + + register int i; + + + + KILLreg('9'); + + for (i = '8'; i >= '0'; i--) + + copy(mapreg(i+1), mapreg(i), sizeof (struct strreg)); + +} + + + +YANKline() + +{ + + register char *lp = linebuf; + + register struct rbuf *rp = rbuf; + + register int c; + + + + do { + + c = *lp++; + + if (c == 0) + + c = '\n'; + + if (rnleft == 0) { + + rp->rb_next = REGblk(); + + rbflush(); + + rblock = rp->rb_next; + + rp->rb_next = 0; + + rp->rb_prev = rblock; + + rnleft = sizeof rp->rb_text; + + rbufcp = rp->rb_text; + + } + + *rbufcp++ = c; + + --rnleft; + + } while (c != '\n'); + + if (rnleft) + + *rbufcp = 0; + +} + + + +rbflush() + +{ + + register struct strreg *sp = strp; + + + + if (rblock == 0) + + return; + + regio(rblock, write); + + if (sp->rg_first == 0) + + sp->rg_first = rblock; + + sp->rg_last = rblock; + + sp->rg_nleft = rnleft; + +} + + + +/* Register c to char buffer buf of size buflen */ + +regbuf(c, buf, buflen) + +char c; + +char *buf; + +int buflen; + +{ + + struct rbuf arbuf; + + register char *p, *lp; + + + + rbuf = &arbuf; + + rnleft = 0; + + rblock = 0; + + rnext = mapreg(c)->rg_first; + + if (rnext==0) { + + *buf = 0; + + error("Nothing in register %c",c); + + } + + p = buf; + + while (getREG()==0) { + + for (lp=linebuf; *lp;) { + + if (p >= &buf[buflen]) + + error("Register too long@to fit in memory"); + + *p++ = *lp++; + + } + + *p++ = '\n'; + + } + + if (partreg(c)) p--; + + *p = '\0'; + + getDOT(); + +} +++ +++/* +++ * Encryption routines. These are essentially unmodified from ed. +++ */ +++ +++#ifdef CRYPT +++/* +++ * crblock: encrypt/decrypt a block of text. +++ * buf is the buffer through which the text is both input and +++ * output. nchar is the size of the buffer. permp is a work +++ * buffer, and startn is the beginning of a sequence. +++ */ +++crblock(permp, buf, nchar, startn) +++char *permp; +++char *buf; +++int nchar; +++long startn; +++{ +++ register char *p1; +++ int n1; +++ int n2; +++ register char *t1, *t2, *t3; +++ +++ t1 = permp; +++ t2 = &permp[256]; +++ t3 = &permp[512]; +++ +++ n1 = startn&0377; +++ n2 = (startn>>8)&0377; +++ p1 = buf; +++ while(nchar--) { +++ *p1 = t2[(t3[(t1[(*p1+n1)&0377]+n2)&0377]-n2)&0377]-n1; +++ n1++; +++ if(n1==256){ +++ n1 = 0; +++ n2++; +++ if(n2==256) n2 = 0; +++ } +++ p1++; +++ } +++} +++ +++/* +++ * makekey: initialize buffers based on user key a. +++ */ +++makekey(a, b) +++char *a, *b; +++{ +++ register int i; +++ long t; +++ char temp[KSIZE + 1]; +++ +++ for(i = 0; i < KSIZE; i++) +++ temp[i] = *a++; +++ time(&t); +++ t += getpid(); +++ for(i = 0; i < 4; i++) +++ temp[i] ^= (t>>(8*i))&0377; +++ crinit(temp, b); +++} +++ +++/* +++ * crinit: besides initializing the encryption machine, this routine +++ * returns 0 if the key is null, and 1 if it is non-null. +++ */ +++crinit(keyp, permp) +++char *keyp, *permp; +++{ +++ register char *t1, *t2, *t3; +++ register i; +++ int ic, k, temp; +++ unsigned random; +++ char buf[13]; +++ long seed; +++ +++ t1 = permp; +++ t2 = &permp[256]; +++ t3 = &permp[512]; +++ if(*keyp == 0) +++ return(0); +++ strncpy(buf, keyp, 8); +++ while (*keyp) +++ *keyp++ = '\0'; +++ +++ buf[8] = buf[0]; +++ buf[9] = buf[1]; +++ domakekey(buf); +++ +++ seed = 123; +++ for (i=0; i<13; i++) +++ seed = seed*buf[i] + i; +++ for(i=0;i<256;i++){ +++ t1[i] = i; +++ t3[i] = 0; +++ } +++ for(i=0; i<256; i++) { +++ seed = 5*seed + buf[i%13]; +++ random = seed % 65521; +++ k = 256-1 - i; +++ ic = (random&0377) % (k+1); +++ random >>= 8; +++ temp = t1[k]; +++ t1[k] = t1[ic]; +++ t1[ic] = temp; +++ if(t3[k]!=0) continue; +++ ic = (random&0377) % k; +++ while(t3[ic]!=0) ic = (ic+1) % k; +++ t3[k] = ic; +++ t3[ic] = k; +++ } +++ for(i=0; i<256; i++) +++ t2[t1[i]&0377] = i; +++ return(1); +++} +++ +++/* +++ * domakekey: the following is the major nonportable part of the encryption +++ * mechanism. A 10 character key is supplied in buffer. +++ * This string is fed to makekey (an external program) which +++ * responds with a 13 character result. This result is placed +++ * in buffer. +++ */ +++domakekey(buffer) +++char *buffer; +++{ +++ int pf[2]; +++ +++ if (pipe(pf)<0) +++ pf[0] = pf[1] = -1; +++ if (fork()==0) { +++ close(0); +++ close(1); +++ dup(pf[0]); +++ dup(pf[1]); +++ execl("/usr/lib/makekey", "-", 0); +++ execl("/lib/makekey", "-", 0); +++ exit(1); +++ } +++ write(pf[1], buffer, 10); +++ if (wait((int *)NULL)==-1 || read(pf[0], buffer, 13)!=13) +++ error("crypt: cannot generate key"); +++ close(pf[0]); +++ close(pf[1]); +++ /* end of nonportable part */ +++} +++#endif diff --cc usr/src/cmd/ex/ex_temp.h index 0000000000,7d4c751807,0000000000..bbdcc48de9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_temp.h +++ b/usr/src/cmd/ex/ex_temp.h @@@@ -1,0 -1,114 -1,0 +1,115 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* sccs id: @(#)ex_temp.h 6.1 10/18/80 */ + +/* + + * The editor uses a temporary file for files being edited, in a structure + + * similar to that of ed. The first block of the file is used for a header + + * block which guides recovery after editor/system crashes. + + * Lines are represented in core by a pointer into the temporary file which + + * is packed into 16 bits (32 on VMUNIX). All but the low bit index the temp + + * file; the last is used by global commands. The parameters below control + + * how much the other bits are shifted left before they index the temp file. + + * Larger shifts give more slop in the temp file but allow larger files + + * to be edited. + + * + + * The editor does not garbage collect the temporary file. When a new + + * file is edited, the temporary file is rather discarded and a new one + + * created for the new file. Garbage collection would be rather complicated + + * in ex because of the general undo, and in any case would require more + + * work when throwing lines away because marks would have be carefully + + * checked before reallocating temporary file space. Said another way, + + * each time you create a new line in the temporary file you get a unique + + * number back, and this is a property used by marks. + + * + + * The following temp file parameters allow 256k bytes in the temporary + + * file. By changing to the numbers in comments you can get 512k. + + * For VMUNIX you get more than you could ever want. + + * VMUNIX uses long (32 bit) integers giving much more + + * space in the temp file and no waste. This doubles core + + * requirements but allows files of essentially unlimited size to be edited. + + */ + +#ifndef VMUNIX + +#define BLKMSK 0777 /* 01777 */ + +#define BNDRY 8 /* 16 */ + +#define INCRMT 0200 /* 0100 */ + +#define LBTMSK 0770 /* 0760 */ + +#define NMBLKS 506 /* 1018 */ + +#define OFFBTS 7 /* 6 */ + +#define OFFMSK 0177 /* 077 */ + +#define SHFT 2 /* 3 */ + +#else + +#define BLKMSK 077777 + +#define BNDRY 2 + +#define INCRMT 02000 + +#define LBTMSK 01776 + +#define NMBLKS 077770 + +#define OFFBTS 10 + +#define OFFMSK 01777 + +#define SHFT 0 + +#endif + + + +/* + + * The editor uses three buffers into the temporary file (ed uses two + + * and is very similar). These are two read buffers and one write buffer. + + * Basically, the editor deals with the file as a sequence of BUFSIZ character + + * blocks. Each block contains some number of lines (and lines + + * can run across block boundaries. + + * + + * New lines are written into the last block in the temporary file + + * which is in core as obuf. When a line is needed which isn't in obuf, + + * then it is brought into an input buffer. As there are two, the choice + + * is to take the buffer into which the last read (of the two) didn't go. + + * Thus this is a 2 buffer LRU replacement strategy. Measurement + + * shows that this saves roughly 25% of the buffer reads over a one + + * input buffer strategy. Since the editor (on our VAX over 1 week) + + * spends (spent) roughly 30% of its time in the system read routine, + + * this can be a big help. + + */ + +bool hitin2; /* Last read hit was ibuff2 not ibuff */ + +bool ichang2; /* Have actually changed ibuff2 */ + +bool ichanged; /* Have actually changed ibuff */ + +short iblock; /* Temp file block number of ibuff (or -1) */ + +short iblock2; /* Temp file block number of ibuff2 (or -1) */ + +short ninbuf; /* Number useful chars left in input buffer */ + +short nleft; /* Number usable chars left in output buffer */ + +short oblock; /* Temp file block number of obuff (or -1) */ + +#ifndef VMUNIX + +short tline; /* Current temp file ptr */ + +#else + +int tline; + +#endif + + + +char ibuff[BUFSIZ]; + +char ibuff2[BUFSIZ]; + +char obuff[BUFSIZ]; + + + +/* + + * Structure of the descriptor block which resides + + * in the first block of the temporary file and is + + * the guiding light for crash recovery. + + * + + * As the Blocks field below implies, there are temporary file blocks + + * devoted to (some) image of the incore array of pointers into the temp + + * file. Thus, to recover from a crash we use these indices to get the + + * line pointers back, and then use the line pointers to get the text back. + + * Except for possible lost lines due to sandbagged I/O, the entire + + * file (at the time of the last editor "sync") can be recovered from + + * the temp file. + + */ + + + +/* This definition also appears in expreserve.c... beware */ + +struct header { + + time_t Time; /* Time temp file last updated */ + + short Uid; + +#ifndef VMUNIX + + short Flines; /* Number of lines in file */ + +#else + + int Flines; + +#endif + + char Savedfile[FNSIZE]; /* The current file name */ + + short Blocks[LBLKS]; /* Blocks where line pointers stashed */ + +} H; + + + +#define uid H.Uid + +#define flines H.Flines + +#define savedfile H.Savedfile + +#define blocks H.Blocks diff --cc usr/src/cmd/ex/ex_tty.c index 0000000000,62763af561,0000000000..c5316b7990 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_tty.c +++ b/usr/src/cmd/ex/ex_tty.c @@@@ -1,0 -1,153 -1,0 +1,221 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_tty.c 6.2 10/30/80"; + +#include "ex.h" + +#include "ex_tty.h" + + + +/* + + * Terminal type initialization routines, + + * and calculation of flags at entry or after + + * a shell escape which may change them. + + */ + +short ospeed = -1; + + + +gettmode() + +{ + + +++#ifndef USG3TTY + + if (gtty(1, &tty) < 0) + + return; + + if (ospeed != tty.sg_ospeed) + + value(SLOWOPEN) = tty.sg_ospeed < B1200; + + ospeed = tty.sg_ospeed; + + normf = tty.sg_flags; + + UPPERCASE = (tty.sg_flags & LCASE) != 0; + + GT = (tty.sg_flags & XTABS) != XTABS && !XT; + + NONL = (tty.sg_flags & CRMOD) == 0; +++#else +++ if (ioctl(1, TCGETA, &tty) < 0) +++ return; +++ if (ospeed != tty.c_cflag & CBAUD) +++ value(SLOWOPEN) = (tty.c_cflag & CBAUD) < B1200; +++ ospeed = tty.c_cflag & CBAUD; +++ normf = tty; +++ UPPERCASE = (tty.c_iflag & IUCLC) != 0; +++ GT = (tty.c_oflag & TABDLY) != TAB3 && !XT; +++ NONL = (tty.c_oflag & OCRNL) == 0; +++#endif + +} + + + +char *xPC; + +char **sstrs[] = { - &AL, &BC, &BT, &CD, &CE, &CL, &CM, &DC, &DL, &DM, &DO, &ED, &EI, +++ &AL, &BC, &BT, &CD, &CE, &CL, &CM, &xCR, &DC, &DL, &DM, &DO, &ED, &EI, + + &F0, &F1, &F2, &F3, &F4, &F5, &F6, &F7, &F8, &F9, + + &HO, &IC, &IM, &IP, &KD, &KE, &KH, &KL, &KR, &KS, &KU, &LL, - &ND, &xPC, &SE, &SF, &SO, &SR, &TA, &TE, &TI, &UP, &VB, &VS, &VE +++ &ND, &xNL, &xPC, &SE, &SF, &SO, &SR, &TA, &TE, &TI, &UP, &VB, &VS, &VE + +}; + +bool *sflags[] = { - &AM, &BS, &DA, &DB, &EO, &HC, &HZ, &IN, &MI, &NC, &OS, &UL, &XN, &XT +++ &AM, &BS, &DA, &DB, &EO, &HC, &HZ, &IN, &MI, &NC, &NS, &OS, &UL, +++ &XB, &XN, &XT, &XX + +}; + +char **fkeys[10] = { + + &F0, &F1, &F2, &F3, &F4, &F5, &F6, &F7, &F8, &F9 + +}; + +setterm(type) + + char *type; + +{ - char *cgoto(); +++ char *tgoto(); + + register int unknown, i; + + register int l; + + char ltcbuf[TCBUFSIZE]; + + + + if (type[0] == 0) + + type = "xx"; + + unknown = 0; + + putpad(TE); + + if (tgetent(ltcbuf, type) != 1) { + + unknown++; - CP(genbuf, "xx|dumb:"); +++ CP(ltcbuf, "xx|dumb:"); + + } + + i = LINES = tgetnum("li"); + + if (LINES <= 5) + + LINES = 24; - if (LINES > 48) - LINES = 48; +++ if (LINES > TUBELINES) +++ LINES = TUBELINES; + + l = LINES; + + if (ospeed < B1200) - l /= 2; +++ l = 9; /* including the message line at the bottom */ + + else if (ospeed < B2400) - l = (l * 2) / 3; +++ l = 17; +++ if (l > LINES) +++ l = LINES; + + aoftspace = tspace; + + zap(); + + /* + + * Initialize keypad arrow keys. + + */ + + arrows[0].cap = KU; arrows[0].mapto = "k"; arrows[0].descr = "up"; + + arrows[1].cap = KD; arrows[1].mapto = "j"; arrows[1].descr = "down"; + + arrows[2].cap = KL; arrows[2].mapto = "h"; arrows[2].descr = "left"; + + arrows[3].cap = KR; arrows[3].mapto = "l"; arrows[3].descr = "right"; + + arrows[4].cap = KH; arrows[4].mapto = "H"; arrows[4].descr = "home"; + + +++#ifdef TIOCLGET +++ /* +++ * Now map users susp char to ^Z, being careful that the susp +++ * overrides any arrow key, but only for hackers (=new tty driver). +++ */ +++ { +++ static char sc[2]; +++ int i, fnd; +++ +++ ioctl(0, TIOCGETD, &ldisc); +++ if (ldisc == NTTYDISC) { +++ sc[0] = olttyc.t_suspc; +++ sc[1] = 0; +++ if (olttyc.t_suspc == CTRL(z)) { +++ for (i=0; i<=4; i++) +++ if (arrows[i].cap[0] == CTRL(z)) +++ addmac(sc, NULL, NULL, arrows); +++ } else +++ addmac(sc, "\32", "susp", arrows); +++ } +++ } +++#endif +++ + + options[WINDOW].ovalue = options[WINDOW].odefault = l - 1; + + if (defwind) options[WINDOW].ovalue = defwind; + + options[SCROLL].ovalue = options[SCROLL].odefault = HC ? 11 : ((l-1) / 2); + + COLUMNS = tgetnum("co"); - if (COLUMNS <= 20) +++ if (COLUMNS <= 4) + + COLUMNS = 1000; - if (cgoto()[0] == 'O') /* OOPS */ +++ if (tgoto(CM, 2, 2)[0] == 'O') /* OOPS */ + + CA = 0, CM = 0; + + else - CA = 1, costCM = strlen(tgoto(CM, 8, 10)); +++ CA = 1, costCM = cost(tgoto(CM, 8, 10)); +++ costSR = cost(SR); +++ costAL = cost(AL); + + PC = xPC ? xPC[0] : 0; + + aoftspace = tspace; - CP(ttytype, longname(genbuf, type)); +++ CP(ttytype, longname(ltcbuf, type)); + + if (i <= 0) + + LINES = 2; + + /* proper strings to change tty type */ - #ifdef notdef - /* Taken out because we don't allow it. See ex_set.c for reasons. */ - if (inopen) - putpad(VE); - #endif + + termreset(); + + gettmode(); + + value(REDRAW) = AL && DL; + + value(OPTIMIZE) = !CA && !GT; +++ if (ospeed == B1200 && !value(REDRAW)) +++ value(SLOWOPEN) = 1; /* see also gettmode above */ + + if (unknown) + + serror("%s: Unknown terminal type", type); + +} + + + +zap() + +{ + + register char *namp; + + register bool **fp; + + register char ***sp; + + - namp = "ambsdadbeohchzinmincosulxnxt"; +++ namp = "ambsdadbeohchzinmincnsosulxbxnxtxx"; + + fp = sflags; + + do { + + *(*fp++) = tgetflag(namp); + + namp += 2; + + } while (*namp); - namp = "albcbtcdceclcmdcdldmdoedeik0k1k2k3k4k5k6k7k8k9hoicimipkdkekhklkrkskullndpcsesfsosrtatetiupvbvsve"; +++ namp = "albcbtcdceclcmcrdcdldmdoedeik0k1k2k3k4k5k6k7k8k9hoicimipkdkekhklkrkskullndnlpcsesfsosrtatetiupvbvsve"; + + sp = sstrs; + + do { + + *(*sp++) = tgetstr(namp, &aoftspace); + + namp += 2; + + } while (*namp); + +} + + + +char * + +longname(bp, def) + + register char *bp; + + char *def; + +{ + + register char *cp; + + + + while (*bp && *bp != ':' && *bp != '|') + + bp++; + + if (*bp == '|') { + + bp++; + + cp = bp; + + while (*cp && *cp != ':' && *cp != '|') + + cp++; + + *cp = 0; + + return (bp); + + } + + return (def); + +} + + + +char * + +fkey(i) + + int i; + +{ + + if (0 <= i && i <= 9) + + return(*fkeys[i]); + + else + + return(NOSTR); + +} +++ +++/* +++ * cost figures out how much (in characters) it costs to send the string +++ * str to the terminal. It takes into account padding information, as +++ * much as it can, for a typical case. (Right now the typical case assumes +++ * the number of lines affected is the size of the screen, since this is +++ * mainly used to decide if AL or SR is better, and this always happens +++ * at the top of the screen. We assume cursor motion (CM) has little +++ * padding, if any, required, so that case, which is really more important +++ * than AL vs SR, won't be really affected.) +++ */ +++static int costnum; +++cost(str) +++char *str; +++{ +++ int countnum(); +++ +++ if (str == NULL) +++ return 10000; /* infinity */ +++ costnum = 0; +++ tputs(str, LINES, countnum); +++ return costnum; +++} +++ +++/* ARGSUSED */ +++countnum(ch) +++char ch; +++{ +++ costnum++; +++} diff --cc usr/src/cmd/ex/ex_tty.h index 0000000000,0dc41fd0be,0000000000..d2d06fb7e3 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_tty.h +++ b/usr/src/cmd/ex/ex_tty.h @@@@ -1,0 -1,126 -1,0 +1,176 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* sccs id: @(#)ex_tty.h 6.1 10/18/80 */ + +/* + + * Capabilities from termcap + + * + + * The description of terminals is a difficult business, and we only + + * attempt to summarize the capabilities here; for a full description + + * see the paper describing termcap. + + * + + * Capabilities from termcap are of three kinds - string valued options, + + * numeric valued options, and boolean options. The string valued options + + * are the most complicated, since they may include padding information, + + * which we describe now. + + * + + * Intelligent terminals often require padding on intelligent operations + + * at high (and sometimes even low) speed. This is specified by + + * a number before the string in the capability, and has meaning for the + + * capabilities which have a P at the front of their comment. + + * This normally is a number of milliseconds to pad the operation. + + * In the current system which has no true programmible delays, we + + * do this by sending a sequence of pad characters (normally nulls, but + + * specifiable as "pc"). In some cases, the pad is better computed + + * as some number of milliseconds times the number of affected lines + + * (to bottom of screen usually, except when terminals have insert modes + + * which will shift several lines.) This is specified as '12*' e.g. + + * before the capability to say 12 milliseconds per affected whatever + + * (currently always line). Capabilities where this makes sense say P*. + + */ + +char tspace[256]; /* Space for capability strings */ + +char *aoftspace; /* Address of tspace for relocation */ + + + +char *AL; /* P* Add new blank line */ + +char *BC; /* Back cursor */ + +char *BT; /* P Back tab */ + +char *CD; /* P* Clear to end of display */ + +char *CE; /* P Clear to end of line */ + +char *CL; /* P* Clear screen */ + +char *CM; /* P Cursor motion */ +++char *xCR; /* P Carriage return */ + +char *DC; /* P* Delete character */ + +char *DL; /* P* Delete line sequence */ + +char *DM; /* Delete mode (enter) */ + +char *DO; /* Down line sequence */ + +char *ED; /* End delete mode */ + +char *EI; /* End insert mode */ + +char *F0,*F1,*F2,*F3,*F4,*F5,*F6,*F7,*F8,*F9; + + /* Strings sent by various function keys */ + +char *HO; /* Home cursor */ + +char *IC; /* P Insert character */ + +char *IM; /* Insert mode (give as ':im=:' if 'ic' */ + +char *IP; /* P* Insert pad after char ins'd using IM+IE */ + +char *KD; /* Keypad down arrow */ + +char *KE; /* Keypad don't xmit */ + +char *KH; /* Keypad home key */ + +char *KL; /* Keypad left arrow */ + +char *KR; /* Keypad right arrow */ + +char *KS; /* Keypad start xmitting */ + +char *KU; /* Keypad up arrow */ + +char *LL; /* Quick to last line, column 0 */ + +char *ND; /* Non-destructive space */ +++char *xNL; /* Line feed (new line) */ + +char PC; /* Pad character */ + +char *SE; /* Standout end (may leave space) */ + +char *SF; /* P Scroll forwards */ + +char *SO; /* Stand out begin (may leave space) */ + +char *SR; /* P Scroll backwards */ + +char *TA; /* P Tab (other than ^I or with padding) */ + +char *TE; /* Terminal end sequence */ + +char *TI; /* Terminal initial sequence */ + +char *UP; /* Upline */ + +char *VB; /* Visible bell */ + +char *VE; /* Visual end sequence */ + +char *VS; /* Visual start sequence */ + +bool AM; /* Automatic margins */ + +bool BS; /* Backspace works */ + +bool CA; /* Cursor addressible */ + +bool DA; /* Display may be retained above */ + +bool DB; /* Display may be retained below */ + +bool EO; /* Can erase overstrikes with ' ' */ + +bool GT; /* Gtty indicates tabs */ + +bool HC; /* Hard copy terminal */ + +bool HZ; /* Hazeltine ~ braindamage */ + +bool IN; /* Insert-null blessing */ + +bool MI; /* can move in insert mode */ + +bool NC; /* No Cr - \r snds \r\n then eats \n (dm2500) */ +++bool NS; /* No scroll - linefeed at bottom won't scroll */ + +bool OS; /* Overstrike works */ + +bool UL; /* Underlining works even though !os */ +++bool XB; /* Beehive (no escape key, simulate with f1) */ + +bool XN; /* A newline gets eaten after wrap (concept) */ + +bool XT; /* Tabs are destructive */ +++bool XX; /* Tektronix 4025 insert line */ + + /* X? is reserved for severely nauseous glitches */ + + /* If there are enough of these we may need bit masks! */ + + + +/* + + * From the tty modes... + + */ + +bool NONL; /* Terminal can't hack linefeeds doing a CR */ + +bool UPPERCASE; /* Ick! */ + +short LINES; /* Number of lines on screen */ + +short COLUMNS; + +short OCOLUMNS; /* Save COLUMNS for a hack in open mode */ + + + +short outcol; /* Where the cursor is */ + +short outline; + + + +short destcol; /* Where the cursor should be */ + +short destline; + + - #ifdef TIOCSETC - struct tchars ottyc, nttyc; /* For V7 character masking */ +++/* +++ * There are several kinds of tty drivers to contend with. These include: +++ * (1) V6: no CBREAK, no ioctl. (Include PWB V1 here). +++ * (2) V7 research: has CBREAK, has ioctl, and has the tchars (TIOCSETC) +++ * business to change start, stop, etc. chars. +++ * (3) USG V2: Basically like V6 but RAW mode is like V7 RAW. +++ * (We treat it as V6.) +++ * (4) USG V3: equivalent to V7 but totally incompatible. +++ * (5) Berkeley: has ltchars in addition to all of V7. +++ * +++ * The following attempts to decide what we are on, and declare +++ * some variables in the appropriate format. The wierd looking one (ttymode) +++ * is the thing we pass to sTTY and family to turn "RAW" mode on or off +++ * when we go into or out of visual mode. In V7/V6 it's just the flags word +++ * to stty. In USG V3 it's the whole tty structure. +++ */ +++#ifdef USG3TTY /* USG V3 */ +++ struct termio tty; /* Use this one structure to change modes */ +++ typedef struct termio ttymode; /* Mode to contain tty flags */ +++ +++#else /* All others */ +++ struct sgttyb tty; /* Always stty/gtty using this one structure */ +++ typedef int ttymode; /* Mode to contain tty flags */ +++# ifdef TIOCSETC /* V7 */ +++ struct tchars ottyc, nttyc; /* For V7 character masking */ +++# endif +++# ifdef TIOCLGET /* Berkeley */ +++ struct ltchars olttyc, nlttyc; /* More of tchars style stuff */ +++# endif +++ + +#endif - struct sgttyb tty; /* Always stty/gtty using this one structure */ - bool normtty; /* Have to restor normal mode from normf */ - int normf; /* Restore tty flags to this (someday) */ +++ +++ttymode normf; /* Restore tty flags to this (someday) */ +++bool normtty; /* Have to restore normal mode from normf */ +++ +++ttymode ostart(), setty(), unixex(); + + + +short WBOT; + +short WECHO; + + - short costCM; +++short costCM; /* # chars to output a typical CM, with padding etc. */ +++short costSR; /* likewise */ +++short costAL; + + - #define MAXNOMACS 32 /* max number of macros */ - #define MAXCHARMACS 512 /* max # of chars total in macros */ +++#ifdef VMUNIX +++# define MAXNOMACS 128 /* max number of macros of each kind */ +++# define MAXCHARMACS 2048 /* max # of chars total in macros */ +++#else +++# define MAXNOMACS 32 /* max number of macros of each kind */ +++# define MAXCHARMACS 512 /* max # of chars total in macros */ +++#endif + +struct maps { + + char *cap; /* pressing button that sends this.. */ + + char *mapto; /* .. maps to this string */ + + char *descr; /* legible description of key */ + +}; + +struct maps arrows[MAXNOMACS]; /* macro defs - 1st 5 built in */ +++struct maps immacs[MAXNOMACS]; /* for while in insert mode */ +++struct maps abbrevs[MAXNOMACS]; /* for word abbreviations */ +++int ldisc; /* line discipline for ucb tty driver */ + +char mapspace[MAXCHARMACS]; + +char *msnext; /* next free location in mapspace */ +++int maphopcnt; /* check for infinite mapping loops */ +++bool anyabbrs; /* true if abbr or unabbr has been done */ +++char ttynbuf[20]; /* result of ttyname() */ +++int ttymesg; /* original mode of users tty */ diff --cc usr/src/cmd/ex/ex_tune.h index 0000000000,192e9b8fe7,0000000000..4a7e8ed16d mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_tune.h +++ b/usr/src/cmd/ex/ex_tune.h @@@@ -1,0 -1,111 -1,0 +1,113 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* sccs id: @(#)ex_tune.h 6.2 10/30/80 */ + +/* + + * Definitions of editor parameters and limits + + */ + + + +/* + + * Pathnames. + + * + + * Only exstrings is looked at "+4", i.e. if you give + + * "/usr/lib/..." here, "/lib" will be tried only for strings. + + */ + +#include "local/uparm.h" - #define EXRECOVER libpath(ex3.2recover) - #define EXPRESERVE libpath(ex3.2preserve) +++#define EXRECOVER libpath(ex3.6recover) +++#define EXPRESERVE libpath(ex3.6preserve) + +#ifndef VMUNIX - #define EXSTRINGS libpath(ex3.2strings) +++#define EXSTRINGS libpath(ex3.6strings) + +#endif - #define MASTERTAGS libpath(tags) + + + +/* + + * If your system believes that tabs expand to a width other than + + * 8 then your makefile should cc with -DTABS=whatever, otherwise we use 8. + + */ + +#ifndef TABS + +#define TABS 8 + +#endif + + + +/* + + * Maximums + + * + + * The definition of LBSIZE should be the same as BUFSIZ (512 usually). + + * Most other definitions are quite generous. + + */ + +/* FNSIZE is also defined in expreserve.c */ + +#define FNSIZE 128 /* File name size */ + +#ifdef VMUNIX + +#define LBSIZE 1024 + +#define ESIZE 512 +++#define CRSIZE 1024 + +#else + +#define LBSIZE 512 /* Line length */ + +#define ESIZE 128 /* Size of compiled re */ +++#define CRSIZE 512 + +#endif + +#define RHSSIZE 256 /* Size of rhs of substitute */ + +#define NBRA 9 /* Number of re \( \) pairs */ + +#define TAGSIZE 32 /* Tag length */ - #define ONMSZ 32 /* Option name size */ +++#define ONMSZ 64 /* Option name size */ + +#define GBSIZE 256 /* Buffer size */ + +#define UXBSIZE 128 /* Unix command buffer size */ + +#define VBSIZE 128 /* Partial line max size in visual */ + +/* LBLKS is also defined in expreserve.c */ + +#ifndef VMUNIX + +#define LBLKS 125 /* Line pointer blocks in temp file */ + +#define HBLKS 1 /* struct header fits in BUFSIZ*HBLKS */ + +#else + +#define LBLKS 900 + +#define HBLKS 2 + +#endif + +#define MAXDIRT 12 /* Max dirtcnt before sync tfile */ + +#define TCBUFSIZE 1024 /* Max entry size in termcap, see + + also termlib and termcap */ + + + +/* + + * Except on VMUNIX, these are a ridiculously small due to the + + * lousy arglist processing implementation which fixes core + + * proportional to them. Argv (and hence NARGS) is really unnecessary, + + * and argument character space not needed except when + + * arguments exist. Argument lists should be saved before the "zero" + + * of the incore line information and could then + + * be reasonably large. + + */ + +#ifndef VMUNIX + +#define NARGS 100 /* Maximum number of names in "next" */ + +#define NCARGS LBSIZE /* Maximum arglist chars in "next" */ + +#else + +#define NCARGS 5120 + +#define NARGS (NCARGS/6) + +#endif + + + +/* + + * Note: because the routine "alloca" is not portable, TUBESIZE + + * bytes are allocated on the stack each time you go into visual + + * and then never freed by the system. Thus if you have no terminals + + * which are larger than 24 * 80 you may well want to make TUBESIZE + + * smaller. TUBECOLS should stay at 160 since this defines the maximum + + * length of opening on hardcopies and allows two lines of open on + + * terminals like adm3's (glass tty's) where it switches to pseudo + + * hardcopy mode when a line gets longer than 80 characters. + + */ + +#ifndef VMUNIX - #define TUBELINES 40 /* Number of screen lines for visual */ +++#define TUBELINES 60 /* Number of screen lines for visual */ + +#define TUBECOLS 160 /* Number of screen columns for visual */ - #define TUBESIZE 3400 /* Maximum screen size for visual */ +++#define TUBESIZE 5000 /* Maximum screen size for visual */ + +#else + +#define TUBELINES 66 + +#define TUBECOLS 160 + +#define TUBESIZE 6600 /* 66 * 100 */ + +#endif + + + +/* + + * Output column (and line) are set to this value on cursor addressible + + * terminals when we lose track of the cursor to force cursor + + * addressing to occur. + + */ + +#define UKCOL -20 /* Prototype unknown column */ + + + +/* + + * Attention is the interrupt character (normally 0177 -- delete). + + * Quit is the quit signal (normally FS -- control-\) and quits open/visual. + + */ - #define ATTN 0177 +++#define ATTN (-2) + +#define QUIT ('\\' & 037) diff --cc usr/src/cmd/ex/ex_unix.c index 0000000000,0000000000,0000000000..d280682a2b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/ex/ex_unix.c @@@@ -1,0 -1,0 -1,0 +1,336 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++static char *sccsid = "@(#)ex_unix.c 6.1 10/18/80"; +++#include "ex.h" +++#include "ex_temp.h" +++#include "ex_tty.h" +++#include "ex_vis.h" +++ +++/* +++ * Unix escapes, filtering +++ */ +++ +++/* +++ * First part of a shell escape, +++ * parse the line, expanding # and % and ! and printing if implied. +++ */ +++unix0(warn) +++ bool warn; +++{ +++ register char *up, *fp; +++ register short c; +++ char printub, puxb[UXBSIZE + sizeof (int)]; +++ +++ printub = 0; +++ CP(puxb, uxb); +++ c = getchar(); +++ if (c == '\n' || c == EOF) +++ error("Incomplete shell escape command@- use 'shell' to get a shell"); +++ up = uxb; +++ do { +++ switch (c) { +++ +++ case '\\': +++ if (any(peekchar(), "%#!")) +++ c = getchar(); +++ default: +++ if (up >= &uxb[UXBSIZE]) { +++tunix: +++ uxb[0] = 0; +++ error("Command too long"); +++ } +++ *up++ = c; +++ break; +++ +++ case '!': +++ fp = puxb; +++ if (*fp == 0) { +++ uxb[0] = 0; +++ error("No previous command@to substitute for !"); +++ } +++ printub++; +++ while (*fp) { +++ if (up >= &uxb[UXBSIZE]) +++ goto tunix; +++ *up++ = *fp++; +++ } +++ break; +++ +++ case '#': +++ fp = altfile; +++ if (*fp == 0) { +++ uxb[0] = 0; +++ error("No alternate filename@to substitute for #"); +++ } +++ goto uexp; +++ +++ case '%': +++ fp = savedfile; +++ if (*fp == 0) { +++ uxb[0] = 0; +++ error("No filename@to substitute for %%"); +++ } +++uexp: +++ printub++; +++ while (*fp) { +++ if (up >= &uxb[UXBSIZE]) +++ goto tunix; +++ *up++ = *fp++ | QUOTE; +++ } +++ break; +++ } +++ c = getchar(); +++ } while (c == '"' || c == '|' || !endcmd(c)); +++ if (c == EOF) +++ ungetchar(c); +++ *up = 0; +++ if (!inopen) +++ resetflav(); +++ if (warn) +++ ckaw(); +++ if (warn && hush == 0 && chng && xchng != chng && value(WARN) && dol > zero) { +++ xchng = chng; +++ vnfl(); +++ printf(mesg("[No write]|[No write since last change]")); +++ noonl(); +++ flush(); +++ } else +++ warn = 0; +++ if (printub) { +++ if (uxb[0] == 0) +++ error("No previous command@to repeat"); +++ if (inopen) { +++ splitw++; +++ vclean(); +++ vgoto(WECHO, 0); +++ } +++ if (warn) +++ vnfl(); +++ if (hush == 0) +++ lprintf("!%s", uxb); +++ if (inopen && Outchar != termchar) { +++ vclreol(); +++ vgoto(WECHO, 0); +++ } else +++ putnl(); +++ flush(); +++ } +++} +++ +++/* +++ * Do the real work for execution of a shell escape. +++ * Mode is like the number passed to open system calls +++ * and indicates filtering. If input is implied, newstdin +++ * must have been setup already. +++ */ +++ttymode +++unixex(opt, up, newstdin, mode) +++ char *opt, *up; +++ int newstdin, mode; +++{ +++ int pvec[2]; +++ ttymode f; +++ +++ signal(SIGINT, SIG_IGN); +++#ifdef SIGTSTP +++ if (dosusp) +++ signal(SIGTSTP, SIG_DFL); +++#endif +++ if (inopen) +++ f = setty(normf); +++ if ((mode & 1) && pipe(pvec) < 0) { +++ /* Newstdin should be io so it will be closed */ +++ if (inopen) +++ setty(f); +++ error("Can't make pipe for filter"); +++ } +++#ifndef VFORK +++ pid = fork(); +++#else +++ pid = vfork(); +++#endif +++ if (pid < 0) { +++ if (mode & 1) { +++ close(pvec[0]); +++ close(pvec[1]); +++ } +++ setrupt(); +++ error("No more processes"); +++ } +++ if (pid == 0) { +++ if (mode & 2) { +++ close(0); +++ dup(newstdin); +++ close(newstdin); +++ } +++ if (mode & 1) { +++ close(pvec[0]); +++ close(1); +++ dup(pvec[1]); +++ if (inopen) { +++ close(2); +++ dup(1); +++ } +++ close(pvec[1]); +++ } +++ if (io) +++ close(io); +++ if (tfile) +++ close(tfile); +++#ifndef VMUNIX +++ close(erfile); +++#endif +++ signal(SIGHUP, oldhup); +++ signal(SIGQUIT, oldquit); +++ if (ruptible) +++ signal(SIGINT, SIG_DFL); +++ execl(svalue(SHELL), "sh", opt, up, (char *) 0); +++ printf("No %s!\n", svalue(SHELL)); +++ error(NOSTR); +++ } +++ if (mode & 1) { +++ io = pvec[0]; +++ close(pvec[1]); +++ } +++ if (newstdin) +++ close(newstdin); +++ return (f); +++} +++ +++/* +++ * Wait for the command to complete. +++ * F is for restoration of tty mode if from open/visual. +++ * C flags suppression of printing. +++ */ +++unixwt(c, f) +++ bool c; +++ ttymode f; +++{ +++ +++ waitfor(); +++#ifdef SIGTSTP +++ if (dosusp) +++ signal(SIGTSTP, onsusp); +++#endif +++ if (inopen) +++ setty(f); +++ setrupt(); +++ if (!inopen && c && hush == 0) { +++ printf("!\n"); +++ flush(); +++ termreset(); +++ gettmode(); +++ } +++} +++ +++/* +++ * Setup a pipeline for the filtration implied by mode +++ * which is like a open number. If input is required to +++ * the filter, then a child editor is created to write it. +++ * If output is catch it from io which is created by unixex. +++ */ +++filter(mode) +++ register int mode; +++{ +++ static int pvec[2]; +++ register ttymode f; +++ register int lines = lineDOL(); +++ +++ mode++; +++ if (mode & 2) { +++ signal(SIGINT, SIG_IGN); +++ if (pipe(pvec) < 0) +++ error("Can't make pipe"); +++ pid = fork(); +++ io = pvec[0]; +++ if (pid < 0) { +++ setrupt(); +++ close(pvec[1]); +++ error("No more processes"); +++ } +++ if (pid == 0) { +++ setrupt(); +++ io = pvec[1]; +++ close(pvec[0]); +++ putfile(); +++ exit(0); +++ } +++ close(pvec[1]); +++ io = pvec[0]; +++ setrupt(); +++ } +++ f = unixex("-c", uxb, (mode & 2) ? pvec[0] : 0, mode); +++ if (mode == 3) { +++ delete(0); +++ addr2 = addr1 - 1; +++ } +++ if (mode & 1) { +++ if(FIXUNDO) +++ undap1 = undap2 = addr2+1; +++ ignore(append(getfile, addr2)); +++#ifdef TRACE +++ if (trace) +++ vudump("after append in filter"); +++#endif +++ } +++ close(io); +++ io = -1; +++ unixwt(!inopen, f); +++ netchHAD(lines); +++} +++ +++/* +++ * Set up to do a recover, getting io to be a pipe from +++ * the recover process. +++ */ +++recover() +++{ +++ static int pvec[2]; +++ +++ if (pipe(pvec) < 0) +++ error(" Can't make pipe for recovery"); +++ pid = fork(); +++ io = pvec[0]; +++ if (pid < 0) { +++ close(pvec[1]); +++ error(" Can't fork to execute recovery"); +++ } +++ if (pid == 0) { +++ close(2); +++ dup(1); +++ close(1); +++ dup(pvec[1]); +++ close(pvec[1]); +++ execl(EXRECOVER, "exrecover", svalue(DIRECTORY), file, (char *) 0); +++ close(1); +++ dup(2); +++ error(" No recovery routine"); +++ } +++ close(pvec[1]); +++} +++ +++/* +++ * Wait for the process (pid an external) to complete. +++ */ +++waitfor() +++{ +++ +++ do +++ rpid = wait(&status); +++ while (rpid != pid && rpid != -1); +++ status = (status >> 8) & 0377; +++} +++ +++/* +++ * The end of a recover operation. If the process +++ * exits non-zero, force not edited; otherwise force +++ * a write. +++ */ +++revocer() +++{ +++ +++ waitfor(); +++ if (pid == rpid && status != 0) +++ edited = 0; +++ else +++ change(); +++} diff --cc usr/src/cmd/ex/ex_v.c index 0000000000,c42808b9f2,0000000000..be06ec5a7e mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_v.c +++ b/usr/src/cmd/ex/ex_v.c @@@@ -1,0 -1,374 -1,0 +1,382 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_v.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_re.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Entry points to open and visual from command mode processor. + + * The open/visual code breaks down roughly as follows: + + * + + * ex_v.c entry points, checking of terminal characteristics + + * + + * ex_vadj.c logical screen control, use of intelligent operations + + * insert/delete line and coordination with screen image; + + * updating of screen after changes. + + * + + * ex_vget.c input of single keys and reading of input lines + + * from the echo area, handling of \ escapes on input for + + * uppercase only terminals, handling of memory for repeated + + * commands and small saved texts from inserts and partline + + * deletes, notification of multi line changes in the echo + + * area. + + * + + * ex_vmain.c main command decoding, some command processing. + + * + + * ex_voperate.c decoding of operator/operand sequences and + + * contextual scans, implementation of word motions. + + * + + * ex_vops.c major operator interfaces, undos, motions, deletes, + + * changes, opening new lines, shifts, replacements and yanks + + * coordinating logical and physical changes. + + * + + * ex_vops2.c subroutines for operator interfaces in ex_vops.c, + + * insert mode, read input line processing at lowest level. + + * + + * ex_vops3.c structured motion definitions of ( ) { } and [ ] operators, + + * indent for lisp routines, () and {} balancing. + + * + + * ex_vput.c output routines, clearing, physical mapping of logical cursor + + * positioning, cursor motions, handling of insert character + + * and delete character functions of intelligent and unintelligent + + * terminals, visual mode tracing routines (for debugging), + + * control of screen image and its updating. + + * + + * ex_vwind.c window level control of display, forward and backward rolls, + + * absolute motions, contextual displays, line depth determination + + */ + + + +/* + + * Enter open mode + + */ + +oop() + +{ + + register char *ic; + + char atube[TUBESIZE + LBSIZE]; - register int f; +++ register ttymode f; + + + + ovbeg(); + + if (peekchar() == '/') { + + ignore(compile(getchar(), 1)); + + savere(scanre); + + if (execute(0, dot) == 0) + + error("Fail|Pattern not found on addressed line"); + + ic = loc1; + + if (ic > linebuf && *ic == 0) + + ic--; + + } else { + + getDOT(); + + ic = vskipwh(linebuf); + + } + + newline(); + + + + /* + + * If overstrike then have to HARDOPEN + + * else if can move cursor up off current line can use CRTOPEN (~~vi1) + + * otherwise (ugh) have to use ONEOPEN (like adm3) + + */ + + if (OS && !EO) + + bastate = HARDOPEN; + + else if (CA || UP) + + bastate = CRTOPEN; + + else + + bastate = ONEOPEN; + + setwind(); + + + + /* + + * To avoid bombing on glass-crt's when the line is too long + + * pretend that such terminals are 160 columns wide. + + * If a line is too wide for display, we will dynamically + + * switch to hardcopy open mode. + + */ + + if (state != CRTOPEN) + + WCOLS = TUBECOLS; + + if (!inglobal) + + savevis(); + + vok(atube); + + if (state != CRTOPEN) + + COLUMNS = WCOLS; + + Outchar = vputchar; + + f = ostart(); + + if (state == CRTOPEN) { + + if (outcol == UKCOL) + + outcol = 0; + + vmoveitup(1, 1); + + } else + + outline = destline = WBOT; + + vshow(dot, NOLINE); + + vnline(ic); + + vmain(); + + if (state != CRTOPEN) + + vclean(); + + Command = "open"; + + ovend(f); + +} + + + +ovbeg() + +{ + + + + if (!value(OPEN)) + + error("Can't use open/visual unless open option is set"); + + if (inopen) + + error("Recursive open/visual not allowed"); + + Vlines = lineDOL(); + + fixzero(); + + setdot(); + + pastwh(); + + dot = addr2; + +} + + + +ovend(f) - int f; +++ ttymode f; + +{ + + + + splitw++; + + vgoto(WECHO, 0); + + vclreol(); + + vgoto(WECHO, 0); + + holdcm = 0; + + splitw = 0; + + ostop(f); + + setoutt(); + + undvis(); + + COLUMNS = OCOLUMNS; + + inopen = 0; + + flusho(); + + netchHAD(Vlines); + +} + + + +/* + + * Enter visual mode + + */ + +vop() + +{ + + register int c; + + char atube[TUBESIZE + LBSIZE]; - register int f; +++ register ttymode f; + + + + if (!CA && UP == NOSTR) { + + if (initev) { + +toopen: + + merror("[Using open mode]"); + + putNFL(); + + oop(); + + return; + + } + + error("Visual needs addressible cursor or upline capability"); + + } + + if (OS && !EO) { + + if (initev) + + goto toopen; + + error("Can't use visual on a terminal which overstrikes"); + + } + + if (!CL) { + + if (initev) + + goto toopen; + + error("Visual requires clear screen capability"); + + } +++ if (NS && !SF) { +++ if (initev) +++ goto toopen; +++ error("Visual requires scrolling"); +++ } + + ovbeg(); + + bastate = VISUAL; + + c = 0; + + if (any(peekchar(), "+-^.")) + + c = getchar(); + + pastwh(); + + vsetsiz(isdigit(peekchar()) ? getnum() : value(WINDOW)); + + setwind(); + + newline(); + + vok(atube); + + if (!inglobal) + + savevis(); + + Outchar = vputchar; + + vmoving = 0; + + f = ostart(); + + if (initev == 0) { + + vcontext(dot, c); + + vnline(NOSTR); + + } + + vmain(); + + Command = "visual"; + + ovend(f); + +} + + + +/* + + * Hack to allow entry to visual with + + * empty buffer since routines internally + + * demand at least one line. + + */ + +fixzero() + +{ + + + + if (dol == zero) { + + register bool ochng = chng; + + + + vdoappend(""); + + if (!ochng) + + sync(); + + addr1 = addr2 = one; + + } else if (addr2 == zero) + + addr2 = one; + +} + + + +/* + + * Save lines before visual between unddol and truedol. + + * Accomplish this by throwing away current [unddol,truedol] + + * and then saving all the lines in the buffer and moving + + * unddol back to dol. Don't do this if in a global. + + * + + * If you do + + * g/xxx/vi. + + * and then do a + + * :e xxxx + + * at some point, and then quit from the visual and undo + + * you get the old file back. Somewhat weird. + + */ + +savevis() + +{ + + + + if (inglobal) + + return; + + truedol = unddol; + + saveall(); + + unddol = dol; + + undkind = UNDNONE; + +} + + + +/* + + * Restore a sensible state after a visual/open, moving the saved + + * stuff back to [unddol,dol], and killing the partial line kill indicators. + + */ + +undvis() + +{ + + + + if (ruptible) + + signal(SIGINT, onintr); + + squish(); + + pkill[0] = pkill[1] = 0; + + unddol = truedol; + + unddel = zero; + + undap1 = one; + + undap2 = dol + 1; + + undkind = UNDALL; +++ if (undadot <= zero || undadot > dol) +++ undadot = zero+1; + +} + + + +/* + + * Set the window parameters based on the base state bastate + + * and the available buffer space. + + */ + +setwind() + +{ + + + + WCOLS = COLUMNS; + + switch (bastate) { + + + + case ONEOPEN: + + if (AM) + + WCOLS--; + + /* fall into ... */ + + + + case HARDOPEN: + + basWTOP = WTOP = WBOT = WECHO = 0; + + ZERO = 0; + + holdcm++; + + break; + + + + case CRTOPEN: + + basWTOP = LINES - 2; + + /* fall into */ + + + + case VISUAL: + + ZERO = LINES - TUBESIZE / WCOLS; + + if (ZERO < 0) + + ZERO = 0; + + if (ZERO > basWTOP) + + error("Screen too large for internal buffer"); + + WTOP = basWTOP; WBOT = LINES - 2; WECHO = LINES - 1; + + break; + + } + + state = bastate; + + basWLINES = WLINES = WBOT - WTOP + 1; + +} + + + +/* + + * Can we hack an open/visual on this terminal? + + * If so, then divide the screen buffer up into lines, + + * and initialize a bunch of state variables before we start. + + */ + +vok(atube) + + register char *atube; + +{ + + register int i; + + + + if (WCOLS == 1000) + + serror("Don't know enough about your terminal to use %s", Command); + + if (WCOLS > TUBECOLS) + + error("Terminal too wide"); + + if (WLINES >= TUBELINES || WCOLS * (WECHO - ZERO + 1) > TUBESIZE) + + error("Screen too large"); + + + + vtube0 = atube; + + vclrbyte(atube, WCOLS * (WECHO - ZERO + 1)); + + for (i = 0; i < ZERO; i++) - vtube[i] = (char *) -20000; +++ vtube[i] = (char *) 0; + + for (; i <= WECHO; i++) + + vtube[i] = atube, atube += WCOLS; + + for (; i < TUBELINES; i++) - vtube[i] = (char *) -20000; +++ vtube[i] = (char *) 0; + + vutmp = atube; + + vundkind = VNONE; + + vUNDdot = 0; + + OCOLUMNS = COLUMNS; + + inopen = 1; + +#ifdef CBREAK + + signal(SIGINT, vintr); + +#endif + + vmoving = 0; + + splitw = 0; + + doomed = 0; + + holdupd = 0; + + Peekkey = 0; + + vcnt = vcline = 0; + + if (vSCROLL == 0) + + vSCROLL = (value(WINDOW)+1)/2; /* round up so dft=6,11 */ + +} + + + +#ifdef CBREAK + +vintr() + +{ + + + + signal(SIGINT, vintr); + + if (vcatch) + + onintr(); + + ungetkey(ATTN); + + draino(); + +} + +#endif + + + +/* + + * Set the size of the screen to size lines, to take effect the + + * next time the screen is redrawn. + + */ + +vsetsiz(size) + + int size; + +{ + + register int b; + + + + if (bastate != VISUAL) + + return; + + b = LINES - 1 - size; + + if (b >= LINES - 1) + + b = LINES - 2; + + if (b < 0) + + b = 0; + + basWTOP = b; + + basWLINES = WBOT - b + 1; + +} diff --cc usr/src/cmd/ex/ex_vadj.c index 0000000000,78373397da,0000000000..47a4868805 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vadj.c +++ b/usr/src/cmd/ex/ex_vadj.c @@@@ -1,0 -1,1047 -1,0 +1,1045 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vadj.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Routines to deal with management of logical versus physical + + * display, opening and redisplaying lines on the screen, and + + * use of intelligent terminal operations. Routines to deal with + + * screen cleanup after a change. + + */ + + + +/* + + * Display a new line at physical line p, returning + + * the depth of the newly displayed line. We may decide + + * to expand the window on an intelligent terminal if it is + + * less than a full screen by deleting a line above the top of the + + * window before doing an insert line to keep all the good text + + * on the screen in which case the line may actually end up + + * somewhere other than line p. + + */ + +vopen(tp, p) + + line *tp; + + int p; + +{ + + register int cnt; + + register struct vlinfo *vp, *vpc; + + + +#ifdef ADEBUG + + if (trace != NULL) + + tfixnl(), fprintf(trace, "vopen(%d, %d)\n", lineno(tp), p); + +#endif + + if (state != VISUAL) { + + if (vcnt) + + if (hold & HOLDROL) + + vup1(); + + else + + vclean(); + + + + /* + + * Forget all that we once knew. + + */ + + vcnt = vcline = 0; + + p = WBOT; LASTLINE = WBOT + 1; + + state = bastate; + + WTOP = basWTOP; + + WLINES = basWLINES; + + } + + vpc = &vlinfo[vcline]; + + for (vp = &vlinfo[vcnt]; vp >= vpc; vp--) + + vlcopy(vp[1], vp[0]); + + vcnt++; + + if (Pline == numbline) + + /* + + * Dirtying all the lines is rather inefficient + + * internally, but number mode is used rarely + + * and so its not worth optimizing. + + */ + + vdirty(vcline+1, WECHO); + + getline(*tp); + + + + /* + + * If we are opening at the top of the window, can try a window + + * expansion at the top. + + */ + + if (state == VISUAL && vcline == 0 && vcnt > 1 && p > ZERO) { + + cnt = p + vdepth() - LINE(1); + + if (cnt > 0) { + + p -= cnt; + + if (p < ZERO) + + p = ZERO; + + WTOP = p; + + WLINES = WBOT - WTOP + 1; + + } + + } + + vpc->vliny = p, vpc->vdepth = 0, vpc->vflags = 0; + + cnt = vreopen(p, lineno(tp), vcline); + + if (vcline + 1 == vcnt) + + LINE(vcnt) = LINE(vcline) + cnt; + +} + + + +/* + + * Redisplay logical line l at physical line p with line number lineno. + + */ + +vreopen(p, lineno, l) + + int p, lineno, l; + +{ + + register int d; + + register struct vlinfo *vp = &vlinfo[l]; + + - #ifdef ADEBUG - if (trace) - tfixnl(), fprintf(trace, "vreopen(%d, %d, %d)\n", p, lineno, l); - #endif + + d = vp->vdepth; + + if (d == 0 || (vp->vflags & VDIRT)) + + vp->vdepth = d = vdepth(); + + vp->vliny = p, vp->vflags &= ~VDIRT; + + + + /* + + * Try to win by making the screen larger rather than inserting + + * a line and driving text off the bottom. + + */ + + p = vglitchup(l, 0); + + + + /* + + * BUG: Should consider using CE here to clear to end of line. + + * As it stands we always strike over the current text. + + * Since often the current text is the same as what + + * we are overstriking with, it tends not to show. + + * On the other hand if it is different and we end up + + * spacing out a lot of text, we could have won with + + * a CE. This is probably worthwhile at low speed + + * only however, since clearly computation will be + + * necessary to determine which way to go. + + */ + + vigoto(p, 0); + + pline(lineno); + + + + /* + + * When we are typing part of a line for hardcopy open, don't + + * want to type the '$' marking an end of line if in list mode. + + */ + + if (hold & HOLDDOL) + + return (d); + + if (Putchar == listchar) + + putchar('$'); + + + + /* + + * Optimization of cursor motion may prevent screen rollup if the + + * line has blanks/tabs at the end unless we force the cursor to appear + + * on the last line segment. + + */ + + if (vp->vliny + d - 1 > WBOT) + + vcsync(); + + + + /* + + * Switch into hardcopy open mode if we are in one line (adm3) + + * open mode and this line is now too long. If in hardcopy + + * open mode, then call sethard to move onto the next line + + * with appropriate positioning. + + */ + + if (state == ONEOPEN) { + + WCOLS = OCOLUMNS; + + if (vdepth() > 1) { + + WCOLS = TUBECOLS; + + sethard(); + + } else + + WCOLS = TUBECOLS; + + } else if (state == HARDOPEN) + + sethard(); + + + + /* + + * Unless we filled (completely) the last line we typed on, + + * we have to clear to the end of the line + + * in case stuff is left from before. + + */ + + if (vp->vliny + d > destline) { + + if (IN && destcol == WCOLS) + + vigoto(vp->vliny + d - 1, 0); + + vclreol(); + + } + + return (d); + +} + + + +/* + + * Real work for winning growing of window at top + + * when inserting in the middle of a partially full + + * screen on an intelligent terminal. We have as argument + + * the logical line number to be inserted after, and the offset + + * from that line where the insert will go. + + * We look at the picture of depths and positions, and if we can + + * delete some (blank) lines from the top of the screen so that + + * later inserts will not push stuff off the bottom. + + */ + +vglitchup(l, o) + + int l, o; + +{ + + register struct vlinfo *vp = &vlinfo[l]; + + register int need; + + register int p = vp->vliny; + + short oldhold, oldheldech; + + bool glitched = 0; + + + + if (l < vcnt - 1) { + + need = p + vp->vdepth - (vp+1)->vliny; + + if (need > 0) { + + if (state == VISUAL && WTOP - ZERO >= need && AL && DL) { + + glitched++; + + WTOP -= need; + + WLINES = WBOT - WTOP + 1; + + p -= need; + + if (p + o == WTOP) { + + vp->vliny = WTOP; + + return (WTOP + o); + + } + + vdellin(WTOP, need, -1); + + oldheldech = heldech; + + oldhold = hold; + + hold |= HOLDECH; + + } + + vinslin((vp+1)->vliny, need, l); + + if (glitched) { + + hold = oldhold; + + heldech = oldheldech; + + } + + } + + } else + + vp[1].vliny = vp[0].vliny + vp->vdepth; + + return (p + o); + +} + + + +/* + + * Insert cnt blank lines before line p, + + * logically and (if supported) physically. + + */ + +vinslin(p, cnt, l) + + register int p, cnt; + + int l; + +{ + + register int i; + + bool could = 1; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vinslin(%d, %d, %d)\n", p, cnt, l); + +#endif + + if (p + cnt > WBOT && CD) { + + /* + + * Really quick -- clear to end of screen. + + */ + + cnt = WECHO + 1 - p; + + vgoto(p, 0), vputp(CD, cnt); + + vclrech(1); + + vadjAL(p, cnt); - } else if (AL) { - /* - * Use insert line. - */ - vgoto(p, 0), vputp(AL, WECHO + 1 - p); - for (i = cnt - 1; i > 0; i--) { - vgoto(outline+1, 0), vputp(AL, WECHO + 1 - outline); - if ((hold & HOLDAT) == 0) - putchar('@'); - } - vadjAL(p, cnt); - } else if (SR && p == WTOP) { +++ } else if (SR && p == WTOP && costSR < costAL) { + + /* + + * Use reverse scroll mode of the terminal, at - * the top of the window. +++ * the top of the window. Reverse linefeed works +++ * too, since we only use it from line WTOP. + + */ + + for (i = cnt; i > 0; i--) { + + vgoto(p, 0), vputp(SR, 0); + + if (i > 1 && (hold & HOLDAT) == 0) + + putchar('@'); + + /* + + * If we are at the top of the screen, and the + + * terminal retains display above, then we + + * should try to clear to end of line. + + * Have to use CE since we don't remember what is + + * actually on the line. + + */ + + if (CE && (DA || p != 0)) + + vputp(CE, 1); + + } + + vadjAL(p, cnt); +++ } else if (AL) { +++ /* +++ * Use insert line. +++ */ +++ vgoto(p, 0), vputp(AL, WECHO + 1 - p); +++ for (i = cnt - 1; i > 0; i--) { +++ vgoto(outline+1, 0), vputp(AL, WECHO + 1 - outline); +++ if ((hold & HOLDAT) == 0) +++ putchar('@'); +++ } +++ vadjAL(p, cnt); + + } else + + could = 0; + + vopenup(cnt, could, l); + +} + + + +/* + + * Logically open up after line l, cnt of them. + + * We need to know if it was done ``physically'' since in this + + * case we accept what the hardware gives us. If we have to do + + * it ourselves (brute force) we will squish out @ lines in the process + + * if this will save us work. + + */ + +vopenup(cnt, could, l) + + int cnt; + + bool could; + +{ + + register struct vlinfo *vc = &vlinfo[l + 1]; + + register struct vlinfo *ve = &vlinfo[vcnt]; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vopenup(%d, %d, %d)\n", cnt, could, l); + +#endif + + if (could) + + /* + + * This will push @ lines down the screen, + + * just as the hardware did. Since the default + + * for intelligent terminals is to never have @ + + * lines on the screen, this should never happen, + + * and the code makes no special effort to be nice in this + + * case, e.g. squishing out the @ lines by delete lines + + * before doing append lines. + + */ + + for (; vc <= ve; vc++) + + vc->vliny += cnt; + + else { + + /* + + * Will have to clean up brute force eventually, + + * so push the line data around as little as possible. + + */ + + vc->vliny += cnt, vc->vflags |= VDIRT; + + while (vc < ve) { + + register int i = vc->vliny + vc->vdepth; + + + + vc++; + + if (i <= vc->vliny) + + break; + + vc->vliny = i, vc->vflags |= VDIRT; + + } + + } + + vscrap(); + +} + + + +/* + + * Adjust data structure internally to account for insertion of + + * blank lines on the screen. + + */ + +vadjAL(p, cnt) + + int p, cnt; + +{ + + char *tlines[TUBELINES]; + + register int from, to; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vadjal(%d, %d)\n", p, cnt); + +#endif + + copy(tlines, vtube, sizeof vtube); /*SASSIGN*/ + + for (from = p, to = p + cnt; to <= WECHO; from++, to++) + + vtube[to] = tlines[from]; + + for (to = p; from <= WECHO; from++, to++) { + + vtube[to] = tlines[from]; + + vclrbyte(vtube[to], WCOLS); + + } + + /* + + * Have to clear the echo area since its contents aren't + + * necessarily consistent with the rest of the display. + + */ + + vclrech(0); + +} + + + +/* + + * Roll the screen up logically and physically + + * so that line dl is the bottom line on the screen. + + */ + +vrollup(dl) + + int dl; + +{ + + register int cnt; + + register int dc = destcol; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vrollup(%d)\n", dl); + +#endif + + cnt = dl - (splitw ? WECHO : WBOT); + + if (splitw && (state == VISUAL || state == CRTOPEN)) + + holdupd = 1; - vscroll(cnt); + + vmoveitup(cnt, 1); +++ vscroll(cnt); + + destline = dl - cnt, destcol = dc; + +} + + + +vup1() + +{ + + + + vrollup(WBOT + 1); + +} + + + +/* + + * Scroll the screen up cnt lines physically. + + * If doclr is true, do a clear eol if the terminal + + * has standout (to prevent it from scrolling up) + + */ + +vmoveitup(cnt, doclr) + + register int cnt; + + bool doclr; + +{ + + + + if (cnt == 0) + + return; + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vmoveitup(%d)\n", cnt); + +#endif + + if (doclr && (SO || SE)) + + vclrech(0); + + if (SF) { + + while (cnt > 0) + + vputp(SF, 0), cnt--; + + return; + + } + + destline = WECHO + cnt; + + destcol = (NONL ? 0 : outcol % WCOLS); + + fgoto(); + + if (state == ONEOPEN || state == HARDOPEN) { + + outline = destline = 0; + + vclrbyte(vtube[0], WCOLS); + + } + +} + + + +/* + + * Scroll the screen up cnt lines logically. + + */ + +vscroll(cnt) + + register int cnt; + +{ + + register int from, to; + + char *tlines[TUBELINES]; + + + +#ifdef ADEBUG + + if (trace) + + fprintf(trace, "vscroll(%d)\n", cnt); + +#endif + + if (cnt < 0 || cnt > TUBELINES) + + error("Internal error: vscroll"); + + if (cnt == 0) + + return; + + copy(tlines, vtube, sizeof vtube); + + for (to = ZERO, from = ZERO + cnt; to <= WECHO - cnt; to++, from++) + + vtube[to] = tlines[from]; + + for (from = ZERO; to <= WECHO; to++, from++) { + + vtube[to] = tlines[from]; + + vclrbyte(vtube[to], WCOLS); + + } + + for (from = 0; from <= vcnt; from++) + + LINE(from) -= cnt; + +} + + + +/* + + * Discard logical lines due to physical wandering off the screen. + + */ + +vscrap() + +{ + + register int i, j; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vscrap\n"), tvliny(); + +#endif + + if (splitw) + + return; + + if (vcnt && WBOT != WECHO && LINE(0) < WTOP && LINE(0) >= ZERO) { + + WTOP = LINE(0); + + WLINES = WBOT - WTOP + 1; + + } + + for (j = 0; j < vcnt; j++) + + if (LINE(j) >= WTOP) { + + if (j == 0) + + break; + + /* + + * Discard the first j physical lines off the top. + + */ + + vcnt -= j, vcline -= j; + + for (i = 0; i <= vcnt; i++) + + vlcopy(vlinfo[i], vlinfo[i + j]); + + break; + + } + + /* + + * Discard lines off the bottom. + + */ + + if (vcnt) { + + for (j = 0; j <= vcnt; j++) + + if (LINE(j) > WBOT || LINE(j) + DEPTH(j) - 1 > WBOT) { + + vcnt = j; + + break; + + } + + LASTLINE = LINE(vcnt-1) + DEPTH(vcnt-1); + + } + +#ifdef ADEBUG + + if (trace) + + tvliny(); + +#endif + + /* + + * May have no lines! + + */ + +} + + + +/* + + * Repaint the screen, with cursor at curs, aftern an arbitrary change. + + * Handle notification on large changes. + + */ + +vrepaint(curs) + + char *curs; + +{ + + + + wdot = NOLINE; + + /* + + * In open want to notify first. + + */ + + noteit(0); + + vscrap(); + + + + /* + + * Deal with a totally useless display. + + */ + + if (vcnt == 0 || vcline < 0 || vcline > vcnt || holdupd && state != VISUAL) { + + register line *odol = dol; + + + + vcnt = 0; + + if (holdupd) + + if (state == VISUAL) + + ignore(peekkey()); + + else + + vup1(); + + holdupd = 0; + + if (odol == zero) + + fixzero(); + + vcontext(dot, '.'); + + noteit(1); + + if (noteit(1) == 0 && odol == zero) { + + CATCH + + error("No lines in buffer"); + + ENDCATCH + + linebuf[0] = 0; + + splitw = 0; + + } + + vnline(curs); + + return; + + } + + + + /* + + * Have some useful displayed text; refresh it. + + */ + + getDOT(); + + + + /* + + * This is for boundary conditions in open mode. + + */ + + if (FLAGS(0) & VDIRT) + + vsync(WTOP); + + + + /* + + * If the current line is after the last displayed line + + * or the bottom of the screen, then special effort is needed + + * to get it on the screen. We first try a redraw at the + + * last line on the screen, hoping it will fill in where @ + + * lines are now. If this doesn't work, then roll it onto + + * the screen. + + */ + + if (vcline >= vcnt || LINE(vcline) > WBOT) { + + short oldhold = hold; + + hold |= HOLDAT, vredraw(LASTLINE), hold = oldhold; + + if (vcline >= vcnt) { + + register int i = vcline - vcnt + 1; + + + + dot -= i; + + vcline -= i; + + vroll(i); + + } else + + vsyncCL(); + + } else + + vsync(vcline > 0 ? LINE(vcline - 1) : WTOP); + + + + /* + + * Notification on large change for visual + + * has to be done last or we may lose + + * the echo area with redisplay. + + */ + + noteit(1); + + + + /* + + * Finally. Move the cursor onto the current line. + + */ + + vnline(curs); + +} + + + +/* + + * Fully cleanup the screen, leaving no @ lines except at end when + + * line after last won't completely fit. The routine vsync is + + * more conservative and much less work on dumb terminals. + + */ + +vredraw(p) + + register int p; + +{ + + register int l; + + register line *tp; + + char temp[LBSIZE]; + + bool anydl = 0; + + short oldhold = hold; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vredraw(%d)\n", p), tvliny(); + +#endif + + if (holdupd) { + + holdupd = 3; + + return; + + } + + if (state == HARDOPEN || splitw) + + return; + + if (p < 0 /* || p > WECHO */) + + error("Internal error: vredraw"); + + + + /* + + * Trim the ragged edges (lines which are off the screen but + + * not yet logically discarded), save the current line, and + + * search for first logical line affected by the redraw. + + */ + + vscrap(); + + CP(temp, linebuf); + + l = 0; + + tp = dot - vcline; + + if (vcnt == 0) + + LINE(0) = WTOP; + + while (l < vcnt && LINE(l) < p) + + l++, tp++; + + + + /* + + * We hold off echo area clearing during the redraw in deference + + * to a final clear of the echo area at the end if appropriate. + + */ + + heldech = 0; + + hold |= HOLDECH; + + for (; l < vcnt && Peekkey != ATTN; l++) { + + if (l == vcline) + + strcLIN(temp); + + else + + getline(*tp); + + + + /* + + * Delete junk between displayed lines. + + */ + + if (LINE(l) != LINE(l + 1) && LINE(l) != p) { + + if (anydl == 0 && DB && CD) { + + hold = oldhold; + + vclrech(0); + + anydl = 1; + + hold |= HOLDECH; + + heldech = 0; + + } + + vdellin(p, LINE(l) - p, l); + + } + + + + /* + + * If line image is not know to be up to date, then + + * redisplay it; else just skip onward. + + */ + + LINE(l) = p; + + if (FLAGS(l) & VDIRT) { + + DEPTH(l) = vdepth(); + + if (l != vcline && p + DEPTH(l) - 1 > WBOT) { + + vscrap(); + + break; + + } + + FLAGS(l) &= ~VDIRT; + + vreopen(p, lineno(tp), l); + + p = LINE(l) + DEPTH(l); + + } else + + p += DEPTH(l); + + tp++; + + } + + + + /* + + * That takes care of lines which were already partially displayed. + + * Now try to fill the rest of the screen with text. + + */ + + if (state == VISUAL && p <= WBOT) { + + int ovcline = vcline; + + + + vcline = l; + + for (; tp <= dol && Peekkey != ATTN; tp++) { + + getline(*tp); + + if (p + vdepth() - 1 > WBOT) + + break; + + vopen(tp, p); + + p += DEPTH(vcline); + + vcline++; + + } + + vcline = ovcline; + + } + + + + /* + + * Thats all the text we can get on. + + * Now rest of lines (if any) get either a ~ if they + + * are past end of file, or an @ if the next line won't fit. + + */ + + for (; p <= WBOT && Peekkey != ATTN; p++) + + vclrlin(p, tp); + + strcLIN(temp); + + hold = oldhold; + + if (heldech) + + vclrech(0); + +#ifdef ADEBUG + + if (trace) + + tvliny(); + +#endif + +} + + + +/* + + * Do the real work in deleting cnt lines starting at line p from + + * the display. First affected line is line l. + + */ + +vdellin(p, cnt, l) + + int p, cnt, l; + +{ + + register int i; + + + + if (cnt == 0) + + return; + + if (DL == NOSTR || cnt < 0) { + + /* + + * Can't do it; just remember that line l is munged. + + */ + + FLAGS(l) |= VDIRT; + + return; + + } + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vdellin(%d, %d, %d)\n", p, cnt, l); + +#endif + + /* + + * Send the deletes to the screen and then adjust logical + + * and physical internal data structures. + + */ + + vgoto(p, 0); + + for (i = 0; i < cnt; i++) + + vputp(DL, WECHO - p); + + vadjDL(p, cnt); + + vcloseup(l, cnt); + +} + +/* + + * Adjust internal physical screen image to account for deleted lines. + + */ + +vadjDL(p, cnt) + + int p, cnt; + +{ + + char *tlines[TUBELINES]; + + register int from, to; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vadjDL(%d, %d)\n", p, cnt); + +#endif + + /* + + * Would like to use structured assignment but early + + * v7 compiler (released with phototypesetter for v6) + + * can't hack it. + + */ + + copy(tlines, vtube, sizeof vtube); /*SASSIGN*/ + + for (from = p + cnt, to = p; from <= WECHO; from++, to++) + + vtube[to] = tlines[from]; + + for (from = p; to <= WECHO; from++, to++) { + + vtube[to] = tlines[from]; + + vclrbyte(vtube[to], WCOLS); + + } + +} + +/* + + * Sync the screen, like redraw but more lazy and willing to leave + + * @ lines on the screen. VsyncCL syncs starting at the current line. + + * In any case, if the redraw option is set then all syncs map to redraws + + * as if vsync didn't exist. + + */ + +vsyncCL() + +{ + + + + vsync(LINE(vcline)); + +} + + + +vsync(p) + + register int p; + +{ + + + + if (value(REDRAW)) + + vredraw(p); + + else + + vsync1(p); + +} + + + +/* + + * The guts of a sync. Similar to redraw but + + * just less ambitous. + + */ + +vsync1(p) + + register int p; + +{ + + register int l; + + char temp[LBSIZE]; + + register struct vlinfo *vp = &vlinfo[0]; + + short oldhold = hold; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vsync1(%d)\n", p), tvliny(); + +#endif + + if (holdupd) { + + if (holdupd < 3) + + holdupd = 2; + + return; + + } + + if (state == HARDOPEN || splitw) + + return; + + vscrap(); + + CP(temp, linebuf); + + if (vcnt == 0) + + LINE(0) = WTOP; + + l = 0; + + while (l < vcnt && vp->vliny < p) + + l++, vp++; + + heldech = 0; + + hold |= HOLDECH; + + while (p <= WBOT && Peekkey != ATTN) { + + /* + + * Want to put a line here if not in visual and first line + + * or if there are lies left and this line starts before + + * the current line, or if this line is piled under the + + * next line (vreplace does this and we undo it). + + */ + + if (l == 0 && state != VISUAL || + + (l < vcnt && (vp->vliny <= p || vp[0].vliny == vp[1].vliny))) { + + if (l == 0 || vp->vliny < p || (vp->vflags & VDIRT)) { + + if (l == vcline) + + strcLIN(temp); + + else + + getline(dot[l - vcline]); + + /* + + * Be careful that a long line doesn't cause the + + * screen to shoot up. + + */ + + if (l != vcline && (vp->vflags & VDIRT)) { + + vp->vdepth = vdepth(); + + vp->vflags &= ~VDIRT; + + if (p + vp->vdepth - 1 > WBOT) + + break; + + } + + vreopen(p, lineDOT() + (l - vcline), l); + + } + + p = vp->vliny + vp->vdepth; + + vp++; + + l++; + + } else + + /* + + * A physical line between logical lines, + + * so we settle for an @ at the beginning. + + */ + + vclrlin(p, dot + (l - vcline)), p++; + + } + + strcLIN(temp); + + hold = oldhold; + + if (heldech) + + vclrech(0); + +} + + + +/* + + * Subtract (logically) cnt physical lines from the + + * displayed position of lines starting with line l. + + */ + +vcloseup(l, cnt) + + int l; + + register int cnt; + +{ + + register int i; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vcloseup(%d, %d)\n", l, cnt); + +#endif + + for (i = l + 1; i <= vcnt; i++) + + LINE(i) -= cnt; + +} + + + +/* + + * Workhorse for rearranging line descriptors on changes. + + * The idea here is that, starting with line l, cnt lines + + * have been replaced with newcnt lines. All of these may + + * be ridiculous, i.e. l may be -1000, cnt 50 and newcnt 0, + + * since we may be called from an undo after the screen has + + * moved a lot. Thus we have to be careful. + + * + + * Many boundary conditions here. + + */ + +vreplace(l, cnt, newcnt) + + int l, cnt, newcnt; + +{ + + register int from, to, i; + + bool savenote = 0; + + + +#ifdef ADEBUG + + if (trace) { + + tfixnl(), fprintf(trace, "vreplace(%d, %d, %d)\n", l, cnt, newcnt); + + tvliny(); + + } + +#endif + + if (l >= vcnt) + + return; + + if (l < 0) { + + if (l + cnt < 0) { + + /* + + * Nothing on the screen is relevant. + + * Settle for redrawing from scratch (later). + + */ + + vcnt = 0; + + return; + + } + + /* + + * Normalize l to top of screen; the add is + + * really a subtract from cnt since l is negative. + + */ + + cnt += l; + + l = 0; + + + + /* + + * Unseen lines were affect so notify (later). + + */ + + savenote++; + + } + + + + /* + + * These shouldn't happen + + * but would cause great havoc. + + */ + + if (cnt < 0) + + cnt = 0; + + if (newcnt < 0) + + newcnt = 0; + + + + /* + + * Surely worthy of note if more than report + + * lines were changed. + + */ + + if (cnt > value(REPORT) || newcnt > value(REPORT)) + + savenote++; + + + + /* + + * Same number of lines affeted as on screen, and we + + * can insert and delete lines. Thus we just type + + * over them, since otherwise we will push them + + * slowly off the screen, a clear lose. + + */ + + if (cnt == newcnt || vcnt - l == newcnt && AL && DL) { + + if (cnt > 1 && l + cnt > vcnt) + + savenote++; + + vdirty(l, newcnt); + + } else { + + /* + + * Lines are going away, squish them out. + + */ + + if (cnt > 0) { + + /* + + * If non-displayed lines went away, + + * always notify. + + */ + + if (cnt > 1 && l + cnt > vcnt) + + savenote++; + + if (l + cnt >= vcnt) + + cnt = vcnt - l; + + else + + for (from = l + cnt, to = l; from <= vcnt; to++, from++) + + vlcopy(vlinfo[to], vlinfo[from]); + + vcnt -= cnt; + + } + + /* + + * Open up space for new lines appearing. + + * All new lines are piled in the same place, + + * and will be unpiled by vredraw/vsync, which + + * inserts lines in front as it unpiles. + + */ + + if (newcnt > 0) { + + /* + + * Newlines are appearing which may not show, + + * so notify (this is only approximately correct + + * when long lines are present). + + */ + + if (newcnt > 1 && l + newcnt > vcnt + 1) + + savenote++; + + + + /* + + * If there will be more lines than fit, then + + * just throw way the rest of the stuff on the screen. + + */ + + if (l + newcnt > WBOT && AL && DL) { + + vcnt = l; + + goto skip; + + } + + from = vcnt, to = vcnt + newcnt; + + i = TUBELINES - to; + + if (i < 0) + + from += i, to += i; + + vcnt = to; + + for (; from >= l; from--, to--) + + vlcopy(vlinfo[to], vlinfo[from]); + + for (from = to + 1, to = l; to < l + newcnt && to <= WBOT + 1; to++) { + + LINE(to) = LINE(from); + + DEPTH(to) = 0; + + FLAGS(to) = VDIRT; + + } + + } + + } + +skip: + + if (Pline == numbline && cnt != newcnt) + + /* + + * When lines positions are shifted, the numbers + + * will be wrong. + + */ + + vdirty(l, WECHO); + + if (!savenote) + + notecnt = 0; + +#ifdef ADEBUG + + if (trace) + + tvliny(); + +#endif + +} + + + +/* + + * Start harcopy open. + + * Print an image of the line to the left of the cursor + + * under the full print of the line and position the cursor. + + * If we are in a scroll ^D within hardcopy open then all this + + * is suppressed. + + */ + +sethard() + +{ + + + + if (state == VISUAL) + + return; + + rubble = 0; + + state = HARDOPEN; + + if (hold & HOLDROL) + + return; + + vup1(); + + LINE(0) = WBOT; + + if (Pline == numbline) + + vgoto(WBOT, 0), printf("%6d ", lineDOT()); + +} + + + +/* + + * Mark the lines starting at base for i lines + + * as dirty so that they will be checked for correct + + * display at next sync/redraw. + + */ + +vdirty(base, i) + + register int base, i; + +{ + + register int l; + + + + for (l = base; l < vcnt; l++) { + + if (--i < 0) + + return; + + FLAGS(l) |= VDIRT; + + } + +} diff --cc usr/src/cmd/ex/ex_vars.h index 0000000000,c3bd859427,0000000000..439739876c mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vars.h +++ b/usr/src/cmd/ex/ex_vars.h @@@@ -1,0 -1,37 -1,0 +1,43 @@@@ +++/* sccs id @(#)ex_vars.h 6.1 10/18/80 */ + +#define AUTOINDENT 0 + +#define AUTOPRINT 1 + +#define AUTOWRITE 2 + +#define BEAUTIFY 3 + +#define DIRECTORY 4 + +#define EDCOMPATIBLE 5 + +#define ERRORBELLS 6 + +#define HARDTABS 7 + +#define IGNORECASE 8 + +#define LISP 9 + +#define LIST 10 + +#define MAGIC 11 - #define MAPINPUT 12 +++#define MESG 12 + +#define NUMBER 13 + +#define OPEN 14 + +#define OPTIMIZE 15 + +#define PARAGRAPHS 16 + +#define PROMPT 17 - #define REDRAW 18 - #define REPORT 19 - #define SCROLL 20 - #define SECTIONS 21 - #define SHELL 22 - #define SHIFTWIDTH 23 - #define SHOWMATCH 24 - #define SLOWOPEN 25 - #define TABSTOP 26 - #define TTYTYPE 27 - #define TERM 28 - #define TERSE 29 - #define WARN 30 - #define WINDOW 31 - #define WRAPSCAN 32 - #define WRAPMARGIN 33 - #define WRITEANY 34 +++#define READONLY 18 +++#define REDRAW 19 +++#define REMAP 20 +++#define REPORT 21 +++#define SCROLL 22 +++#define SECTIONS 23 +++#define SHELL 24 +++#define SHIFTWIDTH 25 +++#define SHOWMATCH 26 +++#define SLOWOPEN 27 +++#define TABSTOP 28 +++#define TAGLENGTH 29 +++#define TAGS 30 +++#define TERM 31 +++#define TERSE 32 +++#define TIMEOUT 33 +++#define TTYTYPE 34 +++#define WARN 35 +++#define WINDOW 36 +++#define WRAPSCAN 37 +++#define WRAPMARGIN 38 +++#define WRITEANY 39 + + - #define NOPTS 35 +++#define NOPTS 40 diff --cc usr/src/cmd/ex/ex_vget.c index 0000000000,a4645a03e4,0000000000..3b5ebde1a5 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vget.c +++ b/usr/src/cmd/ex/ex_vget.c @@@@ -1,0 -1,546 -1,0 +1,660 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vget.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Input routines for open/visual. + + * We handle upper case only terminals in visual and reading from the + + * echo area here as well as notification on large changes + + * which appears in the echo area. + + */ + + + +/* + + * Return the key. + + */ + +ungetkey(c) + + char c; + +{ + + + + if (Peekkey != ATTN) + + Peekkey = c; + +} + + + +/* + + * Return a keystroke, but never a ^@. + + */ + +getkey() + +{ + + register char c; + + + + do { + + c = getbr(); + + if (c==0) + + beep(); + + } while (c == 0); + + return (c); + +} + + + +/* + + * Tell whether next keystroke would be a ^@. + + */ + +peekbr() + +{ + + + + Peekkey = getbr(); + + return (Peekkey == 0); + +} + + + +short precbksl; + + + +/* + + * Get a keystroke, including a ^@. + + * If an key was returned with ungetkey, that + + * comes back first. Next comes unread input (e.g. + + * from repeating commands with .), and finally new + + * keystrokes. + + * + + * The hard work here is in mapping of \ escaped + + * characters on upper case only terminals. + + */ + +getbr() + +{ + + char ch; + + register int c, d; + + register char *colp; +++#define BEEHIVE +++#ifdef BEEHIVE +++ static char Peek2key; +++#endif +++ extern short slevel, ttyindes; + + + +getATTN: + + if (Peekkey) { + + c = Peekkey; + + Peekkey = 0; + + return (c); + + } +++#ifdef BEEHIVE +++ if (Peek2key) { +++ c = Peek2key; +++ Peek2key = 0; +++ return (c); +++ } +++#endif + + if (vglobp) { + + if (*vglobp) + + return (lastvgk = *vglobp++); + + lastvgk = 0; + + return (ESCAPE); + + } + + if (vmacp) { + + if (*vmacp) + + return(*vmacp++); + + /* End of a macro or set of nested macros */ + + vmacp = 0; + + if (inopen == -1) /* don't screw up undo for esc esc */ + + vundkind = VMANY; + + inopen = 1; /* restore old setting now that macro done */ +++ vch_mac = VC_NOTINMAC; + + } - #ifdef TRACE - if (trace) - fflush(trace); - #endif + + flusho(); + +again: - if (read(0, &ch, 1) != 1) { +++ if (read(slevel == 0 ? 0 : ttyindes, &ch, 1) != 1) { + + if (errno == EINTR) + + goto getATTN; + + error("Input read error"); + + } + + c = ch & TRIM; +++#ifdef BEEHIVE +++ if (XB && slevel==0 && c == ESCAPE) { +++ if (read(0, &Peek2key, 1) != 1) +++ goto getATTN; +++ Peek2key &= TRIM; +++ switch (Peek2key) { +++ case 'C': /* SPOW mode sometimes sends \EC for space */ +++ c = ' '; +++ Peek2key = 0; +++ break; +++ case 'q': /* f2 -> ^C */ +++ c = CTRL(c); +++ Peek2key = 0; +++ break; +++ case 'p': /* f1 -> esc */ +++ Peek2key = 0; +++ break; +++ } +++ } +++#endif + + + +#ifdef UCVISUAL + + /* + + * The algorithm here is that of the UNIX kernel. + + * See the description in the programmers manual. + + */ + + if (UPPERCASE) { + + if (isupper(c)) + + c = tolower(c); + + if (c == '\\') { + + if (precbksl < 2) + + precbksl++; + + if (precbksl == 1) + + goto again; + + } else if (precbksl) { + + d = 0; + + if (islower(c)) + + d = toupper(c); + + else { + + colp = "({)}!|^~'~"; + + while (d = *colp++) + + if (d == c) { + + d = *colp++; + + break; + + } else + + colp++; + + } + + if (precbksl == 2) { + + if (!d) { + + Peekkey = c; + + precbksl = 0; + + c = '\\'; + + } + + } else if (d) + + c = d; + + else { + + Peekkey = c; + + precbksl = 0; + + c = '\\'; + + } + + } + + if (c != '\\') + + precbksl = 0; + + } + +#endif + +#ifdef TRACE + + if (trace) { + + if (!techoin) { + + tfixnl(); + + techoin = 1; + + fprintf(trace, "*** Input: "); + + } + + tracec(c); + + } + +#endif + + lastvgk = 0; + + return (c); + +} + + + +/* + + * Get a key, but if a delete, quit or attention + + * is typed return 0 so we will abort a partial command. + + */ + +getesc() + +{ + + register int c; + + + + c = getkey(); + + switch (c) { + + +++ case CTRL(v): +++ case CTRL(q): +++ c = getkey(); +++ return (c); +++ + + case ATTN: + + case QUIT: + + ungetkey(c); + + return (0); + + + + case ESCAPE: + + return (0); + + } + + return (c); + +} + + + +/* + + * Peek at the next keystroke. + + */ + +peekkey() + +{ + + + + Peekkey = getkey(); + + return (Peekkey); + +} + + + +/* + + * Read a line from the echo area, with single character prompt c. + + * A return value of 1 means the user blewit or blewit away. + + */ + +readecho(c) + + char c; + +{ + + register char *sc = cursor; + + register int (*OP)(); + + bool waste; + + register int OPeek; + + + + if (WBOT == WECHO) + + vclean(); + + else + + vclrech(0); + + splitw++; + + vgoto(WECHO, 0); + + putchar(c); + + vclreol(); + + vgoto(WECHO, 1); + + cursor = linebuf; linebuf[0] = 0; genbuf[0] = c; + + if (peekbr()) { + + if (!INS[0] || (INS[0] & (QUOTE|TRIM)) == OVERBUF) + + goto blewit; + + vglobp = INS; + + } + + OP = Pline; Pline = normline; - ignore(vgetline(0, genbuf + 1, &waste)); +++ ignore(vgetline(0, genbuf + 1, &waste, c)); +++ if (Outchar == termchar) +++ putchar('\n'); + + vscrap(); + + Pline = OP; + + if (Peekkey != ATTN && Peekkey != QUIT && Peekkey != CTRL(h)) { + + cursor = sc; + + vclreol(); + + return (0); + + } + +blewit: + + OPeek = Peekkey==CTRL(h) ? 0 : Peekkey; Peekkey = 0; + + splitw = 0; + + vclean(); + + vshow(dot, NOLINE); + + vnline(sc); + + Peekkey = OPeek; + + return (1); + +} + + + +/* + + * A complete command has been defined for + + * the purposes of repeat, so copy it from + + * the working to the previous command buffer. + + */ + +setLAST() + +{ + + - if (vglobp) +++ if (vglobp || vmacp) + + return; + + lastreg = vreg; + + lasthad = Xhadcnt; + + lastcnt = Xcnt; + + *lastcp = 0; + + CP(lastcmd, workcmd); + +} + + + +/* + + * Gather up some more text from an insert. + + * If the insertion buffer oveflows, then destroy + + * the repeatability of the insert. + + */ + +addtext(cp) + + char *cp; + +{ + + + + if (vglobp) + + return; + + addto(INS, cp); + + if ((INS[0] & (QUOTE|TRIM)) == OVERBUF) + + lastcmd[0] = 0; + +} + + + +setDEL() + +{ + + + + setBUF(DEL); + +} + + + +/* + + * Put text from cursor upto wcursor in BUF. + + */ + +setBUF(BUF) + + register char *BUF; + +{ + + register int c; + + register char *wp = wcursor; + + + + c = *wp; + + *wp = 0; + + BUF[0] = 0; + + addto(BUF, cursor); + + *wp = c; + +} + + + +addto(buf, str) + + register char *buf, *str; + +{ + + + + if ((buf[0] & (QUOTE|TRIM)) == OVERBUF) + + return; + + if (strlen(buf) + strlen(str) + 1 >= VBSIZE) { + + buf[0] = OVERBUF; + + return; + + } + + ignore(strcat(buf, str)); + +} + + + +/* + + * Note a change affecting a lot of lines, or non-visible + + * lines. If the parameter must is set, then we only want + + * to do this for open modes now; return and save for later + + * notification in visual. + + */ + +noteit(must) + + bool must; + +{ + + register int sdl = destline, sdc = destcol; + + + + if (notecnt < 2 || !must && state == VISUAL) + + return (0); + + splitw++; + + if (WBOT == WECHO) + + vmoveitup(1, 1); + + vigoto(WECHO, 0); + + printf("%d %sline", notecnt, notesgn); + + if (notecnt > 1) + + putchar('s'); + + if (*notenam) { + + printf(" %s", notenam); + + if (*(strend(notenam) - 1) != 'e') + + putchar('e'); + + putchar('d'); + + } + + vclreol(); + + notecnt = 0; + + if (state != VISUAL) + + vcnt = vcline = 0; + + splitw = 0; + + if (state == ONEOPEN || state == CRTOPEN) + + vup1(); + + destline = sdl; destcol = sdc; + + return (1); + +} + + + +/* + + * Rrrrringgggggg. + + * If possible, use flash (VB). + + */ + +beep() + +{ + + + + if (VB) + + vputp(VB, 0); + + else + + vputc(CTRL(g)); + +} + + + +/* + + * Map the command input character c, + + * for keypads and labelled keys which do cursor + + * motions. I.e. on an adm3a we might map ^K to ^P. + + * DM1520 for example has a lot of mappable characters. + + */ + + + +map(c,maps) + + register int c; + + register struct maps *maps; + +{ + + register int d; + + register char *p, *q; + + char b[10]; /* Assumption: no keypad sends string longer than 10 */ + + + + /* + + * Mapping for special keys on the terminal only. + + * BUG: if there's a long sequence and it matches + + * some chars and then misses, we lose some chars. + + * + + * For this to work, some conditions must be met. + + * 1) Keypad sends SHORT (2 or 3 char) strings + + * 2) All strings sent are same length & similar + + * 3) The user is unlikely to type the first few chars of + + * one of these strings very fast. + + * Note: some code has been fixed up since the above was laid out, + + * so conditions 1 & 2 are probably not required anymore. + + * However, this hasn't been tested with any first char + + * that means anything else except escape. + + */ + +#ifdef MDEBUG + + if (trace) + + fprintf(trace,"map(%c): ",c); + +#endif +++ /* +++ * If c==0, the char came from getesc typing escape. Pass it through +++ * unchanged. 0 messes up the following code anyway. +++ */ +++ if (c==0) +++ return(0); +++ + + b[0] = c; + + b[1] = 0; + + for (d=0; maps[d].mapto; d++) { + +#ifdef MDEBUG + + if (trace) - fprintf(trace,"d=%d, ",d); +++ fprintf(trace,"\ntry '%s', ",maps[d].cap); + +#endif + + if (p = maps[d].cap) { + + for (q=b; *p; p++, q++) { + +#ifdef MDEBUG + + if (trace) + + fprintf(trace,"q->b[%d], ",q-b); + +#endif + + if (*q==0) { + + /* +++ * Is there another char waiting? +++ * + + * This test is oversimplified, but + + * should work mostly. It handles the + + * case where we get an ESCAPE that + + * wasn't part of a keypad string. + + */ + + if ((c=='#' ? peekkey() : fastpeekkey()) == 0) { + +#ifdef MDEBUG - if (trace) - fprintf(trace,"fpk=0: return %c",c); +++ if (trace) +++ fprintf(trace,"fpk=0: return '%c'",c); + +#endif - macpush(&b[1],1); +++ /* +++ * Nothing waiting. Push back +++ * what we peeked at & return +++ * failure (c). +++ * +++ * We want to be able to undo +++ * commands, but it's nonsense +++ * to undo part of an insertion +++ * so if in input mode don't. +++ */ +++ macpush(&b[1],maps == arrows); + + return(c); + + } + + *q = getkey(); + + q[1] = 0; + + } + + if (*p != *q) + + goto contin; + + } - macpush(maps[d].mapto,1); +++ macpush(maps[d].mapto,maps == arrows); + + c = getkey(); + +#ifdef MDEBUG - if (trace) - fprintf(trace,"Success: return %c",c); +++ if (trace) +++ fprintf(trace,"Success: push(%s), return %c",maps[d].mapto, c); + +#endif + + return(c); /* first char of map string */ + + contin:; + + } + + } + +#ifdef MDEBUG + + if (trace) - fprintf(trace,"Fail: return %c",c); /* DEBUG */ +++ fprintf(trace,"Fail: push(%s), return %c", &b[1], c); + +#endif + + macpush(&b[1],0); + + return(c); + +} + + + +/* + + * Push st onto the front of vmacp. This is tricky because we have to + + * worry about where vmacp was previously pointing. We also have to + + * check for overflow (which is typically from a recursive macro) + + * Finally we have to set a flag so the whole thing can be undone. + + * canundo is 1 iff we want to be able to undo the macro. This + + * is false for, for example, pushing back lookahead from fastpeekkey(), + + * since otherwise two fast escapes can clobber our undo. + + */ + +macpush(st, canundo) + +char *st; + +int canundo; + +{ + + char tmpbuf[BUFSIZ]; + + + + if (st==0 || *st==0) + + return; +++#ifdef notdef +++ if (!value(UNDOMACRO)) +++ canundo = 0; +++#endif + +#ifdef TRACE + + if (trace) - fprintf(trace, "macpush(%s)",st); +++ fprintf(trace, "macpush(%s), canundo=%d\n",st,canundo); + +#endif - if (strlen(vmacp) + strlen(st) > BUFSIZ) +++ if ((vmacp ? strlen(vmacp) : 0) + strlen(st) > BUFSIZ) + + error("Macro too long@ - maybe recursive?"); + + if (vmacp) { + + strcpy(tmpbuf, vmacp); - canundo = 0; /* can't undo inside a macro anyway */ +++ if (!FIXUNDO) +++ canundo = 0; /* can't undo inside a macro anyway */ + + } + + strcpy(vmacbuf, st); + + if (vmacp) + + strcat(vmacbuf, tmpbuf); + + vmacp = vmacbuf; + + /* arrange to be able to undo the whole macro */ + + if (canundo) { - inopen = -1; /* no need to save since it had to be 1 or -1 before */ +++#ifdef notdef + + otchng = tchng; + + vsave(); + + saveall(); +++ inopen = -1; /* no need to save since it had to be 1 or -1 before */ + + vundkind = VMANY; +++#endif +++ vch_mac = VC_NOCHANGE; + + } +++} +++ + +#ifdef TRACE - if (trace) - fprintf(trace, "saveall for macro: undkind=%d, unddel=%d, undap1=%d, undap2=%d, dol=%d, unddol=%d, truedol=%d\n", undkind, lineno(unddel), lineno(undap1), lineno(undap2), lineno(dol), lineno(unddol), lineno(truedol)); - #endif +++visdump(s) +++char *s; +++{ +++ register int i; +++ +++ if (!trace) return; +++ +++ fprintf(trace, "\n%s: basWTOP=%d, basWLINES=%d, WTOP=%d, WBOT=%d, WLINES=%d, WCOLS=%d, WECHO=%d\n", +++ s, basWTOP, basWLINES, WTOP, WBOT, WLINES, WCOLS, WECHO); +++ fprintf(trace, " vcnt=%d, vcline=%d, cursor=%d, wcursor=%d, wdot=%d\n", +++ vcnt, vcline, cursor-linebuf, wcursor-linebuf, wdot-zero); +++ for (i=0; i= 0) { +++ signal(SIGALRM, trapalarm); +++ alarm(1); +++ } + + CATCH + + c = peekkey(); + +#ifdef MDEBUG + + if (trace) + + fprintf(trace,"[OK]",c); + +#endif + + alarm(0); + + ONERR + + c = 0; + +#ifdef MDEBUG + + if (trace) + + fprintf(trace,"[TOUT]",c); + +#endif + + ENDCATCH + +#ifdef MDEBUG + + if (trace) + + fprintf(trace,"[fpk:%o]",c); + +#endif + + return(c); + +} + + + +trapalarm() { + + alarm(0); + + longjmp(vreslab,1); + +} diff --cc usr/src/cmd/ex/ex_vis.h index 0000000000,9fac3bcfcb,0000000000..b401d39c6d mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vis.h +++ b/usr/src/cmd/ex/ex_vis.h @@@@ -1,0 -1,252 -1,0 +1,267 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++/* sccs id: @(#)ex_vis.h 6.1 10/18/80 */ + +/* - * Ex version 2 +++ * Ex version 3 + + * Mark Horton, UCB + + * Bill Joy UCB + + * + + * Open and visual mode definitions. + + * + + * There are actually 4 major states in open/visual modes. These + + * are visual, crt open (where the cursor can move about the screen and + + * the screen can scroll and be erased), one line open (on dumb glass-crt's + + * like the adm3), and hardcopy open (for everything else). + + * + + * The basic state is given by bastate, and the current state by state, + + * since we can be in pseudo-hardcopy mode if we are on an adm3 and the + + * line is longer than 80. + + */ + + + +short bastate; + +short state; + + + +#define VISUAL 0 + +#define CRTOPEN 1 + +#define ONEOPEN 2 + +#define HARDOPEN 3 + + + +/* + + * The screen in visual and crtopen is of varying size; the basic + + * window has top basWTOP and basWLINES lines are thereby implied. + + * The current window (which may have grown from the basic size) + + * has top WTOP and WLINES lines. The top line of the window is WTOP, + + * and the bottom line WBOT. The line WECHO is used for messages, + + * search strings and the like. If WBOT==WECHO then we are in ONEOPEN + + * or HARDOPEN and there is no way back to the line we were on if we + + * go to WECHO (i.e. we will have to scroll before we go there, and + + * we can't get back). There are WCOLS columns per line. + + * If WBOT!=WECHO then WECHO will be the last line on the screen + + * and WBOT is the line before it. + + */ + +short basWTOP; + +short basWLINES; + +short WTOP; + +short WBOT; + +short WLINES; + +short WCOLS; + +short WECHO; + + + +/* + + * When we are dealing with the echo area we consider the window + + * to be "split" and set the variable splitw. Otherwise, moving + + * off the bottom of the screen into WECHO causes a screen rollup. + + */ + +bool splitw; + + + +/* + + * Information about each line currently on the screen includes + + * the y coordinate associated with the line, the printing depth + + * of the line (0 indicates unknown), and a mask which indicates + + * whether the line is "unclean", i.e. whether we should check + + * to make sure the line is displayed correctly at the next + + * appropriate juncture. + + */ + +struct vlinfo { + + char vliny; /* Y coordinate */ + + char vdepth; /* Depth of displayed line */ + + short vflags; /* Is line potentially dirty ? */ + +} vlinfo[TUBELINES + 2]; + + + +#define DEPTH(c) (vlinfo[c].vdepth) + +#define LINE(c) (vlinfo[c].vliny) + +#define FLAGS(c) (vlinfo[c].vflags) + + + +#define VDIRT 1 + + + +/* + + * Hacks to copy vlinfo structures around + + */ + +#ifdef V6 + + /* Kludge to make up for no structure assignment */ + + struct { + + long longi; + + }; + +# define vlcopy(i, j) i.longi = j.longi + +#else + +# define vlcopy(i, j) i = j; + +#endif + + + +/* + + * The current line on the screen is represented by vcline. + + * There are vcnt lines on the screen, the last being "vcnt - 1". + + * Vcline is intimately tied to the current value of dot, + + * and when command mode is used as a subroutine fancy footwork occurs. + + */ + +short vcline; + +short vcnt; + + + +/* + + * To allow many optimizations on output, an exact image of the terminal + + * screen is maintained in the space addressed by vtube0. The vtube + + * array indexes this space as lines, and is shuffled on scrolls, insert+delete + + * lines and the like rather than (more expensively) shuffling the screen + + * data itself. It is also rearranged during insert mode across line + + * boundaries to make incore work easier. + + */ + +char *vtube[TUBELINES]; + +char *vtube0; + + + +/* + + * The current cursor position within the current line is kept in + + * cursor. The current line is kept in linebuf. During insertions + + * we use the auxiliary array genbuf as scratch area. + + * The cursor wcursor and wdot are used in operations within/spanning + + * lines to mark the other end of the affected area, or the target + + * for a motion. + + */ + +char *cursor; + +char *wcursor; + +line *wdot; + + + +/* + + * Undo information is saved in a LBSIZE buffer at "vutmp" for changes + + * within the current line, or as for command mode for multi-line changes + + * or changes on lines no longer the current line. + + * The change kind "VCAPU" is used immediately after a U undo to prevent + + * two successive U undo's from destroying the previous state. + + */ + +#define VNONE 0 + +#define VCHNG 1 + +#define VMANY 2 + +#define VCAPU 3 + +#define VMCHNG 4 + +#define VMANYINS 5 + + + +short vundkind; /* Which kind of undo - from above */ + +char *vutmp; /* Prev line image when "VCHNG" */ + + +++/* +++ * State information for undoing of macros. The basic idea is that +++ * if the macro does only 1 change or even none, we don't treat it +++ * specially. If it does 2 or more changes we want to be able to +++ * undo it as a unit. We remember how many changes have been made +++ * within the current macro. (Remember macros can be nested.) +++ */ +++#define VC_NOTINMAC 0 /* Not in a macro */ +++#define VC_NOCHANGE 1 /* In a macro, no changes so far */ +++#define VC_ONECHANGE 2 /* In a macro, one change so far */ +++#define VC_MANYCHANGE 3 /* In a macro, at least 2 changes so far */ +++ +++short vch_mac; /* Change state - one of the above */ +++ + +/* + + * For U undo's the line is grabbed by "vmove" after it first appears + + * on that line. The "vUNDdot" which specifies which line has been + + * saved is selectively cleared when changes involving other lines + + * are made, i.e. after a 'J' join. This is because a 'JU' would + + * lose completely the text of the line just joined on. + + */ + +char *vUNDcurs; /* Cursor just before 'U' */ + +line *vUNDdot; /* The line address of line saved in vUNDsav */ + +line vUNDsav; /* Grabbed initial "*dot" */ + + + +#define killU() vUNDdot = NOLINE + + + +/* + + * There are a number of cases where special behaviour is needed + + * from deeply nested routines. This is accomplished by setting + + * the bits of hold, which acts to change the state of the general + + * visual editing behaviour in specific ways. + + * + + * HOLDAT prevents the clreol (clear to end of line) routines from + + * putting out @'s or ~'s on empty lines. + + * + + * HOLDDOL prevents the reopen routine from putting a '$' at the + + * end of a reopened line in list mode (for hardcopy mode, e.g.). + + * + + * HOLDROL prevents spurious blank lines when scrolling in hardcopy + + * open mode. + + * + + * HOLDQIK prevents the fake insert mode during repeated commands. + + * + + * HOLDPUPD prevents updating of the physical screen image when + + * mucking around while in insert mode. + + * + + * HOLDECH prevents clearing of the echo area while rolling the screen + + * backwards (e.g.) in deference to the clearing of the area at the + + * end of the scroll (1 time instead of n times). The fact that this + + * is actually needed is recorded in heldech, which says that a clear + + * of the echo area was actually held off. + + */ + +short hold; + +short holdupd; /* Hold off update when echo line is too long */ + + + +#define HOLDAT 1 + +#define HOLDDOL 2 + +#define HOLDROL 4 + +#define HOLDQIK 8 + +#define HOLDPUPD 16 + +#define HOLDECH 32 + +#define HOLDWIG 64 + + + +/* + + * Miscellaneous variables + + */ + +short CDCNT; /* Count of ^D's in insert on this line */ + +char DEL[VBSIZE]; /* Last deleted text */ + +bool HADUP; /* This insert line started with ^ then ^D */ + +bool HADZERO; /* This insert line started with 0 then ^D */ + +char INS[VBSIZE]; /* Last inserted text */ + +int Vlines; /* Number of file lines "before" vi command */ + +int Xcnt; /* External variable holding last cmd's count */ + +bool Xhadcnt; /* Last command had explicit count? */ + +short ZERO; + +short dir; /* Direction for search (+1 or -1) */ + +short doomed; /* Disply chars right of cursor to be killed */ + +bool gobblebl; /* Wrapmargin space generated nl, eat a space */ + +bool hadcnt; /* (Almost) internal to vmain() */ + +bool heldech; /* We owe a clear of echo area */ + +bool insmode; /* Are in character insert mode */ + +char lastcmd[5]; /* Chars in last command */ + +int lastcnt; /* Count for last command */ + +char *lastcp; /* Save current command here to repeat */ + +bool lasthad; /* Last command had a count? */ + +short lastvgk; /* Previous input key, if not from keyboard */ + +short lastreg; /* Register with last command */ + +char *ncols['z'-'a'+2]; /* Cursor positions of marks */ + +char *notenam; /* Name to be noted with change count */ + +char *notesgn; /* Change count from last command */ + +char op; /* Operation of current command */ + +short Peekkey; /* Peek ahead key */ + +bool rubble; /* Line is filthy (in hardcopy open), redraw! */ + +int vSCROLL; /* Number lines to scroll on ^D/^U */ + +char *vglobp; /* Untyped input (e.g. repeat insert text) */ + +char vmacbuf[VBSIZE]; /* Text of visual macro, hence nonnestable */ + +char *vmacp; /* Like vglobp but for visual macros */ + +char *vmcurs; /* Cursor for restore after undo d), e.g. */ + +short vmovcol; /* Column to try to keep on arrow keys */ + +bool vmoving; /* Are trying to keep vmovcol */ + +char vreg; /* Register for this command */ + +short wdkind; /* Liberal/conservative words? */ + +char workcmd[5]; /* Temporary for lastcmd */ + + + + + +/* + + * Macros + + */ + +#define INF 30000 + +#define LASTLINE LINE(vcnt) + +#define OVERBUF QUOTE + +#define beep obeep + +#define cindent() ((outline - vlinfo[vcline].vliny) * WCOLS + outcol) + +#define vputp(cp, cnt) tputs(cp, cnt, vputch) + +#define vputc(c) putch(c) + + + +/* + + * Function types + + */ + +int beep(); + +int qcount(); + +int vchange(); + +int vdelete(); + +int vgrabit(); + +int vinschar(); + +int vmove(); + +int vputchar(); + +int vshift(); + +int vyankit(); diff --cc usr/src/cmd/ex/ex_vmain.c index 0000000000,e894dee246,0000000000..53dc857c10 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vmain.c +++ b/usr/src/cmd/ex/ex_vmain.c @@@@ -1,0 -1,1196 -1,0 +1,1288 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vmain.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * This is the main routine for visual. + + * We here decode the count and possible named buffer specification + + * preceding a command and interpret a few of the commands. + + * Commands which involve a target (i.e. an operator) are decoded + + * in the routine operate in ex_voperate.c. + + */ + + + +#define forbid(a) { if (a) goto fonfon; } + + + +vmain() + +{ + + register int c, cnt, i; + + char esave[TUBECOLS]; + + char *oglobp; + + char d; + + line *addr; - int ind; +++ int ind, nlput; +++ int shouldpo = 0; + + int onumber, olist, (*OPline)(), (*OPutchar)(); + + +++ vch_mac = VC_NOTINMAC; +++ + + /* + + * If we started as a vi command (on the command line) + + * then go process initial commands (recover, next or tag). + + */ + + if (initev) { + + oglobp = globp; + + globp = initev; + + hadcnt = cnt = 0; + + i = tchng; + + addr = dot; + + goto doinit; + + } + + + + /* + + * NB: + + * + + * The current line is always in the line buffer linebuf, + + * and the cursor at the position cursor. You should do + + * a vsave() before moving off the line to make sure the disk + + * copy is updated if it has changed, and a getDOT() to get + + * the line back if you mung linebuf. The motion + + * routines in ex_vwind.c handle most of this. + + */ + + for (;;) { + + /* + + * Decode a visual command. + + * First sync the temp file if there has been a reasonable + + * amount of change. Clear state for decoding of next + + * command. + + */ + + TSYNC(); + + vglobp = 0; + + vreg = 0; + + hold = 0; +++ seenprompt = 1; + + wcursor = 0; + + Xhadcnt = hadcnt = 0; + + Xcnt = cnt = 1; + + splitw = 0; + + if (i = holdupd) { + + if (state == VISUAL) + + ignore(peekkey()); + + holdupd = 0; + +/* + + if (LINE(0) < ZERO) { + + vclear(); + + vcnt = 0; + + i = 3; + + } + +*/ + + if (state != VISUAL) { + + vcnt = 0; + + vsave(); + + vrepaint(cursor); + + } else if (i == 3) + + vredraw(WTOP); + + else + + vsync(WTOP); + + vfixcurs(); + + } + + + + /* + + * Gobble up counts and named buffer specifications. + + */ + + for (;;) { + +looptop: + +#ifdef MDEBUG + + if (trace) + + fprintf(trace, "pc=%c",peekkey()); + +#endif + + if (isdigit(peekkey()) && peekkey() != '0') { + + hadcnt = 1; + + cnt = vgetcnt(); + + forbid (cnt <= 0); + + } + + if (peekkey() != '"') + + break; + + ignore(getkey()), c = getkey(); + + /* + + * Buffer names be letters or digits. + + * But not '0' as that is the source of + + * an 'empty' named buffer spec in the routine + + * kshift (see ex_temp.c). + + */ + + forbid (c == '0' || !isalpha(c) && !isdigit(c)); + + vreg = c; + + } + +reread: + + /* + + * Come to reread from below after some macro expansions. + + * The call to map allows use of function key pads + + * by performing a terminal dependent mapping of inputs. + + */ + +#ifdef MDEBUG + + if (trace) + + fprintf(trace,"pcb=%c,",peekkey()); + +#endif + + op = getkey(); +++ maphopcnt = 0; + + do { + + /* + + * Keep mapping the char as long as it changes. + + * This allows for double mappings, e.g., q to #, + + * #1 to something else. + + */ + + c = op; + + op = map(c,arrows); + +#ifdef MDEBUG + + if (trace) + + fprintf(trace,"pca=%c,",c); + +#endif + + /* + + * Maybe the mapped to char is a count. If so, we have + + * to go back to the "for" to interpret it. Likewise + + * for a buffer name. + + */ + + if ((isdigit(c) && c!='0') || c == '"') { + + ungetkey(c); + + goto looptop; + + } +++ if (!value(REMAP)) { +++ c = op; +++ break; +++ } +++ if (++maphopcnt > 256) +++ error("Infinite macro loop"); + + } while (c != op); + + + + /* + + * Begin to build an image of this command for possible + + * later repeat in the buffer workcmd. It will be copied + + * to lastcmd by the routine setLAST + + * if/when completely specified. + + */ + + lastcp = workcmd; + + if (!vglobp) + + *lastcp++ = c; + + + + /* + + * First level command decode. + + */ + + switch (c) { + + + + /* + + * ^L Clear screen e.g. after transmission error. + + */ - case CTRL(l): - vclear(); - vdirty(0, vcnt); - /* fall into... */ + + + + /* + + * ^R Retype screen, getting rid of @ lines. + + * If in open, equivalent to ^L. +++ * On terminals where the right arrow key sends +++ * ^L we make ^R act like ^L, since there is no +++ * way to get ^L. These terminals (adm31, tvi) +++ * are intelligent so ^R is useless. Soroc +++ * will probably foul this up, but nobody has +++ * one of them. + + */ +++ case CTRL(l): + + case CTRL(r): +++ if (c == CTRL(l) || (KR && *KR==CTRL(l))) { +++ vclear(); +++ vdirty(0, vcnt); +++ } + + if (state != VISUAL) { + + /* + + * Get a clean line, throw away the + + * memory of what is displayed now, + + * and move back onto the current line. + + */ + + vclean(); + + vcnt = 0; + + vmoveto(dot, cursor, 0); + + continue; + + } + + vredraw(WTOP); + + /* + + * Weird glitch -- when we enter visual + + * in a very small window we may end up with + + * no lines on the screen because the line + + * at the top is too long. This forces the screen + + * to be expanded to make room for it (after + + * we have printed @'s ick showing we goofed). + + */ + + if (vcnt == 0) + + vrepaint(cursor); + + vfixcurs(); + + continue; + + + + /* + + * $ Escape just cancels the current command + + * with a little feedback. + + */ + + case ESCAPE: + + beep(); + + continue; + + + + /* + + * @ Macros. Bring in the macro and put it + + * in vmacbuf, point vglobp there and punt. + + */ + + case '@': - c = getkey(); +++ c = getesc(); +++ if (c == 0) +++ continue; + + if (c == '@') + + c = lastmac; + + if (isupper(c)) + + c = tolower(c); + + forbid(!islower(c)); + + lastmac = c; + + vsave(); + + CATCH + + char tmpbuf[BUFSIZ]; + + + + regbuf(c,tmpbuf,sizeof(vmacbuf)); - macpush(tmpbuf); +++ macpush(tmpbuf, 1); + + ONERR + + lastmac = 0; + + splitw = 0; + + getDOT(); + + vrepaint(cursor); + + continue; + + ENDCATCH + + vmacp = vmacbuf; + + goto reread; + + + + /* + + * . Repeat the last (modifying) open/visual command. + + */ + + case '.': + + /* + + * Check that there was a last command, and + + * take its count and named buffer unless they + + * were given anew. Special case if last command + + * referenced a numeric named buffer -- increment + + * the number and go to a named buffer again. + + * This allows a sequence like "1pu.u.u... + + * to successively look for stuff in the kill chain + + * much as one does in EMACS with C-Y and M-Y. + + */ + + forbid (lastcmd[0] == 0); + + if (hadcnt) + + lastcnt = cnt; + + if (vreg) + + lastreg = vreg; + + else if (isdigit(lastreg) && lastreg < '9') + + lastreg++; + + vreg = lastreg; + + cnt = lastcnt; + + hadcnt = lasthad; + + vglobp = lastcmd; + + goto reread; + + + + /* + + * ^U Scroll up. A count sticks around for + + * future scrolls as the scroll amount. + + * Attempt to hold the indentation from the + + * top of the screen (in logical lines). + + * + + * BUG: A ^U near the bottom of the screen + + * on a dumb terminal (which can't roll back) + + * causes the screen to be cleared and then + + * redrawn almost as it was. In this case + + * one should simply move the cursor. + + */ + + case CTRL(u): + + if (hadcnt) + + vSCROLL = cnt; + + cnt = vSCROLL; + + if (state == VISUAL) + + ind = vcline, cnt += ind; + + else + + ind = 0; + + vmoving = 0; + + vup(cnt, ind, 1); + + vnline(NOSTR); + + continue; + + + + /* + + * ^D Scroll down. Like scroll up. + + */ + + case CTRL(d): +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "before vdown in ^D, dot=%d, wdot=%d, dol=%d\n", lineno(dot), lineno(wdot), lineno(dol)); +++#endif + + if (hadcnt) + + vSCROLL = cnt; + + cnt = vSCROLL; + + if (state == VISUAL) + + ind = vcnt - vcline - 1, cnt += ind; + + else + + ind = 0; + + vmoving = 0; + + vdown(cnt, ind, 1); +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "before vnline in ^D, dot=%d, wdot=%d, dol=%d\n", lineno(dot), lineno(wdot), lineno(dol)); +++#endif + + vnline(NOSTR); +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "after vnline in ^D, dot=%d, wdot=%d, dol=%d\n", lineno(dot), lineno(wdot), lineno(dol)); +++#endif + + continue; + + + + /* + + * ^E Glitch the screen down (one) line. + + * Cursor left on same line in file. + + */ + + case CTRL(e): + + if (state != VISUAL) + + continue; + + if (!hadcnt) + + cnt = 1; + + /* Bottom line of file already on screen */ + + forbid(lineDOL()-lineDOT() <= vcnt-1-vcline); + + ind = vcnt - vcline - 1 + cnt; + + vdown(ind, ind, 1); + + vnline(cursor); + + continue; + + + + /* + + * ^Y Like ^E but up + + */ + + case CTRL(y): + + if (state != VISUAL) + + continue; + + if (!hadcnt) + + cnt = 1; + + forbid(lineDOT()-1<=vcline); /* line 1 already there */ + + ind = vcline + cnt; + + vup(ind, ind, 1); + + vnline(cursor); + + continue; + + + + + + /* + + * m Mark position in mark register given + + * by following letter. Return is + + * accomplished via ' or `; former + + * to beginning of line where mark + + * was set, latter to column where marked. + + */ + + case 'm': + + /* + + * Getesc is generally used when a character + + * is read as a latter part of a command + + * to allow one to hit rubout/escape to cancel + + * what you have typed so far. These characters + + * are mapped to 0 by the subroutine. + + */ + + c = getesc(); + + if (c == 0) + + continue; + + + + /* + + * Markreg checks that argument is a letter + + * and also maps ' and ` to the end of the range + + * to allow '' or `` to reference the previous + + * context mark. + + */ + + c = markreg(c); + + forbid (c == 0); + + vsave(); + + names[c - 'a'] = (*dot &~ 01); + + ncols[c - 'a'] = cursor; + + anymarks = 1; + + continue; + + + + /* + + * ^F Window forwards, with 2 lines of continuity. - * Count gives new screen size. +++ * Count repeats. + + */ + + case CTRL(f): + + vsave(); - if (hadcnt) - vsetsiz(cnt); + + if (vcnt > 2) { - dot += (vcnt - vcline) - 2; +++ addr = dot + (vcnt - vcline) - 2 + (cnt-1)*basWLINES; +++ forbid(addr > dol); +++ dot = addr; + + vcnt = vcline = 0; + + } + + vzop(0, 0, '+'); + + continue; + + + + /* + + * ^B Window backwards, with 2 lines of continuity. + + * Inverse of ^F. + + */ + + case CTRL(b): + + vsave(); - if (hadcnt) - vsetsiz(cnt); + + if (one + vcline != dot && vcnt > 2) { - dot -= vcline - 2; +++ addr = dot - vcline - 2 + (cnt-1)*basWLINES; +++ forbid (addr <= zero); +++ dot = addr; + + vcnt = vcline = 0; + + } + + vzop(0, 0, '^'); + + continue; + + + + /* + + * z Screen adjustment, taking a following character: + + * z current line to top + + * z like z + + * z- current line to bottom + + * also z+, z^ like ^F and ^B. + + * A preceding count is line to use rather + + * than current line. A count between z and + + * specifier character changes the screen size + + * for the redraw. + + * + + */ + + case 'z': + + if (state == VISUAL) { + + i = vgetcnt(); + + if (i > 0) + + vsetsiz(i); + + c = getesc(); + + if (c == 0) + + continue; + + } + + vsave(); + + vzop(hadcnt, cnt, c); + + continue; + + + + /* + + * Y Yank lines, abbreviation for y_ or yy. + + * Yanked lines can be put later if no + + * changes intervene, or can be put in named + + * buffers and put anytime in this session. + + */ + + case 'Y': + + ungetkey('_'); + + c = 'y'; + + break; + + + + /* + + * J Join lines, 2 by default. Count is number + + * of lines to join (no join operator sorry.) + + */ + + case 'J': + + forbid (dot == dol); + + if (cnt == 1) + + cnt = 2; + + if (cnt > (i = dol - dot + 1)) + + cnt = i; + + vsave(); +++ vmacchng(1); + + setLAST(); + + cursor = strend(linebuf); + + vremote(cnt, join, 0); + + notenam = "join"; + + vmoving = 0; + + killU(); + + vreplace(vcline, cnt, 1); + + if (!*cursor && cursor > linebuf) + + cursor--; + + if (notecnt == 2) + + notecnt = 0; + + vrepaint(cursor); + + continue; + + + + /* + + * S Substitute text for whole lines, abbrev for c_. + + * Count is number of lines to change. + + */ + + case 'S': + + ungetkey('_'); + + c = 'c'; + + break; + + + + /* + + * O Create a new line above current and accept new + + * input text, to an escape, there. + + * A count specifies, for dumb terminals when + + * slowopen is not set, the number of physical + + * line space to open on the screen. + + * + + * o Like O, but opens lines below. + + */ + + case 'O': + + case 'o': +++ vmacchng(1); + + voOpen(c, cnt); + + continue; + + + + /* + + * C Change text to end of line, short for c$. + + */ + + case 'C': + + if (*cursor) { + + ungetkey('$'), c = 'c'; + + break; + + } + + goto appnd; + + + + /* + + * ~ Switch case of letter under cursor + + */ + + case '~': + + { + + char mbuf[4]; +++ setLAST(); + + mbuf[0] = 'r'; + + mbuf[1] = *cursor; + + mbuf[2] = cursor[1]==0 ? 0 : ' '; + + mbuf[3] = 0; + + if (isalpha(mbuf[1])) + + mbuf[1] ^= ' '; /* toggle the case */ - macpush(mbuf); +++ macpush(mbuf, 1); + + } + + continue; + + + + + + /* + + * A Append at end of line, short for $a. + + */ + + case 'A': + + operate('$', 1); + +appnd: + + c = 'a'; + + /* fall into ... */ + + + + /* + + * a Appends text after cursor. Text can continue + + * through arbitrary number of lines. + + */ + + case 'a': + + if (*cursor) { + + if (state == HARDOPEN) + + putchar(*cursor); + + cursor++; + + } + + goto insrt; + + + + /* + + * I Insert at beginning of whitespace of line, + + * short for ^i. + + */ + + case 'I': + + operate('^', 1); + + c = 'i'; + + /* fall into ... */ + + + + /* + + * R Replace characters, one for one, by input + + * (logically), like repeated r commands. + + * + + * BUG: This is like the typeover mode of many other + + * editors, and is only rarely useful. Its + + * implementation is a hack in a low level + + * routine and it doesn't work very well, e.g. + + * you can't move around within a R, etc. + + */ + + case 'R': + + /* fall into... */ + + + + /* + + * i Insert text to an escape in the buffer. + + * Text is arbitrary. This command reminds of + + * the i command in bare teco. + + */ + + case 'i': + +insrt: + + /* + + * Common code for all the insertion commands. + + * Save for redo, position cursor, prepare for append + + * at command and in visual undo. Note that nothing + + * is doomed, unless R when all is, and save the + + * current line in a the undo temporary buffer. + + */ +++ vmacchng(1); + + setLAST(); + + vcursat(cursor); + + prepapp(); + + vnoapp(); + + doomed = c == 'R' ? 10000 : 0; - vundkind = VCHNG; +++ if(FIXUNDO) +++ vundkind = VCHNG; +++ vmoving = 0; + + CP(vutmp, linebuf); + + + + /* + + * If this is a repeated command, then suppress + + * fake insert mode on dumb terminals which looks + + * ridiculous and wastes lots of time even at 9600B. + + */ + + if (vglobp) + + hold = HOLDQIK; + + vappend(c, cnt, 0); + + continue; + + + + /* + + * ^? An attention, normally a ^?, just beeps. + + * If you are a vi command within ex, then + + * two ATTN's will drop you back to command mode. + + */ + + case ATTN: + + beep(); + + if (initev || peekkey() != ATTN) + + continue; + + /* fall into... */ + + + + /* + + * ^\ A quit always gets command mode. + + */ + + case QUIT: + + /* + + * Have to be careful if we were called + + * g/xxx/vi + + * since a return will just start up again. + + * So we simulate an interrupt. + + */ + + if (inglobal) + + onintr(); + + /* fall into... */ + + +++#ifdef notdef + + /* + + * q Quit back to command mode, unless called as + + * vi on command line in which case dont do it + + */ + + case 'q': /* quit */ + + if (initev) { + + vsave(); + + CATCH + + error("Q gets ex command mode, :q leaves vi"); + + ENDCATCH + + splitw = 0; + + getDOT(); + + vrepaint(cursor); + + continue; + + } +++#endif + + /* fall into... */ + + + + /* + + * Q Is like q, but always gets to command mode + + * even if command line invocation was as vi. + + */ + + case 'Q': + + vsave(); +++ /* +++ * If we are in the middle of a macro, throw away +++ * the rest and fix up undo. +++ * This code copied from getbr(). +++ */ +++ if (vmacp) { +++ vmacp = 0; +++ if (inopen == -1) /* don't screw up undo for esc esc */ +++ vundkind = VMANY; +++ inopen = 1; /* restore old setting now that macro done */ +++ } + + return; + + +++ +++ /* +++ * ZZ Like :x +++ */ +++ case 'Z': +++ forbid(getkey() != 'Z'); +++ oglobp = globp; +++ globp = "x"; +++ vclrech(0); +++ goto gogo; +++ + + /* + + * P Put back text before cursor or before current + + * line. If text was whole lines goes back + + * as whole lines. If part of a single line + + * or parts of whole lines splits up current + + * line to form many new lines. + + * May specify a named buffer, or the delete + + * saving buffers 1-9. + + * + + * p Like P but after rather than before. + + */ + + case 'P': + + case 'p': + + vmoving = 0; - forbid (inopen < 0); +++#ifdef notdef +++ forbid (!vreg && value(UNDOMACRO) && inopen < 0); +++#endif + + /* + + * If previous delete was partial line, use an + + * append or insert to put it back so as to + + * use insert mode on intelligent terminals. + + */ + + if (!vreg && DEL[0]) { + + forbid ((DEL[0] & (QUOTE|TRIM)) == OVERBUF); + + vglobp = DEL; + + ungetkey(c == 'p' ? 'a' : 'i'); + + goto reread; + + } + + + + /* + + * If a register wasn't specified, then make + + * sure there is something to put back. + + */ + + forbid (!vreg && unddol == dol); +++ /* +++ * If we just did a macro the whole buffer is in +++ * the undo save area. We don't want to put THAT. +++ */ +++ forbid (vundkind == VMANY && undkind==UNDALL); + + vsave(); +++ vmacchng(1); + + setLAST(); + + i = 0; + + if (vreg && partreg(vreg) || !vreg && pkill[0]) { + + /* + + * Restoring multiple lines which were partial + + * lines; will leave cursor in middle + + * of line after shoving restored text in to + + * split the current line. + + */ + + i++; + + if (c == 'p' && *cursor) + + cursor++; + + } else { + + /* + + * In whole line case, have to back up dot + + * for P; also want to clear cursor so + + * cursor will eventually be positioned + + * at the beginning of the first put line. + + */ + + cursor = 0; + + if (c == 'P') { + + dot--, vcline--; + + c = 'p'; + + } + + } + + killU(); + + + + /* + + * The call to putreg can potentially + + * bomb since there may be nothing in a named buffer. + + * We thus put a catch in here. If we didn't and + + * there was an error we would end up in command mode. + + */ +++ addr = dol; /* old dol */ + + CATCH + + vremote(1, vreg ? putreg : put, vreg); + + ONERR + + if (vreg == -1) { + + splitw = 0; + + if (op == 'P') + + dot++, vcline++; + + goto pfixup; + + } + + ENDCATCH + + splitw = 0; +++ nlput = dol - addr + 1; + + if (!i) { + + /* + + * Increment undap1, undap2 to make up + + * for their incorrect initialization in the + + * routine vremote before calling put/putreg. + + */ - undap1++, undap2++; +++ if (FIXUNDO) +++ undap1++, undap2++; + + vcline++; - } +++ nlput--; + + - /* - * After a put want current line first line, - * and dot was made the last line put in code run - * so far. This is why we increment vcline above, - * and decrease (usually) dot here. - */ - dot = undap1; - vreplace(vcline, i, undap2 - undap1); +++ /* +++ * After a put want current line first line, +++ * and dot was made the last line put in code +++ * run so far. This is why we increment vcline +++ * above and decrease dot here. +++ */ +++ dot -= nlput - 1; +++ } +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "vreplace(%d, %d, %d), undap1=%d, undap2=%d, dot=%d\n", vcline, i, nlput, lineno(undap1), lineno(undap2), lineno(dot)); +++#endif +++ vreplace(vcline, i, nlput); + + if (state != VISUAL) { + + /* + + * Special case in open mode. + + * Force action on the screen when a single + + * line is put even if it is identical to + + * the current line, e.g. on YP; otherwise + + * you can't tell anything happened. + + */ + + vjumpto(dot, cursor, '.'); + + continue; + + } + +pfixup: + + vrepaint(cursor); + + vfixcurs(); + + continue; + + + + /* - * ^^ Return to previous context. Like a 't - * if that mark is set since tag sets that - * mark if it stays in same file. Else - * like a :e #, and thus can be used after a +++ * ^^ Return to previous file. +++ * Like a :e #, and thus can be used after a + + * "No Write" diagnostic. - * - * Note: this doesn't correspond with documentation - * Is this comment misleading? + + */ + + case CTRL(^): - if (hadcnt) - vsetsiz(cnt); - addr = getmark('t'); - if (addr != 0) { - markit(addr); - vupdown(addr - dot, NOSTR); - continue; - } +++ forbid (hadcnt); + + vsave(); + + ckaw(); + + oglobp = globp; + + if (value(AUTOWRITE)) + + globp = "e! #"; + + else + + globp = "e #"; + + goto gogo; + + + + /* + + * ^] Takes word after cursor as tag, and then does + + * tag command. Read ``go right to''. + + */ + + case CTRL(]): + + grabtag(); + + oglobp = globp; + + globp = "tag"; + + goto gogo; + + + + /* + + * & Like :& + + */ + + case '&': + + oglobp = globp; + + globp = "&"; + + goto gogo; + + + + /* + + * ^G Bring up a status line at the bottom of + + * the screen, like a :file command. + + * + + * BUG: Was ^S but doesn't work in cbreak mode + + */ + + case CTRL(g): + + oglobp = globp; + + globp = "file"; + +gogo: + + addr = dot; + + vsave(); + + goto doinit; + + +++#ifdef SIGTSTP +++ /* +++ * ^Z: suspend editor session and temporarily return +++ * to shell. Only works with Berkeley/IIASA process +++ * control in kernel. +++ */ +++ case CTRL(z): +++ forbid(dosusp == 0 || !ldisc); +++ vsave(); +++ oglobp = globp; +++ globp = "stop"; +++ goto gogo; +++#endif +++ + + /* + + * : Read a command from the echo area and + + * execute it in command mode. + + */ + + case ':': - if (hadcnt) - vsetsiz(cnt); +++ forbid (hadcnt); + + vsave(); + + i = tchng; + + addr = dot; + + if (readecho(c)) { + + esave[0] = 0; + + goto fixup; + + } +++ getDOT(); + + /* + + * Use the visual undo buffer to store the global + + * string for command mode, since it is idle right now. + + */ + + oglobp = globp; strcpy(vutmp, genbuf+1); globp = vutmp; + +doinit: + + esave[0] = 0; + + fixech(); + + + + /* + + * Have to finagle around not to lose last + + * character after this command (when run from ex + + * command mode). This is clumsy. + + */ + + d = peekc; ungetchar(0); +++ if (shouldpo) { +++ /* +++ * So after a "Hit return..." ":", we do +++ * another "Hit return..." the next time +++ */ +++ pofix(); +++ shouldpo = 0; +++ } + + CATCH + + /* + + * Save old values of options so we can + + * notice when they change; switch into + + * cooked mode so we are interruptible. + + */ + + onumber = value(NUMBER); + + olist = value(LIST); + + OPline = Pline; + + OPutchar = Putchar; + +#ifndef CBREAK + + vcook(); + +#endif + + commands(1, 1); + + if (dot == zero && dol > zero) + + dot = one; + +#ifndef CBREAK + + vraw(); + +#endif + + ONERR + +#ifndef CBREAK + + vraw(); + +#endif + + copy(esave, vtube[WECHO], TUBECOLS); + + ENDCATCH + + fixol(); + + Pline = OPline; + + Putchar = OPutchar; + + ungetchar(d); + + globp = oglobp; + + + + /* + + * If we ended up with no lines in the buffer, make + + * a line, and don't consider the buffer changed. + + */ + + if (dot == zero) { + + fixzero(); + + sync(); + + } + + splitw = 0; + + + + /* + + * Special case: did list/number options change? + + */ + + if (onumber != value(NUMBER)) + + setnumb(value(NUMBER)); + + if (olist != value(LIST)) + + setlist(value(LIST)); + + + +fixup: + + /* + + * If a change occurred, other than + + * a write which clears changes, then + + * we should allow an undo even if . + + * didn't move. + + * + + * BUG: You can make this wrong by + + * tricking around with multiple commands + + * on one line of : escape, and including + + * a write command there, but its not + + * worth worrying about. + + */ - if (tchng && tchng != i) +++ if (FIXUNDO && tchng && tchng != i) + + vundkind = VMANY, cursor = 0; + + + + /* + + * If we are about to do another :, hold off + + * updating of screen. + + */ + + if (vcnt < 0 && Peekkey == ':') { + + getDOT(); +++ shouldpo = 1; + + continue; + + } +++ shouldpo = 0; + + + + /* + + * In the case where the file being edited is + + * new; e.g. if the initial state hasn't been + + * saved yet, then do so now. + + */ + + if (unddol == truedol) { + + vundkind = VNONE; + + Vlines = lineDOL(); + + if (!inglobal) + + savevis(); + + addr = zero; + + vcnt = 0; + + if (esave[0] == 0) + + copy(esave, vtube[WECHO], TUBECOLS); + + } + + + + /* + + * If the current line moved reset the cursor position. + + */ + + if (dot != addr) { + + vmoving = 0; + + cursor = 0; + + } + + + + /* + + * If current line is not on screen or if we are + + * in open mode and . moved, then redraw. + + */ + + i = vcline + (dot - addr); + + if (i < 0 || i >= vcnt && i >= -vcnt || state != VISUAL && dot != addr) { + + if (state == CRTOPEN) + + vup1(); + + if (vcnt > 0) + + vcnt = 0; + + vjumpto(dot, (char *) 0, '.'); + + } else { + + /* + + * Current line IS on screen. + + * If we did a [Hit return...] then + + * restore vcnt and clear screen if in visual + + */ + + vcline = i; + + if (vcnt < 0) { + + vcnt = -vcnt; + + if (state == VISUAL) + + vclear(); - else if (state == CRTOPEN) +++ else if (state == CRTOPEN) { + + vcnt = 0; +++ } + + } + + + + /* + + * Limit max value of vcnt based on $ + + */ + + i = vcline + lineDOL() - lineDOT() + 1; + + if (i < vcnt) + + vcnt = i; + + + + /* + + * Dirty and repaint. + + */ + + vdirty(0, LINES); + + vrepaint(cursor); + + } + + + + /* + + * If in visual, put back the echo area + + * if it was clobberred. + + */ + + if (state == VISUAL) { + + int sdc = destcol, sdl = destline; + + + + splitw++; + + vigoto(WECHO, 0); + + for (i = 0; i < TUBECOLS - 1; i++) { + + if (esave[i] == 0) + + break; + + vputchar(esave[i]); + + } + + splitw = 0; + + vgoto(sdl, sdc); + + } + + continue; + + + + /* + + * u undo the last changing command. + + */ + + case 'u': - vundo(); +++ vundo(1); + + continue; + + + + /* + + * U restore current line to initial state. + + */ + + case 'U': + + vUndo(); + + continue; + + + +fonfon: + + beep(); + + vmacp = 0; + + inopen = 1; /* might have been -1 */ + + continue; + + } + + + + /* + + * Rest of commands are decoded by the operate + + * routine. + + */ + + operate(c, cnt); + + } + +} + + + +/* + + * Grab the word after the cursor so we can look for it as a tag. + + */ + +grabtag() + +{ + + register char *cp, *dp; + + + + cp = vpastwh(cursor); + + if (*cp) { + + dp = lasttag; + + do { + + if (dp < &lasttag[sizeof lasttag - 2]) + + *dp++ = *cp; + + cp++; + + } while (isalpha(*cp) || isdigit(*cp) || *cp == '_'); + + *dp++ = 0; + + } + +} + + + +/* + + * Before appending lines, set up addr1 and + + * the command mode undo information. + + */ + +prepapp() + +{ + + + + addr1 = dot; + + deletenone(); + + addr1++; + + appendnone(); + +} + + + +/* + + * Execute function f with the address bounds addr1 + + * and addr2 surrounding cnt lines starting at dot. + + */ + +vremote(cnt, f, arg) + + int cnt, (*f)(), arg; + +{ + + register int oing = inglobal; + + + + addr1 = dot; + + addr2 = dot + cnt - 1; - if (inopen > 0) - undap1 = undap2 = dot; + + inglobal = 0; +++ if (FIXUNDO) +++ undap1 = undap2 = dot; + + (*f)(arg); + + inglobal = oing; - if (inopen > 0) +++ if (FIXUNDO) + + vundkind = VMANY; + + vmcurs = 0; + +} + + + +/* + + * Save the current contents of linebuf, if it has changed. + + */ + +vsave() + +{ + + char temp[LBSIZE]; + + + + CP(temp, linebuf); - if (vundkind == VCHNG || vundkind == VCAPU) { +++ if (FIXUNDO && vundkind == VCHNG || vundkind == VCAPU) { + + /* + + * If the undo state is saved in the temporary buffer + + * vutmp, then we sync this into the temp file so that + + * we will be able to undo even after we have moved off + + * the line. It would be possible to associate a line + + * with vutmp but we assume that vutmp is only associated + + * with line dot (e.g. in case ':') above, so beware. + + */ + + prepapp(); + + strcLIN(vutmp); + + putmark(dot); + + vremote(1, yank, 0); + + vundkind = VMCHNG; + + notecnt = 0; + + undkind = UNDCHANGE; + + } + + /* + + * Get the line out of the temp file and do nothing if it hasn't + + * changed. This may seem like a loss, but the line will + + * almost always be in a read buffer so this may well avoid disk i/o. + + */ + + getDOT(); + + if (strcmp(linebuf, temp) == 0) + + return; + + strcLIN(temp); + + putmark(dot); + +} + + + +#undef forbid + +#define forbid(a) if (a) { beep(); return; } + + + +/* + + * Do a z operation. + + * Code here is rather long, and very uninteresting. + + */ + +vzop(hadcnt, cnt, c) + + bool hadcnt; + + int cnt; + + register int c; + +{ + + register line *addr; + + + + if (state != VISUAL) { + + /* + + * Z from open; always like a z=. + + * This code is a mess and should be cleaned up. + + */ + + vmoveitup(1, 1); + + vgoto(outline, 0); + + ostop(normf); + + setoutt(); + + addr2 = dot; + + vclear(); + + destline = WECHO; + + zop2(Xhadcnt ? Xcnt : value(WINDOW) - 1, '='); + + if (state == CRTOPEN) + + putnl(); + + putNFL(); + + termreset(); + + Outchar = vputchar; + + ignore(ostart()); + + vcnt = 0; + + outline = destline = 0; + + vjumpto(dot, cursor, 0); + + return; + + } + + if (hadcnt) { + + addr = zero + cnt; + + if (addr < one) + + addr = one; + + if (addr > dol) + + addr = dol; + + markit(addr); + + } else + + switch (c) { + + + + case '+': + + addr = dot + vcnt - vcline; + + break; + + + + case '^': + + addr = dot - vcline - 1; + + forbid (addr < one); + + c = '-'; + + break; + + + + default: + + addr = dot; + + break; + + } + + switch (c) { + + + + case '.': + + case '-': + + break; + + + + case '^': + + forbid (addr <= one); + + break; + + + + case '+': + + forbid (addr >= dol); + + /* fall into ... */ + + + + case CR: + + case NL: + + c = CR; + + break; + + + + default: + + beep(); + + return; + + } + + vmoving = 0; + + vjumpto(addr, NOSTR, c); + +} diff --cc usr/src/cmd/ex/ex_voper.c index 0000000000,0000000000,0000000000..1f31488e7b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/ex/ex_voper.c @@@@ -1,0 -1,0 -1,0 +1,855 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_voper.c 6.2 10/23/80"; +++#include "ex.h" +++#include "ex_tty.h" +++#include "ex_vis.h" +++ +++#define blank() isspace(wcursor[0]) +++#define forbid(a) if (a) goto errlab; +++ +++char vscandir[2] = { '/', 0 }; +++ +++/* +++ * Decode an operator/operand type command. +++ * Eventually we switch to an operator subroutine in ex_vops.c. +++ * The work here is setting up a function variable to point +++ * to the routine we want, and manipulation of the variables +++ * wcursor and wdot, which mark the other end of the affected +++ * area. If wdot is zero, then the current line is the other end, +++ * and if wcursor is zero, then the first non-blank location of the +++ * other line is implied. +++ */ +++operate(c, cnt) +++ register int c, cnt; +++{ +++ register int i; +++ int (*moveop)(), (*deleteop)(); +++ register int (*opf)(); +++ bool subop = 0; +++ char *oglobp, *ocurs; +++ register line *addr; +++ line *odot; +++ static char lastFKND, lastFCHR; +++ char d; +++ +++ moveop = vmove, deleteop = vdelete; +++ wcursor = cursor; +++ wdot = NOLINE; +++ notecnt = 0; +++ dir = 1; +++ switch (c) { +++ +++ /* +++ * d delete operator. +++ */ +++ case 'd': +++ moveop = vdelete; +++ deleteop = beep; +++ break; +++ +++ /* +++ * s substitute characters, like c\040, i.e. change space. +++ */ +++ case 's': +++ ungetkey(' '); +++ subop++; +++ /* fall into ... */ +++ +++ /* +++ * c Change operator. +++ */ +++ case 'c': +++ if (c == 'c' && workcmd[0] == 'C' || workcmd[0] == 'S') +++ subop++; +++ moveop = vchange; +++ deleteop = beep; +++ break; +++ +++ /* +++ * ! Filter through a UNIX command. +++ */ +++ case '!': +++ moveop = vfilter; +++ deleteop = beep; +++ break; +++ +++ /* +++ * y Yank operator. Place specified text so that it +++ * can be put back with p/P. Also yanks to named buffers. +++ */ +++ case 'y': +++ moveop = vyankit; +++ deleteop = beep; +++ break; +++ +++ /* +++ * = Reformat operator (for LISP). +++ */ +++#ifdef LISPCODE +++ case '=': +++ forbid(!value(LISP)); +++ /* fall into ... */ +++#endif +++ +++ /* +++ * > Right shift operator. +++ * < Left shift operator. +++ */ +++ case '<': +++ case '>': +++ moveop = vshftop; +++ deleteop = beep; +++ break; +++ +++ /* +++ * r Replace character under cursor with single following +++ * character. +++ */ +++ case 'r': +++ vmacchng(1); +++ vrep(cnt); +++ return; +++ +++ default: +++ goto nocount; +++ } +++ vmacchng(1); +++ /* +++ * Had an operator, so accept another count. +++ * Multiply counts together. +++ */ +++ if (isdigit(peekkey()) && peekkey() != '0') { +++ cnt *= vgetcnt(); +++ Xcnt = cnt; +++ forbid (cnt <= 0); +++ } +++ +++ /* +++ * Get next character, mapping it and saving as +++ * part of command for repeat. +++ */ +++ c = map(getesc(),arrows); +++ if (c == 0) +++ return; +++ if (!subop) +++ *lastcp++ = c; +++nocount: +++ opf = moveop; +++ switch (c) { +++ +++ /* +++ * b Back up a word. +++ * B Back up a word, liberal definition. +++ */ +++ case 'b': +++ case 'B': +++ dir = -1; +++ /* fall into ... */ +++ +++ /* +++ * w Forward a word. +++ * W Forward a word, liberal definition. +++ */ +++ case 'W': +++ case 'w': +++ wdkind = c & ' '; +++ forbid(lfind(2, cnt, opf, 0) < 0); +++ vmoving = 0; +++ break; +++ +++ /* +++ * E to end of following blank/nonblank word +++ */ +++ case 'E': +++ wdkind = 0; +++ goto ein; +++ +++ /* +++ * e To end of following word. +++ */ +++ case 'e': +++ wdkind = 1; +++ein: +++ forbid(lfind(3, cnt - 1, opf, 0) < 0); +++ vmoving = 0; +++ break; +++ +++ /* +++ * ( Back an s-expression. +++ */ +++ case '(': +++ dir = -1; +++ /* fall into... */ +++ +++ /* +++ * ) Forward an s-expression. +++ */ +++ case ')': +++ forbid(lfind(0, cnt, opf, (line *) 0) < 0); +++ markDOT(); +++ break; +++ +++ /* +++ * { Back an s-expression, but don't stop on atoms. +++ * In text mode, a paragraph. For C, a balanced set +++ * of {}'s. +++ */ +++ case '{': +++ dir = -1; +++ /* fall into... */ +++ +++ /* +++ * } Forward an s-expression, but don't stop on atoms. +++ * In text mode, back paragraph. For C, back a balanced +++ * set of {}'s. +++ */ +++ case '}': +++ forbid(lfind(1, cnt, opf, (line *) 0) < 0); +++ markDOT(); +++ break; +++ +++ /* +++ * % To matching () or {}. If not at ( or { scan for +++ * first such after cursor on this line. +++ */ +++ case '%': +++ vsave(); +++ i = lmatchp((line *) 0); +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "after lmatchp in %, dot=%d, wdot=%d, dol=%d\n", lineno(dot), lineno(wdot), lineno(dol)); +++#endif +++ getDOT(); +++ forbid(!i); +++ if (opf != vmove) +++ if (dir > 0) +++ wcursor++; +++ else +++ cursor++; +++ else +++ markDOT(); +++ vmoving = 0; +++ break; +++ +++ /* +++ * [ Back to beginning of defun, i.e. an ( in column 1. +++ * For text, back to a section macro. +++ * For C, back to a { in column 1 (~~ beg of function.) +++ */ +++ case '[': +++ dir = -1; +++ /* fall into ... */ +++ +++ /* +++ * ] Forward to next defun, i.e. a ( in column 1. +++ * For text, forward section. +++ * For C, forward to a } in column 1 (if delete or such) +++ * or if a move to a { in column 1. +++ */ +++ case ']': +++ if (!vglobp) +++ forbid(getkey() != c); +++ forbid (Xhadcnt); +++ vsave(); +++ i = lbrack(c, opf); +++ getDOT(); +++ forbid(!i); +++ markDOT(); +++ if (ospeed > B300) +++ hold |= HOLDWIG; +++ break; +++ +++ /* +++ * , Invert last find with f F t or T, like inverse +++ * of ;. +++ */ +++ case ',': +++ forbid (lastFKND == 0); +++ c = isupper(lastFKND) ? tolower(lastFKND) : toupper(lastFKND); +++ i = lastFCHR; +++ if (vglobp == 0) +++ vglobp = ""; +++ subop++; +++ goto nocount; +++ +++ /* +++ * 0 To beginning of real line. +++ */ +++ case '0': +++ wcursor = linebuf; +++ vmoving = 0; +++ break; +++ +++ /* +++ * ; Repeat last find with f F t or T. +++ */ +++ case ';': +++ forbid (lastFKND == 0); +++ c = lastFKND; +++ i = lastFCHR; +++ subop++; +++ goto nocount; +++ +++ /* +++ * F Find single character before cursor in current line. +++ * T Like F, but stops before character. +++ */ +++ case 'F': /* inverted find */ +++ case 'T': +++ dir = -1; +++ /* fall into ... */ +++ +++ /* +++ * f Find single character following cursor in current line. +++ * t Like f, but stope before character. +++ */ +++ case 'f': /* find */ +++ case 't': +++ if (!subop) { +++ i = getesc(); +++ if (i == 0) +++ return; +++ *lastcp++ = i; +++ } +++ if (vglobp == 0) +++ lastFKND = c, lastFCHR = i; +++ for (; cnt > 0; cnt--) +++ forbid (find(i) == 0); +++ vmoving = 0; +++ switch (c) { +++ +++ case 'T': +++ wcursor++; +++ break; +++ +++ case 't': +++ wcursor--; +++ case 'f': +++fixup: +++ if (moveop != vmove) +++ wcursor++; +++ break; +++ } +++ break; +++ +++ /* +++ * | Find specified print column in current line. +++ */ +++ case '|': +++ if (Pline == numbline) +++ cnt += 8; +++ vmovcol = cnt; +++ vmoving = 1; +++ wcursor = vfindcol(cnt); +++ break; +++ +++ /* +++ * ^ To beginning of non-white space on line. +++ */ +++ case '^': +++ wcursor = vskipwh(linebuf); +++ vmoving = 0; +++ break; +++ +++ /* +++ * $ To end of line. +++ */ +++ case '$': +++ if (opf == vmove) { +++ vmoving = 1; +++ vmovcol = 20000; +++ } else +++ vmoving = 0; +++ if (cnt > 1) { +++ if (opf == vmove) { +++ wcursor = 0; +++ cnt--; +++ } else +++ wcursor = linebuf; +++ /* This is wrong at EOF */ +++ wdot = dot + cnt; +++ break; +++ } +++ if (linebuf[0]) { +++ wcursor = strend(linebuf) - 1; +++ goto fixup; +++ } +++ wcursor = linebuf; +++ break; +++ +++ /* +++ * h Back a character. +++ * ^H Back a character. +++ */ +++ case 'h': +++ case CTRL(h): +++ dir = -1; +++ /* fall into ... */ +++ +++ /* +++ * space Forward a character. +++ */ +++ case 'l': +++ case ' ': +++ forbid (margin() || opf == vmove && edge()); +++ while (cnt > 0 && !margin()) +++ wcursor += dir, cnt--; +++ if (margin() && opf == vmove || wcursor < linebuf) +++ wcursor -= dir; +++ vmoving = 0; +++ break; +++ +++ /* +++ * D Delete to end of line, short for d$. +++ */ +++ case 'D': +++ cnt = INF; +++ goto deleteit; +++ +++ /* +++ * X Delete character before cursor. +++ */ +++ case 'X': +++ dir = -1; +++ /* fall into ... */ +++deleteit: +++ /* +++ * x Delete character at cursor, leaving cursor where it is. +++ */ +++ case 'x': +++ if (margin()) +++ goto errlab; +++ vmacchng(1); +++ while (cnt > 0 && !margin()) +++ wcursor += dir, cnt--; +++ opf = deleteop; +++ vmoving = 0; +++ break; +++ +++ default: +++ /* +++ * Stuttered operators are equivalent to the operator on +++ * a line, thus turn dd into d_. +++ */ +++ if (opf == vmove || c != workcmd[0]) { +++errlab: +++ beep(); +++ vmacp = 0; +++ return; +++ } +++ /* fall into ... */ +++ +++ /* +++ * _ Target for a line or group of lines. +++ * Stuttering is more convenient; this is mostly +++ * for aesthetics. +++ */ +++ case '_': +++ wdot = dot + cnt - 1; +++ vmoving = 0; +++ wcursor = 0; +++ break; +++ +++ /* +++ * H To first, home line on screen. +++ * Count is for count'th line rather than first. +++ */ +++ case 'H': +++ wdot = (dot - vcline) + cnt - 1; +++ if (opf == vmove) +++ markit(wdot); +++ vmoving = 0; +++ wcursor = 0; +++ break; +++ +++ /* +++ * - Backwards lines, to first non-white character. +++ */ +++ case '-': +++ wdot = dot - cnt; +++ vmoving = 0; +++ wcursor = 0; +++ break; +++ +++ /* +++ * ^P To previous line same column. Ridiculous on the +++ * console of the VAX since it puts console in LSI mode. +++ */ +++ case 'k': +++ case CTRL(p): +++ wdot = dot - cnt; +++ if (vmoving == 0) +++ vmoving = 1, vmovcol = column(cursor); +++ wcursor = 0; +++ break; +++ +++ /* +++ * L To last line on screen, or count'th line from the +++ * bottom. +++ */ +++ case 'L': +++ wdot = dot + vcnt - vcline - cnt; +++ if (opf == vmove) +++ markit(wdot); +++ vmoving = 0; +++ wcursor = 0; +++ break; +++ +++ /* +++ * M To the middle of the screen. +++ */ +++ case 'M': +++ wdot = dot + ((vcnt + 1) / 2) - vcline - 1; +++ if (opf == vmove) +++ markit(wdot); +++ vmoving = 0; +++ wcursor = 0; +++ break; +++ +++ /* +++ * + Forward line, to first non-white. +++ * +++ * CR Convenient synonym for +. +++ */ +++ case '+': +++ case CR: +++ wdot = dot + cnt; +++ vmoving = 0; +++ wcursor = 0; +++ break; +++ +++ /* +++ * ^N To next line, same column if possible. +++ * +++ * LF Linefeed is a convenient synonym for ^N. +++ */ +++ case CTRL(n): +++ case 'j': +++ case NL: +++ wdot = dot + cnt; +++ if (vmoving == 0) +++ vmoving = 1, vmovcol = column(cursor); +++ wcursor = 0; +++ break; +++ +++ /* +++ * n Search to next match of current pattern. +++ */ +++ case 'n': +++ vglobp = vscandir; +++ c = *vglobp++; +++ goto nocount; +++ +++ /* +++ * N Like n but in reverse direction. +++ */ +++ case 'N': +++ vglobp = vscandir[0] == '/' ? "?" : "/"; +++ c = *vglobp++; +++ goto nocount; +++ +++ /* +++ * ' Return to line specified by following mark, +++ * first white position on line. +++ * +++ * ` Return to marked line at remembered column. +++ */ +++ case '\'': +++ case '`': +++ d = c; +++ c = getesc(); +++ if (c == 0) +++ return; +++ c = markreg(c); +++ forbid (c == 0); +++ wdot = getmark(c); +++ forbid (wdot == NOLINE); +++ forbid (Xhadcnt); +++ vmoving = 0; +++ wcursor = d == '`' ? ncols[c - 'a'] : 0; +++ if (opf == vmove && (wdot != dot || (d == '`' && wcursor != cursor))) +++ markDOT(); +++ if (wcursor) { +++ vsave(); +++ getline(*wdot); +++ if (wcursor > strend(linebuf)) +++ wcursor = 0; +++ getDOT(); +++ } +++ if (ospeed > B300) +++ hold |= HOLDWIG; +++ break; +++ +++ /* +++ * G Goto count'th line, or last line if no count +++ * given. +++ */ +++ case 'G': +++ if (!Xhadcnt) +++ cnt = lineDOL(); +++ wdot = zero + cnt; +++ forbid (wdot < one || wdot > dol); +++ if (opf == vmove) +++ markit(wdot); +++ vmoving = 0; +++ wcursor = 0; +++ break; +++ +++ /* +++ * / Scan forward for following re. +++ * ? Scan backward for following re. +++ */ +++ case '/': +++ case '?': +++ forbid (Xhadcnt); +++ vsave(); +++ ocurs = cursor; +++ odot = dot; +++ wcursor = 0; +++ if (readecho(c)) +++ return; +++ if (!vglobp) +++ vscandir[0] = genbuf[0]; +++ oglobp = globp; CP(vutmp, genbuf); globp = vutmp; +++ d = peekc; +++fromsemi: +++ ungetchar(0); +++ fixech(); +++ CATCH +++#ifndef CBREAK +++ /* +++ * Lose typeahead (ick). +++ */ +++ vcook(); +++#endif +++ addr = address(cursor); +++#ifndef CBREAK +++ vraw(); +++#endif +++ ONERR +++#ifndef CBREAK +++ vraw(); +++#endif +++slerr: +++ globp = oglobp; +++ dot = odot; +++ cursor = ocurs; +++ ungetchar(d); +++ splitw = 0; +++ vclean(); +++ vjumpto(dot, ocurs, 0); +++ return; +++ ENDCATCH +++ if (globp == 0) +++ globp = ""; +++ else if (peekc) +++ --globp; +++ if (*globp == ';') { +++ /* /foo/;/bar/ */ +++ globp++; +++ dot = addr; +++ cursor = loc1; +++ goto fromsemi; +++ } +++ dot = odot; +++ ungetchar(d); +++ c = 0; +++ if (*globp == 'z') +++ globp++, c = '\n'; +++ if (any(*globp, "^+-.")) +++ c = *globp++; +++ i = 0; +++ while (isdigit(*globp)) +++ i = i * 10 + *globp++ - '0'; +++ if (any(*globp, "^+-.")) +++ c = *globp++; +++ if (*globp) { +++ /* random junk after the pattern */ +++ beep(); +++ goto slerr; +++ } +++ globp = oglobp; +++ splitw = 0; +++ vmoving = 0; +++ wcursor = loc1; +++ if (i != 0) +++ vsetsiz(i); +++ if (opf == vmove) { +++ if (state == ONEOPEN || state == HARDOPEN) +++ outline = destline = WBOT; +++ if (addr != dot || loc1 != cursor) +++ markDOT(); +++ if (loc1 > linebuf && *loc1 == 0) +++ loc1--; +++ if (c) +++ vjumpto(addr, loc1, c); +++ else { +++ vmoving = 0; +++ if (loc1) { +++ vmoving++; +++ vmovcol = column(loc1); +++ } +++ getDOT(); +++ if (state == CRTOPEN && addr != dot) +++ vup1(); +++ vupdown(addr - dot, NOSTR); +++ } +++ return; +++ } +++ lastcp[-1] = 'n'; +++ getDOT(); +++ wdot = addr; +++ break; +++ } +++ /* +++ * Apply. +++ */ +++ if (vreg && wdot == 0) +++ wdot = dot; +++ (*opf)(c); +++ wdot = NOLINE; +++} +++ +++/* +++ * Find single character c, in direction dir from cursor. +++ */ +++find(c) +++ char c; +++{ +++ +++ for(;;) { +++ if (edge()) +++ return (0); +++ wcursor += dir; +++ if (*wcursor == c) +++ return (1); +++ } +++} +++ +++/* +++ * Do a word motion with operator op, and cnt more words +++ * to go after this. +++ */ +++word(op, cnt) +++ register int (*op)(); +++ int cnt; +++{ +++ register int which; +++ register char *iwc; +++ register line *iwdot = wdot; +++ +++ if (dir == 1) { +++ iwc = wcursor; +++ which = wordch(wcursor); +++ while (wordof(which, wcursor)) { +++ if (cnt == 1 && op != vmove && wcursor[1] == 0) { +++ wcursor++; +++ break; +++ } +++ if (!lnext()) +++ return (0); +++ if (wcursor == linebuf) +++ break; +++ } +++ /* Unless last segment of a change skip blanks */ +++ if (op != vchange || cnt > 1) +++ while (!margin() && blank()) +++ wcursor++; +++ else +++ if (wcursor == iwc && iwdot == wdot && *iwc) +++ wcursor++; +++ if (op == vmove && margin()) +++ wcursor--; +++ } else { +++ if (!lnext()) +++ return (0); +++ while (blank()) +++ if (!lnext()) +++ return (0); +++ if (!margin()) { +++ which = wordch(wcursor); +++ while (!margin() && wordof(which, wcursor)) +++ wcursor--; +++ } +++ if (wcursor < linebuf || !wordof(which, wcursor)) +++ wcursor++; +++ } +++ return (1); +++} +++ +++/* +++ * To end of word, with operator op and cnt more motions +++ * remaining after this. +++ */ +++eend(op) +++ register int (*op)(); +++{ +++ register int which; +++ +++ if (!lnext()) +++ return; +++ while (blank()) +++ if (!lnext()) +++ return; +++ which = wordch(wcursor); +++ while (wordof(which, wcursor)) { +++ if (wcursor[1] == 0) { +++ wcursor++; +++ break; +++ } +++ if (!lnext()) +++ return; +++ } +++ if (op != vchange && op != vdelete && wcursor > linebuf) +++ wcursor--; +++} +++ +++/* +++ * Wordof tells whether the character at *wc is in a word of +++ * kind which (blank/nonblank words are 0, conservative words 1). +++ */ +++wordof(which, wc) +++ char which; +++ register char *wc; +++{ +++ +++ if (isspace(*wc)) +++ return (0); +++ return (!wdkind || wordch(wc) == which); +++} +++ +++/* +++ * Wordch tells whether character at *wc is a word character +++ * i.e. an alfa, digit, or underscore. +++ */ +++wordch(wc) +++ char *wc; +++{ +++ register int c; +++ +++ c = wc[0]; +++ return (isalpha(c) || isdigit(c) || c == '_'); +++} +++ +++/* +++ * Edge tells when we hit the last character in the current line. +++ */ +++edge() +++{ +++ +++ if (linebuf[0] == 0) +++ return (1); +++ if (dir == 1) +++ return (wcursor[1] == 0); +++ else +++ return (wcursor == linebuf); +++} +++ +++/* +++ * Margin tells us when we have fallen off the end of the line. +++ */ +++margin() +++{ +++ +++ return (wcursor < linebuf || wcursor[0] == 0); +++} diff --cc usr/src/cmd/ex/ex_vops.c index 0000000000,92a5f6829a,0000000000..cc85af4954 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vops.c +++ b/usr/src/cmd/ex/ex_vops.c @@@@ -1,0 -1,812 -1,0 +1,925 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vops.c 6.3 10/23/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * This file defines the operation sequences which interface the + + * logical changes to the file buffer with the internal and external + + * display representations. + + */ + + + +/* + + * Undo. + + * + + * Undo is accomplished in two ways. We often for small changes in the + + * current line know how (in terms of a change operator) how the change + + * occurred. Thus on an intelligent terminal we can undo the operation + + * by another such operation, using insert and delete character + + * stuff. The pointers vU[AD][12] index the buffer vutmp when this + + * is possible and provide the necessary information. + + * + + * The other case is that the change involved multiple lines or that + + * we have moved away from the line or forgotten how the change was + + * accomplished. In this case we do a redisplay and hope that the + + * low level optimization routines (which don't look for winning + + * via insert/delete character) will not lose too badly. + + */ + +char *vUA1, *vUA2; + +char *vUD1, *vUD2; + + + +vUndo() + +{ + + + + /* + + * Avoid UU which clobbers ability to do u. + + */ + + if (vundkind == VCAPU || vUNDdot != dot) { + + beep(); + + return; + + } + + CP(vutmp, linebuf); + + vUD1 = linebuf; vUD2 = strend(linebuf); + + putmk1(dot, vUNDsav); + + getDOT(); + + vUA1 = linebuf; vUA2 = strend(linebuf); + + vundkind = VCAPU; + + if (state == ONEOPEN || state == HARDOPEN) { + + vjumpto(dot, vUNDcurs, 0); + + return; + + } + + vdirty(vcline, 1); + + vsyncCL(); +++ cursor = linebuf; + + vfixcurs(); + +} + + - vundo() +++vundo(show) +++bool show; /* if true update the screen */ + +{ + + register int cnt; + + register line *addr; + + register char *cp; + + char temp[LBSIZE]; + + bool savenote; + + int (*OO)(); + + short oldhold = hold; + + + + switch (vundkind) { + + + + case VMANYINS: + + wcursor = 0; + + addr1 = undap1; + + addr2 = undap2 - 1; + + vsave(); + + YANKreg('1'); + + notecnt = 0; + + /* fall into ... */ + + + + case VMANY: + + case VMCHNG: + + vsave(); + + addr = dot - vcline; + + notecnt = 1; + + if (undkind == UNDPUT && undap1 == undap2) { + + beep(); - return; +++ break; + + } + + /* + + * Undo() call below basically replaces undap1 to undap2-1 + + * with dol through unddol-1. Hack screen image to + + * reflect this replacement. + + */ - vreplace(undap1 - addr, undap2 - undap1, - undkind == UNDPUT ? 0 : unddol - dol); +++ if (show) +++ if (undkind == UNDMOVE) +++ vdirty(0, LINES); +++ else +++ vreplace(undap1 - addr, undap2 - undap1, +++ undkind == UNDPUT ? 0 : unddol - dol); + + savenote = notecnt; + + undo(1); - if (vundkind != VMCHNG || addr != dot) +++ if (show && (vundkind != VMCHNG || addr != dot)) + + killU(); + + vundkind = VMANY; + + cnt = dot - addr; + + if (cnt < 0 || cnt > vcnt || state != VISUAL) { - vjumpto(dot, NOSTR, '.'); - return; +++ if (show) +++ vjumpto(dot, NOSTR, '.'); +++ break; + + } + + if (!savenote) + + notecnt = 0; - vcline = cnt; - vrepaint(vmcurs); +++ if (show) { +++ vcline = cnt; +++ vrepaint(vmcurs); +++ } + + vmcurs = 0; - return; +++ break; + + + + case VCHNG: + + case VCAPU: + + vundkind = VCHNG; + + strcpy(temp, vutmp); + + strcpy(vutmp, linebuf); + + doomed = column(vUA2 - 1) - column(vUA1 - 1); + + strcLIN(temp); + + cp = vUA1; vUA1 = vUD1; vUD1 = cp; + + cp = vUA2; vUA2 = vUD2; vUD2 = cp; +++ if (!show) +++ break; + + cursor = vUD1; + + if (state == HARDOPEN) { + + doomed = 0; + + vsave(); + + vopen(dot, WBOT); + + vnline(cursor); - return; +++ break; + + } + + /* + + * Pseudo insert command. + + */ + + vcursat(cursor); + + OO = Outchar; Outchar = vinschar; hold |= HOLDQIK; + + vprepins(); + + temp[vUA2 - linebuf] = 0; + + for (cp = &temp[vUA1 - linebuf]; *cp;) + + putchar(*cp++); + + Outchar = OO; hold = oldhold; + + endim(); + + physdc(cindent(), cindent() + doomed); + + doomed = 0; + + vdirty(vcline, 1); + + vsyncCL(); + + if (cursor > linebuf && cursor >= strend(linebuf)) + + cursor--; + + vfixcurs(); - return; +++ break; + + + + case VNONE: + + beep(); +++ break; +++ } +++} +++ +++/* +++ * Routine to handle a change inside a macro. +++ * Fromvis is true if we were called from a visual command (as +++ * opposed to an ex command). This has nothing to do with being +++ * in open/visual mode as :s/foo/bar is not fromvis. +++ */ +++vmacchng(fromvis) +++bool fromvis; +++{ +++ line *savedot, *savedol; +++ char *savecursor; +++ char savelb[LBSIZE]; +++ int nlines, more; +++ register line *a1, *a2; +++ char ch; /* DEBUG */ +++ int copyw(), copywR(); +++ +++ if (!inopen) + + return; +++ if (!vmacp) +++ vch_mac = VC_NOTINMAC; +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "vmacchng, vch_mac=%d, linebuf='%s', *dot=%o\n", vch_mac, linebuf, *dot); +++#endif +++ if (vmacp && fromvis) +++ vsave(); +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "after vsave, linebuf='%s', *dot=%o\n", linebuf, *dot); +++#endif +++ switch(vch_mac) { +++ case VC_NOCHANGE: +++ vch_mac = VC_ONECHANGE; +++ break; +++ case VC_ONECHANGE: +++ /* Save current state somewhere */ +++#ifdef TRACE +++ vudump("before vmacchng hairy case"); +++#endif +++ savedot = dot; savedol = dol; savecursor = cursor; +++ CP(savelb, linebuf); +++ nlines = dol - zero; +++ while ((line *) endcore - truedol < nlines) +++ morelines(); +++ copyw(truedol+1, zero+1, nlines); +++ truedol += nlines; +++ +++#ifdef TRACE +++ visdump("before vundo"); +++#endif +++ /* Restore state as it was at beginning of macro */ +++ vundo(0); +++#ifdef TRACE +++ visdump("after vundo"); +++ vudump("after vundo"); +++#endif +++ +++ /* Do the saveall we should have done then */ +++ saveall(); +++#ifdef TRACE +++ vudump("after saveall"); +++#endif +++ +++ /* Restore current state from where saved */ +++ more = savedol - dol; /* amount we shift everything by */ +++ if (more) +++ (*(more>0 ? copywR : copyw))(savedol+1, dol+1, truedol-dol); +++ unddol += more; truedol += more; undap2 += more; +++ +++ truedol -= nlines; +++ copyw(zero+1, truedol+1, nlines); +++ dot = savedot; dol = savedol ; cursor = savecursor; +++ CP(linebuf, savelb); +++ vch_mac = VC_MANYCHANGE; +++ +++ /* Arrange that no further undo saving happens within macro */ +++ otchng = tchng; /* Copied this line blindly - bug? */ +++ inopen = -1; /* no need to save since it had to be 1 or -1 before */ +++ vundkind = VMANY; +++#ifdef TRACE +++ vudump("after vmacchng"); +++#endif +++ break; +++ case VC_NOTINMAC: +++ case VC_MANYCHANGE: +++ /* Nothing to do for various reasons. */ +++ break; + + } + +} + + + +/* + + * Initialize undo information before an append. + + */ + +vnoapp() + +{ + + + + vUD1 = vUD2 = cursor; + +} + + + +/* + + * All the rest of the motion sequences have one or more + + * cases to deal with. In the case wdot == 0, operation + + * is totally within current line, from cursor to wcursor. + + * If wdot is given, but wcursor is 0, then operation affects + + * the inclusive line range. The hardest case is when both wdot + + * and wcursor are given, then operation affects from line dot at + + * cursor to line wdot at wcursor. + + */ + + + +/* + + * Move is simple, except for moving onto new lines in hardcopy open mode. + + */ + +vmove() + +{ + + register int cnt; + + + + if (wdot) { + + if (wdot < one || wdot > dol) { + + beep(); + + return; + + } + + cnt = wdot - dot; + + wdot = NOLINE; + + if (cnt) + + killU(); + + vupdown(cnt, wcursor); + + return; + + } + + + + /* + + * When we move onto a new line, save information for U undo. + + */ + + if (vUNDdot != dot) { + + vUNDsav = *dot; + + vUNDcurs = wcursor; + + vUNDdot = dot; + + } + + + + /* + + * In hardcopy open, type characters to left of cursor + + * on new line, or back cursor up if its to left of where we are. + + * In any case if the current line is ``rubbled'' i.e. has trashy + + * looking overstrikes on it or \'s from deletes, we reprint + + * so it is more comprehensible (and also because we can't work + + * if we let it get more out of sync since column() won't work right. + + */ + + if (state == HARDOPEN) { + + register char *cp; + + if (rubble) { + + register int c; + + int oldhold = hold; + + + + sethard(); + + cp = wcursor; + + c = *cp; + + *cp = 0; + + hold |= HOLDDOL; + + vreopen(WTOP, lineDOT(), vcline); + + hold = oldhold; + + *cp = c; + + } else if (wcursor > cursor) { + + vfixcurs(); + + for (cp = cursor; *cp && cp < wcursor;) { + + register int c = *cp++ & TRIM; + + + + putchar(c ? c : ' '); + + } + + } + + } + + vsetcurs(wcursor); + +} + + + +/* + + * Delete operator. + + * + + * Hard case of deleting a range where both wcursor and wdot + + * are specified is treated as a special case of change and handled + + * by vchange (although vchange may pass it back if it degenerates + + * to a full line range delete.) + + */ + +vdelete(c) + + char c; + +{ + + register char *cp; + + register int i; + + + + if (wdot) { + + if (wcursor) { + + vchange('d'); + + return; + + } + + if ((i = xdw()) < 0) + + return; + + if (state != VISUAL) { + + vgoto(LINE(0), 0); + + vputchar('@'); + + } + + wdot = dot; + + vremote(i, delete, 0); + + notenam = "delete"; + + DEL[0] = 0; + + killU(); + + vreplace(vcline, i, 0); + + if (wdot > dol) + + vcline--; + + vrepaint(NOSTR); + + return; + + } + + if (wcursor < linebuf) + + wcursor = linebuf; + + if (cursor == wcursor) { + + beep(); + + return; + + } + + i = vdcMID(); + + cp = cursor; + + setDEL(); + + CP(cp, wcursor); + + if (cp > linebuf && (cp[0] == 0 || c == '#')) + + cp--; + + if (state == HARDOPEN) { + + bleep(i, cp); + + cursor = cp; + + return; + + } + + physdc(column(cursor - 1), i); + + DEPTH(vcline) = 0; + + vreopen(LINE(vcline), lineDOT(), vcline); + + vsyncCL(); + + vsetcurs(cp); + +} + + + +/* + + * Change operator. + + * + + * In a single line we mark the end of the changed area with '$'. + + * On multiple whole lines, we clear the lines first. + + * Across lines with both wcursor and wdot given, we delete + + * and sync then append (but one operation for undo). + + */ + +vchange(c) + + char c; + +{ + + register char *cp; + + register int i, ind, cnt; + + line *addr; + + + + if (wdot) { + + /* + + * Change/delete of lines or across line boundaries. + + */ + + if ((cnt = xdw()) < 0) + + return; + + getDOT(); + + if (wcursor && cnt == 1) { + + /* + + * Not really. + + */ + + wdot = 0; + + if (c == 'd') { + + vdelete(c); + + return; + + } + + goto smallchange; + + } + + if (cursor && wcursor) { + + /* + + * Across line boundaries, but not + + * necessarily whole lines. + + * Construct what will be left. + + */ + + *cursor = 0; + + strcpy(genbuf, linebuf); + + getline(*wdot); + + if (strlen(genbuf) + strlen(wcursor) > LBSIZE - 2) { + + getDOT(); + + beep(); + + return; + + } + + strcat(genbuf, wcursor); + + if (c == 'd' && *vpastwh(genbuf) == 0) { + + /* + + * Although this is a delete + + * spanning line boundaries, what + + * would be left is all white space, + + * so take it all away. + + */ + + wcursor = 0; + + getDOT(); + + op = 0; + + notpart(lastreg); + + notpart('1'); + + vdelete(c); + + return; + + } + + ind = -1; + + } else if (c == 'd' && wcursor == 0) { + + vdelete(c); + + return; + + } else + +#ifdef LISPCODE + + /* + + * We are just substituting text for whole lines, + + * so determine the first autoindent. + + */ + + if (value(LISP) && value(AUTOINDENT)) + + ind = lindent(dot); + + else + +#endif + + ind = whitecnt(linebuf); + + i = vcline >= 0 ? LINE(vcline) : WTOP; + + + + /* + + * Delete the lines from the buffer, + + * and remember how the partial stuff came about in + + * case we are told to put. + + */ + + addr = dot; + + vremote(cnt, delete, 0); + + setpk(); + + notenam = "delete"; + + if (c != 'd') + + notenam = "change"; + + /* + + * If DEL[0] were nonzero, put would put it back + + * rather than the deleted lines. + + */ + + DEL[0] = 0; + + if (cnt > 1) + + killU(); + + + + /* + + * Now hack the screen image coordination. + + */ + + vreplace(vcline, cnt, 0); + + wdot = NOLINE; + + noteit(0); + + vcline--; + + if (addr <= dol) + + dot--; + + + + /* + + * If this is a across line delete/change, + + * cursor stays where it is; just splice together the pieces + + * of the new line. Otherwise generate a autoindent + + * after a S command. + + */ + + if (ind >= 0) { + + *genindent(ind) = 0; + + vdoappend(genbuf); + + } else { + + vmcurs = cursor; + + strcLIN(genbuf); + + vdoappend(linebuf); + + } + + + + /* + + * Indicate a change on hardcopies by + + * erasing the current line. + + */ + + if (c != 'd' && state != VISUAL && state != HARDOPEN) { + + int oldhold = hold; + + + + hold |= HOLDAT, vclrlin(i, dot), hold = oldhold; + + } + + + + /* + + * Open the line (logically) on the screen, and + + * update the screen tail. Unless we are really a delete + + * go off and gather up inserted characters. + + */ + + vcline++; + + if (vcline < 0) + + vcline = 0; + + vopen(dot, i); + + vsyncCL(); + + noteit(1); + + if (c != 'd') { + + if (ind >= 0) { + + cursor = linebuf; + + linebuf[0] = 0; + + vfixcurs(); + + } else { + + ind = 0; + + vcursat(cursor); + + } + + vappend('x', 1, ind); + + return; + + } + + if (*cursor == 0 && cursor > linebuf) + + cursor--; + + vrepaint(cursor); + + return; + + } + + + +smallchange: + + /* + + * The rest of this is just low level hacking on changes + + * of small numbers of characters. + + */ + + if (wcursor < linebuf) + + wcursor = linebuf; + + if (cursor == wcursor) { + + beep(); + + return; + + } + + i = vdcMID(); + + cp = cursor; + + if (state != HARDOPEN) + + vfixcurs(); + + + + /* + + * Put out the \\'s indicating changed text in hardcopy, + + * or mark the end of the change with $ if not hardcopy. + + */ + + if (state == HARDOPEN) + + bleep(i, cp); + + else { + + vcursbef(wcursor); + + putchar('$'); + + i = cindent(); + + } + + + + /* + + * Remember the deleted text for possible put, + + * and then prepare and execute the input portion of the change. + + */ + + cursor = cp; + + setDEL(); + + CP(cursor, wcursor); + + if (state != HARDOPEN) { + + vcursaft(cursor - 1); + + doomed = i - cindent(); + + } else { + +/* + + sethard(); + + wcursor = cursor; + + cursor = linebuf; + + vgoto(outline, value(NUMBER) << 3); + + vmove(); + +*/ + + doomed = 0; + + } + + prepapp(); + + vappend('c', 1, 0); + +} + + + +/* + + * Open new lines. + + * + + * Tricky thing here is slowopen. This causes display updating + + * to be held off so that 300 baud dumb terminals don't lose badly. + + * This also suppressed counts, which otherwise say how many blank + + * space to open up. Counts are also suppressed on intelligent terminals. + + * Actually counts are obsoleted, since if your terminal is slow + + * you are better off with slowopen. + + */ + +voOpen(c, cnt) + + char c; + + register int cnt; + +{ + + register int ind = 0, i; + + short oldhold = hold; + + + + if (value(SLOWOPEN) || value(REDRAW) && AL && DL) + + cnt = 1; + + vsave(); + + setLAST(); + + if (value(AUTOINDENT)) + + ind = whitecnt(linebuf); + + if (c == 'O') { + + vcline--; + + dot--; + + if (dot > zero) + + getDOT(); + + } + + if (value(AUTOINDENT)) { + +#ifdef LISPCODE + + if (value(LISP)) + + ind = lindent(dot + 1); + +#endif + + } + + killU(); + + prepapp(); - vundkind = VMANY; +++ if (FIXUNDO) +++ vundkind = VMANY; + + if (state != VISUAL) + + c = WBOT + 1; + + else { + + c = vcline < 0 ? WTOP - cnt : LINE(vcline) + DEPTH(vcline); + + if (c < ZERO) + + c = ZERO; + + i = LINE(vcline + 1) - c; + + if (i < cnt && c <= WBOT && (!AL || !DL)) + + vinslin(c, cnt - i, vcline); + + } + + *genindent(ind) = 0; + + vdoappend(genbuf); + + vcline++; + + oldhold = hold; + + hold |= HOLDROL; + + vopen(dot, c); + + hold = oldhold; + + if (value(SLOWOPEN)) + + /* + + * Oh, so lazy! + + */ + + vscrap(); + + else + + vsync1(LINE(vcline)); + + cursor = linebuf; + + linebuf[0] = 0; + + vappend('o', 1, ind); + +} + + + +/* + + * > < and = shift operators. + + * + + * Note that =, which aligns lisp, is just a ragged sort of shift, + + * since it never distributes text between lines. + + */ + +char vshnam[2] = { 'x', 0 }; + + + +vshftop() + +{ + + register line *addr; + + register int cnt; + + + + if ((cnt = xdw()) < 0) + + return; + + addr = dot; + + vremote(cnt, vshift, 0); + + vshnam[0] = op; + + notenam = vshnam; + + dot = addr; + + vreplace(vcline, cnt, cnt); + + if (state == HARDOPEN) + + vcnt = 0; + + vrepaint(NOSTR); + +} + + + +/* + + * !. + + * + + * Filter portions of the buffer through unix commands. + + */ + +vfilter() + +{ + + register line *addr; + + register int cnt; + + char *oglobp, d; + + + + if ((cnt = xdw()) < 0) + + return; + + if (vglobp) + + vglobp = uxb; + + if (readecho('!')) + + return; + + oglobp = globp; globp = genbuf + 1; + + d = peekc; ungetchar(0); + + CATCH + + fixech(); + + unix0(0); + + ONERR + + splitw = 0; + + ungetchar(d); + + vrepaint(cursor); + + globp = oglobp; + + return; + + ENDCATCH + + ungetchar(d); globp = oglobp; + + addr = dot; + + CATCH + + vgoto(WECHO, 0); flusho(); + + vremote(cnt, filter, 2); + + ONERR + + vdirty(0, LINES); + + ENDCATCH + + if (dot == zero && dol > zero) + + dot = one; + + splitw = 0; + + notenam = ""; +++ /* +++ * BUG: we shouldn't be depending on what undap2 and undap1 are, +++ * since we may be inside a macro. What's really wanted is the +++ * number of lines we read from the filter. However, the mistake +++ * will be an overestimate so it only results in extra work, +++ * it shouldn't cause any real screwups. +++ */ + + vreplace(vcline, cnt, undap2 - undap1); + + dot = addr; + + if (dot > dol) { + + dot--; + + vcline--; + + } + + vrepaint(NOSTR); + +} + + + +/* + + * Xdw exchanges dot and wdot if appropriate and also checks + + * that wdot is reasonable. Its name comes from + + * xchange dotand wdot + + */ + +xdw() + +{ + + register char *cp; + + register int cnt; + +/* + + register int notp = 0; + + */ + + + + if (wdot == NOLINE || wdot < one || wdot > dol) { + + beep(); + + return (-1); + + } + + vsave(); + + setLAST(); + + if (dot > wdot) { + + register line *addr; + + + + vcline -= dot - wdot; + + addr = dot; dot = wdot; wdot = addr; + + cp = cursor; cursor = wcursor; wcursor = cp; + + } + + /* + + * If a region is specified but wcursor is at the begining + + * of the last line, then we move it to be the end of the + + * previous line (actually off the end). + + */ + + if (cursor && wcursor == linebuf && wdot > dot) { + + wdot--; + + getDOT(); + + if (vpastwh(linebuf) >= cursor) + + wcursor = 0; + + else { + + getline(*wdot); + + wcursor = strend(linebuf); + + getDOT(); + + } + + /* + + * Should prepare in caller for possible dot == wdot. + + */ + + } + + cnt = wdot - dot + 1; + + if (vreg) { + + vremote(cnt, YANKreg, vreg); + +/* + + if (notp) + + notpart(vreg); + + */ + + } + + + + /* + + * Kill buffer code. If delete operator is c or d, then save + + * the region in numbered buffers. + + * + + * BUG: This may be somewhat inefficient due + + * to the way named buffer are implemented, + + * necessitating some optimization. + + */ + + vreg = 0; + + if (any(op, "cd")) { + + vremote(cnt, YANKreg, '1'); + +/* + + if (notp) + + notpart('1'); + + */ + + } + + return (cnt); + +} + + + +/* + + * Routine for vremote to call to implement shifts. + + */ + +vshift() + +{ + + + + shift(op, 1); + +} + + + +/* + + * Replace a single character with the next input character. + + * A funny kind of insert. + + */ + +vrep(cnt) + + register int cnt; + +{ + + register int i, c; + + + + if (cnt > strlen(cursor)) { + + beep(); + + return; + + } + + i = column(cursor + cnt - 1); + + vcursat(cursor); + + doomed = i - cindent(); + + if (!vglobp) { + + c = getesc(); + + if (c == 0) { + + vfixcurs(); + + return; + + } + + ungetkey(c); + + } + + CP(vutmp, linebuf); - vundkind = VCHNG; +++ if (FIXUNDO) +++ vundkind = VCHNG; + + wcursor = cursor + cnt; + + vUD1 = cursor; vUD2 = wcursor; + + CP(cursor, wcursor); + + prepapp(); + + vappend('r', cnt, 0); + + *lastcp++ = INS[0]; + + setLAST(); + +} + + + +/* + + * Yank. + + * + + * Yanking to string registers occurs for free (essentially) + + * in the routine xdw(). + + */ + +vyankit() + +{ + + register int cnt; + + + + if (wdot) { + + if ((cnt = xdw()) < 0) + + return; + + vremote(cnt, yank, 0); + + setpk(); + + notenam = "yank"; - vundkind = VNONE; +++ if (FIXUNDO) +++ vundkind = VNONE; + + DEL[0] = 0; + + wdot = NOLINE; + + if (notecnt <= vcnt - vcline && notecnt < value(REPORT)) + + notecnt = 0; + + vrepaint(cursor); + + return; + + } + + takeout(DEL); + +} + + + +/* + + * Set pkill variables so a put can + + * know how to put back partial text. + + * This is necessary because undo needs the complete + + * line images to be saved, while a put wants to trim + + * the first and last lines. The compromise + + * is for put to be more clever. + + */ + +setpk() + +{ + + + + if (wcursor) { + + pkill[0] = cursor; + + pkill[1] = wcursor; + + } + +} diff --cc usr/src/cmd/ex/ex_vops2.c index 0000000000,86334bc437,0000000000..4d1cc93847 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vops2.c +++ b/usr/src/cmd/ex/ex_vops2.c @@@@ -1,0 -1,782 -1,0 +1,892 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vops2.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Low level routines for operations sequences, + + * and mostly, insert mode (and a subroutine + + * to read an input line, including in the echo area.) + + */ + +char *vUA1, *vUA2; + +char *vUD1, *vUD2; + + + +/* + + * Obleeperate characters in hardcopy + + * open with \'s. + + */ + +bleep(i, cp) + + register int i; + + char *cp; + +{ + + + + i -= column(cp); + + do + + putchar('\\' | QUOTE); + + while (--i >= 0); + + rubble = 1; + +} + + + +/* + + * Common code for middle part of delete + + * and change operating on parts of lines. + + */ + +vdcMID() + +{ + + register char *cp; + + + + squish(); + + setLAST(); - vundkind = VCHNG, CP(vutmp, linebuf); +++ if (FIXUNDO) +++ vundkind = VCHNG, CP(vutmp, linebuf); + + if (wcursor < cursor) + + cp = wcursor, wcursor = cursor, cursor = cp; + + vUD1 = vUA1 = vUA2 = cursor; vUD2 = wcursor; + + return (column(wcursor - 1)); + +} + + + +/* + + * Take text from linebuf and stick it + + * in the VBSIZE buffer BUF. Used to save + + * deleted text of part of line. + + */ + +takeout(BUF) + + char *BUF; + +{ + + register char *cp; + + + + if (wcursor < linebuf) + + wcursor = linebuf; + + if (cursor == wcursor) { + + beep(); + + return; + + } + + if (wcursor < cursor) { + + cp = wcursor; + + wcursor = cursor; + + cursor = cp; + + } + + setBUF(BUF); + + if ((BUF[0] & (QUOTE|TRIM)) == OVERBUF) + + beep(); + +} + + + +/* + + * Are we at the end of the printed representation of the + + * line? Used internally in hardcopy open. + + */ + +ateopr() + +{ + + register int i, c; + + register char *cp = vtube[destline] + destcol; + + + + for (i = WCOLS - destcol; i > 0; i--) { + + c = *cp++; + + if (c == 0) + + return (1); + + if (c != ' ' && (c & QUOTE) == 0) + + return (0); + + } + + return (1); + +} + + + +/* + + * Append. + + * + + * This routine handles the top level append, doing work + + * as each new line comes in, and arranging repeatability. + + * It also handles append with repeat counts, and calculation + + * of autoindents for new lines. + + */ + +bool vaifirst; + +bool gobbled; + +char *ogcursor; + + + +vappend(ch, cnt, indent) + + char ch; + + int cnt, indent; + +{ + + register int i; + + register char *gcursor; + + bool escape; - int repcnt; +++ int repcnt, savedoomed; + + short oldhold = hold; + + + + /* + + * Before a move in hardopen when the line is dirty + + * or we are in the middle of the printed representation, + + * we retype the line to the left of the cursor so the + + * insert looks clean. + + */ + + if (ch != 'o' && state == HARDOPEN && (rubble || !ateopr())) { + + rubble = 1; + + gcursor = cursor; + + i = *gcursor; + + *gcursor = ' '; + + wcursor = gcursor; + + vmove(); + + *gcursor = i; + + } + + vaifirst = indent == 0; + + + + /* + + * Handle replace character by (eventually) + + * limiting the number of input characters allowed + + * in the vgetline routine. + + */ + + if (ch == 'r') + + repcnt = 2; + + else + + repcnt = 0; + + + + /* + + * If an autoindent is specified, then + + * generate a mixture of blanks to tabs to implement + + * it and place the cursor after the indent. + + * Text read by the vgetline routine will be placed in genbuf, + + * so the indent is generated there. + + */ + + if (value(AUTOINDENT) && indent != 0) { + + gcursor = genindent(indent); + + *gcursor = 0; + + vgotoCL(qcolumn(cursor - 1, genbuf)); + + } else { + + gcursor = genbuf; + + *gcursor = 0; + + if (ch == 'o') + + vfixcurs(); + + } + + + + /* + + * Prepare for undo. Pointers delimit inserted portion of line. + + */ + + vUA1 = vUA2 = cursor; + + + + /* + + * If we are not in a repeated command and a ^@ comes in + + * then this means the previous inserted text. + + * If there is none or it was too long to be saved, + + * then beep() and also arrange to undo any damage done + + * so far (e.g. if we are a change.) + + */ + + if ((vglobp && *vglobp == 0) || peekbr()) { + + if ((INS[0] & (QUOTE|TRIM)) == OVERBUF) { + + beep(); + + if (!splitw) + + ungetkey('u'); + + doomed = 0; + + hold = oldhold; + + return; + + } + + /* + + * Unread input from INS. + + * An escape will be generated at end of string. + + * Hold off n^^2 type update on dumb terminals. + + */ + + vglobp = INS; + + hold |= HOLDQIK; + + } else if (vglobp == 0) + + /* + + * Not a repeated command, get + + * a new inserted text for repeat. + + */ + + INS[0] = 0; + + + + /* + + * For wrapmargin to hack away second space after a '.' + + * when the first space caused a line break we keep + + * track that this happened in gobblebl, which says + + * to gobble up a blank silently. + + */ + + gobblebl = 0; + + + + /* + + * Text gathering loop. + + * New text goes into genbuf starting at gcursor. + + * cursor preserves place in linebuf where text will eventually go. + + */ + + if (*cursor == 0 || state == CRTOPEN) + + hold |= HOLDROL; + + for (;;) { + + if (ch == 'r' && repcnt == 0) + + escape = 0; + + else { - gcursor = vgetline(repcnt, gcursor, &escape); +++ gcursor = vgetline(repcnt, gcursor, &escape, ch); + + + + /* + + * After an append, stick information + + * about the ^D's and ^^D's and 0^D's in + + * the repeated text buffer so repeated + + * inserts of stuff indented with ^D as backtab's + + * can work. + + */ + + if (HADUP) + + addtext("^"); + + else if (HADZERO) + + addtext("0"); + + while (CDCNT > 0) + + addtext("\204"), CDCNT--; + + if (gobbled) + + addtext(" "); + + addtext(ogcursor); + + } + + repcnt = 0; + + + + /* + + * Smash the generated and preexisting indents together + + * and generate one cleanly made out of tabs and spaces + + * if we are using autoindent. + + */ + + if (!vaifirst && value(AUTOINDENT)) { + + i = fixindent(indent); + + if (!HADUP) + + indent = i; + + gcursor = strend(genbuf); + + } + + + + /* + + * Limit the repetition count based on maximum + + * possible line length; do output implied + + * by further count (> 1) and cons up the new line + + * in linebuf. + + */ + + cnt = vmaxrep(ch, cnt); + + CP(gcursor + 1, cursor); + + do { + + CP(cursor, genbuf); + + if (cnt > 1) { + + int oldhold = hold; + + + + Outchar = vinschar; + + hold |= HOLDQIK; + + printf("%s", genbuf); + + hold = oldhold; + + Outchar = vputchar; + + } + + cursor += gcursor - genbuf; + + } while (--cnt > 0); + + endim(); + + vUA2 = cursor; + + if (escape != '\n') + + CP(cursor, gcursor + 1); + + + + /* + + * If doomed characters remain, clobber them, + + * and reopen the line to get the display exact. + + */ + + if (state != HARDOPEN) { + + DEPTH(vcline) = 0; +++ savedoomed = doomed; + + if (doomed > 0) { + + register int cind = cindent(); + + + + physdc(cind, cind + doomed); + + doomed = 0; + + } + + i = vreopen(LINE(vcline), lineDOT(), vcline); +++#ifdef TRACE +++ if (trace) +++ fprintf(trace, "restoring doomed from %d to %d\n", doomed, savedoomed); +++#endif +++ if (ch == 'R') +++ doomed = savedoomed; + + } + + + + /* + + * All done unless we are continuing on to another line. + + */ + + if (escape != '\n') + + break; + + + + /* + + * Set up for the new line. + + * First save the current line, then construct a new + + * first image for the continuation line consisting + + * of any new autoindent plus the pushed ahead text. + + */ + + killU(); + + addtext(gobblebl ? " " : "\n"); + + vsave(); + + cnt = 1; + + if (value(AUTOINDENT)) { + +#ifdef LISPCODE + + if (value(LISP)) + + indent = lindent(dot + 1); + + else + +#endif + + if (!HADUP && vaifirst) + + indent = whitecnt(linebuf); + + vaifirst = 0; + + strcLIN(vpastwh(gcursor + 1)); + + gcursor = genindent(indent); + + *gcursor = 0; + + if (gcursor + strlen(linebuf) > &genbuf[LBSIZE - 2]) + + gcursor = genbuf; + + CP(gcursor, linebuf); + + } else { + + CP(genbuf, gcursor + 1); + + gcursor = genbuf; + + } + + + + /* + + * If we started out as a single line operation and are now + + * turning into a multi-line change, then we had better yank + + * out dot before it changes so that undo will work + + * correctly later. + + */ - if (vundkind == VCHNG) { +++ if (FIXUNDO && vundkind == VCHNG) { + + vremote(1, yank, 0); + + undap1--; + + } + + + + /* + + * Now do the append of the new line in the buffer, + + * and update the display. If slowopen + + * we don't do very much. + + */ + + vdoappend(genbuf); + + vundkind = VMANYINS; + + vcline++; + + if (state != VISUAL) + + vshow(dot, NOLINE); + + else { + + i += LINE(vcline - 1); + + vopen(dot, i); + + if (value(SLOWOPEN)) + + vscrap(); + + else + + vsync1(LINE(vcline)); + + } + + strcLIN(gcursor); + + *gcursor = 0; + + cursor = linebuf; + + vgotoCL(qcolumn(cursor - 1, genbuf)); + + } + + + + /* + + * All done with insertion, position the cursor + + * and sync the screen. + + */ + + hold = oldhold; + + if (cursor > linebuf) + + cursor--; + + if (state != HARDOPEN) + + vsyncCL(); + + else if (cursor > linebuf) + + back1(); + + doomed = 0; + + wcursor = cursor; + + vmove(); + +} + + + +/* + + * Subroutine for vgetline to back up a single character position, + + * backwards around end of lines (vgoto can't hack columns which are + + * less than 0 in general). + + */ + +back1() + +{ + + + + vgoto(destline - 1, WCOLS + destcol - 1); + +} + + + +/* + + * Get a line into genbuf after gcursor. + + * Cnt limits the number of input characters + + * accepted and is used for handling the replace + + * single character command. Aescaped is the location + + * where we stick a termination indicator (whether we + + * ended with an ESCAPE or a newline/return. + + * + + * We do erase-kill type processing here and also + + * are careful about the way we do this so that it is + + * repeatable. (I.e. so that your kill doesn't happen, + + * when you repeat an insert if it was escaped with \ the - * first time you did it. +++ * first time you did it. commch is the command character +++ * involved, including the prompt for readline. + + */ + +char * - vgetline(cnt, gcursor, aescaped) +++vgetline(cnt, gcursor, aescaped, commch) + + int cnt; + + register char *gcursor; + + bool *aescaped; +++ char commch; + +{ + + register int c, ch; + + register char *cp; - int x, y, iwhite; +++ int x, y, iwhite, backsl=0; + + char *iglobp; +++ char cstr[2]; + + int (*OO)() = Outchar; + + + + /* + + * Clear the output state and counters + + * for autoindent backwards motion (counts of ^D, etc.) + + * Remember how much white space at beginning of line so + + * as not to allow backspace over autoindent. + + */ + + *aescaped = 0; + + ogcursor = gcursor; + + flusho(); + + CDCNT = 0; + + HADUP = 0; + + HADZERO = 0; + + gobbled = 0; + + iwhite = whitecnt(genbuf); + + iglobp = vglobp; + + + + /* + + * Carefully avoid using vinschar in the echo area. + + */ + + if (splitw) + + Outchar = vputchar; + + else { + + Outchar = vinschar; + + vprepins(); + + } + + for (;;) { +++ backsl = 0; + + if (gobblebl) + + gobblebl--; + + if (cnt != 0) { + + cnt--; + + if (cnt == 0) + + goto vadone; + + } - ch = c = getkey() & (QUOTE|TRIM); - if (value(MAPINPUT)) - while ((ch = map(c, arrows)) != c) +++ c = getkey(); +++ if (c != ATTN) +++ c &= (QUOTE|TRIM); +++ ch = c; +++ maphopcnt = 0; +++ if (vglobp == 0 && Peekkey == 0 && commch != 'r') +++ while ((ch = map(c, immacs)) != c) { + + c = ch; +++ if (!value(REMAP)) +++ break; +++ if (++maphopcnt > 256) +++ error("Infinite macro loop"); +++ } + + if (!iglobp) { + + + + /* + + * Erase-kill type processing. + + * Only happens if we were not reading + + * from untyped input when we started. + + * Map users erase to ^H, kill to -1 for switch. + + */ +++#ifndef USG3TTY + + if (c == tty.sg_erase) + + c = CTRL(h); + + else if (c == tty.sg_kill) + + c = -1; +++#else +++ if (c == tty.c_cc[VERASE]) +++ c = CTRL(h); +++ else if (c == tty.c_cc[VKILL]) +++ c = -1; +++#endif + + switch (c) { + + + + /* + + * ^? Interrupt drops you back to visual + + * command mode with an unread interrupt + + * still in the input buffer. + + * + + * ^\ Quit does the same as interrupt. + + * If you are a ex command rather than + + * a vi command this will drop you + + * back to command mode for sure. + + */ + + case ATTN: + + case QUIT: + + ungetkey(c); + + goto vadone; + + + + /* + + * ^H Backs up a character in the input. + + * + + * BUG: Can't back around line boundaries. + + * This is hard because stuff has + + * already been saved for repeat. + + */ + + case CTRL(h): + +bakchar: + + cp = gcursor - 1; + + if (cp < ogcursor) { + + if (splitw) { + + /* + + * Backspacing over readecho + + * prompt. Pretend delete but + + * don't beep. + + */ + + ungetkey(c); + + goto vadone; + + } + + beep(); + + continue; + + } + + goto vbackup; + + + + /* + + * ^W Back up a white/non-white word. + + */ + + case CTRL(w): + + wdkind = 1; + + for (cp = gcursor; cp > ogcursor && isspace(cp[-1]); cp--) + + continue; + + for (c = wordch(cp - 1); + + cp > ogcursor && wordof(c, cp - 1); cp--) + + continue; + + goto vbackup; + + + + /* + + * users kill Kill input on this line, back to + + * the autoindent. + + */ + + case -1: + + cp = ogcursor; + +vbackup: + + if (cp == gcursor) { + + beep(); + + continue; + + } + + endim(); + + *cp = 0; + + c = cindent(); + + vgotoCL(qcolumn(cursor - 1, genbuf)); + + if (doomed >= 0) + + doomed += c - cindent(); + + gcursor = cp; + + continue; + + + + /* + + * \ Followed by erase or kill + + * maps to just the erase or kill. + + */ + + case '\\': + + x = destcol, y = destline; + + putchar('\\'); + + vcsync(); + + c = getkey(); - if (c == tty.sg_erase || c == tty.sg_kill) { +++#ifndef USG3TTY +++ if (c == tty.sg_erase || c == tty.sg_kill) +++#else +++ if (c == tty.c_cc[VERASE] +++ || c == tty.c_cc[VKILL]) +++#endif +++ { + + vgoto(y, x); + + if (doomed >= 0) + + doomed++; + + goto def; + + } + + ungetkey(c), c = '\\'; - goto noput; +++ backsl = 1; +++ break; + + + + /* + + * ^Q Super quote following character + + * Only ^@ is verboten (trapped at + + * a lower level) and \n forces a line + + * split so doesn't really go in. + + * + + * ^V Synonym for ^Q + + */ + + case CTRL(q): + + case CTRL(v): + + x = destcol, y = destline; + + putchar('^'); + + vgoto(y, x); + + c = getkey(); + +#ifdef TIOCSETC + + if (c == ATTN) + + c = nttyc.t_intrc; + +#endif + + if (c != NL) { + + if (doomed >= 0) + + doomed++; + + goto def; + + } + + break; + + } + + } + + + + /* + + * If we get a blank not in the echo area + + * consider splitting the window in the wrapmargin. + + */ - if (c == ' ' && !splitw) { - if (gobblebl) { +++ if (c != NL && !splitw) { +++ if (c == ' ' && gobblebl) { + + gobbled = 1; + + continue; + + } - if (value(WRAPMARGIN) && outcol >= OCOLUMNS - value(WRAPMARGIN)) { - c = NL; - gobblebl = 2; +++ if (value(WRAPMARGIN) && +++ (outcol >= OCOLUMNS - value(WRAPMARGIN) || +++ backsl && outcol==0) && +++ commch != 'r') { +++ /* +++ * At end of word and hit wrapmargin. +++ * Move the word to next line and keep going. +++ */ +++ wdkind = 1; +++ *gcursor++ = c; +++ if (backsl) +++ *gcursor++ = getkey(); +++ *gcursor = 0; +++ /* +++ * Find end of previous word if we are past it. +++ */ +++ for (cp=gcursor; cp>ogcursor && isspace(cp[-1]); cp--) +++ ; +++ if (outcol+(backsl?OCOLUMNS:0) - (gcursor-cp) >= OCOLUMNS - value(WRAPMARGIN)) { +++ /* +++ * Find beginning of previous word. +++ */ +++ for (; cp>ogcursor && !isspace(cp[-1]); cp--) +++ ; +++ if (cp <= ogcursor) { +++ /* +++ * There is a single word that +++ * is too long to fit. Just +++ * let it pass, but beep for +++ * each new letter to warn +++ * the luser. +++ */ +++ c = *--gcursor; +++ *gcursor = 0; +++ beep(); +++ goto dontbreak; +++ } +++ /* +++ * Save it for next line. +++ */ +++ macpush(cp, 0); +++ cp--; +++ } +++ macpush("\n", 0); +++ /* +++ * Erase white space before the word. +++ */ +++ while (cp > ogcursor && isspace(cp[-1])) +++ cp--; /* skip blank */ +++ gobblebl = 3; +++ goto vbackup; + + } +++ dontbreak:; +++ } +++ +++ /* +++ * Word abbreviation mode. +++ */ +++ cstr[0] = c; +++ if (anyabbrs && gcursor > ogcursor && !wordch(cstr) && wordch(gcursor-1)) { +++ int wdtype, abno; +++ +++ cstr[1] = 0; +++ wdkind = 1; +++ cp = gcursor - 1; +++ for (wdtype = wordch(cp - 1); +++ cp > ogcursor && wordof(wdtype, cp - 1); cp--) +++ ; +++ *gcursor = 0; +++ for (abno=0; abbrevs[abno].mapto; abno++) { +++ if (eq(cp, abbrevs[abno].cap)) { +++ macpush(cstr, 0); +++ macpush(abbrevs[abno].mapto); +++ goto vbackup; +++ } +++ } + + } +++ + + switch (c) { + + + + /* + + * ^M Except in repeat maps to \n. + + */ + + case CR: + + if (vglobp) + + goto def; + + c = '\n'; + + /* presto chango ... */ + + + + /* + + * \n Start new line. + + */ + + case NL: + + *aescaped = c; + + goto vadone; + + + + /* + + * escape End insert unless repeat and more to repeat. + + */ + + case ESCAPE: + + if (lastvgk) + + goto def; + + goto vadone; + + + + /* + + * ^D Backtab. + + * ^T Software forward tab. + + * + + * Unless in repeat where this means these + + * were superquoted in. + + */ + + case CTRL(d): + + case CTRL(t): + + if (vglobp) + + goto def; + + /* fall into ... */ + + + + /* + + * ^D|QUOTE Is a backtab (in a repeated command). + + */ + + case CTRL(d) | QUOTE: + + *gcursor = 0; + + cp = vpastwh(genbuf); + + c = whitecnt(genbuf); + + if (ch == CTRL(t)) { + + /* + + * ^t just generates new indent replacing + + * current white space rounded up to soft + + * tab stop increment. + + */ + + if (cp != gcursor) + + /* + + * BUG: Don't hack ^T except + + * right after initial + + * white space. + + */ + + continue; + + cp = genindent(iwhite = backtab(c + value(SHIFTWIDTH) + 1)); + + ogcursor = cp; + + goto vbackup; + + } + + /* + + * ^D works only if we are at the (end of) the + + * generated autoindent. We count the ^D for repeat + + * purposes. + + */ + + if (c == iwhite && c != 0) + + if (cp == gcursor) { + + iwhite = backtab(c); + + CDCNT++; + + ogcursor = cp = genindent(iwhite); + + goto vbackup; + + } else if (&cp[1] == gcursor && + + (*cp == '^' || *cp == '0')) { + + /* + + * ^^D moves to margin, then back + + * to current indent on next line. + + * + + * 0^D moves to margin and then + + * stays there. + + */ + + HADZERO = *cp == '0'; + + ogcursor = cp = genbuf; + + HADUP = 1 - HADZERO; + + CDCNT = 1; + + endim(); + + back1(); - vputc(' '); +++ vputchar(' '); + + goto vbackup; + + } + + if (vglobp && vglobp - iglobp >= 2 && + + (vglobp[-2] == '^' || vglobp[-2] == '0') + + && gcursor == ogcursor + 1) + + goto bakchar; + + continue; + + + + default: + + /* + + * Possibly discard control inputs. + + */ + + if (!vglobp && junk(c)) { + + beep(); + + continue; + + } + +def: - putchar(c); - noput: +++ if (!backsl) { +++ putchar(c); +++ flush(); +++ } + + if (gcursor > &genbuf[LBSIZE - 2]) + + error("Line too long"); + + *gcursor++ = c & TRIM; + + vcsync(); - #ifdef LISPCODE + + if (value(SHOWMATCH) && !iglobp) + + if (c == ')' || c == '}') + + lsmatch(gcursor); - #endif + + continue; + + } + + } + +vadone: + + *gcursor = 0; - Outchar = OO; +++ if (Outchar != termchar) +++ Outchar = OO; + + endim(); + + return (gcursor); + +} + + + +int vgetsplit(); + +char *vsplitpt; + + + +/* + + * Append the line in buffer at lp + + * to the buffer after dot. + + */ + +vdoappend(lp) + + char *lp; + +{ + + register int oing = inglobal; + + + + vsplitpt = lp; + + inglobal = 1; + + ignore(append(vgetsplit, dot)); + + inglobal = oing; + +} + + + +/* + + * Subroutine for vdoappend to pass to append. + + */ + +vgetsplit() + +{ + + + + if (vsplitpt == 0) + + return (EOF); + + strcLIN(vsplitpt); + + vsplitpt = 0; + + return (0); + +} + + + +/* + + * Vmaxrep determines the maximum repetitition factor + + * allowed that will yield total line length less than + + * LBSIZE characters and also does hacks for the R command. + + */ + +vmaxrep(ch, cnt) + + char ch; + + register int cnt; + +{ + + register int len, replen; + + + + if (cnt > LBSIZE - 2) + + cnt = LBSIZE - 2; + + replen = strlen(genbuf); + + if (ch == 'R') { + + len = strlen(cursor); + + if (replen < len) + + len = replen; + + CP(cursor, cursor + len); + + vUD2 += len; + + } + + len = strlen(linebuf); + + if (len + cnt * replen <= LBSIZE - 2) + + return (cnt); + + cnt = (LBSIZE - 2 - len) / replen; + + if (cnt == 0) { + + vsave(); + + error("Line too long"); + + } + + return (cnt); + +} diff --cc usr/src/cmd/ex/ex_vops3.c index 0000000000,b0e96971e6,0000000000..57e3f2ab65 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vops3.c +++ b/usr/src/cmd/ex/ex_vops3.c @@@@ -1,0 -1,539 -1,0 +1,548 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vops3.c 6.2 10/23/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Routines to handle structure. + + * Operations supported are: + + * ( ) { } [ ] + + * + + * These cover: LISP TEXT + + * ( ) s-exprs sentences + + * { } list at same paragraphs + + * [ ] defuns sections + + * + + * { and } for C used to attempt to do something with matching {}'s, but + + * I couldn't find definitions which worked intuitively very well, so I + + * scrapped this. + + * + + * The code here is very hard to understand. + + */ + +line *llimit; + +int (*lf)(); + + + +#ifdef LISPCODE + +int lindent(); + +#endif + + + +bool wasend; + + + +/* + + * Find over structure, repeated count times. + + * Don't go past line limit. F is the operation to + + * be performed eventually. If pastatom then the user said {} + + * rather than (), implying past atoms in a list (or a paragraph + + * rather than a sentence. + + */ + +lfind(pastatom, cnt, f, limit) + + bool pastatom; + + int cnt, (*f)(); + + line *limit; + +{ + + register int c; + + register int rc = 0; + + char save[LBSIZE]; + + + + /* + + * Initialize, saving the current line buffer state + + * and computing the limit; a 0 argument means + + * directional end of file. + + */ + + wasend = 0; + + lf = f; + + strcpy(save, linebuf); + + if (limit == 0) + + limit = dir < 0 ? one : dol; + + llimit = limit; + + wdot = dot; + + wcursor = cursor; + + + + if (pastatom >= 2) { + + while (cnt > 0 && word(f, cnt)) + + cnt--; + + if (pastatom == 3) + + eend(f); + + if (dot == wdot) { + + wdot = 0; + + if (cursor == wcursor) + + rc = -1; + + } + + } + +#ifdef LISPCODE + + else if (!value(LISP)) { + +#else + + else { + +#endif + + char *icurs; + + line *idot; + + + + if (linebuf[0] == 0) { + + do + + if (!lnext()) + + goto ret; + + while (linebuf[0] == 0); + + if (dir > 0) { + + wdot--; + + linebuf[0] = 0; + + wcursor = linebuf; + + /* + + * If looking for sentence, next line + + * starts one. + + */ + + if (!pastatom) { + + icurs = wcursor; + + idot = wdot; + + goto begin; + + } + + } + + } + + icurs = wcursor; + + idot = wdot; + + + + /* + + * Advance so as to not find same thing again. + + */ + + if (dir > 0) { + + if (!lnext()) { + + rc = -1; + + goto ret; + + } + + } else + + ignore(lskipa1("")); + + + + /* + + * Count times find end of sentence/paragraph. + + */ + +begin: + + for (;;) { + + while (!endsent(pastatom)) + + if (!lnext()) + + goto ret; + + if (!pastatom || wcursor == linebuf && endPS()) + + if (--cnt <= 0) + + break; + + if (linebuf[0] == 0) { + + do + + if (!lnext()) + + goto ret; + + while (linebuf[0] == 0); + + } else + + if (!lnext()) + + goto ret; + + } + + + + /* + + * If going backwards, and didn't hit the end of the buffer, + + * then reverse direction. + + */ + + if (dir < 0 && (wdot != llimit || wcursor != linebuf)) { + + dir = 1; + + llimit = dot; + + /* + + * Empty line needs special treatement. + + * If moved to it from other than begining of next line, + + * then a sentence starts on next line. + + */ + + if (linebuf[0] == 0 && !pastatom && + + (wdot != dot - 1 || cursor != linebuf)) { + + lnext(); + + goto ret; + + } + + } + + + + /* + + * If we are not at a section/paragraph division, + + * advance to next. + + */ + + if (wcursor == icurs && wdot == idot || wcursor != linebuf || !endPS()) + + ignore(lskipa1("")); + + } + +#ifdef LISPCODE + + else { + + c = *wcursor; + + /* + + * Startup by skipping if at a ( going left or a ) going + + * right to keep from getting stuck immediately. + + */ + + if (dir < 0 && c == '(' || dir > 0 && c == ')') { + + if (!lnext()) { + + rc = -1; + + goto ret; + + } + + } + + /* + + * Now chew up repitition count. Each time around + + * if at the beginning of an s-exp (going forwards) + + * or the end of an s-exp (going backwards) + + * skip the s-exp. If not at beg/end resp, then stop + + * if we hit a higher level paren, else skip an atom, + + * counting it unless pastatom. + + */ + + while (cnt > 0) { + + c = *wcursor; + + if (dir < 0 && c == ')' || dir > 0 && c == '(') { + + if (!lskipbal("()")) + + goto ret; + + /* + + * Unless this is the last time going + + * backwards, skip past the matching paren + + * so we don't think it is a higher level paren. + + */ + + if (dir < 0 && cnt == 1) + + goto ret; + + if (!lnext() || !ltosolid()) + + goto ret; + + --cnt; + + } else if (dir < 0 && c == '(' || dir > 0 && c == ')') + + /* Found a higher level paren */ + + goto ret; + + else { + + if (!lskipatom()) + + goto ret; + + if (!pastatom) + + --cnt; + + } + + } + + } + +#endif + +ret: + + strcLIN(save); + + return (rc); + +} + + + +/* + + * Is this the end of a sentence? + + */ + +endsent(pastatom) + + bool pastatom; + +{ + + register char *cp = wcursor; + + register int c, d; + + + + /* + + * If this is the beginning of a line, then + + * check for the end of a paragraph or section. + + */ + + if (cp == linebuf) + + return (endPS()); + + + + /* + + * Sentences end with . ! ? not at the beginning + + * of the line, and must be either at the end of the line, + + * or followed by 2 spaces. Any number of intervening ) ] ' " + + * characters are allowed. + + */ + + if (!any(c = *cp, ".!?")) + + goto tryps; + + do + + if ((d = *++cp) == 0) + + return (1); + + while (any(d, ")]'")); + + if (*cp == 0 || *cp++ == ' ' && *cp == ' ') + + return (1); + +tryps: + + if (cp[1] == 0) + + return (endPS()); + + return (0); + +} + + + +/* + + * End of paragraphs/sections are respective + + * macros as well as blank lines and form feeds. + + */ + +endPS() + +{ + + + + return (linebuf[0] == 0 || + + isa(svalue(PARAGRAPHS)) || isa(svalue(SECTIONS))); + + + +} + + + +#ifdef LISPCODE + +lindent(addr) + + line *addr; + +{ + + register int i; + + char *swcurs = wcursor; + + line *swdot = wdot; + + + +again: + + if (addr > one) { + + register char *cp; + + register int cnt = 0; + + + + addr--; + + getline(*addr); + + for (cp = linebuf; *cp; cp++) + + if (*cp == '(') + + cnt++; + + else if (*cp == ')') + + cnt--; + + cp = vpastwh(linebuf); + + if (*cp == 0) + + goto again; + + if (cnt == 0) + + return (whitecnt(linebuf)); + + addr++; + + } + + wcursor = linebuf; + + linebuf[0] = 0; + + wdot = addr; + + dir = -1; + + llimit = one; + + lf = lindent; + + if (!lskipbal("()")) + + i = 0; + + else if (wcursor == linebuf) + + i = 2; + + else { + + register char *wp = wcursor; + + + + dir = 1; + + llimit = wdot; + + if (!lnext() || !ltosolid() || !lskipatom()) { + + wcursor = wp; + + i = 1; + + } else + + i = 0; + + i += column(wcursor) - 1; + + if (!inopen) + + i--; + + } + + wdot = swdot; + + wcursor = swcurs; + + return (i); + +} + +#endif + + + +lmatchp(addr) + + line *addr; + +{ + + register int i; + + register char *parens, *cp; + + - for (cp = cursor; !any(*cp, "({)}");) +++ for (cp = cursor; !any(*cp, "({[)}]");) + + if (*cp++ == 0) + + return (0); + + lf = 0; - parens = any(*cp, "()") ? "()" : "{}"; +++ parens = any(*cp, "()") ? "()" : any(*cp, "[]") ? "[]" : "{}"; + + if (*cp == parens[1]) { + + dir = -1; + + llimit = one; + + } else { + + dir = 1; + + llimit = dol; + + } + + if (addr) + + llimit = addr; + + if (splitw) + + llimit = dot; + + wcursor = cp; + + wdot = dot; + + i = lskipbal(parens); + + return (i); + +} + + + +lsmatch(cp) + + char *cp; + +{ + + char save[LBSIZE]; + + register char *sp = save; + + register char *scurs = cursor; + + + + wcursor = cp; + + strcpy(sp, linebuf); + + *wcursor = 0; + + strcpy(cursor, genbuf); + + cursor = strend(linebuf) - 1; + + if (lmatchp(dot - vcline)) { + + register int i = insmode; + + register int c = outcol; + + register int l = outline; + + + + if (!MI) + + endim(); + + vgoto(splitw ? WECHO : LINE(wdot - llimit), column(wcursor) - 1); + + flush(); + + sleep(1); + + vgoto(l, c); + + if (i) + + goim(); + + } +++ else { +++ strcLIN(sp); +++ strcpy(scurs, genbuf); +++ if (!lmatchp((line *) 0)) +++ beep(); +++ } + + strcLIN(sp); + + wdot = 0; + + wcursor = 0; + + cursor = scurs; + +} + + + +ltosolid() + +{ + + + + return (ltosol1("()")); + +} + + + +ltosol1(parens) + + register char *parens; + +{ + + register char *cp; + + + + if (*parens && !*wcursor && !lnext()) + + return (0); + + while (isspace(*wcursor) || (*wcursor == 0 && *parens)) + + if (!lnext()) + + return (0); + + if (any(*wcursor, parens) || dir > 0) + + return (1); + + for (cp = wcursor; cp > linebuf; cp--) + + if (isspace(cp[-1]) || any(cp[-1], parens)) + + break; + + wcursor = cp; + + return (1); + +} + + + +lskipbal(parens) + + register char *parens; + +{ + + register int level = dir; + + register int c; + + + + do { - if (!lnext()) +++ if (!lnext()) { +++ wdot = NOLINE; + + return (0); +++ } + + c = *wcursor; + + if (c == parens[1]) + + level--; + + else if (c == parens[0]) + + level++; + + } while (level); + + return (1); + +} + + + +lskipatom() + +{ + + + + return (lskipa1("()")); + +} + + + +lskipa1(parens) + + register char *parens; + +{ + + register int c; + + + + for (;;) { + + if (dir < 0 && wcursor == linebuf) { + + if (!lnext()) + + return (0); + + break; + + } + + c = *wcursor; + + if (c && (isspace(c) || any(c, parens))) + + break; + + if (!lnext()) + + return (0); + + if (dir > 0 && wcursor == linebuf) + + break; + + } + + return (ltosol1(parens)); + +} + + + +lnext() + +{ + + + + if (dir > 0) { + + if (*wcursor) + + wcursor++; + + if (*wcursor) + + return (1); + + if (wdot >= llimit) { - if (wcursor > linebuf) +++ if (lf == vmove && wcursor > linebuf) + + wcursor--; + + return (0); + + } + + wdot++; + + getline(*wdot); + + wcursor = linebuf; + + return (1); + + } else { + + --wcursor; + + if (wcursor >= linebuf) + + return (1); + +#ifdef LISPCODE + + if (lf == lindent && linebuf[0] == '(') + + llimit = wdot; + +#endif + + if (wdot <= llimit) { + + wcursor = linebuf; + + return (0); + + } + + wdot--; + + getline(*wdot); + + wcursor = linebuf[0] == 0 ? linebuf : strend(linebuf) - 1; + + return (1); + + } + +} + + + +lbrack(c, f) + + register int c; + + int (*f)(); + +{ + + register line *addr; + + + + addr = dot; + + for (;;) { + + addr += dir; + + if (addr < one || addr > dol) { + + addr -= dir; + + break; + + } + + getline(*addr); + + if (linebuf[0] == '{' || + +#ifdef LISPCODE + + value(LISP) && linebuf[0] == '(' || + +#endif + + isa(svalue(SECTIONS))) { + + if (c == ']' && f != vmove) { + + addr--; + + getline(*addr); + + } + + break; + + } + + if (c == ']' && f != vmove && linebuf[0] == '}') + + break; + + } + + if (addr == dot) + + return (0); + + if (f != vmove) + + wcursor = c == ']' ? strend(linebuf) : linebuf; + + else + + wcursor = 0; + + wdot = addr; + + vmoving = 0; + + return (1); + +} + + + +isa(cp) + + register char *cp; + +{ + + + + if (linebuf[0] != '.') + + return (0); + + for (; cp[0] && cp[1]; cp += 2) + + if (linebuf[1] == cp[0]) { + + if (linebuf[2] == cp[1]) + + return (1); + + if (linebuf[2] == 0 && cp[1] == ' ') + + return (1); + + } + + return (0); + +} diff --cc usr/src/cmd/ex/ex_vput.c index 0000000000,cadd33ab3c,0000000000..9411f83390 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vput.c +++ b/usr/src/cmd/ex/ex_vput.c @@@@ -1,0 -1,1331 -1,0 +1,1354 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vput.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Deal with the screen, clearing, cursor positioning, putting characters + + * into the screen image, and deleting characters. + + * Really hard stuff here is utilizing insert character operations + + * on intelligent terminals which differs widely from terminal to terminal. + + */ + +vclear() + +{ + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "------\nvclear\n"); + +#endif + + tputs(CL, LINES, putch); + + destcol = 0; + + outcol = 0; + + destline = 0; + + outline = 0; + + if (inopen) + + vclrbyte(vtube0, WCOLS * (WECHO - ZERO + 1)); + +} + + + +/* + + * Clear memory. + + */ + +vclrbyte(cp, i) + + register char *cp; + + register int i; + +{ + + + + if (i > 0) + + do + + *cp++ = 0; + + while (--i != 0); + +} + + + +/* + + * Clear a physical display line, high level. + + */ + +vclrlin(l, tp) + + int l; + + line *tp; + +{ + + + + vigoto(l, 0); + + if ((hold & HOLDAT) == 0) + + putchar(tp > dol ? ((UPPERCASE || HZ) ? '^' : '~') : '@'); + + if (state == HARDOPEN) + + sethard(); + + vclreol(); + +} + + + +/* + + * Clear to the end of the current physical line + + */ + +vclreol() + +{ + + register int i, j; + + register char *tp; + + + + if (destcol == WCOLS) + + return; + + destline += destcol / WCOLS; + + destcol %= WCOLS; + + if (destline < 0 || destline > WECHO) + + error("Internal error: vclreol"); + + i = WCOLS - destcol; + + tp = vtube[destline] + destcol; + + if (CE) { + + if (IN && *tp || !ateopr()) { + + vcsync(); + + vputp(CE, 1); + + } + + vclrbyte(tp, i); + + return; + + } + + if (*tp == 0) + + return; + + while (i > 0 && (j = *tp & (QUOTE|TRIM))) { + + if (j != ' ' && (j & QUOTE) == 0) { + + destcol = WCOLS - i; + + vputchar(' '); + + } + + --i, *tp++ = 0; + + } + +} + + + +/* + + * Clear the echo line. + + * If didphys then its been cleared physically (as + + * a side effect of a clear to end of display, e.g.) + + * so just do it logically. + + * If work here is being held off, just remember, in + + * heldech, if work needs to be done, don't do anything. + + */ + +vclrech(didphys) + + bool didphys; + +{ + + + + if (Peekkey == ATTN) + + return; + + if (hold & HOLDECH) { + + heldech = !didphys; + + return; + + } + + if (!didphys && (CD || CE)) { + + splitw++; + + /* + + * If display is retained below, then MUST use CD or CE + + * since we don't really know whats out there. + + * Vigoto might decide (incorrectly) to do nothing. + + */ - if (DB) - vgoto(WECHO, 0), vputp(CD ? CD : CE, 1); - else - vigoto(WECHO, 0), vclreol(); +++ if (DB) { +++ vgoto(WECHO, 0); +++ vputp(CD ? CD : CE, 1); +++ } else { +++ if (XT) { +++ /* +++ * This code basically handles the t1061 +++ * where positioning at (0, 0) won't work +++ * because the terminal won't let you put +++ * the cursor on it's magic cookie. +++ * +++ * Should probably be XS above, or even a +++ * new X? glitch, but right now t1061 is the +++ * only terminal with XT. +++ */ +++ vgoto(WECHO, 0); +++ vputp(DL, 1); +++ } else { +++ vigoto(WECHO, 0); +++ vclreol(); +++ } +++ } + + splitw = 0; + + didphys = 1; + + } + + if (didphys) + + vclrbyte(vtube[WECHO], WCOLS); + + heldech = 0; + +} + + + +/* + + * Fix the echo area for use, setting + + * the state variable splitw so we wont rollup + + * when we move the cursor there. + + */ + +fixech() + +{ + + + + splitw++; + + if (state != VISUAL && state != CRTOPEN) { + + vclean(); + + vcnt = 0; + + } + + vgoto(WECHO, 0); flusho(); + +} + + + +/* + + * Put the cursor ``before'' cp. + + */ + +vcursbef(cp) + + register char *cp; + +{ + + + + if (cp <= linebuf) + + vgotoCL(value(NUMBER) << 3); + + else + + vgotoCL(column(cp - 1) - 1); + +} + + + +/* + + * Put the cursor ``at'' cp. + + */ + +vcursat(cp) + + register char *cp; + +{ + + + + if (cp <= linebuf && linebuf[0] == 0) + + vgotoCL(value(NUMBER) << 3); + + else + + vgotoCL(column(cp - 1)); + +} + + + +/* + + * Put the cursor ``after'' cp. + + */ + +vcursaft(cp) + + register char *cp; + +{ + + + + vgotoCL(column(cp)); + +} + + + +/* + + * Fix the cursor to be positioned in the correct place + + * to accept a command. + + */ + +vfixcurs() + +{ + + + + vsetcurs(cursor); + +} + + + +/* + + * Compute the column position implied by the cursor at ``nc'', + + * and move the cursor there. + + */ + +vsetcurs(nc) + + register char *nc; + +{ + + register int col; + + + + col = column(nc); + + if (linebuf[0]) + + col--; + + vgotoCL(col); + + cursor = nc; + +} + + + +/* + + * Move the cursor invisibly, i.e. only remember to do it. + + */ + +vigoto(y, x) + + int y, x; + +{ + + + + destline = y; + + destcol = x; + +} + + + +/* + + * Move the cursor to the position implied by any previous + + * vigoto (or low level hacking with destcol/destline as in readecho). + + */ + +vcsync() + +{ + + + + vgoto(destline, destcol); + +} + + + +/* + + * Goto column x of the current line. + + */ + +vgotoCL(x) + + register int x; + +{ + + + + if (splitw) + + vgoto(WECHO, x); + + else + + vgoto(LINE(vcline), x); + +} + + + +/* + + * Invisible goto column x of current line. + + */ + +vigotoCL(x) + + register int x; + +{ + + + + if (splitw) + + vigoto(WECHO, x); + + else + + vigoto(LINE(vcline), x); + +} + + + +/* + + * Move cursor to line y, column x, handling wraparound and scrolling. + + */ + +vgoto(y, x) + + register int y, x; + +{ + + register char *tp; + + register int c; + + + + /* + + * Fold the possibly too large value of x. + + */ + + if (x >= WCOLS) { + + y += x / WCOLS; + + x %= WCOLS; + + } + + if (y < 0) + + error("Internal error: vgoto"); + + if (outcol >= WCOLS) { + + if (AM) { + + outline += outcol / WCOLS; + + outcol %= WCOLS; + + } else + + outcol = WCOLS - 1; + + } + + + + /* + + * In a hardcopy or glass crt open, print the stuff + + * implied by a motion, or backspace. + + */ + + if (state == HARDOPEN || state == ONEOPEN) { + + if (y != outline) + + error("Line too long for open"); + + if (x + 1 < outcol - x || (outcol > x && !BS)) + + destcol = 0, fgoto(); + + tp = vtube[WBOT] + outcol; + + while (outcol != x) + + if (outcol < x) { + + if (*tp == 0) + + *tp = ' '; + + c = *tp++ & TRIM; + + vputc(c && (!OS || EO) ? c : ' '), outcol++; + + } else { + + if (BC) + + vputp(BC, 0); + + else + + vputc('\b'); + + outcol--; + + } + + destcol = outcol = x; + + destline = outline; + + return; + + } + + + + /* + + * If the destination position implies a scroll, do it. + + */ + + destline = y; + + if (destline > WBOT && (!splitw || destline > WECHO)) { + + endim(); + + vrollup(destline); + + } + + + + /* + + * If there really is a motion involved, do it. + + * The check here is an optimization based on profiling. + + */ + + destcol = x; + + if ((destline - outline) * WCOLS != destcol - outcol) { + + if (!MI) + + endim(); + + fgoto(); + + } + +} + + + +/* + + * This is the hardest code in the editor, and deals with insert modes + + * on different kinds of intelligent terminals. The complexity is due + + * to the cross product of three factors: + + * + + * 1. Lines may display as more than one segment on the screen. + + * 2. There are 2 kinds of intelligent terminal insert modes. + + * 3. Tabs squash when you insert characters in front of them, + + * in a way in which current intelligent terminals don't handle. + + * + + * The two kinds of terminals are typified by the DM2500 or HP2645 for + + * one and the CONCEPT-100 or the FOX for the other. + + * + + * The first (HP2645) kind has an insert mode where the characters + + * fall off the end of the line and the screen is shifted rigidly + + * no matter how the display came about. + + * + + * The second (CONCEPT-100) kind comes from terminals which are designed + + * for forms editing and which distinguish between blanks and ``spaces'' + + * on the screen, spaces being like blank, but never having had + + * and data typed into that screen position (since, e.g. a clear operation + + * like clear screen). On these terminals, when you insert a character, + + * the characters from where you are to the end of the screen shift + + * over till a ``space'' is found, and the null character there gets + + * eaten up. + + * + + * + + * The code here considers the line as consisting of several parts + + * the first part is the ``doomed'' part, i.e. a part of the line + + * which is being typed over. Next comes some text up to the first + + * following tab. The tab is the next segment of the line, and finally + + * text after the tab. + + * + + * We have to consider each of these segments and the effect of the + + * insertion of a character on them. On terminals like HP2645's we + + * must simulate a multi-line insert mode using the primitive one + + * line insert mode. If we are inserting in front of a tab, we have + + * to either delete characters from the tab or insert white space + + * (when the tab reaches a new spot where it gets larger) before we + + * insert the new character. + + * + + * On a terminal like a CONCEPT our strategy is to make all + + * blanks be displayed, while trying to keep the screen having ``spaces'' + + * for portions of tabs. In this way the terminal hardward does some + + * of the hacking for compression of tabs, although this tends to + + * disappear as you work on the line and spaces change into blanks. + + * + + * There are a number of boundary conditions (like typing just before + + * the first following tab) where we can avoid a lot of work. Most + + * of them have to be dealt with explicitly because performance is + + * much, much worse if we don't. + + * + + * A final thing which is hacked here is two flavors of insert mode. + + * Datamedia's do this by an insert mode which you enter and leave + + * and by having normal motion character operate differently in this + + * mode, notably by having a newline insert a line on the screen in + + * this mode. This generally means it is unsafe to move around + + * the screen ignoring the fact that we are in this mode. + + * This is possible on some terminals, and wins big (e.g. HP), so + + * we encode this as a ``can move in insert capability'' mi, + + * and terminals which have it can do insert mode with much less + + * work when tabs are present following the cursor on the current line. + + */ + + + +/* + + * Routine to expand a tab, calling the normal Outchar routine + + * to put out each implied character. Note that we call outchar + + * with a QUOTE. We use QUOTE internally to represent a position + + * which is part of the expansion of a tab. + + */ + +vgotab() + +{ - register int i = (LINE(vcline) - destline) * WCOLS + destcol; +++ register int i = tabcol(destcol, value(TABSTOP)) - destcol; + + + + do + + (*Outchar)(QUOTE); - while (++i % value(TABSTOP)); +++ while (--i); + +} + + + +/* + + * Variables for insert mode. + + */ + +int linend; /* The column position of end of line */ + +int tabstart; /* Column of start of first following tab */ + +int tabend; /* Column of end of following tabs */ + +int tabsize; /* Size of the following tabs */ + +int tabslack; /* Number of ``spaces'' in following tabs */ + +int inssiz; /* Number of characters to be inserted */ + +int inscol; /* Column where insertion is taking place */ + +int shft; /* Amount tab expansion shifted rest of line */ + +int slakused; /* This much of tabslack will be used up */ + + + +/* + + * This routine MUST be called before insert mode is run, + + * and brings all segments of the current line to the top + + * of the screen image buffer so it is easier for us to + + * maniuplate them. + + */ + +vprepins() + +{ + + register int i; + + register char *cp = vtube0; + + + + for (i = 0; i < DEPTH(vcline); i++) { + + vmaktop(LINE(vcline) + i, cp); + + cp += WCOLS; + + } + +} + + + +vmaktop(p, cp) + + register int p; + + char *cp; + +{ + + register int i; + + char temp[TUBECOLS]; + + - if (vtube[p] == cp) +++ if (p < 0 || vtube[p] == cp) + + return; + + for (i = ZERO; i <= WECHO; i++) + + if (vtube[i] == cp) { + + copy(temp, vtube[i], WCOLS); + + copy(vtube[i], vtube[p], WCOLS); + + copy(vtube[p], temp, WCOLS); + + vtube[i] = vtube[p]; + + vtube[p] = cp; + + return; + + } + + error("Line too long"); + +} + + + +/* + + * Insert character c at current cursor position. + + * Multi-character inserts occur only as a result + + * of expansion of tabs (i.e. inssize == 1 except + + * for tabs) and code assumes this in several place + + * to make life simpler. + + */ + +vinschar(c) + + char c; + +{ + + register int i; + + register char *tp; + + + + if ((!IM || !EI) && ((hold & HOLDQIK) || !value(REDRAW) || value(SLOWOPEN))) { + + /* + + * Don't want to try to use terminal + + * insert mode, or to try to fake it. + + * Just put the character out; the screen + + * will probably be wrong but we will fix it later. + + */ + + if (c == '\t') { + + vgotab(); + + return; + + } + + vputchar(c); + + if (DEPTH(vcline) * WCOLS + !value(REDRAW) > + + (destline - LINE(vcline)) * WCOLS + destcol) + + return; + + /* + + * The next line is about to be clobbered + + * make space for another segment of this line + + * (on an intelligent terminal) or just remember + + * that next line was clobbered (on a dumb one + + * if we don't care to redraw the tail. + + */ + + if (AL) { + + vnpins(0); + + } else { + + c = LINE(vcline) + DEPTH(vcline); + + if (c < LINE(vcline + 1) || c > WBOT) + + return; + + i = destcol; + + vinslin(c, 1, vcline); + + DEPTH(vcline)++; + + vigoto(c, i); + + vprepins(); + + } + + return; + + } + + /* + + * Compute the number of positions in the line image of the + + * current line. This is done from the physical image + + * since that is faster. Note that we have no memory + + * from insertion to insertion so that routines which use + + * us don't have to worry about moving the cursor around. + + */ + + if (*vtube0 == 0) + + linend = 0; + + else { + + /* + + * Search backwards for a non-null character + + * from the end of the displayed line. + + */ + + i = WCOLS * DEPTH(vcline); + + if (i == 0) + + i = WCOLS; + + tp = vtube0 + i; + + while (*--tp == 0) + + if (--i == 0) + + break; + + linend = i; + + } + + + + /* + + * We insert at a position based on the physical location + + * of the output cursor. + + */ + + inscol = destcol + (destline - LINE(vcline)) * WCOLS; + + if (c == '\t') { + + /* + + * Characters inserted from a tab must be + + * remembered as being part of a tab, but we can't + + * use QUOTE here since we really need to print blanks. + + * QUOTE|' ' is the representation of this. + + */ - inssiz = value(TABSTOP) - inscol % value(TABSTOP); +++ inssiz = tabcol(inscol, value(TABSTOP)) - inscol; + + c = ' ' | QUOTE; + + } else + + inssiz = 1; + + + + /* + + * If the text to be inserted is less than the number + + * of doomed positions, then we don't need insert mode, + + * rather we can just typeover. + + */ + + if (inssiz <= doomed) { + + endim(); + + if (inscol != linend) + + doomed -= inssiz; + + do + + vputchar(c); + + while (--inssiz); + + return; + + } + + + + /* + + * Have to really do some insertion, thus + + * stake out the bounds of the first following + + * group of tabs, computing starting position, + + * ending position, and the number of ``spaces'' therein + + * so we can tell how much it will squish. + + */ + + tp = vtube0 + inscol; + + for (i = inscol; i < linend; i++) + + if (*tp++ & QUOTE) { + + --tp; + + break; + + } + + tabstart = tabend = i; + + tabslack = 0; + + while (tabend < linend) { + + i = *tp++; + + if ((i & QUOTE) == 0) + + break; + + if ((i & TRIM) == 0) + + tabslack++; + + tabsize++; + + tabend++; + + } + + tabsize = tabend - tabstart; + + + + /* + + * For HP's and DM's, e.g. tabslack has no meaning. + + */ + + if (!IN) + + tabslack = 0; + +#ifdef IDEBUG + + if (trace) { + + fprintf(trace, "inscol %d, inssiz %d, tabstart %d, ", + + inscol, inssiz, tabstart); + + fprintf(trace, "tabend %d, tabslack %d, linend %d\n", + + tabend, tabslack, linend); + + } + +#endif + + + + /* + + * The real work begins. + + */ + + slakused = 0; + + shft = 0; + + if (tabsize) { + + /* + + * There are tabs on this line. + + * If they need to expand, then the rest of the line + + * will have to be shifted over. In this case, + + * we will need to make sure there are no ``spaces'' + + * in the rest of the line (on e.g. CONCEPT-100) + + * and then grab another segment on the screen if this + + * line is now deeper. We then do the shift + + * implied by the insertion. + + */ - if (inssiz >= doomed + value(TABSTOP) - tabstart % value(TABSTOP)) { +++ if (inssiz >= doomed + tabcol(tabstart, value(TABSTOP)) - tabstart) { + + if (IN) + + vrigid(); + + vneedpos(value(TABSTOP)); + + vishft(); + + } + + } else if (inssiz > doomed) + + /* + + * No tabs, but line may still get deeper. + + */ + + vneedpos(inssiz - doomed); + + /* + + * Now put in the inserted characters. + + */ + + viin(c); + + + + /* + + * Now put the cursor in its final resting place. + + */ + + destline = LINE(vcline); + + destcol = inscol + inssiz; + + vcsync(); + +} + + + +/* + + * Rigidify the rest of the line after the first + + * group of following tabs, typing blanks over ``spaces''. + + */ + +vrigid() + +{ + + register int col; + + register char *tp = vtube0 + tabend; + + + + for (col = tabend; col < linend; col++) + + if ((*tp++ & TRIM) == 0) { + + endim(); + + vgotoCL(col); + + vputchar(' ' | QUOTE); + + } + +} + + + +/* + + * We need cnt more positions on this line. + + * Open up new space on the screen (this may in fact be a + + * screen rollup). + + * + + * On a dumb terminal we may infact redisplay the rest of the + + * screen here brute force to keep it pretty. + + */ + +vneedpos(cnt) + + int cnt; + +{ + + register int d = DEPTH(vcline); + + register int rmdr = d * WCOLS - linend; + + + + if (cnt <= rmdr - IN) + + return; + + endim(); + + vnpins(1); + +} + + + +vnpins(dosync) + + int dosync; + +{ + + register int d = DEPTH(vcline); + + register int e; + + + + e = LINE(vcline) + DEPTH(vcline); + + if (e < LINE(vcline + 1)) { + + vigoto(e, 0); + + vclreol(); + + return; + + } + + DEPTH(vcline)++; + + if (e < WECHO) { + + e = vglitchup(vcline, d); + + vigoto(e, 0); vclreol(); + + if (dosync) { +++ int (*Ooutchar)() = Outchar; + + Outchar = vputchar; + + vsync(e + 1); - Outchar = vinschar; +++ Outchar = Ooutchar; + + } + + } else { + + vup1(); + + vigoto(WBOT, 0); + + vclreol(); + + } + + vprepins(); + +} + + + +/* + + * Do the shift of the next tabstop implied by + + * insertion so it expands. + + */ + +vishft() + +{ + + int tshft = 0; + + int j; + + register int i; + + register char *tp = vtube0; + + register char *up; + + short oldhold = hold; + + + + shft = value(TABSTOP); + + hold |= HOLDPUPD; + + if (!IM && !EI) { + + /* + + * Dumb terminals are easy, we just have + + * to retype the text. + + */ + + vigotoCL(tabend + shft); + + up = tp + tabend; + + for (i = tabend; i < linend; i++) + + vputchar(*up++); + + } else if (IN) { + + /* + + * CONCEPT-like terminals do most of the work for us, + + * we don't have to muck with simulation of multi-line + + * insert mode. Some of the shifting may come for free + + * also if the tabs don't have enough slack to take up + + * all the inserted characters. + + */ + + i = shft; + + slakused = inssiz - doomed; + + if (slakused > tabslack) { + + i -= slakused - tabslack; + + slakused -= tabslack; + + } + + if (i > 0 && tabend != linend) { + + tshft = i; + + vgotoCL(tabend); + + goim(); + + do + + vputchar(' ' | QUOTE); + + while (--i); + + } + + } else { + + /* + + * HP and Datamedia type terminals have to have multi-line + + * insert faked. Hack each segment after where we are + + * (going backwards to where we are.) We then can + + * hack the segment where the end of the first following + + * tab group is. + + */ + + for (j = DEPTH(vcline) - 1; j > (tabend + shft) / WCOLS; j--) { + + vgotoCL(j * WCOLS); + + goim(); + + up = tp + j * WCOLS - shft; + + i = shft; - do - vputchar(*up++); - while (--i); +++ do { +++ if (*up) +++ vputchar(*up++); +++ else +++ break; +++ } while (--i); + + } + + vigotoCL(tabstart); + + i = shft - (inssiz - doomed); + + if (i > 0) { + + tabslack = inssiz - doomed; + + vcsync(); + + goim(); + + do + + vputchar(' '); + + while (--i); + + } + + } + + /* + + * Now do the data moving in the internal screen + + * image which is common to all three cases. + + */ + + tp += linend; + + up = tp + shft; + + i = linend - tabend; + + if (i > 0) + + do + + *--up = *--tp; + + while (--i); + + if (IN && tshft) { + + i = tshft; + + do + + *--up = ' ' | QUOTE; + + while (--i); + + } + + hold = oldhold; + +} + + + +/* + + * Now do the insert of the characters (finally). + + */ + +viin(c) + + char c; + +{ + + register char *tp, *up; + + register int i, j; + + register bool noim = 0; + + int remdoom; + + short oldhold = hold; + + + + hold |= HOLDPUPD; + + if (tabsize && (IM && EI) && inssiz - doomed > tabslack) + + /* + + * There is a tab out there which will be affected + + * by the insertion since there aren't enough doomed + + * characters to take up all the insertion and we do + + * have insert mode capability. + + */ + + if (inscol + doomed == tabstart) { + + /* + + * The end of the doomed characters sits right at the + + * start of the tabs, then we don't need to use insert + + * mode; unless the tab has already been expanded + + * in which case we MUST use insert mode. + + */ + + slakused = 0; + + noim = !shft; + + } else { + + /* + + * The last really special case to handle is case + + * where the tab is just sitting there and doesn't + + * have enough slack to let the insertion take + + * place without shifting the rest of the line + + * over. In this case we have to go out and + + * delete some characters of the tab before we start + + * or the answer will be wrong, as the rest of the + + * line will have been shifted. This code means + + * that terminals with only insert chracter (no + + * delete character) won't work correctly. + + */ + + i = inssiz - doomed - tabslack - slakused; + + i %= value(TABSTOP); + + if (i > 0) { + + vgotoCL(tabstart); + + godm(); + + for (i = inssiz - doomed - tabslack; i > 0; i--) + + vputp(DC, DEPTH(vcline)); + + enddm(); + + } + + } + + + + /* + + * Now put out the characters of the actual insertion. + + */ + + vigotoCL(inscol); + + remdoom = doomed; + + for (i = inssiz; i > 0; i--) { + + if (remdoom > 0) { + + remdoom--; + + endim(); + + } else if (noim) + + endim(); + + else if (IM && EI) { + + vcsync(); + + goim(); + + } + + vputchar(c); + + } + + + + if (!IM || !EI) { + + /* + + * We are a dumb terminal; brute force update + + * the rest of the line; this is very much an n^^2 process, + + * and totally unreasonable at low speed. + + * + + * You asked for it, you get it. + + */ + + tp = vtube0 + inscol + doomed; + + for (i = inscol + doomed; i < tabstart; i++) + + vputchar(*tp++); + + hold = oldhold; + + vigotoCL(tabstart + inssiz - doomed); + + for (i = tabsize - (inssiz - doomed) + shft; i > 0; i--) + + vputchar(' ' | QUOTE); + + } else { + + if (!IN) { + + /* + + * On terminals without multi-line + + * insert in the hardware, we must go fix the segments + + * between the inserted text and the following + + * tabs, if they are on different lines. + + * + + * Aaargh. + + */ + + tp = vtube0; + + for (j = (inscol + inssiz - 1) / WCOLS + 1; + + j <= (tabstart + inssiz - doomed - 1) / WCOLS; j++) { + + vgotoCL(j * WCOLS); + + i = inssiz - doomed; + + up = tp + j * WCOLS - i; + + goim(); + + do + + vputchar(*up++); + + while (--i && *up); + + } + + } else { + + /* + + * On terminals with multi line inserts, + + * life is simpler, just reflect eating of + + * the slack. + + */ + + tp = vtube0 + tabend; + + for (i = tabsize - (inssiz - doomed); i >= 0; i--) { + + if ((*--tp & (QUOTE|TRIM)) == QUOTE) { + + --tabslack; + + if (tabslack >= slakused) + + continue; + + } + + *tp = ' ' | QUOTE; + + } + + } + + /* + + * Blank out the shifted positions to be tab positions. + + */ + + if (shft) { + + tp = vtube0 + tabend + shft; + + for (i = tabsize - (inssiz - doomed) + shft; i > 0; i--) + + if ((*--tp & QUOTE) == 0) + + *tp = ' ' | QUOTE; + + } + + } + + + + /* + + * Finally, complete the screen image update + + * to reflect the insertion. + + */ + + hold = oldhold; + + tp = vtube0 + tabstart; up = tp + inssiz - doomed; + + for (i = tabstart; i > inscol + doomed; i--) + + *--up = *--tp; + + for (i = inssiz; i > 0; i--) + + *--up = c; + + doomed = 0; + +} + + + +/* + + * Go into ``delete mode''. If the + + * sequence which goes into delete mode + + * is the same as that which goes into insert + + * mode, then we are in delete mode already. + + */ + +godm() + +{ + + + + if (insmode) { + + if (eq(DM, IM)) + + return; + + endim(); + + } + + vputp(DM, 0); + +} + + + +/* + + * If we are coming out of delete mode, but + + * delete and insert mode end with the same sequence, + + * it wins to pretend we are now in insert mode, + + * since we will likely want to be there again soon + + * if we just moved over to delete space from part of + + * a tab (above). + + */ + +enddm() + +{ + + + + if (eq(DM, IM)) { + + insmode = 1; + + return; + + } + + vputp(ED, 0); + +} + + + +/* + + * In and out of insert mode. + + * Note that the code here demands that there be + + * a string for insert mode (the null string) even + + * if the terminal does all insertions a single character + + * at a time, since it branches based on whether IM is null. + + */ + +goim() + +{ + + + + if (!insmode) + + vputp(IM, 0); + + insmode = 1; + +} + + + +endim() + +{ + + + + if (insmode) { + + vputp(EI, 0); + + insmode = 0; + + } + +} + + + +/* + + * Put the character c on the screen at the current cursor position. + + * This routine handles wraparound and scrolling and understands not + + * to roll when splitw is set, i.e. we are working in the echo area. + + * There is a bunch of hacking here dealing with the difference between + + * QUOTE, QUOTE|' ', and ' ' for CONCEPT-100 like terminals, and also + + * code to deal with terminals which overstrike, including CRT's where + + * you can erase overstrikes with some work. CRT's which do underlining + + * implicitly which has to be erased (like CONCEPTS) are also handled. + + */ + +vputchar(c) + + register int c; + +{ + + register char *tp; + + register int d; + + + + c &= (QUOTE|TRIM); + +#ifdef TRACE + + if (trace) + + tracec(c); + +#endif - /* Patch to fix problem of >79 chars on echo line: don't echo extras */ +++ /* Fix problem of >79 chars on echo line. */ + + if (destcol >= WCOLS-1 && splitw && destline == WECHO) - return; +++ pofix(); + + if (destcol >= WCOLS) { + + destline += destcol / WCOLS; + + destcol %= WCOLS; + + } + + if (destline > WBOT && (!splitw || destline > WECHO)) + + vrollup(destline); + + tp = vtube[destline] + destcol; + + switch (c) { + + + + case '\t': + + vgotab(); + + return; + + + + case ' ': + + /* + + * We can get away without printing a space in a number + + * of cases, but not always. We get away with doing nothing + + * if we are not in insert mode, and not on a CONCEPT-100 + + * like terminal, and either not in hardcopy open or in hardcopy + + * open on a terminal with no overstriking, provided, + + * in all cases, that nothing has ever been displayed + + * at this position. Ugh. + + */ + + if (!insmode && !IN && (state != HARDOPEN || OS) && (*tp&TRIM) == 0) { + + *tp = ' '; + + destcol++; + + return; + + } + + goto def; + + + + case QUOTE: + + if (insmode) { + + /* + + * When in insert mode, tabs have to expand + + * to real, printed blanks. + + */ + + c = ' ' | QUOTE; + + goto def; + + } + + if (*tp == 0) { + + /* + + * A ``space''. + + */ + + if ((hold & HOLDPUPD) == 0) + + *tp = QUOTE; + + destcol++; + + return; + + } + + /* + + * A ``space'' ontop of a part of a tab. + + */ + + if (*tp & QUOTE) { + + destcol++; + + return; + + } + + c = ' ' | QUOTE; + + /* fall into ... */ + + + +def: + + default: + + d = *tp & TRIM; + + /* + + * Now get away with doing nothing if the characters + + * are the same, provided we are not in insert mode + + * and if we are in hardopen, that the terminal has overstrike. + + */ + + if (d == (c & TRIM) && !insmode && (state != HARDOPEN || OS)) { + + if ((hold & HOLDPUPD) == 0) + + *tp = c; + + destcol++; + + return; + + } + + /* + + * Backwards looking optimization. + + * The low level cursor motion routines will use + + * a cursor motion right sequence to step 1 character + + * right. On, e.g., a DM3025A this is 2 characters + + * and printing is noticeably slower at 300 baud. + + * Since the low level routines are not allowed to use + + * spaces for positioning, we discover the common + + * case of a single space here and force a space + + * to be printed. + + */ + + if (destcol == outcol + 1 && tp[-1] == ' ' && outline == destline) { + + vputc(' '); + + outcol++; + + } + + + + /* + + * This is an inline expansion a call to vcsync() dictated + + * by high frequency in a profile. + + */ + + if (outcol != destcol || outline != destline) + + vgoto(destline, destcol); + + + + /* + + * Deal with terminals which have overstrike. + + * We handle erasing general overstrikes, erasing + + * underlines on terminals (such as CONCEPTS) which + + * do underlining correctly automatically (e.g. on nroff + + * output), and remembering, in hardcopy mode, + + * that we have overstruct something. + + */ + + if (!insmode && d && d != ' ' && d != (c & TRIM)) { + + if (EO && (OS || UL && (c == '_' || d == '_'))) { + + vputc(' '); + + outcol++, destcol++; + + back1(); + + } else + + rubble = 1; + + } + + + + /* + + * Unless we are just bashing characters around for + + * inner working of insert mode, update the display. + + */ + + if ((hold & HOLDPUPD) == 0) + + *tp = c; + + + + /* + + * In insert mode, put out the IC sequence, padded + + * based on the depth of the current line. + + * A terminal which had no real insert mode, rather + + * opening a character position at a time could do this. + + * Actually should use depth to end of current line + + * but this rarely matters. + + */ + + if (insmode) + + vputp(IC, DEPTH(vcline)); + + vputc(c & TRIM); + + + + /* + + * In insert mode, IP is a post insert pad. + + */ + + if (insmode) + + vputp(IP, DEPTH(vcline)); + + destcol++, outcol++; + + + + /* + + * CONCEPT braindamage in early models: after a wraparound + + * the next newline is eaten. It's hungry so we just + + * feed it now rather than worrying about it. + + */ + + if (XN && outcol % WCOLS == 0) + + vputc('\n'); + + } + +} + + + +/* + + * Delete display positions stcol through endcol. + + * Amount of use of special terminal features here is limited. + + */ + +physdc(stcol, endcol) + + int stcol, endcol; + +{ + + register char *tp, *up; + + char *tpe; + + register int i; + + register int nc = endcol - stcol; + + + +#ifdef IDEBUG + + if (trace) + + tfixnl(), fprintf(trace, "physdc(%d, %d)\n", stcol, endcol); + +#endif + + if (!DC || nc <= 0) + + return; + + if (IN) { + + /* + + * CONCEPT-100 like terminal. + + * If there are any ``spaces'' in the material to be + + * deleted, then this is too hard, just retype. + + */ + + vprepins(); + + up = vtube0 + stcol; + + i = nc; + + do + + if ((*up++ & (QUOTE|TRIM)) == QUOTE) + + return; + + while (--i); + + i = 2 * nc; + + do + + if (*up == 0 || (*up++ & QUOTE) == QUOTE) + + return; + + while (--i); + + vgotoCL(stcol); + + } else { + + /* + + * HP like delete mode. + + * Compute how much text we are moving over by deleting. + + * If it appears to be faster to just retype + + * the line, do nothing and that will be done later. + + * We are assuming 2 output characters per deleted + + * characters and that clear to end of line is available. + + */ + + i = stcol / WCOLS; + + if (i != endcol / WCOLS) + + return; + + i += LINE(vcline); + + stcol %= WCOLS; + + endcol %= WCOLS; + + up = vtube[i]; tp = up + endcol; tpe = up + WCOLS; + + while (tp < tpe && *tp) + + tp++; + + if (tp - (up + stcol) < 2 * nc) + + return; + + vgoto(i, stcol); + + } + + + + /* + + * Go into delete mode and do the actual delete. + + * Padding is on DC itself. + + */ + + godm(); + + for (i = nc; i > 0; i--) + + vputp(DC, DEPTH(vcline)); + + vputp(ED, 0); + + + + /* + + * Straighten up. + + * With CONCEPT like terminals, characters are pulled left + + * from first following null. HP like terminals shift rest of + + * this (single physical) line rigidly. + + */ + + if (IN) { + + up = vtube0 + stcol; + + tp = vtube0 + endcol; + + while (i = *tp++) { + + if ((i & (QUOTE|TRIM)) == QUOTE) + + break; + + *up++ = i; + + } + + do + + *up++ = i; + + while (--nc); + + } else { + + copy(up + stcol, up + endcol, WCOLS - endcol); + + vclrbyte(tpe - nc, nc); + + } + +} + + + +#ifdef TRACE + +tfixnl() + +{ + + + + if (trubble || techoin) + + fprintf(trace, "\n"); + + trubble = 0, techoin = 0; + +} + + + +tvliny() + +{ + + register int i; + + + + if (!trace) + + return; + + tfixnl(); + + fprintf(trace, "vcnt = %d, vcline = %d, vliny = ", vcnt, vcline); + + for (i = 0; i <= vcnt; i++) { + + fprintf(trace, "%d", LINE(i)); + + if (FLAGS(i) & VDIRT) + + fprintf(trace, "*"); + + if (DEPTH(i) != 1) + + fprintf(trace, "<%d>", DEPTH(i)); + + if (i < vcnt) + + fprintf(trace, " "); + + } + + fprintf(trace, "\n"); + +} + + + +tracec(c) + + char c; + +{ + + + + if (!techoin) + + trubble = 1; + + if (c == ESCAPE) + + fprintf(trace, "$"); + + else if (c < ' ' || c == DELETE) + + fprintf(trace, "^%c", ctlof(c)); + + else + + fprintf(trace, "%c", c); + +} + +#endif + + + +/* + + * Put a character with possible tracing. + + */ + +vputch(c) + + int c; + +{ + + + +#ifdef TRACE + + if (trace) + + tracec(c); + +#endif + + vputc(c); + +} diff --cc usr/src/cmd/ex/ex_vwind.c index 0000000000,18f1104321,0000000000..72f63933f6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/ex_vwind.c +++ b/usr/src/cmd/ex/ex_vwind.c @@@@ -1,0 -1,460 -1,0 +1,461 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)ex_vwind.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_tty.h" + +#include "ex_vis.h" + + + +/* + + * Routines to adjust the window, showing specified lines + + * in certain positions on the screen, and scrolling in both + + * directions. Code here is very dependent on mode (open versus visual). + + */ + + + +/* + + * Move in a nonlocal way to line addr. + + * If it isn't on screen put it in specified context. + + * New position for cursor is curs. + + * Like most routines here, we vsave(). + + */ + +vmoveto(addr, curs, context) + + register line *addr; + + char *curs; + + char context; + +{ + + + + markit(addr); + + vsave(); + + vjumpto(addr, curs, context); + +} + + + +/* + + * Vjumpto is like vmoveto, but doesn't mark previous + + * context or save linebuf as current line. + + */ + +vjumpto(addr, curs, context) + + register line *addr; + + char *curs; + + char context; + +{ + + + + noteit(0); + + if (context != 0) + + vcontext(addr, context); + + else + + vshow(addr, NOLINE); + + noteit(1); + + vnline(curs); + +} + + + +/* + + * Go up or down cnt (negative is up) to new position curs. + + */ + +vupdown(cnt, curs) + + register int cnt; + + char *curs; + +{ + + + + if (cnt > 0) + + vdown(cnt, 0, 0); + + else if (cnt < 0) + + vup(-cnt, 0, 0); + + if (vcnt == 0) + + vrepaint(curs); + + else + + vnline(curs); + +} + + + +/* + + * Go up cnt lines, afterwards preferring to be ind + + * logical lines from the top of the screen. + + * If scroll, then we MUST use a scroll. + + * Otherwise clear and redraw if motion is far. + + */ + +vup(cnt, ind, scroll) + + register int cnt, ind; + + bool scroll; + +{ + + register int i, tot; + + + + if (dot == one) { + + beep(); + + return; + + } + + vsave(); + + i = lineDOT() - 1; + + if (cnt > i) { + + ind -= cnt - i; + + if (ind < 0) + + ind = 0; + + cnt = i; + + } + + if (!scroll && cnt <= vcline) { + + vshow(dot - cnt, NOLINE); + + return; + + } + + cnt -= vcline, dot -= vcline, vcline = 0; + + if (hold & HOLDWIG) + + goto contxt; + + if (state == VISUAL && !AL && !SR && + + cnt <= WTOP - ZERO && vfit(dot - cnt, cnt) <= WTOP - ZERO) + + goto okr; + + tot = WECHO - ZERO; + + if (state != VISUAL || (!AL && !SR) || (!scroll && (cnt > tot || vfit(dot - cnt, cnt) > tot / 3 + 1))) { + + if (ind > basWLINES / 2) + + ind = basWLINES / 3; + +contxt: + + vcontext(dot + ind - cnt, '.'); + + return; + + } + +okr: + + vrollR(cnt); + + if (scroll) { + + vcline += ind, dot += ind; + + if (vcline >= vcnt) + + dot -= vcline - vcnt + 1, vcline = vcnt - 1; + + getDOT(); + + } + +} + + + +/* + + * Like vup, but scrolling down. + + */ + +vdown(cnt, ind, scroll) + + register int cnt, ind; + + bool scroll; + +{ + + register int i, tot; + + + + if (dot == dol) { + + beep(); + + return; + + } + + vsave(); + + i = dol - dot; + + if (cnt > i) { + + ind -= cnt - i; + + if (ind < 0) + + ind = 0; + + cnt = i; + + } + + i = vcnt - vcline - 1; + + if (!scroll && cnt <= i) { + + vshow(dot + cnt, NOLINE); + + return; + + } + + cnt -= i, dot += i, vcline += i; + + if (hold & HOLDWIG) + + goto dcontxt; + + if (!scroll) { + + tot = WECHO - ZERO; + + if (state != VISUAL || cnt - tot > 0 || vfit(dot, cnt) > tot / 3 + 1) { + +dcontxt: + + vcontext(dot + cnt, '.'); + + return; + + } + + } + + if (cnt > 0) + + vroll(cnt); + + if (state == VISUAL && scroll) { + + vcline -= ind, dot -= ind; + + if (vcline < 0) + + dot -= vcline, vcline = 0; + + getDOT(); + + } + +} + + + +/* + + * Show line addr in context where on the screen. + + * Work here is in determining new top line implied by + + * this placement of line addr, since we always draw from the top. + + */ + +vcontext(addr, where) + + register line *addr; + + char where; + +{ + + register line *top; + + + + getline(*addr); + + if (state != VISUAL) + + top = addr; + + else switch (where) { + + + + case '^': + + addr = vback(addr, basWLINES - vdepth()); + + getline(*addr); + + /* fall into ... */ + + + + case '-': + + top = vback(addr, basWLINES - vdepth()); + + getline(*addr); + + break; + + + + case '.': + + top = vback(addr, basWLINES / 2 - vdepth()); + + getline(*addr); + + break; + + + + default: + + top = addr; + + break; + + } + + if (state == ONEOPEN && LINE(0) == WBOT) + + vup1(); + + vcnt = vcline = 0; + + vclean(); + + if (state == CRTOPEN) + + vup1(); + + vshow(addr, top); + +} + + + +/* + + * Get a clean line. If we are in a hard open + + * we may be able to reuse the line we are on + + * if it is blank. This is a real win. + + */ + +vclean() + +{ + + + + if (state != VISUAL && state != CRTOPEN) { + + destcol = 0; + + if (!ateopr()) + + vup1(); + + vcnt = 0; + + } + +} + + + +/* + + * Show line addr with the specified top line on the screen. + + * Top may be 0; in this case have vcontext compute the top + + * (and call us recursively). Eventually, we clear the screen + + * (or its open mode equivalent) and redraw. + + */ + +vshow(addr, top) + + line *addr, *top; + +{ + +#ifndef CBREAK + + register bool fried = 0; + +#endif + + register int cnt = addr - dot; + + register int i = vcline + cnt; + + short oldhold = hold; + + + + if (state != HARDOPEN && state != ONEOPEN && i >= 0 && i < vcnt) { + + dot = addr; + + getDOT(); + + vcline = i; + + return; + + } + + if (state != VISUAL) { + + dot = addr; + + vopen(dot, WBOT); + + return; + + } + + if (top == 0) { + + vcontext(addr, '.'); + + return; + + } + + dot = top; + +#ifndef CBREAK + + if (vcookit(2)) + + fried++, vcook(); + +#endif + + oldhold = hold; + + hold |= HOLDAT; + + vclear(); + + vreset(0); + + vredraw(WTOP); + + /* error if vcline >= vcnt ! */ + + vcline = addr - top; + + dot = addr; + + getDOT(); + + hold = oldhold; + + vsync(LASTLINE); + +#ifndef CBREAK + + if (fried) + + flusho(), vraw(); + +#endif + +} + + + +/* + + * reset the state. + + * If inecho then leave us at the beginning of the echo + + * area; we are called this way in the middle of a :e escape + + * from visual, e.g. + + */ + +vreset(inecho) + + bool inecho; + +{ + + + + vcnt = vcline = 0; + + WTOP = basWTOP; + + WLINES = basWLINES; + + if (inecho) + + splitw = 1, vgoto(WECHO, 0); + +} + + + +/* + + * Starting from which line preceding tp uses almost (but not more + + * than) cnt physical lines? + + */ + +line * + +vback(tp, cnt) + + register int cnt; + + register line *tp; + +{ + + register int d; + + + + if (cnt > 0) + + for (; tp > one; tp--) { + + getline(tp[-1]); + + d = vdepth(); + + if (d > cnt) + + break; + + cnt -= d; + + } + + return (tp); + +} + + + +/* + + * How much scrolling will it take to roll cnt lines starting at tp? + + */ + +vfit(tp, cnt) + + register line *tp; + + int cnt; + +{ + + register int j; + + + + j = 0; + + while (cnt > 0) { + + cnt--; + + getline(tp[cnt]); + + j += vdepth(); + + } + + if (tp > dot) + + j -= WBOT - LASTLINE; + + return (j); + +} + + + +/* + + * Roll cnt lines onto the screen. + + */ + +vroll(cnt) + + register int cnt; + +{ + +#ifndef CBREAK + + register bool fried = 0; + +#endif + + short oldhold = hold; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vroll(%d)\n", cnt); + +#endif + + if (state != VISUAL) + + hold |= HOLDAT|HOLDROL; + + if (WBOT == WECHO) { + + vcnt = 0; + + if (state == ONEOPEN) + + vup1(); + + } + +#ifndef CBREAK + + if (vcookit(cnt)) + + fried++, vcook(); + +#endif + + for (; cnt > 0 && Peekkey != ATTN; cnt--) { + + dot++, vcline++; + + vopen(dot, LASTLINE); + + vscrap(); + + } + + hold = oldhold; + + if (state == HARDOPEN) + + sethard(); + + vsyncCL(); + +#ifndef CBREAK + + if (fried) + + flusho(), vraw(); + +#endif + +} + + + +/* + + * Roll backwards (scroll up). + + */ + +vrollR(cnt) + + register int cnt; + +{ + + register bool fried = 0; + + short oldhold = hold; + + + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vrollR(%d), dot=%d\n", cnt, lineDOT()); + +#endif + +#ifndef CBREAK + + if (vcookit(cnt)) + + fried++, vcook(); + +#endif + + if (WBOT == WECHO) + + vcnt = 0; + + heldech = 0; + + hold |= HOLDAT|HOLDECH; + + for (; cnt > 0 && Peekkey != ATTN; cnt--) { + + dot--; + + vopen(dot, WTOP); + + vscrap(); + + } + + hold = oldhold; + + if (heldech) + + vclrech(0); + + vsync(LINE(vcnt-1)); + +#ifndef CBREAK + + if (fried) + + flusho(), vraw(); + +#endif + +} + + + +/* + + * Go into cooked mode (allow interrupts) during + + * a scroll if we are at less than 1200 baud and not + + * a 'vi' command, of if we are in a 'vi' command and the + + * scroll is more than 2 full screens. + + * + + * BUG: An interrupt during a scroll in this way + + * dumps to command mode. + + */ + +vcookit(cnt) + + register int cnt; + +{ + + + + return (cnt > 1 && (ospeed < B1200 && !initev || cnt > LINES * 2)); + +} + + + +/* + + * Determine displayed depth of current line. + + */ + +vdepth() + +{ + + register int d; + + + + d = (column(NOSTR) + WCOLS - 1 + (Putchar == listchar) + IN) / WCOLS; + +#ifdef ADEBUG + + if (trace) + + tfixnl(), fprintf(trace, "vdepth returns %d\n", d == 0 ? 1 : d); + +#endif + + return (d == 0 ? 1 : d); + +} + + + +/* + + * Move onto a new line, with cursor at position curs. + + */ + +vnline(curs) + + char *curs; + +{ + + + + if (curs) + + wcursor = curs; + + else if (vmoving) + + wcursor = vfindcol(vmovcol); + + else + + wcursor = vskipwh(linebuf); + + cursor = linebuf; + + vmove(); + +} diff --cc usr/src/cmd/ex/expreserve.c index 0000000000,373aa699c0,0000000000..ec901dd6df mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/expreserve.c +++ b/usr/src/cmd/ex/expreserve.c @@@@ -1,0 -1,358 -1,0 +1,364 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)expreserve.c 6.1 10/18/80"; + +#include + +#include + +#include + +#include + +#include + +#include + +#include "local/uparm.h" + + + +#ifdef VMUNIX + +#define HBLKS 2 + +#else + +#define HBLKS 1 + +#endif + + + +/* + + * Expreserve - preserve a file in usrpath(preserve) + + * Bill Joy UCB November 13, 1977 + + * + + * This routine is very naive - it doesn't remove anything from + + * usrpath(preserve)... this may mean that we will be unable to preserve + + * stuff there... the danger in doing anything with usrpath(preserve) + + * is that the clock may be screwed up and we may get confused. + + * + + * We are called in two ways - first from the editor with no argumentss + + * and the standard input open on the temp file. Second with an argument + + * to preserve the entire contents of /tmp (root only). + + * + + * BUG: should do something about preserving Rx... (register contents) + + * temporaries. + + */ + + + +#ifndef VMUNIX + +#define LBLKS 125 + +#else + +#define LBLKS 900 + +#endif + +#define FNSIZE 128 + + + +struct header { + + time_t Time; /* Time temp file last updated */ + + short Uid; /* This users identity */ + +#ifndef VMUNIX + + short Flines; /* Number of lines in file */ + +#else + + int Flines; + +#endif + + char Savedfile[FNSIZE]; /* The current file name */ + + short Blocks[LBLKS]; /* Blocks where line pointers stashed */ + +} H; + + + +#ifdef lint + +#define ignore(a) Ignore(a) + +#define ignorl(a) Ignorl(a) + +#else + +#define ignore(a) a + +#define ignorl(a) a + +#endif + + + +struct passwd *getpwuid(); + +off_t lseek(); + +FILE *popen(); + + + +#define eq(a, b) strcmp(a, b) == 0 + + + +main(argc) + + int argc; + +{ + + register FILE *tf; + + struct direct dirent; + + struct stat stbuf; + + + + /* + + * If only one argument, then preserve the standard input. + + */ + + if (argc == 1) { + + if (copyout((char *) 0)) + + exit(1); + + exit(0); + + } + + + + /* + + * If not super user, then can only preserve standard input. + + */ + + if (getuid()) { + + fprintf(stderr, "NOT super user\n"); + + exit(1); + + } + + + + /* + + * ... else preserve all the stuff in /tmp, removing + + * it as we go. + + */ + + if (chdir("/tmp") < 0) { + + perror("/tmp"); + + exit(1); + + } + + + + tf = fopen(".", "r"); + + if (tf == NULL) { + + perror("/tmp"); + + exit(1); + + } + + while (fread((char *) &dirent, sizeof dirent, 1, tf) == 1) { + + if (dirent.d_ino == 0) + + continue; + + /* + + * Ex temporaries must begin with Ex; + + * we check that the 10th character of the name is null + + * so we won't have to worry about non-null terminated names + + * later on. + + */ + + if (dirent.d_name[0] != 'E' || dirent.d_name[1] != 'x' || dirent.d_name[10]) + + continue; + + if (stat(dirent.d_name, &stbuf)) + + continue; + + if ((stbuf.st_mode & S_IFMT) != S_IFREG) + + continue; + + /* + + * Save the bastard. + + */ + + ignore(copyout(dirent.d_name)); + + } + + exit(0); + +} + + + +char pattern[] = usrpath(preserve/Exaa`XXXXX); + + + +/* + + * Copy file name into usrpath(preserve)/... + + * If name is (char *) 0, then do the standard input. + + * We make some checks on the input to make sure it is + + * really an editor temporary, generate a name for the + + * file (this is the slowest thing since we must stat + + * to find a unique name), and finally copy the file. + + */ + +copyout(name) + + char *name; + +{ + + int i; + + static int reenter; + + char buf[BUFSIZ]; + + + + /* + + * The first time we put in the digits of our + + * process number at the end of the pattern. + + */ + + if (reenter == 0) { + + mkdigits(pattern); + + reenter++; + + } + + + + /* + + * If a file name was given, make it the standard + + * input if possible. + + */ + + if (name != 0) { + + ignore(close(0)); + + /* + + * Need read/write access for arcane reasons + + * (see below). + + */ + + if (open(name, 2) < 0) + + return (-1); + + } + + + + /* + + * Get the header block. + + */ + + ignorl(lseek(0, 0l, 0)); + + if (read(0, (char *) &H, sizeof H) != sizeof H) { + +format: + + if (name == 0) - fprintf(stderr, "Buffer format error\n"); +++ fprintf(stderr, "Buffer format error\t"); + + return (-1); + + } + + + + /* + + * Consistency checsks so we don't copy out garbage. + + */ + + if (H.Flines < 0) { + +#ifdef DEBUG + + fprintf(stderr, "Negative number of lines\n"); + +#endif + + goto format; + + } + + if (H.Blocks[0] != HBLKS || H.Blocks[1] != HBLKS+1) { + +#ifdef DEBUG + + fprintf(stderr, "Blocks %d %d\n", H.Blocks[0], H.Blocks[1]); + +#endif + + goto format; + + } + + if (name == 0 && H.Uid != getuid()) { + +#ifdef DEBUG + + fprintf(stderr, "Wrong user-id\n"); + +#endif + + goto format; + + } + + if (lseek(0, 0l, 0)) { + +#ifdef DEBUG + + fprintf(stderr, "Negative number of lines\n"); + +#endif + + goto format; + + } + + + + /* + + * If no name was assigned to the file, then give it the name + + * LOST, by putting this in the header. + + */ + + if (H.Savedfile[0] == 0) { + + strcpy(H.Savedfile, "LOST"); + + ignore(write(0, (char *) &H, sizeof H)); + + H.Savedfile[0] = 0; + + lseek(0, 0l, 0); + + } + + + + /* + + * File is good. Get a name and create a file for the copy. + + */ + + mknext(pattern); + + ignore(close(1)); + + if (creat(pattern, 0600) < 0) { + + if (name == 0) + + perror(pattern); + + return (1); + + } + + + + /* + + * Make the target be owned by the owner of the file. + + */ + + ignore(chown(pattern, H.Uid, 0)); + + + + /* + + * Copy the file. + + */ + + for (;;) { + + i = read(0, buf, BUFSIZ); + + if (i < 0) { + + if (name) + + perror("Buffer read error"); + + ignore(unlink(pattern)); + + return (-1); + + } + + if (i == 0) { + + if (name) + + ignore(unlink(name)); + + notify(H.Uid, H.Savedfile, (int) name); + + return (0); + + } + + if (write(1, buf, i) != i) { + + if (name == 0) + + perror(pattern); + + unlink(pattern); + + return (-1); + + } + + } + +} + + + +/* + + * Blast the last 5 characters of cp to be the process number. + + */ + +mkdigits(cp) + + char *cp; + +{ + + register int i, j; + + + + for (i = getpid(), j = 5, cp += strlen(cp); j > 0; i /= 10, j--) + + *--cp = i % 10 | '0'; + +} + + + +/* + + * Make the name in cp be unique by clobbering up to + + * three alphabetic characters into a sequence of the form 'aab', 'aac', etc. + + * Mktemp gets weird names too quickly to be useful here. + + */ + +mknext(cp) + + char *cp; + +{ + + char *dcp; + + struct stat stb; + + + + dcp = cp + strlen(cp) - 1; + + while (isdigit(*dcp)) + + dcp--; + +whoops: + + if (dcp[0] == 'z') { + + dcp[0] = 'a'; + + if (dcp[-1] == 'z') { + + dcp[-1] = 'a'; + + if (dcp[-2] == 'z') - fprintf(stderr, "Can't find a name\n"); +++ fprintf(stderr, "Can't find a name\t"); + + dcp[-2]++; + + } else + + dcp[-1]++; + + } else + + dcp[0]++; + + if (stat(cp, &stb) == 0) + + goto whoops; + +} + + + +/* + + * Notify user uid that his file fname has been saved. + + */ + +notify(uid, fname, flag) + + int uid; + + char *fname; + +{ + + struct passwd *pp = getpwuid(uid); + + register FILE *mf; + + char cmd[BUFSIZ]; + + + + if (pp == NULL) + + return; + + sprintf(cmd, "mail %s", pp->pw_name); + + mf = popen(cmd, "w"); + + if (mf == NULL) + + return; + + setbuf(mf, cmd); + + if (fname[0] == 0) { + + fprintf(mf, + +"A copy of an editor buffer of yours was saved when %s.\n", - flag ? "the system went down" : "your phone was hung up"); +++ flag ? "the system went down" : "the editor was killed"); + + fprintf(mf, + +"No name was associated with this buffer so it has been named \"LOST\".\n"); + + } else + + fprintf(mf, + +"A copy of an editor buffer of your file \"%s\"\nwas saved when %s.\n", fname, - flag ? "the system went down" : "your phone was hung up"); +++ /* +++ * "the editor was killed" is perhaps still not an ideal +++ * error message. Usually, either it was forcably terminated +++ * or the phone was hung up, but we don't know which. +++ */ +++ flag ? "the system went down" : "the editor was killed"); + + fprintf(mf, + +"This buffer can be retrieved using the \"recover\" command of the editor.\n"); + + fprintf(mf, + +"An easy way to do this is to give the command \"ex -r %s\".\n",fname); + + fprintf(mf, + +"This works for \"edit\" and \"vi\" also.\n"); + + pclose(mf); + +} + + + +/* + + * people making love + + * never exactly the same + + * just like a snowflake + + */ + + + +#ifdef lint + +Ignore(a) + + int a; + +{ + + + + a = a; + +} + + + +Ignorl(a) + + long a; + +{ + + + + a = a; + +} + +#endif diff --cc usr/src/cmd/ex/exrecover.c index 0000000000,9781fb9f8d,0000000000..f1216443fb mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/exrecover.c +++ b/usr/src/cmd/ex/exrecover.c @@@@ -1,0 -1,757 -1,0 +1,763 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1980 Regents of the University of California */ +++static char *sccsid = "@(#)exrecover.c 6.1 10/18/80"; + +#include "ex.h" + +#include "ex_temp.h" + +#include "ex_tty.h" + +#include "local/uparm.h" + + + +#undef BUFSIZ + +#undef EOF + +#undef NULL + + + +#include + +#include + + + +/* + + * Ex recovery program + + * exrecover dir name + + * exrecover -r + + * + + * This program searches through the specified directory and then + + * the directory usrpath(preserve) looking for an instance of the specified + + * file from a crashed editor or a crashed system. + + * If this file is found, it is unscrambled and written to + + * the standard output. + + * + + * If this program terminates without a "broken pipe" diagnostic + + * (i.e. the editor doesn't die right away) then the buffer we are + + * writing from is removed when we finish. This is potentially a mistake + + * as there is not enough handshaking to guarantee that the file has actually + + * been recovered, but should suffice for most cases. + + */ + + + +/* + + * For lint's sake... + + */ + +#ifndef lint + +#define ignorl(a) a + +#endif + + + +/* + + * This directory definition also appears (obviously) in expreserve.c. + + * Change both if you change either. + + */ + +char mydir[] = usrpath(preserve); + + + +/* + + * Limit on the number of printed entries + + * when an, e.g. ``ex -r'' command is given. + + */ + +#define NENTRY 50 + + + +char *ctime(); + +char nb[BUFSIZ]; + +int vercnt; /* Count number of versions of file found */ + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register char *cp; + + register int b, i; + + + + /* + + * Initialize as though the editor had just started. + + */ + + fendcore = (line *) sbrk(0); + + dot = zero = dol = fendcore; + + one = zero + 1; + + endcore = fendcore - 2; + + iblock = oblock = -1; + + + + /* + + * If given only a -r argument, then list the saved files. + + */ + + if (argc == 2 && eq(argv[1], "-r")) { + + listfiles(mydir); + + exit(0); + + } + + if (argc != 3) + + error(" Wrong number of arguments to exrecover", 0); + + + + CP(file, argv[2]); + + + + /* + + * Search for this file. + + */ + + findtmp(argv[1]); + + + + /* + + * Got (one of the versions of) it, write it back to the editor. + + */ + + cp = ctime(&H.Time); + + cp[19] = 0; + + fprintf(stderr, " [Dated: %s", cp); + + fprintf(stderr, vercnt > 1 ? ", newest of %d saved]" : "]", vercnt); + + H.Flines++; + + + + /* + + * Allocate space for the line pointers from the temp file. + + */ + + if ((int) sbrk((int) (H.Flines * sizeof (line))) == -1) + + /* + + * Good grief. + + */ + + error(" Not enough core for lines", 0); + +#ifdef DEBUG + + fprintf(stderr, "%d lines\n", H.Flines); + +#endif + + + + /* + + * Now go get the blocks of seek pointers which are scattered + + * throughout the temp file, reconstructing the incore + + * line pointers at point of crash. + + */ + + b = 0; + + while (H.Flines > 0) { + + ignorl(lseek(tfile, (long) blocks[b] * BUFSIZ, 0)); + + i = H.Flines < BUFSIZ / sizeof (line) ? + + H.Flines * sizeof (line) : BUFSIZ; + + if (read(tfile, (char *) dot, i) != i) { + + perror(nb); + + exit(1); + + } + + dot += i / sizeof (line); + + H.Flines -= i / sizeof (line); + + b++; + + } + + dot--; dol = dot; + + + + /* + + * Sigh... due to sandbagging some lines may really not be there. + + * Find and discard such. This shouldn't happen much. + + */ + + scrapbad(); + + + + /* + + * Now if there were any lines in the recovered file + + * write them to the standard output. + + */ + + if (dol > zero) { + + addr1 = one; addr2 = dol; io = 1; + + putfile(); + + } + + + + /* + + * Trash the saved buffer. + + * Hopefully the system won't crash before the editor + + * syncs the new recovered buffer; i.e. for an instant here + + * you may lose if the system crashes because this file + + * is gone, but the editor hasn't completed reading the recovered + + * file from the pipe from us to it. + + * + + * This doesn't work if we are coming from an non-absolute path + + * name since we may have chdir'ed but what the hay, noone really + + * ever edits with temporaries in "." anyways. + + */ + + if (nb[0] == '/') + + ignore(unlink(nb)); + + + + /* + + * Adieu. + + */ + + exit(0); + +} + + + +/* + + * Print an error message (notably not in error + + * message file). If terminal is in RAW mode, then + + * we should be writing output for "vi", so don't print + + * a newline which would screw up the screen. + + */ + +/*VARARGS2*/ + +error(str, inf) + + char *str; + + int inf; + +{ + + + + fprintf(stderr, str, inf); +++#ifndef USG3TTY + + gtty(2, &tty); + + if ((tty.sg_flags & RAW) == 0) +++#else +++ ioctl(2, TCGETA, &tty); +++ if (tty.c_lflag & ICANON) +++#endif + + fprintf(stderr, "\n"); + + exit(1); + +} + + + +/* + + * Here we save the information about files, when + + * you ask us what files we have saved for you. + + * We buffer file name, number of lines, and the time + + * at which the file was saved. + + */ + +struct svfile { + + char sf_name[FNSIZE + 1]; + + int sf_lines; + + char sf_entry[DIRSIZ + 1]; + + time_t sf_time; + +}; + + + +listfiles(dirname) + + char *dirname; + +{ + + register FILE *dir; + + struct direct dirent; + + int ecount, qucmp(); + + register int f; + + char *cp; + + struct svfile *fp, svbuf[NENTRY]; + + + + /* + + * Open usrpath(preserve), and go there to make things quick. + + */ + + dir = fopen(dirname, "r"); + + if (dir == NULL) { + + perror(dirname); + + return; + + } + + if (chdir(dirname) < 0) { + + perror(dirname); + + return; + + } + + + + /* + + * Look at the candidate files in usrpath(preserve). + + */ + + fp = &svbuf[0]; + + ecount = 0; + + while (fread((char *) &dirent, sizeof dirent, 1, dir) == 1) { + + if (dirent.d_ino == 0) + + continue; + + if (dirent.d_name[0] != 'E') + + continue; + +#ifdef DEBUG + + fprintf(stderr, "considering %s\n", dirent.d_name); + +#endif + + /* + + * Name begins with E; open it and + + * make sure the uid in the header is our uid. + + * If not, then don't bother with this file, it can't + + * be ours. + + */ + + f = open(dirent.d_name, 0); + + if (f < 0) { + +#ifdef DEBUG + + fprintf(stderr, "open failed\n"); + +#endif + + continue; + + } + + if (read(f, (char *) &H, sizeof H) != sizeof H) { + +#ifdef DEBUG + + fprintf(stderr, "culdnt read hedr\n"); + +#endif + + ignore(close(f)); + + continue; + + } + + ignore(close(f)); + + if (getuid() != H.Uid) { + +#ifdef DEBUG + + fprintf(stderr, "uid wrong\n"); + +#endif + + continue; + + } + + + + /* + + * Saved the day! + + */ + + enter(fp++, dirent.d_name, ecount); + + ecount++; + +#ifdef DEBUG + + fprintf(stderr, "entered file %s\n", dirent.d_name); + +#endif + + } + + ignore(fclose(dir)); + + + + /* + + * If any files were saved, then sort them and print + + * them out. + + */ + + if (ecount == 0) { + + fprintf(stderr, "No files saved.\n"); + + return; + + } + + qsort(&svbuf[0], ecount, sizeof svbuf[0], qucmp); + + for (fp = &svbuf[0]; fp < &svbuf[ecount]; fp++) { + + cp = ctime(&fp->sf_time); + + cp[10] = 0; + + fprintf(stderr, "On %s at ", cp); + + cp[16] = 0; + + fprintf(stderr, &cp[11]); + + fprintf(stderr, " saved %d lines of file \"%s\"\n", + + fp->sf_lines, fp->sf_name); + + } + +} + + + +/* + + * Enter a new file into the saved file information. + + */ + +enter(fp, fname, count) + + struct svfile *fp; + + char *fname; + +{ + + register char *cp, *cp2; + + register struct svfile *f, *fl; + + time_t curtime, itol(); + + + + f = 0; + + if (count >= NENTRY) { + + /* + + * My god, a huge number of saved files. + + * Would you work on a system that crashed this + + * often? Hope not. So lets trash the oldest + + * as the most useless. + + * + + * (I wonder if this code has ever run?) + + */ + + fl = fp - count + NENTRY - 1; + + curtime = fl->sf_time; + + for (f = fl; --f > fp-count; ) + + if (f->sf_time < curtime) + + curtime = f->sf_time; + + for (f = fl; --f > fp-count; ) + + if (f->sf_time == curtime) + + break; + + fp = f; + + } + + + + /* + + * Gotcha. + + */ + + fp->sf_time = H.Time; + + fp->sf_lines = H.Flines; + + for (cp2 = fp->sf_name, cp = savedfile; *cp;) + + *cp2++ = *cp++; + + for (cp2 = fp->sf_entry, cp = fname; *cp && cp-fname < 14;) + + *cp2++ = *cp++; + + *cp2++ = 0; + +} + + + +/* + + * Do the qsort compare to sort the entries first by file name, + + * then by modify time. + + */ + +qucmp(p1, p2) + + struct svfile *p1, *p2; + +{ + + register int t; + + + + if (t = strcmp(p1->sf_name, p2->sf_name)) + + return(t); + + if (p1->sf_time > p2->sf_time) + + return(-1); + + return(p1->sf_time < p2->sf_time); + +} + + + +/* + + * Scratch for search. + + */ + +char bestnb[BUFSIZ]; /* Name of the best one */ + +long besttime; /* Time at which the best file was saved */ + +int bestfd; /* Keep best file open so it dont vanish */ + + + +/* + + * Look for a file, both in the users directory option value + + * (i.e. usually /tmp) and in usrpath(preserve). + + * Want to find the newest so we search on and on. + + */ + +findtmp(dir) + + char *dir; + +{ + + + + /* + + * No name or file so far. + + */ + + bestnb[0] = 0; + + bestfd = -1; + + + + /* + + * Search usrpath(preserve) and, if we can get there, /tmp + + * (actually the users "directory" option). + + */ + + searchdir(dir); + + if (chdir(mydir) == 0) + + searchdir(mydir); + + if (bestfd != -1) { + + /* + + * Gotcha. + + * Put the file (which is already open) in the file + + * used by the temp file routines, and save its + + * name for later unlinking. + + */ + + tfile = bestfd; + + CP(nb, bestnb); + + ignorl(lseek(tfile, 0l, 0)); + + + + /* + + * Gotta be able to read the header or fall through + + * to lossage. + + */ + + if (read(tfile, (char *) &H, sizeof H) == sizeof H) + + return; + + } + + + + /* + + * Extreme lossage... + + */ + + error(" File not found", 0); + +} + + + +/* + + * Search for the file in directory dirname. + + * + + * Don't chdir here, because the users directory + + * may be ".", and we would move away before we searched it. + + * Note that we actually chdir elsewhere (because it is too slow + + * to look around in usrpath(preserve) without chdir'ing there) so we + + * can't win, because we don't know the name of '.' and if the path + + * name of the file we want to unlink is relative, rather than absolute + + * we won't be able to find it again. + + */ + +searchdir(dirname) + + char *dirname; + +{ + + struct direct dirent; + + register FILE *dir; + + char dbuf[BUFSIZ]; + + + + dir = fopen(dirname, "r"); + + if (dir == NULL) + + return; + + setbuf(dir, dbuf); + + while (fread((char *) &dirent, sizeof dirent, 1, dir) == 1) { + + if (dirent.d_ino == 0) + + continue; + + if (dirent.d_name[0] != 'E' || dirent.d_name[DIRSIZ - 1] != 0) + + continue; + + /* + + * Got a file in the directory starting with E... + + * Save a consed up name for the file to unlink + + * later, and check that this is really a file + + * we are looking for. + + */ + + ignore(strcat(strcat(strcpy(nb, dirname), "/"), dirent.d_name)); + + if (yeah(nb)) { + + /* + + * Well, it is the file we are looking for. + + * Is it more recent than any version we found before? + + */ + + if (H.Time > besttime) { + + /* + + * A winner. + + */ + + ignore(close(bestfd)); + + bestfd = dup(tfile); + + besttime = H.Time; + + CP(bestnb, nb); + + } + + /* + + * Count versions so user can be told there are + + * ``yet more pages to be turned''. + + */ + + vercnt++; + + } + + ignore(close(tfile)); + + } + + ignore(fclose(dir)); + +} + + + +/* + + * Given a candidate file to be recovered, see + + * if its really an editor temporary and of this + + * user and the file specified. + + */ + +yeah(name) + + char *name; + +{ + + + + tfile = open(name, 2); + + if (tfile < 0) + + return (0); + + if (read(tfile, (char *) &H, sizeof H) != sizeof H) { + +nope: + + ignore(close(tfile)); + + return (0); + + } + + if (!eq(savedfile, file)) + + goto nope; + + if (getuid() != H.Uid) + + goto nope; + + /* + + * This is old and stupid code, which + + * puts a word LOST in the header block, so that lost lines + + * can be made to point at it. + + */ + + ignorl(lseek(tfile, (long)(BUFSIZ*HBLKS-8), 0)); + + ignore(write(tfile, "LOST", 5)); + + return (1); + +} + + + +preserve() + +{ + + + +} + + + +/* + + * Find the true end of the scratch file, and ``LOSE'' + + * lines which point into thin air. This lossage occurs + + * due to the sandbagging of i/o which can cause blocks to + + * be written in a non-obvious order, different from the order + + * in which the editor tried to write them. + + * + + * Lines which are lost are replaced with the text LOST so + + * they are easy to find. We work hard at pretty formatting here + + * as lines tend to be lost in blocks. + + * + + * This only seems to happen on very heavily loaded systems, and + + * not very often. + + */ + +scrapbad() + +{ + + register line *ip; + + struct stat stbuf; + + off_t size, maxt; + + int bno, cnt, bad, was; + + char bk[BUFSIZ]; + + + + ignore(fstat(tfile, &stbuf)); + + size = stbuf.st_size; + + maxt = (size >> SHFT) | (BNDRY-1); + + bno = (maxt >> OFFBTS) & BLKMSK; + +#ifdef DEBUG + + fprintf(stderr, "size %ld, maxt %o, bno %d\n", size, maxt, bno); + +#endif + + + + /* + + * Look for a null separating two lines in the temp file; + + * if last line was split across blocks, then it is lost + + * if the last block is. + + */ + + while (bno > 0) { + + ignorl(lseek(tfile, (long) BUFSIZ * bno, 0)); + + cnt = read(tfile, (char *) bk, BUFSIZ); + + while (cnt > 0) + + if (bk[--cnt] == 0) + + goto null; + + bno--; + + } + +null: + + + + /* + + * Magically calculate the largest valid pointer in the temp file, + + * consing it up from the block number and the count. + + */ + + maxt = ((bno << OFFBTS) | (cnt >> SHFT)) & ~1; + +#ifdef DEBUG + + fprintf(stderr, "bno %d, cnt %d, maxt %o\n", bno, cnt, maxt); + +#endif + + + + /* + + * Now cycle through the line pointers, + + * trashing the Lusers. + + */ + + was = bad = 0; + + for (ip = one; ip <= dol; ip++) + + if (*ip > maxt) { + +#ifdef DEBUG + + fprintf(stderr, "%d bad, %o > %o\n", ip - zero, *ip, maxt); + +#endif + + if (was == 0) + + was = ip - zero; + + *ip = ((HBLKS*BUFSIZ)-8) >> SHFT; + + } else if (was) { + + if (bad == 0) + + fprintf(stderr, " [Lost line(s):"); + + fprintf(stderr, " %d", was); + + if ((ip - 1) - zero > was) + + fprintf(stderr, "-%d", (ip - 1) - zero); + + bad++; + + was = 0; + + } + + if (was != 0) { + + if (bad == 0) + + fprintf(stderr, " [Lost line(s):"); + + fprintf(stderr, " %d", was); + + if (dol - zero != was) + + fprintf(stderr, "-%d", dol - zero); + + bad++; + + } + + if (bad) + + fprintf(stderr, "]"); + +} + + + +/* + + * Aw shucks, if we only had a (void) cast. + + */ + +#ifdef lint + +Ignorl(a) + + long a; + +{ + + + + a = a; + +} + + + +Ignore(a) + + char *a; + +{ + + + + a = a; + +} + + + +Ignorf(a) + + int (*a)(); + +{ + + + + a = a; + +} + + + +ignorl(a) + + long a; + +{ + + + + a = a; + +} + +#endif + + + +int cntch, cntln, cntodd, cntnull; + +/* + + * Following routines stolen mercilessly from ex. + + */ + +putfile() + +{ + + line *a1; + + register char *fp, *lp; + + register int nib; + + + + a1 = addr1; + + clrstats(); + + cntln = addr2 - a1 + 1; + + if (cntln == 0) + + return; + + nib = BUFSIZ; + + fp = genbuf; + + do { + + getline(*a1++); + + lp = linebuf; + + for (;;) { + + if (--nib < 0) { + + nib = fp - genbuf; + + if (write(io, genbuf, nib) != nib) + + wrerror(); + + cntch += nib; + + nib = 511; + + fp = genbuf; + + } + + if ((*fp++ = *lp++) == 0) { + + fp[-1] = '\n'; + + break; + + } + + } + + } while (a1 <= addr2); + + nib = fp - genbuf; + + if (write(io, genbuf, nib) != nib) + + wrerror(); + + cntch += nib; + +} + + + +wrerror() + +{ + + + + syserror(); + +} + + + +clrstats() + +{ + + + + ninbuf = 0; + + cntch = 0; + + cntln = 0; + + cntnull = 0; + + cntodd = 0; + +} + + + +#define READ 0 + +#define WRITE 1 + + + +getline(tl) + + line tl; + +{ + + register char *bp, *lp; + + register int nl; + + + + lp = linebuf; + + bp = getblock(tl, READ); + + nl = nleft; + + tl &= ~OFFMSK; + + while (*lp++ = *bp++) + + if (--nl == 0) { + + bp = getblock(tl += INCRMT, READ); + + nl = nleft; + + } + +} + + + +int read(); + +int write(); + + + +char * + +getblock(atl, iof) + + line atl; + + int iof; + +{ + + register int bno, off; + + + + bno = (atl >> OFFBTS) & BLKMSK; + + off = (atl << SHFT) & LBTMSK; + + if (bno >= NMBLKS) + + error(" Tmp file too large"); + + nleft = BUFSIZ - off; + + if (bno == iblock) { + + ichanged |= iof; + + return (ibuff + off); + + } + + if (bno == oblock) + + return (obuff + off); + + if (iof == READ) { + + if (ichanged) + + blkio(iblock, ibuff, write); + + ichanged = 0; + + iblock = bno; + + blkio(bno, ibuff, read); + + return (ibuff + off); + + } + + if (oblock >= 0) + + blkio(oblock, obuff, write); + + oblock = bno; + + return (obuff + off); + +} + + + +blkio(b, buf, iofcn) + + short b; + + char *buf; + + int (*iofcn)(); + +{ + + + + lseek(tfile, (long) (unsigned) b * BUFSIZ, 0); + + if ((*iofcn)(tfile, buf, BUFSIZ) != BUFSIZ) + + syserror(); + +} + + + +syserror() + +{ + + extern int sys_nerr; + + extern char *sys_errlist[]; + + + + dirtcnt = 0; + + write(2, " ", 1); + + if (errno >= 0 && errno <= sys_nerr) + + error(sys_errlist[errno]); + + else + + error("System error %d", errno); + + exit(1); + +} diff --cc usr/src/cmd/ex/makeoptions index 0000000000,84d2639389,0000000000..87420c190a mode 000000,100755,000000..100644 --- a/usr/src/cmd/ex/makeoptions +++ b/usr/src/cmd/ex/makeoptions @@@@ -1,0 -1,40 -1,0 +1,46 @@@@ + +# + +# remake options -- this isn't necessary unless you add/delete options + +# - onintr ifintr - cp ex_data.c /tmp/$$.c - ex - /tmp/$$.c <<'%' - g/^#include/d - w - q +++onintr ifintr +++cp ex_data.c /tmp/$$.c +++ex - /tmp/$$.c <<'%' +++ g/^#include/d +++ w +++ q + +'%' - cc -E $* /tmp/$$.c >/tmp/foo.c - ex - /tmp/foo.c <<'X' - g/^# /d - set sh=/bin/csh - g/^[ ]*$/d - 1,/options/d - /}/-1,$d - 1,$s/ "// - 1,$s/".*// - 1m$ - w! ex_vars.h - !rm -f %; num ex_vars.h >% - e - $t0 - 1s/......../ 0 / - 1,$s/\(......\)\(.*\)/#define \U\2\L \1/ - 1,$s/ */ /g - g/ */s// /g - w - !rm -f ex_vars.h; expand -8,24 % >ex_vars.h - e! ex_vars.h - $i +++cc -E $* /tmp/$$.c >/tmp/foo.c +++ex - /tmp/foo.c <<'X' +++ " delete all preprocessor output (# line, etc) +++ g/^# /d +++ set sh=/bin/csh +++ " delete junk (all but data lines) +++ g/^[ ]*$/d +++ 1,/option options/d +++ /}/-1,$d +++ " get rid of all of line but option name +++ 1,$s/ "// +++ 1,$s/".*// +++ 1m$ " kludge since options start at 0 but num at 1 +++ %!num +++ $t0 " unkludge +++ 1s/......../ 0 / " unkludge +++ " make #define lines +++ 1,$s/\(......\)\(.*\)/#define \U\2\L \1/ +++ " get rid of extra blanks, turning into (single) tabs. +++ 1,$s/ */ /g +++ g/ */s// /g +++ " filter through expand to make it line up nice +++ %!expand -8\,24 +++ " blank line and number of options. +++ $i + + + +. - $s/e[ ].*[ ]/e NOPTS / - w - q +++ $s/e[ ].*[ ]/e NOPTS / +++ 0a +++ /* sccs id @(#) ex_vars.h @(#)makeoptions 6.1 10/18/80 */ +++. +++ w! ex_vars.h +++ q + +'X' + +ifintr: - rm /tmp/foo.c +++rm /tmp/foo.c diff --cc usr/src/cmd/ex/printf.c index 0000000000,be24ebe25e,0000000000..07906448d9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ex/printf.c +++ b/usr/src/cmd/ex/printf.c @@@@ -1,0 -1,340 -1,0 +1,343 @@@@ - /* char printf_id[] = "@(#) printf.c:2.2 6/5/79";*/ +++/* The pwb version this is based on */ +++static char *printf_id = "@(#) printf.c:2.2 6/5/79"; +++/* The local sccs version within ex */ +++static char *sccsid = "@(#)printf.c 6.1 10/18/80"; + +#include "varargs.h" + +/* + + * This version of printf is compatible with the Version 7 C + + * printf. The differences are only minor except that this + + * printf assumes it is to print through putchar. Version 7 + + * printf is more general (and is much larger) and includes + + * provisions for floating point. + + */ + + + + + +#define MAXOCT 11 /* Maximum octal digits in a long */ + +#define MAXINT 32767 /* largest normal length positive integer */ + +#define BIG 1000000000 /* largest power of 10 less than an unsigned long */ + +#define MAXDIGS 10 /* number of digits in BIG */ + + + +static int width, sign, fill; + + + +char *_p_dconv(); + + + +printf(va_alist) + + va_dcl + +{ + + va_list ap; + + register char *fmt; + + char fcode; + + int prec; + + int length,mask1,nbits,n; + + long int mask2, num; + + register char *bptr; + + char *ptr; + + char buf[134]; + + + + va_start(ap); + + fmt = va_arg(ap,char *); + + for (;;) { + + /* process format string first */ + + while ((fcode = *fmt++)!='%') { + + /* ordinary (non-%) character */ + + if (fcode=='\0') + + return; + + putchar(fcode); + + } + + /* length modifier: -1 for h, 1 for l, 0 for none */ + + length = 0; + + /* check for a leading - sign */ + + sign = 0; + + if (*fmt == '-') { + + sign++; + + fmt++; + + } + + /* a '0' may follow the - sign */ + + /* this is the requested fill character */ + + fill = 1; + + if (*fmt == '0') { + + fill--; + + fmt++; + + } + + + + /* Now comes a digit string which may be a '*' */ + + if (*fmt == '*') { + + width = va_arg(ap, int); + + if (width < 0) { + + width = -width; + + sign = !sign; + + } + + fmt++; + + } + + else { + + width = 0; + + while (*fmt>='0' && *fmt<='9') + + width = width * 10 + (*fmt++ - '0'); + + } + + + + /* maybe a decimal point followed by more digits (or '*') */ + + if (*fmt=='.') { + + if (*++fmt == '*') { + + prec = va_arg(ap, int); + + fmt++; + + } + + else { + + prec = 0; + + while (*fmt>='0' && *fmt<='9') + + prec = prec * 10 + (*fmt++ - '0'); + + } + + } + + else + + prec = -1; + + + + /* + + * At this point, "sign" is nonzero if there was + + * a sign, "fill" is 0 if there was a leading + + * zero and 1 otherwise, "width" and "prec" + + * contain numbers corresponding to the digit + + * strings before and after the decimal point, + + * respectively, and "fmt" addresses the next + + * character after the whole mess. If there was + + * no decimal point, "prec" will be -1. + + */ + + switch (*fmt) { + + case 'L': + + case 'l': + + length = 2; + + /* no break!! */ + + case 'h': + + case 'H': + + length--; + + fmt++; + + break; + + } + + + + /* + + * At exit from the following switch, we will + + * emit the characters starting at "bptr" and + + * ending at "ptr"-1, unless fcode is '\0'. + + */ + + switch (fcode = *fmt++) { + + /* process characters and strings first */ + + case 'c': + + buf[0] = va_arg(ap, int); + + ptr = bptr = &buf[0]; + + if (buf[0] != '\0') + + ptr++; + + break; + + case 's': + + bptr = va_arg(ap,char *); + + if (bptr==0) + + bptr = "(null pointer)"; + + if (prec < 0) + + prec = MAXINT; + + for (n=0; *bptr++ && n < prec; n++) ; + + ptr = --bptr; + + bptr -= n; + + break; + + case 'O': + + length = 1; + + fcode = 'o'; + + /* no break */ + + case 'o': + + case 'X': + + case 'x': + + if (length > 0) + + num = va_arg(ap,long); + + else + + num = (unsigned)va_arg(ap,int); + + if (fcode=='o') { + + mask1 = 0x7; + + mask2 = 0x1fffffffL; + + nbits = 3; + + } + + else { + + mask1 = 0xf; + + mask2 = 0x0fffffffL; + + nbits = 4; + + } + + n = (num!=0); + + bptr = buf + MAXOCT + 3; + + /* shift and mask for speed */ + + do + + if (((int) num & mask1) < 10) + + *--bptr = ((int) num & mask1) + 060; + + else + + *--bptr = ((int) num & mask1) + 0127; + + while (num = (num >> nbits) & mask2); + + + + if (fcode=='o') { + + if (n) + + *--bptr = '0'; + + } + + else + + if (!sign && fill <= 0) { + + putchar('0'); + + putchar(fcode); + + width -= 2; + + } + + else { + + *--bptr = fcode; + + *--bptr = '0'; + + } + + ptr = buf + MAXOCT + 3; + + break; + + case 'D': + + case 'U': + + case 'I': + + length = 1; + + fcode = fcode + 'a' - 'A'; + + /* no break */ + + case 'd': + + case 'i': + + case 'u': + + if (length > 0) + + num = va_arg(ap,long); + + else { + + n = va_arg(ap,int); + + if (fcode=='u') + + num = (unsigned) n; + + else + + num = (long) n; + + } + + if (n = (fcode != 'u' && num < 0)) + + num = -num; + + /* now convert to digits */ + + bptr = _p_dconv(num, buf); + + if (n) + + *--bptr = '-'; + + if (fill == 0) + + fill = -1; + + ptr = buf + MAXDIGS + 1; + + break; + + default: + + /* not a control character, + + * print it. + + */ + + ptr = bptr = &fcode; + + ptr++; + + break; + + } + + if (fcode != '\0') + + _p_emit(bptr,ptr); + + } + + va_end(ap); + +} + + + +/* _p_dconv converts the unsigned long integer "value" to + + * printable decimal and places it in "buffer", right-justified. + + * The value returned is the address of the first non-zero character, + + * or the address of the last character if all are zero. + + * The result is NOT null terminated, and is MAXDIGS characters long, + + * starting at buffer[1] (to allow for insertion of a sign). + + * + + * This program assumes it is running on 2's complement machine + + * with reasonable overflow treatment. + + */ + +char * + +_p_dconv(value, buffer) + + long value; + + char *buffer; + +{ + + register char *bp; + + register int svalue; + + int n; + + long lval; + + + + bp = buffer; + + + + /* zero is a special case */ + + if (value == 0) { + + bp += MAXDIGS; + + *bp = '0'; + + return(bp); + + } + + + + /* develop the leading digit of the value in "n" */ + + n = 0; + + while (value < 0) { + + value -= BIG; /* will eventually underflow */ + + n++; + + } + + while ((lval = value - BIG) >= 0) { + + value = lval; + + n++; + + } + + + + /* stash it in buffer[1] to allow for a sign */ + + bp[1] = n + '0'; + + /* + + * Now develop the rest of the digits. Since speed counts here, + + * we do it in two loops. The first gets "value" down until it + + * is no larger than MAXINT. The second one uses integer divides + + * rather than long divides to speed it up. + + */ + + bp += MAXDIGS + 1; + + while (value > MAXINT) { + + *--bp = (int)(value % 10) + '0'; + + value /= 10; + + } + + + + /* cannot lose precision */ + + svalue = value; + + while (svalue > 0) { + + *--bp = (svalue % 10) + '0'; + + svalue /= 10; + + } + + + + /* fill in intermediate zeroes if needed */ + + if (buffer[1] != '0') { + + while (bp > buffer + 2) + + *--bp = '0'; + + --bp; + + } + + return(bp); + +} + + + +/* + + * This program sends string "s" to putchar. The character after + + * the end of "s" is given by "send". This allows the size of the + + * field to be computed; it is stored in "alen". "width" contains the + + * user specified length. If width width) + + width = alen; + + cfill = fill>0? ' ': '0'; + + + + /* we may want to print a leading '-' before anything */ + + if (*s == '-' && fill < 0) { + + putchar(*s++); + + alen--; + + width--; + + } + + npad = width - alen; + + + + /* emit any leading pad characters */ + + if (!sign) + + while (--npad >= 0) + + putchar(cfill); + + + + /* emit the string itself */ + + while (--alen >= 0) + + putchar(*s++); + + + + /* emit trailing pad characters */ + + if (sign) + + while (--npad >= 0) + + putchar(cfill); + +} diff --cc usr/src/cmd/expand.c index 0000000000,4dc6d8718b,0000000000..a71c871a2d mode 000000,100644,000000..100644 --- a/usr/src/cmd/expand.c +++ b/usr/src/cmd/expand.c @@@@ -1,0 -1,111 -1,0 +1,112 @@@@ +++static char *sccsid = "@(#)expand.c 4.1 (Berkeley) 10/1/80"; + +#include + +/* + + * expand - expand tabs to equivalent spaces + + */ + +char obuf[BUFSIZ]; + +int nstops; + +int tabstops[100]; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register int c, column; + + register int n; + + + + setbuf(stdout, obuf); + + argc--, argv++; + + do { + + while (argc > 0 && argv[0][0] == '-') { + + getstops(argv[0]); + + argc--, argv++; + + } + + if (argc > 0) { + + if (freopen(argv[0], "r", stdin) == NULL) { + + perror(argv[0]); + + exit(1); + + } + + argc--, argv++; + + } + + column = 0; + + for (;;) { + + c = getc(stdin); + + if (c == -1) + + break; + + switch (c) { + + + + case '\t': + + if (nstops == 0) { + + do { + + putchar(' '); + + column++; + + } while (column & 07); + + continue; + + } + + if (nstops == 1) { + + do { + + putchar(' '); + + column++; + + } while (((column - 1) % tabstops[0]) != (tabstops[0] - 1)); + + continue; + + } + + for (n = 0; n < nstops; n++) + + if (tabstops[n] > column) + + break; + + if (n == nstops) { + + putchar(' '); + + column++; + + continue; + + } + + while (column < tabstops[n]) { + + putchar(' '); + + column++; + + } + + continue; + + + + case '\b': + + if (column) + + column--; + + putchar('\b'); + + continue; + + + + default: + + putchar(c); + + column++; + + continue; + + + + case '\n': + + putchar(c); + + column = 0; + + continue; + + } + + } + + } while (argc > 0); + + exit(0); + +} + + + +getstops(cp) + + register char *cp; + +{ + + register int i; + + + + nstops = 0; + + cp++; + + for (;;) { + + i = 0; + + while (*cp >= '0' && *cp <= '9') + + i = i * 10 + *cp++ - '0'; + + if (i <= 0 || i > 256) { + +bad: + + fprintf(stderr, "Bad tab stop spec\n"); + + exit(1); + + } + + if (nstops > 0 && i <= tabstops[nstops]) + + goto bad; + + tabstops[nstops++] = i; + + if (*cp == 0) + + break; + + if (*cp++ != ',') + + goto bad; + + } + +} diff --cc usr/src/cmd/expr.y index 0000000000,c31facf658,0000000000..f98907f462 mode 000000,100644,000000..100644 --- a/usr/src/cmd/expr.y +++ b/usr/src/cmd/expr.y @@@@ -1,0 -1,669 -1,0 +1,670 @@@@ + +/* Yacc productions for "expr" command: */ + + + +%token OR AND ADD SUBT MULT DIV REM EQ GT GEQ LT LEQ NEQ + +%token A_STRING SUBSTR LENGTH INDEX NOARG MATCH + + + +/* operators listed below in increasing precedence: */ + +%left OR + +%left AND + +%left EQ LT GT GEQ LEQ NEQ + +%left ADD SUBT + +%left MULT DIV REM + +%left MCH + +%left MATCH + +%left SUBSTR + +%left LENGTH INDEX + +%% + + + +/* a single `expression' is evaluated and printed: */ + + + +expression: expr NOARG = { + + printf("%s\n", $1); + + exit((!strcmp($1,"0")||!strcmp($1,"\0"))? 1: 0); + + } + + ; + + + + + +expr: '(' expr ')' = { $$ = $2; } + + | expr OR expr = { $$ = conj(OR, $1, $3); } + + | expr AND expr = { $$ = conj(AND, $1, $3); } + + | expr EQ expr = { $$ = rel(EQ, $1, $3); } + + | expr GT expr = { $$ = rel(GT, $1, $3); } + + | expr GEQ expr = { $$ = rel(GEQ, $1, $3); } + + | expr LT expr = { $$ = rel(LT, $1, $3); } + + | expr LEQ expr = { $$ = rel(LEQ, $1, $3); } + + | expr NEQ expr = { $$ = rel(NEQ, $1, $3); } + + | expr ADD expr = { $$ = arith(ADD, $1, $3); } + + | expr SUBT expr = { $$ = arith(SUBT, $1, $3); } + + | expr MULT expr = { $$ = arith(MULT, $1, $3); } + + | expr DIV expr = { $$ = arith(DIV, $1, $3); } + + | expr REM expr = { $$ = arith(REM, $1, $3); } + + | expr MCH expr = { $$ = match($1, $3); } + + | MATCH expr expr = { $$ = match($2, $3); } + + | SUBSTR expr expr expr = { $$ = substr($2, $3, $4); } + + | LENGTH expr = { $$ = length($2); } + + | INDEX expr expr = { $$ = index($2, $3); } + + | A_STRING + + ; + +%% + +/* expression command */ + +#include + +#define ESIZE 256 + +#define error(c) errxx(c) + +#define EQL(x,y) !strcmp(x,y) + +long atol(); + +char **Av; + +int Ac; + +int Argi; + + + +char Mstring[1][128]; + +char *malloc(); + +extern int nbra; + + + +main(argc, argv) char **argv; { + + Ac = argc; + + Argi = 1; + + Av = argv; + + yyparse(); + +} + + + +char *operators[] = { "|", "&", "+", "-", "*", "/", "%", ":", + + "=", "==", "<", "<=", ">", ">=", "!=", + + "match", "substr", "length", "index", "\0" }; + +int op[] = { OR, AND, ADD, SUBT, MULT, DIV, REM, MCH, + + EQ, EQ, LT, LEQ, GT, GEQ, NEQ, + + MATCH, SUBSTR, LENGTH, INDEX }; + +yylex() { + + register char *p; + + register i; + + + + if(Argi >= Ac) return NOARG; + + + + p = Av[Argi++]; + + + + if(*p == '(' || *p == ')') + + return (int)*p; - for(i = 0; *operator[i]; ++i) - if(EQL(operator[i], p)) +++ for(i = 0; *operators[i]; ++i) +++ if(EQL(operators[i], p)) + + return op[i]; + + + + yylval = p; + + return A_STRING; + +} + + + +char *rel(op, r1, r2) register char *r1, *r2; { + + register i; + + + + if(ematch(r1, "-*[0-9]*$") && ematch(r2, "[0-9]*$")) + + i = atol(r1) - atol(r2); + + else + + i = strcmp(r1, r2); + + switch(op) { + + case EQ: i = i==0; break; + + case GT: i = i>0; break; + + case GEQ: i = i>=0; break; + + case LT: i = i<0; break; + + case LEQ: i = i>=0; break; + + case NEQ: i = i!=0; break; + + } + + return i? "1": "0"; + +} + + + +char *arith(op, r1, r2) char *r1, *r2; { + + long i1, i2; + + register char *rv; + + + + if(!(ematch(r1, "[0-9]*$") && ematch(r2, "[0-9]*$"))) + + yyerror("non-numeric argument"); + + i1 = atol(r1); + + i2 = atol(r2); + + + + switch(op) { + + case ADD: i1 = i1 + i2; break; + + case SUBT: i1 = i1 - i2; break; + + case MULT: i1 = i1 * i2; break; + + case DIV: i1 = i1 / i2; break; + + case REM: i1 = i1 % i2; break; + + } + + rv = malloc(16); + + sprintf(rv, "%D", i1); + + return rv; + +} + +char *conj(op, r1, r2) char *r1, *r2; { + + register char *rv; + + + + switch(op) { + + + + case OR: + + if(EQL(r1, "0") + + || EQL(r1, "")) + + if(EQL(r2, "0") + + || EQL(r2, "")) + + rv = "0"; + + else + + rv = r2; + + else + + rv = r1; + + break; + + case AND: + + if(EQL(r1, "0") + + || EQL(r1, "")) + + rv = "0"; + + else if(EQL(r2, "0") + + || EQL(r2, "")) + + rv = "0"; + + else + + rv = r1; + + break; + + } + + return rv; + +} + + + +char *substr(v, s, w) char *v, *s, *w; { + +register si, wi; + +register char *res; + + + + si = atol(s); + + wi = atol(w); + + while(--si) if(*v) ++v; + + + + res = v; + + + + while(wi--) if(*v) ++v; + + + + *v = '\0'; + + return res; + +} + + + +char *length(s) register char *s; { + + register i = 0; + + register char *rv; + + + + while(*s++) ++i; + + + + rv = malloc(8); + + sprintf(rv, "%d", i); + + return rv; + +} + + + +char *index(s, t) char *s, *t; { + + register i, j; + + register char *rv; + + + + for(i = 0; s[i] ; ++i) + + for(j = 0; t[j] ; ++j) + + if(s[i]==t[j]) { + + sprintf(rv = malloc(8), "%d", ++i); + + return rv; + + } + + return "0"; + +} + + + +char *match(s, p) + +{ + + register char *rv; + + + + sprintf(rv = malloc(8), "%d", ematch(s, p)); + + if(nbra) { + + rv = malloc(strlen(Mstring[0])+1); + + strcpy(rv, Mstring[0]); + + } + + return rv; + +} + + + +#define INIT register char *sp = instring; + +#define GETC() (*sp++) + +#define PEEKC() (*sp) + +#define UNGETC(c) (--sp) + +#define RETURN(c) return + +#define ERROR(c) errxx(c) + + + + + +ematch(s, p) + +char *s; + +register char *p; + +{ + + static char expbuf[ESIZE]; + + char *compile(); + + register num; + + extern char *braslist[], *braelist[], *loc2; + + + + compile(p, expbuf, &expbuf[512], 0); + + if(nbra > 1) + + yyerror("Too many '\\('s"); + + if(advance(s, expbuf)) { + + if(nbra == 1) { + + p = braslist[0]; + + num = braelist[0] - p; + + strncpy(Mstring[0], p, num); + + Mstring[0][num] = '\0'; + + } + + return(loc2-s); + + } + + return(0); + +} + + + +errxx(c) + +{ + + yyerror("RE error"); + +} + + + +#define CBRA 2 + +#define CCHR 4 + +#define CDOT 8 + +#define CCL 12 + +#define CDOL 20 + +#define CEOF 22 + +#define CKET 24 + +#define CBACK 36 + + + +#define STAR 01 + +#define RNGE 03 + + + +#define NBRA 9 + + + +#define PLACE(c) ep[c >> 3] |= bittab[c & 07] + +#define ISTHERE(c) (ep[c >> 3] & bittab[c & 07]) + + + +char *braslist[NBRA]; + +char *braelist[NBRA]; + +int nbra; + +char *loc1, *loc2, *locs; + +int sed; + + + +int circf; + +int low; + +int size; + + + +char bittab[] = { + + 1, + + 2, + + 4, + + 8, + + 16, + + 32, + + 64, + + 128 + +}; + + + +char * + +compile(instring, ep, endbuf, seof) + +register char *ep; + +char *instring, *endbuf; + +{ + + INIT /* Dependent declarations and initializations */ + + register c; + + register eof = seof; + + char *lastep = instring; + + int cclcnt; + + char bracket[NBRA], *bracketp; + + int closed; + + char neg; + + int lc; + + int i, cflg; + + + + lastep = 0; + + if((c = GETC()) == eof) { + + if(*ep == 0 && !sed) + + ERROR(41); + + RETURN(ep); + + } + + bracketp = bracket; + + circf = closed = nbra = 0; + + if (c == '^') + + circf++; + + else + + UNGETC(c); + + for (;;) { + + if (ep >= endbuf) + + ERROR(50); + + if((c = GETC()) != '*' && ((c != '\\') || (PEEKC() != '{'))) + + lastep = ep; + + if (c == eof) { + + *ep++ = CEOF; + + RETURN(ep); + + } + + switch (c) { + + + + case '.': + + *ep++ = CDOT; + + continue; + + + + case '\n': + + ERROR(36); + + case '*': + + if (lastep==0 || *lastep==CBRA || *lastep==CKET) + + goto defchar; + + *lastep |= STAR; + + continue; + + + + case '$': + + if(PEEKC() != eof) + + goto defchar; + + *ep++ = CDOL; + + continue; + + + + case '[': + + if(&ep[17] >= endbuf) + + ERROR(50); + + + + *ep++ = CCL; + + lc = 0; + + for(i = 0; i < 16; i++) + + ep[i] = 0; + + + + neg = 0; + + if((c = GETC()) == '^') { + + neg = 1; + + c = GETC(); + + } + + + + do { + + if(c == '\0' || c == '\n') + + ERROR(49); + + if(c == '-' && lc != 0) { + + if ((c = GETC()) == ']') { + + PLACE('-'); + + break; + + } + + while(lc < c) { + + PLACE(lc); + + lc++; + + } + + } + + lc = c; + + PLACE(c); + + } while((c = GETC()) != ']'); + + if(neg) { + + for(cclcnt = 0; cclcnt < 16; cclcnt++) + + ep[cclcnt] ^= -1; + + ep[0] &= 0376; + + } + + + + ep += 16; + + + + continue; + + + + case '\\': + + switch(c = GETC()) { + + + + case '(': + + if(nbra >= NBRA) + + ERROR(43); + + *bracketp++ = nbra; + + *ep++ = CBRA; + + *ep++ = nbra++; + + continue; + + + + case ')': + + if(bracketp <= bracket) + + ERROR(42); + + *ep++ = CKET; + + *ep++ = *--bracketp; + + closed++; + + continue; + + + + case '{': + + if(lastep == (char *) (0)) + + goto defchar; + + *lastep |= RNGE; + + cflg = 0; + + nlim: + + c = GETC(); + + i = 0; + + do { + + if ('0' <= c && c <= '9') + + i = 10 * i + c - '0'; + + else + + ERROR(16); + + } while(((c = GETC()) != '\\') && (c != ',')); + + if (i > 255) + + ERROR(11); + + *ep++ = i; + + if (c == ',') { + + if(cflg++) + + ERROR(44); + + if((c = GETC()) == '\\') + + *ep++ = 255; + + else { + + UNGETC(c); + + goto nlim; /* get 2'nd number */ + + } + + } + + if(GETC() != '}') + + ERROR(45); + + if(!cflg) /* one number */ + + *ep++ = i; + + else if((ep[-1] & 0377) < (ep[-2] & 0377)) + + ERROR(46); + + continue; + + + + case '\n': + + ERROR(36); + + + + case 'n': + + c = '\n'; + + goto defchar; + + + + default: + + if(c >= '1' && c <= '9') { + + if((c -= '1') >= closed) + + ERROR(25); + + *ep++ = CBACK; + + *ep++ = c; + + continue; + + } + + } + + /* Drop through to default to use \ to turn off special chars */ + + + + defchar: + + default: + + lastep = ep; + + *ep++ = CCHR; + + *ep++ = c; + + } + + } + +} + + + +step(p1, p2) + +register char *p1, *p2; + +{ + + register c; + + + + if (circf) { + + loc1 = p1; + + return(advance(p1, p2)); + + } + + /* fast check for first character */ + + if (*p2==CCHR) { + + c = p2[1]; + + do { + + if (*p1 != c) + + continue; + + if (advance(p1, p2)) { + + loc1 = p1; + + return(1); + + } + + } while (*p1++); + + return(0); + + } + + /* regular algorithm */ + + do { + + if (advance(p1, p2)) { + + loc1 = p1; + + return(1); + + } + + } while (*p1++); + + return(0); + +} + + + +advance(lp, ep) + +register char *lp, *ep; + +{ + + register char *curlp; + + char c; + + char *bbeg; + + int ct; + + + + for (;;) switch (*ep++) { + + + + case CCHR: + + if (*ep++ == *lp++) + + continue; + + return(0); + + + + case CDOT: + + if (*lp++) + + continue; + + return(0); + + + + case CDOL: + + if (*lp==0) + + continue; + + return(0); + + + + case CEOF: + + loc2 = lp; + + return(1); + + + + case CCL: + + c = *lp++ & 0177; + + if(ISTHERE(c)) { + + ep += 16; + + continue; + + } + + return(0); + + case CBRA: + + braslist[*ep++] = lp; + + continue; + + + + case CKET: + + braelist[*ep++] = lp; + + continue; + + + + case CCHR|RNGE: + + c = *ep++; + + getrnge(ep); + + while(low--) + + if(*lp++ != c) + + return(0); + + curlp = lp; + + while(size--) + + if(*lp++ != c) + + break; + + if(size < 0) + + lp++; + + ep += 2; + + goto star; + + + + case CDOT|RNGE: + + getrnge(ep); + + while(low--) + + if(*lp++ == '\0') + + return(0); + + curlp = lp; + + while(size--) + + if(*lp++ == '\0') + + break; + + if(size < 0) + + lp++; + + ep += 2; + + goto star; + + + + case CCL|RNGE: + + getrnge(ep + 16); + + while(low--) { + + c = *lp++ & 0177; + + if(!ISTHERE(c)) + + return(0); + + } + + curlp = lp; + + while(size--) { + + c = *lp++ & 0177; + + if(!ISTHERE(c)) + + break; + + } + + if(size < 0) + + lp++; + + ep += 18; /* 16 + 2 */ + + goto star; + + + + case CBACK: + + bbeg = braslist[*ep]; + + ct = braelist[*ep++] - bbeg; + + + + if(ecmp(bbeg, lp, ct)) { + + lp += ct; + + continue; + + } + + return(0); + + + + case CBACK|STAR: + + bbeg = braslist[*ep]; + + ct = braelist[*ep++] - bbeg; + + curlp = lp; + + while(ecmp(bbeg, lp, ct)) + + lp += ct; + + + + while(lp >= curlp) { + + if(advance(lp, ep)) return(1); + + lp -= ct; + + } + + return(0); + + + + + + case CDOT|STAR: + + curlp = lp; + + while (*lp++); + + goto star; + + + + case CCHR|STAR: + + curlp = lp; + + while (*lp++ == *ep); + + ep++; + + goto star; + + + + case CCL|STAR: + + curlp = lp; + + do { + + c = *lp++ & 0177; + + } while(ISTHERE(c)); + + ep += 16; + + goto star; + + + + star: + + do { + + if(--lp == locs) + + break; + + if (advance(lp, ep)) + + return(1); + + } while (lp > curlp); + + return(0); + + + + } + +} + + + +getrnge(str) + +register char *str; + +{ + + low = *str++ & 0377; + + size = *str == 255 ? 20000 : (*str &0377) - low; + +} + + + +ecmp(a, b, count) + +register char *a, *b; + +register count; + +{ + + if(a == b) /* should have been caught in compile() */ + + error(51); + + while(count--) + + if(*a++ != *b++) return(0); + + return(1); + +} + + +++static char *sccsid = "@(#)expr.y 4.1 (Berkeley) 10/1/80"; + +yyerror(s) + + + +{ + + fprintf(stderr, "%s\n", s); + + exit(2); + +} diff --cc usr/src/cmd/f77/driver.c index 0000000000,7fefae3772,0000000000..bb8b760877 mode 000000,100644,000000..100644 --- a/usr/src/cmd/f77/driver.c +++ b/usr/src/cmd/f77/driver.c @@@@ -1,0 -1,1203 -1,0 +1,1226 @@@@ - char *xxxvers[] = "\n FORTRAN 77 DRIVER, VERSION 2.00, 7 JANUARY 1980\n"; +++char *xxxvers[] = "\n@(#) FORTRAN 77 DRIVER, VERSION 2.03.5, 7 NOVEMBER 1980\n"; + +#include + +#include + +#include "defines" + +#include "machdefs" + +#include "drivedefs" + +#include "ftypes" + +#include + + + +static FILEP diagfile = {stderr} ; + +static int pid; + +static int sigivalue = 0; + +static int sigqvalue = 0; + +static int sighvalue = 0; + +static int sigtvalue = 0; + + + +static char *pass1name = PASS1NAME ; + +static char *pass2name = PASS2NAME ; + +static char *asmname = ASMNAME ; + +static char *ldname = LDNAME ; + +static char *footname = FOOTNAME; + +static char *proffoot = PROFFOOT; + +static char *macroname = "m4"; + +static char *shellname = "/bin/sh"; + +static char *aoutname = "a.out" ; +++static char *temppref = TEMPPREF; + + + +static char *infname; - static char textfname[15]; - static char asmfname[15]; - static char asmpass2[15]; - static char initfname[15]; - static char sortfname[15]; - static char prepfname[15]; - static char objfdefault[15]; - static char optzfname[15]; - static char setfname[15]; +++static char textfname[40]; +++static char asmfname[40]; +++static char asmpass2[40]; +++static char initfname[40]; +++static char sortfname[40]; +++static char prepfname[40]; +++static char objfdefault[40]; +++static char optzfname[40]; +++static char setfname[40]; + + + +static char fflags[50] = "-"; - static char cflags[20] = "-c"; - static char eflags[30] = ""; +++static char cflags[50] = "-c"; +++#if TARGET == GCOS +++ static char eflags[30] = "system=gcos "; +++#else +++ static char eflags[30] = "system=unix "; +++#endif + +static char rflags[30] = ""; + +static char lflag[3] = "-x"; + +static char *fflagp = fflags+1; + +static char *cflagp = cflags+2; - static char *eflagp = eflags; +++static char *eflagp = eflags+12; + +static char *rflagp = rflags; + +static char **loadargs; + +static char **loadp; + + + +static flag erred = NO; + +static flag loadflag = YES; + +static flag saveasmflag = NO; + +static flag profileflag = NO; + +static flag optimflag = NO; + +static flag debugflag = NO; + +static flag verbose = NO; + +static flag nofloating = NO; + +static flag fortonly = NO; + +static flag macroflag = NO; +++static flag sdbflag = NO; +++ + + + + + +main(argc, argv) + +int argc; + +char **argv; + +{ + +int i, c, status; - char *setdoto(), *lastchar(), *lastfield(); +++char *setdoto(), *lastchar(), *lastfield(), *copys(); + +ptr ckalloc(); + +register char *s; + +char fortfile[20], *t; + +char buff[100]; + +int intrupt(); + + + +sigivalue = (int) signal(SIGINT, SIG_IGN) & 01; + +sigqvalue = (int) signal(SIGQUIT,SIG_IGN) & 01; + +sighvalue = (int) signal(SIGHUP, SIG_IGN) & 01; + +sigtvalue = (int) signal(SIGTERM,SIG_IGN) & 01; + +enbint(intrupt); + + + +pid = getpid(); + +crfnames(); + + + +loadargs = (char **) ckalloc( (argc+20) * sizeof(*loadargs) ); + +loadargs[1] = "-X"; + +loadargs[2] = "-u"; + +#if HERE==PDP11 || HERE==VAX + + loadargs[3] = "_MAIN__"; + +#endif + +#if HERE == INTERDATA + + loadargs[3] = "main"; + +#endif + +loadp = loadargs + 4; + + + +--argc; + +++argv; + + + +while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0') + + { + + for(s = argv[0]+1 ; *s ; ++s) switch(*s) + + { + + case 'T': /* use special passes */ + + switch(*++s) + + { + + case '1': + + pass1name = s+1; goto endfor; + + case '2': + + pass2name = s+1; goto endfor; + + case 'a': + + asmname = s+1; goto endfor; + + case 'l': + + ldname = s+1; goto endfor; + + case 'F': + + footname = s+1; goto endfor; + + case 'm': + + macroname = s+1; goto endfor; +++ case 't': +++ temppref = s+1; goto endfor; + + default: + + fatali("bad option -T%c", *s); + + } + + break; + + + + case '6': + + if(s[1]=='6') + + { + + *fflagp++ = *s++; + + goto copyfflag; + + } + + else { + + fprintf(diagfile, "invalid flag 6%c\n", s[1]); + + done(1); + + } + + + + case 'w': + + if(s[1]=='6' && s[2]=='6') + + { + + *fflagp++ = *s++; + + *fflagp++ = *s++; + + } + + + + copyfflag: + + case 'u': + + case 'U': - case 'M': + + case '1': + + case 'C': - case 'g': + + *fflagp++ = *s; + + break; + + + + case 'O': + + optimflag = YES; + +#if TARGET == INTERDATA + + *loadp++ = "-r"; + + *loadp++ = "-d"; + +#endif + + *fflagp++ = 'O'; + + if( isdigit(s[1]) ) + + *fflagp++ = *++s; + + break; + + + + case 'N': + + *fflagp++ = 'N'; + + if( oneof(*++s, "qxscn") ) + + *fflagp++ = *s++; + + else { + + fprintf(diagfile, "invalid flag -N%c\n", *s); + + done(1); + + } + + while( isdigit(*s) ) + + *fflagp++ = *s++; + + *fflagp++ = 'X'; + + goto endfor; + + + + case 'm': + + if(s[1] == '4') + + ++s; + + macroflag = YES; + + break; + + + + case 'S': +++ strcat(cflags, " -S"); + + saveasmflag = YES; + + + + case 'c': + + loadflag = NO; + + break; + + + + case 'v': + + verbose = YES; + + break; + + + + case 'd': + + debugflag = YES; + + goto copyfflag; + + +++ case 'M': +++ *loadp++ = "-M"; +++ break; +++ +++ case 'g': +++ strcat(cflags," -g"); +++ sdbflag = YES; +++ goto copyfflag; +++ + + case 'p': + + profileflag = YES; - *cflagp++ = 'p'; +++ strcat(cflags," -p"); + + goto copyfflag; + + + + case 'o': + + if( ! strcmp(s, "onetrip") ) + + { + + *fflagp++ = '1'; + + goto endfor; + + } + + aoutname = *++argv; + + --argc; + + break; + + + +#if TARGET == PDP11 + + case 'f': + + nofloating = YES; + + pass2name = NOFLPASS2; + + break; + +#endif + + + + case 'F': + + fortonly = YES; + + loadflag = NO; + + break; + + + + case 'I': + + if(s[1]=='2' || s[1]=='4' || s[1]=='s') + + { + + *fflagp++ = *s++; + + goto copyfflag; + + } + + fprintf(diagfile, "invalid flag -I%c\n", s[1]); + + done(1); + + + + case 'l': /* letter ell--library */ + + s[-1] = '-'; + + *loadp++ = s-1; + + goto endfor; + + + + case 'E': /* EFL flag argument */ + + while( *eflagp++ = *++s) + + ; + + *eflagp++ = ' '; + + goto endfor; + + case 'R': + + while( *rflagp++ = *++s ) + + ; + + *rflagp++ = ' '; + + goto endfor; + + default: + + lflag[1] = *s; + + *loadp++ = copys(lflag); + + break; + + } + +endfor: + + --argc; + + ++argv; + + } + + + +*fflagp = '\0'; + + + +loadargs[0] = ldname; + +#if TARGET == PDP11 + + if(nofloating) + + *loadp++ = (profileflag ? NOFLPROF : NOFLFOOT); + + else + +#endif + +*loadp++ = (profileflag ? proffoot : footname); + + + +for(i = 0 ; i%s", macroname, infname, prepfname); + + if( sys(buff) ) + + { + + rmf(prepfname); + + erred = YES; + + break; + + } + + infname = prepfname; + + } + + + + if(c == 'e') + + sprintf(buff, "efl %s %s >%s", eflags, infname, fortfile); + + else + + sprintf(buff, "ratfor %s %s >%s", rflags, infname, fortfile); + + status = sys(buff); + + if(macroflag) + + rmf(infname); + + if(status) + + { + + erred = YES; + + rmf(fortfile); + + break; + + } + + + + if( ! fortonly ) + + { + + infname = argv[i] = lastfield(argv[i]); + + *lastchar(infname) = 'f'; + + + + if( dofort(argv[i]) ) + + erred = YES; + + else { + + if( nodup(t = setdoto(argv[i])) ) + + *loadp++ = t; + + rmf(fortfile); + + } + + } + + break; + + + + case 'f': /* Fortran file */ + + case 'F': + + if( unreadable(argv[i]) ) + + erred = YES; + + else if( dofort(argv[i]) ) + + erred = YES; + + else if( nodup(t=setdoto(argv[i])) ) + + *loadp++ = t; + + break; + + + + case 'c': /* C file */ + + case 's': /* Assembler file */ + + if( unreadable(argv[i]) ) + + { + + erred = YES; + + break; + + } + +#if HERE==PDP11 || HERE==VAX + + fprintf(diagfile, "%s:\n", argv[i]); + +#endif - sprintf(buff, "cc -c %s", argv[i] ); +++ sprintf(buff, "cc %s %s", cflags, argv[i] ); + + if( sys(buff) ) + + erred = YES; + + else + + if( nodup(t = setdoto(argv[i])) ) + + *loadp++ = t; + + break; + + + + case 'o': + + if( nodup(argv[i]) ) + + *loadp++ = argv[i]; + + break; + + + + default: + + if( ! strcmp(argv[i], "-o") ) + + aoutname = argv[++i]; + + else + + *loadp++ = argv[i]; + + break; + + } + + + +if(loadflag && !erred) + + doload(loadargs, loadp); + +done(erred); + +} + + + +dofort(s) + +char *s; + +{ + +int retcode; + +char buff[200]; + + + +infname = s; + +sprintf(buff, "%s %s %s %s %s %s", + + pass1name, fflags, s, asmfname, initfname, textfname); + +switch( sys(buff) ) + + { + + case 1: + + goto error; + + case 0: + + break; + + default: + + goto comperror; + + } + + + +if(content(initfname) > 0) + + if( dodata() ) + + goto error; + +if( dopass2() ) + + goto comperror; + +doasm(s); + +retcode = 0; + + + +ret: + + rmf(asmfname); + + rmf(initfname); + + rmf(textfname); + + return(retcode); + + + +error: + + fprintf(diagfile, "\nError. No assembly.\n"); + + retcode = 1; + + goto ret; + + + +comperror: + + fprintf(diagfile, "\ncompiler error.\n"); + + retcode = 2; + + goto ret; + +} + + + + + + + + + +dopass2() + +{ + +char buff[100]; + + + +if(verbose) + + fprintf(diagfile, "PASS2."); + + + +#if FAMILY==DMR + + sprintf(buff, "%s %s - %s", pass2name, textfname, asmpass2); + + return( sys(buff) ); + +#endif + + + +#if FAMILY == PCC + +# if TARGET==INTERDATA + + sprintf(buff, "%s -A%s <%s >%s", pass2name, setfname, textfname, asmpass2); + +# else - sprintf(buff, "%s <%s >%s", pass2name, textfname, asmpass2); +++ sprintf(buff, "%s %s >%s", pass2name, textfname, asmpass2); + +# endif + + return( sys(buff) ); + +#endif + +} + + + + + + + + + +doasm(s) + +char *s; + +{ + +register char *lastc; + +char *obj; + +char buff[200]; +++char *lastchar(), *setdoto(); + + + +if(*s == '\0') + + s = objfdefault; + +lastc = lastchar(s); + +obj = setdoto(s); + + + +#if TARGET==PDP11 || TARGET==VAX + +# ifdef PASS2OPT + + if(optimflag) + + { + + sprintf(buff, "%s %s %s", PASS2OPT, asmpass2, optzfname); + + if( sys(buff) ) + + rmf(optzfname); + + else + + { + + sprintf(buff,"mv %s %s", optzfname, asmpass2); + + sys(buff); + + } + + } + +# endif + +#endif + + + +if(saveasmflag) + + { + + *lastc = 's'; + +#if TARGET == INTERDATA + + sprintf(buff, "cat %s %s %s >%s",asmfname, setfname, asmpass2, obj); + +#else + + sprintf(buff, "cat %s %s >%s", asmfname, asmpass2, obj); + +#endif + + sys(buff); + + *lastc = 'o'; + + } + +else + + { + + if(verbose) + + fprintf(diagfile, " ASM."); + +#if TARGET == INTERDATA + + sprintf(buff, "%s -o %s %s %s %s", asmname, obj, asmfname, setfname, asmpass2); + +#endif + + + +#if TARGET == VAX + + /* vax assembler currently accepts only one input file */ + + sprintf(buff, "cat %s >>%s", asmpass2, asmfname); + + sys(buff); + + sprintf(buff, "%s -o %s %s", asmname, obj, asmfname); + +#endif + + + +#if TARGET == PDP11 + + sprintf(buff, "%s -u -o %s %s %s", asmname, obj, asmfname, asmpass2); + +#endif + + + +#if TARGET!=INTERDATA && TARGET!=PDP11 && TARGET!=VAX + + sprintf(buff, "%s -o %s %s %s", asmname, obj, asmfname, asmpass2); + +#endif + + + + if( sys(buff) ) + + fatal("assembler error"); + + if(verbose) + + fprintf(diagfile, "\n"); + +#if HERE==PDP11 && TARGET!=PDP11 + + rmf(obj); + +#endif + + } + + + +rmf(asmpass2); + +} + + + + + + + +doload(v0, v) + +register char *v0[], *v[]; + +{ + +char **p; + +int waitpid; + + +++if(sdbflag) +++ *v++ = "-lg"; + +for(p = liblist ; *p ; *v++ = *p++) + + ; + + + +*v++ = "-o"; + +*v++ = aoutname; + +*v = NULL; + + + +if(verbose) + + fprintf(diagfile, "LOAD."); + +if(debugflag) + + { + + for(p = v0 ; p') + + { + + if(t[1] == '>') + + { + + append = YES; + + outname = t+2; + + } + + else { + + append = NO; + + outname = t+1; + + } + + } + + else + + argv[argc++] = t; + + while( !isspace(*t) && *t!='\0' ) + + ++t; + + if(*t) + + { + + *t++ = '\0'; + + while( isspace(*t) ) + + ++t; + + } + + } + + + +if(argc == 1) /* no command */ + + return(-1); + +argv[argc] = 0; + + + +s = path; + +t = "/usr/bin/"; + +while(*t) + + *s++ = *t++; + +for(t = argv[1] ; *s++ = *t++ ; ) + + ; + +if((waitpid = fork()) == 0) + + { + + if(inname) + + freopen(inname, "r", stdin); + + if(outname) + + freopen(outname, (append ? "a" : "w"), stdout); + + enbint(SIG_DFL); + + + + texec(path+9, argv); /* command */ + + texec(path+4, argv); /* /bin/command */ + + texec(path , argv); /* /usr/bin/command */ + + + + fatalstr("Cannot load %s",path+9); + + } + + + +return( await(waitpid) ); + +} + + + + + + + + + + + +#include "errno.h" + + + +/* modified version from the Shell */ + +texec(f, av) + +char *f; + +char **av; + +{ + +extern int errno; + + + +execv(f, av+1); + + + +if (errno==ENOEXEC) + + { + + av[1] = f; + + execv(shellname, av); + + fatal("No shell!"); + + } + +if (errno==ENOMEM) + + fatalstr("%s: too large", f); + +} + + + + + + + + + + + + + +done(k) + +int k; + +{ + +static int recurs = NO; + + + +if(recurs == NO) + + { + + recurs = YES; + + rmfiles(); + + } + +exit(k); + +} + + + + + + + + + + + + + +enbint(k) + +int (*k)(); + +{ + +if(sigivalue == 0) + + signal(SIGINT,k); + +if(sigqvalue == 0) + + signal(SIGQUIT,k); + +if(sighvalue == 0) + + signal(SIGHUP,k); + +if(sigtvalue == 0) + + signal(SIGTERM,k); + +} + + + + + + + + + +intrupt() + +{ + +done(2); + +} + + + + + + + +await(waitpid) + +int waitpid; + +{ + +int w, status; + + + +enbint(SIG_IGN); + +while ( (w = wait(&status)) != waitpid) + + if(w == -1) + + fatal("bad wait code"); + +enbint(intrupt); + +if(status & 0377) + + { + + if(status != SIGINT) + + fprintf(diagfile, "Termination code %d", status); + + done(3); + + } + +return(status>>8); + +} + + + +/* File Name and File Manipulation Routines */ + + + +unreadable(s) + +register char *s; + +{ + +register FILE *fp; + + + +if(fp = fopen(s, "r")) + + { + + fclose(fp); + + return(NO); + + } + + + +else + + { + + fprintf(diagfile, "Error: Cannot read file %s\n", s); + + return(YES); + + } + +} + + + + + + + +clf(p) + +FILEP *p; + +{ + +if(p!=NULL && *p!=NULL && *p!=stdout) + + { + + if(ferror(*p)) + + fatal("writing error"); + + fclose(*p); + + } + +*p = NULL; + +} + + + +rmfiles() + +{ + +rmf(textfname); + +rmf(asmfname); + +rmf(initfname); + +rmf(asmpass2); + +#if TARGET == INTERDATA + + rmf(setfname); + +#endif + +} + + + + + + + + + + + + + + + + + +/* return -1 if file does not exist, 0 if it is of zero length + + and 1 if of positive length + +*/ + +content(filename) + +char *filename; + +{ + +#ifdef VERSION6 + + struct stat + + { + + char cjunk[9]; + + char size0; + + int size1; + + int ijunk[12]; + + } buf; + +#else + +# include + +# include + + struct stat buf; + +#endif + + + +if(stat(filename,&buf) < 0) + + return(-1); + +#ifdef VERSION6 + + return(buf.size0 || buf.size1); + +#else + + return( buf.st_size > 0 ); + +#endif + +} + + + + + + + + + +crfnames() + +{ + +fname(textfname, "x"); + +fname(asmfname, "s"); + +fname(asmpass2, "a"); + +fname(initfname, "d"); + +fname(sortfname, "S"); + +fname(objfdefault, "o"); + +fname(prepfname, "p"); + +fname(optzfname, "z"); + +fname(setfname, "A"); + +} + + + + + + + + + +rmf(fn) + +register char *fn; + +{ + +if(!debugflag && fn!=NULL && *fn!='\0') + + unlink(fn); + +} + + + + + + + + + + + +LOCAL fname(name, suff) + +char *name, *suff; + +{ - sprintf(name, "fort%d.%s", pid, suff); +++sprintf(name, "%s%d.%s", temppref, pid, suff); + +} + + + + + + + + + +dotchar(s) + +register char *s; + +{ + +for( ; *s ; ++s) + + if(s[0]=='.' && s[1]!='\0' && s[2]=='\0') + + return( s[1] ); + +return(NO); + +} + + + + + + + +char *lastfield(s) + +register char *s; + +{ + +register char *t; + +for(t = s; *s ; ++s) + + if(*s == '/') + + t = s+1; + +return(t); + +} + + + + + + + +char *lastchar(s) + +register char *s; + +{ + +while(*s) + + ++s; + +return(s-1); + +} + + + +char *setdoto(s) + +register char *s; + +{ + +*lastchar(s) = 'o'; + +return( lastfield(s) ); + +} + + + + + + + +badfile(s) + +char *s; + +{ + +fatalstr("cannot open intermediate file %s", s); + +} + + + + + + + +ptr ckalloc(n) + +int n; + +{ + +ptr p, calloc(); + + + +if( p = calloc(1, (unsigned) n) ) + + return(p); + + + +fatal("out of memory"); + +/* NOTREACHED */ + +} + + + + + + + + + + - copyn(n, s) +++char *copyn(n, s) + +register int n; + +register char *s; + +{ + +register char *p, *q; + + + +p = q = (char *) ckalloc(n); + +while(n-- > 0) + + *q++ = *s++; + +return(p); + +} + + + + + + - copys(s) +++char *copys(s) + +char *s; + +{ + +return( copyn( strlen(s)+1 , s) ); + +} + + + + + + + + + + + +oneof(c,s) + +register c; + +register char *s; + +{ + +while( *s ) + + if(*s++ == c) + + return(YES); + +return(NO); + +} + + + + + + + +nodup(s) + +char *s; + +{ + +register char **p; + + + +for(p = loadargs ; p < loadp ; ++p) + + if( !strcmp(*p, s) ) + + return(NO); + + + +return(YES); + +} + + + + + + + +static fatal(t) + +char *t; + +{ + +fprintf(diagfile, "Compiler error in file %s: %s\n", infname, t); + +if(debugflag) + + abort(); + +done(1); + +exit(1); + +} + + + + + + + + + +static fatali(t,d) + +char *t; + +int d; + +{ + +char buff[100]; + +sprintf(buff, t, d); + +fatal(buff); + +} + + + + + + + + + +static fatalstr(t, s) + +char *t, *s; + +{ + +char buff[100]; + +sprintf(buff, t, s); + +fatal(buff); + +} + +err(s) + +char *s; + +{ + +fprintf(diagfile, "Error in file %s: %s\n", infname, s); + +} + + +++/* Code to generate initializations for DATA statements */ +++ + +LOCAL int nch = 0; + +LOCAL FILEP asmfile; + +LOCAL FILEP sortfile; + + + +#include "ftypes" + + + +static ftnint typesize[NTYPES] + + = { 1, SZADDR, SZSHORT, SZLONG, SZLONG, 2*SZLONG, + + 2*SZLONG, 4*SZLONG, SZLONG, 1, 1, 1}; + +static int typealign[NTYPES] + + = { 1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE, + + ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1}; + + + +dodata() + +{ + +char buff[50]; + +char varname[XL+1], ovarname[XL+1]; + +int status; + +flag erred; + +ftnint offset, vlen, type; + +register ftnint ooffset, ovlen; + +ftnint nblank, vchar; + +int size, align; + +int vargroup; + +ftnint totlen, doeven(); + + + +erred = NO; + +ovarname[0] = '\0'; + +ooffset = 0; + +ovlen = 0; + +totlen = 0; + +nch = 0; + + + +sprintf(buff, "sort %s >%s", initfname, sortfname); + +if(status = sys(buff)) + + fatali("call sort status = %d", status); + +if( (sortfile = fopen(sortfname, "r")) == NULL) + + badfile(sortfname); + +if( (asmfile = fopen(asmfname, "a")) == NULL) + + badfile(asmfname); + +pruse(asmfile, USEINIT); + + + +while( rdname(&vargroup, varname) && rdlong(&offset) && rdlong(&vlen) && rdlong(&type) ) + + { + + size = typesize[type]; + + if( strcmp(varname, ovarname) ) + + { + + prspace(ovlen-ooffset); + + strcpy(ovarname, varname); + + ooffset = 0; + + totlen += ovlen; + + ovlen = vlen; + + if(vargroup == 0) + + align = (type==TYCHAR || type==TYBLANK ? + + SZLONG : typealign[type]); + + else align = ALIDOUBLE; + + totlen = doeven(totlen, align); + + if(vargroup == 2) + + prcomblock(asmfile, varname); + + else + + fprintf(asmfile, LABELFMT, varname); + + } + + if(offset < ooffset) + + { + + erred = YES; + + err("overlapping initializations"); +++ ooffset = offset; + + } + + if(offset > ooffset) + + { + + prspace(offset-ooffset); + + ooffset = offset; + + } + + if(type == TYCHAR) + + { + + if( rdlong(&vchar) ) + + prch( (int) vchar ); + + else + + fatal("bad intermediate file format"); + + } + + else if(type == TYBLANK) + + { + + if( rdlong(&nblank) ) + + { + + size = nblank; + + while( --nblank >= 0) + + prch( ' ' ); + + } + + else + + fatal("bad intermediate file format"); + + } + + else + + { + + putc('\t', asmfile); + + while ( putc( getc(sortfile), asmfile) != '\n') + + ; + + } + + if( (ooffset += size) > ovlen) + + { + + erred = YES; + + err("initialization out of bounds"); + + } + + } + + + +prspace(ovlen-ooffset); + +totlen = doeven(totlen+ovlen, (ALIDOUBLE>SZLONG ? ALIDOUBLE : SZLONG) ); + +clf(&sortfile); + +clf(&asmfile); + +clf(&sortfile); + +rmf(sortfname); + +return(erred); + +} + + + + + + + + + +prspace(n) + +register ftnint n; + +{ + +register ftnint m; + + + +while(nch>0 && n>0) + + { + + --n; + + prch(0); + + } + +m = SZSHORT * (n/SZSHORT); + +if(m > 0) + + prskip(asmfile, m); + +for(n -= m ; n>0 ; --n) + + prch(0); + +} + + + + + + + + + +ftnint doeven(tot, align) + +register ftnint tot; + +int align; + +{ + +ftnint new; + +new = roundup(tot, align); + +prspace(new - tot); + +return(new); + +} + + + + + + + +rdname(vargroupp, name) + +int *vargroupp; + +register char *name; + +{ + +register int i, c; + + + +if( (c = getc(sortfile)) == EOF) + + return(NO); + +*vargroupp = c - '0'; + + + +for(i = 0 ; i + + + +#ifdef SDB + +# include +++# ifndef N_SO +++# include +++# endif + +#endif + + + + + +main(argc, argv) + +int argc; + +char **argv; + +{ + +char *s; + +int k, retcode, *ip; + +FILEP opf(); + +int flovflo(); + + + +#define DONE(c) { retcode = c; goto finis; } + + + +signal(SIGFPE, flovflo); /* catch overflows */ + + + +#if HERE == PDP11 + + ldfps(01200); /* trap on overflow */ + +#endif + + + + + + + +--argc; + +++argv; + + + +while(argc>0 && argv[0][0]=='-') + + { + + for(s = argv[0]+1 ; *s ; ++s) switch(*s) + + { + + case 'w': + + if(s[1]=='6' && s[2]=='6') + + { + + ftn66flag = YES; + + s += 2; + + } + + else + + nowarnflag = YES; + + break; + + + + case 'U': + + shiftcase = NO; + + break; + + + + case 'u': + + undeftype = YES; + + break; + + + + case 'O': + + optimflag = YES; + + if( isdigit(s[1]) ) + + { + + k = *++s - '0'; + + if(k > MAXREGVAR) + + { + + warn1("-O%d: too many register variables", k); + + maxregvar = MAXREGVAR; + + } + + else + + maxregvar = k; + + } + + break; + + + + case 'd': + + debugflag = YES; + + break; + + + + case 'p': + + profileflag = YES; + + break; + + + + case 'C': + + checksubs = YES; + + break; + + + + case '6': + + no66flag = YES; + + noextflag = YES; + + break; + + + + case '1': + + onetripflag = YES; + + break; + + + +#ifdef SDB + + case 'g': + + sdbflag = YES; + + break; + +#endif + + + + case 'N': + + switch(*++s) + + { + + case 'q': + + ip = &maxequiv; goto getnum; + + case 'x': + + ip = &maxext; goto getnum; + + case 's': + + ip = &maxstno; goto getnum; + + case 'c': + + ip = &maxctl; goto getnum; + + case 'n': + + ip = &maxhash; goto getnum; + + + + default: + + fatali("invalid flag -N%c", *s); + + } + + getnum: + + k = 0; + + while( isdigit(*++s) ) + + k = 10*k + (*s - '0'); + + if(k <= 0) + + fatal("Table size too small"); + + *ip = k; + + break; + + + + case 'I': + + if(*++s == '2') + + tyint = TYSHORT; + + else if(*s == '4') + + { + + shortsubs = NO; + + tyint = TYLONG; + + } + + else if(*s == 's') + + shortsubs = YES; + + else + + fatali("invalid flag -I%c\n", *s); + + tylogical = tyint; + + break; + + + + default: + + fatali("invalid flag %c\n", *s); + + } + + --argc; + + ++argv; + + } + + + +if(argc != 4) + + fatali("arg count %d", argc); + +asmfile = opf(argv[1]); + +initfile = opf(argv[2]); + +textfile = opf(argv[3]); + + + +initkey(); + +if(inilex( copys(argv[0]) )) + + DONE(1); + +fprintf(diagfile, "%s:\n", argv[0]); + + + +#ifdef SDB + +for(s = argv[0] ; ; s += 8) + + { + + prstab(s,N_SO,0,0); + + if( strlen(s) < 8 ) + + break; + + } + +#endif + + + +fileinit(); + +procinit(); + +if(k = yyparse()) + + { + + fprintf(diagfile, "Bad parse, return code %d\n", k); + + DONE(1); + + } + +if(nerr > 0) + + DONE(1); + +if(parstate != OUTSIDE) + + { + + warn("missing END statement"); + + endproc(); + + } + +doext(); + +preven(ALIDOUBLE); + +prtail(); + +#if FAMILY==PCC + + puteof(); + +#endif + + + +if(nerr > 0) + + DONE(1); + +DONE(0); + + + + + +finis: + + done(retcode); + + return(retcode); + +} + + + + + + + +done(k) + +int k; + +{ + +static int recurs = NO; + + + +if(recurs == NO) + + { + + recurs = YES; + + clfiles(); + + } + +exit(k); + +} + + + + + +LOCAL FILEP opf(fn) + +char *fn; + +{ + +FILEP fp; + +if( fp = fopen(fn, "w") ) + + return(fp); + + + +fatalstr("cannot open intermediate file %s", fn); + +/* NOTREACHED */ + +} + + + + + + + +LOCAL clfiles() + +{ + +clf(&textfile); + +clf(&asmfile); + +clf(&initfile); + +} + + + + + +clf(p) + +FILEP *p; + +{ + +if(p!=NULL && *p!=NULL && *p!=stdout) + + { + + if(ferror(*p)) + + fatal("writing error"); + + fclose(*p); + + } + +*p = NULL; + +} + + + + + + + + + +flovflo() + +{ + +err("floating exception during constant evaluation"); + +#if HERE == VAX + + fatal("vax cannot recover from floating exception"); + + /* vax returns a reserved operand that generates + + an illegal operand fault on next instruction, + + which if ignored causes an infinite loop. + + */ + +#endif + +signal(SIGFPE, flovflo); + +} diff --cc usr/src/cmd/fgrep.c index 0000000000,ff48d94b4b,0000000000..0c2b97a682 mode 000000,100644,000000..100644 --- a/usr/src/cmd/fgrep.c +++ b/usr/src/cmd/fgrep.c @@@@ -1,0 -1,349 -1,0 +1,365 @@@@ +++static char *sccsid = "@(#)fgrep.c 4.1 (Berkeley) 10/1/80"; + +/* + + * fgrep -- print all lines containing any of a set of keywords + + * + + * status returns: + + * 0 - ok, and some matches + + * 1 - ok, but no matches + + * 2 - some error + + */ + + - #include +++#include "stdio.h" +++# include "ctype.h" + + + +#define MAXSIZ 6000 + +#define QSIZE 400 + +struct words { + + char inp; + + char out; + + struct words *nst; + + struct words *link; + + struct words *fail; + +} w[MAXSIZ], *smax, *q; + + + +long lnum; - int bflag, cflag, fflag, lflag, nflag, vflag, xflag; +++int bflag, cflag, fflag, lflag, nflag, vflag, xflag, yflag; + +int hflag = 1; + +int sflag; +++int retcode = 0; + +int nfile; - int blkno; +++long blkno; + +int nsucc; + +long tln; + +FILE *wordf; + +char *argptr; + + + +main(argc, argv) + +char **argv; + +{ + + while (--argc > 0 && (++argv)[0][0]=='-') + + switch (argv[0][1]) { + + + + case 's': + + sflag++; + + continue; + + + + case 'h': + + hflag = 0; + + continue; + + + + case 'b': + + bflag++; + + continue; + + + + case 'c': + + cflag++; + + continue; + + + + case 'e': + + argc--; + + argv++; + + goto out; + + + + case 'f': + + fflag++; + + continue; + + + + case 'l': + + lflag++; + + continue; + + + + case 'n': + + nflag++; + + continue; + + + + case 'v': + + vflag++; + + continue; + + + + case 'x': + + xflag++; + + continue; + + +++ case 'i': /* Berkeley */ +++ case 'y': /* Btl */ +++ yflag++; +++ continue; + + default: + + fprintf(stderr, "fgrep: unknown flag\n"); + + continue; + + } + +out: + + if (argc<=0) + + exit(2); + + if (fflag) { + + wordf = fopen(*argv, "r"); + + if (wordf==NULL) { + + fprintf(stderr, "fgrep: can't open %s\n", *argv); + + exit(2); + + } + + } + + else argptr = *argv; + + argc--; + + argv++; + + + + cgotofn(); + + cfail(); + + nfile = argc; + + if (argc<=0) { + + if (lflag) exit(1); + + execute((char *)NULL); + + } + + else while (--argc >= 0) { + + execute(*argv); + + argv++; + + } - exit(nsucc == 0); +++ exit(retcode != 0 ? retcode : nsucc == 0); + +} + + +++# define ccomp(a,b) (yflag ? lca(a)==lca(b) : a==b) +++# define lca(x) (isupper(x) ? tolower(x) : x) + +execute(file) + +char *file; + +{ - register char *p; + + register struct words *c; + + register ccount; - char buf[BUFSIZ*2]; +++ register char ch; +++ register char *p; +++ char buf[2*BUFSIZ]; + + int f; - int failed, ecnt; +++ int failed; + + char *nlp; + + if (file) { + + if ((f = open(file, 0)) < 0) { + + fprintf(stderr, "fgrep: can't open %s\n", file); - exit(2); +++ retcode = 2; +++ return; + + } + + } + + else f = 0; + + ccount = 0; + + failed = 0; + + lnum = 1; + + tln = 0; - blkno = -1; +++ blkno = 0; + + p = buf; + + nlp = p; + + c = w; + + for (;;) { + + if (--ccount <= 0) { - if (p == &buf[BUFSIZ*2]) p = buf; +++ if (p == &buf[2*BUFSIZ]) p = buf; + + if (p > &buf[BUFSIZ]) { - if ((ccount = read(f, p, &buf[BUFSIZ] - p)) <= 0) break; +++ if ((ccount = read(f, p, &buf[2*BUFSIZ] - p)) <= 0) break; + + } + + else if ((ccount = read(f, p, BUFSIZ)) <= 0) break; - blkno++; +++ blkno += ccount; + + } + + nstate: - if (c->inp == *p) { +++ if (ccomp(c->inp, *p)) { + + c = c->nst; + + } + + else if (c->link != 0) { + + c = c->link; + + goto nstate; + + } + + else { + + c = c->fail; + + failed = 1; + + if (c==0) { + + c = w; + + istate: - if (c->inp == *p) { +++ if (ccomp(c->inp , *p)) { + + c = c->nst; + + } + + else if (c->link != 0) { + + c = c->link; + + goto istate; + + } + + } + + else goto nstate; + + } + + if (c->out) { - ecnt = 0; + + while (*p++ != '\n') { - ecnt++; - if (--ccount <= 0) { - if (p == &buf[BUFSIZ*2]) p = buf; +++ if (--ccount <= 0) { +++ if (p == &buf[2*BUFSIZ]) p = buf; + + if (p > &buf[BUFSIZ]) { - if ((ccount = read(f, p, &buf[BUFSIZ] - p)) <= 0) break; +++ if ((ccount = read(f, p, &buf[2&BUFSIZ] - p)) <= 0) break; + + } + + else if ((ccount = read(f, p, BUFSIZ)) <= 0) break; - blkno++; - } - } - if (vflag == 0) { - if (xflag) - if (failed || ecnt > 1) goto nogood; - succeed: nsucc = 1; - if (cflag) tln++; - else if (sflag) - ; /* ugh */ - else if (lflag) { - printf("%s\n", file); - close(f); - return; +++ blkno += ccount; + + } - else { - if (nfile > 1 && hflag) printf("%s:", file); - if (bflag) printf("%d:", blkno); - if (nflag) printf("%ld:", lnum); - if (p <= nlp) { - while (nlp < &buf[BUFSIZ*2]) putchar(*nlp++); - nlp = buf; - } - while (nlp < p) putchar(*nlp++); +++ } +++ if ( (vflag && (failed == 0 || xflag == 0)) || (vflag == 0 && xflag && failed) ) +++ goto nomatch; +++ succeed: nsucc = 1; +++ if (cflag) tln++; +++ else if (sflag) +++ ; /* ugh */ +++ else if (lflag) { +++ printf("%s\n", file); +++ close(f); +++ return; +++ } +++ else { +++ if (nfile > 1 && hflag) printf("%s:", file); +++ if (bflag) printf("%ld:", (blkno-ccount-1)/BUFSIZ); +++ if (nflag) printf("%ld:", lnum); +++ if (p <= nlp) { +++ while (nlp < &buf[2*BUFSIZ]) putchar(*nlp++); +++ nlp = buf; + + } +++ while (nlp < p) putchar(*nlp++); + + } - nogood: lnum++; +++ nomatch: lnum++; + + nlp = p; + + c = w; + + failed = 0; + + continue; + + } + + if (*p++ == '\n') + + if (vflag) goto succeed; + + else { + + lnum++; + + nlp = p; + + c = w; + + failed = 0; + + } + + } + + close(f); + + if (cflag) { + + if (nfile > 1) + + printf("%s:", file); + + printf("%ld\n", tln); + + } + +} + + + +getargc() + +{ + + register c; + + if (wordf) + + return(getc(wordf)); + + if ((c = *argptr++) == '\0') + + return(EOF); + + return(c); + +} + + + +cgotofn() { + + register c; + + register struct words *s; + + + + s = smax = w; + +nword: for(;;) { + + c = getargc(); + + if (c==EOF) + + return; + + if (c == '\n') { + + if (xflag) { + + for(;;) { + + if (s->inp == c) { + + s = s->nst; + + break; + + } + + if (s->inp == 0) goto nenter; + + if (s->link == 0) { + + if (smax >= &w[MAXSIZ -1]) overflo(); + + s->link = ++smax; + + s = smax; + + goto nenter; + + } + + s = s->link; + + } + + } + + s->out = 1; + + s = w; + + } else { + + loop: if (s->inp == c) { + + s = s->nst; + + continue; + + } + + if (s->inp == 0) goto enter; + + if (s->link == 0) { + + if (smax >= &w[MAXSIZ - 1]) overflo(); + + s->link = ++smax; + + s = smax; + + goto enter; + + } + + s = s->link; + + goto loop; + + } + + } + + + + enter: + + do { + + s->inp = c; + + if (smax >= &w[MAXSIZ - 1]) overflo(); + + s->nst = ++smax; + + s = smax; + + } while ((c = getargc()) != '\n' && c!=EOF); + + if (xflag) { + + nenter: s->inp = '\n'; + + if (smax >= &w[MAXSIZ -1]) overflo(); + + s->nst = ++smax; + + } + + smax->out = 1; + + s = w; + + if (c != EOF) + + goto nword; + +} + + + +overflo() { + + fprintf(stderr, "wordlist too large\n"); + + exit(2); + +} + +cfail() { + + struct words *queue[QSIZE]; + + struct words **front, **rear; + + struct words *state; +++ int bstart; + + register char c; + + register struct words *s; + + s = w; + + front = rear = queue; + +init: if ((s->inp) != 0) { + + *rear++ = s->nst; + + if (rear >= &queue[QSIZE - 1]) overflo(); + + } + + if ((s = s->link) != 0) { + + goto init; + + } + + + + while (rear!=front) { + + s = *front; + + if (front == &queue[QSIZE-1]) + + front = queue; + + else front++; + + cloop: if ((c = s->inp) != 0) { +++ bstart = 0; + + *rear = (q = s->nst); + + if (front < rear) + + if (rear >= &queue[QSIZE-1]) + + if (front == queue) overflo(); + + else rear = queue; + + else rear++; + + else + + if (++rear == front) overflo(); + + state = s->fail; - floop: if (state == 0) state = w; +++ floop: if (state == 0) { +++ state = w; +++ bstart = 1; +++ } + + if (state->inp == c) { - q->fail = state->nst; +++ qloop: q->fail = state->nst; + + if ((state->nst)->out == 1) q->out = 1; - continue; +++ if ((q = q->link) != 0) goto qloop; + + } + + else if ((state = state->link) != 0) + + goto floop; +++ else if(bstart == 0){ +++ state = 0; +++ goto floop; +++ } + + } + + if ((s = s->link) != 0) + + goto cloop; + + } + +} diff --cc usr/src/cmd/file.c index 0000000000,c820744b75,0000000000..5a39208dab mode 000000,100644,000000..100644 --- a/usr/src/cmd/file.c +++ b/usr/src/cmd/file.c @@@@ -1,0 -1,327 -1,0 +1,392 @@@@ +++static char sccsid[] = "@(#)file.c 4.1 10/1/80"; + +/* - * determine type of file +++ * file - determine type of file + + */ + + - #include - #include +++#include +++#include +++#include + +#include + +#include +++#include + +int in; + +int i = 0; - char buf[512]; +++char buf[BUFSIZ]; +++char *troff[] = { /* new troff intermediate lang */ +++ "x","T","res","init","font","202","V0","p1",0}; + +char *fort[] = { + + "function","subroutine","common","dimension","block","integer", + + "real","data","double",0}; + +char *asc[] = { + + "chmk","mov","tst","clr","jmp",0}; + +char *c[] = { + + "int","char","float","double","struct","extern",0}; + +char *as[] = { + + "globl","byte","align","text","data","comm",0}; + +int ifile; + + + +main(argc, argv) + +char **argv; + +{ + + FILE *fl; + + register char *p; + + char ap[128]; +++ extern char _sobuf[]; + + + + if (argc>1 && argv[1][0]=='-' && argv[1][1]=='f') { + + if ((fl = fopen(argv[2], "r")) == NULL) { + + printf("Can't open %s\n", argv[2]); + + exit(2); + + } + + while ((p = fgets(ap, 128, fl)) != NULL) { + + int l = strlen(p); + + if (l>0) + + p[l-1] = '\0'; + + printf("%s: ", p); + + type(p); + + if (ifile>=0) + + close(ifile); + + } + + exit(1); + + } + + while(argc > 1) { + + printf("%s: ", argv[1]); + + type(argv[1]); +++ fflush(stdout); + + argc--; + + argv++; + + if (ifile >= 0) + + close(ifile); + + } + +} + + + +type(file) + +char *file; + +{ + + int j,nl; + + char ch; + + struct stat mbuf; + + + + ifile = -1; + + if(stat(file, &mbuf) < 0) { + + printf("cannot stat\n"); + + return; + + } + + switch (mbuf.st_mode & S_IFMT) { + + + + case S_IFCHR: + + printf("character"); + + goto spcl; + + + + case S_IFDIR: + + printf("directory\n"); + + return; + + +++ case S_IFMPC: +++ printf("char multiplexor\n"); +++ return; +++ +++ case S_IFMPB: +++ printf("block multiplexor\n"); +++ return; +++ + + case S_IFBLK: + + printf("block"); + + + +spcl: + + printf(" special (%d/%d)\n", major(mbuf.st_rdev), minor(mbuf.st_rdev)); + + return; + + } + + + + ifile = open(file, 0); + + if(ifile < 0) { + + printf("cannot open\n"); + + return; + + } - in = read(ifile, buf, 512); +++ in = read(ifile, buf, BUFSIZ); + + if(in == 0){ + + printf("empty\n"); + + return; + + } + + switch(*(int *)buf) { + + + + case 0413: + + printf("demand paged "); +++ + + case 0410: + + printf("pure "); + + goto exec; + + - case 0412: - printf("demand paged "); - goto exec; - + + case 0411: - printf("separate "); +++ printf("jfr or pdp-11 unix 411 executable\n"); +++ return; + + + + case 0407: + +exec: + + printf("executable"); - if(((int *)buf)[4] != 0) +++ if(((int *)buf)[4] != 0) { + + printf(" not stripped"); +++ if(oldo(buf)) +++ printf(" (old format symbol table)"); +++ } + + printf("\n"); + + goto out; + + + + case 0177555: - printf("old archive\n"); +++ printf("very old archive\n"); + + goto out; + + + + case 0177545: - printf("archive\n"); +++ printf("old archive\n"); +++ goto out; +++ +++ case 070707: +++ printf("cpio data\n"); + + goto out; + + } + + +++ if(strncmp(buf, "!\n__.SYMDEF", 17) == 0 ) { +++ printf("archive random library\n"); +++ goto out; +++ } +++ if (strncmp(buf, "!\n", 8)==0) { +++ printf("archive\n"); +++ goto out; +++ } + + i = 0; + + if(ccom() == 0)goto notc; + + while(buf[i] == '#'){ + + j = i; + + while(buf[i++] != '\n'){ + + if(i - j > 255){ + + printf("data\n"); + + goto out; + + } + + if(i >= in)goto notc; + + } + + if(ccom() == 0)goto notc; + + } + +check: + + if(lookup(c) == 1){ + + while((ch = buf[i++]) != ';' && ch != '{')if(i >= in)goto notc; + + printf("c program text"); + + goto outa; + + } + + nl = 0; + + while(buf[i] != '('){ + + if(buf[i] <= 0) + + goto notas; + + if(buf[i] == ';'){ + + i++; + + goto check; + + } + + if(buf[i++] == '\n') + + if(nl++ > 6)goto notc; + + if(i >= in)goto notc; + + } + + while(buf[i] != ')'){ + + if(buf[i++] == '\n') + + if(nl++ > 6)goto notc; + + if(i >= in)goto notc; + + } + + while(buf[i] != '{'){ + + if(buf[i++] == '\n') + + if(nl++ > 6)goto notc; + + if(i >= in)goto notc; + + } + + printf("c program text"); + + goto outa; + +notc: + + i = 0; + + while(buf[i] == 'c' || buf[i] == '#'){ + + while(buf[i++] != '\n')if(i >= in)goto notfort; + + } + + if(lookup(fort) == 1){ + + printf("fortran program text"); + + goto outa; + + } + +notfort: + + i=0; + + if(ascom() == 0)goto notas; + + j = i-1; + + if(buf[i] == '.'){ + + i++; + + if(lookup(as) == 1){ + + printf("assembler program text"); + + goto outa; + + } + + else if(buf[j] == '\n' && isalpha(buf[j+2])){ + + printf("roff, nroff, or eqn input text"); + + goto outa; + + } + + } + + while(lookup(asc) == 0){ + + if(ascom() == 0)goto notas; + + while(buf[i] != '\n' && buf[i++] != ':') + + if(i >= in)goto notas; + + while(buf[i] == '\n' || buf[i] == ' ' || buf[i] == '\t')if(i++ >= in)goto notas; + + j = i-1; + + if(buf[i] == '.'){ + + i++; + + if(lookup(as) == 1){ + + printf("assembler program text"); + + goto outa; + + } + + else if(buf[j] == '\n' && isalpha(buf[j+2])){ + + printf("roff, nroff, or eqn input text"); + + goto outa; + + } + + } + + } + + printf("assembler program text"); + + goto outa; + +notas: + + for(i=0; i < in; i++)if(buf[i]&0200){ + + if (buf[0]=='\100' && buf[1]=='\357') { - printf("troff output\n"); +++ printf("troff (CAT) output\n"); + + goto out; + + } + + printf("data\n"); + + goto out; + + } + + if (mbuf.st_mode&((S_IEXEC)|(S_IEXEC>>3)|(S_IEXEC>>6))) + + printf("commands text"); - else - if (english(buf, in)) +++ else if (troffint(buf, in)) +++ printf("troff intermediate output text"); +++ else if (english(buf, in)) + + printf("English text"); + + else - printf("ascii text"); +++ printf("ascii text"); + +outa: + + while(i < in) + + if((buf[i++]&0377) > 127){ + + printf(" with garbage\n"); + + goto out; + + } + + /* if next few lines in then read whole file looking for nulls ... - while((in = read(ifile,buf,512)) > 0) +++ while((in = read(ifile,buf,BUFSIZ)) > 0) + + for(i = 0; i < in; i++) + + if((buf[i]&0377) > 127){ + + printf(" with garbage\n"); + + goto out; + + } + + /*.... */ + + printf("\n"); + +out:; + +} +++ +++oldo(cp) +++char *cp; +++{ +++ struct exec ex; +++ struct stat stb; +++ +++ ex = *(struct exec *)cp; +++ if (fstat(ifile, &stb) < 0) +++ return(0); +++ if (N_STROFF(ex)+sizeof(off_t) > stb.st_size) +++ return (1); +++ return (0); +++} +++ +++ +++ +++troffint(bp, n) +++char *bp; +++int n; +++{ +++ int k; +++ +++ i = 0; +++ for (k = 0; k < 6; k++) { +++ if (lookup(troff) == 0) +++ return(0); +++ if (lookup(troff) == 0) +++ return(0); +++ while (i < n && buf[i] != '\n') +++ i++; +++ if (i++ >= n) +++ return(0); +++ } +++ return(1); +++} + +lookup(tab) + +char *tab[]; + +{ + + char r; + + int k,j,l; + + while(buf[i] == ' ' || buf[i] == '\t' || buf[i] == '\n')i++; + + for(j=0; tab[j] != 0; j++){ + + l=0; + + for(k=i; ((r=tab[j][l++]) == buf[k] && r != '\0');k++); + + if(r == '\0') + + if(buf[k] == ' ' || buf[k] == '\n' || buf[k] == '\t' + + || buf[k] == '{' || buf[k] == '/'){ + + i=k; + + return(1); + + } + + } + + return(0); + +} + +ccom(){ + + char cc; + + while((cc = buf[i]) == ' ' || cc == '\t' || cc == '\n')if(i++ >= in)return(0); + + if(buf[i] == '/' && buf[i+1] == '*'){ + + i += 2; + + while(buf[i] != '*' || buf[i+1] != '/'){ + + if(buf[i] == '\\')i += 2; + + else i++; + + if(i >= in)return(0); + + } + + if((i += 2) >= in)return(0); + + } + + if(buf[i] == '\n')if(ccom() == 0)return(0); + + return(1); + +} + +ascom(){ + + while(buf[i] == '/'){ + + i++; + + while(buf[i++] != '\n')if(i >= in)return(0); + + while(buf[i] == '\n')if(i++ >= in)return(0); + + } + + return(1); + +} + + + +english (bp, n) + +char *bp; + +{ + +# define NASC 128 + + int ct[NASC], j, vow, freq, rare; + + int badpun = 0, punct = 0; + + if (n<50) return(0); /* no point in statistics on squibs */ + + for(j=0; j punct) + + return(0); + + vow = ct['a'] + ct['e'] + ct['i'] + ct['o'] + ct['u']; + + freq = ct['e'] + ct['t'] + ct['a'] + ct['i'] + ct['o'] + ct['n']; + + rare = ct['v'] + ct['j'] + ct['k'] + ct['q'] + ct['x'] + ct['z']; + + if (2*ct[';'] > ct['e']) return(0); + + if ( (ct['>']+ct['<']+ct['/'])>ct['e']) return(0); /* shell file test */ + + return (vow*5 >= n-ct[' '] && freq >= 10*rare); + +} diff --cc usr/src/cmd/find.c index 0000000000,39adaa60bf,0000000000..ca673a62e0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/find.c +++ b/usr/src/cmd/find.c @@@@ -1,0 -1,708 -1,0 +1,709 @@@@ +++static char *sccsid = "@(#)find.c 4.1 (Berkeley) 10/1/80"; + +/* find COMPILE: cc -o find -s -O -i find.c -lS */ + +#include + +#include + +#include + +#include + +#define A_DAY 86400L /* a day full of seconds */ + +#define EQ(x, y) (strcmp(x, y)==0) + + + +int Randlast; + +char Pathname[200]; + + + +struct anode { + + int (*F)(); + + struct anode *L, *R; + +} Node[100]; + +int Nn; /* number of nodes */ + +char *Fname; + +long Now; + +int Argc, + + Ai, + + Pi; + +char **Argv; + +/* cpio stuff */ + +int Cpio; + +short *Buf, *Dbuf, *Wp; + +int Bufsize = 5120; + +int Wct = 2560; + + + +long Newer; + + + +struct stat Statb; + + + +struct anode *exp(), + + *e1(), + + *e2(), + + *e3(), + + *mk(); + +char *nxtarg(); + +char Home[128]; + +long Blocks; + +char *rindex(); + +char *sbrk(); + +main(argc, argv) char *argv[]; + +{ + + struct anode *exlist; + + int paths; + + register char *cp, *sp = 0; + + FILE *pwd, *popen(); + + + + time(&Now); + + pwd = popen("pwd", "r"); + + fgets(Home, 128, pwd); + + pclose(pwd); + + Home[strlen(Home) - 1] = '\0'; + + Argc = argc; Argv = argv; + + if(argc<3) { + +usage: fprintf(stderr, "Usage: find path-list predicate-list\n"); + + exit(1); + + } + + for(Ai = paths = 1; Ai < (argc-1); ++Ai, ++paths) + + if(*Argv[Ai] == '-' || EQ(Argv[Ai], "(") || EQ(Argv[Ai], "!")) + + break; + + if(paths == 1) /* no path-list */ + + goto usage; + + if(!(exlist = exp())) { /* parse and compile the arguments */ + + fprintf(stderr, "find: parsing error\n"); + + exit(1); + + } + + if(Ai\n", s); + + exit(1); + + } + + Buf = (short *)sbrk(512); + + Wp = Dbuf = (short *)sbrk(5120); + + return(mk(cpio, (struct anode *)0, (struct anode *)0)); + + } + + else if(EQ(a, "-newer")) { + + if(stat(b, &Statb) < 0) { + + fprintf(stderr, "find: cannot access < %s >\n", b); + + exit(1); + + } + + Newer = Statb.st_mtime; + + return mk(newer, (struct anode *)0, (struct anode *)0); + + } + +err: fprintf(stderr, "find: bad option < %s >\n", a); + + exit(1); + +} + +struct anode *mk(f, l, r) + +int (*f)(); + +struct anode *l, *r; + +{ + + Node[Nn].F = f; + + Node[Nn].L = l; + + Node[Nn].R = r; + + return(&(Node[Nn++])); + +} + + + +char *nxtarg() { /* get next arg from command line */ + + static strikes = 0; + + + + if(strikes==3) { + + fprintf(stderr, "find: incomplete statement\n"); + + exit(1); + + } + + if(Ai>=Argc) { + + strikes++; + + Ai = Argc + 1; + + return(""); + + } + + return(Argv[Ai++]); + +} + + + +/* execution time functions */ + +and(p) + +register struct anode *p; + +{ + + return(((*p->L->F)(p->L)) && ((*p->R->F)(p->R))?1:0); + +} + +or(p) + +register struct anode *p; + +{ + + return(((*p->L->F)(p->L)) || ((*p->R->F)(p->R))?1:0); + +} + +not(p) + +register struct anode *p; + +{ + + return( !((*p->L->F)(p->L))); + +} + +glob(p) + +register struct { int f; char *pat; } *p; + +{ + + return(gmatch(Fname, p->pat)); + +} + +print() + +{ + + puts(Pathname); + + return(1); + +} + +mtime(p) + +register struct { int f, t, s; } *p; + +{ + + return(scomp((int)((Now - Statb.st_mtime) / A_DAY), p->t, p->s)); + +} + +atime(p) + +register struct { int f, t, s; } *p; + +{ + + return(scomp((int)((Now - Statb.st_atime) / A_DAY), p->t, p->s)); + +} + +user(p) + +register struct { int f, u, s; } *p; + +{ + + return(scomp(Statb.st_uid, p->u, p->s)); + +} + +ino(p) + +register struct { int f, u, s; } *p; + +{ + + return(scomp((int)Statb.st_ino, p->u, p->s)); + +} + +group(p) + +register struct { int f, u; } *p; + +{ + + return(p->u == Statb.st_gid); + +} + +links(p) + +register struct { int f, link, s; } *p; + +{ + + return(scomp(Statb.st_nlink, p->link, p->s)); + +} + +size(p) + +register struct { int f, sz, s; } *p; + +{ + + return(scomp((int)((Statb.st_size+511)>>9), p->sz, p->s)); + +} + +perm(p) + +register struct { int f, per, s; } *p; + +{ + + register i; + + i = (p->s=='-') ? p->per : 07777; /* '-' means only arg bits */ + + return((Statb.st_mode & i & 07777) == p->per); + +} + +type(p) + +register struct { int f, per, s; } *p; + +{ + + return((Statb.st_mode&S_IFMT)==p->per); + +} + +exeq(p) + +register struct { int f, com; } *p; + +{ + + fflush(stdout); /* to flush possible `-print' */ + + return(doex(p->com)); + +} + +ok(p) + +struct { int f, com; } *p; + +{ + + char c; int yes; + + yes = 0; + + fflush(stdout); /* to flush possible `-print' */ + + fprintf(stderr, "< %s ... %s > ? ", Argv[p->com], Pathname); + + fflush(stderr); + + if((c=getchar())=='y') yes = 1; + + while(c!='\n') c = getchar(); + + if(yes) return(doex(p->com)); + + return(0); + +} + + + +#define MKSHORT(v, lv) {U.l=1L;if(U.c[0]) U.l=lv, v[0]=U.s[1], v[1]=U.s[0]; else U.l=lv, v[0]=U.s[0], v[1]=U.s[1];} + +union { long l; short s[2]; char c[4]; } U; + +long mklong(v) + +short v[]; + +{ + + U.l = 1; + + if(U.c[0] /* VAX */) + + U.s[0] = v[1], U.s[1] = v[0]; + + else + + U.s[0] = v[0], U.s[1] = v[1]; + + return U.l; + +} + +cpio() + +{ + +#define MAGIC 070707 + + struct header { + + short h_magic, + + h_dev, + + h_ino, + + h_mode, + + h_uid, + + h_gid, + + h_nlink, + + h_rdev; + + short h_mtime[2]; + + short h_namesize; + + short h_filesize[2]; + + char h_name[256]; + + } hdr; + + register ifile, ct; + + static long fsz; + + register i; + + + + hdr.h_magic = MAGIC; + + strcpy(hdr.h_name, !strncmp(Pathname, "./", 2)? Pathname+2: Pathname); + + hdr.h_namesize = strlen(hdr.h_name) + 1; + + hdr.h_uid = Statb.st_uid; + + hdr.h_gid = Statb.st_gid; + + hdr.h_dev = Statb.st_dev; + + hdr.h_ino = Statb.st_ino; + + hdr.h_mode = Statb.st_mode; + + MKSHORT(hdr.h_mtime, Statb.st_mtime); + + hdr.h_nlink = Statb.st_nlink; + + fsz = hdr.h_mode & S_IFREG? Statb.st_size: 0L; + + MKSHORT(hdr.h_filesize, fsz); + + hdr.h_rdev = Statb.st_rdev; + + if(EQ(hdr.h_name, "TRAILER!!!")) { + + bwrite((short *)&hdr, (sizeof hdr-256)+hdr.h_namesize); + + for(i = 0; i < 10; ++i) + + bwrite(Buf, 512); + + return; + + } + + if(!mklong(hdr.h_filesize)) + + return; + + if((ifile = open(Fname, 0)) < 0) { + +cerror: + + fprintf(stderr, "find: cannot copy < %s >\n", hdr.h_name); + + return; + + } + + bwrite((short *)&hdr, (sizeof hdr-256)+hdr.h_namesize); + + for(fsz = mklong(hdr.h_filesize); fsz > 0; fsz -= 512) { + + ct = fsz>512? 512: fsz; + + if(read(ifile, (char *)Buf, ct) < 0) + + goto cerror; + + bwrite(Buf, ct); + + } + + close(ifile); + + return; + +} + +newer() + +{ + + return Statb.st_mtime > Newer; + +} + + + +/* support functions */ + +scomp(a, b, s) /* funny signed compare */ + +register a, b; + +register char s; + +{ + + if(s == '+') + + return(a > b); + + if(s == '-') + + return(a < (b * -1)); + + return(a == b); + +} + + + +doex(com) + +{ + + register np; + + register char *na; + + static char *nargv[50]; + + static ccode; + + + + ccode = np = 0; + + while (na=Argv[com++]) { + + if(strcmp(na, ";")==0) break; + + if(strcmp(na, "{}")==0) nargv[np++] = Pathname; + + else nargv[np++] = na; + + } + + nargv[np] = 0; + + if (np==0) return(9); + + if(fork()) /*parent*/ wait(&ccode); + + else { /*child*/ + + chdir(Home); + + execvp(nargv[0], nargv, np); + + exit(1); + + } + + return(ccode ? 0:1); + +} + + + +getunum(f, s) char *f, *s; { /* find user/group name and return number */ + + register i; + + register char *sp; + + register c; + + char str[20]; + + FILE *pin; + + + + i = -1; + + pin = fopen(f, "r"); + + c = '\n'; /* prime with a CR */ + + do { + + if(c=='\n') { + + sp = str; + + while((c = *sp++ = getc(pin)) != ':') + + if(c == EOF) goto RET; + + *--sp = '\0'; + + if(EQ(str, s)) { + + while((c=getc(pin)) != ':') + + if(c == EOF) goto RET; + + sp = str; + + while((*sp = getc(pin)) != ':') sp++; + + *sp = '\0'; + + i = atoi(str); + + goto RET; + + } + + } + + } while((c = getc(pin)) != EOF); + + RET: + + fclose(pin); + + return(i); + +} + + + +descend(name, fname, exlist) + +struct anode *exlist; + +char *name, *fname; + +{ + + int dir = 0, /* open directory */ + + offset, + + dsize, + + entries, + + dirsize; + + struct direct dentry[BUFSIZ / sizeof (struct direct)]; + + register struct direct *dp; + + register char *c1, *c2; + + int i; + + int rv = 0; + + char *endofname; + + + + if(stat(fname, &Statb)<0) { + + fprintf(stderr, "find: bad status < %s >\n", name); + + return(0); + + } + + (*exlist->F)(exlist); + + if((Statb.st_mode&S_IFMT)!=S_IFDIR) + + return(1); + + + + for(c1 = name; *c1; ++c1); + + if(*(c1-1) == '/') + + --c1; + + endofname = c1; + + dirsize = Statb.st_size; + + + + if(chdir(fname) == -1) + + return(0); + + for(offset=0 ; offset < dirsize ; offset += BUFSIZ) { /* each block */ + + dsize = BUFSIZ<(dirsize-offset)? BUFSIZ: (dirsize-offset); + + if(!dir) { + + if((dir=open(".", 0))<0) { + + fprintf(stderr, "find: cannot open < %s >\n", + + name); + + rv = 0; + + goto ret; + + } + + if(offset) lseek(dir, (long)offset, 0); + + if(read(dir, (char *)dentry, dsize)<0) { + + fprintf(stderr, "find: cannot read < %s >\n", + + name); + + rv = 0; + + goto ret; + + } + + if(dir > 10) { + + close(dir); + + dir = 0; + + } + + } else + + if(read(dir, (char *)dentry, dsize)<0) { + + fprintf(stderr, "find: cannot read < %s >\n", + + name); + + rv = 0; + + goto ret; + + } + + for(dp=dentry, entries=dsize>>4; entries; --entries, ++dp) { /* each directory entry */ + + if(dp->d_ino==0 + + || (dp->d_name[0]=='.' && dp->d_name[1]=='\0') + + || (dp->d_name[0]=='.' && dp->d_name[1]=='.' && dp->d_name[2]=='\0')) + + continue; + + c1 = endofname; + + *c1++ = '/'; + + c2 = dp->d_name; + + for(i=0; i<14; ++i) + + if(*c2) + + *c1++ = *c2++; + + else + + break; + + *c1 = '\0'; + + if(c1 == endofname) { /* ?? */ + + rv = 0; + + goto ret; + + } + + Fname = endofname+1; + + if(!descend(name, Fname, exlist)) { + + *endofname = '\0'; + + chdir(Home); + + if(chdir(Pathname) == -1) { + + fprintf(stderr, "find: bad directory tree\n"); + + exit(1); + + } + + } + + } + + } + + rv = 1; + +ret: + + if(dir) + + close(dir); + + if(chdir("..") == -1) { + + *endofname = '\0'; + + fprintf(stderr, "find: bad directory <%s>\n", name); + + rv = 1; + + } + + return(rv); + +} + + + +gmatch(s, p) /* string match as in glob */ + +register char *s, *p; + +{ + + if (*s=='.' && *p!='.') return(0); + + return amatch(s, p); + +} + + + +amatch(s, p) + +register char *s, *p; + +{ + + register cc; + + int scc, k; + + int c, lc; + + + + scc = *s; + + lc = 077777; + + switch (c = *p) { + + + + case '[': + + k = 0; + + while (cc = *++p) { + + switch (cc) { + + + + case ']': + + if (k) + + return(amatch(++s, ++p)); + + else + + return(0); + + + + case '-': + + k |= lc <= scc & scc <= (cc=p[1]); + + } + + if (scc==(lc=cc)) k++; + + } + + return(0); + + + + case '?': + + caseq: + + if(scc) return(amatch(++s, ++p)); + + return(0); + + case '*': + + return(umatch(s, ++p)); + + case 0: + + return(!scc); + + } + + if (c==scc) goto caseq; + + return(0); + +} + + + +umatch(s, p) + +register char *s, *p; + +{ + + if(*p==0) return(1); + + while(*s) + + if (amatch(s++, p)) return(1); + + return(0); + +} + + + +bwrite(rp, c) + +register short *rp; + +register c; + +{ + + register short *wp = Wp; + + + + c = (c+1) >> 1; + + while(c--) { + + if(!Wct) { + +again: + + if(write(Cpio, (char *)Dbuf, Bufsize)<0) { + + Cpio = chgreel(1, Cpio); + + goto again; + + } + + Wct = Bufsize >> 1; + + wp = Dbuf; + + ++Blocks; + + } + + *wp++ = *rp++; + + --Wct; + + } + + Wp = wp; + +} + +chgreel(x, fl) + +{ + + register f; + + char str[22]; + + FILE *devtty; + + struct stat statb; + + extern errno; + + + + fprintf(stderr, "find: errno: %d, ", errno); + + fprintf(stderr, "find: can't %s\n", x? "write output": "read input"); + + fstat(fl, &statb); + + if((statb.st_mode&S_IFMT) != S_IFCHR) + + exit(1); + +again: + + fprintf(stderr, "If you want to go on, type device/file name %s\n", + + "when ready"); + + devtty = fopen("/dev/tty", "r"); + + fgets(str, 20, devtty); + + str[strlen(str) - 1] = '\0'; + + if(!*str) + + exit(1); + + close(fl); + + if((f = open(str, x? 1: 0)) < 0) { + + fprintf(stderr, "That didn't work"); + + fclose(devtty); + + goto again; + + } + + return f; + +} diff --cc usr/src/cmd/finger.c index 0000000000,5b44f0716a,0000000000..255102149e mode 000000,100644,000000..100644 --- a/usr/src/cmd/finger.c +++ b/usr/src/cmd/finger.c @@@@ -1,0 -1,1355 -1,0 +1,1367 @@@@ +++static char *sccsid = "@(#)finger.c 4.1 (Berkeley) 10/1/80"; + + + +/* This is a finger program. It prints out useful information about users + + * by digging it up from various system files. It is not very portable + + * because the most useful parts of the information (the full user name, + + * office, and phone numbers) are all stored in the VAX-unused gecos field + + * of /etc/passwd, which, unfortunately, other UNIXes use for other things. + + * + + * There are three output formats, all of which give login name, teletype + + * line number, and login time. The short output format is reminiscent + + * of finger on ITS, and gives one line of information per user containing + + * in addition to the minimum basic requirements (MBR), the full name of + + * the user, his idle time and office location and phone number. The + + * quick style output is UNIX who-like, giving only name, teletype and + + * login time. Finally, the long style output give the same information + + * as the short (in more legible format), the home directory and shell + + * of the user, and, if it exits, a copy of the file .plan in the users + + * home directory. Finger may be called with or without a list of people + + * to finger -- if no list is given, all the people currently logged in + + * are fingered. + + * + + * The program is validly called by one of the following: + + * + + * finger {short form list of users} + + * finger -l {long form list of users} + + * finger -b {briefer long form list of users} + + * finger -q {quick list of users} + + * finger -i {quick list of users with idle times} + + * finger namelist {long format list of specified users} + + * finger -s namelist {short format list of specified users} + + * finger -w namelist {narrow short format list of specified users} + + * + + * where 'namelist' is a list of users login names. + + * The other options can all be given after one '-', or each can have its + + * own '-'. The -f option disables the printing of headers for short and + + * quick outputs. The -b option briefens long format outputs. The -p + + * option turns off plans for long format outputs. + + */ + + + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + + +++struct utmp utmp; /* for sizeof */ +++#define NMAX sizeof(utmp.ut_name) +++#define LMAX sizeof(utmp.ut_line) +++ + +#define ASTERISK '*' /* ignore this in real name */ + +#define BLANK ' ' /* blank character (i.e. space) */ + +#define CAPITALIZE 0137& /* capitalize character macro */ + +#define COMMA ',' /* separator in pw_gecos field */ + +#define COMMAND '-' /* command line flag char */ + +#define CORY 'C' /* cory hall office */ + +#define EVANS 'E' /* evans hall office */ + +#define LINEBREAK 012 /* line feed */ + +#define NULLSTR "" /* the null string, opposed to NULL */ + +#define SAMENAME '&' /* repeat login name in real name */ + +#define TALKABLE 0222 /* tty is writeable if 222 mode */ + + + +struct person { /* one for each person fingered */ - char name[ 9 ]; /* login name */ - char tty[ 9 ]; /* NULL terminated tty line */ +++ char name[NMAX+1]; /* login name */ +++ char tty[LMAX+1]; /* NULL terminated tty line */ + + long loginat; /* time of login (possibly last) */ + + long idletime; /* how long idle (if logged in) */ + + short int loggedin; /* flag for being logged in */ + + short int writeable; /* flag for tty being writeable */ + + char *realname; /* pointer to full name */ + + char *office; /* pointer to office name */ + + char *officephone; /* pointer to office phone no. */ + + char *homephone; /* pointer to home phone no. */ + + char *random; /* for any random stuff in pw_gecos */ + + struct passwd *pwd; /* structure of /etc/passwd stuff */ + + struct person *link; /* link to next person */ + +}; + + + +struct passwd *NILPWD = 0; + +struct person *NILPERS = 0; + + + +int persize = sizeof( struct person ); + +int pwdsize = sizeof( struct passwd ); + + + +char LASTLOG[] = "/usr/adm/lastlog"; /* last login info */ + +char USERLOG[] = "/etc/utmp"; /* who is logged in */ + +char outbuf[BUFSIZ]; /* output buffer */ + +char *ctime(); + + + +int unbrief = 1; /* -b option default */ + +int header = 1; /* -f option default */ + +int hack = 1; /* -h option default */ + +int idle = 0; /* -i option default */ + +int large = 0; /* -l option default */ + +int match = 1; /* -m option default */ + +int plan = 1; /* -p option default */ + +int unquick = 1; /* -q option default */ + +int small = 0; /* -s option default */ + +int wide = 1; /* -w option default */ + + + +int lf; + +int llopenerr; + + + +long tloc; /* current time */ + + + + + + + +main( argc, argv ) + + + + int argc; + + char *argv[]; + + + +{ + + FILE *fp, *fopen(); /* for plans */ + + struct passwd *getpwent(); /* read /etc/passwd */ + + struct person *person1, *p, *pend; /* people */ + + struct passwd *pw; /* temporary */ + + struct utmp user; /* ditto */ + + char *malloc(); + + char *s, *pn, *ln; + + char c; + + char *PLAN = "/.plan"; /* what plan file is */ + + char *PROJ = "/.project"; /* what project file */ + + int PLANLEN = strlen( PLAN ); + + int PROJLEN = strlen( PROJ ); + + int numnames = 0; + + int orgnumnames; + + int uf; + + int usize = sizeof user; + + int unshort; + + int i, j; + + int fngrlogin; + + + + setbuf( stdout, outbuf ); /* buffer output */ + + + + /* parse command line for (optional) arguments */ + + + + i = 1; + + if( strcmp( *argv, "sh" ) ) { + + fngrlogin = 0; + + while( i++ < argc && (*++argv)[0] == COMMAND ) { + + for( s = argv[0] + 1; *s != NULL; s++ ) { + + switch (*s) { + + + + case 'b': + + unbrief = 0; + + break; + + + + case 'f': + + header = 0; + + break; + + + + case 'h': + + hack = 0; + + break; + + + + case 'i': + + idle = 1; + + unquick = 0; + + break; + + + + case 'l': + + large = 1; + + break; + + + + case 'm': + + match = 0; + + break; + + + + case 'p': + + plan = 0; + + break; + + + + case 'q': + + unquick = 0; + + break; + + + + case 's': + + small = 1; + + break; + + + + case 'w': + + wide = 0; + + break; + + + + default: + + fprintf( stderr, "finger: Usage -- 'finger [-bfhilmpqsw] [login1 [login2 ...] ]'\n" ); + + exit( 1 ); + + } + + } + + } + + } + + else { + + fngrlogin = 1; + + } + + if( unquick ) { + + time( &tloc ); + + } + + else { + + if( idle ) { + + time( &tloc ); + + } + + } + + + + /* i > argc means no login names given so get them by reading USERLOG */ + + + + if( (i > argc) || fngrlogin ) { + + unshort = large; + + if( ( uf = open(USERLOG, 0) ) >= 0 ) { + + user.ut_name[0] = NULL; + + while( user.ut_name[0] == NULL ) { + + if( read( uf, (char *) &user, usize ) != usize ) { + + printf( "\nNo one logged on\n" ); + + exit( 0 ); + + } + + } + + person1 = (struct person *) malloc( persize ); - for( j = 0; j < 8; j++ ) { +++ for( j = 0; j < NMAX; j++ ) { + + person1->tty[j] = user.ut_line[j]; + + person1->name[j] = user.ut_name[j]; + + } - person1->name[8] = NULL; - person1->tty[8] = NULL; +++ person1->name[NMAX] = NULL; +++ person1->tty[NMAX] = NULL; + + person1->loginat = user.ut_time; + + person1->pwd = NILPWD; + + person1->loggedin = 1; + + numnames++; + + p = person1; + + while( read( uf, (char *) &user, usize ) == usize ) { + + if( user.ut_name[0] == NULL ) continue; + + p->link = (struct person *) malloc( persize ); + + p = p->link; - for( j = 0; j < 8; j++ ) { +++ for( j = 0; j < NMAX; j++ ) { + + p->tty[j] = user.ut_line[j]; + + p->name[j] = user.ut_name[j]; + + } - p->name[8] = NULL; - p->tty[8] = NULL; +++ p->name[NMAX] = NULL; +++ p->tty[NMAX] = NULL; + + p->loginat = user.ut_time; + + p->pwd = NILPWD; + + p->loggedin = 1; + + numnames++; + + } + + p->link = NILPERS; + + close( uf ); + + } + + else { + + fprintf( stderr, "finger: error opening %s\n", USERLOG ); + + exit( 2 ); + + } + + + + /* if we are doing it, read /etc/passwd for the useful info */ + + + + if( unquick ) { + + setpwent(); + + fwopen(); + + i = numnames; + + while( ( (pw = getpwent()) != NILPWD ) && ( i > 0 ) ) { + + p = person1; + + do { + + if( p->pwd == NILPWD ) { + + if( strcmp( p->name, pw->pw_name ) == 0 ) { + + p->pwd = (struct passwd *) malloc( pwdsize ); + + pwdcopy( p->pwd, pw ); + + decode( p ); + + i--; + + } + + } + + p = p->link; + + } while( p != NILPERS ); + + } + + fwclose(); + + endpwent(); + + } + + } + + + + /* get names from command line and check to see if they're logged in */ + + + + else { + + unshort = ( small == 1 ? 0 : 1 ); + + i++; + + person1 = (struct person *) malloc( persize ); + + strcpy( person1->name, (argv++)[ 0 ] ); + + person1->loggedin = 0; + + person1->pwd = NILPWD; + + numnames++; + + p = person1; + + while( i++ <= argc ) { + + p->link = (struct person *) malloc( persize ); + + p = p->link; + + strcpy( p->name, (argv++)[ 0 ] ); + + p->loggedin = 0; + + p->pwd = NILPWD; + + numnames++; + + } + + p->link = NILPERS; + + pend = p; + + + + /* if we are doing it, read /etc/passwd for the useful info */ + + + + orgnumnames = numnames; + + if( unquick ) { + + setpwent(); + + while( ( pw = getpwent() ) != NILPWD ) { + + p = person1; + + i = 0; + + do { + + if( strcmp( p->name, pw->pw_name ) == 0 || + + matchcmp( pw->pw_gecos, pw->pw_name, p->name ) ) { + + if( p->pwd == NILPWD ) { + + p->pwd = (struct passwd *) malloc( pwdsize ); + + pwdcopy( p->pwd, pw ); + + } - else { +++ else { /* handle multiple logins -- append new +++ "duplicate" entry to end of list */ + + pend->link = (struct person *) malloc(persize); + + pend = pend->link; + + pend->link = NILPERS; + + strcpy( pend->name, p->name ); + + pend->pwd = (struct passwd *) malloc(pwdsize); + + pwdcopy( pend->pwd, pw ); + + numnames++; + + } + + } + + p = p->link; + + } while( ++i < orgnumnames ); + + } + + endpwent(); + + } + + + + /* Now get login information */ + + + + if( ( uf = open(USERLOG, 0) ) >= 0 ) { + + while( read( uf, (char *) &user, usize ) == usize ) { + + if( user.ut_name[0] == NULL ) continue; + + p = person1; + + do { + + pw = p->pwd; + + if( pw == NILPWD ) { - p = p->link; - continue; +++ i = ( strcmp( p->name, user.ut_name ) ? 0 : NMAX ); + + } - i = 0; - while((i < 8) && (pw->pw_name[i] == user.ut_name[i])) { - if( pw->pw_name[i] == NULL ) { - i = 8; - break; +++ else { +++ i = 0; +++ while( (i < NMAX) && +++ ( pw->pw_name[i] == user.ut_name[i]) ) { +++ if( pw->pw_name[i] == NULL ) { +++ i = NMAX; +++ break; +++ } +++ i++; + + } - i++; + + } - if( i == 8 ) { +++ if( i == NMAX ) { + + if( p->loggedin == 1 ) { + + pend->link = (struct person *) malloc(persize); + + pend = pend->link; + + pend->link = NILPERS; + + strcpy( pend->name, p->name ); - for( j = 0; j < 8; j++ ) { +++ for( j = 0; j < NMAX; j++ ) { + + pend->tty[j] = user.ut_line[j]; + + } - pend->tty[ 8 ] = NULL; +++ pend->tty[ NMAX ] = NULL; + + pend->loginat = user.ut_time; + + pend->loggedin = 2; - pend->pwd = (struct passwd *) malloc(pwdsize); - pwdcopy( pend->pwd, pw ); +++ if( pw == NILPWD ) { +++ pend ->pwd = NILPWD; +++ } +++ else { +++ pend->pwd = (struct passwd *) malloc(pwdsize); +++ pwdcopy( pend->pwd, pw ); +++ } + + numnames++; + + } + + else { + + if( p->loggedin != 2 ) { - for( j = 0; j < 8; j++ ) { +++ for( j = 0; j < NMAX; j++ ) { + + p->tty[j] = user.ut_line[j]; + + } - p->tty[ 8 ] = NULL; +++ p->tty[ NMAX ] = NULL; + + p->loginat = user.ut_time; + + p->loggedin = 1; + + } + + } + + } + + p = p->link; + + } while( p != NILPERS ); + + } + + fwopen(); + + p = person1; + + while( p != NILPERS ) { + + if( p->loggedin == 2 ) { + + p->loggedin = 1; + + } + + decode( p ); + + p = p->link; + + } + + fwclose(); + + close( uf ); + + } + + else { + + fprintf( stderr, "finger: error opening %s\n", USERLOG ); + + exit( 2 ); + + } + + } + + + + /* print out what we got */ + + + + if( header ) { + + if( unquick ) { + + if( !unshort ) { + + if( wide ) { + + printf( + +"Login Name TTY Idle When Office\n" ); + + } + + else { + + printf( + +"Login TTY Idle When Office\n" ); + + } + + } + + } + + else { + + printf( "Login TTY When" ); + + if( idle ) { + + printf( " Idle" ); + + } + + printf( "\n" ); + + } + + } + + p = person1; + + do { + + if( unquick ) { + + if( unshort ) { + + personprint( p ); + + if( p->pwd != NILPWD ) { + + if( hack ) { + + s = malloc(strlen((p->pwd)->pw_dir) + PROJLEN + 1 ); + + strcpy( s, (p->pwd)->pw_dir ); + + strcat( s, PROJ ); + + if( ( fp = fopen( s, "r") ) != NULL ) { + + printf( "Project: " ); + + while( ( c = getc(fp) ) != EOF ) { + + if( c == LINEBREAK ) { + + break; + + } + + putc( c, stdout ); + + } + + fclose( fp ); + + printf( "\n" ); + + } + + } + + if( plan ) { + + s = malloc( strlen( (p->pwd)->pw_dir ) + PLANLEN + 1 ); + + strcpy( s, (p->pwd)->pw_dir ); + + strcat( s, PLAN ); + + if( ( fp = fopen( s, "r") ) == NULL ) { + + printf( "No Plan.\n" ); + + } + + else { + + printf( "Plan:\n" ); + + while( ( c = getc(fp) ) != EOF ) { + + putc( c, stdout ); + + } + + fclose( fp ); + + } + + } + + } + + if( p->link != NILPERS ) { + + printf( "\n" ); + + } + + } + + else { + + shortprint( p ); + + } + + } + + else { + + quickprint( p ); + + } + + p = p->link; + + } while( p != NILPERS ); - exit(1); +++ exit(0); + +} + + + + + +/* given a pointer to a pwd (pfrom) copy it to another one, allocating + + * space for all the stuff in it. Note: Only the useful (what the + + * program currently uses) things are copied. + + */ + + + +pwdcopy( pto, pfrom ) /* copy relevant fields only */ + + + + struct passwd *pto, *pfrom; + +{ + + pto->pw_name = malloc( strlen( pfrom->pw_name ) + 1 ); + + strcpy( pto->pw_name, pfrom->pw_name ); + + pto->pw_uid = pfrom->pw_uid; + + pto->pw_gecos = malloc( strlen( pfrom->pw_gecos ) + 1 ); + + strcpy( pto->pw_gecos, pfrom->pw_gecos ); + + pto->pw_dir = malloc( strlen( pfrom->pw_dir ) + 1 ); + + strcpy( pto->pw_dir, pfrom->pw_dir ); + + pto->pw_shell = malloc( strlen( pfrom->pw_shell ) + 1 ); + + strcpy( pto->pw_shell, pfrom->pw_shell ); + +} + + + + + +/* print out information on quick format giving just name, tty, login time + + * and idle time if idle is set. + + */ + + + +quickprint( pers ) + + + + struct person *pers; + +{ + + int idleprinted; + + - printf( "%-8.8s", pers->name ); +++ printf( "%-*.*s", NMAX, NMAX, pers->name ); + + printf( " " ); + + if( pers->loggedin ) { + + if( idle ) { + + findidle( pers ); + + if( pers->writeable ) { - printf( " %-8.8s %-16.16s", +++ printf( " %-*.*s %-16.16s", LMAX, LMAX, + + pers->tty, ctime( &pers->loginat ) ); + + } + + else { - printf( "*%-8.8s %-16.16s", +++ printf( "*%-*.*s %-16.16s", LMAX, LMAX, + + pers->tty, ctime( &pers->loginat ) ); + + } + + printf( " " ); + + idleprinted = ltimeprint( &pers->idletime ); + + } + + else { - printf( " %-8.8s %-16.16s", +++ printf( " %-*.*s %-16.16s", LMAX, LMAX, + + pers->tty, ctime( &pers->loginat ) ); + + } + + } + + else { + + printf( " Not Logged In" ); + + } + + printf( "\n" ); + +} + + + + + +/* print out information in short format, giving login name, full name, + + * tty, idle time, login time, office location and phone. + + */ + + + +shortprint( pers ) + + + + struct person *pers; + + + +{ + + struct passwd *pwdt = pers->pwd; + + char buf[ 26 ]; + + int i, len, offset, dialup; + + + + if( pwdt == NILPWD ) { - printf( "%-8.8s", pers->name ); +++ printf( "%-*.*s", NMAX, NMAX, pers->name ); + + printf( " ???\n" ); + + return; + + } - printf( "%-8.8s", pwdt->pw_name ); +++ printf( "%-*.*s", NMAX, NMAX, pwdt->pw_name ); + + dialup = 0; + + if( wide ) { + + if( strlen( pers->realname ) > 0 ) { + + printf( " %-20.20s", pers->realname ); + + } + + else { + + printf( " ??? " ); + + } + + } + + if( pers->loggedin ) { + + if( pers->writeable ) { + + printf( " " ); + + } + + else { + + printf( " *" ); + + } + + } + + else { + + printf( " " ); + + } + + if( strlen( pers->tty ) > 0 ) { + + strcpy( buf, pers->tty ); + + if( (buf[0] == 't') && (buf[1] == 't') && (buf[2] == 'y') ) { + + offset = 3; + + for( i = 0; i < 2; i++ ) { + + buf[i] = buf[i + offset]; + + } + + } + + if( (buf[0] == 'd') && pers->loggedin ) { + + dialup = 1; + + } + + printf( "%-2.2s ", buf ); + + } + + else { + + printf( " " ); + + } + + strcpy( buf, ctime( &pers->loginat ) ); + + if( pers->loggedin ) { + + stimeprint( &pers->idletime ); + + offset = 7; + + for( i = 4; i < 19; i++ ) { + + buf[i] = buf[i + offset]; + + } + + printf( " %-9.9s ", buf ); + + } + + else { + + printf( " " ); + + offset = 4; + + for( i = 0; i <22; i++ ) { + + buf[i] = buf[i + offset]; + + } + + printf( "<%-12.12s>", buf ); + + } + + len = strlen( pers->homephone ); + + if( dialup && (len > 0) ) { + + if( len == 8 ) { + + printf( " " ); + + } + + else { + + if( len == 12 ) { + + printf( " " ); + + } + + else { + + for( i = 1; i <= 21 - len; i++ ) { + + printf( " " ); + + } + + } + + } + + printf( "%s", pers->homephone ); + + } + + else { + + if( strlen( pers->office ) > 0 ) { + + printf( " %-11.11s", pers->office ); + + if( strlen( pers->officephone ) > 0 ) { + + printf( " %8.8s", pers->officephone ); + + } + + else { + + if( len == 8 ) { + + printf( " %8.8s", pers->homephone ); + + } + + } + + } + + else { + + if( strlen( pers->officephone ) > 0 ) { + + printf( " %8.8s", pers->officephone ); + + } + + else { + + if( len == 8 ) { + + printf( " %8.8s", pers->homephone ); + + } + + else { + + if( len == 12 ) { + + printf( " %12.12s", pers->homephone ); + + } + + } + + } + + } + + } + + printf( "\n" ); + +} + + + + + +/* print out a person in long format giving all possible information. + + * directory and shell are inhibited if unbrief is clear. + + */ + + + +personprint( pers ) + + + + struct person *pers; - + +{ + + struct passwd *pwdt = pers->pwd; + + int idleprinted; + + + + if( pwdt == NILPWD ) { + + printf( "Login name: %-10s", pers->name ); + + printf( " " ); + + printf( "In real life: ???\n"); + + return; + + } + + printf( "Login name: %-10s", pwdt->pw_name ); + + if( pers->loggedin ) { + + if( pers->writeable ) { + + printf( " " ); + + } + + else { + + printf( " (messages off) " ); + + } + + } + + else { + + printf( " " ); + + } + + if( strlen( pers->realname ) > 0 ) { + + printf( "In real life: %-s", pers->realname ); + + } + + if( strlen( pers->office ) > 0 ) { + + printf( "\nOffice: %-.11s", pers->office ); + + if( strlen( pers->officephone ) > 0 ) { + + printf( ", %s", pers->officephone ); + + if( strlen( pers->homephone ) > 0 ) { + + printf( " Home phone: %s", pers->homephone ); + + } + + else { + + if( strlen( pers->random ) > 0 ) { + + printf( " %s", pers->random ); + + } + + } + + } + + else { + + if( strlen( pers->homephone ) > 0 ) { + + printf(" Home phone: %s",pers->homephone); + + } + + if( strlen( pers->random ) > 0 ) { + + printf( " %s", pers->random ); + + } + + } + + } + + else { + + if( strlen( pers->officephone ) > 0 ) { + + printf( "\nPhone: %s", pers->officephone ); + + if( strlen( pers->homephone ) > 0 ) { + + printf( "\n, %s", pers->homephone ); + + if( strlen( pers->random ) > 0 ) { + + printf( ", %s", pers->random ); + + } + + } + + else { + + if( strlen( pers->random ) > 0 ) { + + printf( "\n, %s", pers->random ); + + } + + } + + } + + else { + + if( strlen( pers->homephone ) > 0 ) { + + printf( "\nPhone: %s", pers->homephone ); + + if( strlen( pers->random ) > 0 ) { - printf( "%s", pers->random ); +++ printf( ", %s", pers->random ); + + } + + } + + else { + + if( strlen( pers->random ) > 0 ) { + + printf( "\n%s", pers->random ); + + } + + } + + } + + } + + if( unbrief ) { + + printf( "\n" ); + + printf( "Directory: %-25s", pwdt->pw_dir ); + + if( strlen( pwdt->pw_shell ) > 0 ) { + + printf( " Shell: %-s", pwdt->pw_shell ); + + } + + } + + if( pers->loggedin ) { + + register char *ep = ctime( &pers->loginat ); - printf("\nOn since %15.15s on %-8.8s ", &ep[4], pers->tty ); +++ printf("\nOn since %15.15s on %-*.*s ", &ep[4], LMAX, LMAX, pers->tty ); + + idleprinted = ltimeprint( &pers->idletime ); + + if( idleprinted ) { + + printf( " Idle Time" ); + + } + + } + + else { + + register char *ep = ctime( &pers->loginat ); - printf("\nLast login %16.16s on %.8s", ep, pers->tty ); +++ printf("\nLast login %16.16s on %.*s", ep, LMAX, pers->tty ); + + } + + printf( "\n" ); + +} + + + + + +/* - * very hacky section of code to print phone numbers. filled with +++ * very hacky section of code to format phone numbers. filled with + + * magic constants like 4, 7 and 10. + + */ + + + +char *phone( s, len ) + + + + char *s; + + int len; + +{ + + char *strsave(); + + char fonebuf[ 15 ]; + + int i; + + - switch (len) { +++ switch( len ) { + + + + case 4: + + fonebuf[ 0 ] = ' '; + + fonebuf[ 1 ] = 'x'; + + fonebuf[ 2 ] = '2'; + + fonebuf[ 3 ] = '-'; + + for( i = 0; i <= 3; i++ ) { + + fonebuf[ 4 + i ] = *s++; + + } + + fonebuf[ 8 ] = NULL; + + return( strsave( &fonebuf[0] ) ); + + break; + + + + case 7: + + for( i = 0; i <= 2; i++ ) { + + fonebuf[ i ] = *s++; + + } + + fonebuf[ 3 ] = '-'; + + for( i = 0; i <= 3; i++ ) { + + fonebuf[ 4 + i ] = *s++; + + } + + fonebuf[ 8 ] = NULL; + + return( strsave( &fonebuf[0] ) ); + + break; + + + + case 10: + + for( i = 0; i <= 2; i++ ) { + + fonebuf[ i ] = *s++; + + } + + fonebuf[ 3 ] = '-'; + + for( i = 0; i <= 2; i++ ) { + + fonebuf[ 4 + i ] = *s++; + + } + + fonebuf[ 7 ] = '-'; + + for( i = 0; i <= 3; i++ ) { + + fonebuf[ 8 + i ] = *s++; + + } + + fonebuf[ 12 ] = NULL; + + return( strsave( &fonebuf[0] ) ); + + break; + + + + default: + + fprintf( stderr, "finger: error in phone numbering\n" ); + + return( strsave(s) ); + + break; + + } + +} + + + + + +/* decode the information in the gecos field of /etc/passwd + + * another hacky section of code, but given the format the stuff is in... + + */ + + + +decode( pers ) + + + + struct person *pers; + + + +{ + + struct passwd *pwdt = pers->pwd; + + char buffer[ 40 ], *bp, *gp, *lp; + + char *phone(); + + int alldigits; + + int len; + + int i; + + + + pers->realname = NULLSTR; + + pers->office = NULLSTR; + + pers->officephone = NULLSTR; + + pers->homephone = NULLSTR; + + pers->random = NULLSTR; + + if( pwdt != NILPWD ) { + + gp = pwdt->pw_gecos; + + bp = &buffer[ 0 ]; + + if( *gp == ASTERISK ) { + + gp++; + + } - while( (*gp != NULL) && (*gp != COMMA) ) { +++ while( (*gp != NULL) && (*gp != COMMA) ) { /* name */ + + if( *gp == SAMENAME ) { + + lp = pwdt->pw_name; + + *bp++ = CAPITALIZE(*lp++); + + while( *lp != NULL ) { + + *bp++ = *lp++; + + } + + } + + else { + + *bp++ = *gp; + + } + + gp++; + + } + + *bp = NULL; + + pers->realname = malloc( strlen( &buffer[0] ) + 1 ); + + strcpy( pers->realname, &buffer[0] ); - if( *gp++ == COMMA ) { +++ if( *gp++ == COMMA ) { /* office, supposedly */ + + alldigits = 1; + + bp = &buffer[ 0 ]; + + while( (*gp != NULL) && (*gp != COMMA) ) { + + *bp = *gp++; + + alldigits = alldigits && ('0' <= *bp) && (*bp <= '9'); + + bp++; + + } + + *bp = NULL; + + len = strlen( &buffer[0] ); + + if( buffer[ len - 1 ] == CORY ) { + + strcpy( &buffer[ len - 1 ], " Cory" ); + + pers->office = malloc( len + 5 ); + + strcpy( pers->office, &buffer[0] ); + + } + + else { + + if( buffer[ len - 1 ] == EVANS ) { + + strcpy( &buffer[ len - 1 ], " Evans" ); + + pers->office = malloc( len + 6 ); + + strcpy( pers->office, &buffer[0] ); + + } + + else { + + if( buffer[ len - 1 ] == 'L' ) { - strcpy( &buffer[ len - 3 ], " LBL" ); - pers->office = malloc( len + 2 ); +++ strcpy( &buffer[ len - 1 ], " LBL" ); +++ pers->office = malloc( len + 4 ); + + strcpy( pers->office, &buffer[0] ); + + } + + else { + + if( alldigits ) { + + if( len == 4 ) { + + pers->officephone = phone(&buffer[0], len); + + } + + else { + + if( (len == 7) || (len == 10) ) { + + pers->homephone = phone(&buffer[0],len); + + } + + } + + } + + else { + + pers->random = malloc( len + 1 ); + + strcpy( pers->random, &buffer[0] ); + + } + + } + + } + + } - if( *gp++ == COMMA ) { +++ if( *gp++ == COMMA ) { /* office phone, theoretically */ + + bp = &buffer[ 0 ]; + + alldigits = 1; + + while( (*gp != NULL) && (*gp != COMMA) ) { + + *bp = *gp++; + + alldigits = alldigits && ('0' <= *bp) && (*bp <= '9'); + + bp++; + + } + + *bp = NULL; + + len = strlen( &buffer[0] ); + + if( alldigits ) { + + if( len != 4 ) { + + if( (len == 7) || (len == 10) ) { + + pers->homephone = phone( &buffer[0], len ); + + } + + else { + + pers->random = malloc( len + 1 ); + + strcpy( pers->random, &buffer[0] ); + + } + + } + + else { + + pers->officephone = phone( &buffer[0], len ); + + } + + } + + else { + + pers->random = malloc( len + 1 ); + + strcpy( pers->random, &buffer[0] ); + + } - if( *gp++ == COMMA ) { +++ if( *gp++ == COMMA ) { /* home phone?? */ + + bp = &buffer[ 0 ]; + + alldigits = 1; + + while( (*gp != NULL) && (*gp != COMMA) ) { + + *bp = *gp++; + + alldigits = alldigits && ('0' <= *bp) && + + (*bp <= '9'); + + bp++; + + } + + *bp = NULL; + + len = strlen( &buffer[0] ); + + if( alldigits && ( (len == 7) || (len == 10) ) ) { - if( pers->homephone != NULL ) { +++ if( *pers->homephone != NULL ) { + + pers->officephone = pers->homephone; + + } + + pers->homephone = phone( &buffer[0], len ); + + } + + else { + + pers->random = malloc( strlen( &buffer[0] ) + 1 ); + + strcpy( pers->random, &buffer[0] ); + + } + + } + + } + + } + + if( pers->loggedin == 0 ) { + + findwhen( pers ); + + } + + else { + + findidle( pers ); + + } + + } + +} + + + + + +/* find the last log in of a user by checking the LASTLOG file. + + * the entry is indexed by the uid, so this can only be done if + + * the uid is known (which it isn't in quick mode) + + */ + + + +fwopen() + +{ + + if( ( lf = open(LASTLOG, 0) ) >= 0 ) { + + llopenerr = 0; + + } + + else { + + fprintf( stderr, "finger: lastlog open error\n" ); + + llopenerr = 1; + + } + +} + + + + + +findwhen( pers ) + + + + struct person *pers; + +{ + + struct passwd *pwdt = pers->pwd; + + struct lastlog ll; + + int llsize = sizeof ll; + + int i; + + + + if( !llopenerr ) { + + lseek( lf, pwdt->pw_uid*llsize, 0 ); + + if( read( lf, (char *) &ll, llsize ) == llsize ) { - for( i = 0; i < 8; i++ ) { +++ for( i = 0; i < LMAX; i++ ) { + + pers->tty[ i ] = ll.ll_line[ i ]; + + } - pers->tty[ 8 ] = NULL; +++ pers->tty[ LMAX ] = NULL; + + pers->loginat = ll.ll_time; + + } + + else { + + fprintf( stderr, "finger: lastlog read error\n" ); + + pers->tty[ 0 ] = NULL; + + pers->loginat = 0L; + + } + + } + + else { + + pers->tty[ 0 ] = NULL; + + pers->loginat = 0L; + + } + +} + + + + + +fwclose() + +{ + + if( !llopenerr ) { + + close( lf ); + + } + +} + + + + + +/* find the idle time of a user by doing a stat on /dev/histty, + + * where histty has been gotten from USERLOG, supposedly. + + */ + + + +findidle( pers ) + + + + struct person *pers; + +{ + + struct stat ttystatus; + + struct passwd *pwdt = pers->pwd; + + char buffer[ 20 ]; + + char *TTY = "/dev/"; + + int TTYLEN = strlen( TTY ); + + int i; + + + + strcpy( &buffer[0], TTY ); + + i = 0; + + do { + + buffer[ TTYLEN + i ] = pers->tty[ i ]; - } while( ++i <= 8 ); +++ } while( ++i <= LMAX ); + + if( stat( &buffer[0], &ttystatus ) >= 0 ) { + + time( &tloc ); + + if( tloc < ttystatus.st_atime ) { + + pers->idletime = 0L; + + } + + else { + + pers->idletime = tloc - ttystatus.st_atime; + + } + + if( (ttystatus.st_mode & TALKABLE) == TALKABLE ) { + + pers->writeable = 1; + + } + + else { + + pers->writeable = 0; + + } + + } + + else { + + fprintf( stderr, "finger: error STATing %s\n", &buffer[0] ); + + exit( 4 ); + + } + +} + + + + + +/* print idle time in short format; this program always prints 4 characters; + + * if the idle time is zero, it prints 4 blanks. + + */ + + + +stimeprint( dt ) + + + + long *dt; + +{ + + struct tm *gmtime(); + + struct tm *delta; + + + + delta = gmtime( dt ); + + if( delta->tm_yday == 0 ) { + + if( delta->tm_hour == 0 ) { + + if( delta->tm_min >= 10 ) { + + printf( " %2.2d ", delta->tm_min ); + + } + + else { + + if( delta->tm_min == 0 ) { + + printf( " " ); + + } + + else { + + printf( " %1.1d ", delta->tm_min ); + + } + + } + + } + + else { + + if( delta->tm_hour >= 10 ) { + + printf( "%3.3d:", delta->tm_hour ); + + } + + else { + + printf( "%1.1d:%02.2d", delta->tm_hour, delta->tm_min ); + + } + + } + + } + + else { + + printf( "%3dd", delta->tm_yday ); + + } + +} + + + + + +/* print idle time in long format with care being taken not to pluralize + + * 1 minutes or 1 hours or 1 days. + + */ + + + +ltimeprint( dt ) + + + + long *dt; + +{ + + struct tm *gmtime(); + + struct tm *delta; + + int printed = 1; + + + + delta = gmtime( dt ); + + if( delta->tm_yday == 0 ) { + + if( delta->tm_hour == 0 ) { + + if( delta->tm_min >= 10 ) { + + printf( "%2d minutes", delta->tm_min ); + + } + + else { + + if( delta->tm_min == 0 ) { + + if( delta->tm_sec > 10 ) { + + printf( "%2d seconds", delta->tm_sec ); + + } + + else { + + printed = 0; + + } + + } + + else { + + if( delta->tm_min == 1 ) { + + if( delta->tm_sec == 1 ) { + + printf( "%1d minute %1d second", + + delta->tm_min, delta->tm_sec ); + + } + + else { + + printf( "%1d minute %d seconds", + + delta->tm_min, delta->tm_sec ); + + } + + } + + else { + + if( delta->tm_sec == 1 ) { + + printf( "%1d minutes %1d second", + + delta->tm_min, delta->tm_sec ); + + } + + else { + + printf( "%1d minutes %d seconds", + + delta->tm_min, delta->tm_sec ); + + } + + } + + } + + } + + } + + else { + + if( delta->tm_hour >= 10 ) { + + printf( "%2d hours", delta->tm_hour ); + + } + + else { + + if( delta->tm_hour == 1 ) { + + if( delta->tm_min == 1 ) { + + printf( "%1d hour %1d minute", + + delta->tm_hour, delta->tm_min ); + + } + + else { + + printf( "%1d hour %2d minutes", + + delta->tm_hour, delta->tm_min ); + + } + + } + + else { + + if( delta->tm_min == 1 ) { + + printf( "%1d hours %1d minute", + + delta->tm_hour, delta->tm_min ); + + } + + else { + + printf( "%1d hours %2d minutes", + + delta->tm_hour, delta->tm_min ); + + } + + } + + } + + } + + } + + else { + + if( delta->tm_yday >= 10 ) { + + printf( "%2d days", delta->tm_yday ); + + } + + else { + + if( delta->tm_yday == 1 ) { + + if( delta->tm_hour == 1 ) { + + printf( "%1d day %1d hour", + + delta->tm_yday, delta->tm_hour ); + + } + + else { + + printf( "%1d day %2d hours", + + delta->tm_yday, delta->tm_hour ); + + } + + } + + else { + + if( delta->tm_hour == 1 ) { + + printf( "%1d days %1d hour", + + delta->tm_yday, delta->tm_hour ); + + } + + else { + + printf( "%1d days %2d hours", + + delta->tm_yday, delta->tm_hour ); + + } + + } + + } + + } + + return( printed ); + +} + + + + + +matchcmp( gname, login, given ) + + + + char *gname; + + char *login; + + char *given; + +{ + + char buffer[ 20 ]; + + char c; + + int flag, i, unfound; + + + + if( !match ) { + + return( 0 ); + + } + + else { + + if( namecmp( login, given ) ) { + + return( 1 ); + + } + + else { + + if( *gname == ASTERISK ) { + + gname++; + + } + + flag = 1; + + i = 0; + + unfound = 1; + + while( unfound ) { + + if( flag ) { + + c = *gname++; + + if( c == SAMENAME ) { + + flag = 0; + + c = *login++; + + } + + else { + + unfound = (*gname != COMMA) && (*gname != NULL); + + } + + } + + else { + + c = *login++; + + if( c == NULL ) { + + if( (*gname == COMMA) || (*gname == NULL) ) { + + break; + + } + + else { + + flag = 1; + + continue; + + } + + } + + } + + if( c == BLANK ) { + + buffer[i++] = NULL; + + if( namecmp( buffer, given ) ) { + + return( 1 ); + + } + + i = 0; + + flag = 1; + + } + + else { + + buffer[ i++ ] = c; + + } + + } + + buffer[i++] = NULL; + + if( namecmp( buffer, given ) ) { + + return( 1 ); + + } + + else { + + return( 0 ); + + } + + } + + } + +} + + + + + +namecmp( name1, name2 ) + + + + char *name1; + + char *name2; + +{ + + char c1, c2; + + + + c1 = *name1; + + if( (('A' <= c1) && (c1 <= 'Z')) || (('a' <= c1) && (c1 <= 'z')) ) { + + c1 = CAPITALIZE( c1 ); + + } + + c2 = *name2; + + if( (('A' <= c2) && (c2 <= 'Z')) || (('a' <= c2) && (c2 <= 'z')) ) { + + c2 = CAPITALIZE( c2 ); + + } + + while( c1 == c2 ) { + + if( c1 == NULL ) { + + return( 1 ); + + } + + c1 = *++name1; + + if( (('A'<=c1) && (c1<='Z')) || (('a'<=c1) && (c1<='z')) ) { + + c1 = CAPITALIZE( c1 ); + + } + + c2 = *++name2; + + if( (('A'<=c2) && (c2<='Z')) || (('a'<=c2) && (c2<='z')) ) { + + c2 = CAPITALIZE( c2 ); + + } + + } + + if( *name1 == NULL ) { + + while( ('0' <= *name2) && (*name2 <= '9') ) { + + name2++; + + } + + if( *name2 == NULL ) { + + return( 1 ); + + } + + } + + else { + + if( *name2 == NULL ) { + + while( ('0' <= *name1) && (*name1 <= '9') ) { + + name1++; + + } + + if( *name1 == NULL ) { + + return( 1 ); + + } + + } + + } + + return( 0 ); + +} + + + + + +char *strsave( s ) + + + + char *s; + +{ + + char *malloc(); + + char *p; + + + + p = malloc( strlen( s ) + 1 ); + + strcpy( p, s ); + +} diff --cc usr/src/cmd/flcopy.c index 0000000000,4beb38ab79,0000000000..68fb80baec mode 000000,100644,000000..100644 --- a/usr/src/cmd/flcopy.c +++ b/usr/src/cmd/flcopy.c @@@@ -1,0 -1,101 -1,0 +1,126 @@@@ +++static char *sccsid ="@(#)flcopy.c 4.3 (Berkeley) 10/20/80"; + +int floppydes; + +char *flopname = "/dev/floppy"; +++long dsize = 77 * 26 * 128; +++int hflag; +++int rflag; + + + +main(argc,argv) - char *argv[]; +++register char **argv; + +{ + + static char buff[512]; - register count = 77 * 26 * 128, startad = -26 * 128; - register int n, file; +++ register long count; +++ register startad = -26 * 128; +++ register int n, file; register char *cp; + + - if(argc==2) { +++ while((cp = *++argv), --argc > 0) { +++ if(*cp++!='-') continue; +++ while(*cp) switch(*cp++) { +++ case 'h': +++ hflag++; + + printf("Halftime!\n"); - if(strcmp(argv[1],"-h")!=0) - printf("Bad halftime option.\n"), - exit(1); + + if((file = open("floppy",0))<0) - printf("failed to open floppy image"), - exit(1); - goto halftime; +++ printf("failed to open floppy image, for reading\n"), +++ exit(1); +++ continue; +++ case 't': +++ if(*cp >= '0' && *cp <= '9') +++ dsize = atoi(cp); +++ else if(argc > 1) { +++ dsize = atoi(*++argv); +++ argc--; +++ } else dsize = 77; +++ if (dsize <= 0 || dsize > 77) +++ printf("Bad number of tracks\n"), exit(2); +++ dsize *= 26 * 128; +++ continue; +++ case 'r': +++ rflag++; +++ } + + } - file = creat("floppy",0666); - close(file); - file = open("floppy",2); - if(file < 0) exit(1); - for( ; count > 0 ; count -= 512) { +++ if(!hflag) { +++ file = creat("floppy",0666); +++ close(file); +++ file = open("floppy",2); +++ if(file < 0) +++ printf("failed to open floppy image"), +++ exit(1); +++ for(count = dsize; count > 0 ; count -= 512) { + + n = count > 512 ? 512 : count ; + + lread(startad,n,buff); + + write(file,buff,n); + + startad += 512; +++ } + + } - halftime: +++ if(rflag) exit(0); + + printf("Change Floppy, Hit return when done.\n"); + + gets(buff); + + lseek(file,0,0); - count = 77 * 26 * 128; startad = -26 * 128; +++ count = dsize; startad = -26 * 128; + + for( ; count > 0 ; count -= 512) { + + n = count > 512 ? 512 : count ; + + read(file,buff,n); + + lwrite(startad,n,buff); + + startad += 512; + + } + +} + +rt_init() + +{ + + static initized = 0; + + int mode = 2; + + + + if(initized) return; +++ if(rflag) mode = 0; + + initized = 1; + + if((floppydes = open(flopname,mode)) < 0) { + + printf("Floppy open failed\n"); + + exit(1); + + } + +} + + + +long trans(logical) + +register int logical; + +{ + + /* Logical to physical adress translation */ + + register int sector, bytes, track; + + + + logical += 26 * 128; + + bytes = (logical & 127); + + logical >>= 7; + + sector = logical % 26; + + if(sector >= 13) + + sector = sector *2 +1; + + else + + sector *= 2; + + sector += 26 + ((track = (logical / 26)) - 1) * 6; + + sector %= 26; + + return( (((track *26) + sector) << 7) + bytes); + +} + +lread(startad,count,obuff) + +register startad, count; + +register char * obuff; + +{ + + long trans(); + + extern floppydes; + + rt_init(); + + while( (count -= 128) >= 0) { + + lseek(floppydes, trans(startad), 0); + + read(floppydes,obuff,128); + + obuff += 128; + + startad += 128; + + } + +} + +lwrite(startad,count,obuff) + +register startad, count; + +register char * obuff; + +{ + + long trans(); + + extern floppydes; + + rt_init(); + + while( (count -= 128) >= 0) { + + lseek(floppydes, trans(startad), 0); + + write(floppydes,obuff,128); + + obuff += 128; + + startad += 128; + + } + +} diff --cc usr/src/cmd/fold.c index 0000000000,ab968ee0fd,0000000000..09d050552b mode 000000,100644,000000..100644 --- a/usr/src/cmd/fold.c +++ b/usr/src/cmd/fold.c @@@@ -1,0 -1,94 -1,0 +1,95 @@@@ +++static char *sccsid = "@(#)fold.c 4.1 (Berkeley) 10/1/80"; + +#include + +/* + + * fold - fold long lines for finite output devices + + * + + * Bill Joy UCB June 28, 1977 + + */ + + + +int fold = 80; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register c; + + FILE *f; + + char obuf[BUFSIZ]; + + + + argc--, argv++; + + setbuf(stdout, obuf); + + if (argc > 0 && argv[0][0] == '-') { + + fold = 0; + + argv[0]++; + + while (*argv[0] >= '0' && *argv[0] <= '9') + + fold =* 10, fold =+ *argv[0]++ - '0'; + + if (*argv[0]) { + + printf("Bad number for fold\n"); + + exit(1); + + } + + argc--, argv++; + + } + + do { + + if (argc > 0) { + + if (freopen(argv[0], "r", stdin) == NULL) { + + perror(argv[0]); + + exit(1); + + } + + argc--, argv++; + + } + + for (;;) { + + c = getc(stdin); + + if (c == -1) + + break; + + putch(c); + + } + + } while (argc > 0); + + exit(0); + +} + + + +int col; + + + +putch(c) + + register c; + +{ + + register ncol; + + + + switch (c) { + + case '\n': + + ncol = 0; + + break; + + case '\t': + + ncol = (col + 8) &~ 7; + + break; + + case '\b': + + ncol = col ? col - 1 : 0; + + break; + + case '\r': + + ncol = 0; + + break; + + default: + + ncol = col + 1; + + } + + if (ncol > fold) + + putchar('\n'), col = 0; + + putchar(c); + + switch (c) { + + case '\n': + + col = 0; + + break; + + case '\t': + + col =+ 8; + + col =& ~7; + + break; + + case '\b': + + if (col) + + col--; + + break; + + case '\r': + + col = 0; + + break; + + default: + + col++; + + break; + + } + +} diff --cc usr/src/cmd/from.c index 0000000000,3163e5dede,0000000000..01197eb15c mode 000000,100644,000000..100644 --- a/usr/src/cmd/from.c +++ b/usr/src/cmd/from.c @@@@ -1,0 -1,24 -1,0 +1,92 @@@@ +++static char *sccsid = "@(#)from.c 4.1 (Berkeley) 10/1/80"; + +#include +++#include + +#include + + + +struct passwd *getpwuid(); + + - main() +++main(argc, argv) +++int argc; +++register char **argv; + +{ + + char lbuf[BUFSIZ]; +++ char lbuf2[BUFSIZ]; + + register struct passwd *pp; +++ int stashed = 0; +++ register char *name; +++ char *sender; +++ char *getlogin(); + + +++ if (argc > 1 && *(argv[1]) == '-' && (*++argv)[1] == 's') { +++ if (--argc <= 1) { +++ fprintf (stderr, "Usage: from [-s sender] [user]\n"); +++ exit (1); +++ } +++ --argc; +++ sender = *++argv; +++ for (name = sender; *name; name++) +++ if (isupper(*name)) +++ *name = tolower(*name); +++ +++ } +++ else +++ sender = NULL; + + if (chdir("/usr/spool/mail") < 0) + + exit(1); - pp = getpwuid(getuid()); - if (pp == 0) { - fprintf(stderr, "Who are you?\n"); - exit(1); +++ if (argc > 1) +++ name = argv[1]; +++ else { +++ name = getlogin (); +++ if (name == NULL || strlen(name) == 0) { +++ pp = getpwuid(getuid()); +++ if (pp == NULL) { +++ fprintf(stderr, "Who are you?\n"); +++ exit(1); +++ } +++ name = pp->pw_name; +++ } + + } - if (freopen(pp->pw_name, "r", stdin) == NULL) +++ if (freopen(name, "r", stdin) == NULL) + + exit(0); + + while(fgets(lbuf, sizeof lbuf, stdin) != NULL) - if (lbuf[0] == 'F' && lbuf[1] == 'r' && lbuf[2] == 'o' && lbuf[3] == 'm') - printf("%s", lbuf); +++ if (lbuf[0] == '\n' && stashed) { +++ stashed = 0; +++ printf("%s", lbuf2); +++ } +++ else if (bufcmp(lbuf, "From ", 5) && +++ (sender == NULL || match(&lbuf[4], sender))) { +++ strcpy(lbuf2, lbuf); +++ stashed = 1; +++ } +++ if (stashed) +++ printf("%s", lbuf2); + + exit(0); + +} +++ +++bufcmp (b1, b2, n) +++register char *b1, *b2; +++register int n; +++{ +++ while (n-- > 0) +++ if (*b1++ != *b2++) +++ return (0); +++ return (1); +++} +++ +++match (line, str) +++register char *line, *str; +++{ +++ register char ch; +++ +++ while (*line == ' ' || *line == '\t') +++ ++line; +++ if (*line == '\n') +++ return (0); +++ while (*str && *line != ' ' && *line != '\t' && *line != '\n') { +++ ch = isupper(*line) ? tolower(*line) : *line; +++ if (ch != *str++) +++ return (0); +++ line++; +++ } +++ return (*str == '\0'); +++} diff --cc usr/src/cmd/fsck.c index 0000000000,0000000000,0000000000..87a8d983db new file mode 100644 --- /dev/null +++ b/usr/src/cmd/fsck.c @@@@ -1,0 -1,0 -1,0 +1,1907 @@@@ +++static char *sccsid = "@(#)fsck.c 4.10 (Berkeley) 11/15/80"; +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++ +++typedef int (*SIG_TYP)(); +++ +++#define NDIRECT (BSIZE/sizeof(struct direct)) +++#define SPERB (BSIZE/sizeof(short)) +++ +++#define NO 0 +++#define YES 1 +++ +++#define MAXDUP 10 /* limit on dup blks (per inode) */ +++#define MAXBAD 10 /* limit on bad blks (per inode) */ +++ +++#define STEPSIZE 9 /* default step for freelist spacing */ +++#define CYLSIZE 400 /* default cyl size for spacing */ +++#define MAXCYL 500 /* maximum cylinder size */ +++ +++#define BITSPB 8 /* number bits per byte */ +++#define BITSHIFT 3 /* log2(BITSPB) */ +++#define BITMASK 07 /* BITSPB-1 */ +++#define LSTATE 2 /* bits per inode state */ +++#define STATEPB (BITSPB/LSTATE) /* inode states per byte */ +++#define USTATE 0 /* inode not allocated */ +++#define FSTATE 01 /* inode is file */ +++#define DSTATE 02 /* inode is directory */ +++#define CLEAR 03 /* inode is to be cleared */ +++#define SMASK 03 /* mask for inode state */ +++ +++typedef struct dinode DINODE; +++typedef struct direct DIRECT; +++ +++#define ALLOC ((dp->di_mode & IFMT) != 0) +++#define DIR ((dp->di_mode & IFMT) == IFDIR) +++#define REG ((dp->di_mode & IFMT) == IFREG) +++#define BLK ((dp->di_mode & IFMT) == IFBLK) +++#define CHR ((dp->di_mode & IFMT) == IFCHR) +++#define MPC ((dp->di_mode & IFMT) == IFMPC) +++#define MPB ((dp->di_mode & IFMT) == IFMPB) +++#define SPECIAL (BLK || CHR || MPC || MPB) +++ +++#define NINOBLK 11 /* num blks for raw reading */ +++#define MAXRAW 110 /* largest raw read (in blks) */ +++daddr_t startib; /* blk num of first in raw area */ +++unsigned niblk; /* num of blks in raw area */ +++ +++struct bufarea { +++ struct bufarea *b_next; /* must be first */ +++ daddr_t b_bno; +++ union { +++ char b_buf[BSIZE]; /* buffer space */ +++ short b_lnks[SPERB]; /* link counts */ +++ daddr_t b_indir[NINDIR]; /* indirect block */ +++ struct filsys b_fs; /* super block */ +++ struct fblk b_fb; /* free block */ +++ struct dinode b_dinode[INOPB]; /* inode block */ +++ DIRECT b_dir[NDIRECT]; /* directory */ +++ } b_un; +++ char b_dirty; +++}; +++ +++typedef struct bufarea BUFAREA; +++ +++BUFAREA inoblk; /* inode blocks */ +++BUFAREA fileblk; /* other blks in filesys */ +++BUFAREA sblk; /* file system superblock */ +++BUFAREA *poolhead; /* ptr to first buffer in pool */ +++ +++#define initbarea(x) (x)->b_dirty = 0;(x)->b_bno = (daddr_t)-1 +++#define dirty(x) (x)->b_dirty = 1 +++#define inodirty() inoblk.b_dirty = 1 +++#define fbdirty() fileblk.b_dirty = 1 +++#define sbdirty() sblk.b_dirty = 1 +++ +++#define freeblk fileblk.b_un.b_fb +++#define dirblk fileblk.b_un +++#define superblk sblk.b_un.b_fs +++ +++struct filecntl { +++ int rfdes; +++ int wfdes; +++ int mod; +++}; +++ +++struct filecntl dfile; /* file descriptors for filesys */ +++struct filecntl sfile; /* file descriptors for scratch file */ +++ +++typedef unsigned MEMSIZE; +++ +++MEMSIZE memsize; /* amt of memory we got */ +++#ifdef pdp11 +++#define MAXDATA ((MEMSIZE)54*1024) +++#endif +++#ifdef vax +++#define MAXDATA ((MEMSIZE)400*1024) +++#endif +++ +++#define DUPTBLSIZE 100 /* num of dup blocks to remember */ +++daddr_t duplist[DUPTBLSIZE]; /* dup block table */ +++daddr_t *enddup; /* next entry in dup table */ +++daddr_t *muldup; /* multiple dups part of table */ +++ +++#define MAXLNCNT 20 /* num zero link cnts to remember */ +++ino_t badlncnt[MAXLNCNT]; /* table of inos with zero link cnts */ +++ino_t *badlnp; /* next entry in table */ +++ +++char sflag; /* salvage free block list */ +++char csflag; /* salvage free block list (conditional) */ +++char nflag; /* assume a no response */ +++char yflag; /* assume a yes response */ +++char tflag; /* scratch file specified */ +++char preen; /* just fix normal inconsistencies */ +++char rplyflag; /* any questions asked? */ +++char hotroot; /* checking root device */ +++char rawflg; /* read raw device */ +++char rmscr; /* remove scratch file when done */ +++char fixfree; /* corrupted free list */ +++char *membase; /* base of memory we get */ +++char *blkmap; /* ptr to primary blk allocation map */ +++char *freemap; /* ptr to secondary blk allocation map */ +++char *statemap; /* ptr to inode state table */ +++char *pathp; /* pointer to pathname position */ +++char *thisname; /* ptr to current pathname component */ +++char *srchname; /* name being searched for in dir */ +++char pathname[200]; +++char scrfile[80]; +++char *lfname = "lost+found"; +++char *checklist = FSTAB; +++ +++short *lncntp; /* ptr to link count table */ +++ +++int cylsize; /* num blocks per cylinder */ +++int stepsize; /* num blocks for spacing purposes */ +++int badblk; /* num of bad blks seen (per inode) */ +++int dupblk; /* num of dup blks seen (per inode) */ +++int (*pfunc)(); /* function to call to chk blk */ +++ +++ino_t inum; /* inode we are currently working on */ +++ino_t imax; /* number of inodes */ +++ino_t parentdir; /* i number of parent directory */ +++ino_t lastino; /* hiwater mark of inodes */ +++ino_t lfdir; /* lost & found directory */ +++ino_t orphan; /* orphaned inode */ +++ +++off_t filsize; /* num blks seen in file */ +++off_t maxblk; /* largest logical blk in file */ +++off_t bmapsz; /* num chars in blkmap */ +++ +++daddr_t smapblk; /* starting blk of state map */ +++daddr_t lncntblk; /* starting blk of link cnt table */ +++daddr_t fmapblk; /* starting blk of free map */ +++daddr_t n_free; /* number of free blocks */ +++daddr_t n_blks; /* number of blocks used */ +++daddr_t n_files; /* number of files seen */ +++daddr_t fmin; /* block number of the first data block */ +++daddr_t fmax; /* number of blocks in the volume */ +++ +++#define howmany(x,y) (((x)+((y)-1))/(y)) +++#define roundup(x,y) ((((x)+((y)-1))/(y))*(y)) +++#define outrange(x) (x < fmin || x >= fmax) +++#define zapino(x) clear((char *)(x),sizeof(DINODE)) +++ +++#define setlncnt(x) dolncnt(x,0) +++#define getlncnt() dolncnt(0,1) +++#define declncnt() dolncnt(0,2) +++ +++#define setbmap(x) domap(x,0) +++#define getbmap(x) domap(x,1) +++#define clrbmap(x) domap(x,2) +++ +++#define setfmap(x) domap(x,0+4) +++#define getfmap(x) domap(x,1+4) +++#define clrfmap(x) domap(x,2+4) +++ +++#define setstate(x) dostate(x,0) +++#define getstate() dostate(0,1) +++ +++#define DATA 1 +++#define ADDR 0 +++#define ALTERD 010 +++#define KEEPON 04 +++#define SKIP 02 +++#define STOP 01 +++ +++int (*signal())(); +++long lseek(); +++long time(); +++DINODE *ginode(); +++BUFAREA *getblk(); +++BUFAREA *search(); +++int dirscan(); +++int findino(); +++int catch(); +++int mkentry(); +++int chgdd(); +++int pass1(); +++int pass1b(); +++int pass2(); +++int pass3(); +++int pass4(); +++int pass5(); +++ +++char *devname; +++ +++main(argc,argv) +++int argc; +++char *argv[]; +++{ +++ register FILE *fp; +++ register n; +++ register char *p; +++ char filename[50]; +++ char *sbrk(); +++ +++ sync(); +++ while(--argc > 0 && **++argv == '-') { +++ switch(*++*argv) { +++ case 'p': +++ preen++; +++ break; +++ case 't': +++ case 'T': +++ tflag++; +++ if(**++argv == '-' || --argc <= 0) +++ errexit("Bad -t option\n"); +++ p = scrfile; +++ while(*p++ = **argv) +++ (*argv)++; +++ break; +++ case 's': /* salvage flag */ +++ stype(++*argv); +++ sflag++; +++ break; +++ case 'S': /* conditional salvage */ +++ stype(++*argv); +++ csflag++; +++ break; +++ case 'n': /* default no answer flag */ +++ case 'N': +++ nflag++; +++ yflag = 0; +++ break; +++ case 'y': /* default yes answer flag */ +++ case 'Y': +++ yflag++; +++ nflag = 0; +++ break; +++ default: +++ errexit("%c option?\n",**argv); +++ } +++ } +++ if(nflag && (sflag || csflag)) +++ errexit("Incompatible options: -n and -%s\n",sflag?"s":"S"); +++ if(sflag && csflag) +++ sflag = 0; +++ memsize = (MEMSIZE)sbrk(0); +++ memsize = MAXDATA - memsize - sizeof(int); +++ while(memsize >= 2*sizeof(BUFAREA) && +++ (membase = sbrk(memsize)) == (char *)-1) +++ memsize -= 1024; +++ if(memsize < 2*sizeof(BUFAREA)) +++ errexit("Can't get memory\n"); +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) +++ signal(SIGINT, catch); +++ if(argc) { /* arg list has file names */ +++ while(argc-- > 0){ +++ hotroot = 0; +++ check(*argv++); +++ } +++ } +++ else { /* use default checklist */ +++ struct fstab *fsp; +++ int pid, passno, anygtr, sumstatus = 0; +++ passno = 1; +++ do { +++ anygtr = 0; +++ if (setfsent() == 0) +++ errexit("Can't open checklist file: %s\n", +++ FSTAB); +++ while ( (fsp = getfsent()) != 0){ +++ if (strcmp(fsp->fs_type, FSTAB_RW) && +++ strcmp(fsp->fs_type, FSTAB_RO)) +++ continue; +++ if (preen == 0 || +++ passno == 1 && fsp->fs_passno == passno) { +++ if (blockcheck(fsp->fs_spec) == NO && +++ preen) +++ exit(8); +++ } else if (fsp->fs_passno > passno) +++ anygtr = 1; +++ else if (fsp->fs_passno == passno) { +++ pid = fork(); +++ if (pid < 0) { +++ perror("fork"); +++ exit(8); +++ } +++ if (pid == 0) +++ if (blockcheck(fsp->fs_spec)==NO) +++ exit(8); +++ else +++ exit(0); +++ } +++ } +++ if (preen) { +++ int status; +++ while (wait(&status) != -1) +++ sumstatus |= status; +++ } +++ passno++; +++ } while (anygtr); +++ if (sumstatus) +++ exit(8); +++ endfsent(); +++ } +++ exit(0); +++} +++ +++char *rawname(), *rindex(), *unrawname(); +++ +++blockcheck(name) +++ char *name; +++{ +++ struct stat stat_slash, stat_block, stat_char; +++ char *raw; +++ int looped = 0; +++ +++ hotroot = 0; +++ if (stat("/", &stat_slash) < 0){ +++ error("Can't stat root\n"); +++ return(NO); +++ } +++ retry: +++ if (stat(name, &stat_block) < 0){ +++ error("Can't stat %s\n", name); +++ return(NO); +++ } +++ if (stat_block.st_mode & S_IFBLK){ +++ raw = rawname(name); +++ if (stat(raw, &stat_char) < 0){ +++ error("Can't stat %s\n", raw); +++ return(NO); +++ } +++ if (stat_char.st_mode & S_IFCHR){ +++ if (stat_slash.st_dev == stat_block.st_rdev) { +++ hotroot++; +++ raw = unrawname(name); +++ } +++ check(raw); +++ return(YES); +++ } else { +++ error("%s is not a character device\n", raw); +++ return(NO); +++ } +++ } else +++ if (stat_block.st_mode & S_IFCHR){ +++ if (looped) { +++ error("Can't make sense out of name %s\n", name); +++ return(NO); +++ } +++ name = unrawname(name); +++ looped++; +++ goto retry; +++ } +++ error("Can't make sense out of name %s\n", name); +++ return(NO); +++} +++ +++char * +++unrawname(cp) +++ char *cp; +++{ +++ char *dp = rindex(cp, '/'); +++ struct stat stb; +++ if (dp == 0) +++ return(cp); +++ if (stat(cp, &stb) < 0) +++ return(cp); +++ if ((stb.st_mode&S_IFMT) != S_IFCHR) +++ return(cp); +++ if (*(dp+1) != 'r') +++ return(cp); +++ strcpy(dp+1, dp+2); +++ return(cp); +++} +++ +++char * +++rawname(cp) +++ char *cp; +++{ +++ static char rawbuf[32]; +++ char *dp = rindex(cp, '/'); +++ +++ if (dp == 0) +++ return (0); +++ *dp = 0; +++ strcpy(rawbuf, cp); +++ *dp = '/'; +++ strcat(rawbuf, "/r"); +++ strcat(rawbuf, dp+1); +++ return (rawbuf); +++} +++ +++check(dev) +++char *dev; +++{ +++ +++ devname = dev; +++ check1(dev); +++ devname = 0; +++} +++ +++check1(dev) +++char *dev; +++{ +++ register DINODE *dp; +++ register n; +++ register ino_t *blp; +++ ino_t savino; +++ daddr_t blk; +++ BUFAREA *bp1, *bp2; +++ +++ if(setup(dev) == NO) +++ return; +++ if (preen==0) { +++ printf("** Checking %s %s", dev, +++ hotroot?"(ROOT FILE SYSTEM)\n":"\n"); +++ printf("** Phase 1 - Check Blocks and Sizes\n"); +++ } +++ pfunc = pass1; +++ for(inum = 1; inum <= imax; inum++) { +++ if((dp = ginode()) == NULL) +++ continue; +++ if(ALLOC) { +++ lastino = inum; +++ if(ftypeok(dp) == NO) { +++ pfatal("UNKNOWN FILE TYPE I=%u",inum); +++ if(reply("CLEAR") == YES) { +++ zapino(dp); +++ inodirty(); +++ } +++ continue; +++ } +++ n_files++; +++ if(setlncnt(dp->di_nlink) <= 0) { +++ if(badlnp < &badlncnt[MAXLNCNT]) +++ *badlnp++ = inum; +++ else { +++ pfatal("LINK COUNT TABLE OVERFLOW"); +++ if(reply("CONTINUE") == NO) +++ errexit(""); +++ } +++ } +++ setstate(DIR ? DSTATE : FSTATE); +++ badblk = dupblk = 0; +++ filsize = 0; +++ maxblk = 0; +++ ckinode(dp,ADDR); +++ if((n = getstate()) == DSTATE || n == FSTATE) +++ sizechk(dp); +++ } +++ else if(dp->di_mode != 0) { +++ pfatal("PARTIALLY ALLOCATED INODE I=%u",inum); +++ if(reply("CLEAR") == YES) { +++ zapino(dp); +++ inodirty(); +++ } +++ } +++ } +++ +++ +++ if(enddup != &duplist[0]) { +++ if (preen) +++ pfatal("INTERNAL ERROR: dups with -p"); +++ printf("** Phase 1b - Rescan For More DUPS\n"); +++ pfunc = pass1b; +++ for(inum = 1; inum <= lastino; inum++) { +++ if(getstate() != USTATE && (dp = ginode()) != NULL) +++ if(ckinode(dp,ADDR) & STOP) +++ break; +++ } +++ } +++ if(rawflg) { +++ if(inoblk.b_dirty) +++ bwrite(&dfile,membase,startib,(int)niblk*BSIZE); +++ inoblk.b_dirty = 0; +++ if(poolhead) { +++ clear(membase,niblk*BSIZE); +++ for(bp1 = poolhead;bp1->b_next;bp1 = bp1->b_next); +++ bp2 = &((BUFAREA *)membase)[(niblk*BSIZE)/sizeof(BUFAREA)]; +++ while(--bp2 >= (BUFAREA *)membase) { +++ initbarea(bp2); +++ bp2->b_next = bp1->b_next; +++ bp1->b_next = bp2; +++ } +++ } +++ rawflg = 0; +++ +++ } +++ +++ +++ if (preen == 0) +++ printf("** Phase 2 - Check Pathnames\n"); +++ inum = ROOTINO; +++ thisname = pathp = pathname; +++ pfunc = pass2; +++ switch(getstate()) { +++ case USTATE: +++ errexit("ROOT INODE UNALLOCATED. TERMINATING.\n"); +++ case FSTATE: +++ pfatal("ROOT INODE NOT DIRECTORY"); +++ if(reply("FIX") == NO || (dp = ginode()) == NULL) +++ errexit(""); +++ dp->di_mode &= ~IFMT; +++ dp->di_mode |= IFDIR; +++ inodirty(); +++ setstate(DSTATE); +++ case DSTATE: +++ descend(); +++ break; +++ case CLEAR: +++ pfatal("DUPS/BAD IN ROOT INODE"); +++ printf("\n"); +++ if(reply("CONTINUE") == NO) +++ errexit(""); +++ setstate(DSTATE); +++ descend(); +++ } +++ +++ +++ if (preen == 0) +++ printf("** Phase 3 - Check Connectivity\n"); +++ for(inum = ROOTINO; inum <= lastino; inum++) { +++ if(getstate() == DSTATE) { +++ pfunc = findino; +++ srchname = ".."; +++ savino = inum; +++ do { +++ orphan = inum; +++ if((dp = ginode()) == NULL) +++ break; +++ filsize = dp->di_size; +++ parentdir = 0; +++ ckinode(dp,DATA); +++ if((inum = parentdir) == 0) +++ break; +++ } while(getstate() == DSTATE); +++ inum = orphan; +++ if(linkup() == YES) { +++ thisname = pathp = pathname; +++ *pathp++ = '?'; +++ pfunc = pass2; +++ descend(); +++ } +++ inum = savino; +++ } +++ } +++ +++ +++ if (preen == 0) +++ printf("** Phase 4 - Check Reference Counts\n"); +++ pfunc = pass4; +++ for(inum = ROOTINO; inum <= lastino; inum++) { +++ switch(getstate()) { +++ case FSTATE: +++ if(n = getlncnt()) +++ adjust((short)n); +++ else { +++ for(blp = badlncnt;blp < badlnp; blp++) +++ if(*blp == inum) { +++ clri("UNREF",YES); +++ break; +++ } +++ } +++ break; +++ case DSTATE: +++ clri("UNREF",YES); +++ break; +++ case CLEAR: +++ clri("BAD/DUP",YES); +++ } +++ } +++ if(imax - n_files != superblk.s_tinode) { +++ pwarn("FREE INODE COUNT WRONG IN SUPERBLK"); +++ if (preen) +++ printf(" (FIXED)\n"); +++ if (preen || reply("FIX") == YES) { +++ superblk.s_tinode = imax - n_files; +++ sbdirty(); +++ } +++ } +++ flush(&dfile,&fileblk); +++ +++ +++ if (preen == 0) +++ printf("** Phase 5 - Check Free List "); +++ if(sflag || (csflag && rplyflag == 0)) { +++ if (preen == 0) +++ printf("(Ignored)\n"); +++ fixfree = 1; +++ } +++ else { +++ if (preen == 0) +++ printf("\n"); +++ if(freemap) +++ copy(blkmap,freemap,(MEMSIZE)bmapsz); +++ else { +++ for(blk = 0; blk < fmapblk; blk++) { +++ bp1 = getblk((BUFAREA *)NULL,blk); +++ bp2 = getblk((BUFAREA *)NULL,blk+fmapblk); +++ copy(bp1->b_un.b_buf,bp2->b_un.b_buf,BSIZE); +++ dirty(bp2); +++ } +++ } +++ badblk = dupblk = 0; +++ freeblk.df_nfree = superblk.s_nfree; +++ for(n = 0; n < NICFREE; n++) +++ freeblk.df_free[n] = superblk.s_free[n]; +++ freechk(); +++ if(badblk) { +++ pfatal("%d BAD BLKS IN FREE LIST",badblk); +++ printf("\n"); +++ } +++ if(dupblk) +++ pwarn("%d DUP BLKS IN FREE LIST\n",dupblk); +++ if(fixfree == 0) { +++ if((n_blks+n_free) != (fmax-fmin)) { +++ pwarn("%ld BLK(S) MISSING\n", +++ fmax-fmin-n_blks-n_free); +++ fixfree = 1; +++ } +++ else if(n_free != superblk.s_tfree) { +++ pwarn("FREE BLK COUNT WRONG IN SUPERBLK"); +++ if (preen) +++ printf(" (FIXED)\n"); +++ if(preen || reply("FIX") == YES) { +++ superblk.s_tfree = n_free; +++ sbdirty(); +++ } +++ } +++ } +++ if(fixfree) { +++ pwarn("BAD FREE LIST"); +++ if (preen) +++ printf(" (SALVAGED)\n"); +++ else if(reply("SALVAGE") == NO) +++ fixfree = 0; +++ } +++ } +++ +++ +++ if(fixfree) { +++ if (preen == 0) +++ printf("** Phase 6 - Salvage Free List\n"); +++ makefree(); +++ n_free = superblk.s_tfree; +++ } +++ +++ +++ pwarn("%ld files %ld blocks %ld free\n", n_files,n_blks,n_free); +++ if(dfile.mod) { +++ time(&superblk.s_time); +++ sbdirty(); +++ } +++ ckfini(); +++ sync(); +++ if(dfile.mod && hotroot) { +++ printf("\n***** BOOT UNIX (NO SYNC!) *****\n"); +++ exit(4); +++ } +++ if(dfile.mod && preen == 0) +++ printf("\n***** FILE SYSTEM WAS MODIFIED *****\n"); +++} +++ +++/* VARARGS1 */ +++error(s1,s2,s3,s4) +++char *s1; +++{ +++ printf(s1,s2,s3,s4); +++} +++ +++/* VARARGS1 */ +++errexit(s1,s2,s3,s4) +++char *s1; +++{ +++ error(s1,s2,s3,s4); +++ exit(8); +++} +++ +++/* +++ * Pfatal is called when an inconsistency occurs +++ * which should not happen during normal operations. +++ * It prints a message and then dies. +++ * When not preening, this is just a printf. +++ */ +++pfatal(s,a1,a2,a3) +++{ +++ +++ if (preen) { +++ printf("%s: ", devname); +++ printf(s, a1, a2, a3); +++ printf("\n"); +++ preendie(); +++ } +++ printf(s, a1, a2, a3); +++} +++ +++/* +++ * Fatal is called to terminate preening +++ * due to unexplainable inconsistency. +++ */ +++preendie() +++{ +++ +++ printf("%s: UNEXPECTED INCONSISTENCY; RUN fsck MANUALLY.\n", devname); +++ exit(8); +++} +++ +++/* +++ * Pwarn is like printf when not preening, +++ * or a warning (preceded by filename) when preening. +++ */ +++pwarn(s,a1,a2,a3) +++{ +++ +++ if (preen) +++ printf("%s: ", devname); +++ printf(s, a1, a2, a3); +++} +++ +++ckinode(dp,flg) +++DINODE *dp; +++register flg; +++{ +++ register daddr_t *ap; +++ register ret; +++ int (*func)(), n; +++ daddr_t iaddrs[NADDR]; +++ +++ if(SPECIAL) +++ return(KEEPON); +++ l3tol(iaddrs,dp->di_addr,NADDR); +++ func = (flg == ADDR) ? pfunc : dirscan; +++ for(ap = iaddrs; ap < &iaddrs[NADDR-3]; ap++) { +++ if(*ap && (ret = (*func)(*ap)) & STOP) +++ return(ret); +++ } +++ for(n = 1; n < 4; n++) { +++ if(*ap && (ret = iblock(*ap,n,flg)) & STOP) +++ return(ret); +++ ap++; +++ } +++ return(KEEPON); +++} +++ +++ +++iblock(blk,ilevel,flg) +++daddr_t blk; +++register ilevel; +++{ +++ register daddr_t *ap; +++ register n; +++ int (*func)(); +++ BUFAREA ib; +++ +++ if(flg == ADDR) { +++ func = pfunc; +++ if(((n = (*func)(blk)) & KEEPON) == 0) +++ return(n); +++ } +++ else +++ func = dirscan; +++ if(outrange(blk)) /* protect thyself */ +++ return(SKIP); +++ initbarea(&ib); +++ if(getblk(&ib,blk) == NULL) +++ return(SKIP); +++ ilevel--; +++ for(ap = ib.b_un.b_indir; ap < &ib.b_un.b_indir[NINDIR]; ap++) { +++ if(*ap) { +++ if(ilevel > 0) { +++ n = iblock(*ap,ilevel,flg); +++ } +++ else +++ n = (*func)(*ap); +++ if(n & STOP) +++ return(n); +++ } +++ } +++ return(KEEPON); +++} +++ +++ +++pass1(blk) +++daddr_t blk; +++{ +++ register daddr_t *dlp; +++ +++ if(outrange(blk)) { +++ blkerr("BAD",blk); +++ if(++badblk >= MAXBAD) { +++ printf("EXCESSIVE BAD BLKS I=%u",inum); +++ if(reply("CONTINUE") == NO) +++ errexit(""); +++ return(STOP); +++ } +++ return(SKIP); +++ } +++ if(getbmap(blk)) { +++ blkerr("DUP",blk); +++ if(++dupblk >= MAXDUP) { +++ printf("EXCESSIVE DUP BLKS I=%u",inum); +++ if(reply("CONTINUE") == NO) +++ errexit(""); +++ return(STOP); +++ } +++ if(enddup >= &duplist[DUPTBLSIZE]) { +++ printf("DUP TABLE OVERFLOW."); +++ if(reply("CONTINUE") == NO) +++ errexit(""); +++ return(STOP); +++ } +++ for(dlp = duplist; dlp < muldup; dlp++) { +++ if(*dlp == blk) { +++ *enddup++ = blk; +++ break; +++ } +++ } +++ if(dlp >= muldup) { +++ *enddup++ = *muldup; +++ *muldup++ = blk; +++ } +++ } +++ else { +++ n_blks++; +++ setbmap(blk); +++ } +++ filsize++; +++ return(KEEPON); +++} +++ +++ +++pass1b(blk) +++daddr_t blk; +++{ +++ register daddr_t *dlp; +++ +++ if(outrange(blk)) +++ return(SKIP); +++ for(dlp = duplist; dlp < muldup; dlp++) { +++ if(*dlp == blk) { +++ blkerr("DUP",blk); +++ *dlp = *--muldup; +++ *muldup = blk; +++ return(muldup == duplist ? STOP : KEEPON); +++ } +++ } +++ return(KEEPON); +++} +++ +++ +++pass2(dirp) +++register DIRECT *dirp; +++{ +++ register char *p; +++ register n; +++ DINODE *dp; +++ +++ if((inum = dirp->d_ino) == 0) +++ return(KEEPON); +++ thisname = pathp; +++ for(p = dirp->d_name; p < &dirp->d_name[DIRSIZ]; ) +++ if((*pathp++ = *p++) == 0) { +++ --pathp; +++ break; +++ } +++ *pathp = 0; +++ n = NO; +++ if(inum > imax || inum < ROOTINO) +++ n = direrr("I OUT OF RANGE"); +++ else { +++ again: +++ switch(getstate()) { +++ case USTATE: +++ n = direrr("UNALLOCATED"); +++ break; +++ case CLEAR: +++ if((n = direrr("DUP/BAD")) == YES) +++ break; +++ if((dp = ginode()) == NULL) +++ break; +++ setstate(DIR ? DSTATE : FSTATE); +++ goto again; +++ case FSTATE: +++ declncnt(); +++ break; +++ case DSTATE: +++ declncnt(); +++ descend(); +++ } +++ } +++ pathp = thisname; +++ if(n == NO) +++ return(KEEPON); +++ dirp->d_ino = 0; +++ return(KEEPON|ALTERD); +++} +++ +++ +++pass4(blk) +++daddr_t blk; +++{ +++ register daddr_t *dlp; +++ +++ if(outrange(blk)) +++ return(SKIP); +++ if(getbmap(blk)) { +++ for(dlp = duplist; dlp < enddup; dlp++) +++ if(*dlp == blk) { +++ *dlp = *--enddup; +++ return(KEEPON); +++ } +++ clrbmap(blk); +++ n_blks--; +++ } +++ return(KEEPON); +++} +++ +++ +++pass5(blk) +++daddr_t blk; +++{ +++ if(outrange(blk)) { +++ fixfree = 1; +++ if (preen) +++ pfatal("BAD BLOCKS IN FREE LIST."); +++ if(++badblk >= MAXBAD) { +++ printf("EXCESSIVE BAD BLKS IN FREE LIST."); +++ if(reply("CONTINUE") == NO) +++ errexit(""); +++ return(STOP); +++ } +++ return(SKIP); +++ } +++ if(getfmap(blk)) { +++ fixfree = 1; +++ if(++dupblk >= DUPTBLSIZE) { +++ printf("EXCESSIVE DUP BLKS IN FREE LIST."); +++ if(reply("CONTINUE") == NO) +++ errexit(""); +++ return(STOP); +++ } +++ } +++ else { +++ n_free++; +++ setfmap(blk); +++ } +++ return(KEEPON); +++} +++ +++ +++blkerr(s,blk) +++daddr_t blk; +++char *s; +++{ +++ pfatal("%ld %s I=%u",blk,s,inum); +++ printf("\n"); +++ setstate(CLEAR); /* mark for possible clearing */ +++} +++ +++ +++descend() +++{ +++ register DINODE *dp; +++ register char *savname; +++ off_t savsize; +++ +++ setstate(FSTATE); +++ if((dp = ginode()) == NULL) +++ return; +++ savname = thisname; +++ *pathp++ = '/'; +++ savsize = filsize; +++ filsize = dp->di_size; +++ ckinode(dp,DATA); +++ thisname = savname; +++ *--pathp = 0; +++ filsize = savsize; +++} +++ +++ +++dirscan(blk) +++daddr_t blk; +++{ +++ register DIRECT *dirp; +++ register char *p1, *p2; +++ register n; +++ DIRECT direntry; +++ +++ if(outrange(blk)) { +++ filsize -= BSIZE; +++ return(SKIP); +++ } +++ for(dirp = dirblk.b_dir; dirp < &dirblk.b_dir[NDIRECT] && +++ filsize > 0; dirp++, filsize -= sizeof(DIRECT)) { +++ if(getblk(&fileblk,blk) == NULL) { +++ filsize -= (&dirblk.b_dir[NDIRECT]-dirp)*sizeof(DIRECT); +++ return(SKIP); +++ } +++ p1 = &dirp->d_name[DIRSIZ]; +++ p2 = &direntry.d_name[DIRSIZ]; +++ while(p1 > (char *)dirp) +++ *--p2 = *--p1; +++ if((n = (*pfunc)(&direntry)) & ALTERD) { +++ if(getblk(&fileblk,blk) != NULL) { +++ p1 = &dirp->d_name[DIRSIZ]; +++ p2 = &direntry.d_name[DIRSIZ]; +++ while(p1 > (char *)dirp) +++ *--p1 = *--p2; +++ fbdirty(); +++ } +++ else +++ n &= ~ALTERD; +++ } +++ if(n & STOP) +++ return(n); +++ } +++ return(filsize > 0 ? KEEPON : STOP); +++} +++ +++ +++direrr(s) +++char *s; +++{ +++ register DINODE *dp; +++ +++ pwarn("%s ",s); +++ pinode(); +++ printf("\n"); +++ if((dp = ginode()) != NULL && ftypeok(dp)) +++ pfatal("%s=%s",DIR?"DIR":"FILE",pathname); +++ else +++ pfatal("NAME=%s",pathname); +++ return(reply("REMOVE")); +++} +++ +++ +++adjust(lcnt) +++register short lcnt; +++{ +++ register DINODE *dp; +++ +++ if((dp = ginode()) == NULL) +++ return; +++ if(dp->di_nlink == lcnt) { +++ if(linkup() == NO) +++ clri("UNREF",NO); +++ } +++ else { +++ pwarn("LINK COUNT %s", +++ (lfdir==inum)?lfname:(DIR?"DIR":"FILE")); +++ pinode(); +++ printf(" COUNT %d SHOULD BE %d", +++ dp->di_nlink,dp->di_nlink-lcnt); +++ if (preen) { +++ if (lcnt < 0) { +++ printf("\n"); +++ preendie(); +++ } +++ printf(" (ADJUSTED)\n"); +++ } +++ if(preen || reply("ADJUST") == YES) { +++ dp->di_nlink -= lcnt; +++ inodirty(); +++ } +++ } +++} +++ +++ +++clri(s,flg) +++char *s; +++{ +++ register DINODE *dp; +++ +++ if((dp = ginode()) == NULL) +++ return; +++ if(flg == YES) { +++ pwarn("%s %s",s,DIR?"DIR":"FILE"); +++ pinode(); +++ } +++ if(preen || reply("CLEAR") == YES) { +++ if (preen) +++ printf(" (CLEARED)\n"); +++ n_files--; +++ pfunc = pass4; +++ ckinode(dp,ADDR); +++ zapino(dp); +++ inodirty(); +++ } +++} +++ +++ +++setup(dev) +++char *dev; +++{ +++ register n; +++ register BUFAREA *bp; +++ register MEMSIZE msize; +++ char *mbase; +++ daddr_t bcnt, nscrblk; +++ dev_t rootdev; +++ off_t smapsz, lncntsz, totsz; +++ struct { +++ daddr_t tfree; +++ ino_t tinode; +++ char fname[6]; +++ char fpack[6]; +++ } ustatarea; +++ struct stat statarea; +++ +++ if(stat("/",&statarea) < 0) +++ errexit("Can't stat root\n"); +++ rootdev = statarea.st_dev; +++ if(stat(dev,&statarea) < 0) { +++ error("Can't stat %s\n",dev); +++ return(NO); +++ } +++ rawflg = 0; +++ if((statarea.st_mode & S_IFMT) == S_IFBLK) { +++ if(ustat(statarea.st_rdev, (char *)&ustatarea) >= 0) { +++ hotroot++; +++ } +++ } +++ else if((statarea.st_mode & S_IFMT) == S_IFCHR) +++ rawflg++; +++ else { +++ if (reply("file is not a block or character device; OK") == NO) +++ return(NO); +++ } +++ if(rootdev == statarea.st_rdev) +++ hotroot++; +++ if((dfile.rfdes = open(dev,0)) < 0) { +++ error("Can't open %s\n",dev); +++ return(NO); +++ } +++ if (preen == 0) +++ printf("\n%s",dev); +++ if(nflag || (dfile.wfdes = open(dev,1)) < 0) { +++ dfile.wfdes = -1; +++ if (preen) +++ pfatal("NO WRITE ACCESS"); +++ printf(" (NO WRITE)"); +++ } +++ if (preen == 0) +++ printf("\n"); +++ fixfree = 0; +++ dfile.mod = 0; +++ n_files = n_blks = n_free = 0; +++ muldup = enddup = &duplist[0]; +++ badlnp = &badlncnt[0]; +++ lfdir = 0; +++ rplyflag = 0; +++ initbarea(&sblk); +++ initbarea(&fileblk); +++ initbarea(&inoblk); +++ sfile.wfdes = sfile.rfdes = -1; +++ rmscr = 0; +++ if(getblk(&sblk,SUPERB) == NULL) { +++ ckfini(); +++ return(NO); +++ } +++ imax = ((ino_t)superblk.s_isize - (SUPERB+1)) * INOPB; +++ fmin = (daddr_t)superblk.s_isize; /* first data blk num */ +++ fmax = superblk.s_fsize; /* first invalid blk num */ +++ if(fmin >= fmax || +++ (imax/INOPB) != ((ino_t)superblk.s_isize-(SUPERB+1))) { +++ pfatal("Size check: fsize %ld isize %d", +++ superblk.s_fsize,superblk.s_isize); +++ printf("\n"); +++ ckfini(); +++ return(NO); +++ } +++ if (preen == 0) +++ printf("File System: %.6s Volume: %.6s\n\n", superblk.s_fname, +++ superblk.s_fpack); +++ bmapsz = roundup(howmany(fmax,BITSPB),sizeof(*lncntp)); +++ smapsz = roundup(howmany((long)(imax+1),STATEPB),sizeof(*lncntp)); +++ lncntsz = (long)(imax+1) * sizeof(*lncntp); +++ if(bmapsz > smapsz+lncntsz) +++ smapsz = bmapsz-lncntsz; +++ totsz = bmapsz+smapsz+lncntsz; +++ msize = memsize; +++ mbase = membase; +++ if(rawflg) { +++ if(msize < (MEMSIZE)(NINOBLK*BSIZE) + 2*sizeof(BUFAREA)) +++ rawflg = 0; +++ else { +++ msize -= (MEMSIZE)NINOBLK*BSIZE; +++ mbase += (MEMSIZE)NINOBLK*BSIZE; +++ niblk = NINOBLK; +++ startib = fmax; +++ } +++ } +++ clear(mbase,msize); +++ if((off_t)msize < totsz) { +++ bmapsz = roundup(bmapsz,BSIZE); +++ smapsz = roundup(smapsz,BSIZE); +++ lncntsz = roundup(lncntsz,BSIZE); +++ nscrblk = (bmapsz+smapsz+lncntsz)>>BSHIFT; +++ if(tflag == 0) { +++ printf("\nNEED SCRATCH FILE (%ld BLKS)\n",nscrblk); +++ do { +++ printf("ENTER FILENAME: "); +++ if((n = getline(stdin,scrfile,sizeof(scrfile))) == EOF) +++ errexit("\n"); +++ } while(n == 0); +++ } +++ if(stat(scrfile,&statarea) < 0 || +++ (statarea.st_mode & S_IFMT) == S_IFREG) +++ rmscr++; +++ if((sfile.wfdes = creat(scrfile,0666)) < 0 || +++ (sfile.rfdes = open(scrfile,0)) < 0) { +++ error("Can't create %s\n",scrfile); +++ ckfini(); +++ return(NO); +++ } +++ bp = &((BUFAREA *)mbase)[(msize/sizeof(BUFAREA))]; +++ poolhead = NULL; +++ while(--bp >= (BUFAREA *)mbase) { +++ initbarea(bp); +++ bp->b_next = poolhead; +++ poolhead = bp; +++ } +++ bp = poolhead; +++ for(bcnt = 0; bcnt < nscrblk; bcnt++) { +++ bp->b_bno = bcnt; +++ dirty(bp); +++ flush(&sfile,bp); +++ } +++ blkmap = freemap = statemap = (char *) NULL; +++ lncntp = (short *) NULL; +++ smapblk = bmapsz / BSIZE; +++ lncntblk = smapblk + smapsz / BSIZE; +++ fmapblk = smapblk; +++ } +++ else { +++ if(rawflg && (off_t)msize > totsz+BSIZE) { +++ niblk += (unsigned)((off_t)msize-totsz)>>BSHIFT; +++ if(niblk > MAXRAW) +++ niblk = MAXRAW; +++ msize = memsize - (niblk*BSIZE); +++ mbase = membase + (niblk*BSIZE); +++ } +++ poolhead = NULL; +++ blkmap = mbase; +++ statemap = &mbase[(MEMSIZE)bmapsz]; +++ freemap = statemap; +++ lncntp = (short *)&statemap[(MEMSIZE)smapsz]; +++ } +++ return(YES); +++} +++ +++ +++DINODE * +++ginode() +++{ +++ register DINODE *dp; +++ register char *mbase; +++ daddr_t iblk; +++ +++ if(inum > imax) +++ return(NULL); +++ iblk = itod(inum); +++ if(rawflg) { +++ mbase = membase; +++ if(iblk < startib || iblk >= startib+niblk) { +++ if(inoblk.b_dirty) +++ bwrite(&dfile,mbase,startib,(int)niblk*BSIZE); +++ inoblk.b_dirty = 0; +++ if(bread(&dfile,mbase,iblk,(int)niblk*BSIZE) == NO) { +++ startib = fmax; +++ return(NULL); +++ } +++ startib = iblk; +++ } +++ dp = (DINODE *)&mbase[(unsigned)((iblk-startib)<di_mode & IFMT) { +++ case IFDIR: +++ case IFREG: +++ case IFBLK: +++ case IFCHR: +++ case IFMPC: +++ case IFMPB: +++ return(YES); +++ default: +++ return(NO); +++ } +++} +++ +++ +++reply(s) +++char *s; +++{ +++ char line[80]; +++ +++ if (preen) +++ pfatal("INTERNAL ERROR: GOT TO reply()"); +++ rplyflag = 1; +++ printf("\n%s? ",s); +++ if(nflag || csflag || dfile.wfdes < 0) { +++ printf(" no\n\n"); +++ return(NO); +++ } +++ if(yflag) { +++ printf(" yes\n\n"); +++ return(YES); +++ } +++ if(getline(stdin,line,sizeof(line)) == EOF) +++ errexit("\n"); +++ printf("\n"); +++ if(line[0] == 'y' || line[0] == 'Y') +++ return(YES); +++ else +++ return(NO); +++} +++ +++ +++getline(fp,loc,maxlen) +++FILE *fp; +++char *loc; +++{ +++ register n; +++ register char *p, *lastloc; +++ +++ p = loc; +++ lastloc = &p[maxlen-1]; +++ while((n = getc(fp)) != '\n') { +++ if(n == EOF) +++ return(EOF); +++ if(!isspace(n) && p < lastloc) +++ *p++ = n; +++ } +++ *p = 0; +++ return(p - loc); +++} +++ +++ +++stype(p) +++register char *p; +++{ +++ if(*p == 0) +++ return; +++ if (*(p+1) == 0) { +++ if (*p == '3') { +++ cylsize = 200; +++ stepsize = 5; +++ return; +++ } +++ if (*p == '4') { +++ cylsize = 418; +++ stepsize = 9; +++ return; +++ } +++ } +++ cylsize = atoi(p); +++ while(*p && *p != ':') +++ p++; +++ if(*p) +++ p++; +++ stepsize = atoi(p); +++ if(stepsize <= 0 || stepsize > cylsize || +++ cylsize <= 0 || cylsize > MAXCYL) { +++ error("Invalid -s argument, defaults assumed\n"); +++ cylsize = stepsize = 0; +++ } +++} +++ +++ +++dostate(s,flg) +++{ +++ register char *p; +++ register unsigned byte, shift; +++ BUFAREA *bp; +++ +++ byte = (inum)/STATEPB; +++ shift = LSTATE * ((inum)%STATEPB); +++ if(statemap != NULL) { +++ bp = NULL; +++ p = &statemap[byte]; +++ } +++ else if((bp = getblk((BUFAREA *)NULL,(daddr_t)(smapblk+(byte/BSIZE)))) == NULL) +++ errexit("Fatal I/O error\n"); +++ else +++ p = &bp->b_un.b_buf[byte%BSIZE]; +++ switch(flg) { +++ case 0: +++ *p &= ~(SMASK<<(shift)); +++ *p |= s<<(shift); +++ if(bp != NULL) +++ dirty(bp); +++ return(s); +++ case 1: +++ return((*p>>(shift)) & SMASK); +++ } +++ return(USTATE); +++} +++ +++ +++domap(blk,flg) +++daddr_t blk; +++{ +++ register char *p; +++ register unsigned n; +++ register BUFAREA *bp; +++ off_t byte; +++ +++ byte = blk >> BITSHIFT; +++ n = 1<<((unsigned)(blk & BITMASK)); +++ if(flg & 04) { +++ p = freemap; +++ blk = fmapblk; +++ } +++ else { +++ p = blkmap; +++ blk = 0; +++ } +++ if(p != NULL) { +++ bp = NULL; +++ p += (unsigned)byte; +++ } +++ else if((bp = getblk((BUFAREA *)NULL,blk+(byte>>BSHIFT))) == NULL) +++ errexit("Fatal I/O error\n"); +++ else +++ p = &bp->b_un.b_buf[(unsigned)(byte&BMASK)]; +++ switch(flg&03) { +++ case 0: +++ *p |= n; +++ break; +++ case 1: +++ n &= *p; +++ bp = NULL; +++ break; +++ case 2: +++ *p &= ~n; +++ } +++ if(bp != NULL) +++ dirty(bp); +++ return(n); +++} +++ +++ +++dolncnt(val,flg) +++short val; +++{ +++ register short *sp; +++ register BUFAREA *bp; +++ +++ if(lncntp != NULL) { +++ bp = NULL; +++ sp = &lncntp[inum]; +++ } +++ else if((bp = getblk((BUFAREA *)NULL,(daddr_t)(lncntblk+(inum/SPERB)))) == NULL) +++ errexit("Fatal I/O error\n"); +++ else +++ sp = &bp->b_un.b_lnks[inum%SPERB]; +++ switch(flg) { +++ case 0: +++ *sp = val; +++ break; +++ case 1: +++ bp = NULL; +++ break; +++ case 2: +++ (*sp)--; +++ } +++ if(bp != NULL) +++ dirty(bp); +++ return(*sp); +++} +++ +++ +++BUFAREA * +++getblk(bp,blk) +++daddr_t blk; +++register BUFAREA *bp; +++{ +++ register struct filecntl *fcp; +++ +++ if(bp == NULL) { +++ bp = search(blk); +++ fcp = &sfile; +++ } +++ else +++ fcp = &dfile; +++ if(bp->b_bno == blk) +++ return(bp); +++ flush(fcp,bp); +++ if(bread(fcp,bp->b_un.b_buf,blk,BSIZE) != NO) { +++ bp->b_bno = blk; +++ return(bp); +++ } +++ bp->b_bno = (daddr_t)-1; +++ return(NULL); +++} +++ +++ +++flush(fcp,bp) +++struct filecntl *fcp; +++register BUFAREA *bp; +++{ +++ if(bp->b_dirty) { +++ bwrite(fcp,bp->b_un.b_buf,bp->b_bno,BSIZE); +++ } +++ bp->b_dirty = 0; +++} +++ +++ +++rwerr(s,blk) +++char *s; +++daddr_t blk; +++{ +++ if (preen == 0) +++ printf("\n"); +++ pfatal("CAN NOT %s: BLK %ld",s,blk); +++ if(reply("CONTINUE") == NO) +++ errexit("Program terminated\n"); +++} +++ +++ +++sizechk(dp) +++register DINODE *dp; +++{ +++/* +++ if (maxblk != howmany(dp->di_size, BSIZE)) +++ printf("POSSIBLE FILE SIZE ERROR I=%u (%ld,%ld)\n\n", +++ inum, maxblk, howmany(dp->di_size,BSIZE)); +++*/ +++ if(DIR && (dp->di_size % sizeof(DIRECT)) != 0) { +++ pwarn("DIRECTORY MISALIGNED I=%u\n",inum); +++ if (preen == 0) +++ printf("\n"); +++ } +++} +++ +++ +++ckfini() +++{ +++ flush(&dfile,&fileblk); +++ flush(&dfile,&sblk); +++ flush(&dfile,&inoblk); +++ close(dfile.rfdes); +++ close(dfile.wfdes); +++ close(sfile.rfdes); +++ close(sfile.wfdes); +++ if(rmscr) { +++ unlink(scrfile); +++ } +++} +++ +++ +++pinode() +++{ +++ register DINODE *dp; +++ register char *p; +++ char uidbuf[200]; +++ char *ctime(); +++ +++ printf(" I=%u ",inum); +++ if((dp = ginode()) == NULL) +++ return; +++ printf(" OWNER="); +++ if(getpw((int)dp->di_uid,uidbuf) == 0) { +++ for(p = uidbuf; *p != ':'; p++); +++ *p = 0; +++ printf("%s ",uidbuf); +++ } +++ else { +++ printf("%d ",dp->di_uid); +++ } +++ printf("MODE=%o\n",dp->di_mode); +++ if (preen) +++ printf("%s: ", devname); +++ printf("SIZE=%ld ",dp->di_size); +++ p = ctime(&dp->di_mtime); +++ printf("MTIME=%12.12s %4.4s ",p+4,p+20); +++} +++ +++ +++copy(fp,tp,size) +++register char *tp, *fp; +++MEMSIZE size; +++{ +++ while(size--) +++ *tp++ = *fp++; +++} +++ +++ +++freechk() +++{ +++ register daddr_t *ap; +++ +++ if(freeblk.df_nfree == 0) +++ return; +++ do { +++ if(freeblk.df_nfree <= 0 || freeblk.df_nfree > NICFREE) { +++ pfatal("BAD FREEBLK COUNT"); +++ printf("\n"); +++ fixfree = 1; +++ return; +++ } +++ ap = &freeblk.df_free[freeblk.df_nfree]; +++ while(--ap > &freeblk.df_free[0]) { +++ if(pass5(*ap) == STOP) +++ return; +++ } +++ if(*ap == (daddr_t)0 || pass5(*ap) != KEEPON) +++ return; +++ } while(getblk(&fileblk,*ap) != NULL); +++} +++ +++ +++makefree() +++{ +++ register i, cyl, step; +++ int j; +++ char flg[MAXCYL]; +++ short addr[MAXCYL]; +++ daddr_t blk, baseblk; +++ +++ superblk.s_nfree = 0; +++ superblk.s_flock = 0; +++ superblk.s_fmod = 0; +++ superblk.s_tfree = 0; +++ superblk.s_ninode = 0; +++ superblk.s_ilock = 0; +++ superblk.s_ronly = 0; +++ if(cylsize == 0 || stepsize == 0) { +++ step = superblk.s_dinfo[0]; +++ cyl = superblk.s_dinfo[1]; +++ } +++ else { +++ step = stepsize; +++ cyl = cylsize; +++ } +++ if(step > cyl || step <= 0 || cyl <= 0 || cyl > MAXCYL) { +++ error("Default free list spacing assumed\n"); +++ step = STEPSIZE; +++ cyl = CYLSIZE; +++ } +++ superblk.s_dinfo[0] = step; +++ superblk.s_dinfo[1] = cyl; +++ clear(flg,sizeof(flg)); +++ i = 0; +++ for(j = 0; j < cyl; j++) { +++ while(flg[i]) +++ i = (i + 1) % cyl; +++ addr[j] = i + 1; +++ flg[i]++; +++ i = (i + step) % cyl; +++ } +++ baseblk = (daddr_t)roundup(fmax,cyl); +++ clear((char *)&freeblk,BSIZE); +++ freeblk.df_nfree++; +++ for( ; baseblk > 0; baseblk -= cyl) +++ for(i = 0; i < cyl; i++) { +++ blk = baseblk - addr[i]; +++ if(!outrange(blk) && !getbmap(blk)) { +++ superblk.s_tfree++; +++ if(freeblk.df_nfree >= NICFREE) { +++ fbdirty(); +++ fileblk.b_bno = blk; +++ flush(&dfile,&fileblk); +++ clear((char *)&freeblk,BSIZE); +++ } +++ freeblk.df_free[freeblk.df_nfree] = blk; +++ freeblk.df_nfree++; +++ } +++ } +++ superblk.s_nfree = freeblk.df_nfree; +++ for(i = 0; i < NICFREE; i++) +++ superblk.s_free[i] = freeblk.df_free[i]; +++ sbdirty(); +++} +++ +++ +++clear(p,cnt) +++register char *p; +++MEMSIZE cnt; +++{ +++ while(cnt--) +++ *p++ = 0; +++} +++ +++ +++BUFAREA * +++search(blk) +++daddr_t blk; +++{ +++ register BUFAREA *pbp, *bp; +++ +++ for(bp = (BUFAREA *) &poolhead; bp->b_next; ) { +++ pbp = bp; +++ bp = pbp->b_next; +++ if(bp->b_bno == blk) +++ break; +++ } +++ pbp->b_next = bp->b_next; +++ bp->b_next = poolhead; +++ poolhead = bp; +++ return(bp); +++} +++ +++ +++findino(dirp) +++register DIRECT *dirp; +++{ +++ register char *p1, *p2; +++ +++ if(dirp->d_ino == 0) +++ return(KEEPON); +++ for(p1 = dirp->d_name,p2 = srchname;*p2++ == *p1; p1++) { +++ if(*p1 == 0 || p1 == &dirp->d_name[DIRSIZ-1]) { +++ if(dirp->d_ino >= ROOTINO && dirp->d_ino <= imax) +++ parentdir = dirp->d_ino; +++ return(STOP); +++ } +++ } +++ return(KEEPON); +++} +++ +++ +++mkentry(dirp) +++register DIRECT *dirp; +++{ +++ register ino_t in; +++ register char *p; +++ +++ if(dirp->d_ino) +++ return(KEEPON); +++ dirp->d_ino = orphan; +++ in = orphan; +++ p = &dirp->d_name[8]; +++ *--p = 0; +++ while(p > dirp->d_name) { +++ *--p = (in % 10) + '0'; +++ in /= 10; +++ } +++ *p = '#'; +++ return(ALTERD|STOP); +++} +++ +++ +++chgdd(dirp) +++register DIRECT *dirp; +++{ +++ if(dirp->d_name[0] == '.' && dirp->d_name[1] == '.' && +++ dirp->d_name[2] == 0) { +++ dirp->d_ino = lfdir; +++ return(ALTERD|STOP); +++ } +++ return(KEEPON); +++} +++ +++ +++linkup() +++{ +++ register DINODE *dp; +++ register lostdir; +++ register ino_t pdir; +++ +++ if((dp = ginode()) == NULL) +++ return(NO); +++ lostdir = DIR; +++ pdir = parentdir; +++ pwarn("UNREF %s ",lostdir ? "DIR" : "FILE"); +++ pinode(); +++ if (preen && dp->di_size == 0) +++ return(NO); +++ if (preen) +++ printf(" (RECONNECTED)\n"); +++ else +++ if (reply("RECONNECT") == NO) +++ return(NO); +++ orphan = inum; +++ if(lfdir == 0) { +++ inum = ROOTINO; +++ if((dp = ginode()) == NULL) { +++ inum = orphan; +++ return(NO); +++ } +++ pfunc = findino; +++ srchname = lfname; +++ filsize = dp->di_size; +++ parentdir = 0; +++ ckinode(dp,DATA); +++ inum = orphan; +++ if((lfdir = parentdir) == 0) { +++ pfatal("SORRY. NO lost+found DIRECTORY"); +++ printf("\n\n"); +++ return(NO); +++ } +++ } +++ inum = lfdir; +++ if((dp = ginode()) == NULL || !DIR || getstate() != FSTATE) { +++ inum = orphan; +++ pfatal("SORRY. NO lost+found DIRECTORY"); +++ printf("\n\n"); +++ return(NO); +++ } +++ if(dp->di_size & BMASK) { +++ dp->di_size = roundup(dp->di_size,BSIZE); +++ inodirty(); +++ } +++ filsize = dp->di_size; +++ inum = orphan; +++ pfunc = mkentry; +++ if((ckinode(dp,DATA) & ALTERD) == 0) { +++ pfatal("SORRY. NO SPACE IN lost+found DIRECTORY"); +++ printf("\n\n"); +++ return(NO); +++ } +++ declncnt(); +++ if(lostdir) { +++ pfunc = chgdd; +++ dp = ginode(); +++ filsize = dp->di_size; +++ ckinode(dp,DATA); +++ inum = lfdir; +++ if((dp = ginode()) != NULL) { +++ dp->di_nlink++; +++ inodirty(); +++ setlncnt(getlncnt()+1); +++ } +++ inum = orphan; +++ pwarn("DIR I=%u CONNECTED. ",orphan); +++ printf("PARENT WAS I=%u\n",pdir); +++ if (preen == 0) +++ printf("\n"); +++ } +++ return(YES); +++} +++ +++ +++bread(fcp,buf,blk,size) +++daddr_t blk; +++register struct filecntl *fcp; +++register size; +++char *buf; +++{ +++ if(lseek(fcp->rfdes,blk<rfdes,buf,size) == size) +++ return(YES); +++ rwerr("READ",blk); +++ return(NO); +++} +++ +++ +++bwrite(fcp,buf,blk,size) +++daddr_t blk; +++register struct filecntl *fcp; +++register size; +++char *buf; +++{ +++ if(fcp->wfdes < 0) +++ return(NO); +++ if(lseek(fcp->wfdes,blk<wfdes,buf,size) == size) { +++ fcp->mod = 1; +++ return(YES); +++ } +++ rwerr("WRITE",blk); +++ return(NO); +++} +++ +++catch() +++{ +++ ckfini(); +++ exit(12); +++} +++ +++ustat(x, s) +++char *s; +++{ +++ return(-1); +++} diff --cc usr/src/cmd/getNAME.c index 0000000000,32bd5f0328,0000000000..dea5afd7b6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/getNAME.c +++ b/usr/src/cmd/getNAME.c @@@@ -1,0 -1,98 -1,0 +1,99 @@@@ +++static char *sccsid = "@(#)getNAME.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +int tocrc; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + + + argc--, argv++; + + if (!strcmp(argv[0], "-t")) + + argc--, argv++, tocrc++; + + while (argc > 0) + + getfrom(*argv++), argc--; + + exit(0); + +} + + + +getfrom(name) + + char *name; + +{ + + char headbuf[BUFSIZ]; + + char linbuf[BUFSIZ]; + + register char *cp; + + int i = 0; + + + + if (freopen(name, "r", stdin) == 0) { + + perror(name); + + exit(1); + + } + + for (;;) { + + if (fgets(headbuf, sizeof headbuf, stdin) == NULL) + + return; + + if (headbuf[0] != '.') + + continue; + + if (headbuf[1] == 'T' && headbuf[2] == 'H') + + break; + + if (headbuf[1] == 't' && headbuf[2] == 'h') + + break; + + } + + for (;;) { + + if (fgets(linbuf, sizeof linbuf, stdin) == NULL) + + return; + + if (linbuf[0] != '.') + + continue; + + if (linbuf[1] == 'S' && linbuf[2] == 'H') + + break; + + if (linbuf[1] == 's' && linbuf[2] == 'h') + + break; + + } + + trimln(headbuf); + + if (tocrc) { + + register char *dp = name, *ep; + + + +again: + + while (*dp && *dp != '.') + + putchar(*dp++); + + if (*dp) + + for (ep = dp+1; *ep; ep++) + + if (*ep == '.') { + + putchar(*dp++); + + goto again; + + } + + putchar('('); + + if (*dp) + + dp++; + + while (*dp) + + putchar (*dp++); + + putchar(')'); + + putchar(' '); + + } + + printf("%s\t", headbuf); + + for (;;) { + + if (fgets(linbuf, sizeof linbuf, stdin) == NULL) + + break; + + if (linbuf[0] == '.') { + + if (linbuf[1] == 'S' && linbuf[2] == 'H') + + break; + + if (linbuf[1] == 's' && linbuf[2] == 'h') + + break; + + } + + trimln(linbuf); + + if (i != 0) + + printf(" "); + + i++; + + printf("%s", linbuf); + + } + + printf("\n"); + +} + + + +trimln(cp) + + register char *cp; + +{ + + + + while (*cp) + + cp++; + + if (*--cp == '\n') + + *cp = 0; + +} diff --cc usr/src/cmd/gets.c index 0000000000,4572515fc4,0000000000..a4e3eab8c2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/gets.c +++ b/usr/src/cmd/gets.c @@@@ -1,0 -1,23 -1,0 +1,24 @@@@ +++static char *sccsid = "@(#)gets.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +/* + + * gets [ default ] + + * + + * read a line from standard input, echoing to std output + + * if an error occurs just return "default" + + * if no default and error exit abnormally + + */ + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + char buf[BUFSIZ]; + + + + if (gets(buf) == NULL || buf[0] < ' ') { + + if (argc == 1) + + exit(1); + + strcpy(buf,argv[1]); + + } + + printf("%s\n", buf); + + exit(0); + +} diff --cc usr/src/cmd/getty.c index 0000000000,0000000000,0000000000..832c89aa6f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/getty.c @@@@ -1,0 -1,0 -1,0 +1,285 @@@@ +++static char *sccsid = "@(#)getty.c 4.1 (Berkeley) 10/1/80"; +++/* +++ * getty -- adapt to terminal speed on dialup, and call login +++ */ +++ +++#include +++#include +++#include +++ +++#define ERASE '#' +++#define KILL '@' +++ +++#define CEOT 004 +++#define CKILL '@' +++#define CQUIT 034 /* FS, cntl shift L */ +++#define CINTR 0177 /* DEL */ +++#define CSTOP 023 /* Stop output: ctl-s */ +++#define CSTART 021 /* Start output: ctl-q */ +++#define CBRK 0377 +++ +++ +++struct sgttyb tmode; +++ +++struct tab { +++ char tname; /* this table name */ +++ char nname; /* successor table name */ +++ int iflags; /* initial flags */ +++ int fflags; /* final flags */ +++ int ispeed; /* input speed */ +++ int ospeed; /* output speed */ +++ char *message; /* login message */ +++} itab[] = { +++ +++/* table '0'-1-2-3 300,1200,150,110 */ +++ +++ '0', 1, +++ ANYP+RAW+NL1+CR1, ANYP+XTABS+ECHO+CRMOD+CR2, +++ B300, B300, +++ "\n\rlogin: ", +++ +++ 1, 2, +++ ANYP+RAW+NL1+CR1, ANYP+XTABS+ECHO+CRMOD+FF1, +++ B1200, B1200, +++ "\n\rlogin: ", +++ +++ 2, 3, +++ ANYP+RAW+NL1+CR1, EVENP+ECHO+FF1+CR2+TAB1+NL1, +++ B150, B150, +++ "\n\rlogin: ", +++ +++ 3, '0', +++ ANYP+RAW+NL1+CR1, ANYP+ECHO+CRMOD+XTABS+LCASE+CR1, +++ B110, B110, +++ "\n\rlogin: ", +++ +++/* table '-' -- Console TTY 110 */ +++ '-', '-', +++ ANYP+RAW+NL1+CR1, ANYP+ECHO+CRMOD+XTABS+LCASE+CR1, +++ B110, B110, +++ "\n\rlogin: ", +++ +++/* table '1' -- 150 */ +++ '1', '1', +++ ANYP+RAW+NL1+CR1, EVENP+ECHO+FF1+CR2+TAB1+NL1, +++ B150, B150, +++ "\n\r\033:\006\006\017login: ", +++ +++/* table '2' -- 9600 */ +++ '2', '2', +++ ANYP+RAW+NL1+CR1, ANYP+XTABS+ECHO+CRMOD, +++ B9600, B9600, +++ "\n\rlogin: ", +++ +++/* table '3'-'5' -- 1200,300 */ +++ '3', '5', +++ ANYP+RAW+NL1+CR1, ANYP+XTABS+ECHO+CRMOD+FF1, +++ B1200, B1200, +++ "\n\rlogin: ", +++ +++/* table '5'-'3' -- 300,1200 */ +++ '5', '3', +++ ANYP+RAW+NL1+CR1, ANYP+ECHO+CR1, +++ B300, B300, +++ "\n\rlogin: ", +++ +++/* table '4' -- Console Decwriter */ +++ '4', '4', +++ ANYP+RAW, ANYP+ECHO+CRMOD+XTABS, +++ B300, B300, +++ "\n\rlogin: ", +++ +++/* table '6' -- 2400 */ +++ '6', '6' , +++ ANYP+RAW , ANYP+ECHO+CRMOD , +++ B2400 , B2400 , +++ "\n\rlogin: ", +++ +++/* table '7' - - 4800 */ +++ '7' , '7' , +++ ANYP+RAW , ANYP+ECHO+CRMOD , +++ B4800 , B4800 , +++ "\n\rlogin: " , +++ +++/* table '8'-'9' - - 9600 - 300 */ +++ '8', '9', +++ ANYP+RAW+NL1+CR1, ANYP+XTABS+ECHO+CRMOD, +++ B9600, B9600, +++ "\n\rlogin: ", +++ +++ '9', '8', +++ ANYP+RAW+NL1+CR2, ANYP+XTABS+ECHO+CRMOD+CR2, +++ B300, B300, +++ "\n\rlogin: ", +++ +++/* table 'i' -- Interdata Console */ +++ 'i', 'i', +++ RAW+CRMOD, CRMOD+ECHO+LCASE, +++ 0, 0, +++ "\n\rlogin: ", +++ +++/* table 'l' -- LSI Chess Terminal */ +++ 'l', 'l', +++ ANYP+RAW/*+HUPCL*/, ANYP+ECHO/*+HUPCL*/, +++ B300, B300, +++ "*", +++}; +++ +++#define NITAB sizeof itab/sizeof itab[0] +++#define EOT 04 /* EOT char */ +++ +++char name[16]; +++int crmod; +++int upper; +++int lower; +++ +++char partab[] = { +++ 0001,0201,0201,0001,0201,0001,0001,0201, +++ 0202,0004,0003,0205,0005,0206,0201,0001, +++ 0201,0001,0001,0201,0001,0201,0201,0001, +++ 0001,0201,0201,0001,0201,0001,0001,0201, +++ 0200,0000,0000,0200,0000,0200,0200,0000, +++ 0000,0200,0200,0000,0200,0000,0000,0200, +++ 0000,0200,0200,0000,0200,0000,0000,0200, +++ 0200,0000,0000,0200,0000,0200,0200,0000, +++ 0200,0000,0000,0200,0000,0200,0200,0000, +++ 0000,0200,0200,0000,0200,0000,0000,0200, +++ 0000,0200,0200,0000,0200,0000,0000,0200, +++ 0200,0000,0000,0200,0000,0200,0200,0000, +++ 0000,0200,0200,0000,0200,0000,0000,0200, +++ 0200,0000,0000,0200,0000,0200,0200,0000, +++ 0200,0000,0000,0200,0000,0200,0200,0000, +++ 0000,0200,0200,0000,0200,0000,0000,0201 +++}; +++ +++main(argc, argv) +++char **argv; +++{ +++ register struct tab *tabp; +++ char tname; +++ struct tchars tc; +++ +++/* +++ signal(SIGINT, 1); +++ signal(SIGQUIT, 0); +++*/ +++ tname = '0'; +++ if (argc > 1) +++ tname = argv[1][0]; +++ for (;;) { +++ int ldisp = 0; +++ for(tabp = itab; tabp < &itab[NITAB]; tabp++) +++ if(tabp->tname == tname) +++ break; +++ if(tabp >= &itab[NITAB]) +++ tabp = itab; +++ tmode.sg_ispeed = tabp->ispeed; +++ tmode.sg_ospeed = tabp->ospeed; +++ tmode.sg_flags = tabp->iflags; +++ tmode.sg_ispeed = tabp->ispeed; +++ tmode.sg_ospeed = tabp->ospeed; +++ stty(0, &tmode); +++ tc.t_intrc = CINTR; +++ tc.t_quitc = CQUIT; +++ tc.t_stopc = CSTOP; +++ tc.t_startc = CSTART; +++ tc.t_brkc = CBRK; +++ tc.t_eofc = CEOT; +++ ioctl(0, TIOCSETC, &tc); +++ ioctl(0, TIOCSETD, &ldisp); +++ if (tmode.sg_ospeed > B1200) +++ puts("\n\r\n\r"); +++ else +++ puts("\n\r\r\r\r\r\n\r\r\r\r\r"); +++ puts("Virtual "); +++ puts(myname); +++ puts("\n\r\r\r\r"); +++ puts(tabp->message); +++ /* +++ * Wait a while, then flush input to get rid +++ * of noise from open lines +++ */ +++ sleep(1); +++ stty(0, &tmode); +++ if(getname()) { +++ if (upper == 0 && lower == 0) +++ continue; +++ tmode.sg_erase = ERASE; +++ tmode.sg_kill = KILL; +++ tmode.sg_flags = tabp->fflags; +++ if(crmod) +++ tmode.sg_flags |= CRMOD; +++ if(upper) +++ tmode.sg_flags |= LCASE; +++ if(lower) +++ tmode.sg_flags &= ~LCASE; +++ stty(0, &tmode); +++ putchr('\n'); +++ execl("/bin/login", "login", name, 0); +++ exit(1); +++ } +++ tname = tabp->nname; +++ } +++} +++ +++getname() +++{ +++ register char *np; +++ register c; +++ char cs; +++ +++ crmod = 0; +++ upper = 0; +++ lower = 0; +++ np = name; +++ for (;;) { +++ if (read(0, &cs, 1) <= 0) +++ exit(0); +++ if ((c = cs&0177) == 0) +++ return(0); +++ if (c==EOT) +++ exit(1); +++ if (c=='\r' || c=='\n' || np >= &name[16]) +++ break; +++ putchr(cs); +++ if (c>='a' && c <='z') +++ lower++; +++ else if (c>='A' && c<='Z') { +++ upper++; +++ c += 'a'-'A'; +++ } else if (c==ERASE) { +++ if (np > name) +++ np--; +++ continue; +++ } else if (c==KILL) { +++ putchr('\r'); +++ putchr('\n'); +++ np = name; +++ continue; +++ } else if(c == ' ') +++ c = '_'; +++ *np++ = c; +++ } +++ *np = 0; +++ if (c == '\r') +++ crmod++; +++ return(1); +++} +++ +++puts(as) +++char *as; +++{ +++ register char *s; +++ +++ s = as; +++ while (*s) +++ putchr(*s++); +++} +++ +++putchr(cc) +++{ +++ char c; +++ c = cc; +++ c |= partab[c&0177] & 0200; +++ write(1, &c, 1); +++} diff --cc usr/src/cmd/halt.c index 0000000000,0000000000,0000000000..6082a9cc1f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/halt.c @@@@ -1,0 -1,0 -1,0 +1,34 @@@@ +++static char *sccsid = "@(#)halt.c 4.2 (Berkeley) 11/10/80"; +++/* +++ * Halt +++ */ +++#include +++#include +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ int howto; +++ char *ttyn = (char *)ttyname(2); +++ +++ howto = RB_HALT; +++ argc--, argv++; +++ while (argc > 0) { +++ if (!strcmp(*argv, "-n")) +++ howto |= RB_NOSYNC; +++ else if (!strcmp(*argv, "-y")) +++ ttyn = 0; +++ else { +++ fprintf(stderr, "usage: halt [ -n ]\n"); +++ exit(1); +++ } +++ argc--, argv++; +++ } +++ if (ttyn && *(ttyn+strlen("/dev/tty")) == 'd') { +++ fprintf(stderr, "halt: dangerous on a dialup; use ``halt -y'' if you are really sure\n"); +++ exit(1); +++ } +++ syscall(55, howto); +++ perror("reboot"); +++} diff --cc usr/src/cmd/head.c index 0000000000,cc52c61355,0000000000..31171ea1cf mode 000000,100644,000000..100644 --- a/usr/src/cmd/head.c +++ b/usr/src/cmd/head.c @@@@ -1,0 -1,76 -1,0 +1,77 @@@@ +++static char *sccsid = "@(#)head.c 4.1 (Berkeley) 10/1/80"; + +#include + +/* + + * head - give the first few lines of a stream or of each of a set of files + + * + + * Bill Joy UCB August 24, 1977 + + */ + + + +int linecnt = 10; + +int argc; + + + +main(Argc, argv) + + int Argc; + + char *argv[]; + +{ + + register int argc; + + char *name; + + register char *argp; + + static int around; + + char obuf[BUFSIZ]; + + + + setbuf(stdout, obuf); + + Argc--, argv++; + + argc = Argc; + + do { + + while (argc > 0 && argv[0][0] == '-') { + + linecnt = getnum(argv[0] + 1); + + argc--, argv++, Argc--; + + } + + if (argc == 0 && around) + + break; + + if (argc > 0) { + + close(0); + + if (freopen(argv[0], "r", stdin) == NULL) { + + perror(argv[0]); + + exit(1); + + } + + name = argv[0]; + + argc--, argv++; + + } else + + name = 0; + + if (around) + + putchar('\n'); + + around++; + + if (Argc > 1 && name) + + printf("==> %s <==\n", name); + + copyout(linecnt); + + fflush(stdout); + + } while (argc > 0); + +} + + + +copyout(cnt) + + register int cnt; + +{ + + register int c; + + char lbuf[BUFSIZ]; + + + + while (cnt > 0 && fgets(lbuf, sizeof lbuf, stdin) != 0) { + + printf("%s", lbuf); + + fflush(stdout); + + cnt--; + + } + +} + + + +getnum(cp) + + register char *cp; + +{ + + register int i; + + + + for (i = 0; *cp >= '0' && *cp <= '9'; cp++) + + i *= 10, i += *cp - '0'; + + if (*cp) { + + fprintf(stderr, "Badly formed number\n"); + + exit(1); + + } + + return (i); + +} diff --cc usr/src/cmd/icheck.c index 0000000000,6c1b632af0,0000000000..ca478acac1 mode 000000,100644,000000..100644 --- a/usr/src/cmd/icheck.c +++ b/usr/src/cmd/icheck.c @@@@ -1,0 -1,475 -1,0 +1,476 @@@@ +++static char *sccsid = "@(#)icheck.c 4.1 (Berkeley) 10/1/80"; + +#define NI 16 - #define NB 10 +++#define NB 500 + +#define BITS 8 + +#define MAXFN 500 + + + +#ifndef STANDALONE + +#include + +#endif + +#include + +#include + +#include + +#include + +#include + + + +struct filsys sblock; + +struct dinode itab[INOPB*NI]; + +daddr_t iaddr[NADDR]; + +daddr_t blist[NB]; + +char *bmap; + + + +int sflg; + +int mflg; + +int dflg; + +int fi; + +ino_t ino; + + + +ino_t nrfile; + +ino_t ndfile; + +ino_t nbfile; + +ino_t ncfile; + + + +daddr_t ndirect; + +daddr_t nindir; + +daddr_t niindir; + +daddr_t niiindir; + +daddr_t nfree; + +daddr_t ndup; + + + +int nerror; + + + +long atol(); + +daddr_t alloc(); + +#ifndef STANDALONE + +char *malloc(); + +#endif + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + long n; + + + + blist[0] = -1; + +#ifndef STANDALONE + + while (--argc) { + + argv++; + + if (**argv=='-') + + switch ((*argv)[1]) { + + case 'd': + + dflg++; + + continue; + + + + + + case 'm': + + mflg++; + + continue; + + + + case 's': + + sflg++; + + continue; + + + + case 'b': + + for(i=0; i= mino) + + break; + + bread((daddr_t)i, (char *)itab, sizeof(itab)); + + for(j=0; j= mino) + + break; + + ino++; + + pass1(&itab[j]); + + } + + } + + ino = 0; + +#ifndef STANDALONE + + sync(); + +#endif + + bread((daddr_t)1, (char *)&sblock, sizeof(sblock)); + + if (sflg) { + + makefree(); + + close(fi); + +#ifndef STANDALONE + + if (bmap) + + free(bmap); + +#endif + + return; + + } + + nfree = 0; + + while(n = alloc()) { + + if (chk(n, "free")) + + break; + + nfree++; + + } + + close(fi); + +#ifndef STANDALONE + + if (bmap) + + free(bmap); + +#endif + + + + i = nrfile + ndfile + ncfile + nbfile; + +#ifndef STANDALONE + + printf("files %6u (r=%u,d=%u,b=%u,c=%u)\n", + + i, nrfile, ndfile, nbfile, ncfile); + +#else + + printf("files %u (r=%u,d=%u,b=%u,c=%u)\n", + + i, nrfile, ndfile, nbfile, ncfile); + +#endif - n = ndirect + nindir + niindir + niindir; +++ n = ndirect + nindir + niindir + niiindir; + +#ifdef STANDALONE + + printf("used %ld (i=%ld,ii=%ld,iii=%ld,d=%ld)\n", + + n, nindir, niindir, niiindir, ndirect); + + printf("free %ld\n", nfree); + +#else + + printf("used %7ld (i=%ld,ii=%ld,iii=%ld,d=%ld)\n", + + n, nindir, niindir, niiindir, ndirect); + + printf("free %7ld\n", nfree); + +#endif + + if(!dflg) { + + n = 0; + + for(d=(int)sblock.s_isize; ddi_mode & IFMT; + + if(i == 0) { + + sblock.s_tinode++; + + return; + + } + + if(i == IFCHR) { + + ncfile++; + + return; + + } + + if(i == IFBLK) { + + nbfile++; + + return; + + } + + if(i == IFDIR) + + ndfile++; else + + if(i == IFREG) + + nrfile++; + + else { + + printf("bad mode %u\n", ino); + + return; + + } + + l3tol(iaddr, ip->di_addr, NADDR); + + for(i=0; i=sblock.s_fsize) { + + printf("%ld bad; inode=%u, class=%s\n", bno, ino, s); + + return(1); + + } + + if(duped(bno)) { + + printf("%ld dup; inode=%u, class=%s\n", bno, ino, s); + + ndup++; + + } + + for (n=0; blist[n] != -1; n++) + + if (bno == blist[n]) + + printf("%ld arg; inode=%u, class=%s\n", bno, ino, s); + + return(0); + +} + + + +duped(bno) + +daddr_t bno; + +{ + + daddr_t d; + + register m, n; + + + + if(dflg) + + return(0); + + d = bno - (int)sblock.s_isize; + + m = 1 << (d%BITS); + + n = (d/BITS); + + if(bmap[n] & m) + + return(1); + + bmap[n] |= m; + + return(0); + +} + + + +daddr_t + +alloc() + +{ + + int i; + + daddr_t bno; + + union { + + char data[BSIZE]; + + struct fblk fb; + + } buf; + + + + sblock.s_tfree--; + + if (sblock.s_nfree<=0) + + return(0); + + if (sblock.s_nfree>NICFREE) { + + printf("Bad free list, s.b. count = %d\n", sblock.s_nfree); + + return(0); + + } + + bno = sblock.s_free[--sblock.s_nfree]; + + sblock.s_free[sblock.s_nfree] = (daddr_t)0; + + if(bno == 0) + + return(bno); + + if(sblock.s_nfree <= 0) { + + bread(bno, buf.data, BSIZE); + + sblock.s_nfree = buf.df_nfree; + + if (sblock.s_nfree<0 || sblock.s_nfree>NICFREE) { + + printf("Bad free list, entry count of block %ld = %d\n", + + bno, sblock.s_nfree); + + sblock.s_nfree = 0; + + return(0); + + } + + for(i=0; i= NICFREE) { + + for(i=0; i MAXFN) + + n = MAXFN; + + sblock.s_n = n; + + m = sblock.s_m; + + if(m <= 0 || m > sblock.s_n) + + m = 3; + + sblock.s_m = m; + + + + for(i=0; i 0; d -= sblock.s_n) + + for(i=0; i= (int)sblock.s_isize) + + if(!duped(f)) + + bfree(f); + + } + + bwrite((daddr_t)1, (char *)&sblock); + +#ifndef STANDALONE + + sync(); + +#endif + + return; + +} diff --cc usr/src/cmd/init.c index 0000000000,0000000000,0000000000..f5da57940b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/init.c @@@@ -1,0 -1,0 -1,0 +1,373 @@@@ +++static char *sccsid = "@(#)init.c 4.3 (Berkeley) 10/13/80"; +++#include +++#include +++#include +++#include +++#include +++ +++#define LINSIZ sizeof(wtmp.ut_line) +++#define TABSIZ 100 +++#define ALL p = &itab[0]; p < &itab[TABSIZ]; p++ +++#define EVER ;; +++#define SCPYN(a, b) strncpy(a, b, sizeof(a)) +++#define SCMPN(a, b) strncmp(a, b, sizeof(a)) +++ +++char shell[] = "/bin/sh"; +++char getty[] = "/etc/getty"; +++char minus[] = "-"; +++char runc[] = "/etc/rc"; +++char ifile[] = "/etc/ttys"; +++char utmp[] = "/etc/utmp"; +++char wtmpf[] = "/usr/adm/wtmp"; +++char ctty[] = "/dev/console"; +++char dev[] = "/dev/"; +++ +++struct utmp wtmp; +++struct +++{ +++ char line[LINSIZ]; +++ char comn; +++ char flag; +++} line; +++struct tab +++{ +++ char line[LINSIZ]; +++ char comn; +++ char xflag; +++ int pid; +++} itab[TABSIZ]; +++ +++int fi; +++int mergflag; +++char tty[20]; +++jmp_buf sjbuf, shutpass; +++ +++int reset(); +++char *strcpy(), *strcat(); +++long lseek(); +++ +++main() +++{ +++ register int r11; /* passed thru from boot */ +++ int howto, oldhowto; +++ +++ howto = r11; +++ setjmp(sjbuf); +++ signal(SIGTERM, reset); +++ signal(SIGSTOP, SIG_IGN); +++ signal(SIGTSTP, SIG_IGN); +++ signal(SIGTTIN, SIG_IGN); +++ signal(SIGTTOU, SIG_IGN); +++ for(EVER) { +++ oldhowto = howto; +++ howto = RB_SINGLE; +++ if (setjmp(shutpass) == 0) +++ shutdown(); +++ if (oldhowto & RB_SINGLE) +++ single(); +++ if (runcom(oldhowto) == 0) +++ continue; +++ merge(); +++ multiple(); +++ } +++} +++ +++int shutreset(); +++ +++shutdown() +++{ +++ register i; +++ register struct tab *p; +++ +++ close(creat(utmp, 0644)); +++ signal(SIGHUP, SIG_IGN); +++ for(ALL) { +++ term(p); +++ p->line[0] = 0; +++ } +++ signal(SIGALRM, shutreset); +++ alarm(30); +++ for(i=0; i<5; i++) +++ kill(-1, SIGKILL); +++ while(wait((int *)0) != -1) +++ ; +++ alarm(0); +++ shutend(); +++} +++ +++char shutfailm[] = "WARNING: Something is hung (wont die); ps axl advised\n"; +++ +++shutreset() +++{ +++ int status; +++ +++ if (fork() == 0) { +++ int ct = open(ctty, 1); +++ write(ct, shutfailm, sizeof (shutfailm)); +++ sleep(5); +++ exit(1); +++ } +++ sleep(5); +++ shutend(); +++ longjmp(shutpass, 1); +++} +++ +++shutend() +++{ +++ register i; +++ +++ signal(SIGALRM, SIG_DFL); +++ for(i=0; i<10; i++) +++ close(i); +++} +++ +++single() +++{ +++ register pid; +++ +++ pid = fork(); +++ if(pid == 0) { +++/* +++ alarm(300); +++*/ +++ signal(SIGTERM, SIG_DFL); +++ signal(SIGHUP, SIG_DFL); +++ signal(SIGALRM, SIG_DFL); +++ open(ctty, 2); +++ dup(0); +++ dup(0); +++ execl(shell, minus, (char *)0); +++ exit(0); +++ } +++ while(wait((int *)0) != pid) +++ ; +++} +++ +++runcom(oldhowto) +++ int oldhowto; +++{ +++ register pid, f; +++ int status; +++ +++ pid = fork(); +++ if(pid == 0) { +++ open("/", 0); +++ dup(0); +++ dup(0); +++ if (oldhowto & RB_SINGLE) +++ execl(shell, shell, runc, (char *)0); +++ else +++ execl(shell, shell, runc, "autoboot", (char *)0); +++ exit(1); +++ } +++ while(wait(&status) != pid) +++ ; +++ if(status) +++ return(0); +++ f = open(wtmpf, 1); +++ if (f >= 0) { +++ lseek(f, 0L, 2); +++ SCPYN(wtmp.ut_line, "~"); +++ SCPYN(wtmp.ut_name, "reboot"); +++ time(&wtmp.ut_time); +++ write(f, (char *)&wtmp, sizeof(wtmp)); +++ close(f); +++ } +++ return(1); +++} +++ +++setmerge() +++{ +++ +++ signal(SIGHUP, setmerge); +++ mergflag = 1; +++} +++ +++multiple() +++{ +++ register struct tab *p; +++ register pid; +++ +++loop: +++ mergflag = 0; +++ signal(SIGHUP, setmerge); +++ for(EVER) { +++ pid = wait((int *)0); +++ if(mergflag) { +++ merge(); +++ goto loop; +++ } +++ if(pid == -1) +++ return; +++ for(ALL) +++ if(p->pid == pid || p->pid == -1) { +++ rmut(p); +++ dfork(p); +++ } +++ } +++} +++ +++term(p) +++register struct tab *p; +++{ +++ +++ if(p->pid != 0) { +++ rmut(p); +++ kill(p->pid, SIGKILL); +++ } +++ p->pid = 0; +++} +++ +++rline() +++{ +++ register c, i; +++ +++loop: +++ c = get(); +++ if(c < 0) +++ return(0); +++ if(c == 0) +++ goto loop; +++ line.flag = c; +++ c = get(); +++ if(c <= 0) +++ goto loop; +++ line.comn = c; +++ SCPYN(line.line, ""); +++ for (i=0; i 0) +++ c = get(); +++ if(line.line[0] == 0) +++ goto loop; +++ if(line.flag == '0') +++ goto loop; +++ strcpy(tty, dev); +++ strncat(tty, line.line, LINSIZ); +++ if(access(tty, 06) < 0) +++ goto loop; +++ return(1); +++} +++ +++get() +++{ +++ char b; +++ +++ if(read(fi, &b, 1) != 1) +++ return(-1); +++ if(b == '\n') +++ return(0); +++ return(b); +++} +++ +++#define FOUND 1 +++#define CHANGE 2 +++ +++merge() +++{ +++ register struct tab *p; +++ +++ fi = open(ifile, 0); +++ if(fi < 0) +++ return; +++ for(ALL) +++ p->xflag = 0; +++ while(rline()) { +++ for(ALL) { +++ if (SCMPN(p->line, line.line)) +++ continue; +++ p->xflag |= FOUND; +++ if(line.comn != p->comn) { +++ p->xflag |= CHANGE; +++ p->comn = line.comn; +++ } +++ goto contin1; +++ } +++ for(ALL) { +++ if(p->line[0] != 0) +++ continue; +++ SCPYN(p->line, line.line); +++ p->xflag |= FOUND|CHANGE; +++ p->comn = line.comn; +++ goto contin1; +++ } +++ contin1: +++ ; +++ } +++ close(fi); +++ for(ALL) { +++ if((p->xflag&FOUND) == 0) { +++ term(p); +++ p->line[0] = 0; +++ } +++ if((p->xflag&CHANGE) != 0) { +++ term(p); +++ dfork(p); +++ } +++ } +++} +++ +++dfork(p) +++struct tab *p; +++{ +++ register pid; +++ +++ pid = fork(); +++ if(pid == 0) { +++ signal(SIGTERM, SIG_DFL); +++ signal(SIGHUP, SIG_IGN); +++ strcpy(tty, dev); +++ strncat(tty, p->line, LINSIZ); +++ chown(tty, 0, 0); +++ chmod(tty, 0622); +++ open(tty, 2); +++ vhangup(); +++ signal(SIGHUP, SIG_DFL); +++ open(tty, 2); +++ close(0); +++ dup(1); +++ dup(0); +++ tty[0] = p->comn; +++ tty[1] = 0; +++ execl(getty, minus, tty, (char *)0); +++ exit(0); +++ } +++ p->pid = pid; +++} +++ +++rmut(p) +++register struct tab *p; +++{ +++ register f; +++ +++ f = open(utmp, 2); +++ if(f >= 0) { +++ while(read(f, (char *)&wtmp, sizeof(wtmp)) == sizeof(wtmp)) { +++ if (SCMPN(wtmp.ut_line, p->line)) +++ continue; +++ lseek(f, -(long)sizeof(wtmp), 1); +++ SCPYN(wtmp.ut_name, ""); +++ time(&wtmp.ut_time); +++ write(f, (char *)&wtmp, sizeof(wtmp)); +++ } +++ close(f); +++ } +++ f = open(wtmpf, 1); +++ if (f >= 0) { +++ SCPYN(wtmp.ut_line, p->line); +++ SCPYN(wtmp.ut_name, ""); +++ time(&wtmp.ut_time); +++ lseek(f, (long)0, 2); +++ write(f, (char *)&wtmp, sizeof(wtmp)); +++ close(f); +++ } +++} +++ +++reset() +++{ +++ longjmp(sjbuf, 1); +++} diff --cc usr/src/cmd/iostat.c index 0000000000,31ad101140,0000000000..79579edf0e mode 000000,100644,000000..100644 --- a/usr/src/cmd/iostat.c +++ b/usr/src/cmd/iostat.c @@@@ -1,0 -1,303 -1,0 +1,179 @@@@ - int bflg; - int dflg; - int tflg = 1; - int iflg; - int aflg; - int sflg; - struct - { - char name[8]; - int type; - unsigned value; - } nl[] = { - "_dk_busy", 0, 0, - "_dk_time", 0, 0, - "_dk_numb", 0, 0, - "_dk_wds", 0, 0, - "_tk_nin", 0, 0, - "_tk_nout", 0, 0, - "_io_info", 0, 0, - "\0\0\0\0\0\0\0\0", 0, 0 +++static char *sccsid = "@(#)iostat.c 4.2 (Berkeley) 10/19/80"; +++/* +++ * iostat +++ */ +++#include +++#include +++ +++struct nlist nl[] = { +++ { "_dk_busy" }, +++#define X_DK_BUSY 0 +++ { "_dk_time" }, +++#define X_DK_TIME 1 +++ { "_dk_xfer" }, +++#define X_DK_XFER 2 +++ { "_dk_wds" }, +++#define X_DK_WDS 3 +++ { "_tk_nin" }, +++#define X_TK_NIN 4 +++ { "_tk_nout" }, +++#define X_TK_NOUT 5 +++ { "_dk_seek" }, +++#define X_DK_SEEK 6 +++ { "_cp_time" }, +++#define X_CP_TIME 7 +++ { "_dk_mspw" }, +++#define X_DK_MSPW 8 +++ { 0 }, + +}; + +struct + +{ - int busy; - long etime[32]; - long numb[3]; - long wds[3]; - long tin; - long tout; +++ int dk_busy; +++ long cp_time[CPUSTATES]; +++ long dk_time[DK_NDRIVE]; +++ long dk_wds[DK_NDRIVE]; +++ long dk_seek[DK_NDRIVE]; +++ long dk_xfer[DK_NDRIVE]; +++ float dk_mspw[DK_NDRIVE]; +++ long tk_nin; +++ long tk_nout; + +} s, s1; + + - struct iostat { - int nbuf; - long nread; - long nreada; - long ncache; - long nwrite; - long bufcount[50]; - } io_info, io_delta; - double etime; - + +int mf; +++double etime; + + + +main(argc, argv) + +char *argv[]; + +{ + + extern char *ctime(); + + register i; + + int iter; + + double f1, f2; + + long t; +++ int tohdr = 1; + + + + nlist("/vmunix", nl); - if(nl[0].type == -1) { +++ if(nl[X_DK_BUSY].n_type == 0) { + + printf("dk_busy not found in /vmunix namelist\n"); + + exit(1); + + } + + mf = open("/dev/kmem", 0); + + if(mf < 0) { + + printf("cannot open /dev/kmem\n"); + + exit(1); + + } + + iter = 0; + + while (argc>1&&argv[1][0]=='-') { - if (argv[1][1]=='d') - dflg++; - else if (argv[1][1]=='s') - sflg++; - else if (argv[1][1]=='a') - aflg++; - else if (argv[1][1]=='t') - tflg++; - else if (argv[1][1]=='i') - iflg++; - else if (argv[1][1]=='b') - bflg++, tflg = 0; + + argc--; + + argv++; + + } +++ lseek(mf, (long)nl[X_DK_MSPW].n_value, 0); +++ read(mf, s.dk_mspw, sizeof s.dk_mspw); + + if(argc > 2) + + iter = atoi(argv[2]); - if (!(sflg|iflg)) { - if(tflg) - printf(" TTY"); - if (bflg==0) - printf(" RP RM PERCENT\n"); - if(tflg) - printf(" tin tout"); - if (bflg==0) - printf(" spm tpm msps mspt tpm msps mspt user nice systm idle\n"); - } - + +loop: - lseek(mf, (long)nl[0].value, 0); - read(mf, &s.busy, sizeof s.busy); - lseek(mf, (long)nl[1].value, 0); - read(mf, s.etime, sizeof s.etime); - lseek(mf, (long)nl[2].value, 0); - read(mf, s.numb, sizeof s.numb); - lseek(mf, (long)nl[3].value, 0); - read(mf, s.wds, sizeof s.wds); - lseek(mf, (long)nl[4].value, 0); - read(mf, &s.tin, sizeof s.tin); - lseek(mf, (long)nl[5].value, 0); - read(mf, &s.tout, sizeof s.tout); - for(i=0; i<40; i++) { - t = s.etime[i]; - s.etime[i] -= s1.etime[i]; - s1.etime[i] = t; - } - t = 0; - for(i=0; i<32; i++) - t += s.etime[i]; - etime = t; - if(etime == 0.) - etime = 1.; - if (bflg) { - biostats(); - goto contin; - } - if (dflg) { - long tm; - time(&tm); - printf("%s", ctime(&tm)); - } - if (aflg) - printf("%.2f minutes total\n", etime/3600); - if (sflg) { - stats2(etime); - goto contin; +++ if (--tohdr == 0) { +++ printf(" TTY"); +++ for (i = 0; i < DK_NDRIVE; i++) +++ if (s.dk_mspw[i] != 0.0) +++ printf(" D%d ", i); +++ printf(" CPU\n"); +++ printf(" tin tout"); +++ for (i = 0; i < DK_NDRIVE; i++) +++ if (s.dk_mspw[i] != 0.0) +++ printf(" sps tps msps "); +++ printf(" us ni sy id\n"); +++ tohdr = 19; + + } - if (iflg) { - stats3(etime); - goto contin; +++ lseek(mf, (long)nl[X_DK_BUSY].n_value, 0); +++ read(mf, &s.dk_busy, sizeof s.dk_busy); +++ lseek(mf, (long)nl[X_DK_TIME].n_value, 0); +++ read(mf, s.dk_time, sizeof s.dk_time); +++ lseek(mf, (long)nl[X_DK_XFER].n_value, 0); +++ read(mf, s.dk_xfer, sizeof s.dk_xfer); +++ lseek(mf, (long)nl[X_DK_WDS].n_value, 0); +++ read(mf, s.dk_wds, sizeof s.dk_wds); +++ lseek(mf, (long)nl[X_TK_NIN].n_value, 0); +++ read(mf, &s.tk_nin, sizeof s.tk_nin); +++ lseek(mf, (long)nl[X_TK_NOUT].n_value, 0); +++ read(mf, &s.tk_nout, sizeof s.tk_nout); +++ lseek(mf, (long)nl[X_DK_SEEK].n_value, 0); +++ read(mf, s.dk_seek, sizeof s.dk_seek); +++ lseek(mf, (long)nl[X_CP_TIME].n_value, 0); +++ read(mf, s.cp_time, sizeof s.cp_time); +++ lseek(mf, (long)nl[X_DK_MSPW].n_value, 0); +++ read(mf, s.dk_mspw, sizeof s.dk_mspw); +++ for (i = 0; i < DK_NDRIVE; i++) { +++#define X(fld) t = s.fld[i]; s.fld[i] -= s1.fld[i]; s1.fld[i] = t +++ X(dk_xfer); X(dk_seek); X(dk_wds); X(dk_time); + + } - etime /= 60.; - if(tflg) { - f1 = s.tin; - f2 = s.tout; - printf("%6.1f", f1/etime); - printf("%6.1f", f2/etime); +++ t = s.tk_nin; s.tk_nin -= s1.tk_nin; s1.tk_nin = t; +++ t = s.tk_nout; s.tk_nout -= s1.tk_nout; s1.tk_nout = t; +++ etime = 0; +++ for(i=0; i 1) { + + sleep(atoi(argv[1])); + + goto loop; + + } + +} + + - /* usec per word for the various disks */ - double xf[] = { - 2.48, /* RP06 */ - 2.48, /* RP06 */ - 1.66, /* RM03 */ - 16.0, /* RF */ - 11.1, /* RK03/05 */ - }; - + +stats(dn) + +{ + + register i; - double f1, f2, f3; - double f4, f5, f6; - long t; - static float zerof5; +++ double atime, words, xtime, itime; + + - t = 0; - for(i=0; i<32; i++) - if(i & (1< + +#define F1 0 + +#define F2 1 + +#define NFLD 20 /* max field per line */ + +#define comp() cmp(ppi[F1][j1],ppi[F2][j2]) + + + +FILE *f[2]; + +char buf[2][BUFSIZ]; /*input lines */ + +char *ppi[2][NFLD]; /* pointers to fields in lines */ + +char *s1,*s2; + +int j1 = 1; /* join of this field of file 1 */ + +int j2 = 1; /* join of this field of file 2 */ + +int olist[2*NFLD]; /* output these fields */ + +int olistf[2*NFLD]; /* from these files */ + +int no; /* number of entries in olist */ + +int sep1 = ' '; /* default field separator */ + +int sep2 = '\t'; + +char* null = ""; + +int unpub1; + +int unpub2; + +int aflg; + + + +main(argc, argv) + +char *argv[]; + +{ + + int i; + + int n1, n2; + + long top2, bot2; + + long ftell(); + + + + while (argc > 1 && argv[1][0] == '-') { + + if (argv[1][1] == '\0') + + break; + + switch (argv[1][1]) { + + case 'a': + + switch(argv[1][2]) { + + case '1': + + aflg |= 1; + + break; + + case '2': + + aflg |= 2; + + break; + + default: + + aflg |= 3; + + } + + break; + + case 'e': + + null = argv[2]; + + argv++; + + argc--; + + break; + + case 't': + + sep1 = sep2 = argv[1][2]; + + break; + + case 'o': + + for (no = 0; no < 2*NFLD; no++) { + + if (argv[2][0] == '1' && argv[2][1] == '.') { + + olistf[no] = F1; + + olist[no] = atoi(&argv[2][2]); + + } else if (argv[2][0] == '2' && argv[2][1] == '.') { + + olist[no] = atoi(&argv[2][2]); + + olistf[no] = F2; + + } else + + break; + + argc--; + + argv++; + + } + + break; + + case 'j': + + if (argv[1][2] == '1') + + j1 = atoi(argv[2]); + + else if (argv[1][2] == '2') + + j2 = atoi(argv[2]); + + else + + j1 = j2 = atoi(argv[2]); + + argc--; + + argv++; + + break; + + } + + argc--; + + argv++; + + } + + for (i = 0; i < no; i++) + + olist[i]--; /* 0 origin */ + + if (argc != 3) + + error("usage: join [-j1 x -j2 y] [-o list] file1 file2"); + + j1--; + + j2--; /* everyone else believes in 0 origin */ + + s1 = ppi[F1][j1]; + + s2 = ppi[F2][j2]; + + if (argv[1][0] == '-') + + f[F1] = stdin; + + else if ((f[F1] = fopen(argv[1], "r")) == NULL) + + error("can't open %s", argv[1]); + + if ((f[F2] = fopen(argv[2], "r")) == NULL) + + error("can't open %s", argv[2]); + + + +#define get1() n1=input(F1) + +#define get2() n2=input(F2) + + get1(); + + bot2 = ftell(f[F2]); + + get2(); + + while(n1>0 && n2>0 || aflg!=0 && n1+n2>0) { + + if(n1>0 && n2>0 && comp()>0 || n1==0) { + + if(aflg&2) output(0, n2); + + bot2 = ftell(f[F2]); + + get2(); + + } else if(n1>0 && n2>0 && comp()<0 || n2==0) { + + if(aflg&1) output(n1, 0); + + get1(); + + } else /*(n1>0 && n2>0 && comp()==0)*/ { + + while(n2>0 && comp()==0) { + + output(n1, n2); + + top2 = ftell(f[F2]); + + get2(); + + } + + fseek(f[F2], bot2, 0); + + get2(); + + get1(); + + for(;;) { + + if(n1>0 && n2>0 && comp()==0) { + + output(n1, n2); + + get2(); + + } else if(n1>0 && n2>0 && comp()<0 || n2==0) { + + fseek(f[F2], bot2, 0); + + get2(); + + get1(); + + } else /*(n1>0 && n2>0 && comp()>0 || n1==0)*/{ + + fseek(f[F2], top2, 0); + + bot2 = top2; + + get2(); + + break; + + } + + } + + } + + } + + return(0); + +} + + + +input(n) /* get input line and split into fields */ + +{ + + register int i, c; + + char *bp; + + char **pp; + + + + bp = buf[n]; + + pp = ppi[n]; + + if (fgets(bp, BUFSIZ, f[n]) == NULL) + + return(0); + + for (i = 0; ; i++) { + + if (sep1 == ' ') /* strip multiples */ + + while ((c = *bp) == sep1 || c == sep2) + + bp++; /* skip blanks */ + + else + + c = *bp; + + if (c == '\n' || c == '\0') + + break; + + *pp++ = bp; /* record beginning */ + + while ((c = *bp) != sep1 && c != '\n' && c != sep2 && c != '\0') + + bp++; + + *bp++ = '\0'; /* mark end by overwriting blank */ + + /* fails badly if string doesn't have \n at end */ + + } + + *pp = 0; + + return(i); + +} + + + +output(on1, on2) /* print items from olist */ + +int on1, on2; + +{ + + int i; + + char *temp; + + + + if (no <= 0) { /* default case */ + + printf("%s", on1? ppi[F1][j1]: ppi[F2][j2]); + + for (i = 0; i < on1; i++) + + if (i != j1) + + printf("%c%s", sep1, ppi[F1][i]); + + for (i = 0; i < on2; i++) + + if (i != j2) + + printf("%c%s", sep1, ppi[F2][i]); + + printf("\n"); + + } else { + + for (i = 0; i < no; i++) { + + temp = ppi[olistf[i]][olist[i]]; + + if(olistf[i]==F1 && on1<=olist[i] || + + olistf[i]==F2 && on2<=olist[i] || + + *temp==0) + + temp = null; + + printf("%s", temp); + + if (i == no - 1) + + printf("\n"); + + else + + printf("%c", sep1); + + } + + } + +} + + + +error(s1, s2, s3, s4, s5) + +char *s1; + +{ + + fprintf(stderr, "join: "); + + fprintf(stderr, s1, s2, s3, s4, s5); + + fprintf(stderr, "\n"); + + exit(1); + +} + + + +cmp(s1, s2) + +char *s1, *s2; + +{ + + return(strcmp(s1, s2)); + +} diff --cc usr/src/cmd/kill.c index 0000000000,e56f0f05b3,0000000000..1a52bdb009 mode 000000,100644,000000..100644 --- a/usr/src/cmd/kill.c +++ b/usr/src/cmd/kill.c @@@@ -1,0 -1,40 -1,0 +1,75 @@@@ +++static char *sccsid = "@(#)kill.c 4.2 (Berkeley) 10/9/80"; + +/* + + * kill - send signal to process + + */ + + + +#include +++#include +++ +++char *signm[] = { 0, +++"HUP", "INT", "QUIT", "ILL", "TRAP", "IOT", "EMT", "FPE", /* 1-8 */ +++"KILL", "BUS", "SEGV", "SYS", "PIPE", "ALRM", "TERM", 0, /* 9-16 */ +++"STOP", "TSTP", "CONT", "CHLD", "TTIN", "TTOU", "TINT", "XCPU", /* 17-24 */ +++"XFSZ", 0, 0, 0, 0, 0, 0, 0, /* 25-31 */ +++}; + + + +main(argc, argv) + +char **argv; + +{ + + register signo, pid, res; + + int errlev; + + extern char *sys_errlist[]; + + extern errno; + + + + errlev = 0; + + if (argc <= 1) { + + usage: - printf("usage: kill [ -signo ] pid ...\n"); +++ printf("usage: kill [ -sig ] pid ...\n"); +++ printf("for a list of signals: kill -l\n"); + + exit(2); + + } + + if (*argv[1] == '-') { - signo = atoi(argv[1]+1); +++ if (argv[1][1] == 'l') { +++ for (signo = 1; signo <= NSIG; signo++) { +++ if (signm[signo]) +++ printf("%s ", signm[signo]); +++ if (signo == 16) +++ printf("\n"); +++ } +++ printf("\n"); +++ exit(0); +++ } else if (isdigit(argv[1][1])) { +++ signo = atoi(argv[1]+1); +++ if (signo < 1 || signo > NSIG) { +++ printf("kill: %s: number out of range\n", +++ argv[1]); +++ exit(1); +++ } +++ } else { +++ char *name = argv[1]+1; +++ for (signo = 1; signo <= NSIG; signo++) +++ if (signm[signo] && !strcmp(signm[signo], name)) +++ goto foundsig; +++ printf("kill: %s: unknown signal; kill -l lists signals\n", name); +++ exit(1); +++foundsig: +++ ; +++ } + + argc--; + + argv++; + + } else + + signo = SIGTERM; + + argv++; + + while (argc > 1) { + + if (**argv<'0' || **argv>'9') + + goto usage; + + res = kill(pid = atoi(*argv), signo); + + if (res<0) { + + printf("%u: %s\n", pid, sys_errlist[errno]); + + errlev = 1; + + } + + argc--; + + argv++; + + } + + return(errlev); + +} diff --cc usr/src/cmd/last.c index 0000000000,3adaeb4e58,0000000000..495accc690 mode 000000,100644,000000..100644 --- a/usr/src/cmd/last.c +++ b/usr/src/cmd/last.c @@@@ -1,0 -1,301 -1,0 +1,165 @@@@ - # +++static char *sccsid = "@(#)last.c 4.2 (Berkeley) 10/9/80"; + +/* - * NAME: last - * - * SYNOPSIS: last [list] - * - * DESCRIPTION: Displays login history of named users or tty's. - * Last with no argument prints history for all users. - * - * AUTHOR - Howard P. Katseff +++ * last + + */ +++#include +++#include +++#include +++#include +++#include + + - # include - # include - # include - # include +++#define NMAX sizeof(buf[0].ut_name) +++#define LMAX sizeof(buf[0].ut_line) +++#define SECDAY (24*60*60) + + - char yes = 1, - no = 0, +++#define lineq(a,b) (!strncmp(a,b,LMAX)) +++#define nameq(a,b) (!strncmp(a,b,NMAX)) + + - *wtmp = "/usr/adm/wtmp", - b [512], +++#define MAXTTYS 256 + + - Arg [25] [9], - tty_names [48] [9], +++char **argv; +++int argc; + + - *ctime (), - *move (), - *rmchar (); +++struct utmp buf[128]; +++char ttnames[MAXTTYS][LMAX+1]; +++long logouts[MAXTTYS]; + + +++char *ctime(), *strspl(); +++int onintr(); + + - long logouts [48], - bl, - rec, - nblock; - - struct utmp buf [128]; /* buf takes exactly 5 blocks */ - - main (argc, argv) - char **argv; +++main(ac, av) +++ char **av; + +{ - char f, - narg, - - *bend, - *p, - *q; - - short n_byte, - n_record; - - long i, - k, - ntime, - otime, - - intrp (); - - struct stat sbuf; +++ register int i, k; +++ int bl, wtmp; +++ char *ct; +++ register struct utmp *bp; +++ long otime; +++ struct stat stb; +++ int print; + + - for (i = 1; i < argc; i++) - { - if - ( - length (argv [i]) > 2 /* long tty or user name */ - || - equal (argv [i], "~") /* tilde */ - || - getpwnam (argv [i]) /* user name */ - ) - { - move (argv [i], Arg [narg++]); - } - else /* short tty name */ - { - move (argv [i], move ("tty", Arg [narg++])); - } +++ time(&buf[0].ut_time); +++ ac--, av++; +++ argc = ac; +++ argv = av; +++ for (i = 0; i < argc; i++) { +++ if (strlen(argv[i])>2) +++ continue; +++ if (!strcmp(argv[i], "~")) +++ continue; +++ if (getpwnam(argv[i])) +++ continue; +++ argv[i] = strspl("tty", argv[i]); + + } - f = open (wtmp, 0); - if (f < 0) - { - perror (wtmp); - fflush (stdout); - exit (); +++ wtmp = open("/usr/adm/wtmp", 0); +++ if (wtmp < 0) { +++ perror("/usr/adm/wtmp"); +++ exit(1); + + } - if (fstat (f, &sbuf) < 0) - { - perror ("/usr/adm/wtmp"); - fflush (stdout); - exit (); +++ fstat(wtmp, &stb); +++ bl = (stb.st_size + sizeof (buf)-1) / sizeof (buf); +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) { +++ signal(SIGINT, onintr); +++ signal(SIGQUIT, onintr); + + } - nblock = (sbuf.st_size + 2559) / 2560; - signal (2, intrp); - for (bl = nblock - 1; bl >= 0; bl--) - { - lseek (f, bl * 2560, 0); - n_byte = read (f, buf, 2560); - n_record = n_byte / sizeof buf [0]; - for (rec = n_record - 1; rec >= 0; rec--) - { - - if (should_print ()) - { - q = ctime (&buf[rec].ut_time); - printf - ( - "%-8.8s %-8.8s %10.10s %5.5s ", - buf[rec].ut_name, buf[rec].ut_line, q, 11+q - ); - otime = buf[rec].ut_time; - /* - * look up the logout time for the tty - */ - for (i = 0;; i++) - { - if (!*tty_names [i]) - /* not in the table, therefore add it */ - { - move - ( - buf[rec].ut_line, - tty_names [i] - ); - ntime = 0; - break; - } - if - ( - equal - ( - tty_names [i], - buf [rec].ut_line - ) - ) - { - ntime = logouts [i]; - break; - } - } - if (ntime == 0) - { - printf (" still logged in\n"); - } - else - { - if (ntime < 0) - { - ntime = -ntime; - printf ("- crash"); - } - else - { - printf ("- %5.5s", ctime (&ntime) + 11); - } - /* - * calculate how long logged in - */ - otime = ntime - otime; - otime += 231220830 + 10800; - if (otime < 231220830 + 86400 + 10800) - { - printf - ( - " (%5.5s)\n", - ctime (&otime) + 11 - ); - } - else - { - printf - ( - " (%ld+%5.5s)\n", - (otime - - (231330830-86400-10800))/86400, - ctime (&otime) + 11 - ); - } - } - fflush (stdout); +++ for (bl--; bl >= 0; bl--) { +++ lseek(wtmp, bl * sizeof (buf), 0); +++ bp = &buf[read(wtmp, buf, sizeof (buf)) / sizeof(buf[0]) - 1]; +++ for ( ; bp >= buf; bp--) { +++ print = want(bp); +++ if (print) { +++ ct = ctime(&bp->ut_time); +++ printf("%-*.*s %-*.*s %10.10s %5.5s ", +++ NMAX, NMAX, bp->ut_name, +++ LMAX, LMAX, bp->ut_line, ct, 11+ct); + + } - if - ( - equal (buf[rec].ut_line, "~") - || - equal (buf[rec].ut_line, "tty~") - ) - { - for (i = 0; *tty_names [i]; i++) - { - logouts [i] = -buf[rec].ut_time; +++ for (i = 0; i < MAXTTYS; i++) { +++ if (ttnames[i][0] == 0) { +++ strncpy(ttnames[i], bp->ut_line, +++ sizeof(bp->ut_line)); +++ otime = logouts[i]; +++ logouts[i] = bp->ut_time; +++ break; +++ } +++ if (lineq(ttnames[i], bp->ut_line)) { +++ otime = logouts[i]; +++ logouts[i] = bp->ut_time; +++ break; + + } + + } - else - { - for (k = 0;; k++) - { - if (!*tty_names [k]) - { - move - ( - buf[rec].ut_line, - tty_names [k] - ); - logouts [k] = buf[rec].ut_time; - break; - } - if (equal (tty_names [k], buf[rec].ut_line)) - { - logouts [k] = buf[rec].ut_time; - break; - } +++ if (print) { +++ if (otime == 0) +++ printf(" still logged in\n"); +++ else { +++ long delta; +++ if (otime < 0) { +++ otime = -otime; +++ printf("- crash"); +++ } else +++ printf("- %5.5s", +++ ctime(&otime)+11); +++ delta = otime - bp->ut_time; +++ if (delta < SECDAY) +++ printf(" (%5.5s)\n", +++ asctime(gmtime(&delta))+11); +++ else +++ printf(" (%ld+%5.5s)\n", +++ delta / SECDAY, +++ asctime(gmtime(&delta))+11); + + } +++ fflush(stdout); + + } +++ if (!strcmp(bp->ut_name, "reboot")) +++ for (i = 0; i < MAXTTYS; i++) +++ logouts[i] = -bp->ut_time; + + } + + } - q = ctime (&buf [0].ut_time); - printf - ( - "\nwtmp begins %10.10s %5.5s \n", - q, q + 11 - ); - } - - equal (a, b) - char *a, *b; - { - char i; - - for (i = 0; i < 8; i++) - { - if (!*a) return (!*b); - if (*a++ != *b++) return (0); - } - return (1); +++ ct = ctime(&buf[0].ut_time); +++ printf("\nwtmp begins %10.10s %5.5s \n", ct, ct + 11); +++ exit(0); + +} + + - - intrp () +++onintr(signo) +++ int signo; + +{ - char *q; - - signal (2, 1); /* ignore further interrupts */ - q = ctime (&buf[rec].ut_time); - printf - ( - "\ninterrupted %10.10s %5.5s \n", - q, q + 11 - ); - exit (); +++ char *ct; +++ +++ if (signo == SIGQUIT) +++ signal(SIGQUIT, onintr); +++ ct = ctime(&buf[0].ut_time); +++ printf("\ninterrupted %10.10s %5.5s \n", ct, ct + 11); +++ if (signo == SIGINT) +++ exit(1); + +} + + - char * - rmchar (c, s) - char c, *s; +++want(bp) +++ struct utmp *bp; + +{ - for (; *s; s++) - { - if (*s == c) - { - *s = 0; - return (s); - } +++ register char **av; +++ register int ac; +++ +++ if (bp->ut_line[0] == '~') +++ strcpy(bp->ut_name, "reboot"); /* bandaid */ +++ if (bp->ut_name[0] == 0) +++ return (0); +++ if (argc == 0) +++ return (1); +++ av = argv; +++ for (ac = 0; ac < argc; ac++) { +++ if (nameq(*av, bp->ut_name) || lineq(*av, bp->ut_line)) +++ return (1); +++ av++; + + } + + return (0); + +} + + - length (a) - char *a; - { - char *b; - - for (b = a; *b; b++); - return (b - a); - } - + +char * - move (a, b) - char *a, *b; +++strspl(left, right) +++ char *left, *right; + +{ - while (*b++ = *a++); - return (b - 1); - } - - should_print () - { - short i; +++ char *res = (char *)malloc(strlen(left)+strlen(right)+1); + + - if (buf [rec].ut_name [0] == no) return no; /* a logout entry */ - if (!**Arg) return yes; /* no arguments? Print all login entries */ - for (i = 0; i < *Arg [i]; i++) - { - if - ( - equal (Arg [i], buf[rec].ut_name) - || - equal (Arg [i], buf[rec].ut_line) - ) - return yes; - } - return no; +++ strcpy(res, left); +++ strcat(res, right); +++ return (res); + +} diff --cc usr/src/cmd/lastcomm.c index 0000000000,2db5b4c070,0000000000..634fea0ed1 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lastcomm.c +++ b/usr/src/cmd/lastcomm.c @@@@ -1,0 -1,159 -1,0 +1,160 @@@@ +++static char *sccsid = "@(#)lastcomm.c 4.1 (Berkeley) 10/1/80"; + +# + + + +/* + + * last command + + */ + + + +# include + +# include + +# include + +# include + +# include + +# include + + + +# define N_USER 1000 + + + +struct acct acct_buff [BUFSIZ / sizeof (struct acct)]; + + + +char yes = 1, + + no = 0, + + + + user_list [1000][9]; + + + +time_t expand (); + + + +struct passwd + + *passwd, + + *getpwent (); + + + +struct stat stat_buff; + + + +main (argc, argv) + +char **argv; + +{ + + char acct_desc, + + *p; + + + + long i, + + j, + + i_block, + + n_blocks, + + n_byte, + + n_entry; + + + + float x; + + + +/* + + * set up user names + + */ + + while (passwd = getpwent ()) + + { + + move (passwd->pw_name, user_list [passwd->pw_uid]); + + } + + + + acct_desc = open ("/usr/adm/acct", 0); + + if (acct_desc < 0) + + { + + perror ("/usr/adm/acct"); + + return; + + } + + fstat (acct_desc, &stat_buff); + + n_blocks = (stat_buff.st_size + BUFSIZ - 1) / BUFSIZ; + + + + /* + + * read one block's worth + + */ + + for (i_block = n_blocks - 1; i_block >= 0; i_block--) + + { + + lseek (acct_desc, i_block * BUFSIZ, 0); + + n_byte = read (acct_desc, acct_buff, BUFSIZ); + + n_entry = n_byte / sizeof acct_buff [0]; + + for (i = n_entry - 1; i >= 0; i--) + + { + + if (!*user_list [acct_buff [i].ac_uid]) continue; + + /* + + * get the times + + */ + + x = expand (acct_buff [i].ac_utime) + + + + + expand (acct_buff [i].ac_stime); + + /* + + * null terminate the command name + + */ + + acct_buff [i].ac_comm [10] = 0; + + /* + + * replace missing command names with question marks + + */ + + if (!*acct_buff [i].ac_comm) + + { + + move ("?", acct_buff [i].ac_comm); + + } + + /* + + * replace control characters with question marks + + */ + + for (p = acct_buff [i].ac_comm; *p; p++) + + { + + if (*p < '!' || '~' < *p) *p = '?'; + + } + + for (j = 1; j < argc; j++) + + { + + if + + ( + + equal (acct_buff [i].ac_comm, argv [j]) + + || + + equal + + ( + + user_list [acct_buff [i].ac_uid], + + argv [j] + + ) + + ) + + { + + break; + + } + + } + + if (argc == 1 || j != argc) + + { + + printf + + ( + + "%-10s %-8s %6.2f %.16s\n", + + acct_buff [i].ac_comm, + + user_list [acct_buff [i].ac_uid], + + x / 60.0, + + ctime (&acct_buff [i].ac_btime) + + ); + + } + + } + + } + +} + + + +time_t + +expand (t) + +unsigned t; + +{ + + register time_t nt; + + + + nt = t & 017777; + + t >>= 13; + + while (t) + + { + + t--; + + nt <<= 3; + + } + + return (nt); + +} + + + +move (a, b) + +char *a, *b; + +{ + + while (*b++ = *a++); + +} + + + +equal (a, b) + +char *a, *b; + +{ + + for (;; a++, b++) + + { + + if (*a != *b) return no; + + if (!*a) return yes; + + } + +} diff --cc usr/src/cmd/ld.c index 0000000000,90e8895f3a,0000000000..218fadb838 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ld.c +++ b/usr/src/cmd/ld.c @@@@ -1,0 -1,1412 -1,0 +1,1927 @@@@ - char LD[] = "@(#)ld.c 1.10 78/12/07 15:34:58"; /* sccs ident */ +++static char sccsid[] = "@(#)ld.c 4.2 11/7/80"; + +/* - * link editor for VAX +++ * ld - string table version for VAX + + */ + + - /* layout of a.out file: - * - * header of 8 words magic number 0410: - data starts at 1st (PAGSIZ) - boundary above text - magic number 0407: - data starts immediately after - text - * text size ) - * data size ) in bytes - * bss size ) - * symbol table size - * entry point - * size of text relocation info - * size of data relocation info - * - * 'segment' origin comments - * header: 0 - * text: 32 0 padded to multiple of 4 bytes - * data: 32+textsize 0 padded to multiple of 4 bytes - * text relocation: 32+textsize+datasize - * data relocation: 32+textsize+datasize+textrelocationsize - * symbol table: 32+textsize+datasize+textrelocationsize+datarelocationsize - * - */ +++#include + +#include + +#include +++#include + +#include + +#include +++#include +++#include + +#include + + - struct {short hiword; short loword;}; /* stupid fp-11 */ - fixl(p) register long *p;{ - register short t; - t=p->hiword; p->hiword=p->loword; p->loword=t; - } +++/* +++ * Basic strategy: +++ * +++ * The loader takes a number of files and libraries as arguments. +++ * A first pass examines each file in turn. Normal files are +++ * unconditionally loaded, and the (external) symbols they define and require +++ * are noted in the symbol table. Libraries are searched, and the +++ * library members which define needed symbols are remembered +++ * in a special data structure so they can be selected on the second +++ * pass. Symbols defined and required by library members are also +++ * recorded. +++ * +++ * After the first pass, the loader knows the size of the basic text +++ * data, and bss segments from the sum of the sizes of the modules which +++ * were required. It has computed, for each ``common'' symbol, the +++ * maximum size of any reference to it, and these symbols are then assigned +++ * storage locations after their sizes are appropriately rounded. +++ * The loader now knows all sizes for the eventual output file, and +++ * can determine the final locations of external symbols before it +++ * begins a second pass. +++ * +++ * On the second pass each normal file and required library member +++ * is processed again. The symbol table for each such file is +++ * reread and relevant parts of it are placed in the output. The offsets +++ * in the local symbol table for externally defined symbols are recorded +++ * since relocation information refers to symbols in this way. +++ * Armed with all necessary information, the text and data segments +++ * are relocated and the result is placed in the output file, which +++ * is pasted together, ``in place'', by writing to it in several +++ * different places concurrently. +++ */ + + - writel(p,n,f) long *p; FILE *f; { - #ifdef vax - fwrite(p,sizeof(*p),n,f); - #else - while (n--) { - fwrite(&(*p).loword,2,1,f); - fwrite(&(*p).hiword,2,1,f); - p++; - } - #endif - } +++/* +++ * Internal data structures +++ * +++ * All internal data structures are segmented and dynamically extended. +++ * The basic structures hold 1103 (NSYM) symbols, ~~200 (NROUT) +++ * referenced library members, and 100 (NSYMPR) private (local) symbols +++ * per object module. For large programs and/or modules, these structures +++ * expand to be up to 40 (NSEG) times as large as this as necessary. +++ */ +++#define NSEG 40 /* Number of segments, each data structure */ +++#define NSYM 1103 /* Number of symbols per segment */ +++#define NROUT 250 /* Number of library references per segment */ +++#define NSYMPR 100 /* Number of private symbols per segment */ + + - long htoi(p) register char *p; {/* hex to integer conversion */ - register long n = 0; - while (*p) { - n <<= 4; - if (*p<='9' && *p>='0') n += *p - '0'; - else if (*p<='f' && *p>='a') n += *p -'a' +10; - else if (*p<='F' && *p>='A') n += *p -'A' +10; - p++; - } - return(n); - } +++/* +++ * Structure describing each symbol table segment. +++ * Each segment has its own hash table. We record the first +++ * address in and first address beyond both the symbol and hash +++ * tables, for use in the routine symx and the lookup routine respectively. +++ * The symfree routine also understands this structure well as it used +++ * to back out symbols from modules we decide that we don't need in pass 1. +++ * +++ * Csymseg points to the current symbol table segment; +++ * csymseg->sy_first[csymseg->sy_used] is the next symbol slot to be allocated, +++ * (unless csymseg->sy_used == NSYM in which case we will allocate another +++ * symbol table segment first.) +++ */ +++struct symseg { +++ struct nlist *sy_first; /* base of this alloc'ed segment */ +++ struct nlist *sy_last; /* end of this segment, for n_strx */ +++ int sy_used; /* symbols used in this seg */ +++ struct nlist **sy_hfirst; /* base of hash table, this seg */ +++ struct nlist **sy_hlast; /* end of hash table, this seg */ +++} symseg[NSEG], *csymseg; +++ +++/* +++ * The lookup routine uses quadratic rehash. Since a quadratic rehash +++ * only probes 1/2 of the buckets in the table, and since the hash +++ * table is segmented the same way the symbol table is, we make the +++ * hash table have twice as many buckets as there are symbol table slots +++ * in the segment. This guarantees that the quadratic rehash will never +++ * fail to find an empty bucket if the segment is not full and the +++ * symbol is not there. +++ */ +++#define HSIZE (NSYM*2) + + - typedef char *STRING; - typedef int BOOL; - #define TRUE 1 - #define FALSE 0 +++/* +++ * Xsym converts symbol table indices (ala x) into symbol table pointers. +++ * Symx (harder, but never used in loops) inverts pointers into the symbol +++ * table into indices using the symseg[] structure. +++ */ +++#define xsym(x) (symseg[(x)/NSYM].sy_first+((x)%NSYM)) +++/* symx() is a function, defined below */ +++ +++struct nlist cursym; /* current symbol */ +++struct nlist *lastsym; /* last symbol entered */ +++struct nlist *nextsym; /* next available symbol table entry */ +++struct nlist *addsym; /* first sym defined during incr load */ +++int nsym; /* pass2: number of local symbols in a.out */ +++/* nsym + symx(nextsym) is the symbol table size during pass2 */ + + - #define OMAGIC 0407 - #define NMAGIC 0410 +++struct nlist **lookup(), **slookup(); +++struct nlist *p_etext, *p_edata, *p_end, *entrypt; + + + +/* - * Symbol types +++ * Definitions of segmentation for library member table. +++ * For each library we encounter on pass 1 we record pointers to all +++ * members which we will load on pass 2. These are recorded as offsets +++ * into the archive in the library member table. Libraries are +++ * separated in the table by the special offset value -1. + + */ - #define UNDEF 0x0 - #define ABS 0x2 - #define TEXT 0x4 - #define DATA 0x6 - #define BSS 0x8 - #define DATAO 0xA - #define BSSO 0xC - #define TEXTO 0xE - #define ABSO 0x10 - - #define COMM 0x12 /* for internal use only */ - - #define EXTERN 0x1 - #define TYPE 0x1E - #define STABTYPS 0xE0 +++off_t li_init[NROUT]; +++struct libseg { +++ off_t *li_first; +++ int li_used; +++ int li_used2; +++} libseg[NSEG] = { +++ li_init, 0, 0, +++}, *clibseg = libseg; +++ + +/* - * address reference types +++ * In processing each module on pass 2 we must relocate references +++ * relative to external symbols. These references are recorded +++ * in the relocation information as relative to local symbol numbers +++ * assigned to the external symbols when the module was created. +++ * Thus before relocating the module in pass 2 we create a table +++ * which maps these internal numbers to symbol table entries. +++ * A hash table is constructed, based on the local symbol table indices, +++ * for quick lookup of these symbols. + + */ - #define PCREL 1 - #define LEN1 0 - #define LEN2 2 - #define LEN4 4 - - #define HW 01 - #define FW 03 - #define DW 07 - - - #define TYPMASK 0x1E - #define TYMASK (0x1E) - #define TMASK 0x1F - - #define RABS (ABS) - #define RTEXT TEXT - #define RDATA DATA - #define RBSS BSS - #define RDATAO DATAO - #define RBSSO BSSO - #define RTEXTO TEXTO - #define RABSO ABSO - #define REXT (01<<3) - #define ROFF (02<<3) - #define REFMASK 0x7 - - #define NOVLY 1 - #define RELFLG 01 - #define NROUT 256 - #define NSYM 1103 - #define NSYMPR 500 - - char premeof[] = "Premature EOF"; +++#define LHSIZ 31 +++struct local { +++ int l_index; /* index to symbol in file */ +++ struct nlist *l_symbol; /* ptr to symbol table */ +++ struct local *l_link; /* hash link */ +++} *lochash[LHSIZ], lhinit[NSYMPR]; +++struct locseg { +++ struct local *lo_first; +++ int lo_used; +++} locseg[NSEG] = { +++ lhinit, 0 +++}, *clocseg; + + - typedef struct { - long loc; - } LIBLIST; +++/* +++ * Libraries are typically built with a table of contents, +++ * which is the first member of a library with special file +++ * name __.SYMDEF and contains a list of symbol names +++ * and with each symbol the offset of the library member which defines +++ * it. The loader uses this table to quickly tell which library members +++ * are (potentially) useful. The alternative, examining the symbol +++ * table of each library member, is painfully slow for large archives. +++ * +++ * See for the definition of the ranlib structure and an +++ * explanation of the __.SYMDEF file format. +++ */ +++int tnum; /* number of symbols in table of contents */ +++int ssiz; /* size of string table for table of contents */ +++struct ranlib *tab; /* the table of contents (dynamically allocated) */ +++char *tabstr; /* string table for table of contents */ + + - /* overlay management */ - int vindex; - typedef struct { - int argsav; - int symsav; - LIBLIST *libsav; - STRING vname; - long ctsav, cdsav, cbsav; - long offt, offd, offb, offtr, offdr, offs; - } OVERLAY; - OVERLAY vnodes[NOVLY]; - - /* input management */ +++/* +++ * We open each input file or library only once, but in pass2 we +++ * (historically) read from such a file at 2 different places at the +++ * same time. These structures are remnants from those days, +++ * and now serve only to catch ``Premature EOF''. +++ */ + +typedef struct { + + short *fakeptr; + + int bno; + + int nibuf; + + int nuser; + + char buff[BSIZE]; + +} PAGE; + + + +PAGE page[2]; + + + +struct { + + short *fakeptr; + + int bno; + + int nibuf; + + int nuser; + +} fpage; + + + +typedef struct { + + char *ptr; + + int bno; + + int nibuf; + + long size; + + long pos; + + PAGE *pno; + +} STREAM; + + - STREAM text; - STREAM reloc; - - struct ar_hdr archdr; +++STREAM text; +++STREAM reloc; + + +++/* +++ * Header from the a.out and the archive it is from (if any). +++ */ + +struct exec filhdr; +++struct ar_hdr archdr; +++#define OARMAG 0177545 + + - /* one entry for each archive member referenced; - * set in first pass; needs restoring for overlays +++/* +++ * Options. + + */ - - LIBLIST liblist[NROUT]; - LIBLIST *libp = liblist; - - - /* symbol management */ - typedef struct { - char sname[8]; - char stype; - char spare; - short symhash; /* index of hash table entry pointing to this symbol */ - long svalue; - } SYMBOL; - - typedef struct { - int locindex; /* index to symbol in file */ - SYMBOL *locsymbol; /* ptr to symbol table */ - } LOCAL; - - SYMBOL cursym; /* current symbol */ - SYMBOL *symtab; /* actual symbols */ - SYMBOL *lastsym; /* last symbol entered */ - SYMBOL *nextsym; /* next available symbol table entry */ - int nsym; /* number of symbols allocated in symtab */ - SYMBOL *hshtab[NSYM+2]; /* hash table for symbols */ - LOCAL *local; - - /* internal symbols */ - SYMBOL *p_data; - SYMBOL *p_etext; - SYMBOL *p_edata; - SYMBOL *p_end; - SYMBOL *entrypt; - + +int trace; - /* flags */ + +int xflag; /* discard local symbols */ + +int Xflag; /* discard locals starting with 'L' */ + +int Sflag; /* discard all except locals and globals*/ + +int rflag; /* preserve relocation bits, don't define common */ + +int arflag; /* original copy of rflag */ + +int sflag; /* discard all symbols */ - int nflag = 1; /* pure procedure */ +++int Mflag; /* print rudimentary load map */ +++int nflag; /* pure procedure */ + +int dflag; /* define common even with rflag */ - int iflag; /* I/D space separated */ - BOOL vflag; /* overlays used */ - int zflag; - - int ofilfnd; - char *ofilename = "l.out"; - int infil; - char *filname; - - long textbase; - /* cumulative sizes set in pass 1 */ - long tsize; - long dsize; - long bsize; - long trsize; - long drsize; - long ssize; - - /* symbol relocation; both passes */ - long ctrel; - long cdrel; - long cbrel; - long ctorel; - long cdorel; - long cborel; +++int zflag; /* demand paged */ +++long hsize; /* size of hole at beginning of data to be squashed */ +++int Aflag; /* doing incremental load */ +++int Nflag; /* want impure a.out */ +++int funding; /* reading fundamental file for incremental load */ +++int yflag; /* number of symbols to be traced */ +++char **ytab; /* the symbols */ +++ +++/* +++ * These are the cumulative sizes, set in pass 1, which +++ * appear in the a.out header when the loader is finished. +++ */ +++off_t tsize, dsize, bsize, trsize, drsize, ssize; +++ +++/* +++ * Symbol relocation: c?rel is a scale factor which is +++ * added to an old relocation to convert it to new units; +++ * i.e. it is the difference between segment origins. +++ * (Thus if we are loading from a data segment which began at location +++ * 4 in a .o file into an a.out where it will be loaded starting at +++ * 1024, cdrel will be 1020.) +++ */ +++long ctrel, cdrel, cbrel; +++ +++/* +++ * Textbase is the start address of all text, 0 unless given by -T. +++ * Database is the base of all data, computed before and used during pass2. +++ */ +++long textbase, database; + + +++/* +++ * The base addresses for the loaded text, data and bss from the +++ * current module during pass2 are given by torigin, dorigin and borigin. +++ */ +++long torigin, dorigin, borigin; +++ +++/* +++ * Errlev is nonzero when errors have occured. +++ * Delarg is an implicit argument to the routine delexit +++ * which is called on error. We do ``delarg = errlev'' before normal +++ * exits, and only if delarg is 0 (i.e. errlev was 0) do we make the +++ * result file executable. +++ */ + +int errlev; + +int delarg = 4; + + +++/* +++ * The biobuf structure and associated routines are used to write +++ * into one file at several places concurrently. Calling bopen +++ * with a biobuf structure sets it up to write ``biofd'' starting +++ * at the specified offset. You can then use ``bwrite'' and/or ``bputc'' +++ * to stuff characters in the stream, much like ``fwrite'' and ``fputc''. +++ * Calling bflush drains all the buffers and MUST be done before exit. +++ */ +++struct biobuf { +++ short b_nleft; /* Number free spaces left in b_buf */ +++/* Initialize to be less than BUFSIZ initially, to boundary align in file */ +++ char *b_ptr; /* Next place to stuff characters */ +++ char b_buf[BUFSIZ]; /* The buffer itself */ +++ off_t b_off; /* Current file offset */ +++ struct biobuf *b_link; /* Link in chain for bflush() */ +++} *biobufs; +++#define bputc(c,b) ((b)->b_nleft ? (--(b)->b_nleft, *(b)->b_ptr++ = (c)) \ +++ : bflushc(b, c)) +++int biofd; +++off_t boffset; +++struct biobuf *tout, *dout, *trout, *drout, *sout, *strout; + + - FILE *tout; - FILE *dout; - char *doutn = ""; - FILE *trout; - char *troutn = ""; - FILE *drout; - char *droutn = ""; - FILE *sout; - char *soutn = ""; +++/* +++ * Offset is the current offset in the string file. +++ * Its initial value reflects the fact that we will +++ * eventually stuff the size of the string table at the +++ * beginning of the string table (i.e. offset itself!). +++ */ +++off_t offset = sizeof (off_t); + + - char *mktemp(); - char get(); - char getb(); - short gets(); - long get3(); - long getl(); - SYMBOL **lookup(); - FILE *tcreat(); - long round(); - SYMBOL **slookup(); - SYMBOL *lookloc(); - - symwrite(sp,n,f) SYMBOL *sp; FILE *f; { - #ifdef vax - fwrite(sp,sizeof(*symtab),n,f); - #else - while (n--) { - fwrite(sp,sizeof(*symtab)-sizeof(sp->svalue),1,f); - writel(&(sp->svalue),1,f); sp++; - } - #endif - } +++int ofilfnd; /* -o given; otherwise move l.out to a.out */ +++char *ofilename = "l.out"; +++int infil; /* current input file descriptor */ +++char *filname; /* and its name */ + + - delexit() - { - unlink("l.out"); - unlink(doutn); - unlink(troutn); - unlink(droutn); - unlink(soutn); - if (delarg==0) - chmod(ofilename, 0777 &~ umask(0)); - exit(delarg); - } +++/* +++ * Base of the string table of the current module (pass1 and pass2). +++ */ +++char *curstr; +++ +++char get(); +++int delexit(); +++char *savestr(); + + + +main(argc, argv) + +char **argv; + +{ + + register int c, i; + + int num; + + register char *ap, **p; - BOOL found; - int vscan; + + char save; + + - if (signal(SIGINT, SIG_IGN) != SIG_IGN) +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) { + + signal(SIGINT, delexit); +++ signal(SIGTERM, delexit); +++ } + + if (argc == 1) + + exit(4); + + p = argv+1; + + - nextsym=symtab=sbrk(0); nsym=0; - /* scan files once to find symdefs */ +++ /* +++ * Scan files once to find where symbols are defined. +++ */ + + for (c=1; c= argc) - error(1, "Bad output file"); - ofilename = *p++; - ofilfnd++; - continue; - - case 'u': - case 'e': - if (++c >= argc) - error(1, "Bad 'use' or 'entry'"); - enter(slookup(*p++)); - if (ap[i]=='e') - entrypt = lastsym; - continue; - - case 'v': - if (++c >= argc) - error(1, "-v: arg missing"); - vflag=TRUE; - vscan = vindex; - found=FALSE; - while (--vscan>=0 && found==FALSE) - found = eq(vnodes[vscan].vname, *p); - if (found) { - endload(c, argv); - restore(vscan); - } else - record(c, *p); - p++; - continue; - - case 'D': - if (++c >= argc) - error(1, "-D: arg missing"); - num = htoi(*p++); - if (dsize>num) - error(1, "-D: too small"); - dsize = num; - continue; - - case 'T': - if (++c >= argc) - error(1, "-T: arg missing"); - if (tsize!=0) - error(1, "-T: too late, some text already loaded"); - textbase = htoi(*p++); - continue; - - case 'l': - save = ap[--i]; - ap[i]='-'; - load1arg(&ap[i]); - ap[i]=save; - break; - - case 'x': - xflag++; - continue; - - case 'X': - Xflag++; - continue; - - case 'S': - Sflag++; - continue; - - case 'r': - rflag++; - arflag++; - continue; - - case 's': - sflag++; - xflag++; - continue; - - case 'n': - nflag++; - continue; - - case 'N': - nflag = 0; - continue; - - case 'd': - dflag++; - continue; - - case 'i': - iflag++; - continue; - - case 't': - trace++; - continue; - - case 'z': - zflag++; - continue; - - default: - error(1, "bad flag"); - } /*endsw*/ - break; - } /*endfor*/ - } else +++ if (*ap != '-') { + + load1arg(ap); +++ continue; +++ } +++ for (i=1; ap[i]; i++) switch (ap[i]) { +++ +++ case 'o': +++ if (++c >= argc) +++ error(1, "-o where?"); +++ ofilename = *p++; +++ ofilfnd++; +++ continue; +++ case 'u': +++ case 'e': +++ if (++c >= argc) +++ error(1, "-u or -c: arg missing"); +++ enter(slookup(*p++)); +++ if (ap[i]=='e') +++ entrypt = lastsym; +++ continue; +++ case 'H': +++ if (++c >= argc) +++ error(1, "-H: arg missing"); +++ if (tsize!=0) +++ error(1, "-H: too late, some text already loaded"); +++ hsize = atoi(*p++); +++ continue; +++ case 'A': +++ if (++c >= argc) +++ error(1, "-A: arg missing"); +++ if (Aflag) +++ error(1, "-A: only one base file allowed"); +++ Aflag = 1; +++ nflag = 0; +++ funding = 1; +++ load1arg(*p++); +++ trsize = drsize = tsize = dsize = bsize = 0; +++ ctrel = cdrel = cbrel = 0; +++ funding = 0; +++ addsym = nextsym; +++ continue; +++ case 'D': +++ if (++c >= argc) +++ error(1, "-D: arg missing"); +++ num = htoi(*p++); +++ if (dsize > num) +++ error(1, "-D: too small"); +++ dsize = num; +++ continue; +++ case 'T': +++ if (++c >= argc) +++ error(1, "-T: arg missing"); +++ if (tsize!=0) +++ error(1, "-T: too late, some text already loaded"); +++ textbase = htoi(*p++); +++ continue; +++ case 'l': +++ save = ap[--i]; +++ ap[i]='-'; +++ load1arg(&ap[i]); +++ ap[i]=save; +++ goto next; +++ case 'M': +++ Mflag++; +++ continue; +++ case 'x': +++ xflag++; +++ continue; +++ case 'X': +++ Xflag++; +++ continue; +++ case 'S': +++ Sflag++; +++ continue; +++ case 'r': +++ rflag++; +++ arflag++; +++ continue; +++ case 's': +++ sflag++; +++ xflag++; +++ continue; +++ case 'n': +++ nflag++; +++ Nflag = zflag = 0; +++ continue; +++ case 'N': +++ Nflag++; +++ nflag = zflag = 0; +++ continue; +++ case 'd': +++ dflag++; +++ continue; +++ case 'i': +++ printf("ld: -i ignored\n"); +++ continue; +++ case 't': +++ trace++; +++ continue; +++ case 'y': +++ if (ap[i+1] == 0) +++ error(1, "-y: symbol name missing"); +++ if (yflag == 0) { +++ ytab = (char **)calloc(argc, sizeof (char **)); +++ if (ytab == 0) +++ error(1, "ran out of memory (-y)"); +++ } +++ ytab[yflag++] = &ap[i+1]; +++ goto next; +++ case 'z': +++ zflag++; +++ Nflag = nflag = 0; +++ continue; +++ default: +++ filname = savestr("-x"); /* kludge */ +++ filname[1] = ap[i]; /* kludge */ +++ archdr.ar_name[0] = 0; /* kludge */ +++ error(1, "bad flag"); +++ } +++next: +++ ; + + } +++ if (rflag == 0 && Nflag == 0 && nflag == 0) +++ zflag++; + + endload(argc, argv); + + exit(0); + +} + + - /* used after pass 1 */ - long torigin; - long dorigin; - long borigin; - long database; +++/* +++ * Convert a ascii string which is a hex number. +++ * Used by -T and -D options. +++ */ +++htoi(p) +++ register char *p; +++{ +++ register int c, n; +++ +++ n = 0; +++ while (c = *p++) { +++ n <<= 4; +++ if (isdigit(c)) +++ n += c - '0'; +++ else if (c >= 'a' && c <= 'f') +++ n += 10 + (c - 'a'); +++ else if (c >= 'A' && c <= 'F') +++ n += 10 + (c - 'A'); +++ else +++ error(1, "badly formed hex number"); +++ } +++ return (n); +++} +++ +++delexit() +++{ +++ +++ bflush(); +++ unlink("l.out"); +++ if (delarg==0 && Aflag==0) +++ chmod(ofilename, 0777 &~ umask(0)); +++ exit (delarg); +++} + + + +endload(argc, argv) - int argc; - char **argv; +++ int argc; +++ char **argv; + +{ + + register int c, i; + + long dnum; + + register char *ap, **p; + + - brk(nextsym); +++ clibseg = libseg; + + filname = 0; + + middle(); + + setupout(); - if (-1==(local=sbrk(NSYMPR*sizeof(*local)))) error(1,"Memory overflow"); + + p = argv+1; - libp = liblist; + + for (c=1; cargsav = c; - v->symsav = nextsym-symtab; - v->libsav = libp; - v->vname = nam; - v->offt = tsize; - v->offd = dsize; - v->offb = bsize; - v->offtr = trsize; - v->offdr = drsize; - v->offs = ssize; - v->ctsav = ctrel; - v->cdsav = cdrel; - v->cbsav = cbrel; +++ register struct ranlib *tp; +++ off_t nloc; +++ int kind; +++ +++ kind = getfile(cp); +++ if (Mflag) +++ printf("%s\n", filname); +++ switch (kind) { +++ +++ /* +++ * Plain file. +++ */ +++ case 0: +++ load1(0, 0L); +++ break; +++ +++ /* +++ * Archive without table of contents. +++ * (Slowly) process each member. +++ */ +++ case 1: +++ error(-1, +++"warning: archive has no table of contents; add one using ranlib(1)"); +++ nloc = SARMAG; +++ while (step(nloc)) +++ nloc += sizeof(archdr) + +++ round(atol(archdr.ar_size), sizeof (short)); +++ break; +++ +++ /* +++ * Archive with table of contents. +++ * Read the table of contents and its associated string table. +++ * Pass through the library resolving symbols until nothing changes +++ * for an entire pass (i.e. you can get away with backward references +++ * when there is a table of contents!) +++ */ +++ case 2: +++ nloc = SARMAG + sizeof (archdr); +++ dseek(&text, nloc, sizeof (tnum)); +++ mget((char *)&tnum, sizeof (tnum), &text); +++ nloc += sizeof (tnum); +++ tab = (struct ranlib *)malloc(tnum); +++ if (tab == 0) +++ error(1, "ran out of memory (toc)"); +++ dseek(&text, nloc, tnum); +++ mget((char *)tab, tnum, &text); +++ nloc += tnum; +++ tnum /= sizeof (struct ranlib); +++ dseek(&text, nloc, sizeof (ssiz)); +++ mget((char *)&ssiz, sizeof (ssiz), &text); +++ nloc += sizeof (ssiz); +++ tabstr = (char *)malloc(ssiz); +++ if (tabstr == 0) +++ error(1, "ran out of memory (tocstr)"); +++ dseek(&text, nloc, ssiz); +++ mget((char *)tabstr, ssiz, &text); +++ for (tp = &tab[tnum]; --tp >= tab;) { +++ if (tp->ran_un.ran_strx < 0 || +++ tp->ran_un.ran_strx >= ssiz) +++ error(1, "mangled archive table of contents"); +++ tp->ran_un.ran_name = tabstr + tp->ran_un.ran_strx; +++ } +++ while (ldrand()) +++ continue; +++ cfree((char *)tab); +++ cfree(tabstr); +++ nextlibp(-1); +++ break; +++ +++ /* +++ * Table of contents is out of date, so search +++ * as a normal library (but skip the __.SYMDEF file). +++ */ +++ case 3: +++ error(-1, +++"warning: table of contents for archive is out of date; rerun ranlib(1)"); +++ nloc = SARMAG; +++ do +++ nloc += sizeof(archdr) + +++ round(atol(archdr.ar_size), sizeof(short)); +++ while (step(nloc)); +++ break; +++ } +++ close(infil); + +} + + - restore(vscan) - int vscan; +++/* +++ * Advance to the next archive member, which +++ * is at offset nloc in the archive. If the member +++ * is useful, record its location in the liblist structure +++ * for use in pass2. Mark the end of the archive in libilst with a -1. +++ */ +++step(nloc) +++ off_t nloc; + +{ - register OVERLAY *v; - register SYMBOL *saved,*sp; - - v = &vnodes[vscan]; - vindex = vscan+1; - libp = v->libsav; - ctrel = v->ctsav; - cdrel = v->cdsav; - cbrel = v->cbsav; - tsize = v->offt; - dsize = v->offd; - bsize = v->offb; - trsize = v->offtr; - drsize = v->offdr; - ssize = v->offs; - saved = symtab + v->symsav; - sp = nextsym; - while (sp>saved) - hshtab[(--sp)->symhash]=0; - nextsym = saved; +++ +++ dseek(&text, nloc, (long) sizeof archdr); +++ if (text.size <= 0) { +++ nextlibp(-1); +++ return (0); +++ } +++ getarhdr(); +++ if (load1(1, nloc + (sizeof archdr))) +++ nextlibp(nloc); +++ return (1); + +} + + - /* scan file to find defined symbols */ - load1arg(cp) - register char *cp; +++/* +++ * Record the location of a useful archive member. +++ * Recording -1 marks the end of files from an archive. +++ * The liblist data structure is dynamically extended here. +++ */ +++nextlibp(val) +++ off_t val; + +{ - long loc; + + - if (getfile(cp)==0) - load1(0, 0L); - else { - loc = sizeof(int); - for (;;) { - dseek(&text, loc, (long)sizeof(archdr)); - if (text.size <= 0) { - libp->loc = -1; - if( ++libp >= liblist + NROUT) - error(1,"liblist overflow"); - /* thanks to Dennis Wasley */ - return; - } - mget((short *)&archdr, sizeof archdr, &text); - if (load1(1, loc+sizeof(archdr))) { - libp->loc = loc; - libp++; - } - #ifndef vax - if (archdr.ar_size.loword==0) fixl(&archdr.ar_size); - #endif - loc += round(archdr.ar_size, 1) + sizeof(archdr); - } +++ if (clibseg->li_used == NROUT) { +++ if (++clibseg == &libseg[NSEG]) +++ error(1, "too many files loaded from libraries"); +++ clibseg->li_first = (off_t *)malloc(NROUT * sizeof (off_t)); +++ if (clibseg->li_first == 0) +++ error(1, "ran out of memory (nextlibp)"); + + } - close(infil); +++ clibseg->li_first[clibseg->li_used++] = val; +++ if (val != -1 && Mflag) +++ printf("\t%s\n", archdr.ar_name); + +} + + - /* single file or archive member */ +++/* +++ * One pass over an archive with a table of contents. +++ * Remember the number of symbols currently defined, +++ * then call step on members which look promising (i.e. +++ * that define a symbol which is currently externally undefined). +++ * Indicate to our caller whether this process netted any more symbols. +++ */ +++ldrand() +++{ +++ register struct nlist *sp, **hp; +++ register struct ranlib *tp, *tplast; +++ off_t loc; +++ int nsymt = symx(nextsym); +++ +++ tplast = &tab[tnum-1]; +++ for (tp = tab; tp <= tplast; tp++) { +++ if ((hp = slookup(tp->ran_un.ran_name)) == 0) +++ continue; +++ sp = *hp; +++ if (sp->n_type != N_EXT+N_UNDF) +++ continue; +++ step(tp->ran_off); +++ loc = tp->ran_off; +++ while (tp < tplast && (tp+1)->ran_off == loc) +++ tp++; +++ } +++ return (symx(nextsym) != nsymt); +++} +++ +++/* +++ * Examine a single file or archive member on pass 1. +++ */ + +load1(libflg, loc) - long loc; +++ off_t loc; + +{ - register SYMBOL *sp; - SYMBOL *savnext; - int ndef, nlocal, type; +++ register struct nlist *sp; +++ struct nlist *savnext; +++ int ndef, nlocal, type, size, nsymt; +++ register int i; +++ off_t maxoff; +++ struct stat stb; + + + + readhdr(loc); - ctrel = tsize; - cdrel += dsize; - cbrel += bsize; +++ if (filhdr.a_syms == 0) { +++ if (filhdr.a_text+filhdr.a_data == 0) +++ return (0); +++ error(1, "no namelist"); +++ } +++ if (libflg) +++ maxoff = atol(archdr.ar_size); +++ else { +++ fstat(infil, &stb); +++ maxoff = stb.st_size; +++ } +++ if (N_STROFF(filhdr) + sizeof (off_t) >= maxoff) +++ error(1, "too small (old format .o?)"); +++ ctrel = tsize; cdrel += dsize; cbrel += bsize; + + ndef = 0; + + nlocal = sizeof(cursym); + + savnext = nextsym; - /* if (filhdr.a_trsize+filhdr.a_drsize==0) { - /* error(0, "No relocation bits"); - /* return(0); - /* } - */ - loc += filhdr.a_text + filhdr.a_data + - filhdr.a_trsize + filhdr.a_drsize + sizeof(filhdr); +++ loc += N_SYMOFF(filhdr); + + dseek(&text, loc, filhdr.a_syms); +++ dseek(&reloc, loc + filhdr.a_syms, sizeof(off_t)); +++ mget(&size, sizeof (size), &reloc); +++ dseek(&reloc, loc + filhdr.a_syms+sizeof (off_t), size-sizeof (off_t)); +++ curstr = (char *)malloc(size); +++ if (curstr == NULL) +++ error(1, "no space for string table"); +++ mget(curstr+sizeof(off_t), size-sizeof(off_t), &reloc); + + while (text.size > 0) { - symget(&cursym, &text); - type = cursym.stype; - if ((type&EXTERN)==0) { - if (Xflag==0 || cursym.sname[0]!='L' || type & STABTYPS) +++ mget((char *)&cursym, sizeof(struct nlist), &text); +++ if (cursym.n_un.n_strx) { +++ if (cursym.n_un.n_strx=size) +++ error(1, "bad string table index (pass 1)"); +++ cursym.n_un.n_name = curstr + cursym.n_un.n_strx; +++ } +++ type = cursym.n_type; +++ if ((type&N_EXT)==0) { +++ if (Xflag==0 || cursym.n_un.n_name[0]!='L' || +++ type & N_STAB) + + nlocal += sizeof cursym; + + continue; + + } + + symreloc(); + + if (enter(lookup())) + + continue; - if ((sp = lastsym)->stype != EXTERN+UNDEF) +++ if ((sp = lastsym)->n_type != N_EXT+N_UNDF) + + continue; - if (cursym.stype == EXTERN+UNDEF) { - if (cursym.svalue > sp->svalue) - sp->svalue = cursym.svalue; +++ if (cursym.n_type == N_EXT+N_UNDF) { +++ if (cursym.n_value > sp->n_value) +++ sp->n_value = cursym.n_value; + + continue; + + } - if (sp->svalue != 0 && cursym.stype == EXTERN+TEXT) +++ if (sp->n_value != 0 && cursym.n_type == N_EXT+N_TEXT) + + continue; + + ndef++; - sp->stype = cursym.stype; - sp->svalue = cursym.svalue; +++ sp->n_type = cursym.n_type; +++ sp->n_value = cursym.n_value; + + } + + if (libflg==0 || ndef) { + + tsize += filhdr.a_text; - dsize += round(filhdr.a_data, FW); - bsize += round(filhdr.a_bss, FW); +++ dsize += round(filhdr.a_data, sizeof (long)); +++ bsize += round(filhdr.a_bss, sizeof (long)); + + ssize += nlocal; + + trsize += filhdr.a_trsize; + + drsize += filhdr.a_drsize; - return(1); +++ if (funding) +++ textbase = (*slookup("_end"))->n_value; +++ nsymt = symx(nextsym); +++ for (i = symx(savnext); i < nsymt; i++) { +++ sp = xsym(i); +++ sp->n_un.n_name = savestr(sp->n_un.n_name); +++ } +++ free(curstr); +++ return (1); + + } + + /* + + * No symbols defined by this library member. + + * Rip out the hash table entries and reset the symbol table. + + */ - while (nextsym>savnext) - hshtab[(--nextsym)->symhash]=0; +++ symfree(savnext); +++ free(curstr); + + return(0); + +} + + + +middle() + +{ - register SYMBOL *sp, *symp; +++ register struct nlist *sp; + + long csize, t, corigin, ocsize; + + int nund, rnd; + + char s; +++ register int i; +++ int nsymt; + + + + torigin = 0; + + dorigin = 0; + + borigin = 0; + + - p_data = *slookup("_data"); + + p_etext = *slookup("_etext"); + + p_edata = *slookup("_edata"); + + p_end = *slookup("_end"); + + /* + + * If there are any undefined symbols, save the relocation bits. + + */ - symp = nextsym; +++ nsymt = symx(nextsym); + + if (rflag==0) { - for (sp = symtab; spstype==EXTERN+UNDEF && sp->svalue==0 - && sp!=p_end && sp!=p_edata && sp!=p_etext - && sp!=p_data) { +++ for (i = 0; i < nsymt; i++) { +++ sp = xsym(i); +++ if (sp->n_type==N_EXT+N_UNDF && sp->n_value==0 && +++ sp!=p_end && sp!=p_edata && sp!=p_etext) { + + rflag++; + + dflag = 0; + + break; + + } +++ } + + } + + if (rflag) - sflag = iflag = 0; +++ sflag = zflag = 0; + + /* + + * Assign common locations. + + */ + + csize = 0; - database = round(tsize+textbase, (nflag? PAGRND:FW)); +++ if (!Aflag) +++ addsym = symseg[0].sy_first; +++ database = round(tsize+textbase, +++ (nflag||zflag? PAGSIZ : sizeof (long))); +++ database += hsize; + + if (dflag || rflag==0) { - ldrsym(p_data, (long)0 , EXTERN+DATA); - ldrsym(p_etext, tsize, EXTERN+TEXT); - ldrsym(p_edata, dsize, EXTERN+DATA); - ldrsym(p_end, bsize, EXTERN+BSS); - for (sp = symtab; spstype)==EXTERN+UNDEF && (t = sp->svalue)!=0) { - if (t>DW) - rnd = DW; - else if (t>FW) - rnd = FW; +++ ldrsym(p_etext, tsize, N_EXT+N_TEXT); +++ ldrsym(p_edata, dsize, N_EXT+N_DATA); +++ ldrsym(p_end, bsize, N_EXT+N_BSS); +++ for (i = symx(addsym); i < nsymt; i++) { +++ sp = xsym(i); +++ if ((s=sp->n_type)==N_EXT+N_UNDF && +++ (t = sp->n_value)!=0) { +++ if (t >= sizeof (double)) +++ rnd = sizeof (double); +++ else if (t >= sizeof (long)) +++ rnd = sizeof (long); + + else - rnd = HW; +++ rnd = sizeof (short); + + csize = round(csize, rnd); - sp->svalue = csize; - sp->stype = EXTERN+COMM; +++ sp->n_value = csize; +++ sp->n_type = N_EXT+N_COMM; + + ocsize = csize; + + csize += t; + + } - if (((s&TMASK) == EXTERN+UNDEF) && (s & STABTYPS)) { - sp->svalue = ocsize; - sp->stype = (s & STABTYPS) | (EXTERN+COMM); +++ if (s&N_EXT && (s&N_TYPE)==N_UNDF && s&N_STAB) { +++ sp->n_value = ocsize; +++ sp->n_type = (s&N_STAB) | (N_EXT+N_COMM); + + } + + } + + } + + /* + + * Now set symbols to their final value + + */ - csize = round(csize, FW); +++ csize = round(csize, sizeof (long)); + + torigin = textbase; + + dorigin = database; + + corigin = dorigin + dsize; + + borigin = corigin + csize; - /* - if (zflag) - borigin = round(borigin, PAGRND); - */ - cdorel = 0; - cborel = dsize+csize; + + nund = 0; - for (sp = symtab; spstype & TMASK) { - case EXTERN+UNDEF: - errlev |= 01; - if ((arflag==0 || dflag) && sp->svalue==0) { - if (nund==0) - printf("Undefined:\n"); - nund++; - printf("%.8s\n", sp->sname); +++ nsymt = symx(nextsym); +++ for (i = symx(addsym); in_type & (N_TYPE+N_EXT)) { +++ +++ case N_EXT+N_UNDF: +++ errlev |= 01; +++ if ((arflag==0 || dflag) && sp->n_value==0) { +++ if (sp==p_end || sp==p_etext || sp==p_edata) +++ continue; +++ if (nund==0) +++ printf("Undefined:\n"); +++ nund++; +++ printf("%s\n", sp->n_un.n_name); +++ } +++ continue; +++ case N_EXT+N_ABS: +++ default: +++ continue; +++ case N_EXT+N_TEXT: +++ sp->n_value += torigin; +++ continue; +++ case N_EXT+N_DATA: +++ sp->n_value += dorigin; +++ continue; +++ case N_EXT+N_BSS: +++ sp->n_value += borigin; +++ continue; +++ case N_EXT+N_COMM: +++ sp->n_type = (sp->n_type & N_STAB) | (N_EXT+N_BSS); +++ sp->n_value += corigin; +++ continue; + + } - continue; - - case EXTERN+ABS: - default: - continue; - - case EXTERN+TEXT: - sp->svalue += torigin; - continue; - - case EXTERN+DATA: - sp->svalue += dorigin; - continue; - - case EXTERN+BSS: - sp->svalue += borigin; - continue; - - case EXTERN+COMM: - sp->stype = (sp->stype & STABTYPS) | (EXTERN+BSS); - sp->svalue += corigin; - continue; + + } + + if (sflag || xflag) + + ssize = 0; + + bsize += csize; + + nsym = ssize / (sizeof cursym); +++ if (Aflag) { +++ fixspec(p_etext,torigin); +++ fixspec(p_edata,dorigin); +++ fixspec(p_end,borigin); +++ } +++} +++ +++fixspec(sym,offset) +++ struct nlist *sym; +++ long offset; +++{ +++ +++ if(symx(sym) < symx(addsym) && sym!=0) +++ sym->n_value += offset; + +} + + - ldrsym(asp, val, type) - long val; - SYMBOL *asp; +++ldrsym(sp, val, type) +++ register struct nlist *sp; +++ long val; + +{ - register SYMBOL *sp; + + - if ((sp = asp) == 0) +++ if (sp == 0) + + return; - if (sp->stype != EXTERN+UNDEF || sp->svalue) { - printf("%.8s: ", sp->sname); - error(0, "Multiply defined (internal)"); +++ if ((sp->n_type != N_EXT+N_UNDF || sp->n_value) && !Aflag) { +++ printf("%s: ", sp->n_un.n_name); +++ error(0, "user attempt to redfine loader-defined symbol"); + + return; + + } - sp->stype = type; - sp->svalue = val; +++ sp->n_type = type; +++ sp->n_value = val; + +} + + - extern char _sibuf[BUFSIZ]; /* the space is forced upon us; might as well use it */ +++off_t wroff; +++struct biobuf toutb; + + + +setupout() + +{ + + int bss; - tout = fopen(ofilename, "w"); - if (tout==NULL) - error(1, "cannot create output"); - setbuf(tout,_sibuf); - dout = tcreat(&doutn, "/tmp/ldaaXXXXX"); - if (sflag==0 || xflag==0) - sout = tcreat(&soutn, "/tmp/ldbaXXXXX"); - if (rflag) { - trout = tcreat(&troutn, "/tmp/ldcaXXXXX"); - drout = tcreat(&droutn, "/tmp/lddaXXXXX"); +++ extern char *sys_errlist[]; +++ extern int errno; +++ +++ biofd = creat(ofilename, 0666); +++ if (biofd < 0) { +++ filname = ofilename; /* kludge */ +++ archdr.ar_name[0] = 0; /* kludge */ +++ error(1, sys_errlist[errno]); /* kludge */ + + } - filhdr.a_magic = nflag? NMAGIC:OMAGIC; - if (zflag) - filhdr.a_magic = nflag?0413:0412; - filhdr.a_text = nflag? tsize:round(tsize, FW); - if (zflag) - filhdr.a_text = round(tsize, PAGRND); - filhdr.a_data = dsize; - if (zflag) - filhdr.a_data = round(dsize, PAGRND); +++ tout = &toutb; +++ bopen(tout, 0); +++ filhdr.a_magic = nflag ? NMAGIC : (zflag ? ZMAGIC : OMAGIC); +++ filhdr.a_text = nflag ? tsize : +++ round(tsize, zflag ? PAGSIZ : sizeof (long)); +++ filhdr.a_data = zflag ? round(dsize, PAGSIZ) : dsize; + + bss = bsize - (filhdr.a_data - dsize); + + if (bss < 0) + + bss = 0; + + filhdr.a_bss = bss; + + filhdr.a_trsize = trsize; + + filhdr.a_drsize = drsize; - filhdr.a_syms = sflag? 0: (ssize + (sizeof cursym)*(nextsym-symtab)); +++ filhdr.a_syms = sflag? 0: (ssize + (sizeof cursym)*symx(nextsym)); + + if (entrypt) { - if (entrypt->stype!=EXTERN+TEXT) - error(0, "Entry point not in text"); +++ if (entrypt->n_type!=N_EXT+N_TEXT) +++ error(0, "entry point not in text"); + + else - filhdr.a_entry = entrypt->svalue; +++ filhdr.a_entry = entrypt->n_value; + + } else - filhdr.a_entry=0; +++ filhdr.a_entry = 0; + + filhdr.a_trsize = (rflag ? trsize:0); + + filhdr.a_drsize = (rflag ? drsize:0); - writel(&filhdr,8,tout); - if (zflag) - fseek(tout, PAGSIZ, 0); +++ bwrite((char *)&filhdr, sizeof (filhdr), tout); +++ if (zflag) { +++ bflush1(tout); +++ biobufs = 0; +++ bopen(tout, PAGSIZ); +++ } +++ wroff = N_TXTOFF(filhdr) + filhdr.a_text; +++ outb(&dout, filhdr.a_data); +++ if (rflag) { +++ outb(&trout, filhdr.a_trsize); +++ outb(&drout, filhdr.a_drsize); +++ } +++ if (sflag==0 || xflag==0) { +++ outb(&sout, filhdr.a_syms); +++ wroff += sizeof (offset); +++ outb(&strout, 0); +++ } + +} + + - FILE * - tcreat(namep, name) - char **namep, *name; +++outb(bp, inc) +++ register struct biobuf **bp; + +{ - register FILE *fp; - register char *tnm; - - tnm = mktemp(name); - if ((fp = fopen(tnm, "w")) == NULL) - error(1, "Cannot create temp file"); - chmod(tnm, 0600); - *namep = tnm; - return(fp); +++ +++ *bp = (struct biobuf *)malloc(sizeof (struct biobuf)); +++ if (*bp == 0) +++ error(1, "ran out of memory (outb)"); +++ bopen(*bp, wroff); +++ wroff += inc; + +} + + + +load2arg(acp) + +char *acp; + +{ + + register char *cp; - register LIBLIST *lp; +++ off_t loc; + + + + cp = acp; + + if (getfile(cp) == 0) { + + while (*cp) + + cp++; + + while (cp >= acp && *--cp != '/'); + + mkfsym(++cp); + + load2(0L); + + } else { /* scan archive members referenced */ - for (lp = libp; lp->loc != -1; lp++) { - dseek(&text, lp->loc, (long)sizeof(archdr)); - mget((short *)&archdr, sizeof(archdr), &text); +++ for (;;) { +++ if (clibseg->li_used2 == clibseg->li_used) { +++ if (clibseg->li_used < NROUT) +++ error(1, "libseg botch"); +++ clibseg++; +++ } +++ loc = clibseg->li_first[clibseg->li_used2++]; +++ if (loc == -1) +++ break; +++ dseek(&text, loc, (long)sizeof(archdr)); +++ getarhdr(); + + mkfsym(archdr.ar_name); - load2(lp->loc + (long)sizeof(archdr)); +++ load2(loc + (long)sizeof(archdr)); + + } - libp = ++lp; + + } + + close(infil); + +} + + + +load2(loc) + +long loc; + +{ - register SYMBOL *sp; - register LOCAL *lp; - register int symno; +++ int size; +++ register struct nlist *sp; +++ register struct local *lp; +++ register int symno, i; + + int type; + + + + readhdr(loc); - ctrel = torigin; - cdrel += dorigin; - cbrel += borigin; +++ if (!funding) { +++ ctrel = torigin; +++ cdrel += dorigin; +++ cbrel += borigin; +++ } + + /* + + * Reread the symbol table, recording the numbering + + * of symbols for fixing external references. + + */ - lp = local; +++ for (i = 0; i < LHSIZ; i++) +++ lochash[i] = 0; +++ clocseg = locseg; +++ clocseg->lo_used = 0; + + symno = -1; - loc += sizeof(filhdr); +++ loc += N_TXTOFF(filhdr); +++ dseek(&text, loc+filhdr.a_text+filhdr.a_data+ +++ filhdr.a_trsize+filhdr.a_drsize+filhdr.a_syms, sizeof(off_t)); +++ mget(&size, sizeof(size), &text); +++ dseek(&text, loc+filhdr.a_text+filhdr.a_data+ +++ filhdr.a_trsize+filhdr.a_drsize+filhdr.a_syms+sizeof(off_t), +++ size - sizeof(off_t)); +++ curstr = (char *)malloc(size); +++ if (curstr == NULL) +++ error(1, "out of space reading string table (pass 2)"); +++ mget(curstr+sizeof(off_t), size-sizeof(off_t), &text); + + dseek(&text, loc+filhdr.a_text+filhdr.a_data+ + + filhdr.a_trsize+filhdr.a_drsize, filhdr.a_syms); + + while (text.size > 0) { + + symno++; - symget(&cursym, &text); - symreloc(); - type = cursym.stype; - if ((type&EXTERN) == 0) { +++ mget((char *)&cursym, sizeof(struct nlist), &text); +++ if (cursym.n_un.n_strx) { +++ if (cursym.n_un.n_strx=size) +++ error(1, "bad string table index (pass 2)"); +++ cursym.n_un.n_name = curstr + cursym.n_un.n_strx; +++ } +++/* inline expansion of symreloc() */ +++ switch (cursym.n_type & 017) { +++ +++ case N_TEXT: +++ case N_EXT+N_TEXT: +++ cursym.n_value += ctrel; +++ break; +++ case N_DATA: +++ case N_EXT+N_DATA: +++ cursym.n_value += cdrel; +++ break; +++ case N_BSS: +++ case N_EXT+N_BSS: +++ cursym.n_value += cbrel; +++ break; +++ case N_EXT+N_UNDF: +++ break; +++ default: +++ if (cursym.n_type&N_EXT) +++ cursym.n_type = N_EXT+N_ABS; +++ } +++/* end inline expansion of symreloc() */ +++ type = cursym.n_type; +++ if (yflag && cursym.n_un.n_name) +++ for (i = 0; i < yflag; i++) +++ /* fast check for 2d character! */ +++ if (ytab[i][1] == cursym.n_un.n_name[1] && +++ !strcmp(ytab[i], cursym.n_un.n_name)) { +++ tracesym(); +++ break; +++ } +++ if ((type&N_EXT) == 0) { + + if (!sflag&&!xflag&& - (!Xflag||cursym.sname[0]!='L'||type&STABTYPS)) - symwrite(&cursym, 1, sout); +++ (!Xflag||cursym.n_un.n_name[0]!='L'||type&N_STAB)) +++ symwrite(&cursym, sout); + + continue; + + } +++ if (funding) +++ continue; + + if ((sp = *lookup()) == 0) + + error(1, "internal error: symbol not found"); - if (cursym.stype == EXTERN+UNDEF) { - if (lp >= local+NSYMPR) - error(1, "Local symbol overflow"); - lp->locindex = symno; - lp++->locsymbol = sp; +++ if (cursym.n_type == N_EXT+N_UNDF) { +++ if (clocseg->lo_used == NSYMPR) { +++ if (++clocseg == &locseg[NSEG]) +++ error(1, "local symbol overflow"); +++ clocseg->lo_used = 0; +++ } +++ if (clocseg->lo_first == 0) { +++ clocseg->lo_first = (struct local *) +++ malloc(NSYMPR * sizeof (struct local)); +++ if (clocseg->lo_first == 0) +++ error(1, "out of memory (clocseg)"); +++ } +++ lp = &clocseg->lo_first[clocseg->lo_used++]; +++ lp->l_index = symno; +++ lp->l_symbol = sp; +++ lp->l_link = lochash[symno % LHSIZ]; +++ lochash[symno % LHSIZ] = lp; + + continue; + + } - if(cursym.stype & STABTYPS) continue; - if (cursym.stype!=sp->stype || cursym.svalue!=sp->svalue) { - printf("%.8s: ", cursym.sname); - error(0, "Multiply defined"); +++ if (cursym.n_type & N_STAB) +++ continue; +++ if (cursym.n_type!=sp->n_type || cursym.n_value!=sp->n_value) { +++ printf("%s: ", cursym.n_un.n_name); +++ error(0, "multiply defined"); + + } + + } +++ if (funding) +++ return; + + dseek(&text, loc, filhdr.a_text); + + dseek(&reloc, loc+filhdr.a_text+filhdr.a_data, filhdr.a_trsize); - load2td(lp, ctrel, tout, trout); +++ load2td(ctrel, torigin - textbase, tout, trout); + + dseek(&text, loc+filhdr.a_text, filhdr.a_data); - dseek(&reloc, loc+filhdr.a_text+filhdr.a_data+filhdr.a_trsize, filhdr.a_drsize); - load2td(lp, cdrel, dout, drout); - while (filhdr.a_data&FW) { - putc(0, dout); filhdr.a_data++; +++ dseek(&reloc, loc+filhdr.a_text+filhdr.a_data+filhdr.a_trsize, +++ filhdr.a_drsize); +++ load2td(cdrel, dorigin - database, dout, drout); +++ while (filhdr.a_data & (sizeof(long)-1)) { +++ bputc(0, dout); +++ filhdr.a_data++; + + } + + torigin += filhdr.a_text; - dorigin += filhdr.a_data; - borigin += filhdr.a_bss; - cdorel += filhdr.a_data; - cborel += filhdr.a_bss; +++ dorigin += round(filhdr.a_data, sizeof (long)); +++ borigin += round(filhdr.a_bss, sizeof (long)); +++ free(curstr); + +} + + - load2td(lp, creloc, b1, b2) - LOCAL *lp; - long creloc; - FILE *b1, *b2; +++struct tynames { +++ int ty_value; +++ char *ty_name; +++} tynames[] = { +++ N_UNDF, "undefined", +++ N_ABS, "absolute", +++ N_TEXT, "text", +++ N_DATA, "data", +++ N_BSS, "bss", +++ N_COMM, "common", +++ 0, 0, +++}; +++ +++tracesym() + +{ - register r1; - register char r2; - register long t; - register SYMBOL *sp; - long tw,u,l; - - for (;;) { - if (reloc.size==0) {while (text.size) putc(get(&text),b1); break;} - t=getl(&reloc); /* position of relocatable stuff */ - if (rflag) putl(t+creloc,b2); /* remember for subsequent link editing */ - while (text.posstype==EXTERN+UNDEF) { /* still undefined */ - r2=(r2&(REFMASK+REXT+ROFF)); - r1 = nsym+(sp-symtab); /* new reloc */ +++ for (tp = tynames; tp->ty_name; tp++) +++ if (tp->ty_value == (cursym.n_type&N_TYPE)) +++ break; +++ printf((cursym.n_type&N_TYPE) ? "definition of" : "reference to"); +++ if (cursym.n_type&N_EXT) +++ printf(" external"); +++ if (tp->ty_name) +++ printf(" %s", tp->ty_name); +++ printf(" %s\n", cursym.n_un.n_name); +++} +++ +++/* +++ * This routine relocates the single text or data segment argument. +++ * Offsets from external symbols are resolved by adding the value +++ * of the external symbols. Non-external reference are updated to account +++ * for the relative motion of the segments (ctrel, cdrel, ...). If +++ * a relocation was pc-relative, then we update it to reflect the +++ * change in the positioning of the segments by adding the displacement +++ * of the referenced segment and subtracting the displacement of the +++ * current segment (creloc). +++ * +++ * If we are saving the relocation information, then we increase +++ * each relocation datum address by our base position in the new segment. +++ */ +++load2td(creloc, position, b1, b2) +++ long creloc, offset; +++ struct biobuf *b1, *b2; +++{ +++ register struct nlist *sp; +++ register struct local *lp; +++ long tw; +++ register struct relocation_info *rp, *rpend; +++ struct relocation_info *relp; +++ char *codep; +++ register char *cp; +++ int relsz, codesz; +++ +++ relsz = reloc.size; +++ relp = (struct relocation_info *)malloc(relsz); +++ codesz = text.size; +++ codep = (char *)malloc(codesz); +++ if (relp == 0 || codep == 0) +++ error(1, "out of memory (load2td)"); +++ mget((char *)relp, relsz, &reloc); +++ rpend = &relp[relsz / sizeof (struct relocation_info)]; +++ mget(codep, codesz, &text); +++ for (rp = relp; rp < rpend; rp++) { +++ cp = codep + rp->r_address; +++ /* +++ * Pick up previous value at location to be relocated. +++ */ +++ switch (rp->r_length) { +++ +++ case 0: /* byte */ +++ tw = *cp; +++ break; +++ +++ case 1: /* word */ +++ tw = *(short *)cp; +++ break; +++ +++ case 2: /* long */ +++ tw = *(long *)cp; +++ break; +++ +++ default: +++ error(1, "load2td botch: bad length"); + + } - else { - if (sp->stype==EXTERN+DATA && r2&ROFF) { - r1=RDATAO; - r2&=REFMASK; - } - else if (sp->stype==EXTERN+BSS && r2&ROFF) { - r1=RBSSO; - r2&=REFMASK; - } - else if (sp->stype==EXTERN+ABS && r2&ROFF) { - r1=RABSO; - r2&=REFMASK; +++ /* +++ * If relative to an external which is defined, +++ * resolve to a simpler kind of reference in the +++ * result file. If the external is undefined, just +++ * convert the symbol number to the number of the +++ * symbol in the result file and leave it undefined. +++ */ +++ if (rp->r_extern) { +++ /* +++ * Search the hash table which maps local +++ * symbol numbers to symbol tables entries +++ * in the new a.out file. +++ */ +++ lp = lochash[rp->r_symbolnum % LHSIZ]; +++ while (lp->l_index != rp->r_symbolnum) { +++ lp = lp->l_link; +++ if (lp == 0) +++ error(1, "local symbol botch"); + + } - else if (sp->stype==EXTERN+TEXT && r2&ROFF) { - r1=RTEXTO; - r2&=REFMASK; +++ sp = lp->l_symbol; +++ if (sp->n_type == N_EXT+N_UNDF) +++ rp->r_symbolnum = nsym+symx(sp); +++ else { +++ rp->r_symbolnum = sp->n_type & N_TYPE; +++ tw += sp->n_value; +++ rp->r_extern = 0; + + } - else {if (r2&ROFF) {if (rflag) {error(0,"!-r; see JFR"); rflag=0;}} - else tw += database; - r1=sp->stype&TYPE; - r2&=REFMASK; - } - tw += sp->svalue - database; +++ } else switch (rp->r_symbolnum & N_TYPE) { +++ /* +++ * Relocation is relative to the loaded position +++ * of another segment. Update by the change in position +++ * of that segment. +++ */ +++ case N_TEXT: +++ tw += ctrel; +++ break; +++ case N_DATA: +++ tw += cdrel; +++ break; +++ case N_BSS: +++ tw += cbrel; +++ break; +++ case N_ABS: +++ break; +++ default: +++ error(1, "relocation format botch (symbol type))"); + + } - } else switch (r1&TYMASK) { - case RTEXT: tw += ctrel; break; - case RTEXTO:tw += round(filhdr.a_text,PAGRND)+ctrel-database; break; - case RDATA: tw += cdrel; break; - case RDATAO:tw += cdorel; break; - case RBSS: tw += cbrel; break; - case RBSSO: tw += cborel-filhdr.a_data; break; - case RABSO: tw += round(filhdr.a_text,PAGRND)-database; break; - } - if (rflag) { /* remember for subsequent link editing */ - put3(r1,b2); - putb(r2,b2); - } - if (r2&PCREL) tw -= creloc; /* assembler already subtracted text.pos */ - switch (r2&06) {/* output relocated datum according to its length */ - case LEN1: l= -128; u=127; putc((char)tw,b1); break; - case LEN2: l= -32768; u=32767; puts((short)tw,b1); break; - case LEN4: l=0x80000000; u=0x7FFFFFFF; putl(tw,b1); break; - } - if (twr_pcrel) +++ tw -= creloc; +++ /* +++ * Put the value back in the segment, +++ * while checking for overflow. +++ */ +++ switch (rp->r_length) { +++ +++ case 0: /* byte */ +++ if (tw < -128 || tw > 127) +++ error(0, "byte displacement overflow"); +++ *cp = tw; +++ break; +++ case 1: /* word */ +++ if (tw < -32768 || tw > 32767) +++ error(0, "word displacement overflow"); +++ *(short *)cp = tw; +++ break; +++ case 2: /* long */ +++ *(long *)cp = tw; +++ break; +++ } +++ /* +++ * If we are saving relocation information, +++ * we must convert the address in the segment from +++ * the old .o file into an address in the segment in +++ * the new a.out, by adding the position of our +++ * segment in the new larger segment. +++ */ +++ if (rflag) +++ rp->r_address += position; + + } +++ bwrite(codep, codesz, b1); +++ if (rflag) +++ bwrite(relp, relsz, b2); +++ cfree((char *)relp); +++ cfree(codep); + +} + + + +finishout() + +{ +++ register int i; +++ int nsymt; + + - if (!nflag) - while (tsize&FW) { - putc(0, tout); tsize++; - } - if (zflag) { - while (tsize&PAGRND) { - putc(0, tout); tsize++; - } - while (dsize&PAGRND) { - putc(0, dout); dsize++; - } - } - fclose(dout); - copy(doutn); - if (rflag) { - fclose(trout); - copy(troutn); - fclose(drout); - copy(droutn); - } + + if (sflag==0) { - if (xflag==0) { - fclose(sout); - copy(soutn); - } - symwrite(symtab, nextsym-symtab, tout); +++ nsymt = symx(nextsym); +++ for (i = 0; i < nsymt; i++) +++ symwrite(xsym(i), sout); +++ bwrite(&offset, sizeof offset, sout); + + } - fclose(tout); + + if (!ofilfnd) { + + unlink("a.out"); - link("l.out", "a.out"); +++ if (link("l.out", "a.out") < 0) +++ error(1, "cannot move l.out to a.out"); + + ofilename = "a.out"; + + } + + delarg = errlev; + + delexit(); + +} + + - copy(np) - char *np; - { - register c; - register FILE *fp; - - if ((fp = fopen(np, "r")) == NULL) - error(1, "cannot recopy output"); - while ((c = getc(fp)) != EOF) - putc(c, tout); - fclose(fp); - } - + +mkfsym(s) + +char *s; + +{ + + + + if (sflag || xflag) + + return; - cp8c(s, cursym.sname); - cursym.stype = TEXT; - cursym.svalue = torigin; - symwrite(&cursym, 1, sout); +++ cursym.n_un.n_name = s; +++ cursym.n_type = N_TEXT; +++ cursym.n_value = torigin; +++ symwrite(&cursym, sout); +++} +++ +++getarhdr() +++{ +++ register char *cp; +++ +++ mget((char *)&archdr, sizeof archdr, &text); +++ for (cp=archdr.ar_name; cp<&archdr.ar_name[sizeof(archdr.ar_name)];) +++ if (*cp++ == ' ') { +++ cp[-1] = 0; +++ return; +++ } + +} + + + +mget(loc, n, sp) + +register STREAM *sp; + +register char *loc; + +{ + + register char *p; +++ register int take; + + - if ((sp->nibuf -= n) >= 0) { - if ((sp->size -= n) > 0) { - p = sp->ptr; - sp->pos += n; - do - *loc++ = *p++; - while (--n); - sp->ptr = p; - return; - } else - sp->size += n; +++top: +++ if (n == 0) +++ return; +++ if (sp->size && sp->nibuf) { +++ p = sp->ptr; +++ take = sp->size; +++ if (take > sp->nibuf) +++ take = sp->nibuf; +++ if (take > n) +++ take = n; +++ n -= take; +++ sp->size -= take; +++ sp->nibuf -= take; +++ sp->pos += take; +++ do +++ *loc++ = *p++; +++ while (--take > 0); +++ sp->ptr = p; +++ goto top; + + } - sp->nibuf += n; - do { - *loc++ = get(sp); - } while (--n); - } - - short - gets(sp) STREAM *sp; { - short t; mget(&t,2,sp); return(t); - } - - char - getb(sp) STREAM *sp; { - char t; mget(&t,1,sp); return(t); - } - - long - get3(sp) STREAM *sp; { - long t; t=0; mget(&t,3,sp); return(t); - } - - long - getl(sp) STREAM *sp; { - long t; mget(&t,4,sp); - #ifndef vax - fixl(&t); - #endif - return(t); +++ if (n > BUFSIZ) { +++ take = n - n % BSIZE; +++ lseek(infil, (sp->bno+1)*BSIZE, 0); +++ if (take > sp->size || read(infil, loc, take) != take) +++ error(1, "premature EOF"); +++ loc += take; +++ n -= take; +++ sp->size -= take; +++ sp->pos += take; +++ dseek(sp, (sp->bno+1+take/BSIZE)*BSIZE, -1); +++ goto top; +++ } +++ *loc++ = get(sp); +++ --n; +++ goto top; + +} + + - symget(sp,f) SYMBOL *sp; STREAM *f; { - mget(sp,sizeof(*sp),f); - #ifndef vax - fixl(&sp->svalue); - #endif +++symwrite(sp, bp) +++ struct nlist *sp; +++ struct biobuf *bp; +++{ +++ register int len; +++ register char *str; +++ +++ str = sp->n_un.n_name; +++ if (str) { +++ sp->n_un.n_strx = offset; +++ len = strlen(str) + 1; +++ bwrite(str, len, strout); +++ offset += len; +++ } +++ bwrite(sp, sizeof (*sp), bp); +++ sp->n_un.n_name = str; + +} + + + +dseek(sp, loc, s) + +register STREAM *sp; + +long loc, s; + +{ + + register PAGE *p; + + register b, o; + + int n; + + + + b = loc>>BSHIFT; + + o = loc&BMASK; + + if (o&01) + + error(1, "loader error; odd offset"); + + --sp->pno->nuser; + + if ((p = &page[0])->bno!=b && (p = &page[1])->bno!=b) + + if (p->nuser==0 || (p = &page[0])->nuser==0) { + + if (page[0].nuser==0 && page[1].nuser==0) + + if (page[0].bno < page[1].bno) + + p = &page[0]; + + p->bno = b; + + lseek(infil, loc & ~(long)BMASK, 0); + + if ((n = read(infil, p->buff, sizeof(p->buff))) < 0) + + n = 0; + + p->nibuf = n; + + } else - error(1, "No pages"); +++ error(1, "botch: no pages"); + + ++p->nuser; + + sp->bno = b; + + sp->pno = p; + + if (s != -1) {sp->size = s; sp->pos = 0;} - sp->ptr = (short *)(p->buff + o); +++ sp->ptr = (char *)(p->buff + o); + + if ((sp->nibuf = p->nibuf-o) <= 0) + + sp->size = 0; + +} + + + +char + +get(asp) + +STREAM *asp; + +{ + + register STREAM *sp; + + + + sp = asp; + + if ((sp->nibuf -= sizeof(char)) < 0) { + + dseek(sp, ((long)(sp->bno+1)<nibuf -= sizeof(char); + + } + + if ((sp->size -= sizeof(char)) <= 0) { + + if (sp->size < 0) - error(1, premeof); +++ error(1, "premature EOF"); + + ++fpage.nuser; + + --sp->pno->nuser; - sp->pno = &fpage; +++ sp->pno = (PAGE *) &fpage; + + } + + sp->pos += sizeof(char); + + return(*sp->ptr++); + +} + + + +getfile(acp) - STRING acp; +++char *acp; + +{ - register STRING cp; +++ register char *cp; + + register int c; - int arcmag; +++ char arcmag[SARMAG+1]; +++ struct stat stb; + + + + cp = acp; + + infil = -1; + + archdr.ar_name[0] = '\0'; + + filname = cp; + + if (cp[0]=='-' && cp[1]=='l') { + + char *locfilname = "/usr/local/lib/libxxxxxxxxxxxxxxx"; + + if(cp[2] == '\0') + + cp = "-la"; + + filname = "/usr/lib/libxxxxxxxxxxxxxxx"; + + for(c=0; cp[c+2]; c++) { + + filname[c+12] = cp[c+2]; + + locfilname[c+18] = cp[c+2]; + + } + + filname[c+12] = locfilname[c+18] = '.'; + + filname[c+13] = locfilname[c+19] = 'a'; + + filname[c+14] = locfilname[c+20] = '\0'; + + if ((infil = open(filname+4, 0)) >= 0) { + + filname += 4; + + } else if ((infil = open(filname, 0)) < 0) { + + filname = locfilname; + + } + + } + + if (infil == -1 && (infil = open(filname, 0)) < 0) + + error(1, "cannot open"); + + page[0].bno = page[1].bno = -1; + + page[0].nuser = page[1].nuser = 0; - text.pno = reloc.pno = &fpage; +++ text.pno = reloc.pno = (PAGE *) &fpage; + + fpage.nuser = 2; - dseek(&text, 0L, (long)sizeof(int)); +++ dseek(&text, 0L, SARMAG); + + if (text.size <= 0) - error(1, premeof); - mget(&arcmag, sizeof(arcmag), &text); - return(arcmag==ARMAG); +++ error(1, "premature EOF"); +++ mget((char *)arcmag, SARMAG, &text); +++ arcmag[SARMAG] = 0; +++ if (strcmp(arcmag, ARMAG)) +++ return (0); +++ dseek(&text, SARMAG, sizeof archdr); +++ if(text.size <= 0) +++ return (1); +++ getarhdr(); +++ if (strncmp(archdr.ar_name, "__.SYMDEF", sizeof(archdr.ar_name)) != 0) +++ return (1); +++ fstat(infil, &stb); +++ return (stb.st_mtime > atol(archdr.ar_date) ? 3 : 2); + +} + + - SYMBOL **lookup() +++struct nlist ** +++lookup() + +{ - int i; - BOOL clash; - register SYMBOL **hp; +++ register int sh; +++ register struct nlist **hp; + + register char *cp, *cp1; +++ register struct symseg *gp; +++ register int i; +++ +++ sh = 0; +++ for (cp = cursym.n_un.n_name; *cp;) +++ sh = (sh<<1) + *cp++; +++ sh = (sh & 0x7fffffff) % HSIZE; +++ for (gp = symseg; gp < &symseg[NSEG]; gp++) { +++ if (gp->sy_first == 0) { +++ gp->sy_first = (struct nlist *) +++ calloc(NSYM, sizeof (struct nlist)); +++ gp->sy_hfirst = (struct nlist **) +++ calloc(HSIZE, sizeof (struct nlist *)); +++ if (gp->sy_first == 0 || gp->sy_hfirst == 0) +++ error(1, "ran out of space for symbol table"); +++ gp->sy_last = gp->sy_first + NSYM; +++ gp->sy_hlast = gp->sy_hfirst + HSIZE; +++ } +++ if (gp > csymseg) +++ csymseg = gp; +++ hp = gp->sy_hfirst + sh; +++ i = 1; +++ do { +++ if (*hp == 0) { +++ if (gp->sy_used == NSYM) +++ break; +++ return (hp); +++ } +++ cp1 = (*hp)->n_un.n_name; +++ for (cp = cursym.n_un.n_name; *cp == *cp1++;) +++ if (*cp++ == 0) +++ return (hp); +++ hp += i; +++ i += 2; +++ if (hp >= gp->sy_hlast) +++ hp -= HSIZE; +++ } while (i < HSIZE); +++ if (i > HSIZE) +++ error(1, "hash table botch"); +++ } +++ error(1, "symbol table overflow"); +++ /*NOTREACHED*/ +++} + + - i = 0; - for (cp = cursym.sname; cp < &cursym.sname[8];) - i = (i<<1) + *cp++; - for (hp = &hshtab[(i&077777)%NSYM+2]; *hp!=0;) { - cp1 = (*hp)->sname; - clash=FALSE; - for (cp = cursym.sname; cp < &cursym.sname[8];) - if (*cp++ != *cp1++) { - clash=TRUE; - break; +++symfree(saved) +++ struct nlist *saved; +++{ +++ register struct symseg *gp; +++ register struct nlist *sp; +++ +++ for (gp = csymseg; gp >= symseg; gp--, csymseg--) { +++ sp = gp->sy_first + gp->sy_used; +++ if (sp == saved) { +++ nextsym = sp; +++ return; +++ } +++ for (sp--; sp >= gp->sy_first; sp--) { +++ gp->sy_hfirst[sp->n_hash] = 0; +++ gp->sy_used--; +++ if (sp == saved) { +++ nextsym = sp; +++ return; + + } - if (clash) { - if (++hp >= &hshtab[NSYM+2]) - hp = hshtab; - } else - break; +++ } + + } - return(hp); +++ if (saved == 0) +++ return; +++ error(1, "symfree botch"); + +} + + - SYMBOL **slookup(s) - char *s; +++struct nlist ** +++slookup(s) +++ char *s; + +{ - cp8c(s, cursym.sname); - cursym.stype = EXTERN+UNDEF; - cursym.svalue = 0; - return(lookup()); +++ +++ cursym.n_un.n_name = s; +++ cursym.n_type = N_EXT+N_UNDF; +++ cursym.n_value = 0; +++ return (lookup()); + +} + + + +enter(hp) - register SYMBOL **hp; +++register struct nlist **hp; + +{ - register SYMBOL *sp; +++ register struct nlist *sp; + + + + if (*hp==0) { - if ((nextsym-symtab)>=NSYM) - error(1, "Symbol table overflow"); - if ((nextsym-symtab)>=nsym) { - if (-1==sbrk(NSYM/5 * sizeof(*symtab))) error(1,"Memory overflow"); - nsym += NSYM/5; - } - *hp = lastsym = sp = nextsym++; - cp8c(cursym.sname, sp->sname); - sp->stype = cursym.stype; - sp->symhash = hp-hshtab; - sp->svalue = cursym.svalue; +++ if (hp < csymseg->sy_hfirst || hp >= csymseg->sy_hlast) +++ error(1, "enter botch"); +++ *hp = lastsym = sp = csymseg->sy_first + csymseg->sy_used; +++ csymseg->sy_used++; +++ sp->n_un.n_name = cursym.n_un.n_name; +++ sp->n_type = cursym.n_type; +++ sp->n_hash = hp - csymseg->sy_hfirst; +++ sp->n_value = cursym.n_value; +++ nextsym = lastsym + 1; + + return(1); + + } else { + + lastsym = *hp; + + return(0); + + } + +} + + +++symx(sp) +++ struct nlist *sp; +++{ +++ register struct symseg *gp; +++ +++ if (sp == 0) +++ return (0); +++ for (gp = csymseg; gp >= symseg; gp--) +++ /* <= is sloppy so nextsym will always work */ +++ if (sp >= gp->sy_first && sp <= gp->sy_last) +++ return ((gp - symseg) * NSYM + sp - gp->sy_first); +++ error(1, "symx botch"); +++ /*NOTREACHED*/ +++} +++ + +symreloc() + +{ - switch (cursym.stype & 017) { +++ if(funding) return; +++ switch (cursym.n_type & 017) { +++ +++ case N_TEXT: +++ case N_EXT+N_TEXT: +++ cursym.n_value += ctrel; +++ return; + + - case TEXT: - case EXTERN+TEXT: - cursym.svalue += ctrel; +++ case N_DATA: +++ case N_EXT+N_DATA: +++ cursym.n_value += cdrel; + + return; + + - case DATA: - case EXTERN+DATA: - cursym.svalue += cdrel; +++ case N_BSS: +++ case N_EXT+N_BSS: +++ cursym.n_value += cbrel; + + return; + + - case BSS: - case EXTERN+BSS: - cursym.svalue += cbrel; +++ case N_EXT+N_UNDF: + + return; + + - case EXTERN+UNDEF: +++ default: +++ if (cursym.n_type&N_EXT) +++ cursym.n_type = N_EXT+N_ABS; + + return; + + } - if (cursym.stype&EXTERN) - cursym.stype = EXTERN+ABS; + +} + + + +error(n, s) + +char *s; + +{ +++ + + if (errlev==0) + + printf("ld:"); + + if (filname) { + + printf("%s", filname); - if (archdr.ar_name[0]) - printf("(%.14s)", archdr.ar_name); +++ if (n != -1 && archdr.ar_name[0]) +++ printf("(%s)", archdr.ar_name); + + printf(": "); + + } + + printf("%s\n", s); +++ if (n == -1) +++ return; + + if (n) + + delexit(); + + errlev = 2; + +} + + - SYMBOL * - lookloc(lp, r) - register LOCAL *lp; - { - register LOCAL *clp; - register sn; - - sn = r; - for (clp = local; clplocindex == sn) - return(clp->locsymbol); - error(1, "Local symbol botch"); - } - + +readhdr(loc) - long loc; +++off_t loc; + +{ - long *p; int i; +++ + + dseek(&text, loc, (long)sizeof(filhdr)); + + mget((short *)&filhdr, sizeof(filhdr), &text); - #ifndef vax - for (p= &filhdr,i=8;--i>=0;) fixl(p++); - #endif - if (filhdr.a_magic!=A_MAGIC1 && filhdr.a_magic!=A_MAGIC2 && - filhdr.a_magic!=A_MAGIC3 && filhdr.a_magic!=A_MAGIC4) - error(1,"Bad magic number"); - if (filhdr.a_text&01 || filhdr.a_data&01) { - printf("tsize=%X dsize=%X\n",filhdr.a_text,filhdr.a_data); - error(1, "Text/data size odd"); +++ if (N_BADMAG(filhdr)) { +++ if (filhdr.a_magic == OARMAG) +++ error(1, "old archive"); +++ error(1, "bad magic number"); + + } - filhdr.a_bss = round(filhdr.a_bss, FW); - if (filhdr.a_magic == NMAGIC) { - cdrel = -round(filhdr.a_text, PAGRND); +++ if (filhdr.a_text&01 || filhdr.a_data&01) +++ error(1, "text/data size odd"); +++ if (filhdr.a_magic == NMAGIC || filhdr.a_magic == ZMAGIC) { +++ cdrel = -round(filhdr.a_text, PAGSIZ); + + cbrel = cdrel - filhdr.a_data; + + } else if (filhdr.a_magic == OMAGIC) { + + cdrel = -filhdr.a_text; + + cbrel = cdrel - filhdr.a_data; + + } else - error(1, "Bad format"); +++ error(1, "bad format"); + +} + + - cp8c(from, to) - char *from, *to; +++round(v, r) +++ int v; +++ u_long r; + +{ - register char *f, *t, *te; - - f = from; - t = to; - te = t+8; - while ((*t++ = *f++) && t saveleft) { +++ saveleft = NSAVETAB; +++ if (len > saveleft) +++ saveleft = len; +++ savetab = (char *)malloc(saveleft); +++ if (savetab == 0) +++ error(1, "ran out of memory (savestr)"); +++ } +++ strncpy(savetab, cp, len); +++ cp = savetab; +++ savetab += len; +++ saveleft -= len; +++ return (cp); + +} + + - long - round(v, r) - long v; - unsigned r; +++bopen(bp, off) +++ struct biobuf *bp; + +{ - v += r; - v &= ~(long)r; - return(v); +++ +++ bp->b_ptr = bp->b_buf; +++ bp->b_nleft = BUFSIZ - off % BUFSIZ; +++ bp->b_off = off; +++ bp->b_link = biobufs; +++ biobufs = bp; + +} + + - puts(w, f) - FILE *f; short w; { - fwrite(&w,sizeof(short),1,f); +++int bwrerror; +++ +++bwrite(p, cnt, bp) +++ register char *p; +++ register int cnt; +++ register struct biobuf *bp; +++{ +++ register int put; +++ register char *to; +++ +++top: +++ if (cnt == 0) +++ return; +++ if (bp->b_nleft) { +++ put = bp->b_nleft; +++ if (put > cnt) +++ put = cnt; +++ bp->b_nleft -= put; +++ to = bp->b_ptr; +++ asm("movc3 r8,(r11),(r7)"); +++ bp->b_ptr += put; +++ p += put; +++ cnt -= put; +++ goto top; +++ } +++ if (cnt >= BUFSIZ) { +++ if (bp->b_ptr != bp->b_buf) +++ bflush1(bp); +++ put = cnt - cnt % BUFSIZ; +++ if (boffset != bp->b_off) +++ lseek(biofd, bp->b_off, 0); +++ if (write(biofd, p, put) != put) { +++ bwrerror = 1; +++ error(1, "output write error"); +++ } +++ bp->b_off += put; +++ boffset = bp->b_off; +++ p += put; +++ cnt -= put; +++ goto top; +++ } +++ bflush1(bp); +++ goto top; + +} + + - putb(w, f) - FILE *f; char w; { - fwrite(&w,sizeof(char),1,f); +++bflush() +++{ +++ register struct biobuf *bp; +++ +++ if (bwrerror) +++ return; +++ for (bp = biobufs; bp; bp = bp->b_link) +++ bflush1(bp); + +} + + - put3(w, f) - FILE *f; long w; { - fwrite(&w,3,1,f); +++bflush1(bp) +++ register struct biobuf *bp; +++{ +++ register int cnt = bp->b_ptr - bp->b_buf; +++ +++ if (cnt == 0) +++ return; +++ if (boffset != bp->b_off) +++ lseek(biofd, bp->b_off, 0); +++ if (write(biofd, bp->b_buf, cnt) != cnt) { +++ bwrerror = 1; +++ error(1, "output write error"); +++ } +++ bp->b_off += cnt; +++ boffset = bp->b_off; +++ bp->b_ptr = bp->b_buf; +++ bp->b_nleft = BUFSIZ; + +} + + - putl(w, f) - FILE *f; long w; { - #ifndef vax - fixl(&w); - #endif - fwrite(&w,sizeof(long),1,f); +++bflushc(bp, c) +++ register struct biobuf *bp; +++{ +++ +++ bflush1(bp); +++ bputc(c, bp); + +} diff --cc usr/src/cmd/leave.c index 0000000000,c996aea528,0000000000..a61fd8c6c5 mode 000000,100644,000000..100644 --- a/usr/src/cmd/leave.c +++ b/usr/src/cmd/leave.c @@@@ -1,0 -1,152 -1,0 +1,172 @@@@ - #include +++static char *sccsid = "@(#)leave.c 4.1 (Berkeley) 10/1/80"; +++#include + +/* - * leave - reminds you when you have to leave. - * leave prompts for input and goes away if you hit return. - * it nags you like a mother hen. +++ * leave [hhmm] +++ * +++ * Reminds you when you have to leave. +++ * Leave prompts for input and goes away if you hit return. +++ * It nags you like a mother hen. + + */ + +char origlogin[20], thislogin[20]; + +char *getlogin(); + +char *whenleave; + +char *ctime(); + +char buff[100]; + + - main(argc,argv) char **argv; { +++main(argc,argv) +++char **argv; +++{ + + long when, tod, now, diff, hours, minutes; + + int *nv; + + int atoi(); + + int *localtime(); + + + + if (argc < 2) { + + printf("When do you have to leave? "); +++ fflush(stdout); + + buff[read(0,buff,sizeof buff)] = 0; + + } else { + + strcpy(buff,argv[1]); + + } - if (buff[0] == '\n') exit(0); +++ +++ if (buff[0] == '\n') +++ exit(0); + + if (buff[0] == '+') { + + diff = atoi(buff+1); + + doalarm(diff); + + } + + if (buff[0] < '0' || buff[0] > '9') { + + printf("usage: %s [hhmm]\n",argv[0]); + + exit(1); + + } + + strcpy(origlogin,getlogin()); + + + + tod = atoi(buff); + + hours = tod / 100; - if (hours > 12) hours -= 12; - if (hours == 12) hours = 0; +++ if (hours > 12) +++ hours -= 12; +++ if (hours == 12) +++ hours = 0; + + minutes = tod % 100; + + + + if (hours < 0 || hours > 12 || minutes < 0 || minutes > 59) { + + printf("usage: %s [hhmm]\n",argv[0]); + + exit(1); + + } + + + + setexit(); /* refigure time if killed */ + + time(&now); + + nv = localtime(&now); + + when = 60*hours+minutes; + + if (nv[2] > 12) nv[2] -= 12; /* do am/pm bit */ + + now = 60*nv[2] + nv[1]; + + diff = when - now; + + while (diff < 0) + + diff += 12*60; + + if (diff > 11*60) printf("That time has already passed!\n"); + + doalarm(diff); + + exit(0); + +} + + + + - doalarm(nmins) long nmins; { +++doalarm(nmins) +++long nmins; +++{ + + char *msg1, *msg2, *msg3, *msg4; + + register int i; + + int slp1, slp2, slp3, slp4; + + int seconds, gseconds; + + long daytime; + + + + seconds = 60 * nmins; - if (seconds <= 0) seconds = 1; +++ if (seconds <= 0) +++ seconds = 1; + + gseconds = seconds; + + + + msg1 = "You have to leave in 5 minutes"; + + if (seconds <= 60*5) { + + slp1 = 0; + + } else { + + slp1 = seconds - 60*5; + + seconds = 60*5; + + } + + + + msg2 = "Just one more minute!"; + + if (seconds <= 60) { + + slp2 = 0; + + } else { + + slp2 = seconds - 60; + + seconds = 60; + + } + + + + msg3 = "Time to leave!"; + + slp3 = seconds; + + + + msg4 = "You're going to be late!"; + + slp4 = 60; + + + + time(&daytime); + + daytime += gseconds; + + whenleave = ctime(&daytime); + + printf("Alarm set for %s\n",whenleave); - if (fork()) exit(0); +++ if (fork()) +++ exit(0); + + signal(2,1); + + signal(3,1); - signal(15,1/*nag*/); +++ signal(15,1); + + + + if (slp1) + + bother(slp1,msg1); + + if (slp2) + + bother(slp2,msg2); + + bother(slp3,msg3); + + for (;;) { + + bother(slp4,msg4); + + } + +} + + - bother(slp,msg) int slp; char *msg; { +++bother(slp,msg) +++int slp; +++char *msg; +++{ + + + + delay(slp); + + printf("\7\7\7"); + + printf("%s\n",msg); + +} + + + +/* + + * delay is like sleep but does it in 100 sec pieces and + + * knows what zero means. + + */ + +delay(secs) int secs; { + + int n; + + + + while(secs>0) { + + n = 100; + + secs = secs - 100; + + if (secs < 0) { + + n = n + secs; + + } - if (n > 0) sleep(n); +++ if (n > 0) +++ sleep(n); + + strcpy(thislogin,getlogin()); - if (strcmp(origlogin, thislogin)) exit(0); +++ if (strcmp(origlogin, thislogin)) +++ exit(0); + + } + +} + + - #ifndef VAX +++#ifdef V6 + +char *getlogin() { + +#include +++ + + static struct utmp ubuf; + + int ufd; + + + + ufd = open("/etc/utmp",0); + + seek(ufd, ttyn(0)*sizeof(ubuf), 0); + + read(ufd, &ubuf, sizeof(ubuf)); - ubuf.ut_name[8] = 0; +++ ubuf.ut_name[sizeof(ubuf.ut_name)] = 0; + + return(&ubuf.ut_name); + +} + +#endif diff --cc usr/src/cmd/lisp/Orderit.s index 0000000000,0000000000,0000000000..e13755ffd0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/Orderit.s @@@@ -1,0 -1,0 -1,0 +1,74 @@@@ +++ .data +++ .asciz "@(#)Orderit.s 34.1 10/13/80" +++ .text +++.long _Xargc +++.long _Xargv +++.long __sobuf +++.long _retval +++.long _orgbnp +++.long _orgnp +++.long _rlevel +++.long _errp +++.long _piport +++.long _poport +++.long _vtemp +++.long _bnp +++.long _sigintcnt +++.long _rsetsw +++.long _lispsys +++.long _stattab +++.long _bnplim +++.long _nplim +++.long _chkport +++.long _zeroq +++.long _atmlen +++.long _hunk_items +++.long _hunk_pages +++.long _hunk_name +++.long _itemp +++.long _header +++.long _strbuf +++.long _GCtime +++.long _datalim +++.long _beginsweep +++.long _usehole +++.long _curhbeg +++.long _hasht +++.long _exception +++.long _hash +++.long _sigstruck +++.long _sigacts +++.long _sigdelay +++.long _keywait +++.long _atomval +++.long _lastrtab +++.long _rbktf +++.long _rdrport +++.long _contval +++.long _errport +++.long _tint +++.long _gftab +++.long _proport +++.long _namptr +++.long _bcdtrsw +++.long _ftemp +++.long _argptr +++.long _ttemp +++.long _lctrace +++.long _trcur +++.long _end +++.long _pbuf +++.long _mcounts +++.long _globtag +++.long _syml +++.long _fakenp +++.long _fakelbot +++.long _errno +++.long __sibuf +++.long _zfreespace +++.long _bitmapq +++ .data +++ .globl _firstalloc +++_firstalloc: +++ .long 0x78 +++ .space 508 diff --cc usr/src/cmd/lisp/Talloc.c index 0000000000,5f61bf4439,0000000000..5a3af699aa mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/Talloc.c +++ b/usr/src/cmd/lisp/Talloc.c @@@@ -1,0 -1,727 -1,0 +1,987 @@@@ +++ +++static char *sccsid = "@(#)Talloc.c 34.11 10/31/80"; +++ + +# include "global.h" +++# include "structs.h" +++# ifndef UNIXTS +++# include +++# endif + + + +# define NUMWORDS TTSIZE * 128 /* max number of words in P0 space */ + +# define BITQUADS TTSIZE * 2 /* length of bit map in quad words */ + + + +# define ftstbit asm(" ashl $-2,r11,r3");\ + + asm(" bbcs r3,_bitmapq,$1");\ + + asm(" .byte 4"); + +/* define ftstbit if( readbit(p) ) return; oksetbit; */ + +# define readbit(p) ((int)bitmap[r=(int)p>>5] & (s=bitmsk[((int)p>>2)&7])) + +# define lookbit(p) (bitmap[(int)p>>5] & bitmsk[((int)p>>2) & 7]) + +# define setbit(p) {bitmap[(int)p>>5] |= bitmsk[((int)p >> 2) & 7];} + +# define oksetbit {bitmap[r] |= s;} + + + +# define readchk(p) ((int)bitfre[(int)p>>5] & bitmsk[((int)p>>2)&7]) + +# define setchk(p) {bitfre[(int)p>>5] |= bitmsk[((int)p >> 2) & 7];} +++# define roundup(x,l) (((x - 1) | (l - 1)) + 1) +++ +++/* METER denotes something added to help meter storage allocation. */ + + - struct heads { - struct heads *link; - char *pntr; - } header[TTSIZE]; +++extern struct heads header[]; + + + +FILE * chkport; /* garbage collection dump file */ - lispval datalim; /* end of data space */ +++extern lispval datalim; /* end of data space */ + +double bitmapq[BITQUADS]; /* the bit map--one bit per long */ +++#ifdef METER +++double Mbitmapq[BITQUADS]; +++#endif + +double zeroq; /* a quad word of zeros */ + +char *bitmap = (char *) bitmapq; /* byte version of bit map array */ +++int *bitmapi = (int *) bitmapq; /* integer version of bit map array */ +++#ifdef METER +++int *Mbitmapi = (int *) Mbitmapq; /* integer version of bit map array */ +++int freefree,usedfree,freeused,usedused; +++#endif +++#ifndef METER +++int freefree,usedfree,freeused,usedused; /* need so external refs will be +++ satisfied, remove when get rid +++ of meter stuff +++ */ +++#endif + +char bitmsk[8]={1,2,4,8,16,32,64,128}; /* used by bit-marking macros */ - int *bind_lists = (int *) CNIL; /* lisp data for compiled code */ +++extern int *bind_lists ; /* lisp data for compiled code */ + + + +char *xsbrk(); +++char *gethspace(); + + + + + +int atmlen; + + - struct types { - char *next_free; - int space_left, - space, - type, - type_len; /* note type_len is in units of int */ - lispval *items, - *pages, - *type_name; - struct heads - *first; - } atom_str = {(char *)CNIL,0,ATOMSPP,ATOM,5,&atom_items,&atom_pages,&atom_name,(struct heads *)CNIL}, - strng_str = {(char *)CNIL,0,STRSPP,STRNG,1,&str_items,&str_pages,&str_name,(struct heads *)CNIL}, - int_str = {(char *)CNIL,0,INTSPP,INT,1,&int_items,&int_pages,&int_name,(struct heads *)CNIL}, - dtpr_str = {(char *)CNIL,0,DTPRSPP,DTPR,2,&dtpr_items,&dtpr_pages,&dtpr_name,(struct heads *)CNIL}, - doub_str = {(char *)CNIL,0,DOUBSPP,DOUB,2,&doub_items,&doub_pages,&doub_name,(struct heads *)CNIL}, - array_str = {(char *)CNIL,0,ARRAYSPP,ARRAY,5,&array_items,&array_pages,&array_name,(struct heads *)CNIL}, - sdot_str = {(char *)CNIL,0,SDOTSPP,SDOT,2,&sdot_items,&sdot_pages,&sdot_name,(struct heads *)CNIL}, - val_str = {(char *)CNIL,0,VALSPP,VALUE,1,&val_items,&val_pages,&val_name,(struct heads *)CNIL}, - funct_str = {(char *)CNIL,0,BCDSPP,BCD,2,&funct_items,&funct_pages,&funct_name,(struct heads *)CNIL}; +++extern struct types atom_str, strng_str, int_str, dtpr_str, doub_str, +++ array_str, sdot_str, val_str, funct_str, hunk_str[]; +++ +++lispval hunk_items[7], hunk_pages[7], hunk_name[7]; + + + +extern int initflag; /* starts off TRUE: initially gc not allowed */ + + + +int gcflag = FALSE; /* TRUE during garbage collection */ + + + +int current = 0; /* number of pages currently allocated */ + + - #define NUMSPACES 9 - + +static struct types *(spaces[NUMSPACES]) = + + {&atom_str, &strng_str, &int_str, + + &dtpr_str, &doub_str, &array_str, - &sdot_str, &val_str, &funct_str}; +++ &sdot_str, &val_str, &funct_str, +++ &hunk_str[0], &hunk_str[1], &hunk_str[2], +++ &hunk_str[3], &hunk_str[4], &hunk_str[5], +++ &hunk_str[6]}; +++ +++/* this is a table of pointers to collectable struct types objects +++ * the index is the type number. +++ */ +++struct types *gcableptr[] = +++ { (struct types *) 0, /* strings not collectable */ +++ (struct types *) 0, /* atoms not collectable */ +++ &int_str, &dtpr_str, &doub_str, +++ (struct types *) 0, /* binary objects not collectable */ +++ (struct types *) 0, /* port objects not collectable */ +++ &array_str, +++ (struct types *) 0, /* gap in the type number sequence */ +++ &sdot_str,&val_str, +++ &hunk_str[0], &hunk_str[1], &hunk_str[2], +++ &hunk_str[3], &hunk_str[4], &hunk_str[5], +++ &hunk_str[6]}; + + + + + +/** get_more_space(type_struct) *****************************************/ + +/* */ + +/* Allocates and structures a new page, returning 0. */ + +/* If no space is available, returns 1. */ + + + +get_more_space(type_struct) + +struct types *type_struct; + +{ + + int cntr; + + char *start; + + int *loop, *temp; + + lispval p, plim; - struct heads *next; +++ struct heads *next; extern char holend[]; + + + + if(initflag == FALSE) + + /* mustn't look at plist of plima too soon */ + + { + + while( plim=copval(plima,(lispval)CNIL), TYPE(plim)!=INT ) + + copval(plima,error("BAD PAGE LIMIT",TRUE)); + + if( plim->i <= current ) return(1); /* Can't allocate */ + + } + + + + if( current >= TTSIZE ) return(2); + + - start = xsbrk( NBPG ); +++#ifdef HOLE +++ if(type_struct==&strng_str || (type_struct==&funct_str)) +++ start = gethspace(NBPG,type_struct->type); +++ else +++#endif +++ start = xsbrk(); +++ +++ +++ SETTYPE(start, type_struct->type); /* set type of page */ + + + + /* bump the page counter for this space */ + + + + ++((*(type_struct->pages))->i); + + - SETTYPE(start, type_struct->type); /* set type of page */ - + + type_struct->space_left = type_struct->space; - next = &header[ current++ ]; - if ((type_struct->type)==STRNG) - { +++ if(start >= holend) { +++ next = &header[ current++ ]; +++ next->pntr = start; +++ next->link = type_struct->first; +++ type_struct->first = next; +++ } +++ if(type_struct==&strng_str) { + + type_struct->next_free = start; + + return(0); /* space was available */ - } - next->pntr = start; - next->link = type_struct->first; +++ } + + type_struct->first = next; + + temp = loop = (int *) start; + + for(cntr=1; cntr < type_struct->space; cntr++) + + loop = (int *) (*loop = (int) (loop + type_struct->type_len)); + + *loop = (int) (type_struct->next_free); + + type_struct->next_free = (char *) temp; + + + + /* if type atom, set pnames to CNIL */ + + + + if( type_struct == &atom_str ) + + for(cntr=0, p=(lispval) temp; cntrpname = (char *) CNIL; +++ p->a.pname = (char *) CNIL; + + p = (lispval) ((int *)p + atom_str.type_len); + + } + + return(0); /* space was available */ + +} + + + + + +/** next_one(type_struct) ************************************************/ + +/* */ + +/* Allocates one new item of each kind of space, except STRNG. */ + +/* If there is no space, calls gc, the garbage collector. */ + +/* If there is still no space, allocates a new page using */ + +/* get_more_space(type_struct) */ + + + +lispval + +next_one(type_struct) + +struct types *type_struct; + +{ + + + + register char *temp; + + snpand(1); + + + + while(type_struct->next_free == (char *) CNIL) + + { + + int g; + + + + if((type_struct->type != ATOM) && /* can't collect atoms */ + + (type_struct->type != STRNG) && /* can't collect strings */ - (gcthresh->i <= current) && /* threshhold for gc */ - ISNIL(copval(gcdis,CNIL)) && /* gc not disabled */ - (NOTNIL(copval(gcload,CNIL)) || (loading->clb != tatom)) && +++ (type_struct->type != BCD) && /* nor function headers */ +++ (gcthresh->i <= current) && /* threshhold for gc */ +++ gcdis->a.clb == nil && /* gc not disabled */ +++ (NOTNIL(copval(gcload,CNIL)) || (loading->a.clb != tatom)) && + + /* not to collect during load */ + + (initflag == FALSE) && /* dont gc during init */ + + (gcflag == FALSE)) /* don't recurse gc */ + + + + { + + /* fputs("Collecting",poport); + + dmpport(poport);*/ + + gc(type_struct); /* collect */ + + } + + + + if( type_struct->next_free != (char *) CNIL ) break; + + + + if(! (g=get_more_space(type_struct))) break; + + + + if( g==1 ) + + { + + plimit->i = current+NUMSPACES; + + /* allow a few more pages */ + + copval(plima,plimit); /* restore to reserved reg */ + + + + error("PAGE LIMIT EXCEEDED--EMERGENCY PAGES ALLOCATED", + + TRUE); + + } + + else error("SORRY, ABSOLUTE PAGE LIMIT HAS BEEN REACHED", + + TRUE); + + } + + + + temp = type_struct->next_free; + + type_struct->next_free = * (char **)(type_struct->next_free); + + return((lispval) temp); + +} + + + +lispval + +newint() + +{ + + ++(int_items->i); + + return(next_one(&int_str)); + +} + + + +lispval + +newdot() + +{ + + lispval temp; + + + + ++(dtpr_items->i); + + temp = next_one(&dtpr_str); - temp->car = temp->cdr = nil; +++ temp->d.car = temp->d.cdr = nil; + + return(temp); + +} + + + +lispval + +newdoub() + +{ + + ++(doub_items->i); + + return(next_one(&doub_str)); + +} + + + +lispval + +newsdot() + +{ + + register lispval temp; + + ++(dtpr_items->i); + + temp = next_one(&sdot_str); - temp->car = temp->cdr = 0; +++ temp->d.car = temp->d.cdr = 0; + + return(temp); + +} + + - struct atom *newatom() { +++struct atom * +++newatom() { + + struct atom *save; + + + + ++(atom_items->i); + + save = (struct atom *) next_one(&atom_str) ; + + save->plist = save->fnbnd = nil; + + save->hshlnk = (struct atom *)CNIL; + + save->clb = CNIL; + + save->pname = newstr(); + + return (save); + +} + + + +char *newstr() { + + char *save; - int atmlen2; +++ int atmlen2,atmlen; + + + + ++(str_items->i); + + atmlen = strlen(strbuf)+1; + + if(atmlen > strng_str.space_left) + + while(get_more_space(&strng_str)) + + error("YOU HAVE RUN OUT OF SPACE",TRUE); + + strcpy((save = strng_str.next_free), strbuf); + + atmlen2 = atmlen; - while(atmlen2 % 4) ++atmlen2; /* even up length of string */ +++ while(atmlen2 & 3) ++atmlen2; /* even up length of string */ + + strng_str.next_free += atmlen2; + + strng_str.space_left -= atmlen2; + + return(save); + +} + + + +char *inewstr(s) char *s; + +{ + + strbuf[STRBLEN-1] = '\0'; + + strcpyn(strbuf,s,STRBLEN-1); + + return(newstr()); + +} + + + +lispval + +newarray() + + { + + register lispval temp; +++ + + ++(array_items->i); + + temp = next_one(&array_str); - temp->data = (char *)nil; - temp->accfun = nil; - temp->aux = nil; - temp->length = SMALL(0); - temp->delta = SMALL(0); +++ temp->ar.data = (char *)nil; +++ temp->ar.accfun = nil; +++ temp->ar.aux = nil; +++ temp->ar.length = SMALL(0); +++ temp->ar.delta = SMALL(0); + + return(temp); + + } + + + +lispval + +badcall() + + { error("BAD FUNCTION DESCRIPTOR USED IN CALL",FALSE); } + + + +lispval + +newfunct() + + { + + register lispval temp; + + ++(funct_items->i); + + temp = next_one(&funct_str); - temp->entry = badcall; - temp->discipline = nil; +++ temp->bcd.entry = badcall; +++ temp->bcd.discipline = nil; + + return(temp); + + } + + + +lispval + +newval() + + { + + register lispval temp; + + ++(val_items->i); + + temp = next_one(&val_str); + + temp->l = nil; + + return(temp); + + } + + +++lispval +++newhunk(hunknum) +++int hunknum; +++ { +++ register lispval temp; +++ +++ ++(hunk_items[hunknum]->i); /* Update used hunks count */ +++ temp = next_one(&hunk_str[hunknum]); /* Get a hunk */ +++ return(temp); +++ } +++ + +lispval + +inewval(arg) lispval arg; + + { + + lispval temp; + + ++(val_items->i); + + temp = next_one(&val_str); + + temp->l = arg; + + return(temp); + + } + + +++ + +/** Ngc *****************************************************************/ + +/* */ + +/* LISP interface to gc. */ + + + +lispval Ngc() + + { + + lispval temp; + + + + if( ISNIL(lbot->val) ) return(gc(CNIL)); + + + + if( TYPE(lbot->val) != DTPR ) error("BAD CALL TO GC",FALSE); + + + + chkport = poport; + + - if( NOTNIL(lbot->val->car) ) +++ if( NOTNIL(lbot->val->d.car) ) + + { - temp = eval(lbot->val->car); - if( TYPE(temp) == PORT ) chkport = (FILE *)*temp; +++ temp = eval(lbot->val->d.car); +++ if( TYPE(temp) == PORT ) chkport = temp->p; + + } + + + + gc1(TRUE); + + + + return(nil); + + } + + + +/** gc(type_struct) *****************************************************/ + +/* */ + +/* garbage collector: Collects garbage by mark and sweep algorithm. */ + +/* After this is done, calls the Nlambda, gcafter. */ + +/* gc may also be called from LISP, as a lambda of no arguments. */ + + + +lispval + +gc(type_struct) + + struct types *type_struct; + + { + + lispval save; + + struct { + + long mytime; + + long allelse[3]; + + } begin, finish; + + extern int GCtime; + + + + save = copval(gcport,CNIL); + + if(GCtime) + + times(&begin); + + + + while( (TYPE(save) != PORT) && NOTNIL(save)) + + save = error("NEED PORT FOR GC",TRUE); + + - chkport = ISNIL(save) ? poport : (FILE *)*save; +++ chkport = (ISNIL(save) ? poport : save->p); + + + + gc1(NOTNIL(copval(gccheck,CNIL)) || (chkport!=poport)); /* mark&sweep */ + + + + /* Now we call gcafter--special case if gc called from LISP */ + + + + if( type_struct == (struct types *) CNIL ) - gccall1->cdr = nil; /* make the call "(gcafter)" */ +++ gccall1->d.cdr = nil; /* make the call "(gcafter)" */ + + else + + { - gccall1->cdr = gccall2; - gccall2->car = *(type_struct->type_name); +++ gccall1->d.cdr = gccall2; +++ gccall2->d.car = *(type_struct->type_name); + + } +++ {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/} + + gcflag = TRUE; /* flag to indicate in garbage collector */ + + save = eval(gccall1); /* call gcafter */ + + gcflag = FALSE; /* turn off flag */ +++ {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/} + + + + if(GCtime) { + + times(&finish); + + GCtime += (finish.mytime - begin.mytime); + + } + + return(save); /* return result of gcafter */ + + } + + + + + + + +/* gc1() **************************************************************/ + +/* */ + +/* Mark-and-sweep phase */ + + + +gc1(chkflag) int chkflag; + + { - int i, j, typep; - register int *start, *point; - struct types *s; +++ int j, typep,k; +++ register int *start,bvalue,type_len; +++ register struct types *s; +++ int *point,i,freecnt,itemstogo,bits,bindex,type,enddat; + + struct heads *loop; + + struct argent *loop2; +++ struct nament *loop3; +++#ifdef METER +++ int Mbvalue; +++#endif + + int markdp(); +++ int debugin = FALSE; /* temp debug flag */ +++ extern int *beginsweep; +++#define ERDB(s) { printf(s); fflush(stdout); } + + - +++#ifndef UNIXTS +++ vadvise(VA_ANOM); + + /* decide whether to check LISP structure or not */ - +++#endif + + + + + + + + /* first set all bit maps to zero */ + + - for(i=0; i<((int)datalim >> 8); ++i) bitmapq[i] = zeroq; +++ +++ if(debugin) ERDB("Begin gc\n"); +++ enddat = (int)datalim >> 8; +++ for(bvalue=0; bvalue < (int)enddat ; ++bvalue) +++ { +++#ifdef METER +++ /* Mbitmapq[bvalue] = bitmapq[bvalue]; /* remember old vals */ +++ /* the C compiler will use a movd if we let it,and this +++ will not work since the bit maps may be illegal +++ floating point values +++ */ +++ asm(" movq _bitmapq[r10],_Mbitmapq[r10] "); +++#endif +++ bitmapq[bvalue] = zeroq; +++ } +++ +++ /* try the movc5 to clear the bit maps */ +++ /* blzero(bitmap,TTSIZE * 16); */ + + + + + + /* then mark all atoms' plists, clbs, and function bindings */ + + + + for(loop=atom_str.first; loop!=(struct heads *)CNIL; loop=loop->link) + + for(start=(int *)(loop->pntr), i=1; + + i <= atom_str.space; + + start = start + atom_str.type_len, ++i) + + { + + + + /* unused atoms are marked with pname == CNIL */ + + /* this is done by get_more_space, as well as */ + + /* by gc (in the future) */ + + - if(((lispval)start)->pname == (char *)CNIL) continue; +++ if(((lispval)start)->a.pname == (char *)CNIL) continue; + +#define MARKSUB(p) if(nil!=((lispval)start)->p)markdp(((lispval)start)->p); - MARKSUB(clb); - MARKSUB(fnbnd); - MARKSUB(plist); +++ MARKSUB(a.clb); +++ MARKSUB(a.fnbnd); +++ MARKSUB(a.plist); + + } + + +++ /* Mark all the atoms and ints associated with the hunk +++ data types */ +++ +++ for(i=0; i<8; i++) { +++ markdp(hunk_items[i]); +++ markdp(hunk_name[i]); +++ markdp(hunk_pages[i]); +++ } + + /* next run up the name stack */ - +++ if(debugin) ERDB("name stack\n"); + + for(loop2 = np - 1; loop2 >= orgnp; --loop2) markdp((loop2->val)); +++ +++ /* now the bindstack (vals only, atoms are marked elsewhere ) */ +++ for(loop3 = bnp - 1; loop3 >= orgbnp; --loop3)markdp(loop3->val); +++ +++ if(debugin) ERDB("compiler stuff\n"); + + /* from TBL 29july79 */ + + /* next mark all compiler linked data */ + + point = bind_lists; + + while((start = point) != (int *)CNIL) { +++ if(debugin) ERDB("once "); + + while( *start != -1 ) + + markdp(*start++); + + point = (int *)*(point-1); + + } + + /* end from TBL */ + + +++ if(debugin) ERDB("signif stuff\n"); + + /* next mark all system-significant lisp data */ + + + + for(i=0; itype; - if((typep==STRNG) || (typep==ATOM)) continue; - - s->space_left = 0; /* we will count free cells */ - (*(s->items))->i = 0; /* and compute cells used */ - - /* for each space, traverse list of pages. */ +++ (*(s->items))->i = 0; +++ s->space_left = 0; +++ s->next_free = (char *) CNIL; +++ } +++ } + + - s->next_free = (char *) CNIL; /* reinitialize free list */ + + - for(loop = s->first; loop != (struct heads *) CNIL; loop=loop->link) - { - /* add another page's worth to use count */ +++ /* sweep up in memory looking at gcable pages */ + + - (*(s->items))->i += s->space; +++ for(start = beginsweep, bindex = (int)start >> 7; +++ start < (int *)datalim; +++ start += 128) +++ { +++ /* printf(" start %x, bindex %x\n",start,bindex); */ +++ if(!(s=gcableptr[type = TYPE(start)])) +++ { +++ bindex += 4; /* and 4 words of 32 bit bitmap words */ +++ continue; +++ } +++ +++ freecnt = 0; /* number of free items found */ +++ itemstogo = s->space; /* number of items per page */ +++ bits = 32; /* number of bits per word */ +++ type_len = s->type_len; +++ +++ /* printf(" s %d, itemstogo %d, len %d\n",s,itemstogo,type_len);*/ +++ bvalue = bitmapi[bindex++]; +++#ifdef METER +++ Mbvalue = Mbitmapi[bindex-1]; +++#endif +++ +++ point = start; +++ while(TRUE) +++ { +++ /*printf(" bv: %08x, ",bvalue);*/ +++ if(!(bvalue & 1)) /* if data element is not marked */ +++ { +++ freecnt++; +++ *point = (int) (s->next_free) ; +++ s->next_free = (char *) point; +++#ifdef METER +++ if(type == DTPR) +++ { +++ if(Mbvalue & 1) usedfree++; +++ else freefree++; +++ } +++#endif +++ } +++#ifdef METER +++ else if(type == DTPR) +++ { +++ if (Mbvalue & 1) usedused++; +++ else freeused++; +++ } +++#endif +++ +++ if( --itemstogo <= 0 ) +++ { if(type_len >= 64) +++ { +++ bindex++; +++ if(type_len >=128) bindex += 2; +++ } +++ break; +++ } + + - /* for each page, make a list of unmarked data */ +++ point += type_len; +++ /* shift over mask by number of words in data type */ +++ +++ if( (bits -= type_len) > 0) +++ { bvalue = bvalue >> type_len; +++#ifdef METER +++ Mbvalue = Mbvalue >> type_len; +++#endif +++ } +++ else if( bits == 0 ) +++ { bvalue = bitmapi[bindex++]; +++#ifdef METER +++ Mbvalue = Mbitmapi[bindex-1]; +++#endif +++ bits = 32; +++ } +++ else +++ { bits = -bits; +++ while( bits >= 32) { bindex++; +++ bits -= 32; +++ } +++ bvalue = bitmapi[bindex++]; +++ bvalue = bvalue >> bits; +++#ifdef METER +++ Mbvalue = Mbitmapi[bindex-1]; +++ Mbvalue = Mbvalue >> bits; +++#endif +++ bits = 32 - bits;; +++ } +++ } + + - for(j=0, point=(int *)(loop->pntr); - jspace; ++j, point += s->type_len) - if( ! lookbit(point) ) - { - /* add to free list */ - /* update pointer to free list*/ - /* update count of free list */ +++ /* printf(" t %d,fr %d ",type,freecnt); */ +++ s->space_left += freecnt; +++ (*(s->items))->i += s->space - freecnt; +++ } + + - *point = (int)(s->next_free); - s->next_free = (char *) point; - ++(s->space_left); - } - } - (*(s->items))->i -= s->space_left; /* compute cells used */ - } +++#ifndef UNIXTS +++ vadvise(VA_NORM); +++#endif + +} + + + +/** alloc() *************************************************************/ + +/* */ + +/* This routine tries to allocate one more page of the space named */ + +/* by the argument. If no more space is available returns 1, else 0. */ + + + +lispval + +alloc(tname,npages) + + lispval tname; int npages; + + { + + int ii, jj; + + + + ii = typenum(tname); + + +++ if(((int)datalim >> 9) + npages > TTSIZE) +++ error("Space request would exceed maximum memory allocation",FALSE); +++ + + for( jj=0; jjtype_len; /* find c-length of space */ - while( nitems%512 ) ++nitems; /* round up to right length */ - current += nitems/512; - charadd = sbrk(nitems); +++ nitems = roundup(nitems,512); /* round up to right length */ +++#ifdef HOLE +++ if((tname==str_name) && useholeflag) +++ charadd = gethspace(nitems,ii); +++ else +++#endif +++ { +++ current += nitems/512; +++ charadd = sbrk(nitems); +++ datalim = (lispval)(charadd+nitems); +++ } + + if( (int) charadd == 0 ) + + error("NOT ENOUGH SPACE FOR ARRAY",FALSE); - (datalim = (lispval)(charadd+nitems)); + + if((((int)datalim) >> 9) > TTSIZE) { + + datalim = (lispval) (TTSIZE << 9); + + badmem(53); + + } + + for(jj=0; jjtype); + + } +++ blzero(charadd,nitems); + + return((lispval)charadd); - } +++} + + + +int csizeof(tname) lispval tname; + + { + + return( spaces[typenum(tname)]->type_len * 4 ); + + } + + + +int typenum(tname) lispval tname; + + { + + int ii; + + + +chek: for(ii=0; iitype_name)) break; + + if(ii == NUMSPACES) + + { + + tname = error("BAD TYPE NAME",TRUE); + + goto chek; + + } + + + + return(ii); +++ +++ } +++char * +++gethspace(segsiz,type) +++{ +++ extern usehole; extern char holend[]; extern char *curhbeg; +++ register char *value; +++ +++ if(usehole) { +++ curhbeg = (char *) roundup(((int)curhbeg),NBPG); +++ if((holend - curhbeg) < segsiz) +++ { printf("[fasl hole filled up]\n"); +++ usehole = FALSE; +++ } else { +++ value = curhbeg; +++ curhbeg = curhbeg + segsiz; +++ /*printf("start %d, finish %d, size %d\n",value, curhbeg,segsiz);*/ +++ return(value); +++ } + + } +++ value = (ysbrk(segsiz/NBPG,type)); +++ datalim = (lispval)(value + segsiz); +++ return(value); +++} +++gcrebear() +++{ +++#ifdef HOLE +++ /* this gets done upon rebirth */ +++ strng_str.space_left = 0; +++ funct_str.space_left = 0; +++ funct_str.next_free = (char *) CNIL; +++#endif +++} + + + +/** markit(p) ***********************************************************/ + +/* just calls markdp */ + + + +markit(p) lispval *p; { markdp(*p); } + + + +/** markdp(p) ***********************************************************/ + +/* */ + +/* markdp is the routine which marks each data item. If it is a */ + +/* dotted pair, the car and cdr are marked also. */ + +/* An iterative method is used to mark list structure, to avoid */ + +/* excessive recursion. */ + + + + + +markdp(p) register lispval p; + + { + +/* register int r, s; (goes with non-asm readbit, oksetbit) */ +++/* register hsize, hcntr; */ +++ int hsize, hcntr; + + + +ptr_loop: + + if((int)p <= 0) return; /* do not mark special data types or nil=0 */ + + + + switch( TYPE(p) ) + + { + + case INT: + + case DOUB: + +/* setbit(p);*/ + + ftstbit; + + return; + + case VALUE: + + ftstbit; + + p = p->l; + + goto ptr_loop; + + case DTPR: + + ftstbit; - markdp(p->car); - p = p->cdr; +++ markdp(p->d.car); +++ p = p->d.cdr; + + goto ptr_loop; + + + + case ARRAY: + + ftstbit; /* mark array itself */ + + - markdp(p->accfun); /* mark access function */ - markdp(p->aux); /* mark aux data */ - markdp(p->length); /* mark length */ - markdp(p->delta); /* mark delta */ - +++ markdp(p->ar.accfun); /* mark access function */ +++ markdp(p->ar.aux); /* mark aux data */ +++ markdp(p->ar.length); /* mark length */ +++ markdp(p->ar.delta); /* mark delta */ +++ if(TYPE(p->ar.aux)==DTPR && p->ar.aux->d.car==Vnogbar) +++ return; + + { - register int i, l; int d; - register char *dataptr = p->data; +++/* register int i, l; int d; */ +++/* register char *dataptr = p->ar.data; */ +++ int i,l,d; +++ char *dataptr = p->ar.data; + + - for(i=0, l=p->length->i, d=p->delta->i; iar.length->i, d=p->ar.delta->i; iCDR; +++ p = p->s.CDR; + + } while (p!=0); + + return; + + + + case BCD: + + ftstbit; - markdp(p->discipline); +++ markdp(p->bcd.discipline); + + return; +++ +++ case HUNK2: +++ case HUNK4: +++ case HUNK8: +++ case HUNK16: +++ case HUNK32: +++ case HUNK64: +++ case HUNK128: +++ { +++ hsize = 2 << HUNKSIZE(p); +++ ftstbit; +++ for (hcntr = 0; hcntr < hsize; hcntr++) +++ markdp(p->h.hunk[hcntr]); +++ return; +++ } + + } + + return; + + } + + + + + + + +char * + +xsbrk() + + { + + static char *xx; /* pointer to next available blank page */ - static int cycle = 0; /* number of blank pages available */ +++ extern int xcycle; /* number of blank pages available */ + + lispval u; /* used to compute limits of bit table */ + + - if( (cycle--) <= 0 ) +++ if( (xcycle--) <= 0 ) + + { - cycle = 15; +++ xcycle = 15; + + xx = sbrk(16*NBPG); /* get pages 16 at a time */ + + if( (int)xx== -1 ) + + lispend("For sbrk from lisp: no space... Goodbye!"); + + goto done; + + } + + xx += NBPG; + +done: if( (u = (lispval)(xx+NBPG)) > datalim ) datalim = u; + + return(xx); + + } + + + +char *ysbrk(pages,type) int pages, type; + + { + + char *xx; /* will point to block of storage */ + + int i; + + + + xx = sbrk(pages*NBPG); + + if((int)xx == -1) + + error("OUT OF SPACE FOR ARRAY REQUEST",FALSE); + + + + datalim = (lispval)(xx+pages*NBPG); /* compute bit table limit */ + + + + /* set type for pages */ + + + + for(i = 0; i < pages; ++i) { + + SETTYPE((xx + i*NBPG),type); + + } + + + + return(xx); /* return pointer to block of storage */ + + } + + +++#ifdef VMS +++/* sbrk - +++ * this function is used by the VMS franz to allocate space. +++ * It allocates space in the zfreespace array. +++ * The single argument passed to sbrk is the number of bytes to allocate +++ * +++ */ +++ +++extern char zfreespace[]; +++extern char *lsbrkpnt; +++ +++char * +++sbrk(n) +++{ +++ char *result; +++ if(lsbrkpnt == (char *)0) +++ { +++ lsbrkpnt = (char *) roundup((int)zfreespace,NBPG); +++ } +++ result = lsbrkpnt; +++/* printf("lispbrk: %x \n",lsbrkpnt); +++ fflush(stdout); */ +++ lsbrkpnt += n; +++ if(lsbrkpnt > &zfreespace[FREESIZE]) +++ error("sbrk: out of space ",FALSE); +++ return(result); +++} +++#endif + +/* getatom **************************************************************/ + +/* returns either an existing atom with the name specified in strbuf, or*/ + +/* if the atom does not already exist, regurgitates a new one and */ + +/* returns it. */ + +lispval + +getatom() + +{ register lispval aptr; + + register char *name, *endname; +++ register int hash; +++ register struct argent *lbot, *np; + + lispval b; + + char c; - register int hash; - snpand(4); + + + + name = strbuf; + + if (*name == (char)0377) return (eofa); - hash = 0; - for(name=strbuf; *name;) { - hash ^= *name++; - } - hash &= 0177; /* make sure no high-order bits have crept in */ - atmlen = name - strbuf + 1; +++ hash = hashfcn(name); +++ atmlen = strlen(name) + 1; + + aptr = (lispval) hasht[hash]; + + while (aptr != CNIL) - if (strcmp(strbuf,aptr->pname)==0) +++ if (strcmp(name,aptr->a.pname)==0) + + return (aptr); + + else - aptr = (lispval) aptr->hshlnk; +++ aptr = (lispval) aptr->a.hshlnk; + + aptr = (lispval) newatom(); - aptr->hshlnk = hasht[hash]; +++ aptr->a.hshlnk = hasht[hash]; + + hasht[hash] = (struct atom *) aptr; - endname = name - 1; - name = strbuf; +++ endname = name + atmlen - 2; + + if ((atmlen != 4) && (*name == 'c') && (*endname == 'r')) + + { + + b = newdot(); + + protect(b); - b->car = lambda; - b->cdr = newdot(); - b = b->cdr; - b->car = newdot(); - (b->car)->car = xatom; +++ b->d.car = lambda; +++ b->d.cdr = newdot(); +++ b = b->d.cdr; +++ b->d.car = newdot(); +++ (b->d.car)->d.car = xatom; + + while(TRUE) + + { - b->cdr = newdot(); - b= b->cdr; +++ b->d.cdr = newdot(); +++ b= b->d.cdr; + + if(++name == endname) + + { - b->car= (lispval) xatom; - aptr->fnbnd = unprot(); +++ b->d.car= (lispval) xatom; +++ aptr->a.fnbnd = unprot(); + + break; + + } - b->car= newdot(); - b= b->car; - if((c = *name) == 'a') b->car = cara; - else if (c == 'd') b->car = cdra; +++ b->d.car= newdot(); +++ b= b->d.car; +++ if((c = *name) == 'a') b->d.car = cara; +++ else if (c == 'd') b->d.car = cdra; + + else{ unprot(); + + break; + + } + + } + + } + + + + return(aptr); + + } + + +++/* our hash function */ +++ +++hashfcn(symb) +++char *symb; +++{ +++ register int i; +++ for (i=0 ; *symb ; i += i + *symb++); +++ return(i & (HASHTOP-1)); +++} +++ +++extern struct atom *hasht[HASHTOP]; diff --cc usr/src/cmd/lisp/bigmath.s index 0000000000,0000000000,0000000000..1efe0ba580 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/bigmath.s @@@@ -1,0 -1,0 -1,0 +1,338 @@@@ +++ .asciz "@(#)bigmath.s 34.1 10/3/80" +++ .globl _dmlad +++# +++# routine for destructive multiplication and addition to a bignum by +++# two fixnums. +++# +++# from C, the invocation is dmlad(sdot,mul,add); +++# where sdot is the address of the first special cell of the bignum +++# mul is the multiplier, add is the fixnum to be added (The latter +++# being passed by value, as is the usual case. +++# +++# +++# Register assignments: +++# +++# r11 = current sdot +++# r10 = carry +++# r9 = previous sdot, for relinking. +++# +++_dmlad: .word 0x0e00 +++ movl 4(ap),r11 #initialize cell pointer +++ movl 12(ap),r10 #initialize carry +++loop: emul 8(ap),(r11),r10,r0 #r0 gets cell->car times mul + carry +++# ediv $0x40000000,r0,r10,(r11)#cell->car gets prod % 2**30 +++# #carry gets quotient +++ extzv $0,$30,r0,(r11) +++ extv $30,$32,r0,r10 +++ movl r11,r9 #save last cell for fixup at end. +++ movl 4(r11),r11 #move to next cell +++ bneq loop #done indicated by 0 for next sdot +++ tstl r10 #if carry zero no need to allocate +++ beql done #new bigit +++ mcoml r10,r3 #test to see if neg 1. +++ bneq alloc #if not must allocate new cell. +++ tstl (r9) #make sure product isn't -2**30 +++ beql alloc +++ movl r0,(r9) #save old lower half of product. +++ brb done +++alloc: calls $0,_newsdot #otherwise allocate new bigit +++ movl r10,(r0) #store carry +++ movl r0,4(r9) #save new link cell +++done: movl 4(ap),r0 +++ ret +++ .globl _dodiv +++# +++# routine to destructively divide array representation of a bignum by +++# 1000000000 +++# +++# invocation: +++# remainder = dodiv(top,bottom) +++# int *top, *bottom; +++# where *bottom is the address of the biggning of the array, *top is +++# the top of the array. +++# +++# register assignments: +++# r0 = carry +++# r1 & r2 = 64bit temporary +++# r3 = pointer +++# +++_dodiv: .word 0 +++ clrl r0 #no carry to begin. +++ movl 8(ap),r3 #get pointer to array. +++loop2: emul $0x40000000,r0,(r3),r1 +++ ediv $1000000000,r1,(r3),r0 +++ acbl 4(ap),$4,r3,loop2 +++ ret +++ .globl _dsneg +++# +++# dsneg(top, bot); +++# int *top, *bot; +++# +++# routine to destructively negate a bignum stored in array format +++# lower order stuff at higher addresses. It is assume that the +++# result will be positive. +++# +++_dsneg: .word 0 +++ movl 4(ap),r1 #load up address. +++ clrl r2 #set carry +++loop3: mnegl (r1),r0 #negate and take carry into account. +++ addl2 r2,r0 +++ extzv $0,$30,r0,(r1) +++ extv $30,$2,r0,r2 +++ acbl 8(ap),$-4,r1,loop3 +++ #decrease r1, and branch back if appropriate. +++ ret +++ +++# bignum add routine +++# basic data representation is each bigit is a positive number +++# less than 2^30, except for the leading bigit, which is in +++# the range -2^30 < x < 2^30. +++ +++ .globl _adbig +++ .globl Bexport +++ .globl backfr +++# +++# Initialization section +++# +++_adbig: .word 0x0fc0 #save registers 6-11 +++ movl 4(ap),r1 #arg1 = addr of 1st bignum +++ movl 8(ap),r2 #arg2 = addr of 2nd bignum +++ clrl r5 #r5 = carry +++ movl $0xC0000000,r4 #r4 = clear constant. +++ movl sp,r10 #save start address of bignum on stack. +++ #note well that this is 4 above the actual +++ #low order word. +++# +++# first loop is to waltz through both bignums adding +++# bigits, pushing them onto stack. +++# +++loop4: addl3 (r1),(r2),r0 #add bigits +++ addl2 r5,r0 #add carry +++ bicl3 r4,r0,-(sp) #save sum, no overflow possible +++ extv $30,$2,r0,r5 #sign extend two high order bits +++ #to be next carry. +++ movl 4(r1),r1 #get cdr +++ bleq out1 #negative indicates end of list. +++ movl 4(r2),r2 #get cdr of second bignum +++ bgtr loop4 #if neither list at end, do it again +++# +++# second loop propagates carries through higher order words. +++# It assumes remaining list in r1. +++# +++loop5: addl3 (r1),r5,r0 #add bigits and carry +++ bicl3 r4,r0,-(sp) #save sum, no overflow possible +++ extv $30,$2,r0,r5 #sign extend two high order bits +++ #to be next carry. +++ movl 4(r1),r1 #get cdr +++out2: bgtr loop5 #negative indicates end of list. +++out2a: pushl r5 +++# +++# suppress unnecessary leading zeroes and -1's +++# +++iexport:movl sp,r11 #more set up for output routine +++ckloop: +++Bexport:tstl (r11) #look at leading bigit +++ bgtr copyit #if positive, can allocate storage etc. +++ blss negchk #if neg, still a chance we can get by +++ cmpl r11,r10 #check to see that +++ bgeq copyit #we don't pop everything off of stack +++ tstl (r11)+ #incr r11 +++ brb ckloop #examine next +++negchk: +++ mcoml (r11),r3 #r3 is junk register +++ bneq copyit #short test for -1 +++ tstl 4(r11) #examine next bigit +++ beql copyit #if zero must must leave as is. +++ cmpl r11,r10 #check to see that +++ bgeq copyit #we don't pop everything off of stack +++ tstl (r11)+ #incr r11 +++ bisl2 r4,(r11) #set high order two bits +++ brb negchk #try to supress more leading -1's +++# +++# The following code is an error exit from the first loop +++# and is out of place to avoid a jump around a jump. +++# +++out1: movl 4(r2),r1 #get next addr of list to continue. +++ brb out2 #if second list simult. exhausted, do +++ #right thing. +++# +++# loop6 is a faster version of loop5 when carries are no +++# longer necessary. +++# +++loop6a: pushl (r1) #get datum +++loop6: movl 4(r1),r1 #get cdr +++ bgtr loop6a #if not at end get next cell +++ brb out2a +++ +++# +++# create linked list representation of bignum +++# +++copyit: subl3 r11,r10,r2 #see if we can get away with allocating an int +++ bneq on1 #test for having popped everything +++ subl3 $4,r10,r11 #if so, fix up pointer to bottom +++ brb intout #and allocate int. +++on1: cmpl r2,$4 #if = 4, then can do +++ beql intout +++ calls $0,_newsdot #get new cell for new bignum +++backfr: movl r0,(r6)+ #push address of cell on +++ #arg stack to save from garbage collection. +++ #There is guaranteed to be slop for a least one +++ #push without checking. +++ movl r0,r8 #r8 = result of adbig +++loop7: movl -(r10),(r0) #save bigit +++ movl r0,r9 #r9 = old cell, to link +++ cmpl r10,r11 #have we copy'ed all the bigits? +++ bleq Edone +++ calls $0,_newsdot #get new cell for new bignum +++ movl r0,4(r9) #link new cell to old +++ brb loop7 +++Edone: +++ clrl 4(r9) #indicate end of list with 0 +++ movl -(r6),r0 #give resultant address. +++ ret +++# +++# export integer +++# +++intout: pushl (r11) +++ calls $1,_inewint +++ ret +++ .globl _mulbig +++# +++# bignum multiplication routine +++# +++# Initialization section +++# +++_mulbig:.word 0x0fc0 #save regs 6-11 +++ movl 4(ap),r1 #get address of first bignum +++ movl sp,r11 #save top of 1st bignum +++mloop1: pushl (r1) #get bigit +++ movl 4(r1),r1 #get cdr +++ bgtr mloop1 #repeat if not done +++ movl sp,r10 #save bottom of 1st bignum, top of 2nd bignum +++ +++ movl 8(ap),r1 #get address of 2nd bignum +++mloop2: pushl (r1) #get bigit +++ movl 4(r1),r1 #get cdr +++ bgtr mloop2 #repeat if not done +++ movl sp,r9 #save bottom of 2nd bignum +++ subl3 r9,r11,r6 #r6 contains sum of lengths of bignums +++ subl2 r6,sp +++ movl sp,r8 #save bottom of product bignum +++# +++# Actual multiplication +++# +++m1: movc5 $0,(r8),$0,r6,(r8)#zap out stack space +++ movl r9,r7 #r7 = &w[j +n] (+4 for a.d.) through calculation +++ subl3 $4,r10,r4 #r4 = &v[j] +++ +++m3: movl r7,r5 #r7 = &w[j+n] +++ subl3 $4,r11,r3 #r3 = &u[i] +++ clrl r2 #clear carry. +++ +++m4: addl2 -(r5),r2 #add w[i + j] to carry (no ofl poss) +++ emul (r3),(r4),r2,r0 #r0 = u[i] * v[j] + sext(carry) +++ extzv $0,$30,r0,(r5) #get new bigit +++ extv $30,$32,r0,r2 #get new carry +++ +++m5: acbl r10,$-4,r3,m4 #r3 =- 4; if(r3 >= r10) goto m4; r10 = &[u1]; +++ movl r2,-(r5) #save w[j] = carry +++ +++m6: subl2 $4,r7 #add just &w[j+n] (+4 for autodec) +++ acbl r9,$-4,r4,m3 #r4 =- 4; if(r4>=r9) goto m5; r9 = &v[1] +++ +++ movl r9,r10 #set up for output routine +++ movl $0xC0000000,r4 #r4 = clear constant. +++ movq 20(fp),r6 #restor _np and _lbot ! +++ brw iexport #do it! +++# +++# The remainder of this file are routines used in bignum division. +++# Interested parties should consult Knuth, Vol 2, and divbig.c. +++# These files are here only due to an optimizer bug. +++# +++ +++ .align 1 +++ .globl _calqhat +++_calqhat: +++ .word .R1 +++ movl 4(ap),r11 +++ movl 8(ap),r10 +++ movl $0x3fffffff,r0 +++ cmpl (r10),(r11) +++ beql on3 +++ emul (r11),$0x40000000,4(r11),r1 +++ ediv (r10),r1,r0,r5 +++on3: +++ emul r0,4(r10),$0,r1 +++ emul r5,$0x40000000,8(r11),r3 +++ subl2 r3,r1 +++ sbwc r4,r2 +++ bleq out4 +++ decl r0 +++out4: +++ ret +++ .set .R1,0xc00 +++ .align 1 +++ .globl _mlsb +++_mlsb: +++ .word .R2 +++ movl 4(ap),r11 +++ movl 8(ap),r10 +++ movl 12(ap),r9 +++ movl 16(ap),r8 +++ clrl r0 +++loop8: addl2 (r11),r0 +++ emul r8,-(r9),r0,r2 +++ extzv $0,$30,r2,(r11) +++ extv $30,$32,r2,r0 +++ acbl r10,$-4,r11,loop8 +++ ret +++ .set .R2,0xf00 +++ .align 1 +++ .globl _adback +++_adback: +++ .word .R3 +++ movl 4(ap),r11 +++ movl 8(ap),r10 +++ movl 12(ap),r9 +++ clrl r0 +++loop9: addl2 -(r9),r0 +++ addl2 (r11),r0 +++ extzv $0,$30,r0,(r11) +++ extv $30,$2,r0,r0 +++ acbl r10,$-4,r11,loop9 +++ ret +++ .set .R3,0xe00 +++ .align 1 +++ .globl _dsdiv +++_dsdiv: +++ .word .R4 +++ movl 8(ap),r11 +++ clrl r0 +++loopa: emul r0,$0x40000000,(r11),r1 +++ ediv 12(ap),r1,(r11),r0 +++ acbl 4(ap),$4,r11,loopa +++ ret +++ .set .R4,0x800 +++ .align 1 +++ .globl _dsmult +++_dsmult: +++ .word .R5 +++ movl 4(ap),r11 +++ clrl r0 +++loopb: emul 12(ap),(r11),r0,r1 +++ extzv $0,$30,r1,(r11) +++ extv $30,$32,r1,r0 +++ acbl 8(ap),$-4,r11,loopb +++ movl r1,4(r11) +++ ret +++ .set .R5,0x800 +++ .align 1 +++ .globl _export +++_export: +++ .word .R6 +++ movl 8(ap),r11 +++ movl 4(ap),r10 +++ movl $0xC0000000,r4 +++ jmp Bexport +++ ret +++ .set .R6,0xfc0 diff --cc usr/src/cmd/lisp/bind.c index 0000000000,e76a5bada0,0000000000..e26cb78325 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/bind.c +++ b/usr/src/cmd/lisp/bind.c @@@@ -1,0 -1,174 -1,0 +1,177 @@@@ +++ +++static char *sccsid = "@(#)bind.c 34.1 10/3/80"; +++ + +#include "global.h" - #include +++#include "a.out.h" + +#define STRLIM 1024 + + + +static lispval mkptr(); + +static struct exec header; + +static struct nlist nlist; + +static lispval *linkaddr; + +static int *bindaddr; + +static int fildes; + +static lispval currtab; + +static lispval curibase; + +extern int fvirgin; + +extern int initflag; + +lispval + +Lbind(){ + + register struct argent *mlbot = lbot; + + register lispval work; + + char *sbrk(), *tfile, cbuf[512], *mytemp(), *gstab(); + + + + snpand(2); + + + + strcpy(cbuf, gstab()); + + printf("getting symbol table from %s\n",cbuf); fflush(stdout); + + if((fildes = open(cbuf,0))<0) + + return(nil); + + /* + + * Read a.out header to find out where symbol table is. + + */ + + if(read(fildes,(char *)&header,sizeof(header)) <= 0) { + + close(fildes); + + return(nil); + + } + + + + lseek(fildes, header.a_text+header.a_data+header.a_trsize + + +header.a_drsize, 1); + + - currtab = Vreadtable->clb; - Vreadtable->clb = strtab; - curibase = ibase->clb; - ibase->clb = inewint(10); +++ currtab = Vreadtable->a.clb; +++ Vreadtable->a.clb = strtab; +++ curibase = ibase->a.clb; +++ ibase->a.clb = inewint(10); + + while((sizeof nlist)==read(fildes,&nlist,sizeof nlist)) { + + if( nlist.n_name[0]!='.' || nlist.n_name[1]!='.') + + continue; + + + + linkaddr = (lispval *)*(int *)nlist.n_value; + + bindaddr = (int *)*(int *)(nlist.n_value+sizeof(int)); + + do_linker(); + + do_binder(); + + } - ibase->clb = curibase; - Vreadtable->clb = currtab; +++ ibase->a.clb = curibase; +++ Vreadtable->a.clb = currtab; + + return(tatom); + +} + + + +static do_linker() + +{ + + register int *i, *end, temp; + + char array[STRLIM]; + + extern lispval *bind_lists; + + + + /* first link this linkage table to the garbage + + collector's list. We will try to be tricky + + so that if the garbage collector is invoked + + by mkptr we will not cause markdp() to go off + + the deep end. + + */ + + *(linkaddr-1) = (lispval) bind_lists; + + bind_lists = linkaddr; + + i = (int *)linkaddr; + + initflag = TRUE; + + for(; *i!=-1; i++) { + + temp = *i; + + *i = -1; /* clobber to short circuit gc */ + + findstr(temp, array); + + *i = (int)mkptr(array); + + } + + initflag = FALSE; + +} + +static do_binder() + +{ + + char array[STRLIM]; + + register lispval handy; + + struct binder {lispval (*b_entry)(); + + int b_atmlnk; + + int b_type;} bindage, *pos; + + + + pos = (struct binder *)bindaddr; + + initflag = TRUE; + + for(bindage= *pos++; bindage.b_atmlnk!=-1; bindage = *pos++) { + + if( bindage.b_type == 99) { + + struct argent *olbot; + + /* we must evaluate this form for effect */ + + + + findstr(bindage.b_atmlnk, array); + + /* garbage collection appears to + + cause problems at this point */ - /* if(ISNIL(copval(gcload,CNIL)) && loading->clb != tatom) +++ /* if(ISNIL(copval(gcload,CNIL)) && loading->a.clb != tatom) + + gc(CNIL); /* do a gc if gc will be off */ + + handy = mkptr(array); + + olbot = lbot; + + lbot = np; - ibase->clb=curibase; - Vreadtable->clb = currtab; +++ ibase->a.clb=curibase; +++ Vreadtable->a.clb = currtab; + + (np++)->val = handy; + + Leval(); - Vreadtable->clb = strtab; - curibase = ibase->clb; - ibase->clb = inewint(10); +++ Vreadtable->a.clb = strtab; +++ curibase = ibase->a.clb; +++ ibase->a.clb = inewint(10); + + np = lbot; + + lbot = olbot; + + } else { + + handy = newfunct(); - handy->entry = bindage.b_entry; - handy->discipline = (bindage.b_type == 0 ? lambda : +++ handy->bcd.entry = bindage.b_entry; +++ handy->bcd.discipline = (bindage.b_type == 0 ? lambda : + + bindage.b_type == 1 ? nlambda : + + macro); + + + + findstr(bindage.b_atmlnk, array); + + protect(handy); - mkptr(array)->fnbnd = handy; +++ mkptr(array)->a.fnbnd = handy; + + } + + } + + initflag = FALSE; + +} + + + +static + +findstr(ptr,array) + +int ptr; + +char *array; + +{ + + int cnt = 0; + + char *cp; + + + + cp = ptr + (char *)bindaddr; + + while(cnt_flag&(_IOREAD|_IOWRT);p++) + + if(p >= _iob + _NFILE) + + error("Too many open files to do readlist",FALSE); + + p->_flag = _IOREAD | _IOSTRG; + + p->_base = p->_ptr = str; + + p->_cnt = strlen(str) + 1; + + + + olbot = lbot; + + lbot = np; + + piport = p; + + protect(P(p)); + + work = Lread(); + + piport = opiport; + + lbot = olbot; + + p->_cnt = 0; + + p->_ptr = p->_base = 0; + + p->_file = 0; + + p->_flag=0; + + return(work); + +} + + + + + + + + diff --cc usr/src/cmd/lisp/crt0.s index 0000000000,4d59c0948f,0000000000..d46e520021 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/crt0.s +++ b/usr/src/cmd/lisp/crt0.s @@@@ -1,0 -1,115 -1,0 +1,345 @@@@ + +# C runtime startoff +++# sccs id @(#)crt0.s 34.1 10/3/80 + + + + .set exit,1 + +.globl _exit + +.globl start + +.globl _main + +.globl _environ + +.globl _xports + +.globl _gstart + +.globl _proflush +++.globl _holbeg +++.globl _holend +++.globl Fixzero + + + + + +# + +# C language startup routine - + +# + +# special 512 byte area for nil (and possibly other atoms) + +# and special block of smallnums. + +# + + .long 0 + + .long 0 + + .long 0 + + .long -4 + + .long 20 + + .byte 'n,'i,'l,0 + + .long 0 + + .long 0 + + .long -4 + + .long 40 + + .byte 'e,'o,'f,0 + + .space 512-44 +++_xports: +++ .long __iob+0 +++ .long __iob+16 +++ .long __iob+32 +++ .long __iob+48 +++ .long __iob+64 +++ .long __iob+80 +++ .long __iob+96 +++ .long __iob+112 +++ .long __iob+128 +++ .long __iob+144 +++ .long __iob+160 +++ .long __iob+176 +++ .long __iob+192 +++ .long __iob+208 +++ .long __iob+224 +++ .long __iob+240 +++ .long __iob+256 +++ .long __iob+272 +++ .long __iob+288 +++ .long __iob+304 +++ .space 512 - (20 * 4) +++ .long -1024,-1023,-1022,-1021,-1020,-1019,-1018,-1017 +++ .long -1016,-1015,-1014,-1013,-1012,-1011,-1010,-1009 +++ .long -1008,-1007,-1006,-1005,-1004,-1003,-1002,-1001 +++ .long -1000,-999,-998,-997,-996,-995,-994,-993 +++ .long -992,-991,-990,-989,-988,-987,-986,-985 +++ .long -984,-983,-982,-981,-980,-979,-978,-977 +++ .long -976,-975,-974,-973,-972,-971,-970,-969 +++ .long -968,-967,-966,-965,-964,-963,-962,-961 +++ .long -960,-959,-958,-957,-956,-955,-954,-953 +++ .long -952,-951,-950,-949,-948,-947,-946,-945 +++ .long -944,-943,-942,-941,-940,-939,-938,-937 +++ .long -936,-935,-934,-933,-932,-931,-930,-929 +++ .long -928,-927,-926,-925,-924,-923,-922,-921 +++ .long -920,-919,-918,-917,-916,-915,-914,-913 +++ .long -912,-911,-910,-909,-908,-907,-906,-905 +++ .long -904,-903,-902,-901,-900,-899,-898,-897 +++ .long -896,-895,-894,-893,-892,-891,-890,-889 +++ .long -888,-887,-886,-885,-884,-883,-882,-881 +++ .long -880,-879,-878,-877,-876,-875,-874,-873 +++ .long -872,-871,-870,-869,-868,-867,-866,-865 +++ .long -864,-863,-862,-861,-860,-859,-858,-857 +++ .long -856,-855,-854,-853,-852,-851,-850,-849 +++ .long -848,-847,-846,-845,-844,-843,-842,-841 +++ .long -840,-839,-838,-837,-836,-835,-834,-833 +++ .long -832,-831,-830,-829,-828,-827,-826,-825 +++ .long -824,-823,-822,-821,-820,-819,-818,-817 +++ .long -816,-815,-814,-813,-812,-811,-810,-809 +++ .long -808,-807,-806,-805,-804,-803,-802,-801 +++ .long -800,-799,-798,-797,-796,-795,-794,-793 +++ .long -792,-791,-790,-789,-788,-787,-786,-785 +++ .long -784,-783,-782,-781,-780,-779,-778,-777 +++ .long -776,-775,-774,-773,-772,-771,-770,-769 +++ .long -768,-767,-766,-765,-764,-763,-762,-761 +++ .long -760,-759,-758,-757,-756,-755,-754,-753 +++ .long -752,-751,-750,-749,-748,-747,-746,-745 +++ .long -744,-743,-742,-741,-740,-739,-738,-737 +++ .long -736,-735,-734,-733,-732,-731,-730,-729 +++ .long -728,-727,-726,-725,-724,-723,-722,-721 +++ .long -720,-719,-718,-717,-716,-715,-714,-713 +++ .long -712,-711,-710,-709,-708,-707,-706,-705 +++ .long -704,-703,-702,-701,-700,-699,-698,-697 +++ .long -696,-695,-694,-693,-692,-691,-690,-689 +++ .long -688,-687,-686,-685,-684,-683,-682,-681 +++ .long -680,-679,-678,-677,-676,-675,-674,-673 +++ .long -672,-671,-670,-669,-668,-667,-666,-665 +++ .long -664,-663,-662,-661,-660,-659,-658,-657 +++ .long -656,-655,-654,-653,-652,-651,-650,-649 +++ .long -648,-647,-646,-645,-644,-643,-642,-641 +++ .long -640,-639,-638,-637,-636,-635,-634,-633 +++ .long -632,-631,-630,-629,-628,-627,-626,-625 +++ .long -624,-623,-622,-621,-620,-619,-618,-617 +++ .long -616,-615,-614,-613,-612,-611,-610,-609 +++ .long -608,-607,-606,-605,-604,-603,-602,-601 +++ .long -600,-599,-598,-597,-596,-595,-594,-593 +++ .long -592,-591,-590,-589,-588,-587,-586,-585 +++ .long -584,-583,-582,-581,-580,-579,-578,-577 +++ .long -576,-575,-574,-573,-572,-571,-570,-569 +++ .long -568,-567,-566,-565,-564,-563,-562,-561 +++ .long -560,-559,-558,-557,-556,-555,-554,-553 +++ .long -552,-551,-550,-549,-548,-547,-546,-545 +++ .long -544,-543,-542,-541,-540,-539,-538,-537 +++ .long -536,-535,-534,-533,-532,-531,-530,-529 +++ .long -528,-527,-526,-525,-524,-523,-522,-521 +++ .long -520,-519,-518,-517,-516,-515,-514,-513 +++ .long -512,-511,-510,-509,-508,-507,-506,-505 +++ .long -504,-503,-502,-501,-500,-499,-498,-497 +++ .long -496,-495,-494,-493,-492,-491,-490,-489 +++ .long -488,-487,-486,-485,-484,-483,-482,-481 +++ .long -480,-479,-478,-477,-476,-475,-474,-473 +++ .long -472,-471,-470,-469,-468,-467,-466,-465 +++ .long -464,-463,-462,-461,-460,-459,-458,-457 +++ .long -456,-455,-454,-453,-452,-451,-450,-449 +++ .long -448,-447,-446,-445,-444,-443,-442,-441 +++ .long -440,-439,-438,-437,-436,-435,-434,-433 +++ .long -432,-431,-430,-429,-428,-427,-426,-425 +++ .long -424,-423,-422,-421,-420,-419,-418,-417 +++ .long -416,-415,-414,-413,-412,-411,-410,-409 +++ .long -408,-407,-406,-405,-404,-403,-402,-401 +++ .long -400,-399,-398,-397,-396,-395,-394,-393 +++ .long -392,-391,-390,-389,-388,-387,-386,-385 +++ .long -384,-383,-382,-381,-380,-379,-378,-377 +++ .long -376,-375,-374,-373,-372,-371,-370,-369 +++ .long -368,-367,-366,-365,-364,-363,-362,-361 +++ .long -360,-359,-358,-357,-356,-355,-354,-353 +++ .long -352,-351,-350,-349,-348,-347,-346,-345 +++ .long -344,-343,-342,-341,-340,-339,-338,-337 +++ .long -336,-335,-334,-333,-332,-331,-330,-329 +++ .long -328,-327,-326,-325,-324,-323,-322,-321 +++ .long -320,-319,-318,-317,-316,-315,-314,-313 +++ .long -312,-311,-310,-309,-308,-307,-306,-305 +++ .long -304,-303,-302,-301,-300,-299,-298,-297 +++ .long -296,-295,-294,-293,-292,-291,-290,-289 +++ .long -288,-287,-286,-285,-284,-283,-282,-281 +++ .long -280,-279,-278,-277,-276,-275,-274,-273 +++ .long -272,-271,-270,-269,-268,-267,-266,-265 +++ .long -264,-263,-262,-261,-260,-259,-258,-257 +++ .long -256,-255,-254,-253,-252,-251,-250,-249 +++ .long -248,-247,-246,-245,-244,-243,-242,-241 +++ .long -240,-239,-238,-237,-236,-235,-234,-233 +++ .long -232,-231,-230,-229,-228,-227,-226,-225 +++ .long -224,-223,-222,-221,-220,-219,-218,-217 +++ .long -216,-215,-214,-213,-212,-211,-210,-209 +++ .long -208,-207,-206,-205,-204,-203,-202,-201 +++ .long -200,-199,-198,-197,-196,-195,-194,-193 +++ .long -192,-191,-190,-189,-188,-187,-186,-185 +++ .long -184,-183,-182,-181,-180,-179,-178,-177 +++ .long -176,-175,-174,-173,-172,-171,-170,-169 +++ .long -168,-167,-166,-165,-164,-163,-162,-161 +++ .long -160,-159,-158,-157,-156,-155,-154,-153 +++ .long -152,-151,-150,-149,-148,-147,-146,-145 +++ .long -144,-143,-142,-141,-140,-139,-138,-137 +++ .long -136,-135,-134,-133,-132,-131,-130,-129 + + .long -128,-127,-126,-125,-124,-123,-122,-121 + + .long -120,-119,-118,-117,-116,-115,-114,-113 + + .long -112,-111,-110,-109,-108,-107,-106,-105 + + .long -104,-103,-102,-101,-100,-99,-98,-97 + + .long -96,-95,-94,-93,-92,-91,-90,-89 + + .long -88,-87,-86,-85,-84,-83,-82,-81 + + .long -80,-79,-78,-77,-76,-75,-74,-73 + + .long -72,-71,-70,-69,-68,-67,-66,-65 + + .long -64,-63,-62,-61,-60,-59,-58,-57 + + .long -56,-55,-54,-53,-52,-51,-50,-49 + + .long -48,-47,-46,-45,-44,-43,-42,-41 + + .long -40,-39,-38,-37,-36,-35,-34,-33 + + .long -32,-31,-30,-29,-28,-27,-26,-25 + + .long -24,-23,-22,-21,-20,-19,-18,-17 + + .long -16,-15,-14,-13,-12,-11,-10,-9 + + .long -8,-7,-6,-5,-4,-3,-2,-1 +++Fixzero: + + .long 0,1,2,3,4,5,6,7 + + .long 8,9,10,11,12,13,14,15 + + .long 16,17,18,19,20,21,22,23 + + .long 24,25,26,27,28,29,30,31 + + .long 32,33,34,35,36,37,38,39 + + .long 40,41,42,43,44,45,46,47 + + .long 48,49,50,51,52,53,54,55 + + .long 56,57,58,59,60,61,62,63 + + .long 64,65,66,67,68,69,70,71 + + .long 72,73,74,75,76,77,78,79 + + .long 80,81,82,83,84,85,86,87 + + .long 88,89,90,91,92,93,94,95 + + .long 96,97,98,99,100,101,102,103 + + .long 104,105,106,107,108,109,110,111 + + .long 112,113,114,115,116,117,118,119 + + .long 120,121,122,123,124,125,126,127 - _xports: - .long __iob+0 - .long __iob+16 - .long __iob+32 - .long __iob+48 - .long __iob+64 - .long __iob+80 - .long __iob+96 - .long __iob+112 - .long __iob+128 - .long __iob+144 - .long __iob+160 - .long __iob+176 - .long __iob+192 - .long __iob+208 - .long __iob+224 - .long __iob+240 - .long __iob+256 - .long __iob+272 - .long __iob+288 - .long __iob+304 - .space 512 - (20 * 4) +++ .long 128,129,130,131,132,133,134,135 +++ .long 136,137,138,139,140,141,142,143 +++ .long 144,145,146,147,148,149,150,151 +++ .long 152,153,154,155,156,157,158,159 +++ .long 160,161,162,163,164,165,166,167 +++ .long 168,169,170,171,172,173,174,175 +++ .long 176,177,178,179,180,181,182,183 +++ .long 184,185,186,187,188,189,190,191 +++ .long 192,193,194,195,196,197,198,199 +++ .long 200,201,202,203,204,205,206,207 +++ .long 208,209,210,211,212,213,214,215 +++ .long 216,217,218,219,220,221,222,223 +++ .long 224,225,226,227,228,229,230,231 +++ .long 232,233,234,235,236,237,238,239 +++ .long 240,241,242,243,244,245,246,247 +++ .long 248,249,250,251,252,253,254,255 +++ .long 256,257,258,259,260,261,262,263 +++ .long 264,265,266,267,268,269,270,271 +++ .long 272,273,274,275,276,277,278,279 +++ .long 280,281,282,283,284,285,286,287 +++ .long 288,289,290,291,292,293,294,295 +++ .long 296,297,298,299,300,301,302,303 +++ .long 304,305,306,307,308,309,310,311 +++ .long 312,313,314,315,316,317,318,319 +++ .long 320,321,322,323,324,325,326,327 +++ .long 328,329,330,331,332,333,334,335 +++ .long 336,337,338,339,340,341,342,343 +++ .long 344,345,346,347,348,349,350,351 +++ .long 352,353,354,355,356,357,358,359 +++ .long 360,361,362,363,364,365,366,367 +++ .long 368,369,370,371,372,373,374,375 +++ .long 376,377,378,379,380,381,382,383 +++ .long 384,385,386,387,388,389,390,391 +++ .long 392,393,394,395,396,397,398,399 +++ .long 400,401,402,403,404,405,406,407 +++ .long 408,409,410,411,412,413,414,415 +++ .long 416,417,418,419,420,421,422,423 +++ .long 424,425,426,427,428,429,430,431 +++ .long 432,433,434,435,436,437,438,439 +++ .long 440,441,442,443,444,445,446,447 +++ .long 448,449,450,451,452,453,454,455 +++ .long 456,457,458,459,460,461,462,463 +++ .long 464,465,466,467,468,469,470,471 +++ .long 472,473,474,475,476,477,478,479 +++ .long 480,481,482,483,484,485,486,487 +++ .long 488,489,490,491,492,493,494,495 +++ .long 496,497,498,499,500,501,502,503 +++ .long 504,505,506,507,508,509,510,511 +++ .long 512,513,514,515,516,517,518,519 +++ .long 520,521,522,523,524,525,526,527 +++ .long 528,529,530,531,532,533,534,535 +++ .long 536,537,538,539,540,541,542,543 +++ .long 544,545,546,547,548,549,550,551 +++ .long 552,553,554,555,556,557,558,559 +++ .long 560,561,562,563,564,565,566,567 +++ .long 568,569,570,571,572,573,574,575 +++ .long 576,577,578,579,580,581,582,583 +++ .long 584,585,586,587,588,589,590,591 +++ .long 592,593,594,595,596,597,598,599 +++ .long 600,601,602,603,604,605,606,607 +++ .long 608,609,610,611,612,613,614,615 +++ .long 616,617,618,619,620,621,622,623 +++ .long 624,625,626,627,628,629,630,631 +++ .long 632,633,634,635,636,637,638,639 +++ .long 640,641,642,643,644,645,646,647 +++ .long 648,649,650,651,652,653,654,655 +++ .long 656,657,658,659,660,661,662,663 +++ .long 664,665,666,667,668,669,670,671 +++ .long 672,673,674,675,676,677,678,679 +++ .long 680,681,682,683,684,685,686,687 +++ .long 688,689,690,691,692,693,694,695 +++ .long 696,697,698,699,700,701,702,703 +++ .long 704,705,706,707,708,709,710,711 +++ .long 712,713,714,715,716,717,718,719 +++ .long 720,721,722,723,724,725,726,727 +++ .long 728,729,730,731,732,733,734,735 +++ .long 736,737,738,739,740,741,742,743 +++ .long 744,745,746,747,748,749,750,751 +++ .long 752,753,754,755,756,757,758,759 +++ .long 760,761,762,763,764,765,766,767 +++ .long 768,769,770,771,772,773,774,775 +++ .long 776,777,778,779,780,781,782,783 +++ .long 784,785,786,787,788,789,790,791 +++ .long 792,793,794,795,796,797,798,799 +++ .long 800,801,802,803,804,805,806,807 +++ .long 808,809,810,811,812,813,814,815 +++ .long 816,817,818,819,820,821,822,823 +++ .long 824,825,826,827,828,829,830,831 +++ .long 832,833,834,835,836,837,838,839 +++ .long 840,841,842,843,844,845,846,847 +++ .long 848,849,850,851,852,853,854,855 +++ .long 856,857,858,859,860,861,862,863 +++ .long 864,865,866,867,868,869,870,871 +++ .long 872,873,874,875,876,877,878,879 +++ .long 880,881,882,883,884,885,886,887 +++ .long 888,889,890,891,892,893,894,895 +++ .long 896,897,898,899,900,901,902,903 +++ .long 904,905,906,907,908,909,910,911 +++ .long 912,913,914,915,916,917,918,919 +++ .long 920,921,922,923,924,925,926,927 +++ .long 928,929,930,931,932,933,934,935 +++ .long 936,937,938,939,940,941,942,943 +++ .long 944,945,946,947,948,949,950,951 +++ .long 952,953,954,955,956,957,958,959 +++ .long 960,961,962,963,964,965,966,967 +++ .long 968,969,970,971,972,973,974,975 +++ .long 976,977,978,979,980,981,982,983 +++ .long 984,985,986,987,988,989,990,991 +++ .long 992,993,994,995,996,997,998,999 +++ .long 1000,1001,1002,1003,1004,1005,1006,1007 +++ .long 1008,1009,1010,1011,1012,1013,1014,1015 +++ .long 1016,1017,1018,1019,1020,1021,1022,1023 + + + +start: + + .word 0x0000 + + subl2 $8,sp + + movl 8(sp),(sp) # argc + + movab 12(sp),r0 + + movl r0,4(sp) # argv + +L1: + + tstl (r0)+ # null args term ? + + bneq L1 + + cmpl r0,*4(sp) # end of 'env' or 'argv' ? + + blss L2 + + tstl -(r0) # envp's are in list + +L2: + + movl r0,8(sp) # env - movl r0,_environ # indir is 0 if no env ; not 0 if env +++# movl r0,_environ # indir is 0 if no env ; not 0 if env + + calls $3,_main + + pushl r0 + + calls $1,_exit + + chmk $exit + +_gstart: + + .word 0 + + moval start,r0 + + ret + +_proflush: + + .word 0 + + ret + +# + + .data +++_holbeg: # dummy locations +++_holend: + +_environ: .space 4 diff --cc usr/src/cmd/lisp/data.c index 0000000000,5e30ca2ebe,0000000000..cf571ff92a mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/data.c +++ b/usr/src/cmd/lisp/data.c @@@@ -1,0 -1,78 -1,0 +1,226 @@@@ - #include +++ +++static char *sccsid = "@(#)data.c 34.3 10/21/80"; + + + +#include "global.h" + +#include "gtabs.h" +++#include "structs.h" +++#include + + +++/*char firstalloc[NBPG] = { 'x' }; /* first thing allocated in file */ + +lispval lispsys[SIGNIF]; /* lisp data used by system */ + + + +lispval gftab[GFTABLEN]; /* global function table for interpreter */ + + + +lispval gctab[GCTABLEN] = /* global constant table for interpreter */ + + {nil,0,SMALL(-1),SMALL(0),SMALL(1),SMALL(2),SMALL(3),SMALL(4)}; + + + + + +/* Port definitions *****************************************************/ + +FILE *piport, /* standard input port */ + + *poport, /* standard output port */ + + *errport, /* port for error messages */ + + *rdrport, /* temporary port for readr */ + + *proport; /* port for protocal */ + +int lineleng = 80; /* line length desired */ + +int rlevel; /* used to indicate depth of recursion + + in reader. No longer really necessary */ + +char keybin = FALSE; /* logical flag: using keyboard */ + +char protflag = FALSE; /* logical flag: want protocall */ + +char rbktf; /* logical flag: ] mode */ + + +++lispval ioname[_NFILE]; /* strings of names of files currently open */ + + + +/* name stack ***********************************************************/ - struct argent *namptr, /* temporary pointer */ +++struct argent *orgnp; /* used by top level to reset to start */ +++struct argent *namptr, /* temporary pointer */ + + *nplim; /* don't have this = np */ + +struct nament *bnp, /* top of bind stack */ + + *orgbnp, /* absolute bottom of ""*/ + + *bnplim; /* absolute top of "" */ + + + + - /* the typeing table ****************************************************/ - #ifndef ROWAN - char typetab[TTSIZE] = {UNBO,ATOM,INT,INT,PORT}; - #else - char typetab[TTSIZE] = {UNBO,ATOM,INT,INT,INT,PORT}; - #endif + + + +/* hashing things *******************************************************/ - struct atom *hasht[HASHTOP]; + +int hash; /* set by ratom */ + +int atmlen; /* length of atom including final null */ + + + + + +/* big string buffer for whomever needs it ******************************/ + +char strbuf[STRBLEN]; - char *endstrb = strbuf + 255; +++char *endstrb = strbuf + STRBLEN - 1 ; + + + +/* set by sstatus commands */ + +int uctolc = 0; /* when set, uc chars in atoms go to lc */ + +int dmpmode = 413; /* default mode for dumplisp + + (note this is decimal not octal) */ + + + +/* break and error declarations *****************************************/ + +int depth = 0; /* depth of nested breaks */ + +lispval contval; /* the value being returned up */ - struct argent *orgnp; /* used by top level to reset to start */ + +int retval; /* used by each error/prog call */ +++int rsetsw; /* when set, trace frames built */ +++int bcdtrsw; /* when set with rsetsw, trace bcd too */ +++ + + +++/* exception handling stuff *********************************************/ +++int exception; /* true if an exception is pending */ +++int sigintcnt; /* number of SIGINT's pending */ +++ +++/* current state of the hole (for fasling into) *************************/ +++int curhbeg; /* next location to fasl into */ +++int usehole; /* if TRUE, fasl tries to use hole */ + + + +/* other stuff **********************************************************/ + +lispval ftemp,vtemp,argptr,ttemp; /* temporaries: use briefly */ + +int itemp; + +lispval sigacts[16]; /* for catching interrupts */ + +int sigstruck,sigdelay; /* for catching interrupts */ + +lispval stattab[16]; /* miscelleneous options */ + + + +/* interpreter globals */ + + + +int lctrace; + +int fvirgin; + +int GCtime; + +int errp; /* where are lying through our teeth. This + + is a pointer to inside a function. */ +++ +++ +++/* global pointers to the transfer tables */ +++ +++ +++struct trtab *trhead= /* first in list of transfer tables */ +++ (struct trtab *) 0; +++struct trent *trcur; /* next entry to allocate */ +++int trleft = 0; /* number of entries left in current table */ +++ +++/* globals from sysat.c */ +++ +++int *beginsweep; /* place for sweeper to begin */ +++int initflag = TRUE; /* inhibit gcing initially */ +++int tgcthresh = 15; +++ +++/* globals from rlc */ +++ +++int usehole; /* TRUE if allocator should consider the +++ hole for allocation */ +++ +++/* global used in io.c */ +++ +++lispval lastrtab; +++ +++/* globals from [VT]alloc.c */ +++ +++ +++struct heads header[TTSIZE]; +++int *bind_lists = (int *) CNIL; /* lisp data for compiled code */ +++ +++ +++struct types +++ atom_str = +++ { +++ (char *)CNIL, 0, ATOMSPP, ATOM, 5, +++ &atom_items, &atom_pages, &atom_name, +++ (struct heads *) CNIL +++ }, +++ strng_str = +++ { +++ (char *) CNIL, 0, STRSPP, STRNG, 1, +++ &str_items, &str_pages, &str_name, +++ (struct heads *) CNIL +++ }, +++ int_str = +++ { +++ (char *) CNIL, 0, INTSPP, INT, 1, +++ &int_items, &int_pages, &int_name, +++ (struct heads *) CNIL +++ }, +++ dtpr_str = +++ { +++ (char *) CNIL, 0, DTPRSPP, DTPR, 2, +++ &dtpr_items, &dtpr_pages, &dtpr_name, +++ (struct heads *) CNIL +++ }, +++ doub_str = +++ { +++ (char *) CNIL, 0, DOUBSPP, DOUB, 2, +++ &doub_items, &doub_pages, &doub_name, +++ (struct heads *) CNIL +++ }, +++ array_str = +++ { +++ (char *) CNIL, 0, ARRAYSPP, ARRAY, 5, +++ &array_items, &array_pages, &array_name, +++ (struct heads *) CNIL +++ }, +++ sdot_str = +++ { +++ (char *) CNIL, 0, SDOTSPP, SDOT, 2, +++ &sdot_items, &sdot_pages, &sdot_name, +++ (struct heads *) CNIL +++ }, +++ val_str = +++ { +++ (char *) CNIL, 0, VALSPP, VALUE, 1, +++ &val_items, &val_pages, &val_name, +++ (struct heads *) CNIL +++ }, +++funct_str = +++ { +++ (char *) CNIL, 0, BCDSPP, BCD, 2, +++ &funct_items, &funct_pages, &funct_name, +++ (struct heads *) CNIL +++ }, +++hunk_str[7] = +++ { +++ { +++ (char *) CNIL, 0, HUNK2SPP, HUNK2, 2, +++ &hunk_items[0], &hunk_pages[0], &hunk_name[0], +++ (struct heads *) CNIL +++ }, +++ { +++ (char *) CNIL, 0, HUNK4SPP, HUNK4, 4, +++ &hunk_items[1], &hunk_pages[1], &hunk_name[1], +++ (struct heads *) CNIL +++ }, +++ { +++ (char *) CNIL, 0, HUNK8SPP, HUNK8, 8, +++ &hunk_items[2], &hunk_pages[2], &hunk_name[2], +++ (struct heads *) CNIL +++ }, +++ { +++ (char *) CNIL, 0, HUNK16SPP, HUNK16, 16, +++ &hunk_items[3], &hunk_pages[3], &hunk_name[3], +++ (struct heads *) CNIL +++ }, +++ { +++ (char *) CNIL, 0, HUNK32SPP, HUNK32, 32, +++ &hunk_items[4], &hunk_pages[4], &hunk_name[4], +++ (struct heads *) CNIL +++ }, +++ { +++ (char *) CNIL, 0, HUNK64SPP, HUNK64, 64, +++ &hunk_items[5], &hunk_pages[5], &hunk_name[5], +++ (struct heads *) CNIL +++ }, +++ { +++ (char *) CNIL, 0, HUNK128SPP, HUNK128, 128, +++ &hunk_items[6], &hunk_pages[6], &hunk_name[6], +++ (struct heads *) CNIL +++ } +++ }; +++ +++int hashtop = HASHTOP; +++int xcycle = 0; /* used by xsbrk */ +++struct atom *hasht[HASHTOP]; +++lispval datalim; /* pointer to next location to allocate */ +++ +++char typetable[TTSIZE] = {UNBO,ATOM,PORT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT}; +++ +++/* this must be the last thing allocated in this file */ +++#ifdef VMS +++char *lsbrkpnt = (char *)0; +++char zfreespace[FREESIZE]; +++#else +++char lsbrkpnt,zfreespace; +++#endif diff --cc usr/src/cmd/lisp/divbig.c index 0000000000,c598f2d56d,0000000000..b14db552c6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/divbig.c +++ b/usr/src/cmd/lisp/divbig.c @@@@ -1,0 -1,265 -1,0 +1,273 @@@@ +++ +++static char *sccsid = "@(#)divbig.c 34.1 10/3/80"; +++ + +#include "global.h" + + + +#define b 0x40000000 + +#define toint(p) ((int) (p)) + + + +divbig(dividend, divisor, quotient, remainder) + +lispval dividend, divisor, *quotient, *remainder; + +{ + + register *ujp, *vip; + + int *sp(), *alloca(), d, negflag = 0, m, n, carry, rem, qhat, j; + + int borrow, negrem = 0; + + int *utop = sp(), *ubot, *vbot, *qbot; + + register lispval work; lispval export(); +++ snpand(3); + + + + /* copy dividend */ - for(work = dividend; work; work = work ->CDR) - stack(work->I); +++ for(work = dividend; work; work = work ->s.CDR) +++ stack(work->s.I); + + ubot = sp(); + + if(*ubot < 0) { /* knuth's division alg works only for pos + + bignums */ + + negflag ^= 1; + + negrem = 1; + + dsmult(utop-1,ubot,-1); + + } + + stack(0); + + ubot = sp(); + + + + + + /*copy divisor */ - for(work = divisor; work; work = work->CDR) - stack(work->I); +++ for(work = divisor; work; work = work->s.CDR) +++ stack(work->s.I); + + + + vbot = sp(); + + stack(0); + + if(*vbot < 0) { + + negflag ^= 1; + + dsmult(ubot-1,vbot,-1); + + } + + + + /* check validity of data */ + + n = ubot - vbot; + + m = utop - ubot - n - 1; + + if (n == 1) { + + /* do destructive division by a single. */ + + rem = dsdiv(utop-1,ubot,*vbot); + + if(negrem) + + rem = -rem; + + if(negflag) + + dsmult(utop-1,ubot,-1); + + if(remainder) + + *remainder = inewint(rem); + + if(quotient) + + *quotient = export(utop,ubot); + + return; + + } + + if (m < 0) { + + if (remainder) + + *remainder = dividend; + + if(quotient) + + *quotient = inewint(0); + + return; + + } + + qbot = alloca(toint(utop) + toint(vbot) - 2 * toint(ubot)); + +d1: + + d = b /(*vbot +1); + + dsmult(utop-1,ubot,d); + + dsmult(ubot-1,vbot,d); + + + +d2: for(j=0,ujp=ubot; j <= m; j++,ujp++) { + + + + d3: + + qhat = calqhat(ujp,vbot); + + d4: + + if((borrow = mlsb(ujp + n, ujp, ubot, -qhat)) < 0) { + + adback(ujp + n, ujp, ubot); + + qhat--; + + } + + qbot[j] = qhat; + + } + +d8: if(remainder) { + + dsdiv(utop, utop - n, d); + + if(negrem) dsmult(utop-1,utop-n,-1); + + *remainder = export(utop,utop-n); + + } + + if(quotient) { + + if(negflag) + + dsmult(qbot+m,qbot,-1); + + *quotient = export(qbot + m + 1, qbot); + + } + +} - /*static*/ calqhat(ujp,v1p) +++/* +++ * asm code commented out due to optimizer bug +++calqhat(ujp,v1p) + +register int *ujp, *v1p; + +{ + +asm(" movl $0x3fffffff,r0"); + +asm(" cmpl (r10),(r11)"); + +asm(" beql on1"); + +asm(" emul (r11),$0x40000000,4(r11),r1"); + +asm(" ediv (r10),r1,r0,r5"); + +asm("on1:"); + +asm(" emul r0,4(r10),$0,r1"); + +asm(" emul r5,$0x40000000,8(r11),r3"); + +asm(" subl2 r3,r1"); + +asm(" sbwc r4,r2"); + +asm(" bleq out1"); + +asm(" decl r0"); + +asm("out1:"); + +} - /*static*/ mlsb(utop,ubot,vtop,nqhat) +++mlsb(utop,ubot,vtop,nqhat) + +register int *utop, *ubot, *vtop; + +register int nqhat; + +{ + +asm(" clrl r0"); + +asm("loop2: addl2 (r11),r0"); + +asm(" emul r8,-(r9),r0,r2"); + +asm(" extzv $0,$30,r2,(r11)"); + +asm(" extv $30,$32,r2,r0"); + +asm(" acbl r10,$-4,r11,loop2"); + +} - /*static*/ adback(utop,ubot,vtop) +++adback(utop,ubot,vtop) + +register int *utop, *ubot, *vtop; + +{ + +asm(" clrl r0"); + +asm("loop3: addl2 -(r9),r0"); + +asm(" addl2 (r11),r0"); + +asm(" extzv $0,$30,r0,(r11)"); + +asm(" extv $30,$2,r0,r0"); + +asm(" acbl r10,$-4,r11,loop3"); + +} - /*static*/ dsdiv(top,bot,div) +++dsdiv(top,bot,div) + +register int* bot; + +{ + +asm(" clrl r0"); + +asm("loop4: emul r0,$0x40000000,(r11),r1"); + +asm(" ediv 12(ap),r1,(r11),r0"); + +asm(" acbl 4(ap),$4,r11,loop4"); + +} - /*static*/ dsmult(top,bot,mult) +++dsmult(top,bot,mult) + +register int* top; + +{ + +asm(" clrl r0"); + +asm("loop5: emul 12(ap),(r11),r0,r1"); + +asm(" extzv $0,$30,r1,(r11)"); + +asm(" extv $30,$32,r1,r0"); + +asm(" acbl 8(ap),$-4,r11,loop5"); + +asm(" movl r1,4(r11)"); + +} - /*static*/ lispval export(top,bot) +++lispval export(top,bot) + +register lispval bot; + +{ + + register r10, r9, r8, r7, r6; + +asm(" movl 4(ap),r10"); + +asm(" movl $0xC0000000,r4"); + +asm(" jmp Bexport"); + +} +++*/ + + + +#define MAXINT 0x8000000L + + + +Ihau(fix) + +register int fix; + +{ + + register count; + + if(fix==MAXINT) + + return(32); + + if(fix < 0) + + fix = -fix; + + for(count = 0; fix; count++) + + fix /= 2; + + return(count); + +} + +lispval + +Lhau() + +{ + + register count; + + register lispval handy; + + register dum1,dum2; + + register struct argent *lbot, *np; + + lispval Labsval(); + + + + handy = lbot->val; + +top: + + switch(TYPE(handy)) { + + case INT: + + count = Ihau(handy->i); + + break; + + case SDOT: + + lbot->val = Labsval(); - for(count = 0; handy->CDR!=((lispval) 0); handy = handy->CDR) +++ for(count = 0; handy->s.CDR!=((lispval) 0); handy = handy->s.CDR) + + count += 30; - count += Ihau(handy->I); +++ count += Ihau(handy->s.I); + + break; + + default: + + handy = errorh(Vermisc,"Haulong: bad argument",nil, + + TRUE,997,handy); + + goto top; + + } + + return(inewint(count)); + +} + +lispval + +Lhaipar() + +{ + + int *sp(); + + register lispval work; + + register n; + + register int *top = sp() - 1; + + register int *bot; + + register struct argent *lbot, *np; + + int mylen; + + + + /*chkarg(2);*/ + + work = lbot->val; + + /* copy data onto stack */ + +on1: + + switch(TYPE(work)) { + + case INT: + + stack(work->i); + + break; + + case SDOT: - for(; work!=((lispval) 0); work = work->CDR) - stack(work->I); +++ for(; work!=((lispval) 0); work = work->s.CDR) +++ stack(work->s.I); + + break; + + default: + + work = errorh(Vermisc,"Haipart: bad first argument",nil, + + TRUE,996,work); + + goto on1; + + } + + bot = sp(); + + if(*bot < 0) { + + stack(0); + + dsmult(top,bot,-1); + + bot--; + + } + + for(; *bot==0 && bot < top; bot++); + + /* recalculate haulong internally */ + + mylen = (top - bot) * 30 + Ihau(*bot); + + /* get second argument */ + + work = lbot[1].val; + + while(TYPE(work)!=INT) + + work = errorh(Vermisc,"Haipart: 2nd arg not int",nil, + + TRUE,995,work); + + n = work->i; + + if(n >= mylen || -n >= mylen) + + goto done; - if(n >= 0) { +++ if(n==0) return(inewint(0)); +++ if(n > 0) { + + /* Here we want n most significant bits + + so chop off mylen - n bits */ + + stack(0); + + n = mylen - n; + + for(n; n >= 30; n -= 30) + + top--; + + if(top < bot) + + error("Internal error in haipart #1",FALSE); + + dsdiv(top,bot,1<clb != nil) /* if there is an error handler */ +++ contatm = (contuab == TRUE ? tatom : nil); +++ +++ /* if there is a catch every error handler */ +++ if((handy = Verall->a.clb) != nil) +++ { +++ handy = Verall->a.clb; +++ Verall->a.clb = nil; /* turn off before calling */ +++ handy = calhan(limit,work,type,uniqid,contatm,message,handy); +++ if(contuab && (TYPE(handy) == DTPR)) +++ return(handy->d.car); +++ } +++ +++ if((handy = type->a.clb) != nil) /* if there is an error handler */ + + { - handy = calhan(limit,work,type->clb,uniqid,message); +++ handy = calhan(limit,work,type,uniqid,contatm,message,handy); + + if(contuab && (TYPE(handy) == DTPR)) - return(handy->car); +++ return(handy->d.car); + + } + + +++ pass = 1; + + /* search stack for error catcher */ +++ ps2: +++ founduw = FALSE; + + + + for (curp = (cp) errp ; curp != (cp) nil ; curp = curp->link) + + { - if((curp->labl == type) - || ( (TYPE(curp->labl) == DTPR) && (curp->labl->car == Verall))) +++ if(curp->labl == Veruwpt) founduw = TRUE; +++ if(((pass == 2) && founduw) +++ || (curp->labl == type) +++ || ( (TYPE(curp->labl) == DTPR) && (curp->labl->d.car == Verall))) + + { - if((curp->flag != nil) - && (type != Vererr)) { +++ if((pass == 1) && founduw) +++ { pass = 2; +++ goto ps2; +++ } +++ +++ if(founduw) +++ { protect(handy2 = newdot()); +++ handy2->d.car = Veruwpt; +++ handy = handy2->d.cdr = newdot(); +++ handy->d.car = nil; /* indicates error */ +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = type; +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = matom(message); +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = valret; +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = inewint(uniqid); +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = inewint(contuab); +++ while (limit-- > 0) /* put in optional args */ +++ { handy = handy->d.cdr = newdot(); +++ handy->d.car = *work++; +++ } +++ valret = handy2; /* return this as value */ +++ } +++ else if( (curp->flag != nil) +++ && (type != Vererr)) { + + /* print the full error message */ + + printf("%s ",message); + + while(limit-->0) { + + printr(*work++,stdout); + + fflush(stdout); + + } + + fputc('\n',stdout); + + fflush(stdout); + + } +++ if(!founduw && ((handy=Verrset->a.clb) != nil)) +++ { +++ calhan(limit,work,type,uniqid,contatm,message,handy); +++ } + + popnames(curp->svbnp); /* un shallow bind */ + + errp = (int) curp->link; /* set error to next frame */ +++ /* +++ * return value goes into r7 until after movc3 instruction +++ * which clobbers r0 +++ */ +++ asm(" movl 12(ap),r7"); /* set return value (valret)*/ + + asm(" addl3 $16,r11,sp"); /* skip link,flag,labl,svbnp */ - asm(" movc3 $40,(sp),_setsav");/*restore (return) context*/ - asm(" movab 40(sp),sp"); /* skip past "" "" */ +++ asm(" movc3 $44,(sp),_setsav");/*restore (return) context*/ +++ asm(" movab 44(sp),sp"); /* skip past "" "" */ + + asm(" popr $0x2540"); /* restore registers */ - asm(" movl 12(ap),r0"); /* set return value */ +++ asm(" movl r7,r0"); + + asm(" rsb"); /* return to errset */ + + /* NOT REACHED */ + + } + + } + + + + /* no one will catch this error, we must see if there is an + + error-goes-to-top-level catcher */ + + - if (Vertpl->clb != nil) +++ if (Vertpl->a.clb != nil) + + { + + - handy = calhan(limit,work,Vertpl,uniqid,message); +++ handy = calhan(limit,work,type,uniqid,contatm,message,Vertpl->a.clb); + + if( contuab && (TYPE(handy) == DTPR)) - return(handy->car); +++ return(handy->d.car); + + } + + + + /* at this point, print error mssage and break, just like + + the current error scheme */ - printf("%s: ",message); +++ printf("%s ",message); + + while(limit-->0) { + + printr(*work++,stdout); + + fflush(stdout); + + } + + +++ +++ /* If automatic-reset is set +++ we will now jump to top level, calling the reset function +++ if it exists, or using the c rest function if it does not +++ */ +++ +++ if(Sautor) +++ { +++ if ((handy = reseta->a.fnbnd) != nil) +++ { lbot = np; +++ protect(reseta); +++ protect(nil); +++ Lapply(); +++ } +++ contval = 0; +++ reset(BRRETB); +++ } +++ + + curdep = ++depth; + + getexit(saveme); + + while(what = setexit()) { + + errp = myerrp; + + depth = curdep; + + switch(what) { + + case BRRETB: + + if (curdep == (int) contval) { + + popnames(savedbnp); + + lbot = savedlbot; + + continue; + + } + + default: + + resexit(saveme); + + reset(what); + + + + case BRRETN: + + if (contuab) + + { + + popnames(savedbnp); + + lbot = savedlbot; + + depth = curdep -1; + + resexit(saveme); + + return(contval); + + } + + printf("CAN'T CONTINUE\n"); + + + + } + + } + + lbot = np; + + np++->val = P(stdin); + + np++->val = eofa; + + while(TRUE) { + + +++ depth = curdep; /* In case of freturn, reset this global */ + + fprintf(stdout,"\n%d:>",curdep); + + dmpport(stdout); + + vtemp = Lread(); + + if(vtemp == eofa) exit(0); + + printr(eval(vtemp),stdout); + + } + +} - static lispval - calhan(limit,work,handler,uniqid,message) +++lispval +++calhan(limit,work,type,uniqid,contuab,message,handler) + +register lispval *work; - lispval handler; +++lispval handler,type,contuab; + +register limit; + +register char *message; + +int uniqid; + +{ + + register lispval handy; + + register struct argent *lbot, *np; + + lbot = np; - protect(handler->clb); /* funcall the handler */ +++ protect(handler); /* funcall the handler */ + + protect(handy = newdot()); /* with a list consisting of */ - handy->car = inewint(uniqid); /* identifying number, */ - handy = handy->cdr = newdot(); - handy->car = matom(message); /* message to be typed out, */ +++ handy->d.car = type; /* type, */ +++ handy = (handy->d.cdr = newdot()); +++ handy->d.car = inewint(uniqid); /* identifying number, */ +++ handy = (handy->d.cdr = newdot()); +++ handy->d.car = contuab; +++ handy = (handy->d.cdr = newdot()); +++ handy->d.car = matom(message); /* message to be typed out, */ + + while(limit-- > 0) + + { /* any other args. */ - handy = handy->cdr = newdot(); - handy->car = *work++; +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = *work++; + + } - handy->cdr = nil; +++ handy->d.cdr = nil; + + + + handy = Lfuncal(); + + np=lbot; +++ return(handy); + +} + + + +/* lispend **************************************************************/ + +/* Fatal errors come here, with their epitaph. */ + +lispend(mesg) + + char mesg[]; + + { + + dmpport(poport); + + fprintf(errport,"%s\n",mesg); + + dmpport(errport); + + exit(0); + + } + + + +/* namerr ***************************************************************/ + +/* handles namestack overflow, at present by simply giving a message */ + + + +namerr() + +{ - np -= 10; +++ if((nplim = np + NAMINC) > orgnp + NAMESIZE) +++ { +++ printf("Unrecoverable Namestack Overflow, (reset) is forced\n"); +++ fflush(stdout); +++ nplim = orgnp + NAMESIZE - 4*NAMINC; +++ lbot = np = nplim - NAMINC; +++ protect(matom("reset")); +++ Lfuncal(); +++ } + + error("NAMESTACK OVERFLOW",FALSE); + + /* NOT REACHED */ + +} + +binderr() + +{ + + bnp -= 10; + + error("Bindstack overflow.",FALSE); + +} + +rtaberr() + +{ + + bindfix(Vreadtable,strtab,nil); + + error("Illegal read table.",FALSE); + +} + +badmem() + +{ + + error("Attempt to allocate beyond static structures.",FALSE); + +} +++argerr(msg) +++char *msg; +++{ +++ Lshostk(); +++ errorh(Vermisc,"incorrect number of args to", +++ nil,FALSE,0,matom(msg)); +++} diff --cc usr/src/cmd/lisp/eval.c index 0000000000,93b0a830d6,0000000000..10978fc362 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/eval.c +++ b/usr/src/cmd/lisp/eval.c @@@@ -1,0 -1,517 -1,0 +1,607 @@@@ +++static char *sccsid = "@(#)eval.c 34.2 10/21/80"; +++ + +#include "global.h" +++#include + +/************************************************************************/ + +/* */ + +/* file: eval.i */ + +/* contents: evaluator and namestack maintenance routines */ + +/* */ + +/************************************************************************/ + + + + + +/* eval *****************************************************************/ + +/* returns the value of the pointer passed as the argument. */ + + +++ + +lispval + +eval(actarg) + +lispval actarg; + +{ + +#define argptr handy - register lispval a = actarg; - register lispval handy; - register struct nament *namptr; - register struct argent *workp; - register struct argent *lbot; - register struct argent *np; - struct argent *poplbot; - struct nament *oldbnp = bnp; - lispval Ifcall(), Iarray(); - - /*debugging +++ register lispval a = actarg; +++ register lispval handy; +++ register struct nament *namptr; +++ register struct argent *workp; +++ register struct argent *lbot; +++ register struct argent *np; +++ /* struct argent *poplbot; Why this here? - M. Marcus */ +++ struct nament *oldbnp = bnp; +++ lispval Ifcall(), Iarray(); +++ +++ /*debugging +++ if (rsetsw && rsetatom->a.clb != nil) { + + printf("Eval:"); + + printr(a,stdout); - fflush(stdout); */ - switch (TYPE(a)) - { - case ATOM: - handy = a->clb; - if(handy==CNIL) { - handy = errorh(Vermisc,"Unbound Variable:",nil,TRUE,0,a); - } +++ printf("\nrsetsw: %d evalhsw: %d\n", rsetsw, evalhsw); +++ printf("*rset: "); +++ printr(rsetatom->a.clb,stdout); +++ printf(" evalhook: "); +++ printr(evalhatom->a.clb,stdout); +++ printf(" evalhook call flag^G: "); +++ printr(evalhcall->a.clb, stdout); +++ fflush(stdout); +++ }; */ +++ +++ /* check if an interrupt is pending and handle if so */ +++ if(sigintcnt > 0) sigcall(SIGINT); +++ +++ if (rsetsw && rsetatom->a.clb != nil){ /* if (*rset t) has been done */ +++ if (evalhsw != nil && evalhatom->a.clb != nil) +++ /*if (sstatus evalhook t) +++ and evalhook non-nil */ +++ if (evalhcall->a.clb == tatom) +++ /*if this is a call to evalhook, don't call evalhook +++ function, but clobber evalhcall atom, so recursive +++ calls to eval cause evalhook function to fire. */ +++ evalhcall->a.clb = nil; +++ else { +++ /* setup equivalent of (funcall evalhook ) */ +++ (np++)->val = a; /* push form on namestack */ +++ lbot=np; /* set up args to funcall */ +++ (np++)->val = evalhatom->a.clb; /* push evalhook's clb */ +++ (np++)->val = a; /* eval's arg becomes +++ 2nd arg to funcall */ +++ PUSHDOWN(evalhatom, nil); /* lambda-bind evalhook to nil*/ +++ handy = Lfuncal(); /* now call funcall */ +++ POP; + + return(handy); - - case VALUE: - return(a->l); - - case DTPR: - (np++)->val = a; /* push form on namestack */ - lbot = np; /* define beginning of argstack */ - oldbnp = bnp; /* remember start of bind stack */ - a = a->car; /* function name or lambda-expr */ - for(EVER) - { - switch(TYPE(a)) - { - case ATOM: +++ }; +++ }; +++ +++ switch (TYPE(a)) +++ { +++ case ATOM: +++ if (rsetsw && rsetatom->a.clb != nil && bptr_atom->a.clb != nil) { +++ +++ struct nament *bpntr, *eval1bptr; +++ /* Both rsetsw and rsetatom for efficiency*/ +++ /* bptr_atom set by second arg to eval1 */ +++ eval1bptr = (struct nament *) bptr_atom->a.clb->d.cdr; +++ /* eval1bptr is bnp when eval1 was called; +++ if an atom was bound after this, +++ then its clb is valid */ +++ for (bpntr = eval1bptr; bpntr < bnp; bpntr++) +++ if (bpntr->atm==a) { +++ handy = a->a.clb; +++ goto gotatom; +++ }; /* Value saved in first binding of a, +++ if any, after pointer to eval1, +++ is the valid value, else use its clb */ +++ for (bpntr = (struct nament *)bptr_atom->a.clb->d.car; +++ bpntr < eval1bptr; bpntr++) +++ if (bpntr->atm==a) { +++ handy=bpntr->val; +++ goto gotatom; /* Simply no way around goto here */ +++ }; +++ }; +++ handy = a->a.clb; +++ gotatom: +++ if(handy==CNIL) { +++ handy = errorh(Vermisc,"Unbound Variable:",nil,TRUE,0,a); +++ } +++ return(handy); +++ +++ case VALUE: +++ return(a->l); +++ +++ case DTPR: +++ (np++)->val = a; /* push form on namestack */ +++ lbot = np; /* define beginning of argstack */ +++ /* oldbnp = bnp; redundant - Mitch Marcus */ +++ a = a->d.car; /* function name or lambda-expr */ +++ for(EVER) +++ { +++ switch(TYPE(a)) +++ { +++ case ATOM: + + /* get function binding */ - if(a->fnbnd==nil && a->clb!=nil) { - a=a->clb; - if(TYPE(a)==ATOM) - a=a->fnbnd; - } else - a = a->fnbnd; - break; - case VALUE: - a = a->l; /* get value */ - break; - } - - vtemp = (CNIL-1); /* sentinel value for error test */ - - funcal: switch (TYPE(a)) - { - case BCD: /* function */ - argptr = actarg->cdr; - - /* decide whether lambda, nlambda or - macro and push args onto argstack - accordingly. */ - - if(a->discipline==nlambda) { - (np++)->val = argptr; - TNP; - }else if(a->discipline==macro) { - (np++)->val = actarg; - TNP; - } else for(;argptr!=nil; argptr = argptr->cdr) { - (np++)->val = eval(argptr->car); - TNP; - } - /* go for it */ - - if(TYPE(a->discipline)==INT) - vtemp = Ifcall(a); - else - vtemp = (*(lispval (*)())(a->entry))(); - break; - - case ARRAY: - vtemp = Iarray(a,actarg->cdr); - break; - - - case DTPR: - /* push args on argstack according to - type */ - - argptr = a->car; - if (argptr==lambda) { - for(argptr = actarg->cdr; - argptr!=nil; argptr=argptr->cdr) { - - (np++)->val = eval(argptr->car); - TNP; - } - } else if (argptr==nlambda) { - (np++)->val = actarg->cdr; - TNP; - } else if(argptr==macro) { - (np++)->val = actarg; - TNP; - } else if(argptr==lexpr) { - for(argptr = actarg->cdr; - argptr!=nil; argptr=argptr->cdr) { - - (np++)->val = eval(argptr->car); - TNP; - } - handy = newdot(); - handy->car = (lispval)lbot; - handy->cdr = (lispval)np; - PUSHDOWN(lexpr_atom,handy); - lbot = np; - (np++)->val = inewint(((lispval *)handy->cdr) - (lispval *)handy->car); - - } else break; /* something is wrong - this isn't a proper function */ - - argptr = (a->cdr)->car; - namptr = bnp; - workp = lbot; - if(bnp + (np - lbot)> bnplim) - binderr(); - for(;argptr != (lispval)nil; - workp++,argptr = argptr->cdr) /* rebind formal names (shallow) */ - { - if(argptr->car==nil) - continue; - /*if(((namptr)->atm = argptr->car)==nil) - error("Attempt to lambda bind nil",FALSE);*/ - namptr->atm = argptr->car; - if (workp < np) { - namptr->val = namptr->atm->clb; - namptr->atm->clb = workp->val; - } else - bnp = namptr, - error("Too few actual parameters",FALSE); - namptr++; - } - bnp = namptr; - if (workp < np) - error("Too many actual parameters",FALSE); - - /* execute body, implied prog allowed */ - - for (handy = a->cdr->cdr; - handy != nil; - handy = handy->cdr) { - vtemp = eval(handy->car); - } - } - if (vtemp != (CNIL-1)) +++ if(a->a.fnbnd==nil && a->a.clb!=nil) { +++ a=a->a.clb; +++ if(TYPE(a)==ATOM) +++ a=a->a.fnbnd; +++ } else +++ a = a->a.fnbnd; +++ break; +++ case VALUE: +++ a = a->l; /* get value */ +++ break; +++ } +++ +++ vtemp = (CNIL-1); /* sentinel value for error test */ +++ +++ funcal: switch (TYPE(a)) +++ { +++ case BCD: /* function */ +++ argptr = actarg->d.cdr; +++ +++ /* decide whether lambda, nlambda or +++ macro and push args onto argstack +++ accordingly. */ +++ +++ if(a->bcd.discipline==nlambda) { +++ (np++)->val = argptr; +++ TNP; +++ } else if(a->bcd.discipline==macro) { +++ (np++)->val = actarg; +++ TNP; +++ } else for(;argptr!=nil; argptr = argptr->d.cdr) { +++ (np++)->val = eval(argptr->d.car); +++ TNP; +++ } +++ /* go for it */ +++ +++ if(TYPE(a->bcd.discipline)==STRNG) +++ vtemp = Ifcall(a); +++ else +++ vtemp = (*(lispval (*)())(a->bcd.entry))(); +++ break; +++ +++ case ARRAY: +++ vtemp = Iarray(a,actarg->d.cdr,TRUE); +++ break; +++ +++ case DTPR: /* push args on argstack according to +++ type */ +++ argptr = a->d.car; +++ if (argptr==lambda) { +++ for(argptr = actarg->d.cdr; +++ argptr!=nil; argptr=argptr->d.cdr) { +++ +++ (np++)->val = eval(argptr->d.car); +++ TNP; +++ } +++ } else if (argptr==nlambda) { +++ (np++)->val = actarg->d.cdr; +++ TNP; +++ } else if (argptr==macro) { +++ (np++)->val = actarg; +++ TNP; +++ } else if (argptr==lexpr) { +++ for(argptr = actarg->d.cdr; +++ argptr!=nil; argptr=argptr->d.cdr) { +++ +++ (np++)->val = eval(argptr->d.car); +++ TNP; +++ } +++ handy = newdot(); +++ handy->d.car = (lispval)lbot; +++ handy->d.cdr = (lispval)np; +++ PUSHDOWN(lexpr_atom,handy); +++ lbot = np; +++ (np++)->val = inewint(((lispval *)handy->d.cdr) - (lispval *)handy->d.car); +++ +++ } else break; /* something is wrong - this isn't a proper function */ +++ +++ argptr = (a->d.cdr)->d.car; +++ namptr = bnp; +++ workp = lbot; +++ if(bnp + (np - lbot)> bnplim) +++ binderr(); +++ for(;argptr != (lispval)nil; +++ workp++,argptr = argptr->d.cdr) /* rebind formal names (shallow) */ +++ { +++ if(argptr->d.car==nil) +++ continue; +++ /*if(((namptr)->atm = argptr->d.car)==nil) +++ error("Attempt to lambda bind nil",FALSE);*/ +++ namptr->atm = argptr->d.car; +++ if (workp < np) { +++ namptr->val = namptr->atm->a.clb; +++ namptr->atm->a.clb = workp->val; +++ } else +++ bnp = namptr, +++ error("Too few actual parameters",FALSE); +++ namptr++; +++ } +++ bnp = namptr; +++ if (workp < np) +++ error("Too many actual parameters",FALSE); +++ +++ /* execute body, implied prog allowed */ +++ +++ for (handy = a->d.cdr->d.cdr; +++ handy != nil; +++ handy = handy->d.cdr) { +++ vtemp = eval(handy->d.car); +++ } +++ } +++ if (vtemp != (CNIL-1)) { + + /* if we get here with a believable value, */ + + /* we must have executed a function. */ - { - popnames(oldbnp); +++ popnames(oldbnp); + + - /* in case some clown trashed t */ +++ /* in case some clown trashed t */ + + - tatom->clb = (lispval) tatom; - if(a->car==macro) return(eval(vtemp)); - /* It is of the most wonderful - coincidence that the offset - for car is the same as for - discipline so we get bcd macros - for free here ! */ - else return(vtemp); - } - popnames(oldbnp); - a = (lispval) errorh(Vermisc,"BAD FUNCTION",nil,TRUE,0,actarg); - } +++ tatom->a.clb = (lispval) tatom; +++ if(a->d.car==macro) +++ return(eval(vtemp)); +++ /* It is of the most wonderful +++ coincidence that the offset +++ for car is the same as for +++ discipline so we get bcd macros +++ for free here ! */ +++ else return(vtemp); +++ } +++ popnames(oldbnp); +++ a = (lispval) errorh(Verundef,"eval: Undefined function ",nil,TRUE,0,actarg->d.car); +++ } + + - } - return(a); /* other data types are considered constants */ - } +++ } +++ return(a); /* other data types are considered constants */ +++ } + + + + + + + + + +/* popnames *************************************************************/ - /* removes from the name stack all entries above the first argument. */ - /* routine should usually be used to clean up the name stack as it */ - /* knows about the special cases. np is returned pointing to the */ - /* same place as the argument passed. */ +++/* removes from the name stack all entries above the first argument. */ +++/* routine should usually be used to clean up the name stack as it */ +++/* knows about the special cases. np is returned pointing to the */ +++/* same place as the argument passed. */ + +lispval + +popnames(llimit) + +register struct nament *llimit; + +{ - register struct nament *rnp; +++ register struct nament *rnp; + + - for(rnp = bnp - 1; rnp >= llimit; rnp--) - rnp->atm->clb = rnp->val; - bnp = llimit; +++ for(rnp = bnp; --rnp >= llimit;) +++ rnp->atm->a.clb = rnp->val; +++ bnp = llimit; + +} + + + + + +/************************************************************************/ + +/* */ + +/* file: apply.c */ - /* Caveat -- Work in Progress -- not guaranteed! not tested! +++/* Caveat -- Work in Progress -- not guaranteed! not tested! */ + +/* */ + +/* apply ***************************************************************/ + +lispval + +Lapply() + +{ - register lispval a; - register lispval handy; - register struct argent *workp; - register struct nament *namptr; - register struct argent *lbot; - register struct argent *np; - lispval vtemp; - struct nament *oldbnp = bnp; - struct argent *oldlbot = lbot; /* Bottom of my frame! */ - - a = lbot->val; - argptr = lbot[1].val; - if(np-lbot!=2) - errorh(Vermisc,"Apply: Wrong number of args.",nil,FALSE, - 999,a,argptr); - if(TYPE(argptr)!=DTPR && argptr!=nil) - argptr = errorh(Vermisc,"Apply: non-list of args",nil,TRUE, - 998,argptr); - (np++)->val = a; /* push form on namestack */ - TNP; - lbot = np; /* bottom of current frame */ - for(EVER) - { - if (TYPE(a) == ATOM) a = a->fnbnd; - /* get function defn (unless calling form */ - /* is itself a lambda-expr) */ - vtemp = CNIL; /* sentinel value for error test */ - switch (TYPE(a)) - { - case BCD: /* printf("BCD\n");*/ - /* push arguments - value of a */ - if(a->discipline==nlambda || a->discipline==macro) { - (np++)->val=argptr; - TNP; - } else for (; argptr!=nil; argptr = argptr->cdr) { - (np++)->val=argptr->car; - TNP; - } - - vtemp = (*(lispval (*)())(a->entry))(); /* go for it */ - break; - - case ARRAY: - vtemp = Iarray(a,argptr); - break; - - - case DTPR: - if (a->car==nlambda || a->car==macro) { - (np++)->val = argptr; - TNP; - } else if (a->car==lambda) - for (; argptr!=nil; argptr = argptr->cdr) { - (np++)->val = argptr->car; - TNP; - } - else if(a->car==lexpr) { - for (; argptr!=nil; argptr = argptr->cdr) { - - (np++)->val = argptr->car; - TNP; - } - handy = newdot(); - handy->car = (lispval)lbot; - handy->cdr = (lispval)np; - PUSHDOWN(lexpr_atom,handy); - lbot = np; - (np++)->val = inewint(((lispval *)handy->cdr) - (lispval *)handy->car); - - } else break; /* something is wrong - this isn't a proper function */ - rebind(a->cdr->car,lbot); - np = lbot; - for (handy = a->cdr->cdr; - handy != nil; - handy = handy->cdr) { - vtemp = eval(handy->car); /* go for it */ - } - } - if (vtemp != CNIL) - /* if we get here with a believable value, */ - /* we must have executed a function. */ - { - popnames(oldbnp); - - /* in case some clown trashed t */ - - tatom->clb = (lispval) tatom; - return(vtemp); - } - popnames(oldbnp); - printr(oldlbot->val,stdout); - a = (lispval) error("BAD FUNCTION",TRUE); - } - /*NOT REACHED*/ +++ register lispval a; +++ register lispval handy; +++ register struct argent *workp; +++ register struct nament *namptr; +++ register struct argent *lbot; +++ register struct argent *np; +++ lispval vtemp; +++ struct nament *oldbnp = bnp; +++ struct argent *oldlbot = lbot; /* Bottom of my frame! */ +++ +++ a = lbot->val; +++ argptr = lbot[1].val; +++ if(np-lbot!=2) +++ errorh(Vermisc,"Apply: Wrong number of args.",nil,FALSE, +++ 999,a,argptr); +++ if(TYPE(argptr)!=DTPR && argptr!=nil) +++ argptr = errorh(Vermisc,"Apply: non-list of args",nil,TRUE, +++ 998,argptr); +++ (np++)->val = a; /* push form on namestack */ +++ TNP; +++ lbot = np; /* bottom of current frame */ +++ for(EVER) +++ { +++ if (TYPE(a) == ATOM) a = a->a.fnbnd; +++ /* get function definition (unless +++ calling form is itself a lambda- +++ expression) */ +++ vtemp = CNIL; /* sentinel value for error test */ +++ switch (TYPE(a)) { +++ +++ case BCD: +++ /* push arguments - value of a */ +++ if(a->bcd.discipline==nlambda || a->bcd.discipline==macro) { +++ (np++)->val=argptr; +++ TNP; +++ } else for (; argptr!=nil; argptr = argptr->d.cdr) { +++ (np++)->val=argptr->d.car; +++ TNP; +++ } +++ +++ if(TYPE(a->bcd.discipline) == STRNG) +++ vtemp = Ifcall(a); /* foreign function */ +++ else +++ vtemp = (*(lispval (*)())(a->bcd.entry))(); /* go for it */ +++ break; +++ +++ case ARRAY: +++ vtemp = Iarray(a,argptr,FALSE); +++ break; +++ +++ +++ case DTPR: +++ if (a->d.car==nlambda || a->d.car==macro) { +++ (np++)->val = argptr; +++ TNP; +++ } else if (a->d.car==lambda) +++ for (; argptr!=nil; argptr = argptr->d.cdr) { +++ (np++)->val = argptr->d.car; +++ TNP; +++ } +++ else if(a->d.car==lexpr) { +++ for (; argptr!=nil; argptr = argptr->d.cdr) { +++ +++ (np++)->val = argptr->d.car; +++ TNP; +++ } +++ handy = newdot(); +++ handy->d.car = (lispval)lbot; +++ handy->d.cdr = (lispval)np; +++ PUSHDOWN(lexpr_atom,handy); +++ lbot = np; +++ (np++)->val = inewint(((lispval *)handy->d.cdr) - (lispval *)handy->d.car); +++ +++ } else break; /* something is wrong - this isn't a proper function */ +++ rebind(a->d.cdr->d.car,lbot); +++ np = lbot; +++ for (handy = a->d.cdr->d.cdr; +++ handy != nil; +++ handy = handy->d.cdr) { +++ vtemp = eval(handy->d.car); /* go for it */ +++ } +++ } +++ if (vtemp != CNIL) +++ /* if we get here with a believable value, */ +++ /* we must have executed a function. */ +++ { +++ popnames(oldbnp); +++ +++ /* in case some clown trashed t */ +++ +++ tatom->a.clb = (lispval) tatom; +++ return(vtemp); +++ } +++ popnames(oldbnp); +++ a = (lispval) errorh(Verundef,"apply: Undefined Function ", +++ nil,TRUE,0,oldlbot->val); +++ } +++ /*NOT REACHED*/ + +} + + + + + +/* + + * Rebind -- rebind formal names + + */ + +rebind(argptr,workp) - register lispval argptr; /* argptr points to list of atoms */ - register struct argent * workp; /* workp points to position on stack - where evaluated args begin */ +++register lispval argptr; /* argptr points to list of atoms */ +++register struct argent * workp; /* workp points to position on stack +++ where evaluated args begin */ + +{ - register lispval vtemp; - register struct nament *namptr = bnp; - register struct argent *lbot; - register struct argent *np; - - for(;argptr != (lispval)nil; - workp++,argptr = argptr->cdr) /* rebind formal names (shallow) */ - { - if(argptr->car==nil) - continue; - namptr->atm = argptr->car; - if (workp < np) { - namptr->val = namptr->atm->clb; - namptr->atm->clb = workp->val; - } else - bnp = namptr, - error("Too few actual parameters",FALSE); - namptr++; - if(namptr > bnplim) - binderr(); - } - bnp = namptr; - if (workp < np) - error("Too many actual parameters",FALSE); +++ register lispval vtemp; +++ register struct nament *namptr = bnp; +++ register struct argent *lbot; +++ register struct argent *np; +++ +++ for(;argptr != (lispval)nil; +++ workp++,argptr = argptr->d.cdr) /* rebind formal names (shallow) */ +++ { +++ if(argptr->d.car==nil) +++ continue; +++ namptr->atm = argptr->d.car; +++ if (workp < np) { +++ namptr->val = namptr->atm->a.clb; +++ namptr->atm->a.clb = workp->val; +++ } else +++ bnp = namptr, +++ error("Too few actual parameters",FALSE); +++ namptr++; +++ if(namptr > bnplim) +++ binderr(); +++ } +++ bnp = namptr; +++ if (workp < np) +++ error("Too many actual parameters",FALSE); + +} + + +++/* the argument to Lfuncal is optional, if it is given then it is +++ * the name of the function to call and lbot points to the first arg. +++ * if it is not given, then lbot points to the function to call +++ */ + +lispval - Lfuncal() +++Lfuncal(fcn) +++lispval fcn; + +{ - register lispval a; - register lispval handy; - register struct argent *oldlbot; - register struct nament **namptr; - register struct argent *lbot; - register struct argent *np; - - lispval Ifcall(),Llist(),Iarray(); - lispval vtemp; - struct nament *oldbnp = bnp; - int typ; - extern lispval end[]; - - /*debugging stufff - printf("In funcal: "); - printr(lbot->val,stdout); - fflush(stdout); - printf("\n"); */ - - oldlbot = lbot; /* bottom of my namestack frame */ - a = lbot->val; /* function I am evaling. */ +++ register lispval a; +++ register lispval handy; +++ register struct argent *oldlbot; +++ register struct nament **namptr; +++ register struct argent *lbot; +++ register struct argent *np; +++ struct nament *oldbnp = bnp; /* MUST be first local for evalframe */ +++ lispval fcncalled; +++ lispval Ifcall(),Llist(),Iarray(); +++ lispval vtemp; +++ int typ; +++ extern lispval end[]; +++ +++ /*debugging stufff +++ printf("In funcal: "); +++ printr(lbot->val,stdout); +++ fflush(stdout); +++ printf("\n"); */ +++ +++ /* atrocity to avoid call to nargs() */ +++ /*define nargs() (* (char *) (&fcn -1))*/ +++ +++ oldlbot = lbot; /* bottom of my namestack frame */ +++ if((&fcn)[-1]==(lispval)1) /* function I am evaling. */ +++ a = fcncalled = fcn; +++ else { +++ a = fcncalled = lbot->val; + + lbot++; - - for(EVER) - { - typ = TYPE(a); - if (typ == ATOM) a = a->fnbnd, typ = TYPE(a); - - /* get function defn (unless calling form */ - /* is itself a lambda-expr) */ - vtemp = CNIL; /* sentinel value for error test */ - switch (typ) { - case ARRAY: - vtemp = Iarray(a,Llist()); - break; - case BCD: - if(a->discipline==nlambda) - { if(np==lbot) protect(nil); /* default is nil */ - while(np-lbot!=1 || (lbot->val != nil && - TYPE(lbot->val)!=DTPR)) { - lbot->val = error("Bad funcall arg(s) to fexpr.",TRUE); - np = lbot+1; - } - } - /* go for it */ - - if(TYPE(a->discipline)==INT) - vtemp = Ifcall(a); - else - vtemp = (*(lispval (*)())(a->entry))(); - if(a->discipline==macro) - vtemp = eval(vtemp); - break; - - - case DTPR: - if (a->car == lambda) { - ;/* VOID */ - } else if (a->car == nlambda || a->car==macro) { - if( np==lbot ) protect(nil); /* default */ - while(np-lbot!=1 || (lbot->val != nil && - TYPE(lbot->val)!=DTPR)) { - lbot->val = error("Bad funcall arg(s) to fexpr.",TRUE); - np = lbot+1; - } - } else if (a->car == lexpr) { - handy = newdot(); - handy->car = (lispval) lbot; - handy->cdr = (lispval) np; - PUSHDOWN(lexpr_atom,handy); - lbot = np; - (np++)->val = inewint(((lispval *)handy->cdr) - (lispval *)handy->car); - } else break; /* something is wrong - this isn't a proper function */ - rebind(a->cdr->car,lbot); - np = lbot; - for (handy = a->cdr->cdr; - handy != nil; - handy = handy->cdr) { - vtemp = eval(handy->car); /* go for it */ - } - if(a->car==macro) - vtemp = eval(vtemp); - } - if (vtemp != CNIL) - /* if we get here with a believable value, */ - /* we must have executed a function. */ - { - popnames(oldbnp); - - /* in case some clown trashed t */ - - tatom->clb = (lispval) tatom; - /*debugging - if(a>(lispval) end){printf(" leaving:"); - printr(a,stdout); - fflush(stdout);} */ - return(vtemp); - } - popnames(oldbnp); - printr(oldlbot->val,stdout); - a = (lispval) error("BAD FUNCTION",TRUE); - - } - /*NOT REACHED*/ +++ } +++ +++ /* check if exception pending */ +++ if(sigintcnt > 0 ) sigcall(SIGINT); +++ +++ for(EVER) +++ { +++ top: +++ typ = TYPE(a); +++ if (typ == ATOM) a = a->a.fnbnd, typ = TYPE(a); +++ +++ /* get function defn (unless calling form */ +++ /* is itself a lambda-expr) */ +++ vtemp = CNIL-1; /* sentinel value for error test */ +++ switch (typ) { +++ case ARRAY: +++ protect(a); /* stack array descriptor on top */ +++ a = a->ar.accfun; /* now funcall access function */ +++ goto top; +++ case BCD: +++ if(a->bcd.discipline==nlambda) +++ { if(np==lbot) protect(nil); /* default is nil */ +++ while(np-lbot!=1 || (lbot->val != nil && +++ TYPE(lbot->val)!=DTPR)) { +++ +++ lbot->val = errorh(Vermisc,"Bad funcall arg(s) to fexpr.", +++ nil,TRUE,0,lbot->val); +++ +++ np = lbot+1; +++ } +++ } +++ /* go for it */ +++ +++ if(TYPE(a->bcd.discipline)==STRNG) +++ vtemp = Ifcall(a); +++ else +++ vtemp = (*(lispval (*)())(a->bcd.entry))(); +++ if(a->bcd.discipline==macro) +++ vtemp = eval(vtemp); +++ break; +++ +++ +++ case DTPR: +++ if (a->d.car == lambda) { +++ ;/* VOID */ +++ } else if (a->d.car == nlambda || a->d.car==macro) { +++ if( np==lbot ) protect(nil); /* default */ +++ while(np-lbot!=1 || (lbot->val != nil && +++ TYPE(lbot->val)!=DTPR)) { +++ lbot->val = error("Bad funcall arg(s) to fexpr.",TRUE); +++ np = lbot+1; +++ } +++ } else if (a->d.car == lexpr) { +++ handy = newdot(); +++ handy->d.car = (lispval) lbot; +++ handy->d.cdr = (lispval) np; +++ PUSHDOWN(lexpr_atom,handy); +++ lbot = np; +++ (np++)->val = inewint(((lispval *)handy->d.cdr) - (lispval *)handy->d.car); +++ } else break; /* something is wrong - this isn't a proper function */ +++ rebind(a->d.cdr->d.car,lbot); +++ np = lbot; +++ for (handy = a->d.cdr->d.cdr; +++ handy != nil; +++ handy = handy->d.cdr) { +++ vtemp = eval(handy->d.car); /* go for it */ +++ } +++ if(a->d.car==macro) +++ vtemp = eval(vtemp); +++ } +++ if (vtemp != CNIL-1) +++ /* if we get here with a believable value, */ +++ /* we must have executed a function. */ +++ { +++ popnames(oldbnp); +++ +++ /* in case some clown trashed t */ +++ +++ tatom->a.clb = (lispval) tatom; +++ /*debugging +++ if(a>(lispval) end){printf(" leaving:"); +++ printr(a,stdout); +++ fflush(stdout);} */ +++ return(vtemp); +++ } +++ popnames(oldbnp); +++ a = fcncalled = (lispval) errorh(Verundef,"funcall: Bad function", +++ nil,TRUE,0,fcncalled); +++ } +++ /*NOT REACHED*/ + +} + + +++/* The following must be the next "function" after Lfuncal, for the +++sake of Levalf. */ +++fchack () {} +++ +++#undef protect +++ + +/* protect **************************************************************/ + +/* pushes the first argument onto namestack, thereby protecting from gc */ + +lispval + +protect(a) + +lispval a; + +{ - /* (np++)->val = a; - if (np >= nplim) - namerr(); - */ - asm(" movl 4(ap),(r6)+"); - asm(" cmpl r6,_nplim"); - asm(" jlss out1"); - asm(" calls $0,_namerr"); - asm("out1: ret"); - } +++ /* (np++)->val = a; +++ if (np >= nplim) +++ namerr(); +++ */ +++ asm(" movl 4(ap),(r6)+"); +++ asm(" cmpl r6,_nplim"); +++ asm(" jlss out1"); +++ asm(" calls $0,_namerr"); +++ asm("out1: ret"); +++ } + + + + + +/* unprot ****************************************************************/ - /* returns the top thing on the name stack. Underflow had better not */ - /* occur. */ +++/* returns the top thing on the name stack. Underflow had better not */ +++/* occur. */ + +lispval + +unprot() - { - asm(" movl -(r6),r0"); - } +++ { +++ asm(" movl -(r6),r0"); +++ } + + + +lispval + +linterp() - { - error("BYTE INTERPRETER CALLED ERRONEOUSLY",FALSE); - } +++ { +++ error("BYTE INTERPRETER CALLED ERRONEOUSLY",FALSE); +++ } + + + +/* Undeff - called from qfuncl when it detects a call to a undefined - function from compiled code, we print out a message and - dont allow continuation +++ function from compiled code, we print out a message and +++ dont allow continuation + +*/ + +lispval + +Undeff(atmn) + +lispval atmn; + +{ - printf("\n%s - ",atmn->pname); - error("Undefined function called from compiled code",FALSE); +++ return(errorh(Verundef,"Undefined function called from compiled code ", +++ nil,TRUE,0,atmn)); + +} + +bindfix(firstarg) + +lispval firstarg; + +{ - register lispval *argp = &firstarg; - register struct nament *mybnp = bnp; - while(*argp != nil) { - mybnp->atm = *argp++; - mybnp->val = mybnp->atm->clb; - mybnp->atm->clb = *argp++; - bnp = mybnp++; - } +++ register lispval *argp = &firstarg; +++ register struct nament *mybnp = bnp; +++ while(*argp != nil) { +++ mybnp->atm = *argp++; +++ mybnp->val = mybnp->atm->a.clb; +++ mybnp->atm->a.clb = *argp++; +++ bnp = mybnp++; +++ } + +} diff --cc usr/src/cmd/lisp/eval2.c index 0000000000,b0cc6e295e,0000000000..0952cf382c mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/eval2.c +++ b/usr/src/cmd/lisp/eval2.c @@@@ -1,0 -1,78 -1,0 +1,111 @@@@ +++static char *sccsid = "@(#)eval2.c 34.1 10/3/80"; +++ + +#include "global.h" +++ +++/* Iarray - handle array call. +++ * fun - array object +++ * args - arguments to the array call , most likely subscripts. +++ * evalp - flag, if TRUE then the arguments should be evaluated when they +++ * are stacked. +++ */ + +lispval - Iarray(fun,args) +++Iarray(fun,args,evalp) + +register lispval fun,args; + +{ + + register lispval reg, temp; + + register struct argent *lbot, *np; - snpand(2); + + + + lbot = np; - if(np + 3 > nplim) - namerr(); - np++->val = fun->accfun; - np++->val = args; - np++->val = fun; +++ protect(fun->ar.accfun); +++ for ( ; args != nil ; args = args->d.cdr) /* stack subscripts */ +++ if(evalp) protect(eval(args->d.car)); +++ else protect(args->d.car); +++ protect(fun); + + return(vtemp = Lfuncal()); - + +} - #define FINTF 1 - #define FDOUBF 2 - #define FORTSUB 0 + + + +lispval + +Ifcall(a) - register lispval a; +++lispval a; + +{ + + int *alloca(); + + register int *arglist; + + register int index; + + register struct argent *mynp; + + register lispval ltemp; + + register struct argent *lbot; + + register struct argent *np; +++ int itemp; + + int nargs = np - lbot; + + + + arglist = alloca((nargs + 1) * sizeof(int)); + + mynp = lbot; + + *arglist = nargs; + + for(index = 1; index <= nargs; index++) { - switch(TYPE(mynp->val)) { +++ switch(TYPE(ltemp=mynp->val)) { + + case INT: + + arglist[index] = sp(); + + stack(0); - *(int *) arglist[index] = mynp->val->i; +++ *(int *) arglist[index] = ltemp->i; + + break; + + case DOUB: + + stack(0); + + arglist[index] = sp(); + + stack(0); - *(double *) arglist[index] = mynp->val->r; +++ *(double *) arglist[index] = ltemp->r; +++ break; +++ case HUNK2: +++ case HUNK4: +++ case HUNK8: +++ case HUNK16: +++ case HUNK32: +++ case HUNK64: +++ case HUNK128: +++ case DTPR: +++ case ATOM: +++ case SDOT: +++ arglist[index] = (int) ltemp; + + break; +++ + + case ARRAY: - arglist[index] = (int) mynp->val->data; +++ arglist[index] = (int) ltemp->ar.data; +++ break; +++ +++ +++ case BCD: +++ arglist[index] = (int) ltemp->bcd.entry; +++ break; +++ +++ default: +++ error("foreign call: illegal argument ",FALSE); +++ break; + + } + + mynp++; + + } - switch(a->discipline->i) { - case FINTF: - ltemp = inewint(callg(a->entry,arglist)); +++ switch(((char *)a->bcd.discipline)[0]) { +++ case 'i': /* integer-function */ +++ ltemp = inewint(callg(a->bcd.entry,arglist)); + + break; + + - case FDOUBF: +++ case 'r': /* real-function*/ + + ltemp = newdoub(); - ltemp->r = (* ((double (*)()) callg))(a->entry,arglist); +++ ltemp->r = (* ((double (*)()) callg))(a->bcd.entry,arglist); +++ break; +++ +++ case 'f': /* function */ +++ ltemp = (lispval) callg(a->bcd.entry,arglist); + + break; + + + + default: - case FORTSUB: - callg(a->entry,arglist); +++ case 's': /* subroutine */ +++ callg(a->bcd.entry,arglist); + + ltemp = tatom; + + } +++ return(ltemp); + +} + +callg(funct,arglist) + +lispval (*funct)(); + +int *arglist; + +{ + + asm(" callg *8(ap),*4(ap)"); + +} diff --cc usr/src/cmd/lisp/evalf.c index 0000000000,0000000000,0000000000..d6c9d861e6 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/evalf.c @@@@ -1,0 -1,0 -1,0 +1,197 @@@@ +++static char *sccsid = "@(#)evalf.c 34.1 10/3/80"; +++ +++#include "global.h" +++#include "frame.h" +++/* evalframe off of the c stack. +++ We will set fp to point where the register fp points. +++ Then fp+2 = saved ap +++ fp+4 = saved pc +++ fp+3 = saved fp +++ ap+1 = first arg +++*/ +++ +++/* These will keep track of the current saved values of np and lbot +++as we decend the evalstack. These must be read by decoding the registers saved +++by each function call. */ +++struct argent *fakenp; +++struct argent *fakelbot; +++ +++lispval +++Levalf () +++{ +++ register struct frame *myfp; +++ struct frame *nextevf(); +++ register lispval handy, result; +++ int **fp; /* this must be the first local */ +++ int evaltype; +++ snpand(3); +++ if(lbot==np) { +++ protect (nil); +++ }; +++ chkarg(1,"evalf"); +++ fakenp = NULL; +++ fakelbot = NULL; +++ if (lbot->val == nil) { /* Arg of nil means start at the top */ +++ myfp = nextevf ((struct frame *) (&fp +1), &evaltype); +++ /* myfp now points to evalframe of call to evalframe */ +++ myfp = myfp->fp; /* and now to the one past evalframe */ +++ } else { +++ if( TYPE(lbot->val) != INT ) +++ /* Interesting artifact: A pdl pointer will be an INT, but if +++ read in, the Franz reader produces a bignum, thus giving some +++ protection from being hacked. */ +++ error("ARG TO EVALFRAME MUST BE INTEGER",TRUE); +++ myfp = (struct frame *) (lbot->val->i); +++ if (myfp < (struct frame *) (&fp +1)){ +++ /* if purported fp is less than current fp, a fraud +++ (since stack grows down, and current fp must be bottom) */ +++ error("ARG TO EVALFRAME NOT EVALFRAME POINTER", TRUE); +++ } +++ }; +++ myfp = nextevf(myfp, &evaltype); /* get pointer to frame above */ +++ if(myfp > myfp->fp) return(nil); /* end of frames */ +++ /* return ( ) */ +++ protect(result = newdot()); +++ /* See maclisp manual for difference between eval frames and apply +++ frames, or else see the code below. */ +++ result->d.car = matom (evaltype ? "eval" : "apply"); +++ result->d.cdr = (handy = newdot()); +++ handy->d.car = inewint(myfp->fp); /* The frame pointer as a lisp int */ +++ handy->d.cdr = newdot(); +++ handy = handy->d.cdr; +++ if (evaltype) +++ handy->d.car = myfp->ap[1]; /* eval type - simply the arg to eval */ +++ else { /* apply type ; must build argument list. The form will look like +++ ( ( ....)) +++ i.e. the function name followed by a list of evaluated args */ +++ lispval form, handy1, arglist; +++ struct argent *pntr; +++ /* name of function will either be arg to Lfuncal or on argstack */ +++ (form = newdot())->d.car = +++ (int)myfp->ap[0] & 1? myfp->ap[1] : (fakelbot-1)->val; +++ /* Assume that Lfuncal increments lbot after getting +++ function to call. */ +++ (form->d.cdr = newdot())->d.cdr = nil; +++ for (arglist = nil, pntr = fakenp; +++ pntr > fakelbot;) { +++ (handy1 = newdot())->d.cdr = arglist; +++ (arglist = handy1)->d.car = (--pntr)->val; +++ }; +++ form->d.cdr->d.car = arglist; +++ handy->d.car = form; +++ }; +++ handy->d.cdr = newdot(); +++ handy = handy->d.cdr; +++ /* Next is index into bindstack lisp pseudo-array, for maximum +++ usefulness */ +++ handy->d.car = inewint( ((struct nament *) *( ((long *)myfp->fp) -1)) +++ -orgbnp); /* first part gets oldbnp, if first local */ +++ handy->d.cdr = newdot(); +++ handy = handy->d.cdr; +++ +++ handy->d.car = inewint(fakenp-orgnp); /* index of np in namestack*/ +++ handy->d.cdr = newdot(); +++ handy = handy->d.cdr; +++ handy->d.car = inewint(fakelbot-orgnp); /* index of lbot in namestack*/ +++ return(result); +++} +++ +++#define LBOTNPMASK 03<<22 /* Octal 3 */ +++/* We assume that r6 and r7 are saved as pairs, and that no earlier +++registers are saved. If the Franz snpand hack is changed, this may +++have to change too. */ +++struct frame *nextevf (curfp, ftypep) +++struct frame *curfp; +++int *ftypep; +++{ +++ register struct frame *myfp; +++ lispval _qfuncl(),tynames(); /* locations in qfuncl */ +++ lispval fchack(); /*pseudo function after Lfuncal */ +++ for (myfp = curfp; myfp < myfp->fp; myfp = myfp->fp) { +++ /* Look up stack until find a frame with the right saved pc */ +++ if (myfp->mask & LBOTNPMASK) { +++ fakenp = (struct argent *)(myfp->r6); +++ fakelbot = (struct argent *)(myfp->r7); +++ }; +++ if (myfp->pc > eval && myfp->pc < popnames) { /* interpreted code */ +++ *ftypep = TRUE; +++ break; +++ } else +++/* if (myfp->pc > _qfuncl && myfp->pc < tynames) { /* compiled code *//* +++ *ftypep = FALSE; +++ break; +++ } else */ +++ if (myfp->pc > Lfuncal && myfp->pc < fchack) { /* call to funcall */ +++ *ftypep = FALSE; +++ break; +++ }; +++ }; +++ return(myfp); +++} +++ +++#include "catchfram.h" +++lispval +++Lfretn () +++{ +++ int **fp; /* this must be the first local */ +++ struct frame *myfp; +++ struct nament *mybnp; +++ extern long errp; +++ extern long exitlnk; +++ typedef struct catchfr *cp; +++ typedef struct savblock *savp; +++ cp curp; +++ savp cursavp; +++ chkarg(2,"freturn"); +++ if( TYPE(lbot->val) != INT ) +++ error("freturn: 1st arg not pdl pointer",FALSE); +++ myfp = (struct frame *) (lbot->val->i); +++ if (myfp < (struct frame *) (&fp +1)){ +++ /* if purported fp is less than current fp, a fraud +++ (since stack grows down, and current fp must be bottom) */ +++ error("freturn: 1st arg not current pdl pointer", FALSE); +++ }; +++ /* Unwind name stack. The oldbnp will be the first local variable of +++ the function we are returning from, so it will be immediately below this +++ stack frame (i.e. it was pushed right after the call). */ +++ mybnp = (struct nament *) *(((long *)myfp) - 1); +++ if (mybnp < orgbnp || mybnp > bnp) +++ error("freturn: problem with pdl pointer", FALSE); +++ popnames (mybnp); +++ /* Reset pointer to next catchframe in stack appropriately. */ +++ for (curp = (cp) errp ; curp != (cp) nil ; curp = curp->link){ +++ /* Debugging... +++ printf ("Considering catchframe at %d\n", curp); fflush(stdout); */ +++ if ((long *) myfp < (long *) curp) { +++ /* printf ("Won\n"); fflush(stdout); */ +++ break; +++ }; +++ }; +++ errp = (long)curp; +++ /* printf ("errp is now %d\n", errp);fflush(stdout); */ +++ /* Reset saveblock for setexit/reset appropriately. */ +++ for (cursavp = (savp)exitlnk; cursavp != (savp) NULL; +++ cursavp = cursavp->savlnk) { +++ /* printf("Considering saveblock at %d\n", cursavp); +++ fflush (stdout); */ +++ if ((savp) myfp > cursavp && +++ ((savp)myfp < cursavp->savlnk || cursavp->savlnk == 0)) { +++ /* printf("Won\n"); fflush(stdout); */ +++ resexit(cursavp); +++ break; +++ }; +++ }; +++ fsmash(myfp, (np-1)->val); /* Smash the fp register..(If myfp not valid fp, +++ real trouble follows) Will really return +++ from other guy (ha ha) */ +++} +++ +++fsmash(framep, retval) +++struct frame *framep; +++lispval retval; +++{ +++ asm(" movl 4(ap), fp"); +++ asm(" movl 8(ap), r0"); +++ asm(" ret"); +++} +++ diff --cc usr/src/cmd/lisp/fex1.c index 0000000000,dfdf9b57bf,0000000000..8ac1040482 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/fex1.c +++ b/usr/src/cmd/lisp/fex1.c @@@@ -1,0 -1,480 -1,0 +1,537 @@@@ +++static char *sccsid = "@(#)fex1.c 34.2 11/7/80"; +++ + +#include "global.h" + +/* Nprog ****************************************************************/ + +/* This first sets the local variables to nil while saving their old */ + +/* values on the name stack. Then, pointers to various things are */ + +/* saved as this function may be returned to by an "Ngo" or by a */ + +/* "Lreturn". At the end is the loop that cycles through the contents */ + +/* of the prog. */ + + + +lispval + +Nprog() { + + int saveme[SAVSIZE]; + + register struct nament *mybnp = bnp; + + register struct argent *savednp; + + register lispval where, temp; + + register struct argent *lbot, *np; + + struct argent *savedlbot; + + struct nament *savedbnp; + + struct nament *topbind; - int myerrp; extern int errp; +++ long myerrp; extern long errp; + + + + savednp = np; + + savedlbot = lbot; + + savedbnp = bnp; - temp = where = (lbot->val)->car; +++ temp = where = (lbot->val)->d.car; + + while (TYPE(temp) == DTPR) + + { - temp = where->car; +++ temp = where->d.car; + + if (TYPE(temp) == ATOM) + + { + + bnp->atm = temp; - bnp->val = (temp)->clb; - (temp)->clb = nil; - temp = where = where->cdr; +++ bnp->val = (temp)->a.clb; +++ (temp)->a.clb = nil; +++ temp = where = where->d.cdr; + + if(bnp++ > bnplim) + + binderr(); + + } + + else return(CNIL); + + } + + topbind = bnp; + + myerrp = errp; + + if (where != nil) return(CNIL); - temp = where = savedlbot->val->cdr; +++ temp = where = savedlbot->val->d.cdr; + + getexit(saveme); + + while (retval = setexit()) { + + errp = myerrp; + + switch (retval) { + + + + case BRRETN: resexit(saveme); + + popnames(savedbnp); + + lbot = savedlbot; + + return(contval); + + - case BRGOTO: where = (savedlbot->val)->cdr; - while ((TYPE(where) == DTPR) && (where->car != contval)) - where = where->cdr; - if (where->car == contval) { - resexit(saveme); +++ case BRGOTO: where = (savedlbot->val)->d.cdr; +++ while ((TYPE(where) == DTPR) && (where->d.car != contval)) +++ where = where->d.cdr; +++ if (where->d.car == contval) { +++ /* This seems wrong - M Marcus +++ resexit(saveme); */ + + popnames(topbind); + + lbot = savedlbot; + + break; + + } + + + + default: + + resexit(saveme); + + reset(retval); + + + + } + + } + + while (TYPE(where) == DTPR) + + { - temp = where->car; +++ temp = where->d.car; + + if((TYPE(temp))!=ATOM) eval(temp); - where = where->cdr; +++ where = where->d.cdr; + + } + + resexit(saveme); + + return((where == nil) ? nil : CNIL); + + } + + + +lispval globtag; + +/* + + Ncatch is now actually *catch , which has the form + + (*catch tag form) + + tag is evaluated and then the catch entry is set up. + + then form is evaluated + + finally the catch entry is removed. + + + + (catch form [tag]) is translated to (*catch 'tag form) + + by a macro. + + */ + +lispval + +Ncatch() + +{ + + struct argent *savednp,*savedlbot; + + register lispval where, tag, todo; + + register temp; + + register struct argent *lbot, *np; + + int type; + + + + + + where = lbot->val; + + if((TYPE(where))!=DTPR) return(nil); - todo = where->cdr->car; - tag = eval(where->car); - while(TYPE(tag)!=ATOM) - tag = error("Non symbolic tag in *catch.",TRUE); +++ todo = where->d.cdr->d.car; +++ tag = eval(where->d.car); +++ while((TYPE(tag)!=ATOM) && (TYPE(tag) != DTPR)) +++ tag = error("Bad type of tag in *catch.",TRUE); + + asm(" pushab On1"); + + asm(" pushr $0x2540"); - asm(" subl2 $40,sp"); /* THIS IS A CROCK .... +++ asm(" subl2 $44,sp"); /* THIS IS A CROCK .... + + saves current environment + + for (return) z.B. */ - asm(" movc3 $40,_setsav,(sp)"); +++ asm(" movc3 $44,_setsav,(sp)"); + + asm(" pushl _bnp"); + + asm(" pushl r10"); + + asm(" pushl $1"); + + asm(" pushl _errp"); + + asm(" movl sp,_errp"); + + where = (eval(todo)); + + asm(" movl (sp),_errp"); + + return(where); + + asm("On1:ret"); + +} + + + +/* (errset form [flag]) + + if present, flag determines if the error message will be printed + + if an error reaches the errset. + + if no error occurs, errset returns a list of one element, the + + value returned from form. + + if an error occurs, nil is usually returned although it could + + be non nil if err threw a non nil value + + */ + + + +lispval Nerrset() + +{ + + register lispval flag,where,todo; /* order important */ + + register lispval handy = Vlerall; /* to access this easily */ + + register struct argent *lbot, *np; + + where = lbot->val; + + + + if(TYPE(where) != DTPR) return(nil); /* no form */ + + - todo = where->car; /* form to eval */ - flag = where->cdr; - if(flag != nil) flag = eval(flag->car); /* tag to tell if er messg */ +++ todo = where->d.car; /* form to eval */ +++ flag = where->d.cdr; +++ if(flag != nil) flag = eval(flag->d.car); /* tag to tell if er messg */ + + else flag = tatom; /* if not present , assume t */ + + + + /* push on a catch frame */ + + + + asm(" pushab On2"); /* where to jump if error */ + + asm(" pushr $0x2540"); - asm(" subl2 $40,sp"); /* THIS IS A CROCK .... +++ asm(" subl2 $44,sp"); /* THIS IS A CROCK .... + + saves current environment + + for (return) z.B. */ - asm(" movc3 $40,_setsav,(sp)"); +++ asm(" movc3 $44,_setsav,(sp)"); + + asm(" pushl _bnp"); + + asm(" pushl r8"); /* tag , (ER%all) */ + + asm(" pushl r11"); /* flag */ + + asm(" pushl _errp"); /* link in */ + + asm(" movl sp,_errp"); /* " */ + + + + /* evaluate form, and if ok, listify */ + + + + handy = eval(todo); + + asm(" movl (sp),_errp"); /* unlink this frame */ + + protect(handy); /* may gc on nxt call */ - (flag = newdot()) ->car = handy; /* listify arg */ +++ (flag = newdot()) ->d.car = handy; /* listify arg */ + + + + return(flag); + + + + asm("On2: ret"); /* if error occured */ + + + +} + + + +/* this was changed from throw to *throw 21nov79 + + it really should be called Lthrow + +*/ + +Nthrow() + +{ + + register lispval todo, where; + + lispval globtag,contval; + + snpand(2); /* save register mask */ - chkarg(2); +++ switch(np-lbot) { +++ case 0: +++ protect(nil); +++ case 1: +++ protect(nil); +++ case 2: break; +++ default: +++ argerr("throw"); +++ } + + globtag = lbot->val; + + contval = (lbot+1)->val; + + Idothrow(globtag,contval); + + error("Uncaught throw",FALSE); + +} - #include "catchframe.h" +++#include "catchfram.h" + + + +Idothrow(tag,value) + +lispval tag,value; + +{ + + typedef struct catchfr *cp; + + register cp curp; /* must be first register */ - extern int errp; +++ extern long errp; + + extern lispval globtag; +++ int pass1,founduw; +++ lispval handy,handy2; +++ snpand(1); + + + + globtag = tag; +++ /* +++ printf("throw,value ");printr(tag,stdout); printf(" "); +++ printr(value,stdout); fflush(stdout); +++ */ +++ pass1 = TRUE; +++ ps2: +++ founduw = FALSE; +++ + + for (curp=(cp)errp ; curp != (cp) nil ; curp =curp->link) + + { - if(curp->labl == nil || curp->labl == tag) +++ /* printf(" lbl: ");printr(curp->labl,stdout);fflush(stdout); */ +++ if(curp->labl == Veruwpt) +++ { founduw = TRUE; +++ if(!pass1) goto foundit; +++ } +++ if(curp->labl == nil || curp->labl == tag) goto foundit; +++ if(TYPE(curp->labl) == DTPR) + + { +++ for( handy = curp->labl ; handy != nil ; handy = handy->d.cdr) +++ { +++ if(handy->d.car == tag) goto foundit; +++ } +++ } +++ } +++ return; +++ +++ foundit: /* restore context at catch */ +++ if(pass1 && founduw) +++ { pass1 = FALSE; +++ goto ps2; +++ } +++ if(founduw) /* remember the state */ +++ { protect(handy2 = newdot()); +++ handy2->d.car = Veruwpt; +++ handy = handy2->d.cdr = newdot(); +++ handy->d.car = tatom; /* t for throw */ +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = tag; +++ handy = handy->d.cdr = newdot(); +++ handy->d.car = value; +++ value = handy2; +++ /* printf("Ret uwp: ");printr(value,stdout);fflush(stdout);*/ +++ } +++ + + popnames(curp->svbnp); + + errp = (int) curp->link; +++ /* +++ * return value must go into r7 until after movc3 since +++ * a movc3 clobbers r0 +++ */ +++ asm(" movl 8(ap),r7"); /* return value */ + + asm(" addl3 $16,r11,sp"); + + /* account for current (return) */ - asm(" movc3 $40,(sp),_setsav"); - asm(" addl2 $40,sp"); +++ asm(" movc3 $44,(sp),_setsav"); +++ asm(" addl2 $44,sp"); + + asm(" popr $0x2540"); - asm(" movl 8(ap),r0"); +++ asm(" movl r7,r0"); + + asm(" rsb"); - } - } - - return; +++ + +} + + + + +++ + +/* Ngo ******************************************************************/ + +/* First argument only is checked - and must be an atom or evaluate */ + +/* to one. */ + +Ngo() + + { - contval = (lbot->val)->car; +++ contval = (lbot->val)->d.car; + + while (TYPE(contval) != ATOM) + + { + + contval = eval(contval); + + while (TYPE(contval) != ATOM) contval = error("GO ARG NOT ATOM",TRUE); + + } + + reset(BRGOTO); + + } + + + + + +/* Nreset ***************************************************************/ + +/* All arguments are ignored. This just returns-from-break to depth 0. */ + +Nreset() + + { + + contval = 0; + + reset(BRRETB); + + } + + + +/* Nresetio *************************************************************/ + + + +lispval + +Nresetio() { + + register FILE *p; + + + + for(p = &_iob[3]; p < _iob + _NFILE; p++) { + + if(p->_flag & (_IOWRT | _IOREAD)) fclose(p); + + } + + return(nil); + + + +} + + + + + +/* Nbreak ***************************************************************/ + +/* If first argument is not nil, this is evaluated and printed. Then */ + +/* error is called with the "breaking" message. */ + + + +lispval + +Nbreak() + +{ + + register lispval hold; register FILE *port; - port = okport(Vpoport->clb,stdout); +++ port = okport(Vpoport->a.clb,stdout); + + fprintf(port,"Breaking:"); + + - if ((hold = lbot->val) != nil && ((hold = hold->car) != nil)) +++ if ((hold = lbot->val) != nil && ((hold = hold->d.car) != nil)) + + { + + printr(hold,port); + + } + + putc('\n',port); + + dmpport(port); - return(error("",TRUE)); +++ return(errorh(Verbrk,"",nil,TRUE,0)); + +} + + + + + +/* Nexit ****************************************************************/ + +/* Just calls lispend with no message. */ + +Nexit() + + { + + lispend(""); + + } + + + + + +/* Nsys *****************************************************************/ + +/* Just calls lispend with no message. */ + + + +lispval + +Nsys() + + { + + lispend(""); + + } + + + + + + + + + +lispval + +Ndef() { + + register lispval arglist, body, name, form; + + snpand(4); + + + + form = lbot->val; - name = form->car; - body = form->cdr->car; - arglist = body->cdr->car; +++ name = form->d.car; +++ body = form->d.cdr->d.car; +++ arglist = body->d.cdr->d.car; + + if((TYPE(arglist))!=DTPR && arglist != nil) + + error("Warning: defining function with nonlist of args", + + TRUE); - name->fnbnd = body; +++ name->a.fnbnd = body; + + return(name); + +} + + + + + +lispval + +Nquote() + +{ + + snpand(0); - return((lbot->val)->car); +++ return((lbot->val)->d.car); + +} + + + + + +lispval + +Nsetq() + +{ register lispval handy, where, value; + + register int lefttype; + + register struct argent *lbot, *np; + + + + - for(where = lbot->val; where != nil; where = handy->cdr) { - handy = where -> cdr; +++ for(where = lbot->val; where != nil; where = handy->d.cdr) { +++ handy = where->d.cdr; + + if((TYPE(handy))!=DTPR) + + error("odd number of args to setq",FALSE); - if((lefttype=TYPE(where->car))==ATOM) { - if(where->car==nil) +++ if((lefttype=TYPE(where->d.car))==ATOM) { +++ if(where->d.car==nil) + + error("Attempt to set nil",FALSE); - where->car->clb = value = eval(handy->car); +++ where->d.car->a.clb = value = eval(handy->d.car); + + }else if(lefttype==VALUE) - where->car->l = value = eval(handy->car); +++ where->d.car->l = value = eval(handy->d.car); + + else error("CAN ONLY SETQ ATOMS OR VALUES",FALSE); + + } + + return(value); + +} + + + + + +lispval + +Ncond() + +{ + + register lispval where, last; + + snpand(2); + + + + where = lbot->val; + + last = nil; + + for(;;) { + + if ((TYPE(where))!=DTPR) + + break; - if ((TYPE(where->car))!=DTPR) +++ if ((TYPE(where->d.car))!=DTPR) + + break; - if ((last=eval((where->car)->car)) != nil) +++ if ((last=eval((where->d.car)->d.car)) != nil) + + break; - where = where->cdr; +++ where = where->d.cdr; + + } + + + + if ((TYPE(where)) != DTPR) + + return(nil); - where = (where->car)->cdr; +++ where = (where->d.car)->d.cdr; + + while ((TYPE(where))==DTPR) { - last = eval(where->car); - where = where->cdr; +++ last = eval(where->d.car); +++ where = where->d.cdr; + + } + + return(last); + +} + + + +lispval + +Nand() + +{ + + register lispval current, temp; + + snpand(2); + + + + current = lbot->val; + + temp = tatom; + + while (current != nil) - if ( (temp = current->car)!=nil && (temp = eval(temp))!=nil) - current = current->cdr; +++ if ( (temp = current->d.car)!=nil && (temp = eval(temp))!=nil) +++ current = current->d.cdr; + + else { + + current = nil; + + temp = nil; + + } + + return(temp); + +} + + + + + +lispval + +Nor() + +{ + + register lispval current, temp; + + snpand(2); + + + + current = lbot->val; + + temp = nil; + + while (current != nil) - if ( (temp = eval(current->car)) == nil) - current = current->cdr; +++ if ( (temp = eval(current->d.car)) == nil) +++ current = current->d.cdr; + + else + + break; + + return(temp); + +} + + + + + +lispval + +Nprocess() { + + int wflag , childsi , childso , childnum, child; + + register lispval current, temp; + + char * sharg; + + int handler; + + int itemp; + + FILE *bufs[2],*obufs[2]; + + + + wflag = 1; + + childsi = 0; + + childso = 1; + + current = lbot->val; + + if( (TYPE(current))!=DTPR ) + + return(nil); - temp = current->car; +++ temp = current->d.car; + + if( (TYPE(temp))!=ATOM ) + + return(nil); + + - sharg = temp -> pname; +++ sharg = temp->a.pname; + + - if( (current = current->cdr)!=nil && (TYPE((temp = current->car)))==ATOM ) { +++ if( (current = current->d.cdr)!=nil && (TYPE((temp = current->d.car)))==ATOM ) { + + + + if (temp == tatom) { + + wflag = 0; + + childsi = 0; + + } else if (temp != nil) { + + fpipe(bufs); + + wflag = 0; - temp->clb = (lispval)bufs[1]; +++ temp->a.clb = P(bufs[1]); + + childsi = fileno(bufs[0]); + + } + + - if( (current = current->cdr)!=nil && (TYPE((temp = current->car)))==ATOM ) { +++ if( (current = current->d.cdr)!=nil && (TYPE((temp = current->d.car)))==ATOM ) { + + + + if (temp != nil) { + + fpipe(obufs); - temp->clb = (lispval)obufs[0]; +++ temp->a.clb = P(obufs[0]); + + childso = fileno(obufs[1]); + + } + + } + + } + + handler = signal(2,1); + + if((child = fork()) == 0 ) { - if(wflag!=0 && handler!=1) +++ if(wflag!=0 && handler !=1) + + signal(2,0); + + else + + signal(2,1); + + if(childsi != 0) { + + close(0); + + dup(childsi); + + } + + if (childso !=1) { + + close(1); + + dup(childso); + + } + + execlp("csh", "csh", "-c",sharg,0); + + execlp("sh", "sh", "-c",sharg,0); + + exit(-1); /* if exec fails, signal problems*/ + + } + + + + if(childsi != 0) fclose(bufs[0]); + + if(childso != 1) fclose(obufs[1]); + + + + if(wflag && child!= -1) { + + int status=0; + + wait(&status); + + itemp = status >> 8; + + } else + + itemp = child; + + signal(2,handler); + + return(inewint(itemp)); + +} diff --cc usr/src/cmd/lisp/fex2.c index 0000000000,b4d0acd9fe,0000000000..8f89fd48bd mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/fex2.c +++ b/usr/src/cmd/lisp/fex2.c @@@@ -1,0 -1,257 -1,0 +1,274 @@@@ +++static char *sccsid = "@(#)fex2.c 34.1 10/3/80"; +++ + +#include "global.h" - #define NDOVARS 15 +++#define NDOVARS 30 + +#include + +/* + + * Ndo maclisp do function. + + */ + +lispval + +Ndo() + +{ + + register lispval current, where, handy; + + register struct nament *mybnp; + + register struct argent *lbot, *np; + + lispval atom, temp; + + lispval body, endtest, endform, varstuf, renewals[NDOVARS] ; + + struct argent *start, *last, *getem, *savedlbot; + + struct nament *savedbnp, *lastbnd; + + int count, index, saveme[SAVSIZE], virgin = 1; - int myerrp; extern int errp; +++ long myerrp; extern long errp; + + + + savedlbot = lbot; + + myerrp = errp; + + savedbnp = bnp; + + getexit(saveme); /* common nonlocal return */ + + if(retval = setexit()) { + + errp = myerrp; + + if(retval == BRRETN) { + + resexit(saveme); + + lbot = savedlbot; + + popnames(savedbnp); + + return((lispval) contval); + + } else { + + resexit(saveme); + + lbot = savedlbot; + + reset(retval); + + } + + } + + current = lbot->val; - varstuf = current->car; +++ varstuf = current->d.car; + + switch( TYPE(varstuf) ) { + + + + case ATOM: /* This is old style maclisp do; + + atom is var, cadr(current) = init; + + caddr(current) = repeat etc. */ + + atom = varstuf; + + if(varstuf==nil) goto newstyle; + + bnp->atm = atom; /* save current binding of atom */ - bnp++->val = atom->clb; +++ bnp++->val = atom->a.clb; + + if(bnp > bnplim) + + binderr(); - current = current->cdr; - atom->clb = eval(current->car); +++ current = current->d.cdr; +++ atom->a.clb = eval(current->d.car); + + /* Init var. */ - *renewals = (current = current->cdr)->car; +++ *renewals = (current = current->d.cdr)->d.car; + + /* get repeat form */ - endtest = (current = current->cdr)->car; - body = current->cdr; +++ endtest = (current = current->d.cdr)->d.car; +++ body = current->d.cdr; + + + + while(TRUE) { + + if(eval(endtest)!=nil) { + + resexit(saveme); + + popnames(savedbnp); + + return(nil); + + } + + doprog(body); - atom->clb = eval(*renewals); +++ atom->a.clb = eval(*renewals); + + } + + + + + + newstyle: + + case DTPR: /* New style maclisp do; atom is + + list of things of the form + + (var init repeat) */ + + count = 0; + + start = np; - for(where = varstuf; where != nil; where = where->cdr) { +++ for(where = varstuf; where != nil; where = where->d.cdr) { + + /* do inits and count do vars. */ + + /* requires "simultaneous" eval + + of all inits */ - handy = where->car->cdr; +++ handy = where->d.car->d.cdr; + + temp = nil; + + if(handy !=nil) - temp = eval(handy->car); +++ temp = eval(handy->d.car); + + protect(temp); + + count++; + + } + + if(count > NDOVARS) + + error("More than 15 do vars",FALSE); + + bnp += count; + + if(bnp >= bnplim) { + + bnp = savedbnp; + + namerr(); + + } + + last = np; + + where = varstuf; + + mybnp = savedbnp; + + getem = start; + + for(index = 0; index < count; index++) { + + - handy = where->car; +++ handy = where->d.car; + + /* get var name from group */ - atom = handy->car; +++ atom = handy->d.car; + + mybnp->atm = atom; - mybnp->val = atom->clb; +++ mybnp->val = atom->a.clb; + + /* Swap current binding of atom + + for init val pushed on stack */ + + - atom->clb = getem++->val; +++ atom->a.clb = getem++->val; + + /* As long as we are down here in the + + list, save repeat form */ - handy = handy->cdr->cdr; +++ handy = handy->d.cdr->d.cdr; + + if(handy==nil) + + handy = CNIL; /* be sure not to rebind later */ + + else - handy = handy->car; +++ handy = handy->d.car; + + renewals[index] = handy; + + + + /* more loop "increments" */ - where = where->cdr; +++ where = where->d.cdr; + + mybnp++; + + } + + /* Examine End test and End form */ - current = current->cdr; - handy = current->car; - body = current->cdr; +++ current = current->d.cdr; +++ handy = current->d.car; +++ body = current->d.cdr; + + if (handy == nil) { + + doprog(body); + + popnames(savedbnp); + + resexit(saveme); + + return(nil); + + } - endtest = handy->car; - endform = handy->cdr; +++ endtest = handy->d.car; +++ endform = handy->d.cdr; + + /* The following is the loop: */ + + loop: + + if(eval(endtest)!=nil) { - for(handy = nil; endform!=nil; endform = endform->cdr){ - handy = eval(endform->car); +++ for(handy = nil; endform!=nil; endform = endform->d.cdr){ +++ handy = eval(endform->d.car); + + } + + resexit(saveme); + + popnames(savedbnp); + + return(handy); + + } + + doprog(body); + + /* Simultaneously eval repeat forms */ + + for(index = 0; index < count; index++) { + + + + temp = renewals[index]; + + if (temp == nil || temp == CNIL) + + protect(temp); + + else + + protect(eval(temp)); + + } + + getem = (np = last); + + /* now simult. rebind all the atoms */ + + mybnp = savedbnp; + + for(index = 0; index < count; index++, getem++) { + + if( (getem)->val != CNIL ) /* if this atom has a repeat form */ - mybnp->atm->clb = (getem)->val; /* rebind */ +++ mybnp->atm->a.clb = (getem)->val; /* rebind */ + + mybnp++; + + } + + goto loop; + + } + +} + +doprog(body) + +register lispval body; + + { + + int saveme[SAVSIZE]; + + register lispval where, temp; + + /*register struct nament *savednp = np, *savedlbot = lbot;*/ - extern int errp; int myerrp = errp; +++ extern long errp; long myerrp = errp; + + struct nament *savedbnp = bnp; - snpand(2); +++ snpand(3); + + + + where = body; + + getexit(saveme); + + if(retval = setexit()) { + + errp = myerrp; + + switch (retval) { + + + + default: resexit(saveme); + + reset(retval); + + + + case BRGOTO: + + for(where = body; - where->car != (lispval) contval; where = where->cdr) { +++ where->d.car != (lispval) contval; where = where->d.cdr) { + + + + if(where==nil) { + + resexit(saveme); + + reset(retval); + + } + + /* np is automatically restored here by + + virtue of being a register */ + + } + + popnames(savedbnp); + + } + + } + + while (TYPE(where) == DTPR) { - temp = where->car; +++ temp = where->d.car; + + if((TYPE(temp))!=ATOM) eval(temp); - where = where->cdr; +++ where = where->d.cdr; + + } + + resexit(saveme); + +} + +lispval + +Nprogv() + +{ - register lispval argptr, where, handy, atoms; - register struct argent *lbot, *np; - struct argent *namptr, *start; +++ register lispval where, handy; +++ register struct nament *namptr; +++ register struct argent *vars, *lbot, *np; +++ struct argent *start; + + struct nament *oldbnp = bnp; + + + + where = lbot->val; - protect(eval(where->car)); /* list of vars */ - atoms = lbot[1].val; - protect(eval((where = where->cdr)->car)); +++ protect(eval(where->d.car)); /* list of vars = lbot[1].val */ +++ protect(eval((where = where->d.cdr)->d.car)); + + /* list of vals */ + + handy = lbot[2].val; - start = np; - for(;handy!=nil; handy = handy->cdr) { - (np++)->val = eval(handy->car); +++ start = np; namptr = oldbnp; +++ /* simultaneous eval of all +++ args */ +++ for(;handy!=nil; handy = handy->d.cdr) { +++ (np++)->val = eval(handy->d.car); + + TNP; + + } - rebind(atoms,start); +++ asm("# Here is where rebinding is done"); +++ for(handy=lbot[1].val,vars=lbot+3; handy!=nil; handy=handy->d.cdr) { +++ namptr->atm = handy->d.car; +++ ++namptr; /* protect against interrupts +++ while re-lambda binding */ +++ bnp = namptr; +++ namptr[-1].atm = handy->d.car; +++ namptr[-1].val = handy->d.car->a.clb; +++ if(vars < np) +++ handy->d.car->a.clb = vars++->val; +++ else +++ handy->d.car->a.clb = nil; +++ } +++ + + handy = nil; - for(where = where->cdr; where != nil; where = where->cdr) - handy = eval(where->car); +++ for(where = where->d.cdr; where != nil; where = where->d.cdr) +++ handy = eval(where->d.car); + + popnames(oldbnp); + + return(handy); + +} + + + +lispval + +Nprogn() + +{ + + register lispval result, where; + + snpand(2); + + + + result = nil; - for(where = lbot->val; where != nil; where = where->cdr) - result = eval(where->car); +++ for(where = lbot->val; where != nil; where = where->d.cdr) +++ result = eval(where->d.car); + + return(result); + + + + + +} + +lispval + +Nprog2() + +{ + + register lispval result, where; + + snpand(2); + + + + where = lbot->val; - eval(where->car); - result = eval((where = where->cdr)->car); +++ eval(where->d.car); +++ result = eval((where = where->d.cdr)->d.car); + + protect(result); - for(where = where->cdr; where != nil; where = where->cdr) - eval(where->car); +++ for(where = where->d.cdr; where != nil; where = where->d.cdr) +++ eval(where->d.car); + + return(result); + +} diff --cc usr/src/cmd/lisp/fex3.c index 0000000000,d620883204,0000000000..b01f7b33fa mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/fex3.c +++ b/usr/src/cmd/lisp/fex3.c @@@@ -1,0 -1,127 -1,0 +1,254 @@@@ +++static char *sccsid = "@(#)fex3.c 34.2 10/13/80"; +++ + +#include "global.h" +++#include + + + +/* chkarg ***************************************************************/ + +/* This insures that there are at least expnum arguments passed to the */ + +/* BCD function that calls this. If there are fewer, nil arguments */ + +/* are pushed onto the name stack and np adjusted accordingly. */ - chkarg(expnum) +++#ifdef chkarg +++#undef chkarg +++#endif +++chkarg(expnum,string) + +int expnum; /* expected number of args */ +++char string[]; + +{ + + register struct argent *work; + + register r10,r9,r8; + + register struct argent *lbot, *np; + + saveonly(1); + + + + for(work = np,np = lbot + expnum; work < np; ) + + work++->val = nil; - + +} + + + + + +/* + + *Ndumplisp -- create executable version of current state of this lisp. + + */ - #include +++#include "a.out.h" + + + +asm(" .globl Dlast") + +lispval + +Ndumplisp() + +{ + + register struct exec *workp; + + register lispval argptr, temp; + + register char *fname; + + extern lispval reborn; + + struct exec work, old; + + extern etext; - extern int dmpmode; +++ extern int dmpmode,holend,curhbeg,usehole; +++ extern int end; + + int descrip, des2, count, ax,mode; + + char tbuf[BUFSIZ]; + + snpand(4); + + +++ +++#ifndef UNIXTS +++ vadvise(VA_ANOM); +++#endif +++ + + /* dump mode is kept in decimal (which looks like octal in dmpmode) + + and is changeable via (sstatus dumpmode n) where n is 413 or 410 + + base 10 + + */ + + if(dmpmode == 413) mode = 0413; + + else mode = 0410; + + + + workp = &work; + + workp->a_magic = mode; - workp->a_text = ((((unsigned) (&etext)) - 1) & (~PAGRND)) + PAGSIZ; +++ if(usehole) +++ workp->a_text = curhbeg & (~PAGRND); +++ else +++ workp->a_text = ((((unsigned) (&holend)) - 1) & (~PAGRND)) + PAGSIZ; +++#ifndef VMS + + workp->a_data = (unsigned) sbrk(0) - workp->a_text; +++#else +++ workp->a_data = ((int)&end) - workp->a_text; +++#endif + + workp->a_bss = 0; + + workp->a_syms = 0; + + workp->a_entry = (unsigned) gstart(); + + workp->a_trsize = 0; + + workp->a_drsize = 0; + + + + fname = "savedlisp"; /*set defaults*/ + + reborn = CNIL; + + argptr = lbot->val; + + if (argptr != nil) { - temp = argptr->car; +++ temp = argptr->d.car; + + if((TYPE(temp))==ATOM) - fname = temp->pname; +++ fname = temp->a.pname; + + } + + des2 = open(gstab(),0); + + if(des2 >= 0) { + + if(read(des2,&old,sizeof(old))>=0) + + work.a_syms = old.a_syms; + + } + + descrip=creat(fname,0777); /*doit!*/ + + if(-1==write(descrip,workp,sizeof(work))) + + { + + close(descrip); + + error("Dumplisp failed",FALSE); + + } + + if(mode == 0413) lseek(descrip,PAGSIZ,0); + + if( -1==write(descrip,0,workp->a_text) || + + -1==write(descrip,workp->a_text,workp->a_data) ) { + + close(descrip); + + error("Dumplisp failed",FALSE); + + } + + if(des2>0 && work.a_syms) { + + count = old.a_text + old.a_data + sizeof(old); + + if(-1==lseek(des2,count,0)) + + error("Could not seek to stab",FALSE); + + asm("Dlast:"); + + for(count = old.a_syms;count > 0; count -=BUFSIZ) { + + ax = read(des2,tbuf,BUFSIZ); + + if(ax==0) { + + printf("Unexpected end of syms",count); + + fflush(stdout); + + break; + + } + + if(ax > 0) + + write(descrip,tbuf,ax); + + else + + error("Failure to write dumplisp stab",FALSE); + + } + + } + + close(descrip); + + if(des2>0) close(des2); + + reborn = 0; +++ +++#ifndef UNIXTS +++ vadvise(VA_NORM); +++#endif +++ return(nil); +++} +++ +++lispval +++Nndumplisp() +++{ +++ register struct exec *workp; +++ register lispval argptr, temp; +++ register char *fname; +++ extern lispval reborn; +++ struct exec work, old; +++ extern etext; +++ extern int dmpmode,holend,curhbeg,usehole; +++ int descrip, des2, count, ax,mode; +++ char tbuf[BUFSIZ]; +++ snpand(4); +++ +++ +++#ifndef UNIXTS +++ vadvise(VA_ANOM); +++#endif +++ +++ /* dump mode is kept in decimal (which looks like octal in dmpmode) +++ and is changeable via (sstatus dumpmode n) where n is 413 or 410 +++ base 10 +++ */ +++ if(dmpmode == 413) mode = 0413; +++ else mode = 0410; +++ +++ workp = &work; +++ workp->a_magic = mode; +++ if(usehole) +++ workp->a_text = curhbeg & (~PAGRND); +++ else +++ workp->a_text = ((((unsigned) (&holend)) - 1) & (~PAGRND)) + PAGSIZ; +++ workp->a_data = (unsigned) sbrk(0) - workp->a_text; +++ workp->a_bss = 0; +++ workp->a_syms = 0; +++ workp->a_entry = (unsigned) gstart(); +++ workp->a_trsize = 0; +++ workp->a_drsize = 0; +++ +++ fname = "savedlisp"; /*set defaults*/ +++ reborn = CNIL; +++ argptr = lbot->val; +++ if (argptr != nil) { +++ temp = argptr->d.car; +++ if((TYPE(temp))==ATOM) +++ fname = temp->a.pname; +++ } +++ des2 = open(gstab(),0); +++ if(des2 >= 0) { +++ if(read(des2,&old,sizeof(old))>=0) +++ work.a_syms = old.a_syms; +++ } +++ descrip=creat(fname,0777); /*doit!*/ +++ if(-1==write(descrip,workp,sizeof(work))) +++ { +++ close(descrip); +++ error("Dumplisp failed",FALSE); +++ } +++ if(mode == 0413) lseek(descrip,PAGSIZ,0); +++ if( -1==write(descrip,0,workp->a_text) || +++ -1==write(descrip,workp->a_text,workp->a_data) ) { +++ close(descrip); +++ error("Dumplisp failed",FALSE); +++ } +++ if(des2>0 && work.a_syms) { +++ count = old.a_text + old.a_data + (old.a_magic == 0413 ? PAGSIZ +++ : sizeof(old)); +++ if(-1==lseek(des2,count,0)) +++ error("Could not seek to stab",FALSE); +++ for(count = old.a_syms;count > 0; count -=BUFSIZ) { +++ ax = read(des2,tbuf,(count < BUFSIZ ? count : BUFSIZ)); +++ if(ax==0) { +++ printf("Unexpected end of syms",count); +++ fflush(stdout); +++ break; +++ } else if(ax > 0) +++ write(descrip,tbuf,ax); +++ else +++ error("Failure to write dumplisp stab",FALSE); +++ } +++ if(-1 == lseek(des2, +++ (old.a_magic == 0413 ? PAGSIZ : sizeof(old)) +++ + old.a_text + old.a_data +++ + old.a_trsize + old.a_drsize + old.a_syms, +++ 0)) +++ error(" Could not seek to string table ",FALSE); +++ for( ax = 1 ; ax > 0;) { +++ ax = read(des2,tbuf,BUFSIZ); +++ if(ax > 0) +++ write(descrip,tbuf,ax); +++ else if (ax < 0) +++ error("Error in string table read ",FALSE); +++ } +++ } +++ close(descrip); +++ if(des2>0) close(des2); +++ reborn = 0; +++ +++#ifndef UNIXTS +++ vadvise(VA_NORM); +++#endif + + return(nil); + +} + +lispval + +typred(typ,ptr) + +int typ; + +lispval ptr; + + + +{ int tx; + + if ((tx = TYPE(ptr)) == typ) return(tatom); + + if ((tx == INT) && (typ == ATOM)) return(tatom); + + return(nil); + +} + +lispval + +Nfunction() + +{ + + register lispval handy; + + + + snpand(1); - handy = lbot->val->car; - if(TYPE(handy)==ATOM && handy->fnbnd!=nil) - return(handy->fnbnd); +++ handy = lbot->val->d.car; +++ if(TYPE(handy)==ATOM && handy->a.fnbnd!=nil) +++ return(handy->a.fnbnd); + + else + + return(handy); + +} diff --cc usr/src/cmd/lisp/fex4.c index 0000000000,da0b941119,0000000000..fc3472c2e7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/fex4.c +++ b/usr/src/cmd/lisp/fex4.c @@@@ -1,0 -1,317 -1,0 +1,396 @@@@ +++static char *sccsid = "@(#)fex4.c 34.1 10/3/80"; +++ + +#include "global.h" + +#include "lfuncs.h" + +#include "chkrtab.h" + +#include + + +++/* this is now a lambda function instead of a nlambda. +++ the only reason that it wasn't a lambda to begin with is that +++ the person who wrote it didn't know how to write a lexpr +++ - jkf +++*/ + +lispval - Nsyscall() { - register lispval aptr, temp; +++Lsyscall() { +++ register lispval temp; +++ register struct argent *aptr; + + register int acount = 0; + + int args[50]; + + snpand(3); + + - aptr = lbot->val; - temp = eval(aptr->car); +++ /* there must be at least one argument */ +++ +++ if (np==lbot) { chkarg(1,"syscall"); } +++ +++ aptr = lbot; +++ temp = lbot->val; + + if (TYPE(temp) != INT) - return(error("syscall", FALSE)); +++ return(error("syscall: bad first argument ", FALSE)); + + args[acount++] = temp->i; - aptr = aptr->cdr; - while( aptr != nil && acount < 49) { - temp = eval(aptr->car); +++ while( ++aptr < np && acount < 49) { +++ temp = aptr->val; + + switch(TYPE(temp)) { + + + + case ATOM: + + args[acount++] = (int)temp->a.pname; + + break; + + +++ case STRNG: +++ args[acount++] = (int) temp; +++ break; +++ + + case INT: + + args[acount++] = (int)temp->i; + + break; + + + + default: - return(error("syscall", FALSE)); +++ return(error("syscall: arg not symbol, string or fixnum", FALSE)); + + } - aptr = aptr->cdr; + + } + + - if (acount==0) chkarg(2); /* produce arg count message */ + + temp = newint(); + + temp->i = vsyscall(args); + + return(temp); + +} + + + +/* eval-when: this has the form (eval-when ...) + + where the list may contain any combination of `eval', `load', `compile'. + + The interpreter (us) looks for the atom `eval', if it is present + + we treat the rest of the forms as a progn. + +*/ + + + +lispval + +Nevwhen() + +{ + + register lispval handy; + + snpand(1); + + - for(handy=(lbot->val)->car ; handy != nil ; handy = handy->cdr) - if (handy->car == (lispval) Veval) { lbot=np ; - protect(((lbot-1)->val)->cdr); +++ for(handy=(lbot->val)->d.car ; handy != nil ; handy = handy->d.cdr) +++ if (handy->d.car == (lispval) Veval) { lbot=np ; +++ protect(((lbot-1)->val)->d.cdr); + + return(Nprogn()); } ; + + + + + + return(nil); /* eval not seen */ + +} + + + + + +/* Status functions. + + * These operate on the statuslist stlist which has the form: + + * ( status_elem_1 status_elem_2 status_elem_3 ...) + + * where each status element has the form: + + * ( name readcode setcode . readvalue) + + * where + + * name - name of the status feature (the first arg to the status + + * function). + + * readcode - fixnum which tells status how to read the value of + + * this status name. The codes are #defined. + + * setcode - fixnum which tells sstatus how to set the value of + + * this status name + + * readvalue - the value of the status feature is usually stored + + * here. + + * + + * Readcodes: + + * + + * ST_READ - if no second arg, return readvalue. + + * if the second arg is given, we return t if it is eq to + + * the readvalue. + + * ST_FEATR - used in (status feature xxx) where we test for xxx being + + * in the status features list + + * ST_SYNT - used in (status syntax c) where we return c's syntax code + + * ST_INTB - read stattab entry + + * ST_NFETR - used in (status nofeature xxx) where we test for xxx not + + * being in the status features list + + * ST_DMPR - read the dumpmode +++ * ST_UNDEF - return the undefined functions in the transfer table + + * + + * Setcodes: + + * ST_NO - if not allowed to set this status through sstatus. + + * ST_SET - if the second arg is made the readvalue. + + * ST_FEATW - for (sstatus feature xxx), we add xxx to the + + * (status features) list. + + * ST_TOLC - if non nil, map upper case chars in atoms to lc. + + * ST_CORE - if non nil, have bus errors and segmentation violations + + * dump core, if nil have them produce a bad-mem err msg + + * ST_INTB - set stattab table entry + + * ST_NFETW - use in (sstatus nofeature xxx) where we wish to remove xxx + + * from the status feature list. + + * ST_DMPW - set the dumpmode +++ * ST_BCDTR - (ifdef RSET) if non nil, creat trace stack entries for +++ * calls from BCD functions to BCD functions + + */ - +++#include + + + +lispval + +Nstatus() + +{ + + register lispval handy,curitm,valarg; - int indx; +++ int indx,ctim; + + int typ; +++ char *cp; +++ char *ctime(); +++ struct tm *lctime,*localtime(); + + extern char *ctable; + + extern int dmpmode; +++ extern lispval chktt(); + + lispval Istsrch(); +++ snpand(3); + + + + if(lbot->val == nil) return(nil); + + handy = lbot->val; /* arg list */ + + + + while(TYPE(handy) != DTPR) handy = error("status: bad arg list",TRUE); + + - curitm = Istsrch(handy->car); /* look for feature */ +++ curitm = Istsrch(handy->d.car); /* look for feature */ + + + + if( curitm == nil ) return(nil); /* non existant */ + + - if( handy->cdr == nil ) valarg = (lispval) CNIL; - else valarg = handy->cdr->car; +++ if( handy->d.cdr == nil ) valarg = (lispval) CNIL; +++ else valarg = handy->d.cdr->d.car; + + + + /* now do the processing with curitm pointing to the requested + + item in the status list + + */ + + - switch( typ = curitm->cdr->car->i ) { /* look at readcode */ +++ switch( typ = curitm->d.cdr->d.car->i ) { /* look at readcode */ + + + + + + case ST_READ: - curitm = Istsrch(handy->car); /* look for name */ +++ curitm = Istsrch(handy->d.car); /* look for name */ + + if(curitm == nil) return(nil); + + if( valarg != (lispval) CNIL) + + error("status: Second arg not allowed.",FALSE); - else return(curitm->cdr->cdr->cdr); +++ else return(curitm->d.cdr->d.cdr->d.cdr); + + + + case ST_NFETR: /* look for feature present */ + + case ST_FEATR: /* look for feature */ + + curitm = Istsrch(matom("features")); + + if( valarg == (lispval) CNIL) + + error("status: need second arg",FALSE); + + - for( handy = curitm->cdr->cdr->cdr; +++ for( handy = curitm->d.cdr->d.cdr->d.cdr; + + handy != nil; - handy = handy->cdr) - if(handy->car == valarg) +++ handy = handy->d.cdr) +++ if(handy->d.car == valarg) + + return(typ == ST_FEATR ? tatom : nil); + + + + return(typ == ST_FEATR ? nil : tatom); + + - case ST_SYNT: /* want characcter syntax */ - handy = Vreadtable->clb; +++ case ST_SYNT: /* want character syntax */ +++ handy = Vreadtable->a.clb; + + chkrtab(handy); + + if( valarg == (lispval) CNIL) + + error("status: need second arg",FALSE); + + + + while (TYPE(valarg) != ATOM) + + valarg = error("status: second arg must be atom",TRUE); + + - indx = valarg->pname[0]; /* get first char */ +++ indx = valarg->a.pname[0]; /* get first char */ + + - if(valarg->pname[1] != '\0') +++ if(valarg->a.pname[1] != '\0') + + error("status: only one character atom allowed",FALSE); + + - (handy = newint())->i = ctable[indx] & 0377; +++ handy = inewint(ctable[indx] & 0377); + + return(handy); + + + + case ST_RINTB: - return(stattab[curitm->cdr->cdr->cdr->i]); +++ return(stattab[curitm->d.cdr->d.cdr->d.cdr->i]); + + + + case ST_DMPR: + + return(inewint(dmpmode)); + + +++ case ST_CTIM: +++ ctim = time(0); +++ cp = ctime(&ctim); +++ cp[24] = '\0'; +++ return(matom(cp)); +++ +++ case ST_LOCT: +++ ctim = time(0); +++ lctime = localtime(&ctim); +++ (handy = newdot())->d.car = inewint(lctime->tm_sec); +++ protect(handy); +++ handy->d.cdr = (valarg = newdot()); +++ valarg->d.car = inewint(lctime->tm_min); +++ valarg->d.cdr = (curitm = newdot()); +++ curitm->d.car = inewint(lctime->tm_hour); +++ curitm->d.cdr = (valarg = newdot()); +++ valarg->d.car = inewint(lctime->tm_mday); +++ valarg->d.cdr = (curitm = newdot()); +++ curitm->d.car = inewint(lctime->tm_mon); +++ curitm->d.cdr = (valarg = newdot()); +++ valarg->d.car = inewint(lctime->tm_year); +++ valarg->d.cdr = (curitm = newdot()); +++ curitm->d.car = inewint(lctime->tm_wday); +++ curitm->d.cdr = (valarg = newdot()); +++ valarg->d.car = inewint(lctime->tm_yday); +++ valarg->d.cdr = (curitm = newdot()); +++ valarg->d.car = inewint(lctime->tm_isdst); +++ return(handy); +++ +++ case ST_ISTTY: +++ return( (isatty(0) == TRUE ? tatom : nil)); +++ +++ case ST_UNDEF: +++ return(chktt()); + + } + +} + +lispval + +Nsstatus() + +{ + + register lispval handy; + + lispval Isstatus(); + + + + handy = lbot->val; + + - while( TYPE(handy) != DTPR || TYPE(handy->cdr) != DTPR) +++ while( TYPE(handy) != DTPR || TYPE(handy->d.cdr) != DTPR) + + handy = error("sstatus: Bad args",TRUE); + + - return(Isstatus(handy->car,handy->cdr->car)); +++ return(Isstatus(handy->d.car,handy->d.cdr->d.car)); + +} + + + +/* Isstatus - internal routine to do a set status. */ + +lispval + +Isstatus(curnam,curval) + +lispval curnam,curval; + +{ + + register lispval curitm,head; + + lispval Istsrch(),Iaddstat(); - int badmemr(); - extern int uctolc, dmpmode; +++ int badmemr(),clrtt(); +++ extern int uctolc, dmpmode, bcdtrsw; + + + + curitm = Istsrch(curnam); + + /* if doesnt exist, make one up */ + + + + if(curitm == nil) curitm = Iaddstat(curnam,ST_READ,ST_SET,nil); + + - switch (curitm->cdr->cdr->car->i) { +++ switch (curitm->d.cdr->d.cdr->d.car->i) { + + + + case ST_NO: error("sstatus: cannot set this status",FALSE); + + + + case ST_SET: goto setit; + + + + case ST_FEATW: curitm = Istsrch(matom("features")); - (curnam = newdot())->car = curval; - curnam->cdr = curitm->cdr->cdr->cdr; /* old val */ - curitm->cdr->cdr->cdr = curnam; +++ (curnam = newdot())->d.car = curval; +++ curnam->d.cdr = curitm->d.cdr->d.cdr->d.cdr; /* old val */ +++ curitm->d.cdr->d.cdr->d.cdr = curnam; + + return(curval); + + + + case ST_NFETW: /* remove from features list */ - curitm = Istsrch(matom("features"))->cdr->cdr; - for(head = curitm->cdr; head != nil; head = head->cdr) +++ curitm = Istsrch(matom("features"))->d.cdr->d.cdr; +++ for(head = curitm->d.cdr; head != nil; head = head->d.cdr) + + { - if(head->car == curval) curitm->cdr = head->cdr; +++ if(head->d.car == curval) curitm->d.cdr = head->d.cdr; + + else curitm = head; + + } + + return(nil); + + + + + + case ST_TOLC: if(curval == nil) uctolc = FALSE; + + else uctolc = TRUE; + + goto setit; + + + + case ST_CORE: if(curval == nil) + + { + + signal(SIGBUS,badmemr); /* catch bus errors */ + + signal(SIGSEGV,badmemr); /* and segmentation viols */ + + } + + else { + + signal(SIGBUS,SIG_DFL); /* let them core dump */ + + signal(SIGSEGV,SIG_DFL); + + } + + goto setit; + + + + case ST_INTB: - stattab[curitm->cdr->cdr->cdr->i] = curval; +++ stattab[curitm->d.cdr->d.cdr->d.cdr->i] = curval; + + return(curval); + + + + case ST_DMPW: + + if(TYPE(curval) != INT || + + (curval->i != 413 && + + curval->i != 410)) errorh(Vermisc,"sstatus: bad dump mode:", + + nil,FALSE,0,curval); + + dmpmode= curval->i; + + return(curval); +++ +++ case ST_AUTR: +++ if(curval != nil) Sautor = (lispval) TRUE; +++ else Sautor = FALSE; +++ goto setit; +++ +++ case ST_TRAN: +++ if(curval != nil) +++ { +++ Strans = (lispval) TRUE; +++ /* the atom `on' set to set up all table +++ * to their bcd fcn if possible +++ */ +++ if(curval == matom("on")) clrtt(1); +++ } +++ else { +++ Strans = (lispval) FALSE; +++ clrtt(0); /* clear all transfer tables */ +++ } +++ goto setit; +++ case ST_BCDTR: +++ if(curval == nil) bcdtrsw = FALSE; +++ else bcdtrsw = TRUE; +++ goto setit; + + } + + + + setit: /* store value in status list */ - curitm->cdr->cdr->cdr = curval; +++ curitm->d.cdr->d.cdr->d.cdr = curval; + + return(curval); + + + + + +} + + + +/* Istsrch - utility routine to search the status list for the + + name given as an argument. If such an entry is not found, + + we return nil + + */ + + + +lispval Istsrch(nam) + +lispval nam; + +{ + + register lispval handy; + + - for(handy = stlist ; handy != nil ; handy = handy->cdr) - if(handy->car->car == nam) return(handy->car); +++ for(handy = stlist ; handy != nil ; handy = handy->d.cdr) +++ if(handy->d.car->d.car == nam) return(handy->d.car); + + + + return(nil); + +} + + + +/* Iaddstat - add a status entry to the status list */ + +/* return new entry in status list */ + + + +lispval + +Iaddstat(name,readcode,setcode,valu) + +lispval name,valu; + +int readcode,setcode; + +{ + + register lispval handy,handy2; + + snpand(2); + + + + + + protect(handy=newdot()); /* build status list here */ + + - (handy2 = newdot())->car = name; +++ (handy2 = newdot())->d.car = name; + + - handy->car = handy2; +++ handy->d.car = handy2; + + - ((handy2->cdr = newdot())->car = newint())->i = readcode; +++ ((handy2->d.cdr = newdot())->d.car = newint())->i = readcode; + + - handy2 = handy2->cdr; +++ handy2 = handy2->d.cdr; + + - ((handy2->cdr = newdot())->car = newint())->i = setcode; +++ ((handy2->d.cdr = newdot())->d.car = newint())->i = setcode; + + - handy2->cdr->cdr = valu; +++ handy2->d.cdr->d.cdr = valu; + + + + /* link this one in */ + + - handy->cdr = stlist; +++ handy->d.cdr = stlist; + + stlist = handy; + + - return(handy->car); /* return new item in stlist */ +++ return(handy->d.car); /* return new item in stlist */ + +} diff --cc usr/src/cmd/lisp/fexr.c index 0000000000,6ab802c97f,0000000000..6b5c43c695 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/fexr.c +++ b/usr/src/cmd/lisp/fexr.c @@@@ -1,0 -1,96 -1,0 +1,98 @@@@ +++static char *sccsid = "@(#)fexr.c 34.1 10/3/80"; +++ + +#include "global.h" + + + +/* Ngcafter *************************************************************/ + +/* */ + +/* Default garbage collector routine which does nothing. */ + + + +lispval + +Ngcafter() + + { + + return(nil); + + } + + + +/* Nopval *************************************************************/ + +/* */ + +/* Routine which allows system registers and options to be examined */ + +/* and modified. Calls copval, the routine which is called by c code */ + +/* to do the same thing from inside the system. */ + + + +lispval + +Nopval() + + { + + lispval quant; + + snpand(0); + + + + if( TYPE(lbot->val) != DTPR ) + + return(error("BAD CALL TO OPVAL",TRUE)); - quant = eval(lbot->val->car); /* evaluate name of sys variable */ +++ quant = eval(lbot->val->d.car); /* evaluate name of sys variable */ + + while( TYPE(quant) != ATOM ) + + quant = error("FIRST ARG TO OPVAL MUST BE AN ATOM",TRUE); + + - if( (vtemp=lbot->val->cdr) != nil && TYPE(lbot->val->cdr) != DTPR ) +++ if( (vtemp=lbot->val->d.cdr) != nil && TYPE(lbot->val->d.cdr) != DTPR ) + + return(error("BAD ARG LIST FOR OPVAL",TRUE)); + + return(copval( + + quant, - vtemp==nil ? (lispval)CNIL : eval(vtemp->car) +++ vtemp==nil ? (lispval)CNIL : eval(vtemp->d.car) + + )); + + } + +/* copval *************************************************************/ + +/* This routine keeps track of system quantities, and is called from */ + +/* C code. If the second argument is CNIL, no change is made in the */ + +/* quantity. */ + +/* Since this routine may call newdot() if the second argument is not */ + +/* CNIL, the arguments should be protected somehow in that case. */ + + + +lispval + +copval(option,value) + + lispval option, value; + + { + + struct dtpr fake; + + lispval rval; + + snpand(0); + + + + - if( option->plist == nil && value != (lispval) CNIL) +++ if( option->a.plist == nil && value != (lispval) CNIL) + + { + + protect(option); protect(value); - option->plist = newdot(); - option->plist->car = sysa; - option->plist->cdr = newdot(); - option->plist->cdr->car = value; +++ option->a.plist = newdot(); +++ option->a.plist->d.car = sysa; +++ option->a.plist->d.cdr = newdot(); +++ option->a.plist->d.cdr->d.car = value; + + unprot(); unprot(); + + return(nil); + + } + + + + - if( option->plist == nil ) return(nil); +++ if( option->a.plist == nil ) return(nil); + + - fake.cdr = option->plist; +++ fake.cdr = option->a.plist; + + option = (lispval) (&fake); + + - while( option->cdr != nil ) /* can't be nil first time through */ +++ while( option->d.cdr != nil ) /* can't be nil first time through */ + + { - option = option->cdr; - if( option->car == sysa ) +++ option = option->d.cdr; +++ if( option->d.car == sysa ) + + { - rval = option->cdr->car; +++ rval = option->d.cdr->d.car; + + if( value != (lispval)CNIL ) - option->cdr->car = value; +++ option->d.cdr->d.car = value; + + return(rval); + + } - option = option->cdr; +++ option = option->d.cdr; + + } + + + + if( value != (lispval)CNIL ) + + { + + protect(option); protect(value); - option->cdr = newdot(); - option->cdr->car = sysa; - option->cdr->cdr = newdot(); - option->cdr->cdr->car = value; +++ option->d.cdr = newdot(); +++ option->d.cdr->d.car = sysa; +++ option->d.cdr->d.cdr = newdot(); +++ option->d.cdr->d.cdr->d.car = value; + + unprot(); unprot(); + + } + + + + + + return(nil); + + } diff --cc usr/src/cmd/lisp/ffasl.c index 0000000000,45a5c2985d,0000000000..59b005a3bc mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/ffasl.c +++ b/usr/src/cmd/lisp/ffasl.c @@@@ -1,0 -1,109 -1,0 +1,200 @@@@ +++static char *sccsid = "@(#)ffasl.c 34.3 10/23/80"; +++ + +#include "global.h" - #include +++#include +++#include +++#include +++#include "naout.h" + +#define round(x,s) ((((x)-1) & ~((s)-1)) + (s)) + + + +char *stabf = 0; + +int fvirgin = 1; +++static seed=0, mypid = 0; +++lispval verify(); +++ +++/* dispget - get discipline of function +++ * this is used to handle the tricky defaulting of the discipline +++ * field of such functions as cfasl and getaddress. +++ * dispget is given the value supplied by the caller, +++ * the error message to print if something goes wrong, +++ * the default to use if nil was supplied. +++ * the discipline can be an atom or string. If an atom it is supplied +++ * it must be lambda, nlambda or macro. Otherwise the atoms pname +++ * is used. +++ */ +++ +++lispval +++dispget(given,messg,defult) +++lispval given,defult; +++char *messg; +++{ +++ int typ; +++ +++ while(TRUE) +++ { +++ if(given == nil) +++ return(defult); +++ if((typ=TYPE(given)) == ATOM) +++ { if(given == lambda || +++ given == nlambda || +++ given == macro) return(given); +++ else return((lispval) given->a.pname); +++ } else if(typ == STRNG) return(given); +++ +++ given = errorh(Vermisc,messg,nil,TRUE,0,given); +++ } +++} + + + +lispval - Lffasl(){ +++Lcfasl(){ + + register struct argent *mlbot = lbot; + + register lispval work; - int fildes, totsize, readsize; +++ register int fildes, totsize; +++ int readsize; +++ register struct argent *lbot, *np; + + lispval csegment(); - char *sbrk(), *currend, *tfile, cbuf[512], *mytemp(), *gstab(); +++ char *sbrk(), *currend, *tfile, cbuf[6000], *mytemp(), *gstab(); +++ char ostabf[128]; + + struct exec header; - snpand(2); +++ char *largs; +++ snpand(4); + + - if(np - mlbot != 3 || TYPE(mlbot[1].val)!=ATOM) - mlbot[1].val = error("Incorrect .o file specification",TRUE); - if(np - mlbot != 3 || TYPE(mlbot[2].val)!=ATOM) - mlbot[2].val = error("Incorrect entry specification for fasl" - ,TRUE); - if(np - mlbot != 3 || TYPE(mlbot[3].val)!=ATOM || mlbot[3].val==nil) - mlbot[3].val = error( "Bad associated atom name for fasl",TRUE); +++ switch(np-lbot) { +++ case 3: protect(nil); /* no discipline given */ +++ case 4: protect(nil); /* no library given */ +++ } +++ chkarg(5,"cfasl"); +++ mlbot[0].val = verify(mlbot[0].val,"Incorrect .o file specification"); +++ mlbot[1].val = verify(mlbot[1].val,"Incorrect entry specification for cfasl"); +++ mlbot[3].val = dispget(mlbot[3].val,"Incorrect discipline specification for cfasl",Vsubrou->a.pname); +++ while(TYPE(mlbot[2].val)!= ATOM) +++ mlbot[2].val = errorh(Vermisc,"Bad associated atom name for fasl", +++ nil,TRUE,0,mlbot[2].val); +++ work = mlbot[4].val; +++ if(work==nil) +++ largs = 0; +++ else +++ largs = (char *) verify(work,"Bad loader flags"); + + + + /* + + * Invoke loader. + + */ +++ strcpy(ostabf,gstab()); + + currend = sbrk(0); + + tfile = mytemp(); + + sprintf(cbuf, - "nld -A %s -T %x -N %s -e %s -o %s", - gstab(), +++ "/usr/lib/lisp/nld -N -A %s -T %x %s -e %s -o %s %s -lc", +++ ostabf, + + currend, - mlbot[1].val->pname, - mlbot[2].val->pname, - tfile); +++ mlbot[0].val, +++ mlbot[1].val, +++ tfile, +++ largs); + + printf(cbuf); fflush(stdout); + + if(system(cbuf)!=0) { + + unlink(tfile); +++ ungstab(); +++ fprintf(stderr,"Ld returns error status\n"); + + return(nil); + + } +++ putchar('\n'); fflush(stdout); + + if(fvirgin) + + fvirgin = 0; + + else - unlink(stabf); +++ unlink(ostabf); + + stabf = tfile; - if((fildes = open(tfile,0))<0) +++ if((fildes = open(tfile,0))<0) { +++ fprintf(stderr,"Couldn't open temporary file: %s\n",tfile); + + return(nil); +++ } + + /* + + * Read a.out header to find out how much room to + + * allocate and attempt to do so. + + */ + + if(read(fildes,(char *)&header,sizeof(header)) <= 0) { + + close(fildes); + + return(nil); + + } - readsize = header.a_text + header.a_data; +++ readsize = round(header.a_text,4) + round(header.a_data,4); + + totsize = readsize + header.a_bss; + + totsize = round(totsize,512); + + /* + + * Fix up system indicators, typing info, etc. + + */ - currend = (char *)csegment(int_name,totsize/4); +++ currend = (char *)csegment(str_name,totsize,FALSE); + + + + if(readsize!=read(fildes,currend,readsize)) + + return(nil); + + work = newfunct(); - work->entry = (lispval (*)())header.a_entry; - work->discipline = lambda; - return(mlbot[3].val->fnbnd = work); +++ work->bcd.entry = (lispval (*)())header.a_entry; +++ work->bcd.discipline = mlbot[3].val; +++ return(mlbot[2].val->a.fnbnd = work); + +} - #include "types.h" - #include + +static char myname[100]; + +char * + +gstab() + +{ + + register char *cp, *cp2; char *getenv(); + + struct stat stbuf; + + extern char **Xargv; + + + + if(stabf==0) { + + cp = getenv("PATH"); + + if(cp==0) + + cp=":/usr/ucb:/bin:/usr/bin"; - if(*cp==':') { +++ if(*cp==':'||*Xargv[0]=='/') { + + cp++; + + if(stat(Xargv[0],&stbuf)==0) { + + strcpy(myname,Xargv[0]); + + return(stabf = myname); + + } + + } + + for(;*cp;) { + + + + /* copy over current directory + + and then append argv[0] */ + + + + for(cp2=myname;(*cp)!=0 && (*cp)!=':';) + + *cp2++ = *cp++; + + *cp2++ = '/'; + + strcpy(cp2,Xargv[0]); + + if(*cp) cp++; + + if(0!=stat(myname,&stbuf)) continue; + + return(stabf = myname); + + } + + error("Could not find which file is being executed.",FALSE); + + } else return (stabf); + +} +++ +++static char mybuff[40]; +++char * +++mytemp() +++{ +++ if(mypid==0) mypid = getpid(); +++ sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed++); +++ return(mybuff); +++} +++ungstab() +++{ +++ seed--; +++ sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed-1); +++ if(seed==0) { +++ stabf = 0; +++ fvirgin = 1; +++ } +++} +++lispval +++verify(in,error) +++register lispval in; +++char *error; +++{ +++ for(EVER) { +++ switch(TYPE(in)) { +++ case STRNG: +++ return(in); +++ case ATOM: +++ return((lispval)in->a.pname); +++ } +++ in = errorh(Vermisc,error,nil,TRUE,0,in); +++ } +++} diff --cc usr/src/cmd/lisp/filbuf.c index 0000000000,0000000000,0000000000..3cd0482ac9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/filbuf.c @@@@ -1,0 -1,0 -1,0 +1,41 @@@@ +++static char *sccsid = "@(#)filbuf.c 34.1 10/3/80"; +++ +++#include +++char *malloc(); +++ +++_filbuf(iop) +++register FILE *iop; +++{ +++ static char smallbuf[_NFILE]; +++ +++ if ((iop->_flag&_IOREAD) == 0) +++ return(EOF); +++ if (iop->_flag&_IOSTRG) +++ return(EOF); +++tryagain: +++ if (iop->_base==NULL) { +++ if (iop->_flag&_IONBF) { +++ iop->_base = &smallbuf[fileno(iop)]; +++ goto tryagain; +++ } +++ if ((iop->_base = malloc(BUFSIZ)) == NULL) { +++ iop->_flag |= _IONBF; +++ goto tryagain; +++ } +++ iop->_flag |= _IOMYBUF; +++ } +++ iop->_ptr = iop->_base; +++ if (iop == stdin && (stdout->_flag&_IOLBF)) +++ fflush(stdout); +++ iop->_cnt = read(fileno(iop), iop->_ptr, iop->_flag&_IONBF?1:BUFSIZ); +++ iop->_ptr = iop->_base; +++ if (--iop->_cnt < 0) { +++ if (iop->_cnt == -1) +++ iop->_flag |= _IOEOF; +++ else +++ iop->_flag |= _IOERR; +++ iop->_cnt = 0; +++ return(-1); +++ } +++ return(*iop->_ptr++&0377); +++} diff --cc usr/src/cmd/lisp/fixmask.c index 0000000000,837755883d,0000000000..54aaf697af mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/fixmask.c +++ b/usr/src/cmd/lisp/fixmask.c @@@@ -1,0 -1,24 -1,0 +1,26 @@@@ +++static char *sccsid = "@(#)fixmask.c 34.1 10/3/80"; +++ + +#include + +char mybuf[BUFSIZ]; + +extern unsigned short mask[]; + +main(){ + + register savesize = 0; char *cp; + + while(fgets(mybuf,BUFSIZ,stdin)!=NULL) { + + if(*mybuf=='#') { + + if(strcmpn(mybuf,"#save ",6)==0){ + + savesize = mybuf[6]-'0'; + + } else if (strcmpn(mybuf,"#protect ",9)==0){ + + savesize = '0'-1-mybuf[9]; + + } + + } - if(savesize && strcmpn(mybuf," .set .R",8)==0) { +++ if(savesize && strcmpn(mybuf," .set L",7)==0) { + + for(cp=mybuf;*cp++!=',';); + + sprintf(cp,"0x%X\n",mask[savesize + 10]); + + savesize = 0; + + } + + fputs(mybuf,stdout); + + } + +} + +unsigned short mask[] = { + + 0,0,0,0xfc0,0xfc0,0xfc0,0xec0,0xcc0,0x8c0,0x0c0,0, + + 0x800,0xc00,0xe00,0xf00,0xf80,0xfc0,0,0,0,0}; diff --cc usr/src/cmd/lisp/fpipe.c index 0000000000,05c8dd1c74,0000000000..1ee7f3507e mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/fpipe.c +++ b/usr/src/cmd/lisp/fpipe.c @@@@ -1,0 -1,32 -1,0 +1,98 @@@@ - #include +++static char *sccsid = "@(#)fpipe.c 34.2 10/18/80"; +++ +++#include "global.h" +++#include + +FILE *_dofpip(iodes) + +int iodes; + +{ + + register FILE *p; + + + + for(p=_iob; (p->_flag&(_IOWRT|_IOREAD))!=0; p++) + + if (p >= _iob+_NFILE) + + return(NULL); + + p->_file = iodes; + + p->_cnt = 0; + + p->_base = p->_ptr = NULL; + + return(p); + +} + + + +FILE * fpipe(info) + +FILE *info[2]; + +{ + + register FILE *p; + + int descrips[2]; + + + + if(0 > pipe(descrips)) return( (FILE *) -1); + + + + if(NULL==(p = _dofpip(descrips[0]))) return( (FILE *) -1); + + p->_flag = (_IONBF|_IOREAD); + + info[0] = p; + + + + if(NULL==(p = _dofpip(descrips[1]))) return( (FILE *) -1); + + p->_flag = _IOWRT; + + info[1] = p; + + return((FILE *) 2); /*indicate sucess*/ + +} +++#ifndef VMS +++/*C library -- write +++ nwritten = write(file, buffer, count); +++ nwritten == -1 means error +++*/ +++write(file, buffer, count) +++char *buffer; +++{ +++ register lispval handy; +++ int retval; +++ if((file != 1) || (Vcntlw->a.clb == nil)) goto top; +++ /* since ^w is non nil, we do not want to print to the terminal, +++ but we must be sure to return a correct value from the write +++ in case there is no write to ptport +++ */ +++ asm(" movl 12(ap),-4(fp) ") /* retval = count */ +++ goto skipit; +++ +++top: +++ +++asm(" .set write,4 "); +++asm(" chmk $write "); +++asm(" bcc noerror "); +++asm(" jmp cerror "); +++asm("noerror: "); +++asm(" movl r0,-4(fp)"); +++ +++skipit: +++ if(file==1) { +++ handy = Vptport->a.clb; +++ if(handy!=nil && TYPE(handy)==PORT && handy->p->_file!=1) { +++ fflush(handy->p); +++ file = handy->p->_file; +++ goto top; +++ } +++ } +++ return(retval); +++} +++ +++/* +++# C library -- read +++ +++# nread = read(file, buffer, count); +++# +++# nread ==0 means eof; nread == -1 means error +++*/ +++read(file,buffer,count) +++{ +++asm(" .set read,3 "); +++asm(" .set eintr,4 "); /* from /usr/include/errno.h */ +++again: +++asm(" chmk $read "); +++asm(" bcs error "); +++asm(" ret "); +++asm("error: "); +++asm(" cmpl r0,$eintr "); +++asm(" jeql intseen "); +++asm(" jmp cerror "); +++asm(" intseen: "); +++ if(sigintcnt > 0) sigcall(SIGINT); +++ goto again; +++} +++#endif diff --cc usr/src/cmd/lisp/h/catchfram.h index 0000000000,0000000000,0000000000..e3f18131a7 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/catchfram.h @@@@ -1,0 -1,0 -1,0 +1,16 @@@@ +++/* sccs id @(#)catchfram.h 34.1 10/3/80 */ +++ +++struct catchfr { /* catch and errset frame */ +++ struct catchfr *link; /* link to next catchframe */ +++ lispval flag; /* Do we print ? */ +++ lispval labl; /* label caught at this point */ +++ struct nament *svbnp; /* saved bnp */ +++ lispval retenv[11]; /* reset environment - actually a savblock */ +++ lispval rs[4]; /* regis 6-11 and 13 */ +++ lispval (*retadr)(); /* address to continue execution */ +++}; +++ +++struct savblock { +++ lispval envir[10]; +++ struct savblock *savlnk; +++}; diff --cc usr/src/cmd/lisp/h/chars.h index 0000000000,0000000000,0000000000..1faf18f47e new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/chars.h @@@@ -1,0 -1,0 -1,0 +1,43 @@@@ +++/* sccs id @(#)chars.h 34.1 10/3/80 */ +++ +++/* lexical table for input and output ***********************************/ +++/* the format of the entries are: ab..xxxx */ +++/* */ +++/* where a is set iff the atom containing the symbol must be quoted */ +++/* where b is set iff the character separates atoms normally */ +++/* where xxxx is a number unique to the class of symbol */ +++ +++#define VNUM 0000 +++#define VMINUS 0001 +++#define VSIGN 0001 +++#define VCHAR 0002 +++#define VSCA 0102 +++#define VLPARA 0303 +++#define VRPARA 0304 +++#define VPERD 0205 +++#define VLBRCK 0306 +++#define VRBRCK 0307 +++#define VEOF 0310 +++#define VSQ 0311 +++#define VDQ 0212 +++#define VSD 0211 +++#define VERR 0313 +++#define VSEP 0314 +++#define VSPL 0315 +++#define VMAC 0316 +++#define VESC 0217 +++#define VQUO 0326 +++ +++ +++#define QUTMASK 0200 +++#define SEPMASK 0100 +++ +++#define TSCA 1 +++#define TLPARA 2 +++#define TRPARA 3 +++#define TPERD 4 +++#define TEOF 5 +++#define TSPL 6 +++#define TMAC 7 +++#define TSQ 8 +++#define TLBKT 9 diff --cc usr/src/cmd/lisp/h/chkrtab.h index 0000000000,0000000000,0000000000..4047cf9bee new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/chkrtab.h @@@@ -1,0 -1,0 -1,0 +1,6 @@@@ +++/* sccs id @(#)chkrtab.h 34.1 10/3/80 */ +++ +++#define chkrtab(p); \ +++ if(p!=lastrtab){ if(TYPE(p)!=ARRAY && TYPE(p->ar.data)!=INT) rtaberr();\ +++ else { lastrtab = p; ctable = p->ar.data; } } +++extern lispval lastrtab; diff --cc usr/src/cmd/lisp/h/config.h index 0000000000,0000000000,0000000000..e81297789b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/config.h @@@@ -1,0 -1,0 -1,0 +1,34 @@@@ +++/* sccs id @(#)config.h 34.1 10/22/80 */ +++ +++/* +++ * this file contains parameters which each site is likely to modify +++ * to create (and describe) their own configuration. +++ * The following names will be stored in the (status features) list. +++ * +++ */ +++ +++#define OS "unix" +++#define MACHINE "vax" +++#define SITE "ucbvax" +++ +++ +++/* TTSIZ is the absolute limit, in pages, +++ * both text and data, of the +++ * size to which the lisp system may grow. +++ * If you change this, you must recompile +++ * alloc.c and data.c +++ */ +++#ifdef HOLE +++#define TTSIZE 10216 +++#else +++#define TTSIZE 6120 +++#endif +++ +++ +++#ifdef VMS +++#undef TTSIZE +++#define TTSIZE 10216 +++#define FREESIZE 512 * 10000 +++#endif +++ +++ diff --cc usr/src/cmd/lisp/h/dfuncs.h index 0000000000,0000000000,0000000000..62fe1bdd88 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/dfuncs.h @@@@ -1,0 -1,0 -1,0 +1,51 @@@@ +++/* sccs id @(#)dfuncs.h 34.1 10/3/80 */ +++ +++char *brk(); +++char *getsp(); +++char *inewstr(); +++char *mkmsg(); +++char *newstr(); +++char *rstore(); +++char *sbrk(); +++char *xsbrk(); +++char *ysbrk(); +++int csizeof(); +++int finterp(); +++lispval Iget(); +++lispval Imkrtab(); +++lispval Iputprop(); +++lispval Lfuncal(); +++lispval Lnegp(); +++lispval Lsub(); +++lispval alloc(); +++lispval copval(); +++lispval csegment(); +++lispval error(); +++lispval errorh(); +++lispval eval(); +++lispval gc(); +++lispval getatom(); +++lispval inewint(); +++lispval inewval(); +++lispval linterp(); +++lispval matom(); +++lispval mfun(); +++lispval mstr(); +++lispval newarray(); +++lispval newdot(); +++lispval newdoub(); +++lispval newfunct(); +++lispval newint(); +++lispval newsdot(); +++lispval newval(); +++lispval newhunk(); +++lispval popnames(); +++lispval r(); +++lispval ratomr(); +++lispval readr(); +++lispval readrx(); +++lispval readry(); +++lispval typred(); +++lispval unprot(); +++lispval verify(); +++struct atom * newatom(); diff --cc usr/src/cmd/lisp/h/frame.h index 0000000000,0000000000,0000000000..52a59013bf new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/frame.h @@@@ -1,0 -1,0 -1,0 +1,11 @@@@ +++/* sccs id @(#)frame.h 34.1 10/3/80 */ +++ +++struct frame { +++ lispval (*handler)(); +++ long mask; +++ lispval *ap; +++struct frame *fp; +++ lispval (*pc)(); +++ lispval *r6; +++ lispval *r7; +++}; diff --cc usr/src/cmd/lisp/h/global.h index 0000000000,0000000000,0000000000..f7a4f8f4ba new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/global.h @@@@ -1,0 -1,0 -1,0 +1,347 @@@@ +++/* sccs id @(#)global.h 34.4 10/22/80 */ +++ +++/**********************************************************************/ +++/* */ +++/* file: global.h */ +++/* contents: */ +++/* GLOBAL STUFF *******************************************************/ +++ +++#include +++#include +++#include "config.h" +++#ifdef UNIXTS +++#include "tsfix.h" +++#endif +++ +++#define AD 0 +++ +++#define peekc(p) (p->_cnt>0? *(p)->_ptr&0377:_filbuf(p)==-1?-1:((p)->_cnt++,*--(p)->_ptr&0377)) +++ +++#define FALSE 0 +++#define TRUE 1 +++#define EVER ;; +++#define CNIL ((lispval) -4) +++#define nil ((lispval) 0) +++#define eofa ((lispval) 20) +++#define NOTNIL(a) ((int)a) +++#define ISNIL(a) (!(int)a) +++#define STRBLEN 512 +++ +++ +++#define NULL_CHAR 0 +++#define LF '\n' +++#define WILDCHR '\0177' +++ +++ +++/* type flags and the macros to get them ********************************/ +++ +++#define UNBO -1 +++#define STRNG 0 +++#define ATOM 1 +++#define INT 2 +++#define DTPR 3 +++#define DOUB 4 +++#define BCD 5 +++#define PORT 6 +++#define ARRAY 7 +++#define SDOT 9 +++#define VALUE 10 +++ +++#define HUNK2 11 /* The hunks */ +++#define HUNK4 12 +++#define HUNK8 13 +++#define HUNK16 14 +++#define HUNK32 15 +++#define HUNK64 16 +++#define HUNK128 17 +++ +++/* the numbers per page of the different data objects *******************/ +++ +++#define NUMSPACES 16 +++ +++#define ATOMSPP 25 +++#define STRSPP NBPG +++#define INTSPP 128 +++#define DTPRSPP 64 +++#define DOUBSPP 64 +++#define ARRAYSPP 25 +++#define SDOTSPP 64 +++#define VALSPP 128 +++#define BCDSPP 64 +++ +++#define HUNK2SPP 64 /* hunk page sizes */ +++#define HUNK4SPP 32 +++#define HUNK8SPP 16 +++#define HUNK16SPP 8 +++#define HUNK32SPP 4 +++#define HUNK64SPP 2 +++#define HUNK128SPP 1 +++ +++extern char typetable[]; /* the table with types for each page */ +++ +++#define TYPL(a1) ((typetable+1)[(int)(a1) >> 9]) +++#define SETTYPE(a1,b) {if((itemp = ((int)a1) >> 9) >= TTSIZE) badmem();\ +++ (typetable + 1)[itemp] = (b); } +++ +++#define TYPE(a1) ((typetable+1)[(int)(a1) >> 9]) +++#define HUNKP(a1) ((TYPE(a1)+5) & 16) +++#define HUNKSIZE(a1) ((TYPE(a1)+5) & 15) +++ +++#define VALID(a) (a >= CNIL && a < datalim) +++ +++/* some types ***********************************************************/ +++#define lispint long +++#define MAX10LNG 200000000 /* max long divided by 10 */ +++ +++ +++typedef union lispobj *lispval ; +++ +++struct dtpr { +++ lispval cdr, car; +++}; +++ +++struct sdot { +++ int I; +++ lispval CDR; +++}; +++ +++ +++struct atom { +++ lispval clb; /* current level binding*/ +++ lispval plist; /* pointer to prop list */ +++#ifndef WILD +++ lispval fnbnd; /* function binding */ +++#endif +++ struct atom *hshlnk; /* hash link to next */ +++ char *pname; /* print name */ +++ }; +++#ifdef WILD +++#define fnbnd clb +++#endif +++ +++struct array { +++ lispval accfun, /* access function--may be anything */ +++ aux; /* slot for dimensions or auxilliary data */ +++ char *data; /* pointer to first byte of array */ +++ lispval length, delta; /* length in items and length of one item */ +++}; +++ +++struct bfun { +++ lispval (*entry)(); /* entry point to routine */ +++ lispval discipline, /* argument-passing discipline */ +++ language, /* language coded in */ +++ params, /* parameter list if relevant */ +++ loctab; /* local table */ +++}; +++ +++struct Hunk { +++ lispval hunk[1]; +++}; +++ +++union lispobj { +++ struct atom a; +++ FILE *p; +++ struct dtpr d; +++ long int i; +++ long int *j; +++ double r; +++ lispval (*f)(); +++ struct array ar; +++ struct sdot s; +++ char c; +++ lispval l; +++ struct bfun bcd; +++ struct Hunk h; +++}; +++ +++ +++#include "sigtab.h" /* table of all pointers to lisp data */ +++ +++/* Port definitions *****************************************************/ +++extern FILE *piport, /* standard input port */ +++ *poport, /* standard output port */ +++ *errport, /* port for error messages */ +++ *rdrport; /* temporary port for readr */ +++extern FILE *xports[]; /* page of file *'s for lisp */ +++extern int lineleng ; /* line length desired */ +++extern char rbktf; /* logical flag: ] mode */ +++extern char *ctable; /* Character table in current use */ +++#define Xdqc ctable[131] +++#define Xesc ctable[130] +++#define Xsdc ctable[129] +++ +++/* name stack ***********************************************************/ +++ +++#define NAMESIZE 3072 +++ +++/* the name stack limit is raised by NAMINC every namestack overflow to allow +++ a user function to handle the error +++*/ +++#define NAMINC 25 +++ +++extern struct nament { +++ lispval val, +++ atm; +++} *bnp, /* first free bind entry*/ +++ *bnplim; /* limit of bindstack */ +++ +++struct argent { +++ lispval val; +++}; +++extern struct argent *lbot, *np, *namptr; +++extern struct nament *bnp; /* first free bind entry*/ +++extern struct argent *nplim; /* don't have this = np */ +++extern struct argent *orgnp; /* used by top level to reset to start */ +++extern struct nament *orgbnp; /* used by top level to reset to start */ +++extern struct nament *bnplim; /* limit of bindstack */ +++extern struct argent *np, /* top entry on stack */ +++ *lbot, /* bottom of cur frame */ +++ *namptr; /* temporary pointer */ +++extern lispval sigacts[16]; +++extern lispval hunk_pages[7], hunk_items[7], hunk_name[7]; +++ +++#define TNP if(np >= nplim) namerr(); +++ +++#define TNP if(np >= nplim) namerr(); +++#define INRNP if (np++ >= nplim) namerr(); +++#define protect(p) (np++->val = (p)) +++#define chkarg(p,x); if((p)!=np-lbot) argerr(x); +++ +++ +++/** status codes **********************************************/ +++/* */ +++/* these define how status and sstatus should service probes */ +++/* into the lisp data base */ +++ +++/* common status codes */ +++#define ST_NO 0 +++ +++/* status codes */ +++#define ST_READ 1 +++#define ST_FEATR 2 +++#define ST_SYNT 3 +++#define ST_RINTB 4 +++#define ST_NFETR 5 +++#define ST_DMPR 6 +++#define ST_CTIM 7 +++#define ST_LOCT 8 +++#define ST_ISTTY 9 +++#define ST_UNDEF 10 +++ +++/* sstatus codes */ +++#define ST_SET 1 +++#define ST_FEATW 2 +++#define ST_TOLC 3 +++#define ST_CORE 4 +++#define ST_INTB 5 +++#define ST_NFETW 6 +++#define ST_DMPW 7 +++#define ST_AUTR 8 +++#define ST_TRAN 9 +++#define ST_BCDTR 10 +++ +++ +++/* number of counters for fasl to use in a profiling lisp */ +++#define NMCOUNT 5000 +++ +++/* hashing things *******************************************************/ +++#define HASHTOP 1024 /* we handle 8-bit characters by dropping top bit */ +++extern struct atom *hasht[HASHTOP]; +++extern int hash; /* set by ratom */ +++extern int atmlen; /* length of atom including final null */ +++ +++ +++/** exception handling ***********************************************/ +++extern int exception; /* if TRUE then an exception is pending, one of */ +++ /* the below */ +++extern int sigintcnt; /* if > 0 then there is a SIGINT pending */ +++ +++/* big string buffer for whomever needs it ******************************/ +++extern char strbuf[STRBLEN]; +++extern char *endstrb; +++ +++/* break and error declarations *****************************************/ +++#define SAVSIZE 44 /* number of bytes saved by setexit */ +++#define BRRETB 1 +++#define BRCONT 2 +++#define BRGOTO 3 +++#define BRRETN 4 +++#define INTERRUPT 5 +++#define THROW 6 +++extern int depth; /* depth of nested breaks */ +++extern lispval contval; /* the value being returned up */ +++extern int retval; /* used by each error/prog call */ +++extern int rsetsw; /* used by *rset mode */ +++ +++ +++/* other stuff **********************************************************/ +++extern lispval ftemp,vtemp,argptr,ttemp; /* temporaries: use briefly */ +++extern int itemp; +++ /* for pointer type conversion */ +++#include "dfuncs.h" +++ +++#define NUMBERP 2 +++#define BCDP 5 +++#define PORTP 6 +++#define ARRAYP 7 +++ +++#define ABSVAL 0 +++#define MINUS 1 +++#define ADD1 2 +++#define SUB1 3 +++#define NOT 4 +++#define LNILL 5 +++#define ZEROP 6 +++#define ONEP 7 +++#define PLUS 8 +++#define TIMES 9 +++#define DIFFERENCE 10 +++#define QUOTIENT 11 +++#define MOD 12 +++#define LESSP 13 +++#define GREATERP 14 +++#define SUM 15 +++#define PRODUCT 16 +++#define AND 17 +++#define OR 18 +++#define XOR 19 +++ +++interpt(); +++handler(); extern sigdelay, sigstruck; +++ +++/* limit of valid data area **************************************/ +++ +++extern lispval datalim; +++ +++/** macros to push and pop the value of an atom on the stack ******/ +++ +++#define PUSHDOWN(atom,value)\ +++ {bnp->atm=(atom);bnp++->val=(atom)->a.clb;(atom)->a.clb=value;\ +++ if(bnp>bnplim) binderr();} +++ +++#define POP\ +++ {--bnp;bnp->atm->a.clb=bnp->val;} +++ +++/** macro for evaluating atoms in eval and interpreter ***********/ +++ +++#define EVALATOM(x) vtemp = x->a.clb;\ +++ if( vtemp == CNIL ) {\ +++ printf("%s: ",(x)->a.pname);\ +++ vtemp = error("UNBOUND VARIABLE",TRUE);} +++ +++/* having to do with small integers */ +++ +++#define SMALL(i) ((lispval)(1024 + (i<<2))) +++#define P(p) ((lispval) (xports +((p)-_iob))) +++#define PN(p) ((int) ((p)-_iob)) +++#define okport(arg,default) (vtemp = arg,((TYPE((vtemp))!=PORT)?default:(vtemp)->p)) +++ +++extern lispval ioname[]; /* names of open files */ +++/* interpreter globals */ +++ +++extern int lctrace; +++ +++/* register lisp macros for registers */ +++ +++#define saveonly(n) asm("#save n") +++#define snpand(n) asm("#protect n") diff --cc usr/src/cmd/lisp/h/gtabs.h index 0000000000,0000000000,0000000000..10486b7743 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/gtabs.h @@@@ -1,0 -1,0 -1,0 +1,8 @@@@ +++/* sccs id @(#)gtabs.h 34.1 10/3/80 */ +++ +++/* these are the tables of global lispvals known to the interpreter */ +++/* and compiler. They are not used by the garbage collector. */ +++#define GFTABLEN 200 +++#define GCTABLEN 8 +++extern lispval gftab[GFTABLEN]; +++extern lispval gctab[GCTABLEN]; diff --cc usr/src/cmd/lisp/h/lfuncs.h index 0000000000,0000000000,0000000000..fefc55bce0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/lfuncs.h @@@@ -1,0 -1,0 -1,0 +1,250 @@@@ +++/* sccs id @(#)lfuncs.h 34.4 10/31/80 */ +++ +++Lcont(); +++Lexit(); +++Lreturn(); +++Ngo(); +++Nreset(); +++Nthrow(); +++Ntpl(); +++ +++lispval Lalfalp(); +++lispval Lfseek(); +++lispval LDivide(); +++lispval LEmuldiv(); +++lispval LMakhunk(); +++lispval LstarMod(); +++lispval Lstarrpx(); +++lispval Labsval(); +++lispval Lacos(); +++lispval Ladd(); +++lispval Ladd1(); +++lispval Lalloc(); +++lispval Lapply(); +++lispval Larg(); +++lispval Largv(); +++lispval Larrayp(); +++lispval Larrayref(); +++lispval Lascii(); +++lispval Lasin(); +++lispval Lassq(); +++lispval Latan(); +++lispval Latom(); +++lispval Lbaktrace(); +++lispval Lbcdad(); +++lispval Lbcdp(); +++lispval Lbind(); +++lispval Lboole(); +++lispval Lboundp(); +++lispval Lc02r(); +++lispval Lc03r(); /* cdddr */ +++lispval Lc04r(); /* cddddr */ +++lispval Lc12r(); /* caddr */ +++lispval Lc13r(); /* cadddr */ +++lispval Lc14r(); /* caddddr */ +++lispval Lcaar(); +++lispval Lcadr(); +++lispval Lcar(); +++lispval Lcdr(); +++lispval Lcfasl(); +++lispval Lchdir(); +++lispval Lclose(); +++lispval Lconcat(); +++lispval Lcons(); +++lispval Lcopyint(); /* actually copyint* */ +++lispval Lcos(); +++lispval Lcprintf(); +++lispval Lcpy1(); +++lispval Lctcherr(); /* function def of ER%unwind-protect */ +++lispval Lcxr(); +++lispval Ldiff(); +++lispval Ldrain(); +++lispval Ldtpr(); +++lispval Leq(); +++lispval Lequal(); +++lispval Lerr(); +++lispval Leval(); +++lispval Leval1(); +++lispval Levalf(); +++lispval Levalhook(); +++lispval Lexece(); +++lispval Lexp(); +++lispval Lexplda(); +++lispval Lexpldc(); +++lispval Lexpldn(); +++lispval Lfact(); +++lispval Lfake(); +++lispval Lfasl(); +++lispval Lfileopen(); +++lispval Lfix(); +++lispval Lflatsi(); +++lispval Lfloat(); +++lispval Lforget(); +++lispval Lfuncal(); +++lispval Lgcstat(); +++lispval Lgetaddress(); +++lispval Lfretn(); +++lispval Lgensym(); +++lispval Lget(); +++lispval Lgeta(); +++lispval Lgetaux(); +++lispval Lgetd(); +++lispval Lgetdata(); +++lispval Lgetdel(); +++lispval Lgetdim(); +++lispval Lgetdisc(); +++lispval Lgetentry(); +++lispval Lgetenv(); +++lispval Lgetl(); +++lispval Lgetlang(); +++lispval Lgetloc(); +++lispval Lgetparams(); +++lispval Lgreaterp(); +++lispval Lhaipar(); +++lispval Lhashst(); +++lispval Lhau(); +++lispval Lhunkp(); +++lispval Lhunksize(); +++lispval Limplode(); +++lispval Linfile(); +++lispval Lintern(); +++lispval Lkilcopy(); +++lispval Llctrace(); +++lispval Llessp(); +++lispval Llist(); +++lispval Lload(); +++lispval Llog(); +++lispval Llsh(); +++lispval Lmakertbl(); +++lispval Lmaknam(); +++lispval Lmaknum(); +++lispval Lmakunb(); +++lispval Lmap(); +++lispval Lmapc(); +++lispval Lmapcan(); +++lispval Lmapcar(); +++lispval Lmapcon(); +++lispval Lmaplist(); +++lispval Lmarray(); +++lispval Lmfunction(); +++lispval Lminus(); +++lispval Lmod(); +++lispval Lmonitor(); +++lispval Lncons(); +++lispval Lnegp(); +++lispval Lnfasl(); +++lispval Lnthelem(); +++lispval Lnull(); +++lispval Lnumberp(); +++lispval Lnwritn(); +++lispval Loblist(); +++lispval Lod(); +++lispval Lonep(); +++lispval Lopval(); +++lispval Loutfile(); +++lispval Lpatom(); +++lispval Lplist(); +++lispval Lpname(); +++lispval Lpntlen(); +++lispval Lpolyev(); +++lispval Lportp(); +++lispval Lprint(); +++lispval Lprname(); +++lispval Lprobef(); +++lispval Lptime(); +++lispval Lptr(); +++lispval Lputa(); +++lispval Lputaux(); +++lispval Lputd(); +++lispval Lputdata(); +++lispval Lputdel(); +++lispval Lputdim(); +++lispval Lputdisc(); +++lispval Lputl(); +++lispval Lputlang(); +++lispval Lputloc(); +++lispval Lputparams(); +++lispval Lputprop(); +++lispval Lquo(); +++lispval Lrandom(); +++lispval Lratom(); +++lispval Lread(); +++lispval Lreadc(); +++lispval Lreadli(); +++lispval Lrematom(); +++lispval Lremprop(); +++lispval Lreplace(); +++#ifdef VMS +++lispval Lrestlsp(); +++#endif +++lispval Lretbrk(); +++lispval Lrfasl(); +++lispval Lrot(); +++lispval Lrplaca(); +++lispval Lrplacd(); +++lispval Lrplaci(); +++lispval Lrplacx(); +++lispval Lrset(); +++#ifdef VMS +++lispval Lsavelsp(); +++#endif +++lispval Lscons(); +++lispval Lsegment(); +++lispval Lset(); +++lispval Lsetarg(); +++lispval Lsetpli(); +++lispval Lsetsyn(); +++lispval Lshostk(); +++lispval Lsignal(); +++lispval Lsimpld(); +++lispval Lsin(); +++lispval Lsizeof(); +++lispval Lslevel(); +++lispval Lsqrt(); +++lispval Lstringp(); +++lispval Lsub(); +++lispval Lsub1(); +++lispval Lsubstring(); +++lispval Lsubstringn(); +++lispval Lsymbolp(); +++lispval Lsyscall(); +++lispval Lterpr(); +++lispval Ltimes(); +++lispval Ltyi(); +++lispval Ltyipeek(); +++lispval Ltyo(); +++lispval Ltype(); +++lispval Luconcat(); +++lispval Lvaluep(); +++lispval Lvbind(); +++lispval Lzapline(); +++lispval Lzerop(); +++ +++lispval Nand(); +++lispval Nbreak(); +++lispval Ncatch(); +++lispval Ncond(); +++lispval Ndef(); +++lispval Ndo(); +++lispval Ndumplisp(); +++lispval Nndumplisp(); +++lispval Nerrset(); +++lispval Nevwhen(); +++lispval Nfunction(); +++lispval Ngc(); +++lispval Ngcafter(); +++lispval Nlist(); +++lispval Nopval(); +++lispval Nor(); +++lispval Nprocess(); +++lispval Nprod(); +++lispval Nprog(); +++lispval Nprog2(); +++lispval Nprogn(); +++lispval Nprogv(); +++lispval Nquote(); +++lispval Nresetio(); +++lispval Nsetq(); +++lispval Nsstatus(); +++lispval Nstatus(); +++lispval Zequal(); diff --cc usr/src/cmd/lisp/h/naout.h index 0000000000,0000000000,0000000000..dfc6b0909d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/naout.h @@@@ -1,0 -1,0 -1,0 +1,89 @@@@ +++/* sccs id @(#)naout.h 34.1 10/3/80 */ +++ +++/* u_* types come from */ +++/* PAGSIZ comes from */ +++/* +++ * Header prepended to each a.out file. +++ */ +++struct exec { +++ long a_magic; /* magic number */ +++ u_long a_text; /* size of text segment */ +++ u_long a_data; /* size of initialized data */ +++ u_long a_bss; /* size of uninitialized data */ +++ u_long a_syms; /* size of symbol table */ +++ u_long a_entry; /* entry point */ +++ u_long a_trsize; /* size of text relocation */ +++ u_long a_drsize; /* size of data relocation */ +++}; +++ +++#define OMAGIC 0407 /* old impure format */ +++#define NMAGIC 0410 /* read-only text */ +++#define ZMAGIC 0413 /* demand load format */ +++ +++/* +++ * Macros which take exec structures as arguments and tell whether +++ * the file has a reasonable magic number or offsets to text|symbols|strings. +++ */ +++#define N_BADMAG(x) \ +++ (((x).a_magic)!=OMAGIC && ((x).a_magic)!=NMAGIC && ((x).a_magic)!=ZMAGIC) +++ +++#define N_TXTOFF(x) \ +++ ((x).a_magic==ZMAGIC ? PAGSIZ : sizeof (struct exec)) +++#define N_SYMOFF(x) \ +++ (N_TXTOFF(x) + (x).a_text+(x).a_data + (x).a_trsize+(x).a_drsize) +++#define N_STROFF(x) \ +++ (N_SYMOFF(x) + (x).a_syms) +++ +++/* +++ * Format of a relocation datum. +++ */ +++struct relocation_info { +++ int r_address; /* address which is relocated */ +++ u_int r_symbolnum:24, /* local symbol ordinal */ +++ r_pcrel:1, /* was relocated pc relative already */ +++ r_length:2, /* 0=byte, 1=word, 2=long */ +++ r_extern:1, /* does not include value of sym referenced */ +++ :4; /* nothing, yet */ +++}; +++ +++/* +++ * Format of a symbol table entry; this file is included by +++ * and should be used if you aren't interested the a.out header +++ * or relocation information. +++ */ +++struct nlist { +++ union { +++ char *n_name; /* for use when in-core */ +++ long n_strx; /* index into file string table */ +++ } n_un; +++ u_char n_type; /* type flag, i.e. N_TEXT etc; see below */ +++ char n_other; /* unused */ +++ short n_desc; /* see */ +++ u_long n_value; /* value of this symbol (or sdb offset) */ +++}; +++#define n_hash n_desc /* used internally by ld */ +++ +++/* +++ * Simple values for n_type. +++ */ +++#define N_UNDF 0x0 /* undefined */ +++#define N_ABS 0x2 /* absolute */ +++#define N_TEXT 0x4 /* text */ +++#define N_DATA 0x6 /* data */ +++#define N_BSS 0x8 /* bss */ +++#define N_COMM 0x12 /* common (internal to ld) */ +++#define N_FN 0x1f /* file name symbol */ +++ +++#define N_EXT 01 /* external bit, or'ed in */ +++#define N_TYPE 0x1e /* mask for all the type bits */ +++ +++/* +++ * Sdb entries have some of the N_STAB bits set. +++ * These are given in +++ */ +++#define N_STAB 0xe0 /* if any of these bits set, a SDB entry */ +++ +++/* +++ * Format for namelist values. +++ */ +++#define N_FORMAT "%08x" diff --cc usr/src/cmd/lisp/h/oaout.h index 0000000000,0000000000,0000000000..b99a9d46ff new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/oaout.h @@@@ -1,0 -1,0 -1,0 +1,83 @@@@ +++/* sccs id @(#)oaout.h 34.1 10/3/80 */ +++ +++/* +++ * Format of an a.out header +++ */ +++ +++struct exec { /* a.out header */ +++ int a_magic; /* magic number */ +++ unsigned a_text; /* size of text segment */ +++ unsigned a_data; /* size of initialized data */ +++ unsigned a_bss; /* size of uninitialized data */ +++ unsigned a_syms; /* size of symbol table */ +++ unsigned a_entry; /* entry point */ +++ unsigned a_trsize; /* size of text relocation */ +++ unsigned a_drsize; /* size of data relocation */ +++}; +++ +++#define A_MAGIC1 0407 /* normal */ +++#define A_MAGIC2 0410 /* read-only text */ +++#define A_MAGIC3 0411 /* separated I&D (not on VAX) */ +++#define A_MAGIC4 0405 /* overlay */ +++#define A_MAGIC5 0413 /* demand page read-only text */ +++ +++struct relocation_info { +++ long r_address; /* relative to current segment */ +++ long r_symbolnum:24, +++ /* if extern then symbol table */ +++ /* ordinal (0, 1, 2, ...) else */ +++ /* segment number (same as symbol types) */ +++ r_pcrel:1, /* if so, segment offset has already */ +++ /* been subtracted */ +++ r_length:2, /* 0=byte, 1=word, 2=long */ +++ r_extern:1, /* does not include value */ +++ /* of symbol referenced */ +++ r_offset:1, /* already includes origin */ +++ /* of this segment (?) */ +++ r_pad:3; /* nothing, yet */ +++}; +++#ifndef NCPS +++#define NCPS 8 +++#endif +++struct nlist { /* symbol table entry */ +++ char n_name[NCPS]; /* symbol name */ +++ char n_type; /* type flag */ +++ char n_other; +++ short n_desc; +++ unsigned n_value; /* value */ +++}; +++ +++ /* values for type flag */ +++#define N_UNDF 0 /* undefined */ +++#define N_ABS 02 /* absolute */ +++#define N_TEXT 04 /* text */ +++#define N_DATA 06 /* data */ +++#define N_BSS 08 +++#define N_TYPE 037 +++#define N_FN 037 /* file name symbol */ +++ +++#define N_GSYM 0040 /* global sym: name,,type,0 */ +++#define N_FNAME 0042 /* procedure name (f77 kludge): name,,,0 */ +++#define N_FUN 0044 /* procedure: name,,linenumber,address */ +++#define N_STSYM 0046 /* static symbol: name,,type,address */ +++#define N_LCSYM 0048 /* .lcomm symbol: name,,type,address */ +++#define N_RSYM 0100 /* register sym: name,,register,offset */ +++#define N_SLINE 0104 /* src line: ,,linenumber,address */ +++#define N_SSYM 0140 /* structure elt: name,,type,struct_offset */ +++#define N_SO 0144 /* source file name: name,,,address */ +++#define N_LSYM 0200 /* local sym: name,,type,offset */ +++#define N_SOL 0204 /* #line source filename: name,,,address */ +++#define N_PSYM 0240 /* parameter: name,,type,offset */ +++#define N_ENTRY 0244 /* alternate entry: name,,linenumber,address */ +++#define N_LBRAC 0300 /* left bracket: ,,nesting level,address */ +++#define N_RBRAC 0340 /* right bracket: ,,nesting level,address */ +++#define N_BCOMM 0342 /* begin common: name,,, */ +++#define N_ECOMM 0344 /* end common: name,,, */ +++#define N_ECOML 0348 /* end common (local name): ,,,address */ +++#define N_LENG 0376 /* second stab entry with length information */ +++ +++#define N_EXT 01 /* external bit, or'ed in */ +++ +++#define FORMAT "%08x" +++ +++#define STABTYPES 0340 diff --cc usr/src/cmd/lisp/h/sigtab.h index 0000000000,0000000000,0000000000..84b29b29d4 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/sigtab.h @@@@ -1,0 -1,0 -1,0 +1,132 @@@@ +++/* sccs id @(#)sigtab.h 34.2 10/24/80 */ +++ +++/* +++ * lispvals in use by the program should be in this table. +++ * Otherwise they may get garbage-collected. +++ */ +++ +++#define SIGNIF 116 +++ +++extern lispval lispsys[SIGNIF]; +++ +++#define tatom (lispsys[1]) +++#define lambda (lispsys[2]) +++#define nlambda (lispsys[3]) +++#define perda (lispsys[4]) +++#define lpara (lispsys[5]) +++#define rpara (lispsys[6]) +++#define lbkta (lispsys[7]) +++#define rbkta (lispsys[8]) +++#define Eofa (lispsys[9]) +++#define snqta (lispsys[10]) +++#define exclpa (lispsys[11]) +++#define quota (lispsys[12]) +++#define xatom (lispsys[13]) +++#define cara (lispsys[14]) +++#define cdra (lispsys[15]) +++#define gcafter (lispsys[16]) +++#define noptop (lispsys[17]) +++#define gcthresh (lispsys[18]) +++#define int_name (lispsys[19]) +++#define str_name (lispsys[20]) +++#define atom_name (lispsys[21]) +++#define doub_name (lispsys[22]) +++#define dtpr_name (lispsys[23]) +++#define int_items (lispsys[24]) +++#define int_pages (lispsys[25]) +++#define str_items (lispsys[26]) +++#define str_pages (lispsys[27]) +++#define dtpr_items (lispsys[28]) +++#define dtpr_pages (lispsys[29]) +++#define doub_items (lispsys[30]) +++#define doub_pages (lispsys[31]) +++#define atom_items (lispsys[32]) +++#define atom_pages (lispsys[33]) +++#define gccall1 (lispsys[34]) +++#define gccall2 (lispsys[35]) +++#define sysa (lispsys[36]) +++#define plima (lispsys[37]) +++#define macro (lispsys[38]) +++#define startup (lispsys[39]) +++#define rcomms (lispsys[40]) +++#define commta (lispsys[41]) +++#define plimit (lispsys[44]) +++#define array_items (lispsys[45]) +++#define array_pages (lispsys[46]) +++#define array_name (lispsys[47]) +++#define sdot_items (lispsys[48]) +++#define sdot_pages (lispsys[49]) +++#define sdot_name (lispsys[50]) +++#define val_items (lispsys[51]) +++#define val_pages (lispsys[52]) +++#define val_name (lispsys[53]) +++#define splice (lispsys[54]) +++#define rdrsdot (lispsys[55]) +++#define funct_items (lispsys[56]) +++#define funct_pages (lispsys[57]) +++#define funct_name (lispsys[58]) +++#define nstack (lispsys[59]) +++#define rdrint (lispsys[63]) +++#define nilplist (lispsys[64]) +++#define badst (lispsys[65]) +++#define gccheck (lispsys[66]) +++#define gcport (lispsys[67]) +++#define gcdis (lispsys[68]) +++#define gcload (lispsys[69]) +++#define loading (lispsys[70]) +++#define noautot (lispsys[71]) +++#define lcode (lispsys[72]) +++#define ccode (lispsys[73]) +++#define odform (lispsys[74]) +++#define bcdst (lispsys[75]) +++#define listst (lispsys[76]) +++#define macrost (lispsys[77]) +++#define protst (lispsys[78]) +++#define argst (lispsys[79]) +++#define arrayst (lispsys[80]) +++#define proga (lispsys[81]) +++#define progma (lispsys[82]) +++#define bstack (lispsys[83]) +++#define lexpr_atom (lispsys[84]) +++#define lexpr (lispsys[85]) +++#define ibase (lispsys[86]) +++#define Vpiport (lispsys[87]) +++#define Vpoport (lispsys[88]) +++#define Veval (lispsys[89]) +++#define Vererr (lispsys[90]) +++#define Vertpl (lispsys[91]) +++#define Verall (lispsys[92]) +++#define Vermisc (lispsys[93]) +++#define Vlerall (lispsys[94]) +++#define stlist (lispsys[95]) +++#define Vreadtable (lispsys[96]) +++#define strtab (lispsys[97]) +++#define Verbrk (lispsys[98]) +++#define Vnogbar (lispsys[99]) +++#define rdrsdot2 (lispsys[100]) +++#define Veruwpt (lispsys[101]) +++ +++#define hunkfree (lispsys[102]) +++#define port_name (lispsys[103]) +++#define reseta (lispsys[104]) +++#define rsetatom (lispsys[105]) +++#define bptr_atom (lispsys[106]) +++#define evalhatom (lispsys[107]) +++#define evalhcall (lispsys[108]) +++#define Vptport (lispsys[109]) +++#define Vcntlw (lispsys[110]) +++#define Verrset (lispsys[111]) +++#define Verundef (lispsys[112]) +++#define Vsubrou (lispsys[113]) +++#define Vprinlevel (lispsys[114]) +++#define Vprinlength (lispsys[115]) +++ +++/* various status switches */ +++ +++#ifndef CONTORT +++extern lispval stattab[16] ; +++#define Schainp (stattab[0]) +++#define Sautor (stattab[1]) +++#define Strans (stattab[2]) +++#define evalhsw (stattab[3]) +++#endif diff --cc usr/src/cmd/lisp/h/types.h index 0000000000,0000000000,0000000000..2ba2fbe050 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/h/types.h @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* sccs id @(#)types.h 34.1 10/3/80 */ +++ +++typedef struct { int rrr[1]; } * physadr; +++typedef long daddr_t; +++typedef char * caddr_t; +++typedef unsigned short ino_t; +++typedef long time_t; +++typedef int label_t[10]; +++typedef short dev_t; +++typedef long off_t; +++# ifdef UNIXTS +++typedef unisgned short ushort; +++# endif +++/* major part of a device */ +++#define major(x) (int)(((unsigned)x>>8)&0377) +++ +++/* minor part of a device */ +++#define minor(x) (int)(x&0377) +++ +++/* make a device number */ +++#define makedev(x,y) (dev_t)(((x)<<8) | (y)) diff --cc usr/src/cmd/lisp/hcrt0.s index 0000000000,0000000000,0000000000..3685377deb new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/hcrt0.s @@@@ -1,0 -1,0 -1,0 +1,378 @@@@ +++# C runtime startoff +++# sccs id @(#)hcrt0.s 34.1 10/3/80 +++ +++ .set exit,1 +++.globl _exit +++.globl start +++.globl hstart +++.globl _main +++.globl _environ +++.globl _xports +++.globl _gstart +++.globl _proflush +++.globl _holbeg +++.globl _holend +++.globl Fixzero +++ +++# +++# C language startup routine +++ +++# +++# special 512 byte area for nil (and possibly other atoms) +++# and special block of smallnums. +++# +++ .long 0 +++ .long 0 +++ .long 0 +++ .long -4 +++ .long 20 +++ .byte 'n,'i,'l,0 +++ .long 0 +++ .long 0 +++ .long -4 +++ .long 40 +++ .byte 'e,'o,'f,0 +++ .space 512-44 +++_xports: +++ .long __iob+0 +++ .long __iob+16 +++ .long __iob+32 +++ .long __iob+48 +++ .long __iob+64 +++ .long __iob+80 +++ .long __iob+96 +++ .long __iob+112 +++ .long __iob+128 +++ .long __iob+144 +++ .long __iob+160 +++ .long __iob+176 +++ .long __iob+192 +++ .long __iob+208 +++ .long __iob+224 +++ .long __iob+240 +++ .long __iob+256 +++ .long __iob+272 +++ .long __iob+288 +++ .long __iob+304 +++ .space 512 - (20 * 4) +++.globl Negint +++Negint: +++ .long -1024,-1023,-1022,-1021,-1020,-1019,-1018,-1017 +++ .long -1016,-1015,-1014,-1013,-1012,-1011,-1010,-1009 +++ .long -1008,-1007,-1006,-1005,-1004,-1003,-1002,-1001 +++ .long -1000,-999,-998,-997,-996,-995,-994,-993 +++ .long -992,-991,-990,-989,-988,-987,-986,-985 +++ .long -984,-983,-982,-981,-980,-979,-978,-977 +++ .long -976,-975,-974,-973,-972,-971,-970,-969 +++ .long -968,-967,-966,-965,-964,-963,-962,-961 +++ .long -960,-959,-958,-957,-956,-955,-954,-953 +++ .long -952,-951,-950,-949,-948,-947,-946,-945 +++ .long -944,-943,-942,-941,-940,-939,-938,-937 +++ .long -936,-935,-934,-933,-932,-931,-930,-929 +++ .long -928,-927,-926,-925,-924,-923,-922,-921 +++ .long -920,-919,-918,-917,-916,-915,-914,-913 +++ .long -912,-911,-910,-909,-908,-907,-906,-905 +++ .long -904,-903,-902,-901,-900,-899,-898,-897 +++ .long -896,-895,-894,-893,-892,-891,-890,-889 +++ .long -888,-887,-886,-885,-884,-883,-882,-881 +++ .long -880,-879,-878,-877,-876,-875,-874,-873 +++ .long -872,-871,-870,-869,-868,-867,-866,-865 +++ .long -864,-863,-862,-861,-860,-859,-858,-857 +++ .long -856,-855,-854,-853,-852,-851,-850,-849 +++ .long -848,-847,-846,-845,-844,-843,-842,-841 +++ .long -840,-839,-838,-837,-836,-835,-834,-833 +++ .long -832,-831,-830,-829,-828,-827,-826,-825 +++ .long -824,-823,-822,-821,-820,-819,-818,-817 +++ .long -816,-815,-814,-813,-812,-811,-810,-809 +++ .long -808,-807,-806,-805,-804,-803,-802,-801 +++ .long -800,-799,-798,-797,-796,-795,-794,-793 +++ .long -792,-791,-790,-789,-788,-787,-786,-785 +++ .long -784,-783,-782,-781,-780,-779,-778,-777 +++ .long -776,-775,-774,-773,-772,-771,-770,-769 +++ .long -768,-767,-766,-765,-764,-763,-762,-761 +++ .long -760,-759,-758,-757,-756,-755,-754,-753 +++ .long -752,-751,-750,-749,-748,-747,-746,-745 +++ .long -744,-743,-742,-741,-740,-739,-738,-737 +++ .long -736,-735,-734,-733,-732,-731,-730,-729 +++ .long -728,-727,-726,-725,-724,-723,-722,-721 +++ .long -720,-719,-718,-717,-716,-715,-714,-713 +++ .long -712,-711,-710,-709,-708,-707,-706,-705 +++ .long -704,-703,-702,-701,-700,-699,-698,-697 +++ .long -696,-695,-694,-693,-692,-691,-690,-689 +++ .long -688,-687,-686,-685,-684,-683,-682,-681 +++ .long -680,-679,-678,-677,-676,-675,-674,-673 +++ .long -672,-671,-670,-669,-668,-667,-666,-665 +++ .long -664,-663,-662,-661,-660,-659,-658,-657 +++ .long -656,-655,-654,-653,-652,-651,-650,-649 +++ .long -648,-647,-646,-645,-644,-643,-642,-641 +++ .long -640,-639,-638,-637,-636,-635,-634,-633 +++ .long -632,-631,-630,-629,-628,-627,-626,-625 +++ .long -624,-623,-622,-621,-620,-619,-618,-617 +++ .long -616,-615,-614,-613,-612,-611,-610,-609 +++ .long -608,-607,-606,-605,-604,-603,-602,-601 +++ .long -600,-599,-598,-597,-596,-595,-594,-593 +++ .long -592,-591,-590,-589,-588,-587,-586,-585 +++ .long -584,-583,-582,-581,-580,-579,-578,-577 +++ .long -576,-575,-574,-573,-572,-571,-570,-569 +++ .long -568,-567,-566,-565,-564,-563,-562,-561 +++ .long -560,-559,-558,-557,-556,-555,-554,-553 +++ .long -552,-551,-550,-549,-548,-547,-546,-545 +++ .long -544,-543,-542,-541,-540,-539,-538,-537 +++ .long -536,-535,-534,-533,-532,-531,-530,-529 +++ .long -528,-527,-526,-525,-524,-523,-522,-521 +++ .long -520,-519,-518,-517,-516,-515,-514,-513 +++ .long -512,-511,-510,-509,-508,-507,-506,-505 +++ .long -504,-503,-502,-501,-500,-499,-498,-497 +++ .long -496,-495,-494,-493,-492,-491,-490,-489 +++ .long -488,-487,-486,-485,-484,-483,-482,-481 +++ .long -480,-479,-478,-477,-476,-475,-474,-473 +++ .long -472,-471,-470,-469,-468,-467,-466,-465 +++ .long -464,-463,-462,-461,-460,-459,-458,-457 +++ .long -456,-455,-454,-453,-452,-451,-450,-449 +++ .long -448,-447,-446,-445,-444,-443,-442,-441 +++ .long -440,-439,-438,-437,-436,-435,-434,-433 +++ .long -432,-431,-430,-429,-428,-427,-426,-425 +++ .long -424,-423,-422,-421,-420,-419,-418,-417 +++ .long -416,-415,-414,-413,-412,-411,-410,-409 +++ .long -408,-407,-406,-405,-404,-403,-402,-401 +++ .long -400,-399,-398,-397,-396,-395,-394,-393 +++ .long -392,-391,-390,-389,-388,-387,-386,-385 +++ .long -384,-383,-382,-381,-380,-379,-378,-377 +++ .long -376,-375,-374,-373,-372,-371,-370,-369 +++ .long -368,-367,-366,-365,-364,-363,-362,-361 +++ .long -360,-359,-358,-357,-356,-355,-354,-353 +++ .long -352,-351,-350,-349,-348,-347,-346,-345 +++ .long -344,-343,-342,-341,-340,-339,-338,-337 +++ .long -336,-335,-334,-333,-332,-331,-330,-329 +++ .long -328,-327,-326,-325,-324,-323,-322,-321 +++ .long -320,-319,-318,-317,-316,-315,-314,-313 +++ .long -312,-311,-310,-309,-308,-307,-306,-305 +++ .long -304,-303,-302,-301,-300,-299,-298,-297 +++ .long -296,-295,-294,-293,-292,-291,-290,-289 +++ .long -288,-287,-286,-285,-284,-283,-282,-281 +++ .long -280,-279,-278,-277,-276,-275,-274,-273 +++ .long -272,-271,-270,-269,-268,-267,-266,-265 +++ .long -264,-263,-262,-261,-260,-259,-258,-257 +++ .long -256,-255,-254,-253,-252,-251,-250,-249 +++ .long -248,-247,-246,-245,-244,-243,-242,-241 +++ .long -240,-239,-238,-237,-236,-235,-234,-233 +++ .long -232,-231,-230,-229,-228,-227,-226,-225 +++ .long -224,-223,-222,-221,-220,-219,-218,-217 +++ .long -216,-215,-214,-213,-212,-211,-210,-209 +++ .long -208,-207,-206,-205,-204,-203,-202,-201 +++ .long -200,-199,-198,-197,-196,-195,-194,-193 +++ .long -192,-191,-190,-189,-188,-187,-186,-185 +++ .long -184,-183,-182,-181,-180,-179,-178,-177 +++ .long -176,-175,-174,-173,-172,-171,-170,-169 +++ .long -168,-167,-166,-165,-164,-163,-162,-161 +++ .long -160,-159,-158,-157,-156,-155,-154,-153 +++ .long -152,-151,-150,-149,-148,-147,-146,-145 +++ .long -144,-143,-142,-141,-140,-139,-138,-137 +++ .long -136,-135,-134,-133,-132,-131,-130,-129 +++ .long -128,-127,-126,-125,-124,-123,-122,-121 +++ .long -120,-119,-118,-117,-116,-115,-114,-113 +++ .long -112,-111,-110,-109,-108,-107,-106,-105 +++ .long -104,-103,-102,-101,-100,-99,-98,-97 +++ .long -96,-95,-94,-93,-92,-91,-90,-89 +++ .long -88,-87,-86,-85,-84,-83,-82,-81 +++ .long -80,-79,-78,-77,-76,-75,-74,-73 +++ .long -72,-71,-70,-69,-68,-67,-66,-65 +++ .long -64,-63,-62,-61,-60,-59,-58,-57 +++ .long -56,-55,-54,-53,-52,-51,-50,-49 +++ .long -48,-47,-46,-45,-44,-43,-42,-41 +++ .long -40,-39,-38,-37,-36,-35,-34,-33 +++ .long -32,-31,-30,-29,-28,-27,-26,-25 +++ .long -24,-23,-22,-21,-20,-19,-18,-17 +++ .long -16,-15,-14,-13,-12,-11,-10,-9 +++ .long -8,-7,-6,-5,-4,-3,-2,-1 +++Fixzero: +++ .long 0,1,2,3,4,5,6,7 +++ .long 8,9,10,11,12,13,14,15 +++ .long 16,17,18,19,20,21,22,23 +++ .long 24,25,26,27,28,29,30,31 +++ .long 32,33,34,35,36,37,38,39 +++ .long 40,41,42,43,44,45,46,47 +++ .long 48,49,50,51,52,53,54,55 +++ .long 56,57,58,59,60,61,62,63 +++ .long 64,65,66,67,68,69,70,71 +++ .long 72,73,74,75,76,77,78,79 +++ .long 80,81,82,83,84,85,86,87 +++ .long 88,89,90,91,92,93,94,95 +++ .long 96,97,98,99,100,101,102,103 +++ .long 104,105,106,107,108,109,110,111 +++ .long 112,113,114,115,116,117,118,119 +++ .long 120,121,122,123,124,125,126,127 +++ .long 128,129,130,131,132,133,134,135 +++ .long 136,137,138,139,140,141,142,143 +++ .long 144,145,146,147,148,149,150,151 +++ .long 152,153,154,155,156,157,158,159 +++ .long 160,161,162,163,164,165,166,167 +++ .long 168,169,170,171,172,173,174,175 +++ .long 176,177,178,179,180,181,182,183 +++ .long 184,185,186,187,188,189,190,191 +++ .long 192,193,194,195,196,197,198,199 +++ .long 200,201,202,203,204,205,206,207 +++ .long 208,209,210,211,212,213,214,215 +++ .long 216,217,218,219,220,221,222,223 +++ .long 224,225,226,227,228,229,230,231 +++ .long 232,233,234,235,236,237,238,239 +++ .long 240,241,242,243,244,245,246,247 +++ .long 248,249,250,251,252,253,254,255 +++ .long 256,257,258,259,260,261,262,263 +++ .long 264,265,266,267,268,269,270,271 +++ .long 272,273,274,275,276,277,278,279 +++ .long 280,281,282,283,284,285,286,287 +++ .long 288,289,290,291,292,293,294,295 +++ .long 296,297,298,299,300,301,302,303 +++ .long 304,305,306,307,308,309,310,311 +++ .long 312,313,314,315,316,317,318,319 +++ .long 320,321,322,323,324,325,326,327 +++ .long 328,329,330,331,332,333,334,335 +++ .long 336,337,338,339,340,341,342,343 +++ .long 344,345,346,347,348,349,350,351 +++ .long 352,353,354,355,356,357,358,359 +++ .long 360,361,362,363,364,365,366,367 +++ .long 368,369,370,371,372,373,374,375 +++ .long 376,377,378,379,380,381,382,383 +++ .long 384,385,386,387,388,389,390,391 +++ .long 392,393,394,395,396,397,398,399 +++ .long 400,401,402,403,404,405,406,407 +++ .long 408,409,410,411,412,413,414,415 +++ .long 416,417,418,419,420,421,422,423 +++ .long 424,425,426,427,428,429,430,431 +++ .long 432,433,434,435,436,437,438,439 +++ .long 440,441,442,443,444,445,446,447 +++ .long 448,449,450,451,452,453,454,455 +++ .long 456,457,458,459,460,461,462,463 +++ .long 464,465,466,467,468,469,470,471 +++ .long 472,473,474,475,476,477,478,479 +++ .long 480,481,482,483,484,485,486,487 +++ .long 488,489,490,491,492,493,494,495 +++ .long 496,497,498,499,500,501,502,503 +++ .long 504,505,506,507,508,509,510,511 +++ .long 512,513,514,515,516,517,518,519 +++ .long 520,521,522,523,524,525,526,527 +++ .long 528,529,530,531,532,533,534,535 +++ .long 536,537,538,539,540,541,542,543 +++ .long 544,545,546,547,548,549,550,551 +++ .long 552,553,554,555,556,557,558,559 +++ .long 560,561,562,563,564,565,566,567 +++ .long 568,569,570,571,572,573,574,575 +++ .long 576,577,578,579,580,581,582,583 +++ .long 584,585,586,587,588,589,590,591 +++ .long 592,593,594,595,596,597,598,599 +++ .long 600,601,602,603,604,605,606,607 +++ .long 608,609,610,611,612,613,614,615 +++ .long 616,617,618,619,620,621,622,623 +++ .long 624,625,626,627,628,629,630,631 +++ .long 632,633,634,635,636,637,638,639 +++ .long 640,641,642,643,644,645,646,647 +++ .long 648,649,650,651,652,653,654,655 +++ .long 656,657,658,659,660,661,662,663 +++ .long 664,665,666,667,668,669,670,671 +++ .long 672,673,674,675,676,677,678,679 +++ .long 680,681,682,683,684,685,686,687 +++ .long 688,689,690,691,692,693,694,695 +++ .long 696,697,698,699,700,701,702,703 +++ .long 704,705,706,707,708,709,710,711 +++ .long 712,713,714,715,716,717,718,719 +++ .long 720,721,722,723,724,725,726,727 +++ .long 728,729,730,731,732,733,734,735 +++ .long 736,737,738,739,740,741,742,743 +++ .long 744,745,746,747,748,749,750,751 +++ .long 752,753,754,755,756,757,758,759 +++ .long 760,761,762,763,764,765,766,767 +++ .long 768,769,770,771,772,773,774,775 +++ .long 776,777,778,779,780,781,782,783 +++ .long 784,785,786,787,788,789,790,791 +++ .long 792,793,794,795,796,797,798,799 +++ .long 800,801,802,803,804,805,806,807 +++ .long 808,809,810,811,812,813,814,815 +++ .long 816,817,818,819,820,821,822,823 +++ .long 824,825,826,827,828,829,830,831 +++ .long 832,833,834,835,836,837,838,839 +++ .long 840,841,842,843,844,845,846,847 +++ .long 848,849,850,851,852,853,854,855 +++ .long 856,857,858,859,860,861,862,863 +++ .long 864,865,866,867,868,869,870,871 +++ .long 872,873,874,875,876,877,878,879 +++ .long 880,881,882,883,884,885,886,887 +++ .long 888,889,890,891,892,893,894,895 +++ .long 896,897,898,899,900,901,902,903 +++ .long 904,905,906,907,908,909,910,911 +++ .long 912,913,914,915,916,917,918,919 +++ .long 920,921,922,923,924,925,926,927 +++ .long 928,929,930,931,932,933,934,935 +++ .long 936,937,938,939,940,941,942,943 +++ .long 944,945,946,947,948,949,950,951 +++ .long 952,953,954,955,956,957,958,959 +++ .long 960,961,962,963,964,965,966,967 +++ .long 968,969,970,971,972,973,974,975 +++ .long 976,977,978,979,980,981,982,983 +++ .long 984,985,986,987,988,989,990,991 +++ .long 992,993,994,995,996,997,998,999 +++ .long 1000,1001,1002,1003,1004,1005,1006,1007 +++ .long 1008,1009,1010,1011,1012,1013,1014,1015 +++ .long 1016,1017,1018,1019,1020,1021,1022,1023 +++ +++start: +++ .word 0x0000 +++ subl2 $8,sp +++ movl 8(sp),(sp) # argc +++ movab 12(sp),r0 +++ movl r0,4(sp) # argv +++L1: +++ tstl (r0)+ # null args term ? +++ bneq L1 +++ cmpl r0,*4(sp) # end of 'env' or 'argv' ? +++ blss L2 +++ tstl -(r0) # envp's are in list +++L2: +++ movl r0,8(sp) # env +++ movl r0,_environ # indir is 0 if no env ; not 0 if env +++ calls $3,_main +++ pushl r0 +++ calls $1,_exit +++ chmk $exit +++hstart: # This routine is exactly the same as +++ # start except there is a call to _rlc +++ # before the call to _main. One could +++ # arrange a switch by putting different +++ # addresses in a register and jumping +++ # indirect through the register but +++ # it seems worth the cost of 80 bytes +++ # for the gain in clarity by having the +++ # routines EXACTLY the same except for +++ # that one difference. +++ .word 0x0000 +++ subl2 $8,sp +++ calls $0,_rlc +++ movl 8(sp),(sp) # argc +++ movab 12(sp),r0 +++ movl r0,4(sp) # argv +++L3: +++ tstl (r0)+ # null args term ? +++ bneq L3 +++ cmpl r0,*4(sp) # end of 'env' or 'argv' ? +++ blss L4 +++ tstl -(r0) # envp's are in list +++L4: +++ movl r0,8(sp) # env +++ movl r0,_environ # indir is 0 if no env ; not 0 if env +++ calls $0,_rlc +++ calls $3,_main +++ pushl r0 +++ calls $1,_exit +++ chmk $exit +++_gstart: +++ .word 0 +++ moval start,r0 +++ ret +++_proflush: +++ .word 0 +++ ret +++# +++ .data +++_holbeg: +++_holend: +++_environ: .space 4 diff --cc usr/src/cmd/lisp/inewint.s index 0000000000,24406a5bcd,0000000000..eeb83a4473 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/inewint.s +++ b/usr/src/cmd/lisp/inewint.s @@@@ -1,0 -1,11 -1,0 +1,32 @@@@ +++ .asciz "@(#)inewint.s 34.2 10/9/80" + + .globl _inewint +++ .globl _blzero +++ .data 0 +++cntloc: .long 0 +++ .text + +_inewint:.word 0 - cvtlb 4(ap),r0 - bvs nofit - ashl $2,4(ap),r0 - addl2 $1024,r0 +++# movab cntloc,r0 # used when profiling +++# jsb mcount +++ movl 4(ap),r0 +++# cvtlb r0,r0 +++# bvs nottiny +++# moval Fixzero[r0],r0 +++# ret +++# nottiny: +++ cmpl r0,$1024 +++ jgeq alloc +++ cmpl r0,$-1024 +++ jlss alloc +++ moval Fixzero[r0],r0 + + ret - nofit: +++alloc: + + calls $0,_newint + + movl 4(ap),0(r0) + + ret +++_blzero: # blzero(where,howmuch) +++ # char *where; +++ # zeroes a block of length howmuch +++ # beginning at where. +++ .word 0 +++ movc5 $0,*4(ap),$0,8(ap),*4(ap) +++ ret diff --cc usr/src/cmd/lisp/inits.c index 0000000000,993c3c015d,0000000000..c161ab43e5 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/inits.c +++ b/usr/src/cmd/lisp/inits.c @@@@ -1,0 -1,140 -1,0 +1,187 @@@@ +++static char *sccsid = "@(#)inits.c 34.2 10/13/80"; +++ + +#include "global.h" + +#include + +/************************************************************************/ + +/* */ + +/* file: inits.i */ + +/* contents: initialization routines */ + +/* */ + + + + + +/* initial **************************************************************/ + +/* initializes the parts of the system that cannot be automatically */ + +/* accomplished in the declarations. */ + + + +int reborn=0; /* flag to tell whether we are in fast-load version */ + +extern char *stabf; + +extern int fvirgin; + +extern int keywait; + +extern sigstruck, sigdelay; + +initial() + +{ + + int sigalrmh(), sigfpeh(), siginth(); + + lispval Isstatus(),Istsrch(); +++ extern int hashtop; +++ +++ /* clear any memory of pending SIGINT's */ +++ exception = FALSE; +++ sigintcnt = 0; + + + + if( signal(SIGINT,SIG_IGN) != SIG_IGN) + + signal(SIGINT,siginth); + + if( signal(SIGHUP,SIG_IGN) != SIG_IGN) + + signal(SIGHUP,siginth); + + signal(SIGFPE,siginth); + + signal(SIGALRM,siginth); +++ signal(SIGPIPE,siginth); + + /* signals SIGBUS and SIGSEGV will be set up when the status list + + is set up when the lisp is virgin, and will be set up according + + to the current value on the status list if the lisp is reborn + + */ + + + + if( reborn ) { + + register FILE *p = _iob + 3; + + static FILE empty; + + for(; p < _iob + _NFILE; p++) + + *p = empty; + + np = lbot = orgnp; + + stabf = 0; + + fvirgin = 1; - loading->clb = nil; +++ loading->a.clb = nil; +++ gcrebear(); + + + + /* set up SIGBUS and SIGSEGV from current value + + of status flag dumpcore + + */ + + Isstatus(matom("dumpcore"), - (Istsrch(matom("dumpcore")))->cdr->cdr->cdr); +++ (Istsrch(matom("dumpcore")))->d.cdr->d.cdr->d.cdr); + + + + makenv(); + + return; + + } - for (hash=0;hashval = env; + + for (envp=environ; *envp!=NULL; envp++) ; + + while (--envp >= environ) { - for(p= *envp,q=envstr; (*q++ = *p++)!='=';); - *--q = 0; +++ for(p= *envp,q=envstr; *p!='=' ; p++) +++ if(q < envstr + STRBLEN) +++ *q++ = *p; +++ *q = 0; p++; + + /* at this point lbot->val==env, so it is protected + + from gc */ + + lbot->val = temp = newdot(); - temp->cdr = env; +++ temp->d.cdr = env; + + env = temp; + + temp = newdot(); - temp->car = matom(envstr); - temp->cdr = matom(p); - env->car = temp; +++ temp->d.car = matom(envstr); +++ temp->d.cdr = matom(p); +++ env->d.car = temp; + + } - matom("environment")->clb = env; +++ matom("environment")->a.clb = env; + +} + + + +siginth(signo){ + + signal(signo,siginth); + + sigstruck |= (1 << signo); - /*if(signo==SIGBUS || signo==SIGBUS || keywait)*/ - sigcall(signo); +++ /* handle SIGINT differently since it is the only +++ asychronous interrupt we handle */ +++ if( signo == SIGINT) { +++ if( ++sigintcnt == 1) +++ { /* if this is the first interrupt, we just set a flag +++ which will be checked in qfuncl and eval. This will +++ allow us to handle these interrupts when we are +++ ready. +++ */ +++ exception = TRUE; +++ /*putchar('A');*/ +++ fflush(stdout); +++ sigstruck &= ~(1 << signo); +++ return; +++ } +++ else if (sigintcnt == 2) +++ { /* the setting of exception was ignored, we better +++ make sure that all calls from compiled code +++ go through qlinker +++ */ +++ signal(SIGINT,SIG_IGN); /* this may take a while, dont allow ints*/ +++ clrtt(0); +++ /*putchar('B');*/ +++ fflush(stdout); +++ signal(SIGINT,siginth); /* ok to interrupt again */ +++ sigstruck &= ~(1 << signo); +++ return; +++ } +++ else { +++ /*putchar('C');*/ +++ fflush(stdout); +++ } +++ } +++ +++ sigcall(signo); + +} + +sigcall(which) + +register which; + +{ + + extern lispval Lfuncal(); - extern lispval sigacts[16]; - struct argent *oldlbot, *oldnp, saved; +++ +++ snpand(1); +++ +++ if(which == SIGINT) { sigintcnt = 0; exception = 0; } + + + + if(sigacts[which]!=((lispval) 0)) { - oldlbot = lbot; - oldnp = np; + + lbot = np; + + np -> val = sigacts[which]; + + INRNP; + + np -> val = inewint(which); + + INRNP; +++ {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/} + + Lfuncal(); - lbot = oldlbot; - np = oldnp; +++ {lispval temp;temp = rdrsdot, rdrsdot = rdrsdot2, rdrsdot2 = temp; /*KLUDGE*/} + + } + + sigstruck &= ~ (1< + +#include + +#include "chars.h" + + + +struct readtable { + +char ctable[132]; + +} initread = { + +/* ^@ nul ^A soh ^B stx ^C etx ^D eot ^E eng ^F ack ^G bel */ + + VERR, VERR, VERR, VERR, VERR, VERR, VERR, VERR, + +/* ^H bs ^I ht ^J nl ^K vt ^L np ^M cr ^N so ^O si */ + + VCHAR, VSEP, VSEP, VSEP, VSEP, VSEP, VERR, VERR, + +/* ^P dle ^Q dc1 ^R dc2 ^S dc3 ^T dc4 ^U nak ^V syn ^W etb */ + + VERR, VERR, VERR, VERR, VERR, VERR, VERR, VERR, + +/* ^X can ^Y em ^Z sub ^[ esc ^\ fs ^] gs ^^ rs ^_ us */ + + VERR, VERR, VERR, VSEP, VERR, VERR, VERR, VERR, + +/* sp ! " # $ % & ' */ - VSEP, VCHAR, VDQ, VCHAR, VCHAR, VCHAR, VCHAR, VSQ, +++ VSEP, VCHAR, VSD, VCHAR, VCHAR, VCHAR, VCHAR, VSQ, + +/* ( ) * + , - . / */ + + VLPARA, VRPARA, VCHAR, VSIGN, VCHAR, VSIGN, VPERD, VCHAR, + +/* 0 1 2 3 4 5 6 7 */ + + VNUM, VNUM, VNUM, VNUM, VNUM, VNUM, VNUM, VNUM, + +/* 8 9 : ; < = > ? */ + + VNUM, VNUM, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, + +/* @ A B C D E F G */ + + VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, + +/* H I J K L M N O */ + + VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, + +/* P Q R S T U V W */ + + VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, + +/* X Y Z [ \ ] ^ _ */ + + VCHAR, VCHAR, VCHAR, VLBRCK, VESC, VRBRCK, VCHAR, VCHAR, + +/* ` a b c d e f g */ + + VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, + +/* h i j k l m n o */ + + VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, + +/* p q r s t u v w */ + + VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, + +/* x y z { | } ~ del */ - VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VCHAR, VEOF, - /* unused unused Xesc Xdqc */ - 0, 0, '\\', '"' +++ VCHAR, VCHAR, VCHAR, VCHAR, VDQ, VCHAR, VCHAR, VEOF, +++/* unused Xsdc Xesc Xdqc */ +++ 0, '"', '\\', '|' + +}; + + + +char *ctable = initread.ctable; + +lispval atomval; /* external varaible containing atom returned + + from internal atom reading routine */ - lispval protect(); - lispval unprotect(); + +lispval readrx(); lispval readr(); lispval readry(); + +int keywait; +++int prinlevel = -1; /* contains maximum list recursion count */ +++int prinlength = -1; /* maximum number of list elements printed */ + +static int dbqflag; + +static int macflag; + +static int splflag; + +static int mantisfl = 0; - lispval lastrtab; /* external variable designating current reader +++extern lispval lastrtab; /* external variable designating current reader + + table */ + +static char baddot1[]= + +"Bad reader construction: (. )\nShould be (nil . )\n"; + +static char baddot2[]= + +"Bad reader construction: ( .)\n\ + +Should be ( . ), assumed to be ()"; + +static char baddot3[]= + +"Bad reader construction: ( . not followed by )"; + + + +#include "chkrtab.h" + +/* readr ****************************************************************/ + +/* returns a s-expression read in from the port specified as the first */ + +/* argument. Handles superbrackets, reader macros. */ + +lispval + +readr(useport) + +FILE *useport; + +{ - register lispval handy = Vreadtable->clb; +++ register lispval handy = Vreadtable->a.clb; + + + + chkrtab(handy); + + rbktf = FALSE; + + rdrport = (FILE *) useport; + + if(useport==stdin) + + keywait = TRUE; + + handy = readrx(Iratom()); + + if(useport==stdin) + + keywait = FALSE; + + return(handy); + + + +} + + + + + +/* readrx **************************************************************/ + +/* returns a s-expression beginning with the syntax code of an atom */ + +/* passed in the first */ + +/* argument. Does the actual work for readr, including list, dotted */ + +/* pair, and quoted atom detection */ + +lispval + +readrx(code) + +register int code; + +{ + + register lispval work; + + register lispval *current; + + register struct argent *result; + + register struct argent *lbot, *np; + + int inlbkt = FALSE; + + lispval errorh(); + + + +top: + + switch(code) + + { + + case TLBKT: + + inlbkt = TRUE; + + case TLPARA: + + result = np; + + current = (lispval *)np; + + np++->val = nil; /*protect(nil);*/ + + for(EVER) { + + switch(code = Iratom()) + + { + + case TRPARA: + + if(rbktf && inlbkt) + + rbktf = FALSE; + + return(result->val); + + default: + + atomval = readrx(code); + + case TSCA: + + np++->val=atomval; + + *current = work = newdot(); - work->car = atomval; +++ work->d.car = atomval; + + np--; - current = (lispval *) &(work->cdr); +++ current = (lispval *) &(work->d.cdr); + + break; + + case TSPL: + + macrox(); /* input and output in atomval */ + + *current = atomval; + + while(*current!=nil) { + + if(TYPE(*current)!=DTPR) + + errorh(Vermisc,"Non-list returned from splicing macro",nil,FALSE,7,*current); - current=(lispval *)&((*current)->cdr); +++ current=(lispval *)&((*current)->d.cdr); + + } + + break; + + case TPERD: + + if(result->val==nil) { + + work = result->val=newdot(); - current = (lispval *) &(work->cdr); +++ current = (lispval *) &(work->d.cdr); + + fprintf(stderr,baddot1); + + } + + code = Iratom(); + + if(code==TRPARA) { + + return(errorh(Vermisc,baddot2,nil,TRUE,58,result->val)); + + } + + *current = readrx(code); - if((code = Iratom())!=TRPARA) { +++ /* there is the possibility that the expression +++ following the dot is terminated with a "]" +++ and thus needs no closing lparens to follow +++ */ +++ if(!rbktf && ((code = Iratom()))!=TRPARA) { + + errorh(Vermisc,baddot3,nil,TRUE,59,result->val,atomval); + + } + + if(rbktf && inlbkt) + + rbktf = FALSE; + + return(result->val); + + case TEOF: - clearerr(rdrport); - error("Premature end of file.", FALSE); +++ errorh(Vermisc,"Premature end of file after ", +++ nil,FALSE,0,result->val); + + } + + if(rbktf) { + + if(inlbkt) + + rbktf = FALSE; + + return(result->val); + + } + + } + + case TSCA: + + return(atomval); + + case TEOF: + + return(eofa); + + case TMAC: + + macrox(); + + return(atomval); + + case TSPL: + + macrox(); + + if((work = atomval)!=nil) { - if(TYPE(work)==DTPR && work->cdr==nil) - return(work->car); +++ if(TYPE(work)==DTPR && work->d.cdr==nil) +++ return(work->d.car); + + else + + errorh(Vermisc, + +"Improper value returned from splicing macro at top-level",nil,FALSE,9,work); + + } + + code = Iratom(); + + goto top; + + /* return(readrx(Iratom())); */ + + case TSQ: + + result = np; + + protect(newdot()); - (work = result->val)->car = quota; - work = work->cdr = newdot(); - work->car = readrx(Iratom()); +++ (work = result->val)->d.car = quota; +++ work = work->d.cdr = newdot(); +++ work->d.car = readrx(Iratom()); + + return(result->val); + + default: - return(error("Readlist error",FALSE)); +++ return(errorh(Vermisc,"Readlist error, code ",nil,FALSE,0,inewint(code))); + + } + +} + +macrox() + +{ + + lispval Lapply(); + + + + snpand(0); + + lbot = np; + + protect(Iget(atomval,macro)); + + protect(nil); + + atomval = Lapply(); +++ chkrtab(Vreadtable->a.clb); /* the macro could have changed +++ the readtable +++ */ + + return; + +} + + + + + + + +/* ratomr ***************************************************************/ + +/* this routine returns a pointer to an atom read in from the port given*/ + +/* by the first argument */ + +lispval + +ratomr(useport) + +register FILE *useport; + +{ + + rdrport = useport; + + switch(Iratom()) + + { + + case TEOF: + + return(eofa); + + case TSQ: + + case TRPARA: + + case TLPARA: + + case TLBKT: + + case TPERD: + + strbuf[1]=0; + + return(getatom()); + + default: + + return(atomval); + + } + +} + +Iratom() + +{ + + register FILE *useport = rdrport; + + register char c, marker, *name; + + extern lispval finatom(), calcnum(), getnum(); + + char positv = TRUE; + + int code; + + int strflag = FALSE; + + + + name = strbuf; + + + +again: c = getc(useport) & 0177; + + *name = c; + + + + switch(ctable[c] & 0377) { + + + + default: goto again; + + + + case VNUM: + + + + case VSIGN: *name++ = c; + + atomval = (getnum(name)); + + return(TSCA); + + + + case VESC: + + dbqflag = TRUE; + + *name++ = getc(useport) & 0177; + + atomval = (finatom(name)); + + return(TSCA); + + + + case VCHAR: + + *name++ = c; + + atomval = (finatom(name)); + + return(TSCA); + + + + case VLPARA: return(TLPARA); + + + + case VRPARA: return(TRPARA); + + - case VPERD: c = peekc(useport); +++ case VPERD: c = peekc(useport) & 0177; + + if(VNUM!=ctable[c]) +++ { if(SEPMASK & ctable[c]) + + return(TPERD); +++ else { *name++ = '.'; /* this period begins an atm */ +++ atomval = finatom(name); +++ return(TSCA); +++ } +++ } + + *name++ = '.'; + + mantisfl = 1; + + atomval = (getnum(name)); + + return(TSCA); + + + + case VLBRCK: return(TLBKT); + + + + case VRBRCK: rbktf = TRUE; + + return(TRPARA); + + + + case VEOF: /*printf("returning eof atom\n");*/ +++ clearerr(useport); + + return(TEOF); + + + + case VSQ: return(TSQ); + + + + case VSD: strflag = TRUE; + + case VDQ: name = strbuf; + + marker = c; + + while ((c = getc(useport)) != marker) { + + - if(VESC==ctable[c]) c = getc(useport); +++ if(VESC==ctable[c]) c = getc(useport) & 0177; + + *name++ = c; + + if (name >= endstrb) + + error("ATOM TOO LONG",FALSE); + + if (feof(useport)) { + + clearerr(useport); - error("EOF ecountered while reading atom", FALSE); +++ error("EOF encountered while reading atom", FALSE); + + } + + } + + *name = NULL_CHAR; + + if(strflag) + + atomval = (lispval) inewstr(strbuf); + + else + + atomval = (getatom(name)); + + return(TSCA); + + - case VERR: if (c == '\0') goto same; /* null pname */ +++ case VERR: if (c == '\0') +++ { +++ fprintf(stderr,"[read: null read and ignored]\n"); +++ goto again; /* null pname */ +++ } + + fprintf(stderr,"%c (%o): ",c,(int) c); + + error("ILLEGAL CHARACTER IN ATOM",TRUE); + + + + case VSPL: + + code = TSPL; + + goto same; + + case VMAC: + + code = TMAC; + + goto same; + + case VSCA: + + code = TSCA; + + same: + + strbuf[0] = c; + + strbuf[1] = 0; + + atomval = (getatom()); + + return(code); + + } + +} + + + +#define push(); if(name==endstrb) error("Int too long",FALSE); else *name++=c; + +#define next() (stats = ctable[c=getc(useport) & 0177]) + + + +lispval + +getnum(name) + +register char *name; + +{ + + register char c; + + register lispval result; + + register FILE *useport=rdrport; + + char stats; + + double realno; + + extern lispval finatom(), calcnum(), newdoub(), dopow(); + + + + if(mantisfl) { + + mantisfl = 0; + + next(); + + goto mantissa; + + } + + while(VNUM==next()) { + + push(); /* recognize [0-9]*, in "ex" parlance */ + + } + + if(stats==VPERD) { + + push(); /* continue */ + + } else if(stats & SEPMASK) { + + ungetc(c,useport); - return(calcnum(strbuf,name,ibase->clb->i)); +++ return(calcnum(strbuf,name,ibase->a.clb->i)); + + } else if(c=='^') { + + push(); - return(dopow(name,ibase->clb->i)); +++ return(dopow(name,ibase->a.clb->i)); + + } else if(c=='_') { + + push(); + + return(dopow(name,2)); - } else{ +++ } else if(c=='e' || c=='E' || c=='d' ||c=='D') { +++ goto expt; +++ } else { + + ungetc(c,useport); + + return(finatom(name)); + + } + + /* at this point we have [0-9]*\. , which might + + be a decimal int or the leading part of a + + float */ + + if(next()!=VNUM) { + + if(c=='e' || c=='E' || c=='d' ||c=='D') + + goto expt; + + else if(c=='^') { + + push(); - return(dopow(name,ibase->clb->i)); +++ return(dopow(name,ibase->a.clb->i)); + + } else if(c=='_') { + + push(); + + return(dopow(name,2)); + + } else { + + /* Here we have 1.x where x not num, not sep */ + + /* Here we have decimal int. NOT FORTRAN! */ + + ungetc(c,useport); + + return(calcnum(strbuf,name-1,10)); + + } + + } + +mantissa: + + do { + + push(); + + } while (VNUM==next()); + + /* Here we have [0-9]*\.[0-9]* */ + + if(stats & SEPMASK) + + goto last; + + else if(c!='e' && c!='E' && c!='d' && c!='D') { + + ungetc(c,useport); + + goto verylast; + + } + +expt: push(); + + next(); + + if(c=='+' || c =='-') { + + push(); + + next(); + + } + + while (VNUM==stats) { + + push(); + + next(); + + } + +last: ungetc(c,useport); + + if(! (stats & SEPMASK) ) + + return(finatom(name)); + + + +verylast: + + *name=0; + + sscanf(strbuf,"%F",&realno); + + (result = newdoub())->r = realno; + + return(result); + +} + + + +lispval + +dopow(part2,base) + +lispval base; - char *part2; +++register char *part2; + +{ + + register char *name = part2; - register char c; + + register FILE *useport = rdrport; + + register int power; + + register struct argent *lbot, *np; - char stats; +++ char stats,c; + + char *end1 = part2 - 1; lispval Ltimes(); + + + + while(VNUM==next()) { + + push(); + + } + + if(c!='.') { + + ungetc(c,useport); + + } + + if(c!='.' && !(stats & SEPMASK)) { + + return(finatom(name)); + + } + + lbot = np; + + np++->val = inewint(base); + + /* calculate "mantissa"*/ + + if(*end1=='.') + + np++->val = calcnum(strbuf,end1-1,10); + + else - np++->val = calcnum(strbuf,end1,ibase->clb->i); +++ np++->val = calcnum(strbuf,end1,ibase->a.clb->i); + + + + /* calculate exponent */ + + if(c=='.') + + power = calcnum(part2,name,10)->i; + + else - power = calcnum(part2,name,ibase->clb->i)->i; +++ power = calcnum(part2,name,ibase->a.clb->i)->i; + + while(power-- > 0) + + lbot[1].val = Ltimes(); + + return(lbot[1].val); + +} + + + + + +lispval + +calcnum(strbuf,name,base) + +char *name; + +char *strbuf; + +{ + + register char *p; + + register lispval result, temp; + + int negflag = 0; + + + + temp = rdrsdot; /* initialize sdot cell */ - temp->CDR = nil; +++ temp->s.CDR = nil; + + temp->i = 0; + + p = strbuf; + + if(*p=='+') p++; + + else if(*p=='-') {negflag = 1; p++;} + + *name = 0; + + if(p>=name) return(getatom()); + + + + for(;p < name; p++) + + dmlad(temp,base,*p-'0'); + + if(negflag) + + dmlad(temp,-1,0); + + - if(temp->CDR==0) { +++ if(temp->s.CDR==0) { + + result = inewint(temp->i); + + return(result); + + } else { + + (result = newsdot())->i = temp->i; - result->CDR = temp->CDR; - temp->CDR = 0; +++ result->s.CDR = temp->s.CDR; +++ temp->s.CDR = 0; + + } + + return(result); + +} + +lispval + +finatom(name) + +register char *name; + +{ + + extern int uctolc; + + register FILE *useport = rdrport; + + register char c, stats; + + register char *savenm; + + savenm = name - 1; /* remember start of name */ + + while(!(next()&SEPMASK)) { + + + + if(stats == VESC) c = getc(useport) & 0177; + + *name++=c; + + if (name >= endstrb) + + error("ATOM TOO LONG",FALSE); + + } + + *name = NULL_CHAR; + + ungetc(c,useport); + + if (uctolc) for(; *savenm ; savenm++) + + if( isupper(*savenm) ) *savenm = tolower(*savenm); + + return(getatom()); + +} + + + +/* printr ***************************************************************/ + +/* prints the first argument onto the port specified by the second */ +++ +++/* +++ * Last modified Mar 21, 1980 for hunks +++ */ +++ + +printr(a,useport) + +register lispval a; + +register FILE *useport; + +{ - register lispval temp; - char strflag = 0; - char Idqc = 0; - +++ register lispval temp; +++ register hsize, i; +++ char strflag = 0; +++ char Idqc = 0; +++ int curprinlength = prinlength; + + + +val_loop: + + if( ! VALID(a) ) - { - error("BAD LISP DATA ENCOUNTERED BY PRINTR",TRUE); - a = badst; - } +++ { +++ /* error("Bad lisp data encountered by printr", TRUE); +++ a = badst; */ +++ printf("",a); +++ return; +++ } + + - switch (TYPE(a)) { +++ switch (TYPE(a)) +++ { + + + + + + case UNBO: fputs("",useport); + + break; + + + + case VALUE: fputs("(ptr to)",useport); + + a = a->l; + + goto val_loop; + + + + case INT: fprintf(useport,"%d",a->i); + + break; + + - case DOUB: fprintf(useport,"%0.16G",a->r); +++ case DOUB: { char buf[64]; +++ lfltpr(buf,a->r); +++ fputs(buf,useport); +++ } +++ break; +++ +++ case PORT: { lispval cp; +++ if((cp = ioname[PN(a->p)]) == nil) +++ fputs("%$unopenedport",useport); +++ else fprintf(useport,"%%%s",cp); +++ } + + break; + + - case PORT: fputs("port",useport); +++ case HUNK2: +++ case HUNK4: +++ case HUNK8: +++ case HUNK16: +++ case HUNK32: +++ case HUNK64: +++ case HUNK128: +++ if(prinlevel == 0) +++ { +++ fputs("%",useport); +++ break; +++ } +++ hsize = 2 << HUNKSIZE(a); +++ fputs("{", useport); +++ prinlevel--; +++ printr(a->h.hunk[0], useport); +++ curprinlength--; +++ for (i=1; i < hsize; i++) +++ { +++ if (a->h.hunk[i] == hunkfree) +++ break; +++ if (curprinlength-- == 0) +++ { +++ fputs(" ...",useport); +++ break; +++ } +++ else +++ { +++ fputs(" ", useport); +++ printr(a->h.hunk[i], useport); +++ } +++ } +++ fputs("}", useport); +++ prinlevel++; + + break; + + + + case ARRAY: fputs("array[",useport); - printr(a->length,useport); +++ printr(a->ar.length,useport); + + fputs("]",useport); + + break; + + - case BCD: fprintf(useport,"#%X-",a->entry); - printr(a->discipline,useport); +++ case BCD: fprintf(useport,"#%X-",a->bcd.entry); +++ printr(a->bcd.discipline,useport); + + break; + + + + case SDOT: pbignum(a,useport); + + break; + + - case DTPR: if(a->car==quota && a->cdr!=nil - && a->cdr->cdr==nil) { +++ case DTPR: if(prinlevel==0) +++ { +++ fputs("&",useport); +++ break; +++ } +++ prinlevel--; +++ if(a->d.car==quota && a->d.cdr!=nil +++ && a->d.cdr->d.cdr==nil) { + + putc('\'',useport); - printr(a->cdr->car,useport); +++ printr(a->d.cdr->d.car,useport); +++ prinlevel++; + + break; + + } + + putc('(',useport); - morelist: printr(a->car,useport); - if ((a = a->cdr) != nil) +++ curprinlength--; +++ morelist: printr(a->d.car,useport); +++ if ((a = a->d.cdr) != nil) + + { +++ if(curprinlength-- == 0) +++ { +++ fputs(" ...",useport); +++ goto out; +++ } + + putc(' ',useport); + + if (TYPE(a) == DTPR) goto morelist; + + fputs(". ",useport); + + printr(a,useport); + + } +++ out: + + fputc(')',useport); +++ prinlevel++; + + break; + + + + case STRNG: strflag = TRUE; + + Idqc = Xsdc; + + + + case ATOM: { + + char *front, *temp; int clean; - temp = front = (strflag ? ((char *) a) : a->pname); +++ temp = front = (strflag ? ((char *) a) : a->a.pname); + + if(Idqc==0) Idqc = Xdqc; + + + + if(Idqc) { + + clean = *temp; + + if (*temp == '-') temp++; + + clean = clean && (ctable[*temp] != VNUM); + + while (clean && *temp) + + clean = (!(ctable[*temp++] & QUTMASK)); - if (clean) +++ if (clean & !strflag) + + fputs(front,useport); + + else { + + putc(Idqc,useport); + + for(temp=front;*temp;temp++) { + + if( *temp==Idqc + + || ctable[*temp] == VESC) + + putc(Xesc,useport); + + putc(*temp,useport); + + } + + putc(Idqc,useport); + + } + + + + } else { + + register char *cp = front; + + + + if(ctable[*cp]==VNUM) + + putc(Xesc,useport); + + for(; *cp; cp++) { + + if(ctable[*cp]& QUTMASK) + + putc(Xesc,useport); + + putc(*cp,useport); + + } + + + + } + + + + } + + } + +} + + +++lfltpr(buf,val) /* lisp floating point printer */ +++char *buf; +++double val; +++{ +++ register char *cp1; +++ +++ sprintf(buf,"%.16G",val); +++ for(cp1 = buf; *cp1; cp1++) +++ if(*cp1=='.'|| *cp1=='E') return; +++ +++ /* if we are here, there was no dot, so the number was +++ an integer. Furthermore, cp1 already points to the +++ end of the string. */ +++ +++ *cp1++ = '.'; +++ *cp1++ = '0'; +++ *cp1++ = 0; +++} +++ +++ + +/* dmpport ****************************************************************/ + +/* outputs buffer indicated by first argument whether full or not */ +++ + +dmpport(useport) + +register lispval useport; + + { + + fflush(useport); + +} + + + +/* protect and unprot moved to eval.c (whr) */ diff --cc usr/src/cmd/lisp/lam1.c index 0000000000,66595b350c,0000000000..1f21acc108 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam1.c +++ b/usr/src/cmd/lisp/lam1.c @@@@ -1,0 -1,668 -1,0 +1,866 @@@@ +++static char *sccsid = "@(#)lam1.c 34.3 10/24/80"; + + + +# include "global.h" + +# include + +# include "chkrtab.h" + +/**************************************************************************/ + +/* */ + +/* file: ccdfns.i */ + +/* contents: LISP functions coded in C */ + +/* */ + +/* These include LISP primitives, numeric and boolean functions and */ + +/* predicates, some list-processing functions, i/o support functions */ + +/* and control flow functions (e.g. cont, break). */ + +/* There are two types of functions: lambda (prefixed "L") and nlambda */ + +/* (prefixed "N"). */ + +/* Lambda's all call chkarg to insure that at least the minimum number */ + +/* of necessary arguments are on the namestack. */ + +/* All functions take their arguments from the namestack in a read- */ + +/* only manner, and return their results via the normal C value */ + +/* return mechanism. */ + +/* */ + + - - + +lispval + +Leval() + +{ + + register lispval temp; + + - chkarg(1); +++ chkarg(1,"eval"); + + temp = lbot->val; + + return(eval(temp)); + +} + + + +lispval + +Lxcar() + +{ register int typ; + + register lispval temp, result; + + - chkarg(1); +++ chkarg(1,"xcar"); + + temp = lbot->val; - if (((typ = TYPE(temp)) == DTPR) || (typ == ATOM)) - return(temp -> car); +++ if (((typ = TYPE(temp)) == DTPR) || (typ == ATOM) || HUNKP(temp)) +++ return(temp->d.car); + + else if(typ == SDOT) { + + result = inewint(temp->i); + + return(result); + + } else if(Schainp!=nil && typ==ATOM) + + return(nil); + + else - return(error("BAD ARG TO CAR",FALSE)); +++ return(error("Bad arg to car",FALSE)); + + + +} + + + +lispval + +Lxcdr() + +{ register int typ; + + register lispval temp, result; + + - chkarg(1); +++ chkarg(1,"xcdr"); + + temp = lbot->val; + + if(temp==nil) return (nil); + + - if ((typ = TYPE(temp)) == DTPR) - return(temp -> cdr); +++ if (((typ = TYPE(temp)) == DTPR) || HUNKP(temp)) +++ return(temp->d.cdr); + + else if(typ==SDOT) { - if(temp->CDR==0) return(nil); - return(temp->CDR); +++ if(temp->s.CDR==0) return(nil); +++ return(temp->s.CDR); + + } else if(Schainp!=nil && typ==ATOM) + + return(nil); + + else - return(error("BAD ARG TO CDR",FALSE)); +++ return(error("Bad arg to cdr", FALSE)); + +} + + + +lispval + +cxxr(as,ds) + +register int as,ds; + +{ + + + + register lispval temp, temp2; + + int i, typ; + + lispval errorh(); + + - chkarg(1); +++ chkarg(1,"c{ad}+r"); + + temp = lbot->val; + + + + for( i=0 ; i cdr; - else if(typ==SDOT) { - if(temp->CDR==0) temp = nil; - else temp = temp->CDR; - } - else if(Schainp!=nil && typ==ATOM) +++ typ = TYPE(temp); +++ if ((typ == DTPR) || HUNKP(temp)) +++ temp = temp->d.cdr; +++ else +++ if(typ==SDOT) +++ { +++ if(temp->s.CDR==0) +++ temp = nil; +++ else +++ temp = temp->s.CDR; +++ } +++ else +++ if(Schainp!=nil && typ==ATOM) + + return(nil); + + else - return(errorh(Vermisc,"BAD ARG TO CDR",nil,FALSE,5,temp)); +++ return(errorh(Vermisc,"Bad arg to cdr",nil,FALSE,5,temp)); + + } + + } + + + + for( i=0 ; i car; +++ typ = TYPE(temp); +++ if ((typ == DTPR) || HUNKP(temp)) +++ temp = temp->d.car; + + else if(typ == SDOT) + + temp2 = inewint(temp->i), temp = temp2; + + else if(Schainp!=nil && typ==ATOM) - return(nil); +++ return(nil); + + else - return(errorh(Vermisc,"BAD ARG TO CAR",nil,FALSE,5,temp)); +++ return(errorh(Vermisc,"Bad arg to car",nil,FALSE,5,temp)); + + } + + } + + + + return(temp); + +} + + - + +lispval + +Lcar() - { return(cxxr(1,0)); - } +++{ return(cxxr(1,0)); } + + + +lispval + +Lcdr() - { return(cxxr(0,1)); - } +++{ return(cxxr(0,1)); } + + + +lispval + +Lcadr() - { return(cxxr(1,1)); - } +++{ return(cxxr(1,1)); } + + + +lispval + +Lcaar() - { return(cxxr(2,0)); - } +++{ return(cxxr(2,0)); } + + + +lispval + +Lc02r() - { return(cxxr(0,2)); /* cddr */ - } +++{ return(cxxr(0,2)); } /* cddr */ + + + +lispval + +Lc12r() - { return(cxxr(1,2)); /* caddr */ - } +++{ return(cxxr(1,2)); } /* caddr */ + + + +lispval + +Lc03r() - { return(cxxr(0,3)); /* cdddr */ - } +++{ return(cxxr(0,3)); } /* cdddr */ + + + +lispval + +Lc13r() - { return(cxxr(1,3)); /* cadddr */ - } +++{ return(cxxr(1,3)); } /* cadddr */ + + + +lispval + +Lc04r() - { return(cxxr(0,4)); /* cddddr */ - } +++{ return(cxxr(0,4)); } /* cddddr */ + + + +lispval + +Lc14r() - { return(cxxr(1,4)); /* caddddr */ - } +++{ return(cxxr(1,4)); } /* caddddr */ + + - /************************* - * - * (nthelem num list) - * returns the num'th element of the list, by doing a caddddd...ddr - * where there are num-1 d's - * if num<=0 or greater than the length of the list, we return nil - ******************************************************/ +++/* +++ * +++ * (nthelem num list) +++ * +++ * Returns the num'th element of the list, by doing a caddddd...ddr +++ * where there are num-1 d's. If num<=0 or greater than the length of +++ * the list, we return nil. +++ * +++ */ + + + +lispval + +Lnthelem() + +{ + + register lispval temp; + + register int i; + + - chkarg(2); +++ chkarg(2,"nthelem"); + + + + if( TYPE(temp = lbot->val) != INT) + + return (error ("First arg to nthelem must be a fixnum",FALSE)); + + + + i = temp->i; /* pick up the first arg */ + + + + if( i <= 0) return(nil); + + + + ++lbot; /* fix lbot for call to cxxr() 'cadddd..r' */ + + temp = cxxr(1,i-1); + + --lbot; + + + + return(temp); + +} + + - - - - + +lispval + +Lscons() + +{ + + register struct argent *argp = lbot; + + register lispval retp, handy; + + register int typ; + + - chkarg(2); +++ chkarg(2,"scons"); + + retp = newsdot(); + + handy = (argp) -> val; + + if(TYPE(handy)!=INT) + + error("First arg to scons must be an int.",FALSE); - retp->I = handy->i; +++ retp->s.I = handy->i; + + handy = (argp+1)->val; + + if(handy==nil) - retp->CDR = (lispval) 0; +++ retp->s.CDR = (lispval) 0; + + else { + + if(TYPE(handy)!=SDOT) - error("Currently you may only link sdots to sdots.",FALSE); - retp->CDR = handy; +++ error("Currently you may only link sdots to sdots.",FALSE); +++ retp->s.CDR = handy; + + } + + return(retp); + +} +++ + +lispval + +Lcons() - { register struct argent *argp; - lispval retp; +++{ +++ register lispval retp; +++ register struct argent *argp; + + - chkarg(2); +++ chkarg(2,"cons"); + + retp = newdot(); - retp -> cdr = ((argp = np-1) -> val); - retp -> car = (--argp) -> val; +++ retp->d.car = ((argp = lbot) -> val); +++ retp->d.cdr = argp[1].val; + + return(retp); + +} + +#define CA 0 + +#define CD 1 + + + +lispval + +rpla(what) + +int what; + +{ register struct argent *argp; + + register int typ; register lispval first, second; + + - chkarg(2); +++ chkarg(2,"rplac[ad]"); + + argp = np-1; + + first = (argp-1)->val; + + while(first==nil) + + first = error("Attempt to rplac[ad] nil.",TRUE); + + second = argp->val; - if (((typ = TYPE(first)) == DTPR) || (typ == ATOM)) { +++ if (((typ = TYPE(first)) == DTPR) || (typ == ATOM) || HUNKP(first)) { + + if (what == CA) - first->car = second; +++ first->d.car = second; + + else - first->cdr = second; +++ first->d.cdr = second; + + return(first); + + } + + if (typ==SDOT) { + + if(what == CA) { + + typ = TYPE(second); + + if(typ!=INT) error("Rplacca of a bignum will only replace INTS",FALSE); - first->i = second->i; +++ first->s.I = second->i; + + } else { + + if(second==nil) - first->CDR = (lispval) 0; +++ first->s.CDR = (lispval) 0; + + else - first->CDR = second; +++ first->s.CDR = second; + + } + + return(first); + + } - return(error("BAD ARG TO RPLA",FALSE)); +++ return(error("Bad arg to rpla",FALSE)); + +} + +lispval + +Lrplaca() + +{ return(rpla(CA)); } + + + +lispval + +Lrplacd() + +{ return(rpla(CD)); } + + + + + +lispval + +Leq() + +{ + + register struct argent *mynp = lbot + AD; + + int itemp, flag; + + - chkarg(2); +++ chkarg(2,"eq"); + + if(mynp->val==(mynp+1)->val) return(tatom); + + return(nil); + +} + + + + + + + +lispval + +Lnull() - { chkarg(1); +++{ chkarg(1,"null"); + + return ((lbot->val == nil) ? tatom : nil); + +} + + + + + + + +/* Lreturn **************************************************************/ + +/* Returns the first argument - which is nill if not specified. */ +++ + +Lreturn() + + { - chkarg(1); +++ snpand(0); +++ if(lbot==np) protect (nil); + + contval = lbot->val; + + reset(BRRETN); + + } + + + + + +/* Lretbrk **************************************************************/ + +/* The first argument must be an integer and must be in the range */ + +/* -1 .. -depth. */ + +lispval + +Lretbrk() + + { + + lispval number; + + register level; + + - - chkarg(1); +++ snpand(1); +++ if(lbot==np) protect (nil); + + number = lbot->val; + + if (TYPE(number) != INT) + + level = -1; + + else + + level = number->i; + + if(level < 0) + + level += depth; + + contval = (lispval) level; + + if (level < depth) + + reset(BRRETB); + + return(nil); + +} + + + + + + + +lispval + +Linfile() + +{ + + FILE *port; + + register lispval name; +++ int typ; + + snpand(1); + + - chkarg(1); +++ chkarg(1,"infile"); + + name = lbot->val; - while (TYPE(name)!=ATOM) - name = error("Please supply atom name for port.",TRUE); +++loop: +++ name = verify(name,"infile: file name must be atom or string"); + + /* return nil if file couldnt be opened - if ((port = fopen(name->pname,"r")) == NULL) return(nil); */ +++ if ((port = fopen((char *)name,"r")) == NULL) return(nil); */ + + - while ((port = fopen(name->pname,"r")) == NULL) +++ if ((port = fopen((char *)name,"r")) == NULL) { + + name = errorh(Vermisc,"Unable to open file for reading.",nil,TRUE,31,name); - - return((lispval)(xports + (port - _iob))); +++ goto loop; +++ } +++ ioname[PN(port)] = (lispval) inewstr(name); /* remember name */ +++ return(P(port)); + +} + + + +lispval + +Loutfile() + +{ + + FILE *port; register lispval name; + + - chkarg(1); +++ chkarg(1,"outfile"); + + name = lbot->val; - while (TYPE(name)!=ATOM) - name = error("Please supply atom name for port.",TRUE); - while ((port = fopen(name->pname,"w")) == NULL) +++loop: +++ name = verify(name,"Please supply atom or string name for port."); +++ if ((port = fopen(name,"w")) == NULL) { + + name = errorh(Vermisc,"Unable to open file for writing.",nil,TRUE,31,name); - return((lispval)(xports + (port - _iob))); +++ goto loop; +++ } +++ ioname[PN(port)] = (lispval) inewstr(name); +++ return(P(port)); + +} +++ + +lispval + +Lterpr() + +{ + + FILE *port; + + - chkarg(1); - port = okport(lbot->val,okport(Vpoport->clb,stdout)); +++ snpand(0); +++ if(lbot==np) protect (nil); +++ port = okport(lbot->val,okport(Vpoport->a.clb,stdout)); + + putc('\n',port); + + fflush(port); + + return(nil); + +} +++ + +lispval + +Lclose() + +{ + + lispval port; + + + + if(lbot==np) + + port = error("Close requires one argument of type port",TRUE); + + port = lbot->val; + + if((TYPE(port))==PORT) fclose(port->p); +++ ioname[PN(port->p)] = nil; + + return(tatom); + +} + + + +lispval + +Lnwritn() + +{ + + register FILE *port; + + register value; + + - chkarg(1); - port = okport(lbot->val,okport(Vpoport->clb,stdout)); +++ snpand(2); +++ if(lbot==np) protect (nil); +++ port = okport(lbot->val,okport(Vpoport->a.clb,stdout)); + + value = port->_ptr - port->_base; + + return(inewint(value)); + +} + + + +lispval + +Ldrain() + +{ + + register FILE *port; + + register int iodes; + + struct sgttyb arg; + + - chkarg(1); - port = okport(lbot->val, okport(Vpoport->clb,stdout)); +++ snpand(2); +++ if(lbot==np) protect (nil); +++ port = okport(lbot->val, okport(Vpoport->a.clb,stdout)); + + if(port->_flag & _IOWRT) { + + fflush(port); + + return(nil); + + } + + if(! port->_flag & _IOREAD) return(nil); + + port->_cnt = 0; + + port->_ptr = port->_base; + + iodes = fileno(port); + + if(gtty(iodes,&arg) != -1) stty(iodes,&arg); + + return((lispval)(xports + (port - _iob))); + +} +++ + +lispval + +Llist() + +{ + + /* added for the benefit of mapping functions. */ + + register struct argent *ulim, *namptr; + + register lispval temp, result; + + register struct argent *lbot, *np; + + + + ulim = np; + + namptr = lbot + AD; + + temp = result = (lispval) np; + + protect(nil); + + for(; namptr < ulim;) { + + temp = temp->l = newdot(); - temp->car = (namptr++)->val; +++ temp->d.car = (namptr++)->val; + + } + + temp->l = nil; + + return(result->l); + +} + + + +lispval + +Lnumberp() + +{ - chkarg(1); +++ chkarg(1,"numberp"); + + switch(TYPE(lbot->val)) { + + case INT: case DOUB: case SDOT: + + return(tatom); + + } + + return(nil); + +} + + + +lispval + +Latom() + +{ - chkarg(1); - if(TYPE(lbot->val)==DTPR) +++ register struct argent *lb = lbot; +++ chkarg(1,"atom"); +++ if(TYPE(lb->val)==DTPR || (HUNKP(lb->val))) + + return(nil); + + else + + return(tatom); + +} +++ + +lispval + +Ltype() + +{ - chkarg(1); +++ chkarg(1,"type"); + + switch(TYPE(lbot->val)) { + + case INT: + + return(int_name); + + case ATOM: + + return(atom_name); + + case SDOT: + + return(sdot_name); + + case DOUB: + + return(doub_name); + + case DTPR: + + return(dtpr_name); + + case STRNG: + + return(str_name); + + case ARRAY: + + return(array_name); + + case BCD: + + return(funct_name); +++ +++ case HUNK2: +++ return(hunk_name[0]); +++ case HUNK4: +++ return(hunk_name[1]); +++ case HUNK8: +++ return(hunk_name[2]); +++ case HUNK16: +++ return(hunk_name[3]); +++ case HUNK32: +++ return(hunk_name[4]); +++ case HUNK64: +++ return(hunk_name[5]); +++ case HUNK128: +++ return(hunk_name[6]); +++ + + case VALUE: + + return(val_name); + + case PORT: - return(matom("port")); /* fix this when name exists */ +++ return(port_name); + + } + + return(nil); + +} + + + +lispval + +Ldtpr() + +{ - chkarg(1); - return(typred(DTPR,lbot->val)); +++ chkarg(1,"dtpr"); +++ return(typred(DTPR, lbot->val)); + +} + + + +lispval + +Lbcdp() + +{ - chkarg(1); - return(typred(BCD,lbot->val)); +++ chkarg(1,"bcdp"); +++ return(typred(BCD, lbot->val)); + +} + + + +lispval + +Lportp() + +{ - chkarg(1); - return(typred(PORT,lbot->val)); +++ chkarg(1,"portp"); +++ return(typred(PORT, lbot->val)); + +} + + + +lispval + +Larrayp() + +{ - chkarg(1); - return(typred(ARRAY,lbot->val)); +++ chkarg(1,"arrayp"); +++ return(typred(ARRAY, lbot->val)); +++} +++ +++/* +++ * (hunkp 'g_arg1) +++ * Returns t if g_arg1 is a hunk, otherwise returns nil. +++ */ +++ +++lispval +++Lhunkp() +++{ +++ chkarg(1,"hunkp"); +++ if (HUNKP(lbot->val)) +++ return(tatom); /* If a hunk, return t */ +++ else +++ return(nil); /* else nil */ + +} +++ + +lispval + +Lset() + +{ + + lispval varble; + + snpand(0); + + - chkarg(2); +++ chkarg(2,"set"); + + varble = lbot->val; + + switch(TYPE(varble)) + + { - case ATOM: return(varble->clb = lbot[1].val); +++ case ATOM: return(varble->a.clb = lbot[1].val); + + + + case VALUE: return(varble->l = lbot[1].val); + + } + + + + error("IMPROPER USE OF SET",FALSE); + +} +++ + +lispval + +Lequal() + +{ - chkarg(2); +++ register lispval first, second; +++ register type1, type2; +++ register struct argent *lbot, *np; +++ lispval Lsub(),Lzerop(), *stack(), unstack(), *sp(); +++ lispval *oldsp; int mustloop = FALSE, result; +++ chkarg(2,"equal"); +++ +++ +++ if(lbot->val==lbot[1].val) return(tatom); +++ +++ for((oldsp=sp(), stack(lbot->val,lbot[1].val)); +++ oldsp > sp();) { +++ +++ first = unstack(); second = unstack(); +++ again: +++ if(first==second) continue; +++ +++ type1=TYPE(first); type2=TYPE(second); +++ if(type1!=type2) { +++ if((type1==SDOT&&type2==INT)||(type1==INT&&type2==SDOT)) +++ goto dosub; +++ return(nil); +++ } +++ switch(type1) { +++ case DTPR: +++ stack(first->d.cdr,second->d.cdr); +++ first = first->d.car; second = second->d.car; +++ goto again; +++ case DOUB: +++ if(first->r!=second->r) +++ return(nil); +++ continue; +++ case INT: +++ if(first->i!=second->i) +++ return(nil); +++ continue; +++ dosub: +++ case SDOT: +++ lbot = np; +++ np++->val = first; +++ np++->val = second; +++ lbot->val = Lsub(); +++ if(TYPE(lbot->val)!=INT || lbot->val->i!=0) +++ return(nil); +++ np = lbot; +++ continue; +++ case VALUE: +++ if(first->l!=second->l) +++ return(nil); +++ continue; +++ case STRNG: +++ if(strcmp(first,second)!=0) +++ return(nil); +++ continue; +++ +++ default: +++ return(nil); +++ } +++ } +++ return(tatom); +++} +++lispval +++oLequal() +++{ +++ chkarg(2,"equal"); + + + + if( lbot[1].val == lbot->val ) return(tatom); + + if(Iequal(lbot[1].val,lbot->val)) return(tatom); else return(nil); + +} + + + +Iequal(first,second) + +register lispval first, second; + +{ + + register type1, type2; + + register struct argent *lbot, *np; + + lispval Lsub(),Lzerop(); + + + + if(first==second) + + return(1); + + type1=TYPE(first); + + type2=TYPE(second); + + if(type1!=type2) { + + if((type1==SDOT&&type2==INT)||(type1==INT&&type2==SDOT)) + + goto dosub; + + return(0); + + } + + switch(type1) { + + case DTPR: + + return( - Iequal(first->car,second->car) && - Iequal(first->cdr,second->cdr) ); +++ Iequal(first->d.car,second->d.car) && +++ Iequal(first->d.cdr,second->d.cdr) ); + + case DOUB: + + return(first->r==second->r); + + case INT: + + return( (first->i==second->i)); + +dosub: + + case SDOT: + + lbot = np; + + np++->val = first; + + np++->val = second; + + lbot->val = Lsub(); + + np = lbot + 1; - return(Lzerop()!=nil); +++ return(TYPE(lbot->val)==INT&& lbot->val->i==0); + + case VALUE: + + return( first->l==second->l ); + + case STRNG: + + return(strcmp(first,second)==0); + + } + + return(0); + +} +++lispval +++Zequal() +++{ +++ register lispval first, second; +++ register type1, type2; +++ register struct argent *lbot, *np; +++ lispval Lsub(),Lzerop(), *stack(), unstack(), *sp(); +++ lispval *oldsp; int mustloop = FALSE, result; +++ chkarg(2,"equal"); +++ +++ +++ if(lbot->val==lbot[1].val) return(tatom); +++ +++ for((oldsp=sp(), stack(lbot->val,lbot[1].val)); +++ oldsp > sp();) { +++ +++ first = unstack(); second = unstack(); +++ again: +++ if(first==second) continue; +++ +++ type1=TYPE(first); type2=TYPE(second); +++ if(type1!=type2) { +++ if((type1==SDOT&&type2==INT)||(type1==INT&&type2==SDOT)) +++ goto dosub; +++ return(nil); +++ } +++ switch(type1) { +++ case DTPR: +++ stack(first->d.cdr,second->d.cdr); +++ first = first->d.car; second = second->d.car; +++ goto again; +++ case DOUB: +++ if(first->r!=second->r) +++ return(nil); +++ continue; +++ case INT: +++ if(first->i!=second->i) +++ return(nil); +++ continue; +++ dosub: +++ case SDOT: +++ lbot = np; +++ np++->val = first; +++ np++->val = second; +++ lbot->val = Lsub(); +++ if(TYPE(lbot->val)!=INT || lbot->val->i!=0) +++ return(nil); +++ np = lbot; +++ continue; +++ case VALUE: +++ if(first->l!=second->l) +++ return(nil); +++ continue; +++ case STRNG: +++ if(strcmp(first,second)!=0) +++ return(nil); +++ continue; +++ } +++ } +++ return(tatom); +++} + + + +lispval + +Lprint() + +{ - chkarg(2); - chkrtab(Vreadtable->clb); - printr(lbot->val,okport(lbot[1].val,okport(Vpoport->clb,poport))); +++ extern int prinlevel,prinlength; +++ +++ snpand(0); +++ if(np-lbot==1) protect(nil); +++ chkarg(2,"print"); +++ chkrtab(Vreadtable->a.clb); +++ if(TYPE(Vprinlevel->a.clb) == INT) +++ { +++ prinlevel = Vprinlevel->a.clb->i; +++ } +++ else prinlevel = -1; +++ if(TYPE(Vprinlength->a.clb) == INT) +++ { +++ prinlength = Vprinlength->a.clb->i; +++ } +++ else prinlength = -1; +++ printr(lbot->val,okport(lbot[1].val,okport(Vpoport->a.clb,poport))); + + return(nil); + +} + + - FILE * - okport(arg,proper) - lispval arg; - FILE *proper; - { - if(TYPE(arg)!=PORT) - return(proper); - else - return(arg->p); - } +++/* patom does not use prinlevel or prinlength */ + +lispval + +Lpatom() + +{ + + register lispval temp; +++ register int typ; + + FILE *port; +++ extern int prinlevel,prinlength; + + - chkarg(2); - temp = Vreadtable->clb; +++ snpand(2); +++ if(np-lbot==1) protect(nil); +++ chkarg(2,"patom"); +++ temp = Vreadtable->a.clb; + + chkrtab(temp); - port = okport(lbot[1].val, okport(Vpoport->clb,stdout)); - if ((TYPE((temp = (lbot)->val)))!=ATOM) - printr(temp, port); +++ port = okport(lbot[1].val, okport(Vpoport->a.clb,stdout)); +++ if ((typ= TYPE((temp = (lbot)->val))) == ATOM) +++ fputs(temp->a.pname, port); +++ else if(typ == STRNG) +++ fputs(temp,port); + + else - fputs(temp->pname, port); +++ { +++ printr(temp, port); +++ } + + return(temp); + +} + + + +/* + + * (pntlen thing) returns the length it takes to print out + + * an atom or number. + + */ + + + +lispval + +Lpntlen() + +{ + + register lispval temp; + + return(inewint(Ipntlen())); + +} + +Ipntlen() + +{ + + register lispval temp; + + register char *handy; + + + + temp = np[-1].val; + +loop: switch(TYPE(temp)) { + + + + case ATOM: - handy = temp->pname; +++ handy = temp->a.pname; +++ break; +++ +++ case STRNG: +++ handy = (char *) temp; + + break; + + + + case INT: + + sprintf(strbuf,"%d",temp->i); + + handy =strbuf; + + break; + + + + case DOUB: + + sprintf(strbuf,"%g",temp->r); + + handy =strbuf; + + break; + + + + default: + + temp = error("Non atom or number to pntlen\n",TRUE); + + goto loop; + + } + + + + return( strlen(handy)); + +} +++#undef okport +++FILE * +++okport(arg,proper) +++lispval arg; +++FILE *proper; +++{ +++ if(TYPE(arg)!=PORT) +++ return(proper); +++ else +++ return(arg->p); +++} diff --cc usr/src/cmd/lisp/lam2.c index 0000000000,85607b18e3,0000000000..c136a69500 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam2.c +++ b/usr/src/cmd/lisp/lam2.c @@@@ -1,0 -1,593 -1,0 +1,641 @@@@ +++static char *sccsid = "@(#)lam2.c 34.1 10/3/80"; +++ + +# include "global.h" +++# include + +/* - * (flatsize thing max) returns the smaller of max and the number of chars +++ * (flatc thing max) returns the smaller of max and the number of chars + + * required to print thing linearly. +++ * if max argument is not given, we assume the second arg is infinity + + */ + +static flen; /*Internal to this module, used as a running counter of flatsize*/ + +static fmax; /*used for maximum for quick reference */ + + + +lispval + +Lflatsi() + +{ + + register lispval current, temp; + + register struct argent *mylbot = lbot; + + snpand(3); /* fixup entry mask */ + + - chkarg(2); - flen = 0; fmax = mylbot[1].val->i; +++ if( np-lbot == 1) fmax = 0x7fffffff; /* biggest integer */ +++ else fmax = mylbot[1].val->i; +++ flen = 0; + + current = mylbot->val; + + protect(nil); /*create space for argument to pntlen*/ + + Iflatsi(current); + + return(inewint(flen)); + +} + +/* - * Iflatsi does the real work of the calculation for flatsize +++ * Iflatsi does the real work of the calculation for flatc + + */ + +Iflatsi(current) + +register lispval current; + +{ + + register lispval handy; + + register int temp; + + + + if(flen > fmax) return(fmax); + + switch(TYPE(current)) { + + + + patom: - case INT: case ATOM: case DOUB: +++ case INT: case ATOM: case DOUB: case STRNG: + + np[-1].val = current; + + flen += Ipntlen(); + + return; + + + + pthing: + + case DTPR: + + flen++; - Iflatsi(current->car); - current = current->cdr; +++ Iflatsi(current->d.car); +++ current = current->d.cdr; + + if(current == nil) { + + flen++; + + return; + + } + + if(flen > fmax) return; + + switch(TYPE(current)) { + + case INT: case ATOM: case DOUB: + + flen += 4; + + goto patom; + + case DTPR: + + goto pthing; + + } + + } + +} + + + + + +#define EADC -1 + +#define EAD -2 + +lispval + +Lread() + +{ return (r(EAD)); } + + + +lispval + +Lratom() + +{ return (r(ATOM)); } + + + +lispval + +Lreadc() + +{ return (r(EADC)); } + + + +#include "chars.h" +++#include "chkrtab.h" + + + +extern char *ctable; + +/* r *********************************************************************/ + +/* this function maps the desired read function into the system-defined */ + +/* reading functions after testing for a legal port. */ + +lispval + +r(op) + +int op; + +{ + + register char c; register lispval result; + + int orlevel; extern int rlevel; + + FILE *ttemp; + + struct nament *oldbnp = bnp; + + snpand(2); + + - chkarg(2); - result = Vreadtable->clb; +++ switch(np-lbot) { +++ case 0: +++ protect(nil); +++ case 1: +++ protect(nil); +++ case 2: break; +++ default: +++ argerr("read or ratom or readc"); +++ } +++ result = Vreadtable->a.clb; +++ chkrtab(result); + + orlevel = rlevel; + + rlevel = 0; - ttemp = okport(Vpiport->clb,stdin); +++ ttemp = okport(Vpiport->a.clb,stdin); + + ttemp = okport(lbot->val,ttemp); + +/*printf("entering switch\n");*/ + + fflush(stdout); /* flush any pending characters */ + + + + switch (op) + + { + + case EADC: rlevel = orlevel; - switch (ctable[c = getc(ttemp)] & 0377) +++ switch (ctable[c = getc(ttemp) & 0177] & 0377) + + { + + case VEOF: + + return(lbot[1].val); + + default: + + strbuf[0] = hash = c; + + strbuf[1] = 0; + + atmlen = 2; + + return((lispval)getatom()); + + } + + case ATOM: rlevel = orlevel; + + result = (ratomr(ttemp)); + + goto out; + + + + case EAD: PUSHDOWN(Vpiport,P(ttemp)); /* rebind Vpiport */ + + result = readr(ttemp); + + out: if(result==eofa) - result = lbot[1].val; +++ { +++ if(sigintcnt > 0) sigcall(SIGINT); +++ result = lbot[1].val; +++ } + + rlevel = orlevel; + + popnames(oldbnp); /* unwind bindings */ + + return(result); + + } + +} + + + +/* Lload *****************************************************************/ + +/* Reads in and executes forms from the specified file. This should */ + +/* really be an nlambda taking multiple arguments, but the error */ + +/* handling gets funny in that case (one file out of several not */ + +/* openable, for instance). */ + +lispval + +Lload() + +{ + + register FILE *port; - register char *p; register lispval ttemp, vtemp; +++ register char *p, *ttemp; register lispval vtemp; + + register struct argent *lbot, *np; + + struct nament *oldbnp = bnp; - int orlevel; +++ int orlevel,typ; + + char longname[100]; + + char *shortname, *end2; + + - chkarg(1); - ttemp = lbot->val; - if(TYPE(ttemp)!=ATOM) return(error("FILENAME MUST BE ATOMIC",FALSE)); +++ chkarg(1,"load"); +++ if((typ = TYPE(lbot->val)) == ATOM) +++ ttemp = lbot->val->a.pname ; /* ttemp will point to name */ +++ else if(typ == STRNG) +++ ttemp = (char *) lbot->val; +++ else +++ return(error("FILENAME MUST BE ATOMIC",FALSE)); + + strcpy(longname,"/usr/lib/lisp/" ); + + for(p = longname; *p; p++); + + shortname = p; - strcpy(p,ttemp->pname); +++ strcpy(p,ttemp); + + for(; *p; p++); + + end2 = p; + + strcpy(p,".l"); + + if ((port = fopen(shortname,"r")) == NULL && + + (port = fopen(longname, "r")) == NULL) { + + *end2 = 0; + + if ((port = fopen(shortname,"r")) == NULL && + + (port = fopen(longname, "r")) == NULL) - error("CAN'T OPEN FILE", FALSE); +++ errorh(Vermisc,"Can't open file: ", +++ nil,FALSE,0,lbot->val); + + } + + orlevel = rlevel; + + rlevel = 0; + + + + if(ISNIL(copval(gcload,CNIL)) && - loading->clb != tatom && +++ loading->a.clb != tatom && + + ISNIL(copval(gcdis,CNIL))) + + gc(CNIL); /* do a gc if gc will be off */ + + + + /* shallow bind the value of lisp atom piport */ + + /* so readmacros will work */ + + PUSHDOWN(Vpiport,P(port)); + + PUSHDOWN(loading,tatom); /* set indication of loading status */ + + + + while ((vtemp = readr(port)) != eofa) { + + eval(vtemp); + + } + + popnames(oldbnp); /* unbind piport, loading */ + + + + rlevel = orlevel; + + fclose(port); + + return(nil); + +} + + + +/* concat ************************************************** + +- + +- use: (concat arg1 arg2 ... ) + +- + +- concatenates the print names of all of its arguments. + +- the arguments may be atoms, integers or real numbers. + +- + +- *********************************************************/ + +lispval + +Iconcat(unintern) + +{ + + register struct argent *temnp; + + register int atmlen; /* Passt auf! atmlen in the external + + sense calculated by newstr */ + + int i; + + lispval cur; +++ char lstrbf[200]; /* local string buffer needed if sdot seen */ + + snpand(2); + + + + atmlen = 0 ; + + strbuf[0] = NULL_CHAR ; + + + + /* loop for each argument */ + + for(temnp = lbot + AD ; temnp < np ; temnp++) + + { + + cur = temnp->val; + + loop: switch(TYPE(cur)) + + { + + case ATOM: + + strcpy(&strbuf[atmlen], ((struct atom *) cur) -> pname) ; + + break; + + +++ case STRNG: +++ strcpy(&strbuf[atmlen], cur); +++ break; +++ + + case INT: + + sprintf(&strbuf[atmlen],"%d",cur->i); + + break; + + + + case DOUB: + + sprintf(&strbuf[atmlen],"%f",cur->f); + + break; + + +++ case SDOT: +++ if(atmlen > 200) error("concat: string buffer overflow",FALSE); +++ strcpy(lstrbf,strbuf); /* save around explode */ +++ lbot = np; +++ protect(cur); /* must explode */ +++ cur= Lexplda(); +++ np = lbot; +++ strcpy(strbuf,lstrbf); +++ for( ; cur != nil ; cur = cur->d.cdr) +++ strbuf[atmlen++] = cur->d.car->a.pname[0]; +++ strbuf[atmlen] = '\0'; +++ break; +++ + + default: + + cur = error("Non atom or number to concat",TRUE); + + goto loop; /* if returns value, try it */ + + } + + atmlen = strlen(strbuf); + + + + } + + + + if(unintern) + + return( (lispval) newatom()); + + else + + return( (lispval) getatom()) ; + +} + +lispval + +Lconcat(){ + + return(Iconcat(FALSE)); + +} + +lispval + +Luconcat(){ + + return(Iconcat(TRUE)); + +} + + + +lispval + +Lputprop() + +{ + + register struct argent *argp = lbot; + + lispval Iputprop(); + + snpand(1); - chkarg(3); +++ chkarg(3,"putprop"); + + return(Iputprop(argp->val,argp[1].val,argp[2].val)); + +} + + + +lispval + +Iputprop(atm,prop,ind) + +register lispval prop, ind, atm; + +{ + + register lispval pptr; + + lispval *tack; /* place to begin property list */ + + lispval errorh(); + + top: + + switch (TYPE(atm)) { + + case ATOM: + + if(atm == nil) tack = &nilplist; - else tack = &(atm->plist); +++ else tack = &(atm->a.plist); + + break; + + case DTPR: - for (pptr = atm->cdr ; pptr != nil ; pptr = pptr->cdr->cdr) - if(TYPE(pptr) != DTPR || TYPE(pptr->cdr) != DTPR) break; +++ for (pptr = atm->d.cdr ; pptr != nil ; pptr = pptr->d.cdr->d.cdr) +++ if(TYPE(pptr) != DTPR || TYPE(pptr->d.cdr) != DTPR) break; + + if(pptr != nil) + + { atm = errorh(Vermisc, + + "putprop: bad disembodied property list", + + nil,TRUE,0,atm); + + goto top; + + } - tack = (lispval *) &(atm->cdr); +++ tack = (lispval *) &(atm->d.cdr); + + break; + + default: + + errorh(Vermisc,"putprop: Bad first argument: ",nil,FALSE,0,atm); + + } + + pptr = *tack; /* start of property list */ + + findit: - for (pptr = *tack ; pptr != nil ; pptr = pptr->cdr->cdr) - if (pptr->car == ind) { - (pptr->cdr)->car = prop; +++ for (pptr = *tack ; pptr != nil ; pptr = pptr->d.cdr->d.cdr) +++ if (pptr->d.car == ind) { +++ (pptr->d.cdr)->d.car = prop; + + return(prop); + + } - else tack = &(pptr->cdr->cdr) ; +++ else tack = &(pptr->d.cdr->d.cdr) ; + + *tack = pptr = newdot(); - pptr->car = ind; - pptr = pptr->cdr = (lispval) newdot(); - pptr->car = prop; +++ pptr->d.car = ind; +++ pptr = pptr->d.cdr = (lispval) newdot(); +++ pptr->d.car = prop; + + return(prop); + +} + + + +/* get from property list + + * there are three routines to accomplish this + + * Lget - lisp callable, the first arg can be a symbol or a disembodied + + * property list. In the latter case we check to make sure it + + * is a real one (as best we can). + + * Iget - internal routine, the first arg must be a symbol, no disembodied + + * plists allowed + + * Igetplist - internal routine, the first arg is the plist to search. + + */ + +lispval + +Lget() + +{ + + register lispval ind, atm; + + register lispval dum1, dum2; + + lispval Igetplist(); + + snpand(2); + + - chkarg(2); +++ chkarg(2,"get"); + + ind = lbot[1].val; + + atm = lbot[0].val; + +top: + + switch(TYPE(atm)) { + + case ATOM: + + if(atm==nil) atm = nilplist; - else atm = atm->plist; +++ else atm = atm->a.plist; + + break; + + + + case DTPR: - for (dum1 = atm->cdr; dum1 != nil; dum1 = dum1->cdr->cdr) +++ for (dum1 = atm->d.cdr; dum1 != nil; dum1 = dum1->d.cdr->d.cdr) + + if((TYPE(dum1) != DTPR) || - (TYPE(dum1->cdr) != DTPR)) break; /* bad prop list */ +++ (TYPE(dum1->d.cdr) != DTPR)) break; /* bad prop list */ + + if(dum1 != nil) + + { atm = errorh(Vermisc, - "putprop: bad disembodied property list", +++ "get: bad disembodied property list", + + nil,TRUE,0,atm); + + goto top; + + } - atm = atm -> cdr; +++ atm = atm->d.cdr; + + break; + + default: + + /* remove since maclisp doesnt treat + + this as an error, ugh + + return(errorh(Vermisc,"get: bad first argument: ", + + nil,FALSE,0,atm)); + + */ + + return(nil); + + } - return(Igetplist(atm,ind)); +++ +++ while (atm != nil) +++ { +++ if (atm->d.car == ind) +++ return ((atm->d.cdr)->d.car); +++ atm = (atm->d.cdr)->d.cdr; +++ } +++ return(nil); + +} + +/* + + * Iget - the first arg must be a symbol. + + */ + + + +lispval + +Iget(atm,ind) + +register lispval atm, ind; + +{ + + lispval Igetplist(); + + + + if(atm==nil) + + atm = nilplist; + + else - atm = atm->plist; +++ atm = atm->a.plist; + + return(Igetplist(atm,ind)); + +} + + + +/* + + * Igetplist + + * pptr is a plist + + * ind is the indicator + + */ + + + +lispval + +Igetplist(pptr,ind) + +register lispval pptr,ind; + +{ + + while (pptr != nil) + + { - if (pptr->car == ind) - return ((pptr->cdr)->car); - pptr = (pptr->cdr)->cdr; +++ if (pptr->d.car == ind) +++ return ((pptr->d.cdr)->d.car); +++ pptr = (pptr->d.cdr)->d.cdr; + + } + + return(nil); + +} + +lispval + +Lgetd() + +{ + + register lispval typ; + + snpand(1); + + - chkarg(1); +++ chkarg(1,"getd"); + + typ = lbot->val; + + if (TYPE(typ) != ATOM) + + errorh(Vermisc, + + "getd: ONLY ATOMS HAVE FUNCTION DEFINITIONS", + + nil, + + FALSE, + + 0, + + typ); - return(typ->fnbnd); +++ return(typ->a.fnbnd); + +} + +lispval + +Lputd() + +{ + + register lispval atom, list; + + register lispval dum1, dum2; + + register struct argent *lbot, *np; + + snpand(2); + + - chkarg(2); +++ chkarg(2,"putd"); + + list = lbot[1].val; + + atom = lbot->val; + + if (TYPE(atom) != ATOM) error("ONLY ATOMS HAVE FUNCTION DEFINITIONS",FALSE); - atom->fnbnd = list; +++ atom->a.fnbnd = list; + + return(list); + +} + + + +/* =========================================================== + +- mapping functions which return a list of the answers + +- mapcar applies the given function to successive elements + +- maplist applies the given function to successive sublists + +- ===========================================================*/ + + + +lispval + +Lmapcrx(maptyp,join) + +int maptyp; /* 0 = mapcar, 1 = maplist */ + +int join; /* 0 = the above, 1 = s/car/can/ */ + +{ + + register struct argent *namptr; + + register index; + + register lispval temp; + + register lispval current; + + register struct argent *lbot; + + register struct argent *np; + + + + struct argent *first, *last; + + int count; + + lispval lists[25], result; + + + + namptr = lbot + 1; + + count = np - namptr; + + if (count <= 0) return (nil); + + /*oldlbot = lbot; /* lbot saved by virtue of entry mask */ + + result = current = (lispval) np; + + protect(nil); /* set up space for returned list */ + + protect(lbot->val); /*copy funarg for call to funcall */ + + lbot = np -1; + + first = np; + + last = np += count; + + for(index = 0; index < count; index++) { + + temp =(namptr++)->val; + + if (TYPE (temp ) != DTPR && temp!=nil) + + error ( "bad list argument to map",FALSE); + + lists[index] = temp; + + } + + for(;;) { + + for(namptr=first,index=0; indexval = temp->car; +++ if(maptyp==0) (namptr++)->val = temp->d.car; + + else (namptr++)->val = temp; + + - lists[index] = temp->cdr; +++ lists[index] = temp->d.cdr; + + } + + if (join == 0) { + + current->l = newdot(); - current->l->car = Lfuncal(); - current = (lispval) ¤t->l->cdr; +++ current->l->d.car = Lfuncal(); +++ current = (lispval) ¤t->l->d.cdr; + + } else { + + current->l = Lfuncal(); + + if ( TYPE ( current -> l) != DTPR && current->l != nil) + + error("bad type returned from funcall inside map",FALSE); + + else while ( current -> l != nil ) - current = (lispval) & (current ->l ->cdr); +++ current = (lispval) & (current ->l ->d.cdr); + + } + + np = last; + + } + +done: if (join == 0)current->l = nil; + + /*lbot = oldlbot;*/ + + return(result->l); + +} + + + +/* ============================ + +- + +- Lmapcar + +- =============================*/ + + + +lispval + +Lmapcar() + +{ + + snpand(0); + + return(Lmapcrx(0,0)); } /* call general routine */ + + + + + +/* ============================ + +- + +- + +- Lmaplist + +- ==============================*/ + + + +lispval + +Lmaplist() + +{ + + snpand(0); + + return(Lmapcrx(1,0)); } /* call general routine */ + + + + + +/* ================================================ + +- mapping functions which return the value of the last function application. + +- mapc and map + +- ===================================================*/ + + + +lispval + +Lmapcx(maptyp) + +int maptyp; /* 0= mapc , 1= map */ + +{ + + register struct argent *namptr; + + register index; + + register lispval temp; + + register lispval result; + + register struct argent *lbot; + + register struct argent *np; + + + + int count; + + struct argent *first; + + lispval lists[25], errorh(); + + + + namptr = lbot + 1; + + count = np - namptr; + + if(count <= 0) return(nil); + + result = lbot[1].val; /*This is what macsyma wants so ... */ + + /*copy funarg for call to funcall */ + + lbot = np; protect((namptr - 1)->val); + + first = np; np += count; + + + + for(index = 0; index < count; index++) { + + temp = (namptr++)->val; + + while(temp!=nil && TYPE(temp)!=DTPR) + + temp = errorh(Vermisc,"Inappropriate list argument to mapc",nil,TRUE,0,temp); + + lists[index] = temp; + + } + + for(;;) { + + for(namptr=first,index=0; indexval = temp->car; +++ (namptr++)->val = temp->d.car; + + else + + (namptr++)->val = temp; - lists[index] = temp->cdr; +++ lists[index] = temp->d.cdr; + + } + + Lfuncal(); + + } + +done: + + return(result); + +} + + + + + +/* ================================== + +- + +- mapc map the car of the lists + +- + +- ==================================*/ + + + +lispval + +Lmapc() + +{ return( Lmapcx(0) ); } + + + + + +/* ================================= + +- + +- map map the cdr of the lists + +- + +- ===================================*/ + + + +lispval + +Lmap() + +{ return( Lmapcx(1) ); } + + + + + +lispval + +Lmapcan() + +{ + + lispval Lmapcrx(); + + + + return ( Lmapcrx ( 0,1 ) ); + +} + + + +lispval + +Lmapcon() + +{ + + lispval Lmapcrx(); + + + + return ( Lmapcrx ( 1,1 ) ); + +} diff --cc usr/src/cmd/lisp/lam3.c index 0000000000,c0c51bfb8d,0000000000..79e37b4ebb mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam3.c +++ b/usr/src/cmd/lisp/lam3.c @@@@ -1,0 -1,504 -1,0 +1,580 @@@@ +++static char *sccsid = "@(#)lam3.c 34.2 10/24/80"; +++ + +# include "global.h" + +lispval + +Lalfalp() + +{ + + register lispval first, second; + + register struct argent *inp; + + snpand(3); /* clobber save mask */ + + - chkarg(2); +++ chkarg(2,"alphalessp"); + + inp = lbot; + + first = (inp)->val; + + second = (inp+1)->val; + + if( (TYPE(first))!=ATOM || (TYPE(second))!=ATOM) + + error("alphalessp expects atoms"); - if(strcmp(first->pname,second->pname) <= 0) +++ if(strcmp(first->a.pname,second->a.pname) <= 0) + + return(tatom); + + else + + return(nil); + +} + + + +lispval + +Lncons() + +{ + + register lispval handy; + + snpand(1); /* clobber save mask */ + + - chkarg(1); +++ chkarg(1,"ncons"); + + handy = newdot(); - handy -> cdr = nil; - handy -> car = lbot->val; +++ handy->d.cdr = nil; +++ handy->d.car = lbot->val; + + return(handy); + +} + +lispval + +Lzerop() + +{ + + register lispval handy; + + snpand(1); /* clobber save mask */ + + - chkarg(1); +++ chkarg(1,"zerop"); + + handy = lbot->val; + + switch(TYPE(handy)) { + + case INT: + + return(handy->i==0?tatom:nil); + + case DOUB: + + return(handy->r==0.0?tatom:nil); + + } + + return(nil); + +} + +lispval + +Lonep() + +{ + + register lispval handy; lispval Ladd(); + + snpand(1); /* clobber save mask */ + + - chkarg(1); +++ chkarg(1,"onep"); + + handy = lbot->val; + + switch(TYPE(handy)) { + + case INT: + + return(handy->i==1?tatom:nil); + + case DOUB: + + return(handy->r==1.0?tatom:nil); + + case SDOT: + + protect(inewint(0)); + + handy = Ladd(); + + if(TYPE(handy)!=INT || handy->i !=1) + + return(nil); + + else + + return(tatom); + + } + + return(nil); + +} + + + +lispval + +cmpx(lssp) + +{ + + register struct argent *argp; + + register struct argent *outarg; + + register struct argent *handy; + + register count; + + register struct argent *lbot; + + register struct argent *np; + + struct argent *onp = np; + + + + + + argp = lbot + 1; + + outarg = np; + + while(argp < onp) { + + + + np = outarg + 2; + + lbot = outarg; + + if(lssp) + + *outarg = argp[-1], outarg[1] = *argp++; + + else + + outarg[1] = argp[-1], *outarg = *argp++; + + lbot->val = Lsub(); + + np = lbot + 1; + + if(Lnegp()==nil) return(nil); + + } + + return(tatom); + +} + + + +lispval + +Lgreaterp() + +{ +++ register int typ; +++ /* do the easy cases first */ +++ if(np-lbot == 2) +++ { if((typ=TYPE(lbot->val)) == INT) +++ { if((typ=TYPE(lbot[1].val)) == INT) +++ return((lbot[0].val->i - lbot[1].val->i) > 0 ? tatom : nil); +++ else if(typ == DOUB) +++ return((lbot[0].val->i - lbot[1].val->r) > 0.0 ? tatom : nil); +++ } +++ else if(typ == DOUB) +++ { if((typ=TYPE(lbot[1].val)) == INT) +++ return((lbot[0].val->r - lbot[1].val->i) > 0.0 ? tatom : nil); +++ else if(typ == DOUB) +++ return((lbot[0].val->r - lbot[1].val->r) > 0.0 ? tatom : nil); +++ } +++ } +++ + + return(cmpx(FALSE)); + +} + + + +lispval + +Llessp() + +{ +++ register int typ; +++ /* do the easy cases first */ +++ if(np-lbot == 2) +++ { if((typ=TYPE(lbot->val)) == INT) +++ { if((typ=TYPE(lbot[1].val)) == INT) +++ return((lbot[0].val->i - lbot[1].val->i) < 0 ? tatom : nil); +++ else if(typ == DOUB) +++ return((lbot[0].val->i - lbot[1].val->r) < 0.0 ? tatom : nil); +++ } +++ else if(typ == DOUB) +++ { if((typ=TYPE(lbot[1].val)) == INT) +++ return((lbot[0].val->r - lbot[1].val->i) < 0.0 ? tatom : nil); +++ else if(typ == DOUB) +++ return((lbot[0].val->r - lbot[1].val->r) < 0.0 ? tatom : nil); +++ } +++ } +++ + + return(cmpx(TRUE)); + +} + + + +lispval + +Ldiff() + +{ + + register lispval arg1,arg2; register handy = 0; + + snpand(3); /* clobber save mask */ + + + + - chkarg(2); +++ chkarg(2,"Ldiff"); + + arg1 = lbot->val; + + arg2 = (lbot+1)->val; + + if(TYPE(arg1)==INT && TYPE(arg2)==INT) { + + handy=arg1->i - arg2->i; + + } + + else error("non-numeric argument",FALSE); + + return(inewint(handy)); + +} + + + +lispval + +Lmod() + +{ + + register lispval arg1,arg2; lispval handy; + + struct sdot fake1, fake2; + + fake2.CDR = 0; + + fake1.CDR = 0; + + snpand(2); /* clobber save mask */ + + - chkarg(2); +++ chkarg(2,"mod"); + + handy = arg1 = lbot->val; + + arg2 = (lbot+1)->val; + + switch(TYPE(arg1)) { + + case SDOT: + + break; + + case INT: + + fake1.I = arg1->i; + + arg1 =(lispval) &fake1; + + break; + + default: + + error("non-numeric argument",FALSE); + + } + + switch(TYPE(arg2)) { + + case SDOT: + + break; + + case INT: + + fake2.I = arg2->i; + + arg2 =(lispval) &fake2; + + break; + + default: + + error("non-numeric argument",FALSE); + + } - if(Lzerop()!=nil) return(handy); +++ if(TYPE((lbot+1)->val)==INT && lbot[1].val->i==0) +++ return(handy); + + divbig(arg1,arg2,0,&handy); + + if(handy==((lispval)&fake1)) + + handy = inewint(fake1.I); + + if(handy==((lispval)&fake2)) + + handy = inewint(fake2.I); + + return(handy); + + + +} + + + + + +lispval + +Ladd1() + +{ + + register lispval handy; + + lispval Ladd(); + + snpand(1); /* fixup entry mask */ + + + + handy = rdrint; + + handy->i = 1; + + protect(handy); + + return(Ladd()); + + + +} + + + +lispval + +Lsub1() + +{ + + register lispval handy; + + lispval Ladd(); + + snpand(1); /* fixup entry mask */ + + + + handy = rdrint; + + handy->i = - 1; + + protect(handy); + + return(Ladd()); + +} + + + +lispval + +Lminus() + +{ + + register lispval arg1, handy; + + register temp; + + lispval subbig(); + + snpand(3); /* clobber save mask */ + + - chkarg(1); +++ chkarg(1,"minus"); + + arg1 = lbot->val; + + handy = nil; + + switch(TYPE(arg1)) { + + case INT: + + handy= inewint(0 - arg1->i); + + break; + + case DOUB: + + handy = newdoub(); + + handy->r = -arg1->r; + + break; + + case SDOT: + + handy = rdrsdot; - handy->I = 0; - handy->CDR = (lispval) 0; +++ handy->s.I = 0; +++ handy->s.CDR = (lispval) 0; + + handy = subbig(handy,arg1); + + break; + + + + default: + + error("non-numeric argument",FALSE); + + } + + return(handy); + +} + + + +lispval + +Lnegp() + +{ + + register lispval handy = np[-1].val, work; + + register flag = 0; + + snpand(3); /* clobber save mask */ + + + +loop: + + switch(TYPE(handy)) { + + case INT: + + if(handy->i < 0) flag = TRUE; + + break; + + case DOUB: + + if(handy->r < 0) flag = TRUE; + + break; + + case SDOT: - for(work = handy; work->CDR!=(lispval) 0; work = work->CDR); - if(work->I < 0) flag = TRUE; +++ for(work = handy; work->s.CDR!=(lispval) 0; work = work->s.CDR); +++ if(work->s.I < 0) flag = TRUE; + + break; + + default: + + handy = errorh(Vermisc, + + "minusp: Non-(int,real,bignum) arg: ", + + nil, + + TRUE, + + 0, + + handy); + + goto loop; + + } + + if(flag) return(tatom); + + return(nil); + +} + + + +lispval + +Labsval() + +{ + + register lispval arg1, handy; + + register temp; + + snpand(3); /* clobber save mask */ + + - chkarg(1); +++ chkarg(1,"absval"); + + arg1 = lbot->val; + + if(Lnegp()!=nil) return(Lminus()); + + + + return(arg1); + +} + + + +#include "frame.h" + +/* new version of showstack, + + We will set fp to point where the register fp points. + + Then fp+2 = saved ap + + fp+4 = saved pc + + fp+3 = saved fp + + ap+1 = first arg + + If we find that the saved pc is somewhere in the routine eval, + + then we print the first argument to that eval frame. This is done + + by looking one beyond the saved ap. + +*/ + +lispval + +Lshostk() + +{ lispval isho(); + + return(isho(1)); + +} + +static lispval + +isho(f) + +int f; + +{ + + register struct frame *myfp; register lispval handy; + + int **fp; /* this must be the first local */ + + int virgin=1; +++ lispval linterp(); + + lispval _qfuncl(),tynames(); /* locations in qfuncl */ +++ extern int prinlevel,prinlength; +++ +++ if(TYPE(Vprinlevel->a.clb) == INT) +++ { +++ prinlevel = Vprinlevel->a.clb->i; +++ } +++ else prinlevel = -1; +++ if(TYPE(Vprinlength->a.clb) == INT) +++ { +++ prinlength = Vprinlength->a.clb->i; +++ } +++ else prinlength = -1; + + + + if(f==1) + + printf("Forms in evaluation:\n"); + + else + + printf("Backtrace:\n\n"); + + + + myfp = (struct frame *) (&fp +1); /* point to current frame */ + + + + while(TRUE) + + { + + if( (myfp->pc > eval && /* interpreted code */ + + myfp->pc < popnames) + + || - (myfp->pc > _qfuncl && /* compiled code */ - myfp->pc < tynames) ) +++ (myfp->pc > Lfuncal && /* compiled code */ +++ myfp->pc < linterp) ) + + { - handy = (myfp->ap[1]); +++ if(((int) myfp->ap[0]) == 1) /* only if arg given */ +++ { handy = (myfp->ap[1]); + + if(f==1) + + printr(handy,stdout), putchar('\n'); + + else { + + if(virgin) + + virgin = 0; + + else + + printf(" -- "); - printr((TYPE(handy)==DTPR)?handy->car:handy,stdout); +++ printr((TYPE(handy)==DTPR)?handy->d.car:handy,stdout); + + } +++ } + + + + } + + + + if(myfp > myfp->fp) break; /* end of frames */ + + else myfp = myfp->fp; + + } + + putchar('\n'); + + return(nil); + +} +++ +++/* +++ * +++ * (baktrace) +++ * +++ * baktrace will print the names of all functions being evaluated +++ * from the current one (baktrace) down to the first one. +++ * currently it only prints the function name. Planned is a +++ * list of local variables in all stack frames. +++ * written by jkf. +++ * +++ */ + +lispval + +Lbaktrace() + +{ + + isho(0); + +} - /* =========================================================== - - - **** baktrace **** (moved back by kls) - - - - baktrace will print the names of all functions being evaluated - - from the current one (baktrace) down to the first one. - - currently it only prints the function name. Planned is a - - list of local variables in all stack frames. - - written by jkf. - - - -============================================================*/ - - /*============================================================= - - - -*** oblist **** - - - - oblist returns a list of all symbols in the oblist - - - - written by jkf. - ============================================================*/ + + +++/* +++ * +++ * (oblist) +++ * +++ * oblist returns a list of all symbols in the oblist +++ * +++ * written by jkf. +++ */ + +lispval + +Loblist() + +{ + + int indx; + + lispval headp, tailp ; + + struct atom *symb ; +++ extern int hashtop; +++ snpand(0); + + + + headp = tailp = newdot(); /* allocate first DTPR */ + + protect(headp); /*protect the list from garbage collection*/ + + /*line added by kls */ + + - for( indx=0 ; indx <= HASHTOP-1 ; indx++ ) /* though oblist */ +++ for( indx=0 ; indx <= hashtop-1 ; indx++ ) /* though oblist */ + + { + + for( symb = hasht[indx] ; + + symb != (struct atom *) CNIL ; + + symb = symb-> hshlnk) + + { - tailp->car = (lispval) symb ; /* remember this atom */ - tailp = tailp->cdr = newdot() ; /* link to next DTPR */ +++ if(TYPE(symb) != ATOM) +++ { printf(" non symbol in hasht[%d] = %x: ",indx,symb); +++ printr(symb,stdout); +++ printf(" \n"); +++ fflush(stdout); +++ } +++ tailp->d.car = (lispval) symb ; /* remember this atom */ +++ tailp = tailp->d.cdr = newdot() ; /* link to next DTPR */ + + } + + } + + - tailp->cdr = nil ; /* close the list unfortunately throwing away +++ tailp->d.cdr = nil ; /* close the list unfortunately throwing away + + the last DTPR + + */ + + return(headp); + +} + + + +/* + + * Maclisp setsyntax function: + + * (setsyntax c s x) + + * c represents character either by fixnum or atom + + * s is the atom "macro" or the atom "splicing" (in which case x is the + + * macro to be invoked); or nil (meaning don't change syntax of c); or + + * (well thats enough for now) if s is a fixnum then we modify the bits + + * for c in the readtable. + + */ - #define VMAC 0316 - #define VSPL 0315 - #define VDQ 0212 - #define VESC 0217 +++#include "chars.h" + +#include "chkrtab.h" + + + +lispval + +Lsetsyn() + +{ + + register lispval s, c; + + register struct argent *mynp; + + register index; + + register struct argent *lbot, *np; - lispval x; +++ lispval x,debugmode; + + extern char *ctable; +++ extern lispval Istsrch(); + + int value; + + - chkarg(3); - s = Vreadtable->clb; +++ switch(np-lbot) { +++ case 2: +++ protect(nil); +++ case 3: +++ break; +++ default: +++ argerr("setsyntax"); +++ } +++ s = Vreadtable->a.clb; + + chkrtab(s); +++ /* debugging code +++ debugmode = Istsrch(matom("debugging"))->d.cdr->d.cdr->d.cdr; +++ if(debugmode) printf("Readtable addr: %x\n",ctable); +++ end debugging code */ + + mynp = lbot; + + c = (mynp++)->val; + + s = (mynp++)->val; + + x = (mynp++)->val; + + + + switch(TYPE(c)) { + + default: - error("neither fixnum nor atom as char to setsyntax",FALSE); +++ error("neither fixnum, atom or string as char to setsyntax",FALSE); + + + + case ATOM: - index = *(c->pname); - if((c->pname)[1])error("Only 1 char atoms to setsyntax",FALSE); +++ index = *(c->a.pname); +++ if((c->a.pname)[1])error("Only 1 char atoms to setsyntax",FALSE); + + break; + + + + case INT: + + index = c->i; +++ break; +++ +++ case STRNG: +++ index = (int) *((char *) c); + + } + + switch(TYPE(s)) { + + case INT: + + if(s->i == VESC) Xesc = (char) index; + + else if(s->i == VDQ) Xdqc = (char) index; +++ else if(s->i == VSD) Xsdc = (char) index; /* string */ + + + + if(ctable[index] == VESC /* if we changed the current esc */ + + && s->i != VESC /* to something else, pick current */ + + && Xesc == (char) index) { + + ctable[index] = s->i; + + rpltab(VESC,&Xesc); + + } + + else if(ctable[index] == VDQ /* likewise for double quote */ + + && s->i != VDQ + + && Xdqc == (char) index) { + + ctable[index] = s->i; + + rpltab(VDQ,&Xdqc); + + } +++ else if(ctable[index] == VSD /* and for string delimiter */ +++ && s->i != VSD +++ && Xsdc == (char) index) { +++ ctable[index] = s->i; +++ rpltab(VSD,&Xsdc); +++ } + + else ctable[index] = s->i; + + + + break; + + case ATOM: + + if(s==splice) + + ctable[index] = VSPL; + + else if(s==macro) + + ctable[index] = VMAC; + + if(TYPE(c)!=ATOM) { + + strbuf[0] = index; + + strbuf[1] = 0; + + c = (getatom()); + + } + + Iputprop(c,x,macro); + + } + + return(tatom); + +} + + - - - /* this aux function is used by setsyntax to determine the new current - escape or double quote character. It scans the character table for - the first character with the given class (either VESC or VDQ) and - puts that character in Xesc or Xdqc (whichever is pointed to by - addr). - */ +++/* +++ * this aux function is used by setsyntax to determine the new current +++ * escape or double quote character. It scans the character table for +++ * the first character with the given class (either VESC or VDQ) and +++ * puts that character in Xesc or Xdqc (whichever is pointed to by +++ * addr). +++ */ + +rpltab(cclass,addr) + +char cclass; + +char *addr; + +{ + + register int i; + + extern char *ctable; + + for(i=0; i<=127 && ctable[i] != cclass; i++); + + if(i<=127) *addr = (char) i; + + else *addr = '\0'; + +} + + - - + +lispval + +Lzapline() + +{ + + register FILE *port; + + extern FILE * rdrport; + + + + port = rdrport; + + while (!feof(port) && (getc(port)!='\n') ); + + return(nil); + +} - diff --cc usr/src/cmd/lisp/lam4.c index 0000000000,423e9a9199,0000000000..31647fefd7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam4.c +++ b/usr/src/cmd/lisp/lam4.c @@@@ -1,0 -1,389 -1,0 +1,396 @@@@ +++static char *sccsid = "@(#)lam4.c 34.1 10/3/80"; +++ + +#include "global.h" - #define protect(z) (np++->val = (z)) + +typedef struct argent *ap; - static int restype; + +static int prunep; lispval adbig(),subbig(),mulbig(); + +lispval + +Ladd() + +{ + + register lispval work; + + register ap result, mynp, oldnp, lbot, np; - int itemp; +++ int itemp,restype; + + + + oldnp = result = np; + + protect(rdrsdot); - rdrsdot->CDR = (lispval) 0; - rdrsdot->I =0; +++ rdrsdot->s.CDR = (lispval) 0; +++ rdrsdot->s.I =0; + + restype = SDOT; + + prunep = TRUE; + + + + for(mynp = lbot; mynp < oldnp; mynp++) + + { + + work = mynp->val; + + switch(TYPE(work)) { + + case INT: + + switch(restype) { + + case DOUB: + + result->val->r += work->i; + + break; + + case SDOT: + + dmlad(result->val,1,work->i); + + prunep = TRUE; + + break; + + default: + + goto urk; + + } + + break; + + case SDOT: + + switch(restype) { + + case DOUB: + + error("Don't know how to make bignums into reals, yet",FALSE); + + break; + + case SDOT: + + result->val = adbig(work,result->val); + + restype = TYPE(result->val); + + if(restype==INT) { - rdrsdot->I=result->val->I; - rdrsdot->CDR = (lispval) 0; +++ rdrsdot->s.I=result->val->s.I; +++ rdrsdot->s.CDR = (lispval) 0; + + result->val = rdrsdot; + + restype=SDOT; + + prunep = TRUE; + + } else + + prunep = FALSE; + + break; + + default: + + goto urk; + + } + + break; + + case DOUB: + + switch(restype) { + + case SDOT: - if(result->val->CDR==(lispval) 0) { +++ if(result->val->s.CDR==(lispval) 0) { + + protect(newdoub()); + + np[-1].val->r = result->val->i+work->r; + + result->val = np[-1].val; + + np--; + + restype = DOUB; + + } else + + error("Don't know how to make bignums into reals, yet",FALSE); + + break; + + case DOUB: + + result->val->r += work->r; + + break; + + default: + + goto urk; + + } + + break; + + default: - error("Non-number to add",FALSE); +++ errorh(Vermisc,"Non-number to add",nil,0,FALSE,work); + + } + + } + + if(restype==DOUB || prunep==FALSE) + + return(result->val); - else if (result->val->CDR==(lispval) 0) - return(inewint(result->val->I)); +++ else if (result->val->s.CDR==(lispval) 0) +++ return(inewint(result->val->s.I)); + + else { + + struct sdot dummybig; + + + + dummybig.I = 0; + + dummybig.CDR = (lispval) 0; + + return(adbig(&dummybig,result->val)); + + } + + urk: + + error("Internal error in (add,sub,quo,times)",FALSE); + +} + +lispval + +Lsub() + +{ + + register lispval work; + + register ap result, mynp, oldnp, lbot, np; - int itemp; +++ int itemp,restype; + + lispval Lminus(); + + + + oldnp = result = np; + + mynp = lbot + 1; + + protect(rdrsdot); - rdrsdot->CDR = (lispval) 0; - rdrsdot->I =0; +++ rdrsdot->s.CDR = (lispval) 0; +++ rdrsdot->s.I =0; + + restype = SDOT; + + prunep = TRUE; + + if(oldnp==lbot) + + goto out; - if(oldnp==mynp) +++ if(oldnp==mynp) { +++ np--; + + return(Lminus()); +++ } + + work = lbot->val; + + switch(TYPE(work)) { + + case INT: - rdrsdot->I = work->i; +++ rdrsdot->s.I = work->i; + + break; + + case SDOT: + + result->val = adbig(result->val,work); + + if(TYPE(result->val)==INT) { - rdrsdot->I = result->val->i; +++ rdrsdot->s.I = result->val->i; + + result->val = rdrsdot; + + } + + break; + + case DOUB: + + (result->val = newdoub())->r = work->r; + + restype = DOUB; + + } + + + + for(; mynp < oldnp; mynp++) + + { + + work = mynp->val; + + switch(TYPE(work)) { + + case INT: + + switch(restype) { + + case DOUB: + + result->val->r -= work->i; + + break; + + case SDOT: + + dmlad(result->val,1, -work->i); + + prunep = TRUE; + + break; + + default: + + goto urk; + + } + + break; + + case SDOT: + + switch(restype) { + + case DOUB: - error("Don't know how to make bignums into reals, yet",FALSE); +++ errorh(Vermisc, +++ "difference: Don't know how to make bignums into reals, yet", +++ nil,FALSE,0,work); + + break; + + case SDOT: + + result->val = subbig(result->val,work); + + restype = TYPE(result->val); + + if(restype==INT) { - rdrsdot->I=result->val->I; - rdrsdot->CDR = (lispval) 0; +++ rdrsdot->s.I=result->val->s.I; +++ rdrsdot->s.CDR = (lispval) 0; + + result->val = rdrsdot; + + restype=SDOT; + + prunep = TRUE; + + } else + + prunep = FALSE; + + break; + + default: + + goto urk; + + } + + break; + + case DOUB: + + switch(restype) { + + case SDOT: - if(result->val->CDR==(lispval) 0) { +++ if(result->val->s.CDR==(lispval) 0) { + + protect(newdoub()); + + np[-1].val->r = result->val->i-work->r; + + result->val = np[-1].val; + + np--; + + restype = DOUB; + + } else - error("Don't know how to make bignums into reals, yet",FALSE); +++ errorh(Vermisc, +++ "difference: Don't know how to make bignums into reals ",nil,FALSE,0,work); + + break; + + case DOUB: + + result->val->r -= work->r; + + break; + + default: + + goto urk; + + } + + break; + + default: - error("Non-number to minus",FALSE); +++ errorh(Vermisc,"Non-number to minus",nil,FALSE,0,work); + + } + + } + +out: + + if(restype==DOUB || prunep==FALSE) + + return(result->val); - else if (result->val->CDR==(lispval) 0) - return(inewint(result->val->I)); +++ else if (result->val->s.CDR==(lispval) 0) +++ return(inewint(result->val->s.I)); + + else { + + struct sdot dummybig; + + + + dummybig.I = 0; + + dummybig.CDR = (lispval) 0; + + return(adbig(&dummybig,result->val)); + + } + + urk: + + error("Internal error in (add,sub,quo,times)",FALSE); + +} + +lispval + +Ltimes() + +{ + + register lispval work; + + register ap result, mynp, oldnp, lbot, np; - int itemp; +++ int itemp,restype; + + + + oldnp = result = np; + + protect(rdrsdot); - rdrsdot->CDR = (lispval) 0; - rdrsdot->I = 1; +++ rdrsdot->s.CDR = (lispval) 0; +++ rdrsdot->s.I = 1; + + restype = SDOT; + + prunep = TRUE; + + + + for(mynp = lbot; mynp < oldnp; mynp++) + + { + + work = mynp->val; + + switch(TYPE(work)) { + + case INT: + + switch(restype) { + + case DOUB: + + result->val->r *= work->i; + + break; + + case SDOT: + + dmlad(result->val,work->i,0); + + prunep = TRUE; + + break; + + default: + + goto urk; + + } + + break; + + case SDOT: + + switch(restype) { + + case DOUB: + + error("Don't know how to make bignums into reals, yet",FALSE); + + break; + + case SDOT: + + result->val = mulbig(work,result->val); + + restype = TYPE(result->val); + + if(restype==INT) { + + if(result->val->i==0) + + return(result->val); - rdrsdot->I=result->val->I; - rdrsdot->CDR = (lispval) 0; +++ rdrsdot->s.I=result->val->s.I; +++ rdrsdot->s.CDR = (lispval) 0; + + result->val = rdrsdot; + + restype=SDOT; + + prunep = TRUE; + + } else + + prunep = FALSE; + + break; + + default: + + goto urk; + + } + + break; + + case DOUB: + + switch(restype) { + + case SDOT: - if(result->val->CDR==(lispval) 0) { +++ if(result->val->s.CDR==(lispval) 0) { + + protect(newdoub()); + + np[-1].val->r = result->val->i*work->r; + + result->val = np[-1].val; + + np--; + + restype = DOUB; + + } else + + error("Don't know how to make bignums into reals, yet",FALSE); + + break; + + case DOUB: + + result->val->r *= work->r; + + break; + + default: + + goto urk; + + } + + break; + + default: + + error("Non-number to times",FALSE); + + } + + } + + if(restype==DOUB || prunep==FALSE) + + return(result->val); - else if (result->val->CDR==(lispval) 0) - return(inewint(result->val->I)); +++ else if (result->val->s.CDR==(lispval) 0) +++ return(inewint(result->val->s.I)); + + else { + + struct sdot dummybig; + + + + dummybig.I = 0; + + dummybig.CDR = (lispval) 0; + + return(adbig(&dummybig,result->val)); + + } + + urk: + + error("Internal error in (add,sub,quo,times)",FALSE); + +} + +lispval + +Lquo() + +{ + + register lispval work; + + register lispval result; + + register struct argent *mynp; + + register struct argent *oldnp, *lbot, *np; + + int bigflag = 0, realflag = 0, itemp; + + struct sdot dummybig; + + lispval divbig(), *resaddr; + + + + mynp = lbot; + + oldnp = np-1; + + dummybig.CDR = (lispval) 0; + + dummybig.I = 1; + + if(mynp > oldnp) goto out; + + work = (mynp++)->val; + + itemp = TYPE(work); + + switch(itemp) { + + case INT: - dummybig.I = work->i; +++ if(mynp <= oldnp) dummybig.I = work->i; +++ else dummybig.I = 1/work->i; + + break; + + case DOUB: + + realflag = 1; + + protect(result = newdoub()); - result->r = work->r; +++ if(mynp <= oldnp) result->r = work->r; +++ else result->r = 1.0/work->r; + + break; - case SDOT: +++ case SDOT: /* must be fixed for the inverse case */ + + protect(work); + + resaddr = &(np[-1].val); + + bigflag = 1; + + break; + + default: + + error("Don't know how to divide this type.",FALSE); + + } + + for(;mynp <= oldnp; mynp++) { + + work = mynp->val; + + itemp = TYPE(work); + + switch(itemp) { + + + + case INT: + + if (work->i==0) + + kill(getpid(),8); + + if (realflag) + + result->r /= work->i; + + else if(bigflag) { + + dummybig.I = work->i; + + divbig(*resaddr, &dummybig, resaddr, 0); + + } else { + + dummybig.I /= work->i; + + } + + break; + + case DOUB: + + if(realflag) + + result->r /= work->r; + + else if(bigflag) + + error("Don't know how to make bignums into reals, yet",FALSE); + + else { + + realflag = 1; + + result = newdoub(); + + result->r = (double) dummybig.I / work->r; + + protect(result); + + } + + break; + + case SDOT: + + if(realflag) + + error("Don't know how to divide reals by bignums ",FALSE); + + else if(bigflag) + + divbig(*resaddr, work, resaddr, 0); + + else { + + bigflag = 1; + + protect(newsdot()); + + resaddr = &(np[-1].val); + + np[-1].val->i = dummybig.I; + + divbig(*resaddr, work, resaddr, 0); + + } + + break; + + default: + + error("Don't know how to divide this type",FALSE); + + + + } + + } + +out: + + if(realflag) + + return(result); + + else if (bigflag) + + return(*resaddr); + + else { + + result = inewint( dummybig.I ); + + return(result); + + } + +} diff --cc usr/src/cmd/lisp/lam5.c index 0000000000,8b213431f5,0000000000..41493c4700 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam5.c +++ b/usr/src/cmd/lisp/lam5.c @@@@ -1,0 -1,430 -1,0 +1,474 @@@@ +++static char *sccsid = "@(#)lam5.c 34.1 10/3/80"; +++ + +#include "global.h" + +#include "chkrtab.h" + + + +/*=========================================== + +- - - explode functions - - The following function partially implement two explode functions, - - explodec and exploden. They only work for atom arguments. +++- explode functions: aexplode , aexplodec, aexploden +++- The following function partially implement the explode functions for atoms. +++- The full explode functions are written in lisp and call these for atom args. + +- + +-===========================================*/ + + + +#include "chars.h" + +lispval + +Lexpldx(kind,slashify) - int kind, slashify; /* 0=explodec 1=exploden */ +++int kind, slashify; /* kind = 0 => explode to characters +++ = 1 => explode to fixnums (aexploden) +++ slashify = 0 => do not quote bizarre characters +++ = 1 => quote bizarre characters +++ */ + +{ + + int typ, i; + + char ch, *strb, strbb[BUFSIZ]; /* temporary string buffer */ + + register lispval last, handy; +++ register char *cp; + + char Idqc = Xdqc; + + snpand(4); /* kludge register save mask */ + + - chkarg(1); +++ chkarg(1,"expldx"); + + - handy = Vreadtable->clb; +++ handy = Vreadtable->a.clb; + + chkrtab(handy); + + handy = lbot->val; + + *strbuf = 0; + + typ=TYPE(handy); /* we only work for a few types */ + + + + + + /* put the characters to return in the string buffer strb */ + + + + switch(typ) { + + case STRNG: - strb = (char *) handy; - if(Xsdc)Idqc = Xsdc; - goto common; +++ if(slashify && !Xsdc) +++ errorh(Vermisc,"Can't explode without string delimiter",nil +++ ,FALSE,0,handy); +++ +++ strb = strbb; +++ if(slashify) *strb++ = Xsdc; +++ /* copy string into buffer, escape only occurances of the +++ double quoting character if in slashify mode +++ */ +++ for(cp = (char *) handy; *cp; cp++) +++ { +++ if(slashify && +++ (*cp == Xsdc || ctable[*cp]==VESC)) +++ *strb++ = Xesc; +++ *strb++ = *cp; +++ } +++ if(slashify) *strb++ = Xsdc; +++ *strb = NULL_CHAR ; +++ strb = strbb; +++ break; +++ + + case ATOM: - strb = handy->pname; +++ strb = handy->a.pname; + + if(strb[0]==0) { + + strb = strbb; + + strbb[0] = Xdqc; + + strbb[1] = Xdqc; + + strbb[2] = 0; + + } else + + common: + + if(slashify != 0) + + { - register char *cp, *out = strbb; +++ register char *out = strbb; + + cp = strb; + + strb = strbb; + + if(ctable[(*cp)&0177]==VNUM) + + *out++ = Xesc; + + for(; *cp; cp++) + + { + + if(ctable[*cp]& QUTMASK) + + *out++ = Xesc; + + *out++ = *cp; + + } + + *out = 0; + + } + + + + break; + + case INT: + + strb = strbb; + + sprintf(strb, "%d", lbot->val->i); + + break; + + case DOUB: + + strb = strbb; - sprintf(strb, "%0.16G", lbot->val->r); +++ lfltpr(strb, lbot->val->r); + + break; + + case SDOT: + + { + + struct _iobuf _strbuf; + + register count; + + for((handy = lbot->val), count = 12; - handy->CDR!=(lispval) 0; - (handy = handy->CDR), count += 12); +++ handy->s.CDR!=(lispval) 0; +++ (handy = handy->s.CDR), count += 12); + + strb = (char *) alloca(count); + + + + _strbuf._flag = _IOWRT+_IOSTRG; + + _strbuf._ptr = strb; + + _strbuf._cnt = count; + + pbignum(lbot->val,&_strbuf); - putc('.',&_strbuf); + + putc(0,&_strbuf); + + break; + + } + + default: + + errorh(Vermisc,"EXPLODE ARG MUST BE STRING, SYMBOL, FIXNUM, OR FLONUM",nil,FALSE,0,handy); + + return(nil); + + } + + + + + + if( strb[0] != NULL_CHAR ) /* if there is something to do */ + + { + + register lispval prev; + + + + protect(handy = last = newdot()); + + strbuf[1] = NULL_CHAR ; /* set up for getatom */ + + atmlen = 2; + + + + for(i=0; ch = strb[i++]; ) { + + switch(kind) { + + + + case 0: strbuf[0] = hash = ch; /* character explode */ - hash = 177 & hash; /* cut 1st bit off if any */ - last->car = (lispval) getatom(); /* look in oblist */ +++ last->d.car = (lispval) getatom(); /* look in oblist */ + + break; + + + + case 1: - last->car = inewint(ch); +++ last->d.car = inewint(ch); + + break; + + } + + + + /* advance pointers */ + + prev = last; - last->cdr = newdot(); - last = last->cdr; +++ last->d.cdr = newdot(); +++ last = last->d.cdr; + + } + + + + /* end list with a nil pointer */ - prev->cdr = nil; +++ prev->d.cdr = nil; + + return(handy); + + } + + else return(nil); /* return nil if no characters */ + +} + + + +/*=========================== + +- - - (explodec 'atm) returns (a t m) - - (explodec 234) returns (\2 \3 \4) +++- (aexplodec 'atm) returns (a t m) +++- (aexplodec 234) returns (\2 \3 \4) + +-===========================*/ + + + +lispval + +Lexpldc() + +{ return(Lexpldx(0,0)); } + + + + + +/*=========================== + +- - - (exploden 'abc) returns (65 66 67) - - (exploden 123) returns (49 50 51) +++- (aexploden 'abc) returns (65 66 67) +++- (aexploden 123) returns (49 50 51) + +-=============================*/ + + + + + +lispval + +Lexpldn() + +{ return(Lexpldx(1,0)); } + + + +/*=========================== + +- - - (explodea "123") returns (\\ \1 \2 \3); - - (explodea 123) returns (\1 \2 \3); +++- (aexplode "123") returns (\\ \1 \2 \3); +++- (aexplode 123) returns (\1 \2 \3); + +-=============================*/ + + + +lispval + +Lexplda() + +{ return(Lexpldx(0,1)); } + + + +/* + + * (argv) returns how many arguments where on the command line which invoked + + * lisp; (argv i) returns the i'th argument made into an atom; + + */ + + + +lispval + +Largv() + +{ + + register lispval handy; + + register index; - register char c, *base; +++ register char *base; +++ char c; + + extern int Xargc; + + extern char **Xargv; +++ snpand(3); + + - chkarg(1); +++ if(lbot-np==0)protect(nil); + + handy = lbot->val; + + + + if(TYPE(handy)==INT && handy->i>=0 && handy->ii]); + + return(getatom()); + + } else { + + return(inewint(Xargc)); + + } + +} + +/* + + * (chdir ) executes a chdir command + + * if successful, return t otherwise returns nil + + */ + +lispval Lchdir(){ - register lispval handy; +++ register char *filenm; + + - chkarg(1); - handy=lbot->val; - if(TYPE(handy)==ATOM && (chdir(handy->pname)>=0)) +++ chkarg(1,"chdir"); +++ filenm = (char *) verify(lbot->val,"chdir - non symbol or string arg"); +++ if(chdir(filenm)>=0) + + return(tatom); + + else + + return(nil); + +} + + + +/* ========================================================== + +- + +- ascii - convert from number to ascii character + +- + +- form:(ascii number) + +- + +- the number is checked so that it is in the range 0-255 + +- then it is made a character and returned + +- =========================================================*/ + + + +lispval + +Lascii() + +{ + + register lispval handy; + + + + handy = lbot->val; /* get argument */ + + + + if(TYPE(handy) != INT) /* insure that it is an integer */ + + { error("argument not an integer",FALSE); + + return(nil); + + } + + + + if(handy->i < 0 || handy->i > 0377) /* insure that it is in range*/ + + { error("argument is out of ascii range",FALSE); + + return(nil); + + } + + + + strbuf[0] = handy->i ; /* ok value, make into a char */ + + strbuf[1] = NULL_CHAR; + + + + /* lookup and possibly intern the atom given in strbuf */ + + + + return( (lispval) getatom() ); + +} + + + +/* + + * boole - maclisp bitwise boolean function + + * (boole k x y) where k determines which of 16 possible bitwise + + * truth tables may be applied. Common values are 1 (and) 6 (xor) 7 (or) + + * the result is mapped over each pair of bits on input + + */ + +lispval + +Lboole(){ + + register x, y; + + register lispval result; + + register struct argent *mynp; + + int k; + + + + if(np - lbot < 3) + + error("Boole demands at least 3 args",FALSE); + + mynp = lbot+AD; + + k = mynp->val->i & 15; + + x = (mynp+1)->val->i; + + for(mynp += 2; mynp < np; mynp++) { + + y = mynp->val->i; + + switch(k) { + + + + case 0: x = 0; + + break; + + case 1: x = x & y; + + break; + + case 2: x = y & ~x; + + break; + + case 3: x = y; + + break; + + case 4: x = x & ~y; + + break; + + /* case 5: x = x; break; */ + + case 6: x = x ^ y; + + break; + + case 7: x = x | y; + + break; + + case 8: x = ~(x | y); + + break; + + case 9: x = ~(x ^ y); + + break; + + case 10: x = ~x; + + break; + + case 11: x = ~x | y; + + break; + + case 12: x = ~y; + + break; + + case 13: x = x | ~y; + + break; + + case 14: x = ~x | ~y; + + break; + + case 15: x = -1; + + } + + } + + return(inewint(x)); + +} + +lispval + +Lfact() + +{ + + register lispval result, handy; + + register itemp; + + snpand(3); /* fixup entry mask */ + + + + result = lbot->val; + + if(TYPE(result)!=INT) error("Factorial of Non-fixnum. If you want me\ + +to calculate fact of > 2^30 We will be here till doomsday!.",FALSE); + + itemp = result->i; + + protect(result = newsdot()); - result->CDR=(lispval)0; +++ result->s.CDR=(lispval)0; + + result->i = 1; + + for(; itemp > 1; itemp--) + + dmlad(result,itemp,0); - if(result->CDR) return(result); +++ if(result->s.CDR) return(result); + + (handy = newint())->i = result->i; + + return(handy); + +} + +/* + + * fix -- maclisp floating to fixnum conversion + + * for the moment, mereley convert floats to ints. + + * eventual convert to bignum if too big to fit. + + */ + + lispval Lfix() + + { + + register lispval result, handy; + + - chkarg(1); +++ chkarg(1,"fix"); + + handy = lbot->val; + + switch(TYPE(handy)) { + + default: + + error("innaproriate arg to fix.",FALSE); + + case INT: + + case SDOT: + + return(handy); + + case DOUB: + + if(handy->r >= 0) + + return(inewint((int)handy->r)); + + else + + return(inewint(((int)handy->r)-1)); + + } + +} +++#define SIGFPE 8 +++#define B 1073741824.0 +++static double table[] = { 1.0, B, B*B, B*B*B, B*B*B*B, 0.0}; + + + +lispval + +Lfloat() + +{ + + register lispval handy,result; - chkarg(1); +++ register double sum = 0; +++ register int count; +++ chkarg(1,"float"); + + handy = lbot->val; + + switch(TYPE(handy)) + + { + + case DOUB: return(handy); + + + + + + case INT: result = newdoub(); + + result->r = (double) handy->i; + + return(result); - - - default: error(Vermisc,"Bad argument to float",nil,FALSE,0,handy); +++ case SDOT: +++ { +++ for(handy = lbot->val, count = 0; +++ count < 5; +++ count++, handy = handy->s.CDR) { +++ sum += handy->s.I * table[count]; +++ if(handy->s.CDR==(lispval)0) goto done; +++ } +++ kill(getpid(),SIGFPE); +++ done: +++ result = newdoub(); +++ result->r = sum; +++ return(result); +++ } +++ default: errorh(Vermisc,"Bad argument to float",nil,FALSE,0,handy); + + } + +} + + +++ + +/* Lbreak ***************************************************************/ + +/* If first argument is not nil, this is evaluated and printed. Then */ + +/* error is called with the "breaking" message. */ + +lispval Lbreak() { + + register lispval hold; + + + + if (np > lbot) { + + printr(lbot->val,poport); + + dmpport(poport); + + } + + return(error("",TRUE)); + +} + + + + + +lispval LDivide() { + + register lispval result, work, temp; + + register struct argent *mynp; + + register struct argent *lbot, *np; + + int typ; + + lispval quo, rem; struct sdot dummy; + + - chkarg(2); +++ chkarg(2,"Divide"); + + mynp = lbot; + + result = mynp->val; + + work = (mynp+1)->val; + + + + if((typ=TYPE(result))==INT) { + + protect(temp=newsdot()); + + temp->i = result->i; + + result = temp; + + } else if (typ!=SDOT) + + error("First arg to divide neither a bignum nor int.",FALSE); + + typ = TYPE(work); + + if(typ != INT && typ != SDOT) + + error("second arg to Divide neither an sdot nor an int.",FALSE); + + if(typ == INT) { + + dummy.CDR = (lispval) 0; + + dummy.I = work->i; + + work = (lispval) &dummy; + + } + + divbig(result,work, &quo, &rem); + + protect(quo); + + if(rem==((lispval) &dummy)) + + protect(rem = inewint(dummy.I)); + + protect(result = work = newdot()); - work->car = quo; - (work->cdr = newdot())->car = rem; +++ work->d.car = quo; +++ (work->d.cdr = newdot())->d.car = rem; + + return(result); + +} +++ + +lispval LEmuldiv(){ + + register struct argent * mynp = lbot+AD; + + register lispval work, result; + + int quo, rem; + + snpand(3); /* fix register mask */ + + + + /* (Emuldiv mul1 mult2 add quo) => + + temp = mul1 + mul2 + sext(add); + + result = (list temp/quo temp%quo); + + to mix C and lisp a bit */ + + + + Imuldiv(mynp[0].val->i, mynp[1].val->i, mynp[2].val->i, + + mynp[3].val->i, &quo, &rem); + + protect(result=newdot()); - (result->car=inewint(quo)); - work = result->cdr = newdot(); - (work->car=inewint(rem)); +++ (result->d.car=inewint(quo)); +++ work = result->d.cdr = newdot(); +++ (work->d.car=inewint(rem)); + + return(result); + +} + +static Imuldiv() { + +asm(" emul 4(ap),8(ap),12(ap),r0"); + +asm(" ediv 16(ap),r0,*20(ap),*24(ap)"); + +} + + + + diff --cc usr/src/cmd/lisp/lam6.c index 0000000000,44d1d39de5,0000000000..3feb89d3f0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam6.c +++ b/usr/src/cmd/lisp/lam6.c @@@@ -1,0 -1,358 -1,0 +1,426 @@@@ +++static char *sccsid = "@(#)lam6.c 34.2 10/6/80"; +++ + +#include "global.h" +++#include + +FILE * + +mkstFI(base,count,flag) + +char *base; + +char flag; + +{ + + register FILE *p = stderr; + + + + /* find free file descriptor */ + + for(;p->_flag&(_IOREAD|_IOWRT);p++) + + if(p >= _iob + _NFILE) + + error("Too many open files to do readlist",FALSE); + + p->_flag = _IOSTRG | flag; + + p->_cnt = count; + + p->_base = base; + + p->_ptr = base; + + p->_file = -1; + + return(p); + +} + +lispval + +Lreadli() + +{ + + register lispval work, handy; + + register FILE *p; + + register char *string; + + register struct argent *lbot, *np; + + struct argent *olbot; + + FILE *opiport = piport; + + lispval Lread(); + + int count; + + - chkarg(1); + + if(lbot->val==nil) { /*effectively, return(matom(""));*/ + + strbuf[0] = 0; + + return(getatom()); + + } +++ chkarg(1,"readlist"); + + count = 1; + + + + /* compute length of list */ - for(work = lbot->val; TYPE(work)==DTPR; work=work->cdr) +++ for(work = lbot->val; TYPE(work)==DTPR; work=work->d.cdr) + + count++; + + string = (char *) alloca(count); + + p = mkstFI(string, count - 1, _IOREAD); - for(work = lbot->val; TYPE(work)==DTPR; work=work->cdr) { - handy = work->car; +++ for(work = lbot->val; TYPE(work)==DTPR; work=work->d.cdr) { +++ handy = work->d.car; + + switch(TYPE(handy)) { + + case SDOT: + + case INT: + + *string++=handy->i; + + break; + + case ATOM: - *string++ = *(handy->pname); +++ *string++ = *(handy->a.pname); +++ break; +++ case STRNG: +++ *string++ = *(char *)handy; + + break; + + default: + + error("Non atom or int to readlist",FALSE); + + } + + } + + *string = 0; + + olbot = lbot; + + lbot = np; + + protect(P(p)); + + work = Lread(); + + lbot = olbot; + + frstFI(p); + + return(work); + +} + +frstFI(p) + +register FILE *p; + +{ + + p->_flag=0; + + p->_base=0; + + p->_cnt = 0; + + p->_ptr = 0; + + p->_file = 0; + +} + +lispval + +Lgetenv() + +{ + + register struct argent *mylbot=lbot; + + snpand(1); + + if((TYPE(mylbot->val))!=ATOM) + + error("argument to getenv must be atom",FALSE); + + - strcpy(strbuf,getenv(mylbot->val->pname)); +++ strcpy(strbuf,getenv(mylbot->val->a.pname)); + + return(getatom()); + +} + +lispval + +Lboundp() + +{ + + register struct argent *mynp=lbot; + + register lispval result, handy; + + snpand(3); + + + + if((TYPE(mynp->val))!=ATOM) + + error("argument to boundp must be atom",FALSE); - if( (handy = mynp->val)->clb==CNIL) +++ if( (handy = mynp->val)->a.clb==CNIL) + + result = nil; + + else - (result = newdot())->cdr = handy->clb; +++ (result = newdot())->d.cdr = handy->a.clb; + + return(result); + +} + +lispval + +Lplist() + +{ + + register lispval atm; - snpand(0); +++ snpand(1); + + /* get property list of an atom or disembodied property list */ + + - chkarg(1); +++ chkarg(1,"plist"); + + atm = lbot->val; + + switch(TYPE(atm)) { + + case ATOM: + + case DTPR: + + break; + + default: + + error("Only Atoms and disembodied property lists allowed for plist",FALSE); + + } + + if(atm==nil) return(nilplist); - return(atm->plist); +++ return(atm->a.plist); + +} + +lispval + +Lsetpli() + +{ /* set the property list of the given atom to the given list */ + + register lispval atm, vall; + + register lispval dum1, dum2; + + register struct argent *lbot, *np; - snpand(2); + + - chkarg(2); +++ chkarg(2,"setplist"); + + atm = lbot->val; + + if (TYPE(atm) != ATOM) error("First argument must be an atom",FALSE); + + vall = (np-1)->val; + + if (TYPE(vall)!= DTPR && vall !=nil) + + error("Second argument must be a list",FALSE); + + if (atm==nil) + + nilplist = vall; + + else - atm->plist = vall; +++ atm->a.plist = vall; + + return(vall); + +} + + + +lispval + +Lsignal() + +{ + + register struct argent *mylbot = lbot; - extern lispval sigacts[16]; + + int i; register lispval handy, old; - chkarg(2); + + +++ snpand(3); +++ if(lbot-np==1)protect(nil); +++ chkarg(2,"signal"); + + handy = mylbot[AD].val; + + if(TYPE(handy)!=INT) + + error("First arg to signal must be an int",FALSE); + + i = handy->i & 15; + + handy = mylbot[AD+1].val; + + if(TYPE(handy)!=ATOM) + + error("Second arg to signal must be an atom",FALSE); + + old = sigacts[i]; + + if(old==0) old = nil; + + if(handy==nil) + + sigacts[i]=((lispval) 0); + + else + + sigacts[i]=handy; + + return(old); + +} + +lispval + +Lassq() + +{ + + register lispval work, handy, dum1, dum2; + + register struct argent *lbot, *np; - snpand(2); + + - chkarg(2); +++ chkarg(2,"assq"); + + for(work = lbot[AD+1].val; - work->car->car!=lbot->val&& work!=nil; - work = work->cdr); - return(work->car); +++ work->d.car->d.car!=lbot->val&& work!=nil; +++ work = work->d.cdr); +++ return(work->d.car); + +} + +lispval + +Lkilcopy() + +{ + + if(fork()==0) { + + asm(".byte 0"); + + } + +} + +lispval + +Larg() + +{ + + register lispval handy; register offset, count; + + snpand(3); + + - handy = lexpr_atom->clb; +++ handy = lexpr_atom->a.clb; + + if(handy==CNIL || TYPE(handy)!=DTPR) + + error("Arg: not in context of Lexpr.",FALSE); - count = ((long *)handy->cdr) - (long *)handy->car; +++ count = ((long *)handy->d.cdr) -1 - (long *)handy->d.car; + + if(np==lbot || lbot->val==nil) - return(inewint(count)); +++ return(inewint(count+1)); + + if(TYPE(lbot->val)!=INT || (offset = lbot->val->i - 1) > count || offset < 0 ) - error("Out of bonds: arg to \"Arg\"",FALSE); - return( ((struct argent *)handy->car)[offset].val); +++ error("Out of bounds: arg to \"Arg\"",FALSE); +++ return( ((struct argent *)handy->d.car)[offset].val); +++} +++lispval +++Lsetarg() +++{ +++ register lispval handy, work; +++ register limit, index; +++ register struct argent *lbot, *np; +++ +++ chkarg(2,"setarg"); +++ handy = lexpr_atom->a.clb; +++ if(handy==CNIL || TYPE(handy)!=DTPR) +++ error("Arg: not in context of Lexpr.",FALSE); +++ limit = ((long *)handy->d.cdr) - 1 - (long *)(work = handy->d.car); +++ handy = lbot->val; +++ if(TYPE(handy)!=INT) +++ error("setarg: first argument not integer",FALSE); +++ if((index = handy->i - 1) < 0 || index > limit) +++ error("setarg: index out of range"); +++ return(((struct argent *) work)[index].val = lbot[1].val); + +} + +lispval + +Lptime(){ + + extern int GCtime; + + int lgctime = GCtime; + + static struct tbuf { + + long mytime; + + long allelse[3]; + + } current; + + register lispval result, handy; + + + + snpand(2); + + times(¤t); + + result = newdot(); + + handy = result; + + protect(result); - result->cdr = newdot(); - result->car = inewint(current.mytime); - handy = result->cdr; - handy->car = inewint(lgctime); - handy->cdr = nil; +++ result->d.cdr = newdot(); +++ result->d.car = inewint(current.mytime); +++ handy = result->d.cdr; +++ handy->d.car = inewint(lgctime); +++ handy->d.cdr = nil; + + if(GCtime==0) + + GCtime = 1; + + return(result); + +} + + + +/* (err [value] [flag]) + + where if value is present, it is the value to throw to the errset. + + flag if present must evaluate to nil, as we always evaluate value + + before unwinding stack + + */ + + + +lispval Lerr() + +{ + + register lispval handy; + + lispval errorh(); + + char *mesg = "call to err"; /* default message */ + + - chkarg(1); +++ snpand(1); +++ if(np==lbot) protect(nil); + + + + if ((np >= lbot + 2) && ((lbot+1)->val != nil)) + + error("Second arg to err must be nil",FALSE); + + if ((lbot->val != nil) && (TYPE(lbot->val) == ATOM)) - mesg = lbot->val->pname; /* new message if atom */ +++ mesg = lbot->val->a.pname; /* new message if atom */ + + + + return(errorh(Vererr,mesg,lbot->val,nil)); + +} + +lispval + +Ltyi() + +{ + + register FILE *port; - register char val; +++ char val; +++ snpand(1); + + - chkarg(1); - port = okport(lbot->val,okport(Vpiport->clb,stdin)); +++ if(lbot-np==0)protect(nil); +++ port = okport(lbot->val,okport(Vpiport->a.clb,stdin)); + + + + + + fflush(stdout); /* flush any pending output characters */ + + val = getc(port); +++ if(val==EOF) +++ { +++ clearerr(port); +++ if(sigintcnt > 0) sigcall(SIGINT); /* eof might mean int */ +++ } + + return(inewint(val)); + +} + +lispval + +Ltyipeek() + +{ + + register FILE *port; - register char val; +++ char val; +++ snpand(1); + + - chkarg(1); - port = okport(lbot->val,okport(Vpiport->clb,stdin)); +++ if(lbot-np==0) protect(nil); +++ port = okport(lbot->val,okport(Vpiport->a.clb,stdin)); + + + + fflush(stdout); /* flush any pending output characters */ + + val = getc(port); +++ if(val==EOF) +++ clearerr(port); + + ungetc(val,port); + + return(inewint(val)); + +} + +lispval + +Ltyo() + +{ + + register FILE *port; + + register lispval handy, where; - register char val; - register struct argent *lbot, *np; +++ char val; +++ +++ snpand(3); + + - chkarg(2); +++ switch(np-lbot) { +++ case 1: +++ protect(nil); +++ case 2: break; +++ default: +++ argerr("tyo"); +++ } + + handy = lbot->val; + + if(TYPE(handy)!=INT) + + error("Tyo demands number for 1st arg",FALSE); + + val = handy->i; + + + + where = lbot[1].val; - port = (FILE *) okport(where,okport(Vpoport->clb,stdout)); +++ port = (FILE *) okport(where,okport(Vpoport->a.clb,stdout)); + + putc(val,port); + + return(handy); + +} +++ +++#include "chkrtab.h" +++ + +lispval + +Imkrtab(current) + +{ + + extern struct rtab { + + char ctable[132]; + + } initread; + + register lispval handy; extern lispval lastrtab; +++ + + static int cycle = 0; + + static char *nextfree; +++ + + if((cycle++)%3==0) { - nextfree = (char *) csegment(int_name,128); +++ nextfree = (char *) csegment(str_name,512,FALSE); + + } + + handy = newarray(); - handy->data = nextfree; +++ handy->ar.data = nextfree; + + if(current == 0) + + *(struct rtab *)nextfree = initread; + + else + + *(struct rtab *)nextfree = *(struct rtab *)ctable; - handy->delta = inewint(4); - handy->length = inewint(sizeof(struct rtab)/sizeof(int)); - handy->accfun = handy->aux = nil; +++ handy->ar.delta = inewint(4); +++ handy->ar.length = inewint(sizeof(struct rtab)/sizeof(int)); +++ handy->ar.accfun = handy->ar.aux = nil; + + nextfree += sizeof(struct rtab); + + return(handy); + +} + + + +/* makereadtable - arg : t or nil + + returns a readtable, t means return a copy of the initial readtable + + + + nil means return a copy of the current readtable + +*/ + +lispval + +Lmakertbl() + +{ +++ lispval handy = Vreadtable->a.clb; +++ chkrtab(handy); +++ + + if(lbot==np) error("makereadtable: wrong number of args",FALSE); + + + + if(TYPE(lbot->val) != ATOM) + + error("makereadtable: arg must be atom",FALSE); + + + + if(lbot->val == nil) return(Imkrtab(1)); + + else return(Imkrtab(0)); + +} +++ + +lispval + +Lcpy1() + +{ + + register lispval handy = lbot->val, result = handy; + + + +top: + + switch(TYPE(handy)) + + { + + case INT: + + result = inewint(handy->i); + + break; + + case VALUE: + + (result = newval())->l = handy->l; + + break; + + case DOUB: + + (result = newdoub())->r = handy->r; + + break; + + default: + + lbot->val = + + errorh(Vermisc,"Bad arg to cpy1",nil,TRUE,67,handy); + + goto top; + + } + + return(result); + +} +++ +++/* copyint* . This returns a copy of its integer argument. The copy will +++ * be a fresh integer cell, and will not point into the read only +++ * small integer table. +++ */ +++lispval +++Lcopyint() +++{ +++ register lispval handy = lbot->val; +++ register lispval ret; +++ +++ while (TYPE(handy) != INT) +++ { handy=errorh(Vermisc,"copyint* : non integer arg",nil,TRUE,0,handy);} +++ (ret = newint())->i = handy->i; +++ return(ret); +++} +++ +++ diff --cc usr/src/cmd/lisp/lam7.c index 0000000000,2b2bd12234,0000000000..4dba5ae462 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam7.c +++ b/usr/src/cmd/lisp/lam7.c @@@@ -1,0 -1,357 -1,0 +1,404 @@@@ +++static char *sccsid = "@(#)lam7.c 34.2 11/7/80"; +++ + +#include "global.h" + + + +lispval + +Lfork() { + + register lispval temp; + + int pid; + + - chkarg(0); +++ chkarg(0,"fork"); + + if ((pid=fork())) { + + temp = newint(); + + temp->i = pid; + + return(temp); + + } else + + return(nil); + +} + + + +lispval + +Lwait() + +{ + + register lispval ret, temp; + + int status = -1, pid; + + snpand(2); + + + + - chkarg(0); +++ chkarg(0,"wait"); + + pid = wait(&status); + + ret = newdot(); + + protect(ret); + + temp = newint(); + + temp->i = pid; - ret->car = temp; +++ ret->d.car = temp; + + temp = newint(); + + temp->i = status; - ret->cdr = temp; +++ ret->d.cdr = temp; + + return(ret); + +} + + + +lispval + +Lpipe() + +{ + + register lispval ret, temp; + + int pipes[2]; +++ snpand(2); + + - chkarg(0); +++ chkarg(0,"pipe"); + + pipes[0] = -1; + + pipes[1] = -1; + + pipe(pipes); + + ret = newdot(); + + protect(ret); + + temp = newint(); + + temp->i = pipes[0]; - ret->car = temp; +++ ret->d.car = temp; + + temp = newint(); + + temp->i = pipes[1]; - ret->cdr = temp; +++ ret->d.cdr = temp; + + return(ret); + +} + + + +lispval + +Lfdopen() + +{ + + register lispval fd, type; + + FILE *ptr; + + - chkarg(2); +++ chkarg(2,"fdopen"); + + type = (np-1)->val; + + fd = lbot->val; + + if( TYPE(fd)!=INT ) + + return(nil); + + if ( (ptr=fdopen((int)fd->i, (char *)type->a.pname))==NULL) + + return(nil); + + return(P(ptr)); + +} + + + +lispval + +Lexece() + +{ + + lispval fname, arglist, envlist, temp; + + char *args[100], *envs[100], estrs[1024]; + + char *p, *cp, **sp; + + snpand(0); + + - chkarg(3); +++ switch(np-lbot) { +++ case 0: +++ protect(nil); +++ case 1: +++ protect(nil); +++ case 2: +++ protect(nil); +++ case 3: +++ break; +++ default: +++ argerr("exece"); +++ } + + envlist = (--np)->val; + + arglist = (--np)->val; + + fname = (--np)->val; - if (TYPE(fname)!=ATOM) - return(nil); - if (TYPE(arglist)!=DTPR && arglist!=nil) - return(nil); +++ while (TYPE(fname)!=ATOM) +++ fname = error("exece: non atom function name",TRUE); +++ while (TYPE(arglist)!=DTPR && arglist!=nil) +++ arglist = error("exece: non list arglist",TRUE); + + for (sp=args; arglist!=nil; arglist=arglist->d.cdr) { + + temp = arglist->d.car; + + if (TYPE(temp)!=ATOM) - return(nil); +++ error("exece: non atom argument seen",FALSE); + + *sp++ = temp->a.pname; + + } + + *sp = 0; + + if (TYPE(envlist)!=DTPR && envlist!=nil) + + return(nil); + + for (sp=envs,cp=estrs; envlist!=nil; envlist=envlist->d.cdr) { + + temp = envlist->d.car; + + if (TYPE(temp)!=DTPR || TYPE(temp->d.car)!=ATOM + + || TYPE(temp->d.cdr)!=ATOM) - return(nil); +++ error("exece: Bad enviroment list",FALSE); + + *sp++ = cp; + + for (p=temp->d.car->a.pname; (*cp++ = *p++);) ; + + *(cp-1) = '='; + + for (p=temp->d.cdr->a.pname; (*cp++ = *p++);) ; + + } + + *sp = 0; - execve(fname->a.pname, args, envs); - return(nil); +++ +++ return(inewint(execve(fname->a.pname, args, envs))); + +} + + +++int gensymcounter = 0; /* should really be in data.c */ +++ + +lispval + +Lgensym() + +{ + + lispval arg; + + char leader; - static int counter = 0; +++ snpand(0); + + - chkarg(1); +++ if(lbot-np==0)protect(nil); + + arg = lbot->val; + + leader = 'g'; + + if (arg != nil && TYPE(arg)==ATOM) + + leader = arg->a.pname[0]; - sprintf(strbuf, "%c%05d", leader, counter++); +++ sprintf(strbuf, "%c%05d", leader, gensymcounter++); + + atmlen = 7; + + return((lispval)newatom()); + +} + +extern struct types { + +char *next_free; + +int space_left, + + space, + + type, + + type_len; /* note type_len is in units of int */ + +lispval *items, + + *pages, + + *type_name; + +struct heads + + *first; + +} atom_str ; + + + +lispval + +Lremprop() + +{ + + register struct argent *argp; + + register lispval pptr, ind, opptr; + + register struct argent *lbot, *np; + + lispval atm; + + int disemp = FALSE; + + - chkarg(2); +++ chkarg(2,"remprop"); + + argp = lbot; + + ind = argp[1].val; + + atm = argp->val; + + switch (TYPE(atm)) { + + case DTPR: - pptr = atm->cdr; +++ pptr = atm->d.cdr; + + disemp = TRUE; + + break; + + case ATOM: + + if((lispval)atm==nil) + + pptr = nilplist; + + else - pptr = atm->plist; +++ pptr = atm->a.plist; + + break; + + default: + + errorh(Vermisc, "remprop: Illegal first argument :", + + nil, FALSE, 0, atm); + + } + + opptr = nil; + + if (pptr==nil) + + return(nil); + + while(TRUE) { - if (TYPE(pptr->cdr)!=DTPR) +++ if (TYPE(pptr->d.cdr)!=DTPR) + + errorh(Vermisc, "remprop: Bad property list", + + nil, FALSE, 0,atm); - if (pptr->car == ind) { +++ if (pptr->d.car == ind) { + + if( opptr != nil) - opptr->cdr = pptr->cdr->cdr; +++ opptr->d.cdr = pptr->d.cdr->d.cdr; + + else if(disemp) - atm->cdr = pptr->cdr->cdr; +++ atm->d.cdr = pptr->d.cdr->d.cdr; + + else if(atm==nil) - nilplist = pptr->cdr->cdr; +++ nilplist = pptr->d.cdr->d.cdr; + + else - atm->plist = pptr->cdr->cdr; - return(pptr->cdr); +++ atm->a.plist = pptr->d.cdr->d.cdr; +++ return(pptr->d.cdr); + + } - if ((pptr->cdr)->cdr == nil) return(nil); - opptr = pptr->cdr; - pptr = (pptr->cdr)->cdr; +++ if ((pptr->d.cdr)->d.cdr == nil) return(nil); +++ opptr = pptr->d.cdr; +++ pptr = (pptr->d.cdr)->d.cdr; + + } + +} + + + +lispval + +Lbcdad() + +{ + + lispval ret, temp; + + - chkarg(1); +++ chkarg(1,"bcdad"); + + temp = lbot->val; + + if (TYPE(temp)!=ATOM) + + error("ONLY ATOMS HAVE FUNCTION BINDINGS", FALSE); - temp = temp->fnbnd; +++ temp = temp->a.fnbnd; + + if (TYPE(temp)!=BCD) + + return(nil); + + ret = newint(); + + ret->i = (int)temp; + + return(ret); + +} + + + +lispval + +Lstringp() + +{ - chkarg(1); +++ chkarg(1,"stringp"); + + if (TYPE(lbot->val)==STRNG) + + return(tatom); + + return(nil); + +} + + + +lispval + +Lsymbolp() + +{ - chkarg(1); +++ chkarg(1,"symbolp"); + + if (TYPE(lbot->val)==ATOM) + + return(tatom); + + return(nil); + +} + + + +lispval + +Lrematom() + +{ + + register lispval temp; + + - chkarg(1); +++ chkarg(1,"rematom"); + + temp = lbot->val; + + if (TYPE(temp)!=ATOM) + + return(nil); + + temp->a.fnbnd = nil; + + temp->a.pname = (char *)CNIL; + + temp->a.plist = nil; + + (atom_items->i)--; + + (atom_str.space_left)++; + + temp->a.clb=(lispval)atom_str.next_free; + + atom_str.next_free=(char *) temp; + + return(tatom); + +} + + + +#define QUTMASK 0200 + +#define VNUM 0000 + + + +lispval + +Lprname() + +{ + + lispval a, ret; + + register lispval work, prev; + + char *front, *temp; int clean; + + char ctemp[100]; + + extern char *ctable; + + snpand(2); + + - chkarg(1); +++ chkarg(1,"prname"); + + a = lbot->val; + + switch (TYPE(a)) { + + case INT: + + sprintf(ctemp,"%d",a->i); + + break; + + + + case DOUB: + + sprintf(ctemp,"%f",a->r); + + break; + + + + case ATOM: - temp = front = a->pname; +++ temp = front = a->a.pname; + + clean = *temp; + + if (*temp == '-') temp++; + + clean = clean && (ctable[*temp] != VNUM); + + while (clean && *temp) + + clean = (!(ctable[*temp++] & QUTMASK)); + + if (clean) + + strcpyn(ctemp, front, 99); + + else + + sprintf(ctemp,"\"%s\"",front); + + break; + + + + default: + + error("prname does not support this type", FALSE); + + } + + temp = ctemp; + + protect(ret = prev = newdot()); + + while (*temp) { - prev->cdr = work = newdot(); +++ prev->d.cdr = work = newdot(); + + strbuf[0] = *temp++; + + strbuf[1] = 0; - work->car = getatom(); - work->cdr = nil; +++ work->d.car = getatom(); +++ work->d.cdr = nil; + + prev = work; + + } - return(ret->cdr); +++ return(ret->d.cdr); + +} + +Lexit() + +{ + + register lispval handy; + + if(np-lbot==0) exit(0); + + handy = lbot->val; + + if(TYPE(handy)==INT) + + exit(handy->i); + + exit(-1); + +} + +lispval + +Iimplode(unintern) + +{ + + register lispval handy, work; + + register char *cp = strbuf; + + extern int atmlen; /* used by newatom and getatom */ + + - chkarg(1); - for(handy = lbot->val; handy!=nil; handy = handy->cdr) +++ chkarg(1,"implode"); +++ for(handy = lbot->val; handy!=nil; handy = handy->d.cdr) + + { - work = handy->car; +++ work = handy->d.car; + + if(cp >= endstrb) + + errorh(Vermisc,"maknam/impode argument exceeds buffer",nil,FALSE,43,lbot->val); + + again: + + switch(TYPE(work)) + + { + + case ATOM: - *cp++ = work->pname[0]; +++ *cp++ = work->a.pname[0]; + + break; + + case SDOT: + + case INT: + + *cp++ = work->i; + + break; + + case STRNG: + + *cp++ = * (char *) work; + + break; + + default: + + work = errorh(Vermisc,"implode/maknam: Illegal type for this arg:",nil,FALSE,44,work); + + goto again; + + } + + } + + *cp = 0; + + if(unintern) return((lispval)newatom()); + + else return((lispval) getatom()); + +} + + + +lispval + +Lmaknam() + +{ + + return(Iimplode(TRUE)); /* unintern result */ + +} + + + +lispval + +Limplode() + +{ + + return(Iimplode(FALSE)); /* intern result */ + +} +++ +++lispval +++Lintern() +++{ +++ register int hash; +++ register lispval handy,atpr; +++ register char *name; +++ +++ +++ chkarg(1,"intern"); +++ if(TYPE(handy=lbot->val) != ATOM) +++ errorh(Vermisc,"non atom to intern ",nil,FALSE,0,handy); +++ /* compute hash of pname of arg */ +++ hash = hashfcn(handy->a.pname); +++ +++ /* search for atom with same pname on hash list */ +++ +++ atpr = (lispval) hasht[hash]; +++ for(atpr = (lispval) hasht[hash] +++ ; atpr != CNIL +++ ; atpr = (lispval)atpr->a.hshlnk) +++ { +++ if(strcmp(atpr->a.pname,handy->a.pname) == 0) return(atpr); +++ } +++ +++ /* not there yet, put the given one on */ +++ +++ handy->a.hshlnk = hasht[hash]; +++ hasht[hash] = (struct atom *)handy; +++ return(handy); +++} diff --cc usr/src/cmd/lisp/lam8.c index 0000000000,1afb28cff2,0000000000..ae8e8f7e85 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lam8.c +++ b/usr/src/cmd/lisp/lam8.c @@@@ -1,0 -1,156 -1,0 +1,886 @@@@ +++static char *sccsid = "@(#)lam8.c 34.5 11/7/80"; +++ + +#include "global.h" +++#include +++#include +++#include "naout.h" + + + +/* various functions from the c math library */ + +double sin(),cos(),asin(),acos(),atan2(),sqrt(), log(), exp(); +++extern int current; + + + +lispval Imath(func) - double func(); +++double (*func)(); + +{ + + register lispval handy; + + register double res; - chkarg(1); +++ chkarg(1,"Math functions"); + + + + switch(TYPE(handy=lbot->val)) { + + case INT: res = func((double)handy->i); + + break; + + + + case DOUB: res = func(handy->r); + + break; + + + + default: error("Non fixnum or flonum to math function",FALSE); + + } + + handy = newdoub(); + + handy->r = res; + + return(handy); + +} + +lispval Lsin() + +{ + + return(Imath(sin)); + +} + + + +lispval Lcos() + +{ + + return(Imath(cos)); + +} + + + +lispval Lasin() + +{ + + return(Imath(asin)); + +} + + + +lispval Lacos() + +{ + + return(Imath(acos)); + +} + + + +lispval Lsqrt() + +{ + + return(Imath(sqrt)); + +} + +lispval Lexp() + +{ + + return(Imath(exp)); + +} + + + +lispval Llog() + +{ + + return(Imath(log)); + +} + + + +/* although we call this atan, it is really atan2 to the c-world, + + that is, it takes two args + + */ + +lispval Latan() + +{ + + register lispval arg; + + register double arg1v; + + register double res; - chkarg(2); +++ chkarg(2,"arctan"); + + + + switch(TYPE(arg=lbot->val)) { + + + + case INT: arg1v = (double) arg->i; + + break; + + + + case DOUB: arg1v = arg->r; + + break; + + + + default: error("Non fixnum or flonum arg to atan2",FALSE); + + } + + + + switch(TYPE(arg = (lbot+1)->val)) { + + + + case INT: res = atan2(arg1v,(double) arg->i); + + break; + + + + case DOUB: res = atan2(arg1v, arg->r); + + break; + + + + default: error("Non fixnum or flonum to atan2",FALSE); + + } + + arg = newdoub(); + + arg->r = res; + + return(arg); + +} + + + +/* (random) returns a fixnum in the range -2**30 to 2**30 -1 + + (random fixnum) returns a fixnum in the range 0 to fixnum-1 + + */ + +lispval + +Lrandom() + +{ + + register int curval; + + float pow(); + + + + curval = rand(); /* get numb from 0 to 2**31-1 */ + + + + if(np==lbot) return(inewint(curval-(int)pow((double)2,(double)30))); + + + + if((TYPE(lbot->val) != INT) + + || (lbot->val->i <= 0)) errorh(Vermisc,"random: non fixnum arg:", + + nil, FALSE, 0, lbot->val); + + + + return(inewint(curval % lbot->val->i )); + + + +} + +lispval + +Lmakunb() + +{ + + register lispval work; + + - chkarg(1); +++ chkarg(1,"makunbound"); + + work = lbot->val; + + if(work==nil || (TYPE(work)!=ATOM)) + + return(work); - work->clb = CNIL; +++ work->a.clb = CNIL; + + return(work); + +} + +lispval + +Lpolyev() + +{ + + register int count; + + register double *handy, *base; + + register struct argent *argp, *lbot, *np; + + lispval result; int type; + + + + count = 2 * (((int) np) - (int) lbot); + + if(count == 0) + + return(inewint(0)); + + if(count == 8) + + return(lbot->val); + + base = handy = (double *) alloca(count); + + for(argp = lbot; argp < np; argp++) { + + while((type = TYPE(argp->val))!=DOUB && type!=INT) + + argp->val = (lispval) errorh(Vermisc,"%%machine-polyev:non-real arg",nil,TRUE,73,lbot,argp->val); + + if(TYPE(argp->val)==INT) { + + *handy++ = argp->val->i; + + } else + + *handy++ = argp->val->r; + + } + + count = count/sizeof(double) - 2; + + asm("polyd (r9),r11,8(r9)"); + + asm("movd r0,(r9)"); + + result = newdoub(); + + result->r = *base; + + return(result); + +} +++typedef struct doub { +++ unsigned short f1:7,expt:8,sign:1; +++ unsigned short f2,f3p1:14,f3p2:2,f4; +++} *dp; +++ +++typedef struct quad2 { +++ unsigned long g4:16,g3p1:14; +++} *qp2; +++ +++typedef struct quad1 { +++ unsigned long g3p2:2,g2:16,g1:7,hide:1; +++} *qp1; +++ +++static long workbuf[2]; +++static int exponent; +++static Idebig() +++{ +++ register lispval work; +++ register dp rdp; +++ register qp1 rqp1; +++ register qp2 rqp2; +++ register struct argent *lbot,np; +++ workbuf[1] = workbuf[0] = 0; +++ +++ work = lbot->val; /* Unfold mantissa */ +++ rqp2 = (qp2) workbuf + 1; +++ rqp1 = (qp1) workbuf; +++ rdp = (dp) work; +++ rqp2->g4 = rdp->f4; +++ rqp2->g3p1 = rdp->f3p1; +++ rqp1->g3p2 = rdp->f3p2; +++ rqp1->g2 = rdp->f2; +++ rqp1->g1 = rdp->f1; +++ rqp1->hide = 1; +++ if(rdp->sign) { +++ workbuf[0] = (- workbuf[0]); +++ if(workbuf[1] = (- workbuf[1]) & 0xC0000000) +++ workbuf[0]--; +++ } +++ /* calcuate exponent and adjustment */ +++ exponent = -129 - 55 + (int) rdp->expt; +++} +++lispval +++Lfdecom() +++{ +++ register lispval result, handy; +++ register dum1,dum2; +++ register struct argent *lbot,*np; +++ +++ chkarg(1,"Decompose-float"); +++ while(TYPE(lbot->val)!=DOUB) +++ lbot->val = error("Decompose-float: Non-real argument",TRUE); +++ Idebig(); +++ np++->val = result = handy = newdot(); +++ handy->d.car = inewint(exponent); +++ handy = handy->d.cdr = newdot(); +++ handy = handy->d.car = newsdot(); +++ handy->s.I = workbuf[1]; +++ handy = handy->s.CDR = newsdot(); +++ handy->s.I = workbuf[0]; +++} +++ +++lispval +++Lfseek() +++{ +++ register lispval result, handy; +++ register dum1,dum2; +++ register struct argent *lbot,*np; +++ +++ FILE *f; +++ long disk_addr, offset, whence; +++ lispval retp; +++ +++ chkarg(3,"fseek"); /* Make sure there are three arguments*/ +++ +++ f = lbot->val->p; /* Get first argument into f */ +++ if (TYPE(lbot->val)!=PORT) /* Check type of first */ +++ error("fseek: First argument must be a port.",FALSE); +++ +++ offset = lbot[1].val->i; /* Get second argument */ +++ if (TYPE(lbot[1].val)!=INT) +++ error("fseek: Second argument must be an integer.",FALSE); +++ +++ whence = lbot[2].val->i; /* Get last arg */ +++ if (TYPE(lbot[2].val)!=INT) +++ error("fseek: Third argument must be an integer.",FALSE); +++ +++ if (fseek(f, offset, whence) == -1) +++ error("fseek: Illegal parameters.",FALSE); +++ +++ retp = inewint(ftell(f)); +++ +++ return((lispval) retp); +++} +++ +++/* function hashtabstat : return list of number of members in each bucket */ +++lispval Lhashst() +++{ +++ register lispval handy,cur; +++ register struct atom *pnt; +++ int i,cnt; +++ extern int hashtop; +++ snpand(3); +++ +++ handy = newdot(); +++ protect(handy); +++ cur = handy; +++ for(i = 0; i < hashtop; i++) +++ { +++ pnt = hasht[i]; +++ for(cnt = 0; pnt != (struct atom *) CNIL ; pnt=pnt->hshlnk , cnt++); +++ cur->d.cdr = newdot(); +++ cur = cur->d.cdr; +++ cur->d.car = inewint(cnt); +++ } +++ cur->d.cdr = nil; +++ return(handy->d.cdr); +++} +++ +++ +++/* Lctcherr +++ this routine should only be called by the unwind protect simulation +++ lisp code +++ It is called after an unwind-protect frame has been entered and +++ evalated and we want to get on with the error or throw +++ We only handle the case where there are 0 to 2 extra arguments to the +++ error call. +++*/ +++lispval +++Lctcherr() +++{ +++ register lispval handy; +++ lispval type,messg,valret,contuab,uniqid,datum1,datum2; +++ snpand(1); +++ +++ if(lbot-np==0) protect(nil); +++ if((handy = lbot->val) == nil) return(nil); +++ +++ if(handy->d.car == tatom) +++ { /* continuaing a throw */ +++ Idothrow(handy->d.cdr->d.car, handy->d.cdr->d.cdr->d.car); +++ error("ctcherr: throw label gone!",FALSE); +++ } +++ +++ /* decode the arg list */ +++ handy = handy->d.cdr; +++ type = handy->d.car; +++ handy = handy->d.cdr; +++ messg = handy->d.car; +++ handy = handy->d.cdr; +++ valret = handy->d.car; +++ handy = handy->d.cdr; +++ contuab = handy->d.car; +++ handy = handy->d.cdr; +++ uniqid = handy->d.car; +++ handy = handy->d.cdr; +++ +++ /* if not extra args */ +++ if(handy == nil) +++ { +++ errorh(type,messg->a.pname,valret,contuab->i,uniqid->i); +++ } +++ datum1 = handy->d.car; +++ handy = handy->d.cdr; +++ +++ /* if one extra arg */ +++ if(handy == nil) +++ { +++ errorh(type,messg->a.pname,valret,contuab->i,uniqid->i,datum1); +++ } +++ +++ /* if two or more extra args, just use first 2 */ +++ datum2 = handy->d.car; +++ errorh(type,messg->a.pname,valret,contuab->i,uniqid->i,datum1,datum2); +++} +++ +++/* +++ * (*makhunk ') +++ * +++ * Create a hunk of size 2 . must be between 0 and 6. +++ * +++ */ +++ +++lispval +++LMakhunk() +++{ +++ register int hsize, hcntr; +++ register lispval result; +++ +++ chkarg(1,"Makehunk"); +++ if (TYPE(lbot->val)==INT) +++ { +++ hsize = lbot->val->i; /* size of hunk (0-6) */ +++ if ((hsize >= 0) && (hsize <= 6)) +++ { +++ result = newhunk(hsize); +++ hsize = 2 << hsize; /* size of hunk (2-128) */ +++ for (hcntr = 0; hcntr < hsize; hcntr++) +++ result->h.hunk[hcntr] = hunkfree; +++ } +++ else +++ error("*makhunk: Illegal hunk size", FALSE); +++ return(result); +++ } +++ else +++ error("*makhunk: First arg must be an fixnum",FALSE); +++} +++ +++/* +++ * (cxr ' ') +++ * Returns the 'th element of +++ * +++ */ +++lispval +++Lcxr() +++{ +++ register lispval temp; +++ +++ chkarg(2,"cxr"); +++ if (TYPE(lbot->val)!=INT) +++ error("cxr: First arg must be a fixnum", FALSE); +++ else +++ { +++ if (! HUNKP(lbot[1].val)) +++ error("cxr: Second arg must be a hunk", FALSE); +++ else +++ if ( (lbot->val->i >= 0) && +++ (lbot->val->i < (2 << HUNKSIZE(lbot[1].val))) ) +++ { +++ temp = lbot[1].val->h.hunk[lbot->val->i]; +++ if (temp != hunkfree) +++ return(temp); +++ else +++ error("cxr: Arg outside of hunk range", +++ FALSE); +++ } +++ else +++ error("cxr: Arg outside of hunk range", FALSE); +++ } +++} +++ +++/* +++ * (rplacx ' ' ') +++ * Replaces the 'th element of with . +++ * +++ */ +++lispval +++Lrplacx() +++{ +++ lispval *handy; +++ chkarg(3,"rplacx"); +++ if (TYPE(lbot->val)!=INT) +++ error("rplacx: First arg must be a fixnum", FALSE); +++ else +++ { +++ if (! HUNKP(lbot[1].val)) +++ error("rplacx: Second arg must be a hunk", FALSE); +++ else +++ { +++ if ( (lbot->val->i >= 0) && +++ (lbot->val->i < (2 << HUNKSIZE(lbot[1].val))) ) +++ { +++ if (*(handy = &(lbot[1].val->h.hunk[lbot->val->i])) +++ != hunkfree) +++ *handy = lbot[2].val; +++ else +++ error("rplacx: Arg outside hunk range", FALSE); +++ } +++ else +++ error("rplacx: Arg outside hunk range", FALSE); +++ } +++ } +++ return(lbot[1].val); +++} +++ +++/* +++ * (*rplacx ' ' ') +++ * Replaces the 'th element of with . This is the +++ * same as (rplacx ...) except with this function you can replace EMPTY's. +++ * +++ */ +++lispval +++Lstarrpx() +++{ +++ chkarg(3,"*rplacx"); +++ if (TYPE(lbot->val)!=INT) +++ error("*rplacx: First arg must be a fixnum", FALSE); +++ else +++ { +++ if (! HUNKP(lbot[1].val)) +++ error("*rplacx: Second arg must be a hunk", FALSE); +++ else +++ { +++ if ( (lbot->val->i >= 0) && +++ (lbot->val->i < (2 << HUNKSIZE(lbot[1].val))) ) +++ lbot[1].val->h.hunk[lbot->val->i] = lbot[2].val; +++ else +++ error("*rplacx: Arg outside hunk range", FALSE); +++ } +++ } +++ return(lbot[1].val); +++} +++ +++/* +++ * (hunksize ') +++ * Returns the size of +++ * +++ */ +++lispval +++Lhunksize() +++{ +++ register int size,i; +++ +++ chkarg(1,"hunksize"); +++ if (HUNKP(lbot->val)) +++ { +++ size = 2 << HUNKSIZE(lbot->val); +++ for (i = size-1; i >= 0; i--) +++ { +++ if (lbot->val->h.hunk[i] != hunkfree) +++ { +++ size = i + 1; +++ break; +++ } +++ } +++ return( inewint(size) ); +++ } +++ else +++ error("hunksize: First argument must me a hunk", FALSE); +++} +++ +++/* +++ * (fileopen filename mode) +++ * open a file for read, write, or append the arguments can be either +++ * strings or atoms. +++ */ +++lispval +++Lfileopen() +++{ +++ FILE *port; +++ register lispval name; +++ register lispval mode; +++ register char *namech; +++ register char *modech; +++ register struct argent *lbot, *np; +++ int typ; +++ +++ chkarg(2,"fileopen"); +++ name = lbot->val; +++ mode = lbot[1].val; +++ +++ namech = (char *) verify(name,"fileopen:args must be atoms or strings"); +++ modech = (char *) verify(mode,"fileopen:args must be atoms or strings"); +++ +++ while (modech[0] != 'r' && modech[0] != 'w' && modech[0] != 'a') +++ { +++ mode = errorh(Vermisc,"Modes are only r, w, a.",nil,TRUE,31,(char *) 0); +++ modech = (char *) verify(mode,"fileopen:args must be atoms or strings"); +++ } +++ +++ while ((port = fopen(namech, modech)) == NULL) +++ { +++ name = errorh(Vermisc,"Unable to open file.",nil,TRUE,31,name); +++ namech = (char *) verify(name,"fileopen:args must be atoms or strings"); +++ } +++ /* xports is a FILE *, cc complains about adding pointers */ +++ +++ return( (lispval) (xports + (port - _iob))); +++} +++ +++/* +++ * (*mod ' ') +++ * This function returns mod (for balanced modulus). +++ * It is used in vaxima as a speed enhancement. +++ */ +++lispval +++LstarMod() +++{ +++ register int mod_div_2, number, modulus; +++ +++ chkarg(2,"*mod"); +++ if ((TYPE(lbot->val) == INT) && (TYPE(lbot[1].val) == INT)) +++ { +++ modulus = lbot[1].val->i; +++ number = lbot->val->i % modulus; +++ mod_div_2 = modulus / 2; +++ if (number < 0) +++ { +++ if (number < (-mod_div_2)) +++ number += modulus; +++ } +++ else +++ { +++ if (number > mod_div_2) +++ number -= modulus; +++ } +++ return( inewint(number) ); +++ } +++ else +++ error("*mod: Arguments must be fixnums", FALSE); +++} +++lispval +++Llsh() +++{ +++ register struct argent *mylbot = lbot; +++ int val,shift; +++ +++ chkarg(2,"lsh"); +++ if((TYPE(mylbot->val) != INT) || (TYPE(mylbot[1].val) != INT)) +++ errorh(Vermisc, +++ "Non ints to lsh", +++ nil,FALSE,0,mylbot->val,mylbot[1].val); +++ val = mylbot[0].val->i; +++ shift = mylbot[1].val->i; +++ if(shift < -32 || shift > 32) +++ return(inewint(0)); +++ val = val << shift; /* do the shift */ +++ if((val < 0) && (shift < 0)) +++ { /* special case: the vax doesn't have a logical shift +++ instruction, so we must zero out the ones which +++ will propogate from the sign position +++ */ +++ return(inewint ( val & ~(0x80000000 << (shift+1)))); +++ } +++ else return( inewint(val)); +++} +++ +++lispval +++Lrot() +++{ +++ register rot,val; /* these must be the first registers */ +++ register struct argent *mylbot = lbot; +++ +++ chkarg(2,"rot"); +++ if((TYPE(mylbot->val) != INT) || (TYPE(mylbot[1].val) != INT)) +++ errorh(Vermisc, +++ "Non ints to rot", +++ nil,FALSE,0,mylbot->val,mylbot[1].val); +++ val = mylbot[0].val->i; +++ rot = mylbot[1].val->i; +++ rot = rot % 32 ; /* bring it down below one byte in size */ +++ asm(" rotl r11,r10,r10 "); /* rotate val by rot and put back in val */ +++ return( inewint(val)); +++} +++ +++/*----------------- vms routines to simulate dumplisp -------------------- */ +++#ifdef VMS +++ +++extern char firstalloc[]; +++extern int lsbrkpnt; +++extern char zfreespace[]; +++extern int end; +++ +++#define roundup(a,b) (((a-1)|(b-1))+1) +++lispval +++Lsavelsp() +++{ +++ char *filnm; +++ int fp,i,num,start; +++ +++ chkarg(1,"savelisp"); +++ +++ filnm = (char *) verify(lbot->val, "savelisp: non atom arg"); +++ if((fp=creat(filnm,0666)) < 0) +++ errorh(Vermisc,"savelisp: can't open file",nil,FALSE,0, +++ lbot->val); +++ start = roundup((int)firstalloc,PAGSIZ); +++ num = roundup(((int)lsbrkpnt)-NBPG-start,PAGSIZ); +++ if((num = write(fp,start,num)) <= 0) +++ error("savelisp: write failed ",FALSE); +++ printf(" %x bytes written from %x to %x \n",num,start,start+num-1); +++ close(fp); +++ return(tatom); +++} +++ +++lispval +++Lrestlsp() +++{ +++ char *filnm; +++ int fp,i,num,start; +++ extern int xcycle; +++ +++ chkarg(1,"restorelisp"); +++ +++ filnm = (char *) verify(lbot->val,"restorelisp: non atom arg"); +++ if((fp=open(filnm,0)) < 0) +++ errorh(Vermisc,"restorelisp: can't open file",nil,FALSE,0, +++ lbot->val); +++ +++ start = roundup((int)firstalloc,PAGSIZ); +++ if((num = vread(fp,start,((int)&end)-start)) <= 0) +++ error("restorelisp: read failed " ,FALSE); +++ printf(" %x bytes read into %x to %x\n",num,start,start+num-1); +++ xcycle = 0; /* indicate no saved pages to xsbrk */ +++ close(fp); +++ bnp = orgbnp; +++ lbot = np = orgnp; +++ contval = 0; +++ reset(BRRETB); /* reset */ +++} +++#endif +++ +++/*----------------------------------------------------------- */ +++ +++ +++/* getaddress -- +++ * +++ * (getaddress '|_entry1| 'fncname1 '|_entry2| 'fncname2 ...) +++ * +++ * binds value of symbol |_entry1| to function defition of atom fncname1, etc. +++ * +++ * returns fnc-binding of fncname1. +++ * +++ */ +++ +++lispval +++Lgetaddress(){ +++ register struct argent *mlbot = lbot; +++ register lispval work; +++ register int numberofargs, i; +++ register struct argent *lbot, *np; +++ char *gstab(); +++ char ostabf[128]; +++ struct nlist NTABLE[100]; +++ lispval dispget(); +++ +++ snpand(2); +++ +++ if(np-lbot == 2) protect(nil); /* allow 2 args */ +++ numberofargs = (np - lbot)/3; +++ if(numberofargs * 3 != np-lbot) +++ error("getaddress: arguments must come in triples ",FALSE); +++ +++ for ( i=0; ia.pname); +++ } +++ NTABLE[(numberofargs)].n_un.n_name = ""; +++ strcpyn(ostabf,gstab(),128); +++ if ( nlist(ostabf,NTABLE) == -1 ) { +++ errorh(Vermisc,"Getaddress: Bad file",nil,FALSE,0,inewstr(ostabf)); +++ } else +++ for (i=0,mlbot=lbot+1; ibcd.entry = (lispval (*) ())NTABLE[i].n_value; +++ work->bcd.discipline = mlbot[1].val; +++ mlbot->val->a.fnbnd = work; +++ } +++ }; +++ return(lbot[1].val->a.fnbnd); +++}; +++ +++/* very temporary function to test the validity of the bind stack */ +++ +++bndchk() +++{ +++ register struct nament *npt; +++ register lispval in2; +++ +++ in2 = inewint(200); +++ for(npt=orgbnp; npt < bnp; npt++) +++ { if((int) npt->atm < (int) in2) asm(" halt "); +++ } +++} +++ +++/* +++ * formatted printer for lisp data +++ * use: (cprintf formatstring datum [port]) +++ */ +++lispval +++Lcprintf() +++{ +++ FILE *p; +++ char *fstrng; +++ lispval v; +++ if(np-lbot == 2) protect(nil); /* write to standard output port */ +++ chkarg(3,"cprintf"); +++ +++ fstrng = (char *)verify(lbot->val,"cprintf: first arg not string or symbol"); +++ +++ p = okport(lbot[2].val,okport(Vpoport->a.clb,poport)); +++ +++ switch(TYPE(v=lbot[1].val)) { +++ +++ case INT: fprintf(p,fstrng,v->i); +++ break; +++ +++ case DOUB: fprintf(p,fstrng,v->r); +++ break; +++ +++ case ATOM: fprintf(p,fstrng,v->a.pname); +++ break; +++ +++ case STRNG:fprintf(p,fstrng,v); +++ break; +++ +++ default: error("cprintf: Illegal second argument",FALSE); +++ }; +++ +++ return(lbot[1].val); +++} +++ +++lispval +++Lprobef() +++{ +++ char *name; +++ chkarg(1,"probef"); +++ +++ name = (char *)verify(lbot->val,"probef: not symbol or string arg "); +++ +++ if(access(name,0) == 0) return(tatom); +++ else return(nil); +++} +++ +++lispval +++Lsubstring() +++{ register char *name; +++ register lispval index,length; +++ int restofstring = FALSE; +++ int len,ind,reallen; +++ extern char strbuf[]; +++ +++ switch (np-lbot) +++ { +++ case 2: restofstring = TRUE; +++ break; +++ +++ case 3: break; +++ +++ default: chkarg(3,"substring"); +++ } +++ +++ name = (char *)verify(lbot[0].val,"substring: not symbol or string arg "); +++ +++ while (TYPE(index = lbot[1].val) != INT) +++ { lbot[1].val = errorh(Vermisc,"substring: non integer index ",nil, +++ TRUE,0,index); +++ } +++ +++ len = strlen(name); +++ ind = index->i; +++ +++ if(ind < 0) ind = len+1 + ind; +++ +++ if(ind < 1 || ind > len) return(nil); /*index out of bounds*/ +++ if(restofstring) return((lispval)inewstr(name+ind-1)); +++ +++ while (TYPE(length = lbot[2].val) != INT) +++ { lbot[2].val = errorh(Vermisc,"substring: not integer length ",nil, +++ TRUE,0,length); +++ } +++ +++ if((reallen = length->i ) < 0 || (reallen + ind) > len) +++ return((lispval)inewstr(name+ind-1)); +++ +++ strncpy(strbuf,name+ind-1,reallen); +++ strbuf[reallen] = '\0'; +++ return((lispval)newstr()); +++} +++ +++lispval +++Lsubstringn() +++{ +++ register char *name; +++ register int len,ind,reallen; +++ lispval index,length; +++ int restofstring = FALSE; +++ snpand(4); +++ +++ if((np-lbot) == 2) restofstring = TRUE; +++ else { chkarg(3,"substringn");} +++ +++ name = (char *) verify(lbot[0].val,"substringn: non symbol or string arg "); +++ +++ while (TYPE(index = lbot[1].val) != INT) +++ { lbot[1].val = errorh(Vermisc,"substringn: non integer index ",nil, +++ TRUE,0,index); +++ } +++ +++ if(!restofstring) +++ { +++ while (TYPE(length = lbot[2].val) != INT) +++ { lbot[2].val = errorh(Vermisc,"substringn: not integer length ", +++ nil, TRUE,0,length); +++ } +++ reallen = length->i; +++ } +++ else reallen = -1; +++ +++ len = strlen(name); +++ ind = index->i; +++ if(ind < 0) ind = len + 1 + ind; +++ if( ind < 1 || ind > len) return(nil); +++ +++ if(reallen == 0) +++ return((lispval)inewint(*(name + ind - 1))); +++ else { +++ char *pnt = name + ind - 1; +++ char *last = name + len -1; +++ lispval cur,start; +++ +++ protect(cur = start = newdot()); +++ cur->d.car = inewint(*pnt); +++ while(++pnt <= last && --reallen != 0) +++ { +++ cur->d.cdr = newdot(); +++ cur = cur->d.cdr; +++ cur->d.car = inewint(*pnt); +++ } +++ return(start); +++ } +++ +++} +++ diff --cc usr/src/cmd/lisp/lamnop.c index 0000000000,0000000000,0000000000..84b2f29f5b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/lamnop.c @@@@ -1,0 -1,0 -1,0 +1,15 @@@@ +++static char *sccsid = "@(#)lamnop.c 34.1 10/3/80"; +++ +++#include "global.h" +++ +++short pbuf[8]; +++ +++/* data space for fasl to put counters */ +++int mcounts[1]; +++int mcountp = (int) mcounts; +++int doprof = FALSE; +++ +++Lmonitor() +++{ +++ error("Profiling not enabled",FALSE); +++} diff --cc usr/src/cmd/lisp/lamr.c index 0000000000,ea6427ebfd,0000000000..bb93b3a218 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lamr.c +++ b/usr/src/cmd/lisp/lamr.c @@@@ -1,0 -1,482 -1,0 +1,503 @@@@ +++static char *sccsid = "@(#)lamr.c 34.3 10/31/80"; +++ + +# include "global.h" - # include + + + +/************************************************************************/ + +/* */ + +/* Lalloc */ + +/* */ + +/* This lambda allows allocation of pages from lisp. The first */ + +/* argument is the name of a space, n pages of which are allocated, */ + +/* if possible. Returns the number of pages allocated. */ + + + +lispval + +Lalloc() + + { + + int n; + + register struct argent *mylbot = lbot; + + snpand(1); - chkarg(2); +++ chkarg(2,"alloc"); + + if(TYPE((mylbot+1)->val) != INT && (mylbot+1)->val != nil ) + + error("2nd ARGUMENT TO ALLOCATE MUST BE AN INTEGER",FALSE); + + n = 1; + + if((mylbot+1)->val != nil) n = (mylbot+1)->val->i; + + return(alloc((mylbot)->val,n)); /* call alloc to do the work */ + + } + + + +lispval + +Lsizeof() + + { - chkarg(1); +++ chkarg(1,"sizeof"); + + return(inewint(csizeof(lbot->val))); + + } + + + +lispval + +Lsegment() + + { - chkarg(2); +++ chkarg(2,"segment"); + +chek: while(TYPE(np[-1].val) != INT ) + + np[-1].val=error("LENGTH ARG TO SEGMENT MUST BE INTEGER",TRUE); + + if( np[-1].val->i < 0 ) + + { + + np[-1].val = error("LENGTH ARG TO SEGMENT MUST BE POSITIVE",TRUE); + + goto chek; + + } - return(csegment((lbot)->val,np[-1].val->i)); +++ return(csegment((lbot)->val,np[-1].val->i,FALSE)); + + } + + + +/* Lforget *************************************************************/ + +/* */ + +/* This function removes an atom from the hash table. */ + + + +lispval + +Lforget() + + { + + char c,*name; + + struct atom *buckpt; + + int hash; - chkarg(1); +++ chkarg(1,"forget"); + + if(TYPE(lbot->val) != ATOM) - error("CANNOT FORGET NON-ATOM",FALSE); - name = lbot->val->pname; - hash = 0; - while( (c = *name++) != NULL_CHAR) hash ^= c; - hash = hash & 0177; +++ error("remob: non-atom argument",FALSE); +++ name = lbot->val->a.pname; +++ hash = hashfcn(name); + + + + /* We have found the hash bucket for the atom, now we remove it */ + + + + if( hasht[hash] == (struct atom *)lbot->val ) + + { - hasht[hash] = lbot->val->hshlnk; - lbot->val->hshlnk = (struct atom *)CNIL; +++ hasht[hash] = lbot->val->a.hshlnk; +++ lbot->val->a.hshlnk = (struct atom *)CNIL; + + return(lbot->val); + + } + + + + buckpt = hasht[hash]; + + while(buckpt != (struct atom *)CNIL) + + { + + if(buckpt->hshlnk == (struct atom *)lbot->val) + + { - buckpt->hshlnk = lbot->val->hshlnk; - lbot->val->hshlnk = (struct atom *)CNIL; +++ buckpt->hshlnk = lbot->val->a.hshlnk; +++ lbot->val->a.hshlnk = (struct atom *)CNIL; + + return(lbot->val); + + } + + buckpt = buckpt->hshlnk; + + } + + + + /* Whoops! Guess it wasn't in the hash table after all. */ + + + + return(lbot->val); + + } + + + +lispval + +Lgetl() + + { - chkarg(1); +++ chkarg(1,"getlength"); + + if(TYPE(lbot->val) != ARRAY) + + error("ARG TO GETLENGTH MUST BE AN ARRAY",TRUE); - return(lbot->val->length); +++ return(lbot->val->ar.length); + + } + + + +lispval + +Lputl() + + { - chkarg(2); +++ chkarg(2,"putlength"); + + if(TYPE((lbot)->val) != ARRAY) + + error("ARG TO PUTLENGTH MUST BE AN ARRAY",FALSE); + +chek: while(TYPE(np[-1].val) != INT) + + np[-1].val = error("ARRAY LENGTH MUST BE AN INTEGER",FALSE); + + if(np[-1].val->i <= 0) + + { + + np[-1].val = error("ARRAY LENGTH MUST BE POSITIVE",TRUE); + + goto chek; + + } - return((lbot)->val->length = np[-1].val); +++ return((lbot)->val->ar.length = np[-1].val); + + } + +lispval + +Lgetdel() + + { - chkarg(1); +++ chkarg(1,"getdelta"); + + if(TYPE(lbot->val) != ARRAY) + + error("ARG TO GETDELTA MUST BE AN ARRAY",FALSE); - return(lbot->val->delta); +++ return(lbot->val->ar.delta); + + } + + + +lispval + +Lputdel() + + { - chkarg(2); +++ chkarg(2,"putdelta"); + + if(TYPE((np-2)->val) != ARRAY) + + error("ARG TO PUTDELTA MUST BE AN ARRAY",FALSE); + +chek: while(TYPE(np[-1].val) != INT) + + np[-1].val = error("ARRAY LENGTH MUST BE AN INTEGER",TRUE); + + if(np[-1].val->i <= 0) + + { - np[-1].val = error("ARRAY DELTA MUST BE POSITIVE",TRUE); +++ np[-1].val = error("Array delta must be positive",TRUE); + + goto chek; + + } - return((lbot)->val->delta = np[-1].val); +++ return((lbot)->val->ar.delta = np[-1].val); + + } + + + +lispval + +Lgetaux() + + { - chkarg(1); +++ chkarg(1,"getaux"); + + if(TYPE(lbot->val)!=ARRAY) - error("ARG TO GETAUX MUST BE ARRAY",FALSE); - return(lbot->val->aux); +++ error("Arg to getaux must be an array", FALSE); +++ return(lbot->val->ar.aux); + + } + + + +lispval + +Lputaux() + + { - chkarg(2); +++ chkarg(2,"putaux"); + + + + if(TYPE((lbot)->val)!=ARRAY) - error("1st ARG TO PUTAUX MUST BBE ARRAY",FALSE); - return((lbot)->val->aux = np[-1].val); +++ error("1st Arg to putaux must be array", FALSE); +++ return((lbot)->val->ar.aux = np[-1].val); +++ } +++ +++lispval +++Lgetdata() +++ { +++ chkarg(1,"getdata"); +++ if(TYPE(lbot->val)!=ARRAY) +++ error("Arg to getdata must be an array", FALSE); +++ return((lispval)lbot->val->ar.data); +++ } +++ +++lispval +++Lputdata() +++ { +++ chkarg(2,"putdata"); +++ +++ if(TYPE((lbot)->val)!=ARRAY) +++ error("1st Arg to putaux must be array", FALSE); +++ return((lbot)->val->ar.data = (char *)np[-1].val); + + } + + + +lispval + +Lgeta() + + { - chkarg(1); +++ chkarg(1,"getaccess"); + + if(TYPE(lbot->val) != ARRAY) + + error("ARG TO GETACCESS MUST BE AN ARRAY",FALSE); - return(lbot->val->accfun); +++ return(lbot->val->ar.accfun); + + } + + + +lispval + +Lputa() + + { - chkarg(2); +++ chkarg(2,"putaccess"); + + if(TYPE((lbot)->val) != ARRAY) + + error("ARG TO PUTACCESS MUST BE ARRAY",FALSE); - return((lbot)->val->accfun = np[-1].val); +++ return((lbot)->val->ar.accfun = np[-1].val); + + } + + + +lispval + +Lmarray() + +{ + + register struct argent *mylbot = lbot; + + register lispval handy; + + snpand(2); - chkarg(5); +++ chkarg(5,"marray"); + + (handy = newarray()); /* get a new array cell */ - handy->data=(char *)mylbot->val;/* insert data address */ - handy->accfun = mylbot[1].val; /* insert access function */ - handy->aux = mylbot[2].val; /* insert aux data */ - handy->length = mylbot[3].val; /* insert length */ - handy->delta = mylbot[4].val; /* push delta arg */ +++ handy->ar.data=(char *)mylbot->val;/* insert data address */ +++ handy->ar.accfun = mylbot[1].val; /* insert access function */ +++ handy->ar.aux = mylbot[2].val; /* insert aux data */ +++ handy->ar.length = mylbot[3].val; /* insert length */ +++ handy->ar.delta = mylbot[4].val; /* push delta arg */ + + return(handy); + + } + + + +lispval + +Lgetentry() + + { - chkarg(1); +++ chkarg(1,"getentry"); + + if( TYPE(lbot->val) != BCD ) + + error("ARG TO GETENTRY MUST BE FUNCTION",FALSE); - return((lispval)(lbot->val->entry)); +++ return((lispval)(lbot->val->bcd.entry)); + + } + + + +lispval + +Lgetlang() + + { - chkarg(1); +++ chkarg(1,"getlang"); + + while(TYPE(lbot->val)!=BCD) + + lbot->val = error("ARG TO GETLANG MUST BE FUNCTION DESCRIPTOR",TRUE); - return(lbot->val->language); +++ return(lbot->val->bcd.language); + + } + + + +lispval + +Lputlang() + + { - chkarg(2); +++ chkarg(2,"putlang"); + + while(TYPE((lbot)->val)!=BCD) + + lbot->val = error("FIRST ARG TO PUTLANG MUST BE FUNCTION DESCRIPTOR",TRUE); - (lbot)->val->language = np[-1].val; +++ (lbot)->val->bcd.language = np[-1].val; + + return(np[-1].val); + + } + + + +lispval + +Lgetparams() + + { - chkarg(1); +++ chkarg(1,"getparams"); + + if(TYPE(np[-1].val)!=BCD) + + error("ARG TO GETPARAMS MUST BE A FUNCTION DESCRIPTOR",FALSE); - return(np[-1].val->params); +++ return(np[-1].val->bcd.params); + + } + + + +lispval + +Lputparams() + + { - chkarg(2); +++ chkarg(2,"putparams"); + + if(TYPE((lbot)->val)!=BCD) + + error("1st ARG TO PUTPARAMS MUST BE FUNCTION DESCRIPTOR",FALSE); - return((lbot)->val->params = np[-1].val); +++ return((lbot)->val->bcd.params = np[-1].val); + + } + + + +lispval + +Lgetdisc() + + { - chkarg(1); +++ chkarg(1,"getdisc"); + + if(TYPE(np[-1].val) != BCD) + + error("ARGUMENT OF GETDISC MUST BE FUNCTION",FALSE); - return(np[-1].val->discipline); +++ return(np[-1].val->bcd.discipline); + + } + + + +lispval + +Lputdisc() + + { - chkarg(2); +++ chkarg(2,"putdisc"); + + if(TYPE(np[-2].val) != BCD) + + error("ARGUMENT OF PUTDISC MUST BE FUNCTION",FALSE); - return((np-2)->val->discipline = np[-1].val); +++ return((np-2)->val->bcd.discipline = np[-1].val); + + } + + + +lispval + +Lgetloc() + + { - chkarg(1); +++ chkarg(1,"getloc"); + + if(TYPE(lbot->val)!=BCD) + + error("ARGUMENT TO GETLOC MUST BE FUNCTION",FALSE); - return(lbot->val->loctab); +++ return(lbot->val->bcd.loctab); + + } + + + +lispval + +Lputloc() + + { - chkarg(2); +++ chkarg(2,"putloc"); + + if(TYPE((lbot+1)->val)!=BCD); + + error("FIRST ARGUMENT TO PUTLOC MUST BE FUNCTION",FALSE); - (lbot)->val->loctab = (lbot+1)->val; +++ (lbot)->val->bcd.loctab = (lbot+1)->val; + + return((lbot+1)->val); + + } + + + +lispval + +Lmfunction() + + { + + register lispval handy; - chkarg(5); +++ chkarg(2,"mfunction"); + + handy = (newfunct()); /* get a new function cell */ - handy->entry = (lispval (*)())((np-5)->val); /* insert entry point */ - handy->discipline = ((np-4)->val); /* insert discipline */ +++ handy->bcd.entry = (lispval (*)())((np-5)->val); /* insert entry point */ +++ handy->bcd.discipline = ((np-4)->val); /* insert discipline */ + +#ifdef ROWAN + + handy->language = (np-3)->val; /* insert language */ + + handy->params = ((np-2)->val); /* insert parameters */ + + handy->loctab = ((np-1)->val); /* insert local table */ + +#endif + + return(handy); + + } + + + +/** Lreplace ************************************************************/ + +/* */ + +/* Destructively modifies almost any kind of data. */ + + + +lispval + +Lreplace() + + { + + register lispval a1, a2; + + register int t; - chkarg(2); +++ chkarg(2,"replace"); + + + + if((t = TYPE(a1 = (lbot)->val)) != TYPE(a2 = np[-1].val)) + + error("REPLACE ARGS MUST BE SAME TYPE",FALSE); + + + + switch( t ) + + { - case ATOM: error("REPLACE CANNOT STORE ATOMS",FALSE); + + + + case VALUE: a1->l = a2->l; + + return( a1 ); + + + + case INT: a1->i = a2->i; + + return( a1 ); + + - case STRNG: error("STORE CANNOT STORE STRINGS",FALSE); + + - case ARRAY: a1->data = a2->data; - a1->accfun = a2->accfun; - a1->length = a2->length; - a1->delta = a2->delta; +++ case ARRAY: a1->ar.data = a2->ar.data; +++ a1->ar.accfun = a2->ar.accfun; +++ a1->ar.length = a2->ar.length; +++ a1->ar.delta = a2->ar.delta; + + return( a1 ); + + + + case DOUB: a1->r = a2->r; + + return( a1 ); + + + + case SDOT: - case DTPR: a1->car = a2->car; - a1->cdr = a2->cdr; +++ case DTPR: a1->d.car = a2->d.car; +++ a1->d.cdr = a2->d.cdr; + + return( a1 ); - case BCD: a1->entry = a2->entry; - a1->discipline = a2->discipline; +++ case BCD: a1->bcd.entry = a2->bcd.entry; +++ a1->bcd.discipline = a2->bcd.discipline; + + return( a1 ); +++ default: +++ errorh(Vermisc,"Replace: cannot handle the type of this arg", +++ nil,FALSE,0,a1); + + } + + /* NOT REACHED */ + + } + + + +/* Lvaluep */ + + + +lispval + +Lvaluep() + + { - chkarg(1); +++ chkarg(1,"valuep"); + + if( TYPE(lbot->val) == VALUE ) return(tatom); else return(nil); + + } + + + +CNTTYP() { return; /* HI! COUNT ONE TYPE CALL! */ } + + + +lispval + +Lod() + + { + + int i; - chkarg(2); +++ chkarg(2,"od"); + + + + while( TYPE(np[-1].val) != INT ) + + np[-1].val = error("2nd ARG TO OD MUST BE INTEGER",TRUE); + + + + for( i = 0; i < np->val->i; ++i ) - printf(copval(odform,CNIL)->pname,(int *)(np[-2].val)[i]); +++ printf(copval(odform,CNIL)->a.pname,((int *)(np[-2].val))[i]); + + + + dmpport(poport); + + return(nil); + + } + +lispval + +Lfake() + + { - chkarg(1); +++ chkarg(1,"fake"); + + + + if( TYPE(lbot->val) != INT ) + + error("ARG TO FAKE MUST BE INTEGER",TRUE); + + + + return((lispval)(lbot->val->i)); + + } + + +++ /* this used to be Lwhat, but was changed to Lmaknum for maclisp +++ compatiblity +++ */ + +lispval - Lwhat() +++Lmaknum() + + { - chkarg(1); +++ chkarg(1,"maknum"); + + return(inewint((int)(lbot->val))); + + } + + + +lispval + +Lpname() + + { - chkarg(1); +++ chkarg(1,"pname"); + + if(TYPE(lbot->val) != ATOM) + + error("ARG TO PNAME MUST BE AN ATOM",FALSE); - return((lispval)(lbot->val->pname)); +++ return((lispval)(lbot->val->a.pname)); + + } + + + +lispval + +Larrayref() + + { - chkarg(2); +++ chkarg(2,"arrayref"); + + if(TYPE((lbot)->val) != ARRAY) + + error("FIRST ARG TO ARRAYREF MUST BE ARRAY",FALSE); + + vtemp = (lbot + 1)->val; + +chek: while(TYPE(vtemp) != INT) + + vtemp = error("SECOND ARG TO ARRAYREF MUST BE INTEGER",TRUE); + + if( vtemp->i < 0 ) + + { + + vtemp = error("NEGATIVE ARRAY OFFSET",TRUE); + + goto chek; + + } - if( vtemp->i >= (np-2)->val->length->i ) +++ if( vtemp->i >= (np-2)->val->ar.length->i ) + + { + + vtemp = error("ARRAY OFFSET TOO LARGE",TRUE); + + goto chek; + + } - vtemp = (lispval)((np-2)->val->data + ((np-2)->val->delta->i)*(vtemp->i)); +++ vtemp = (lispval)((np-2)->val->ar.data + ((np-2)->val->ar.delta->i)*(vtemp->i)); + + /* compute address of desired item */ + + return(vtemp); + + + + } + + + +lispval + +Lptr() + + { - chkarg(1); +++ chkarg(1,"ptr"); + + return(inewval(lbot->val)); + + } + + + +lispval + +Llctrace() + + { - chkarg(1); - lctrace = (int)(lbot->val->clb); +++ chkarg(1,"lctrace"); +++ lctrace = (int)(lbot->val->a.clb); + + return((lispval)lctrace); + + } + + + +lispval + +Lslevel() + + { + + return(inewint(np-orgnp-2)); + + } + + + +lispval + +Lsimpld() + + { + + register lispval pt; + + register char *cpt = strbuf; + + - chkarg(1); +++ chkarg(1,"simpld"); + + - for(atmlen=1, pt=np->val; NOTNIL(pt); ++atmlen, pt = pt->cdr); +++ for(atmlen=1, pt=np->val; NOTNIL(pt); ++atmlen, pt = pt->d.cdr); + + + + if( atmlen > STRBLEN ) + + { + + error("LCODE WAS TOO LONG",TRUE); + + return((lispval)inewstr("")); + + } + + - for(pt=np->val; NOTNIL(pt); pt = pt->cdr) *(cpt++) = pt->car->i; +++ for(pt=np->val; NOTNIL(pt); pt = pt->d.cdr) *(cpt++) = pt->d.car->i; + + *cpt = 0; + + + + return((lispval)newstr()); + + } + + + + + +/* Lopval *************************************************************/ + +/* */ + +/* Routine which allows system registers and options to be examined */ + +/* and modified. Calls copval, the routine which is called by c code */ + +/* to do the same thing from inside the system. */ + + + +lispval + +Lopval() + + { + + lispval quant; + + snpand(0); + + + + if( lbot == np ) + + return(error("BAD CALL TO OPVAL",TRUE)); + + quant = lbot->val; /* get name of sys variable */ + + while( TYPE(quant) != ATOM ) + + quant = error("FIRST ARG TO OPVAL MUST BE AN ATOM",TRUE); + + + + if(np > lbot+1) vtemp = (lbot+1)->val ; + + else vtemp = CNIL; + + return(copval(quant,vtemp)); + +} - diff --cc usr/src/cmd/lisp/lisp.c index 0000000000,04c28372e5,0000000000..d73dc05cda mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/lisp.c +++ b/usr/src/cmd/lisp/lisp.c @@@@ -1,0 -1,81 -1,0 +1,90 @@@@ +++static char *sccsid = "@(#)lisp.c 34.1 10/3/80"; +++ + +#include "global.h" + + + +/* main *****************************************************************/ + +/* Execution of the lisp system begins here. This is the top level */ + +/* executor which is an infinite loop. The structure is similar to */ + +/* error. */ + + + +extern char _sobuf[]; + +extern lispval reborn; + +extern int rlevel; + +static int virgin = 0; + +int Xargc; + +char **Xargv; +++extern int environ; + + - main(argc,argv) +++main(argc,argv,arge) + +char **argv; + +{ + + lispval temp, matom(); + + extern int errp; +++ extern int holbeg,holend,usehole; +++ extern int *curhbeg; +++ + + snpand(0); + + +++ environ = arge; + + setbuf(stdout,_sobuf); + + Xargc = argc; + + Xargv = argv; + + virgin = 0; + + initial(); + +/* printf("poport = 0%o\n",poport); */ + + while(retval = setexit()) + + switch (retval) { + + + + case BRGOTO: error("GOTO LABEL NOT FOUND",FALSE); + + + + case BRRETN: error("NO PROG TO RETURN FROM",FALSE); + + + + case BRRETB: + + default: popnames(orgbnp); + + + + } + + for(EVER) { + + lbot = np = orgnp; + + rlevel = 0; + + depth = 0; + + errp = 0; + + clearerr(piport = stdin); + + clearerr(poport = stdout); + + np++->val = matom("top-level"); + + np++->val = nil; + + Lapply(); + + } + +} + +Ntpl() + +{ - lispval Lread(); +++ lispval Lread(),Istsrch(); + + snpand(0); + + + + if (virgin == 0) { - fputs("Franz Lisp, Opus 32",poport); +++ fputs(Istsrch(matom("version"))->d.cdr->d.cdr->d.cdr,poport); + + virgin = 1; + + } + + lbot = np; + + np++->val = P(stdin); + + np++->val = eofa; + + while (TRUE) + + { + + fputs("\n-> ",stdout); + + dmpport(stdout); + + vtemp = Lread(); + + if(vtemp == eofa) exit(0); + + printr(eval(vtemp),stdout); + + } + + } + + +++#ifndef VMS + +exit(code) + +{ + + extern int fvirgin; + + extern char *stabf; + + if(!fvirgin) unlink(stabf); + + _cleanup(); + + proflush(); + + _exit(code); + +} +++#endif diff --cc usr/src/cmd/lisp/mcount.s index 0000000000,0000000000,0000000000..6075c2046e new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/mcount.s @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++ .asciz "@(#)mcount.s 34.1 10/3/80" +++# count subroutine called during profiling +++ +++.globl mcount +++.globl _mcount +++.comm _countbase,4 +++ +++_mcount: +++mcount: +++ movl (r0),r1 +++ beql init +++incr: +++ incl (r1) +++return: +++ rsb +++init: +++ movl _countbase,r1 +++ beql return +++ addl2 $8,_countbase +++ movl (sp),(r1)+ +++ movl r1,(r0) +++ brb incr diff --cc usr/src/cmd/lisp/nfasl.c index 0000000000,0000000000,0000000000..6f7d1fef37 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/nfasl.c @@@@ -1,0 -1,0 -1,0 +1,670 @@@@ +++static char *sccsid = "@(#)nfasl.c 34.5 10/13/80"; +++ +++#include "global.h" +++#include +++#include +++#include "naout.h" +++#include "chkrtab.h" +++#include "structs.h" +++ +++/* fasl - fast loader j.k.foderaro +++ * this loader is tuned for the lisp fast loading application +++ * any changes in the system loading procedure will require changes +++ * to this file +++ * +++ * The format of the object file we read as input: +++ * text segment: +++ * 1) program text - this comes first. +++ * 2) binder table - one word entries, see struct bindage +++ * begins with symbol: bind_org +++ * 3) litterals - exploded lisp objects. +++ * begins with symbol: lit_org +++ * ends with symbol: lit_end +++ * data segment: +++ * not used +++ * +++ * +++ * these segments are created permanently in memory: +++ * code segment - contains machine codes to evaluate lisp functions. +++ * linker segment - a list of pointers to lispvals. This allows the +++ * compiled code to reference constant lisp objects. +++ * The first word of the linker segment is a gc link +++ * pointer and does not point to a literal. The +++ * symbol binder is assumed to point to the second +++ * longword in this segment. The last word in the +++ * table is -1 as a sentinal to the gc marker. +++ * The number of real entries in the linker segment +++ * is given as the value of the linker_size symbol. +++ * Taking into account the 2 words required for the +++ * gc, there are 4*linker_size + 8 bytes in this segment. +++ * transfer segment - this is a transfer table block. It is used to +++ * allow compiled code to call other functions +++ * quickly. The number of entries in the transfer table is +++ * given as the value of the trans_size symbol. +++ * +++ * the following segments are set up in memory temporarily then flushed +++ * binder segment - a list of struct bindage entries. They describe +++ * what to do with the literals read from the literal +++ * table. The binder segment begins in the file +++ * following the bindorg symbol. +++ * literal segment - a list of characters which _Lread will read to +++ * create the lisp objects. The order of the literals +++ * is: +++ * linker literals - used to fill the linker segment. +++ * transfer table literals - used to fill the +++ * transfer segment +++ * binder literals - these include names of functions +++ * to bind interspersed with forms to evaluate. +++ * The meanings of the binder literals is given by +++ * the values in the binder segment. +++ * string segment - this is the string table from the file. We have +++ * to allocate space for it in core to speed up +++ * symbol referencing. +++ * +++ */ +++ +++ +++/* external functions called or referenced */ +++ +++lispval qcons(),qlinker(),qget(); +++int _qf0(), _qf1(), _qf2(), _qf3(), _qf4(), _qfuncl(), svkludg(),qnewint(); +++lispval Lread(), Lcons(), Lminus(), Ladd1(), Lsub1(), Lplist(), Lputprop(); +++lispval Lprint(), Lpatom(), Lconcat(), Lget(), Lmapc(), Lmapcan(); +++lispval Llist(), Ladd(), Lgreaterp(), Lequal(), Ltimes(), Lsub(); +++lispval Lncons(); +++lispval Idothrow(),error(); +++lispval Istsrch(); +++int mcount(); +++extern int mcounts[],mcountp,doprof; +++ +++extern lispval *tynames[]; +++extern long errp; +++extern char _erthrow[]; +++extern char setsav[]; +++ +++extern int initflag; /* when TRUE, inhibits gc */ +++ +++char *alloca(); /* stack space allocator */ +++ +++/* mini symbol table, contains the only external symbols compiled code +++ is allowed to reference +++ */ +++ +++#define SYMMAX 16 +++struct ssym { char *fnam; /* pointer to string containing name */ +++ int floc; /* address of symbol */ +++ int ord; /* ordinal number within cur sym tab */ +++ +++ } Symbtb[SYMMAX] +++ = { +++ "trantb", 0, -1, /* must be first */ +++ "linker", 0, -1, /* must be second */ +++ "mcount", (int) mcount, -1, +++ "mcounts", (int) mcounts, -1, +++ "_qnewint", (int) qnewint, -1, +++ "_qcons", (int) qcons, -1, +++ "_typetable", (int) typetable, -1, +++ "_tynames", (int) tynames, -1, +++ "_qget", (int) qget, -1, +++ "_errp", (int) &errp, -1, +++ "_Idothrow", (int) Idothrow, -1, +++ "__erthrow", (int) _erthrow, -1, +++ "_error", (int) error, -1, +++ "_setsav", (int) setsav, -1, +++ "_svkludg", (int) svkludg, -1, +++ "_bnp", (int) &bnp, -1, +++ }; +++ +++struct nlist syml; /* to read a.out symb tab */ +++extern lispval *bind_lists; /* gc binding lists */ +++ +++/* bindage structure: +++ * the bindage structure describes the linkages of functions and name, +++ * and tells which functions should be evaluated. It is mainly used +++ * for the non-fasl'ing of files, we only use one of the fields in fasl +++ */ +++struct bindage +++{ +++ int b_type; /* type code, as described below */ +++}; +++ +++/* the possible values of b_type +++ * -1 - this is the end of the bindage entries +++ * 0 - this is a lambda function +++ * 1 - this is a nlambda function +++ * 2 - this is a macro function +++ * 99 - evaluate the string +++ * +++ */ +++ +++ +++extern struct trtab *trhead; /* head of list of transfer tables */ +++extern struct trent *trcur; /* next entry to allocate */ +++extern int trleft; /* # of entries left in this transfer table */ +++ +++struct trent *gettran(); /* function to allocate entries */ +++ +++/* maximum number of functions */ +++#define MAXFNS 500 +++ +++lispval Lnfasl() +++{ +++ extern int holend,usehole; +++ extern int uctolc; +++ extern char *curhbeg; +++ struct argent *svnp; +++ struct exec exblk; /* stores a.out header */ +++ FILE *filp, *p, *map; /* file pointer */ +++ int domap,note_redef; +++ lispval handy,debugmode; +++ struct relocation_info reloc; +++ struct trent *tranloc; +++ int trsize; +++ lispval disp; +++ int i,j,times, *iptr, oldinitflag; +++ int funloc[MAXFNS]; /* addresses of functions rel to txt org */ +++ int funcnt = 0; +++ +++ /* symbols whose values are taken from symbol table of .o file */ +++ int bind_org = 0; /* beginning of bind table */ +++ int lit_org = 0; /* beginning of literal table */ +++ int lit_end; /* end of literal table */ +++ int trans_size = 0; /* size in entries of transfer table */ +++ int linker_size; /* size in bytes of linker table +++ (not counting gc ptr) */ +++ +++ /* symbols which hold the locations of the segments in core and +++ * in the file +++ */ +++ char *code_core_org, /* beginning of code segment */ +++ *linker_core_org, /* beginning of linker segment */ +++ *linker_core_end, /* last word in linker segment */ +++ *literal_core_org, /* beginning of literal table */ +++ *binder_core_org, /* beginning of binder table */ +++ *string_core_org; +++ +++ int string_file_org, /* location of string table in file */ +++ string_size, /* number of chars in string table */ +++ segsiz; /* size of permanent incore segment */ +++ +++ char *symbol_name; +++ struct bindage *bindorg, *curbind; +++ int linkerloc, typer; +++ lispval rdform, *linktab; +++ int ouctolc; +++ int debug = 0; +++ lispval currtab,curibase; +++ char ch,*filnm; +++ char tempfilbf[100]; +++ +++ +++ switch(np-lbot) { +++ case 0: +++ protect(nil); +++ case 1: +++ protect(nil); +++ case 2: +++ protect(nil); +++ case 3: +++ break; +++ default: +++ argerr("fasl"); +++ } +++ filnm = (char *) verify(lbot->val,"fasl: non atom arg"); +++ +++ +++ domap = FALSE; +++ /* debugging */ +++ debugmode = Istsrch(matom("debugging"))->d.cdr->d.cdr->d.cdr; +++ /* end debugging */ +++ +++ +++ /* insure that the given file name ends in .o +++ if it doesnt, copy to a new buffer and add a .o +++ */ +++ tempfilbf[0] = '\0'; +++ if( (i = strlen(filnm)) < 2 || +++ strcmp(filnm+i-2,".o") != 0) +++ { +++ strcatn(tempfilbf,filnm,96); +++ strcat(tempfilbf,".o"); +++ filnm = tempfilbf; +++ } +++ +++ if ( (filp = fopen(filnm,"r")) == NULL) +++ errorh(Vermisc,"Can't open file",nil,FALSE,9797,lbot->val); +++ +++ if ((handy = (lbot+1)->val) != nil ) +++ { +++ if((TYPE(handy) != ATOM ) || +++ (map = fopen(handy->a.pname, +++ (Istsrch(matom("appendmap"))->d.cdr->d.cdr->d.cdr == nil +++ ? "w" : "a"))) == NULL) +++ error("fasl: can't open map file",FALSE); +++ else +++ { domap = TRUE; +++ /* fprintf(map,"Map of file %s\n",lbot->val->a.pname); */ +++ } +++ } +++ +++ /* set the note redefinition flag */ +++ if((lbot+2)->val != nil) note_redef = TRUE; +++ else note_redef = FALSE; +++ +++ printf("[fasl %s]",filnm); +++ fflush(stdout); +++ svnp = np; +++ +++ lbot = np; /* set up base for later calls */ +++ +++ +++ /* clear the ords in the symbol table */ +++ for(i=0 ; i < SYMMAX ; i++) Symbtb[i].ord = -1; +++ +++ if( read(fileno(filp),&exblk,sizeof(struct exec)) +++ != sizeof(struct exec)) +++ error("fasl: header read failed",FALSE); +++ +++ /* check that the magic number is valid */ +++ +++ if(exblk.a_magic != 0407) error("fasl: bad magic number in fasl file",FALSE); +++ +++ /* read in string table */ +++ lseek(fileno(filp),(string_file_org = N_STROFF(exblk)),0); +++ if( read(fileno(filp), &string_size , 4) != 4) +++ error("fasl: string table read error, probably old fasl format", FALSE); +++ +++ /* allocate space for string table on the stack */ +++ string_core_org = alloca(string_size - 4); +++ +++ if( read(fileno(filp), string_core_org , string_size - 4) +++ != string_size -4) error("fasl: string table read error ",FALSE); +++ /* read in symbol table and set the ordinal values */ +++ +++ fseek(filp,N_SYMOFF(exblk),0); +++ +++ times = exblk.a_syms/sizeof(struct nlist); +++ if(debug) printf(" %d symbols in symbol table\n",times); +++ +++ for(i=0; i < times ; i++) +++ { +++ if( fread(&syml,sizeof(struct nlist),1,filp) != 1) +++ error("fasl: Symb tab read error",FALSE); +++ +++ symbol_name = syml.n_un.n_strx - 4 + string_core_org; +++ if (syml.n_type == N_EXT) +++ { +++ for(j=0; j< SYMMAX; j++) +++ { +++ if((Symbtb[j].ord < 0) +++ && strcmp(Symbtb[j].fnam,symbol_name)==0) +++ { Symbtb[j].ord = i; +++ if(debug)printf("symbol %s ord is %d\n",symbol_name,i); +++ break; +++ }; +++ +++ }; +++ +++ if( j>=SYMMAX ) printf("Unknown symbol %s\n",symbol_name); +++ } +++ else if (((ch = symbol_name[0]) == 's') +++ || (ch == 'L') +++ || (ch == '.') ) ; /* skip this */ +++ else if (symbol_name[0] == 'F') +++ funloc[funcnt++] = syml.n_value; /* seeing function */ +++ else if (!bind_org && (strcmp(symbol_name, "bind_org") == 0)) +++ bind_org = syml.n_value; +++ else if (strcmp(symbol_name, "lit_org") == 0) +++ lit_org = syml.n_value; +++ else if (strcmp(symbol_name, "lit_end") == 0) +++ lit_end = syml.n_value; +++ else if (strcmp(symbol_name, "trans_size") == 0) +++ trans_size = syml.n_value; +++ else if (strcmp(symbol_name, "linker_size") == 0) +++ linker_size = syml.n_value; +++ } +++ +++ /* check to make sure we are working with the right format */ +++ if((lit_org == 0) || (lit_end == 0)) +++ errorh(Vermisc,"File not in new fasl format",nil,FALSE,0,lbot->val); +++ +++ /*----------------*/ +++ +++ /* read in text segment up to beginning of binder table */ +++ +++ segsiz = bind_org + 4*linker_size + 8 + 3; /* size is core segment size +++ * plus linker table size +++ * plus 2 for gc list +++ * plus 3 to round up to word +++ */ +++ +++ lseek(fileno(filp),(long)sizeof(struct exec),0); +++ code_core_org = (char *) csegment(str_name,segsiz/4,TRUE); +++ if(read(fileno(filp),code_core_org,bind_org) != bind_org) +++ error("Read error in text ",FALSE); +++ +++ if(debug) { +++ printf("Read %d bytes of text into 0x%x\n",bind_org,code_core_org); +++ printf(" incore segment size: %d (0x%x)\n",segsiz,segsiz); +++ } +++ +++ /* linker table is 2 entries (8 bytes) larger than the number of +++ * entries given by linker_size . There must be a gc word at +++ * the beginning and a -1 at the end +++ */ +++ linker_core_org = code_core_org + bind_org; +++ linker_core_end = linker_core_org + 4*linker_size + 4; +++ /* address of gc sentinal last */ +++ +++ if(debug)printf("lin_cor_org: %x, link_cor_end %x\n", +++ linker_core_org, +++ linker_core_end); +++ Symbtb[1].floc = (int) (linker_core_org + 4); +++ +++ /* set the linker table to all -1's so we can put in the gc table */ +++ for( iptr = (int *)(linker_core_org + 4 ); +++ iptr <= (int *)(linker_core_end); +++ iptr++) +++ *iptr = -1; +++ +++ +++ /* link our table into the gc tables */ +++ *(int *)linker_core_org = (int)bind_lists; /* point to current */ +++ bind_lists = (lispval *) (linker_core_org + 4); /* point to first item */ +++ +++ /* read the binder table and literals onto the stack */ +++ +++ binder_core_org = alloca(lit_end - bind_org); +++ read(fileno(filp),binder_core_org,lit_end-bind_org); +++ +++ literal_core_org = binder_core_org + lit_org - bind_org; +++ +++ /* check if there is a transfer table required for this +++ * file, and if so allocate one of the necessary size +++ */ +++ +++ if(trans_size > 0) +++ { +++ tranloc = gettran(trans_size); +++ Symbtb[0].floc = (int) tranloc; +++ } +++ +++ /* now relocate the necessary symbols in the text segment */ +++ +++ fseek(filp,(long)(sizeof(struct exec) + exblk.a_text + exblk.a_data),0); +++ times = (exblk.a_trsize)/sizeof(struct relocation_info); +++ +++ /* the only symbols we will relocate are references to +++ external symbols. They are recognized by +++ extern and pcrel set. +++ */ +++ +++ for( i=1; i<=times ; i++) +++ { +++ if( fread(&reloc,sizeof(struct relocation_info),1,filp) != 1) +++ error("Bad text reloc read",FALSE); +++ if(reloc.r_extern && reloc.r_pcrel) +++ { +++ for(j=0; j < SYMMAX; j++) +++ { +++ +++ if(Symbtb[j].ord == reloc.r_symbolnum) /* look for this sym */ +++ { +++ if(debug && FALSE) printf("Relocating %d (ord %d) at %x\n", +++ j, Symbtb[j].ord, reloc.r_address); +++ if (Symbtb[j].floc == (int) mcounts) { +++ *(int *)(code_core_org+reloc.r_address) +++ += mcountp - (int)code_core_org; +++ if(doprof){ +++ if (mcountp == (int) &mcounts[NMCOUNT-2]) +++ printf("Ran out of counters; increas NMCOUNT in fasl.c\n"); +++ if (mcountp < (int) &mcounts[NMCOUNT-1]) +++ mcountp += 4; +++ } +++ } else +++ *(int *)(code_core_org+reloc.r_address) +++ += Symbtb[j].floc - (int)code_core_org; +++ +++ break; +++ +++ } +++ }; +++ if( j >= SYMMAX) if(debug) printf("Couldnt find ord # %d\n", +++ reloc.r_symbolnum); +++ } +++ +++ } +++ +++ putchar('\n'); +++ fflush(stdout); +++ +++ /* set up a fake port so we can read from core */ +++ /* first find a free port */ +++ +++ p = stdin; +++ for( ; p->_flag & (_IOREAD|_IOWRT) ; p++) +++ if( p >= _iob + _NFILE) +++ error(" No free file descriptor for fasl ",FALSE); +++ +++ p->_flag = _IOREAD | _IOSTRG; +++ p->_base = p->_ptr = (char *) literal_core_org; /* start at beginning of lit */ +++ p->_cnt = lit_end - lit_org; +++ +++ if(debug)printf("lit_org %d, charstrt %d\n",lit_org, p->_base); +++ /* the first forms we wish to read are those literals in the +++ * literal table, that is those forms referenced by an offset +++ * from r8 in compiled code +++ */ +++ +++ /* to read in the forms correctly, we must set up the read table +++ */ +++ currtab = Vreadtable->a.clb; +++ Vreadtable->a.clb = strtab; /* standard read table */ +++ curibase = ibase->a.clb; +++ ibase->a.clb = inewint(10); /* read in decimal */ +++ ouctolc = uctolc; /* remember value of uctolc flag */ +++ +++ oldinitflag = initflag; /* remember current val */ +++ initflag = TRUE; /* turn OFF gc */ +++ i = 1; +++ linktab = (lispval *)(linker_core_org +4); +++ while (linktab < (lispval *)linker_core_end) +++ { +++ np = svnp; +++ protect(P(p)); +++ uctolc = FALSE; +++ handy = Lread(); +++ uctolc = ouctolc; +++ getc(p); /* eat trailing blank */ +++ if(debugmode) +++ { printf("form %d read: ",i++); +++ printr(handy,stdout); +++ putchar('\n'); +++ fflush(stdout); +++ } +++ *linktab++ = handy; +++ } +++ +++ /* process the transfer table if one is used */ +++ trsize = trans_size; +++ while(trsize--) +++ { +++ np = svnp; +++ protect(P(p)); +++ uctolc = FALSE; +++ handy = Lread(); /* get function name */ +++ uctolc = ouctolc; +++ getc(p); +++ tranloc->name = handy; +++ tranloc->fcn = qlinker; /* initially go to qlinker */ +++ tranloc++; +++ } +++ +++ +++ +++ /* now process the binder table, which contains pointers to +++ functions to link in and forms to evaluate. +++ */ +++ funcnt = 0; +++ +++ curbind = (struct bindage *) binder_core_org; +++ for( ; curbind->b_type != -1 ; curbind++) +++ { +++ np = svnp; +++ protect(P(p)); +++ uctolc = FALSE; /* inhibit uctolc conversion */ +++ rdform = Lread(); +++ /* debugging */ +++ if(debugmode) { printf("link form read: "); +++ printr(rdform,stdout); +++ printf(" ,type: %d\n", +++ curbind->b_type); +++ fflush(stdout); +++ } +++ /* end debugging */ +++ uctolc = ouctolc; /* restore previous state */ +++ getc(p); /* eat trailing null */ +++ protect(rdform); +++ if(curbind->b_type <= 2) /* if function type */ +++ { +++ handy = newfunct(); +++ if (note_redef && (rdform->a.fnbnd != nil)) +++ { +++ printr(rdform,stdout); +++ printf(" redefined\n"); +++ } +++ rdform->a.fnbnd = handy; +++ handy->bcd.entry = (lispval (*)())(code_core_org + funloc[funcnt++]); +++ handy->bcd.discipline = +++ (curbind->b_type == 0 ? lambda : +++ curbind->b_type == 1 ? nlambda : +++ macro); +++ if(domap) fprintf(map,"%s\n%x\n",rdform->a.pname,handy->bcd.entry); +++ } +++ else { +++ Vreadtable->a.clb = currtab; +++ ibase->a.clb = curibase; +++ +++ /* debugging */ +++ if(debugmode) { +++ printf("Eval: "); +++ printr(rdform,stdout); +++ printf("\n"); +++ fflush(stdout); +++ }; +++ /* end debugging */ +++ +++ eval(rdform); /* otherwise eval it */ +++ +++ if(uctolc) ouctolc = TRUE; /* if changed by eval, remember */ +++ curibase = ibase->a.clb; +++ ibase->a.clb = inewint(10); +++ Vreadtable->a.clb = strtab; +++ } +++ }; +++ +++ p->_cnt = p->_file = p->_flag = 0; /* give up file descriptor */ +++ p->_ptr = p-> _base = (char *) 0; +++ initflag = oldinitflag; /* restore state of gc */ +++ Vreadtable->a.clb = currtab; +++ chkrtab(currtab); +++ ibase->a.clb = curibase; +++ +++ fclose(filp); +++ if(domap) fclose(map); +++ return(tatom); +++} +++ +++ +++/* gettran :: allocate a segment of transfer table of the given size */ +++ +++struct trent * +++gettran(size) +++{ +++ struct trtab *trp; +++ struct trent *retv; +++ int ousehole; +++ extern int usehole; +++ +++ if(size > TRENTS) +++ error("transfer table too large",FALSE); +++ +++ if(size > trleft) +++ { +++ /* allocate a new transfer table */ +++ /* must not allocate in the hole or we cant modify it */ +++ ousehole = usehole; /* remember old value */ +++ usehole = FALSE; +++ trp = (struct trtab *)csegment(str_name,sizeof(struct trtab),FALSE); +++ usehole = ousehole; +++ +++ trp->sentinal = 0; /* make sure the sentinal is 0 */ +++ trp->nxtt = trhead; /* link at beginning of table */ +++ trhead = trp; +++ trcur = &(trp->trentrs[0]); /* begin allocating here */ +++ trleft = TRENTS; +++ } +++ +++ trleft = trleft - size; +++ retv = trcur; +++ trcur = trcur + size; +++ return(retv); +++} +++ +++/* clrtt :: clear transfer tables, or link them all up; +++ * this has two totally opposite functions: +++ * 1) all transfer tables are reset so that all function calls will go +++ * through qlinker +++ * 2) as many transfer tables are set up to point to bcd functions +++ * as possible +++ */ +++clrtt(flag) +++{ +++ /* flag = 0 :: set to qlinker +++ * flag = 1 :: set to function bcd binding if possible +++ */ +++ register struct trtab *temptt; +++ register struct trent *tement; +++ register lispval fnb; +++ +++ for (temptt = trhead; temptt != 0 ; temptt = temptt->nxtt) +++ { +++ for(tement = &temptt->trentrs[0] ; tement->fcn != 0 ; tement++) +++ { if(flag == 0 || TYPE(fnb=tement->name->a.fnbnd) != BCD +++ || TYPE(fnb->bcd.discipline) == STRNG) +++ tement->fcn = qlinker; +++ else tement->fcn = fnb->bcd.entry; +++ } +++ } +++} +++ +++/* chktt - builds a list of transfer table entries which don't yet have +++ a function associated with them, i.e if this transfer table entry +++ were used, an undefined function error would result +++ */ +++lispval +++chktt() +++{ +++ register struct trtab *temptt; +++ register struct trent *tement; +++ register lispval retlst,curv; +++ +++ snpand(4); +++ +++ retlst = newdot(); /* build list of undef functions */ +++ protect(retlst); +++ for (temptt = trhead; temptt != 0 ; temptt = temptt->nxtt) +++ { +++ for(tement = &temptt->trentrs[0] ; tement->fcn != 0 ; tement++) +++ { +++ if(tement->name->a.fnbnd == nil) +++ { +++ curv= newdot(); +++ curv->d.car = tement->name; +++ curv->d.cdr = retlst->d.cdr; +++ retlst->d.cdr = curv; +++ } +++ } +++ } +++ return(retlst->d.cdr); +++} diff --cc usr/src/cmd/lisp/pbignum.c index 0000000000,38933bbe8b,0000000000..6173806ba1 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/pbignum.c +++ b/usr/src/cmd/lisp/pbignum.c @@@@ -1,0 -1,41 -1,0 +1,43 @@@@ +++static char *sccsid = "@(#)pbignum.c 34.1 10/3/80"; +++ + +#include "global.h" + + + +pbignum(current, useport) + +register lispval current; + +register FILE *useport; + +{ + + int *top, *bot, *work, negflag = 0, *sp(), *alloca(); + + register int *digitp, *binp; + + register lispval last; + + + + /* copy bignum onto stack */ + + top = sp() - 1; + + do { - stack(current->I); - } while(current = current->CDR); +++ stack(current->s.I); +++ } while(current = current->s.CDR); + + + + bot = sp(); + + if (top==bot) { + + fprintf(useport,"%d",*bot); + + return; + + } + + + + /* save space for printed digits*/ + + work = alloca((top-bot)*2*sizeof(int)); + + if( *bot < 0) { + + negflag = 1; + + dsneg(top,bot); + + } + + + + /* figure out nine digits at a time by destructive division*/ + + for(digitp = work; bot <= top; digitp++) { + + *digitp = dodiv(top,bot); + + if(*bot==0) bot += 1; + + } + + + + /* print them out */ + + + + if(negflag) putc('-',useport); + + fprintf(useport,"%d",*--digitp); + + while ( digitp > work) fprintf(useport,"%09d",*--digitp); + +} diff --cc usr/src/cmd/lisp/qfuncl.s index 0000000000,4b87e4b7ab,0000000000..5b3996acd6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/qfuncl.s +++ b/usr/src/cmd/lisp/qfuncl.s @@@@ -1,0 -1,84 -1,0 +1,258 @@@@ +++ +++ .asciz "@(#)qfuncl.s 34.1 10/3/80" + +# opus 30 compiler call to ??? interface routines + + .globl __qf0 + +__qf0: + + subl3 $4,r6,r7 + + jbr __qfuncl + + + + .globl __qf1 + +__qf1: + + subl3 $8,r6,r7 + + jbr __qfuncl + + + + .globl __qf2 + +__qf2: + + subl3 $12,r6,r7 + + jbr __qfuncl + + + + .globl __qf3 + +__qf3: + + subl3 $16,r6,r7 + + jbr __qfuncl + + + + .globl __qf4 + +__qf4: + + subl3 $20,r6,r7 + + jbr __qfuncl + + +++ .data +++qfunbuf: .long 0 +++qlinbuf: .long 0 +++ .text + + .globl __qfuncl + +__qfuncl: # quick function call +++# movab qfunbuf,r0 # profiling +++# jsb mcount # profiling + + cmpl r6,_nplim # make sure stack ok + + blss on1 + + calls $0,_namerr + +on1: movl (r7),r0 # bring in addr of atom +++ addl2 $4,r7 # inc lbot by one nament + + pushl r0 # stack addr of atom of fcn to call + + movl 8(r0),r0 # bring in fcn binding addr + + jleq nonexf # jump if fcn non existant +++ tstl _rsetsw # see if in *rset mode +++ jeql norset # if not, call function +++ tstl _bcdtrsw # if (*rset t) & (sstatus bcdtrace t) +++ jneq hackit # then have Lfuncal do the work +++norset: + + ashl $-9,r0,r1 # see if bcd + + cmpb $5,_typetable+1[r1] # we are calling + + jeql gotbcd + +hackit: + + calls $1,_Lfuncal # call lisp stuff - movl r7,r6 # restore np to top +++ movab -4(r7),r6 # restore np to top + + rsb # return to callee + +gotbcd: - addl2 $4,r7 # inc lbot by one nament + + calls $1,*(r0) # call code + + movab -4(r7),r6 # restore np to top + + rsb # return + + + +nonexf: # non existant function, call c function to take care of it, + + # we could process it here but wish to minimize assembly language + + # code. + + # we should never return from this call + + # the addr of the atom is already stacked + + +++# addl2 $4,r7 # inc lbot by one nament for evalframe + + calls $1,_Undeff # call handler + + clrl r0 # return nil to compiled code + + rsb # if ever should return here + + +++ +++ +++# transfer table linkage routine +++# +++ .globl _qlinker +++_qlinker: +++ .word 0xfc0 # save all possible registers +++# movab qlinbuf,r0 # profiling +++# jsb mcount # profiling +++ tstl _exception # any pending exceptions +++ jeql noexc +++ tstl _sigintcnt # is it because of SIGINT +++ jeql noexc # if not, just leave +++ pushl $2 # else push SIGINT +++ calls $1,_sigcall +++noexc: +++ movl 16(fp),r0 # get return pc +++ addl2 -4(r0),r0 # get pointer to table +++ movl 4(r0),r1 # get atom pointer +++retry: # come here after undef func error +++ movl 8(r1),r2 # get function binding +++ jleq nonex # if none, leave +++ tstl _stattab+2*4 # see if linking possible (Strans) +++ jeql nolink # no, it isn't +++ ashl $-9,r2,r3 # check type of function +++ cmpb $5,_typetable+1[r3] +++ jeql linkin # bcd, link it in! +++nolink: +++ pushl r1 # non, bcd, call interpreter +++ calls $1,_Lfuncal +++ ret +++ +++linkin: +++ ashl $-9,4(r2),r3 # check type of function discipline +++ cmpb $0,_typetable+1[r3] # is it string? +++ jeql nolink # yes, it is a c call, so dont link in +++ movl (r2),r2 # get function addr +++ movl r2,(r0) # put fcn addr in table +++ jmp 2(r2) # enter fcn after mask +++ +++nonex: pushl r1 # non existant fcn +++ calls $1,_Undeff # call processor +++ movl r0,r1 # back in r1 +++ jbr retry # for the retry. +++ +++ + + .globl __erthrow # errmessage for uncaught throws + +__erthrow: + + .byte 'U,'n,'c,'a,'u,'g,'h,'t,' ,'t,'h,'r,'o,'w + + .byte ' ,'f,'r,'o,'m,' ,'c,'o,'m,'p,'i,'l,'e,'d + + .byte ' ,'c,'o,'d,'e,0 + + + + .globl _tynames + +_tynames: + + .long 0 # nothing here + + .long _lispsys+20*4 # str_name + + .long _lispsys+21*4 # atom_name + + .long _lispsys+19*4 # int_name + + .long _lispsys+23*4 # dtpr_name + + .long _lispsys+22*4 # doub_name + + .long _lispsys+58*4 # funct_name + + .long _lispsys+83*4 # port_name + + .long _lispsys+47*4 # array_name + + .long 0 # nothing here + + .long _lispsys+50*4 # sdot_name + + .long _lispsys+53*4 # val_nam +++# +++# Quickly allocate small fixnums +++# +++ .globl _qnewint +++_qnewint: +++ cmpl r5,$1024 +++ jgeq alloc +++ cmpl r5,$-1024 +++ jlss alloc +++ moval Fixzero[r5],r0 +++ rsb +++alloc: +++ movl _int_str,r0 # move next cell addr to r0 +++ jlss callnewi # if no space, allocate +++ incl *_lispsys+24*4 # inc count of ints +++ movl (r0),_int_str # advance free list +++ movl r5,(r0) # put baby to bed. +++ rsb +++callnewi: +++ pushl r5 +++ calls $0,_newint +++ movl (sp)+,(r0) +++ rsb +++ .globl _qcons +++ +++# quick cons call, the car and cdr are stacked on the namestack +++# and this function is jsb'ed to. +++ +++_qcons: +++ movl _dtpr_str,r0 # move next cell addr to r0 +++ jlss getnew # if ran out of space jump +++ incl *_lispsys+28*4 # inc count of dtprs +++ movl (r0),_dtpr_str # advance free list +++storit: movl -(r6),(r0) # store in cdr +++ movl -(r6),4(r0) # store in car +++ rsb +++ +++getnew: calls $0,_newdot # must gc to get one +++ jbr storit # now initialize it. +++ +++# +++# Fast equivalent of newdot, entered by jsb +++# +++ .globl _qnewdot +++_qnewdot: +++ movl _dtpr_str,r0 # mov next cell addr t0 r0 +++ jlss mustallo # if ran out of space +++ incl *_lispsys+28*4 # inc count of dtprs +++ movl (r0),_dtpr_str # advance free list +++ clrq (r0) +++ rsb +++mustallo: +++ calls $0,_newdot +++ rsb +++ .globl _qpopnames +++_qpopnames: # equivalent of C-code popnames, entered by jsb. +++ movl (sp)+,r0 # return address +++ movl (sp)+,r1 # Lower limit +++ movl _bnp,r2 # pointer to bind stack entry +++qploop: +++ subl2 $8,r2 # for(; (--r2) > r1;) { +++ cmpl r2,r1 # test for done +++ jlss qpdone +++ movl (r2),*4(r2) # r2->atm->a.clb = r2 -> val; +++ brb qploop # } +++qpdone: +++ movl r1,_bnp # restore bnp +++ jmp (r0) # return + + +++# _qget : fast get subroutine +++# (get 'atom 'ind) +++# called with -8(r6) equal to the atom +++# -4(r6) equal to the indicator +++# no assumption is made about r7 +++# unfortunately, the atom may not in fact be an atom, it may +++# be a list or nil, which are special cases. +++# For nil, we grab the nil property list (stored in a special place) +++# and for lists we punt and call the C routine since it is most likely +++# and error and we havent put in error checks yet. +++# +++ .data +++qgtbf: .word 0 # for profiling +++ .text + + +++ .globl _qget +++_qget: +++# movab qgtbf,r0 # these instructions are for profiling +++# jsb mcount +++ movl -4(r6),r1 # put indicator in r1 +++ movl -8(r6),r0 # and atom into r0 +++ jeql nilpli # jump if atom is nil +++ ashl $-9,r0,r2 # check type +++ cmpb _typetable+1[r2],$1 # is it a symbol?? +++ jneq notsymb # nope +++ movl 4(r0),r0 # yes, put prop list in r1 to begin scan +++ jeql fail # if no prop list, we lose right away +++lp: cmpl r1,4(r0) # is car of list eq to indicator? +++ jeql good # jump if so +++ movl *(r0),r0 # else cddr down list +++ jneq lp # and jump if more list to go. + + +++fail: subl2 $8,r6 # unstack args +++ rsb # return with r0 eq to nil + + +++good: movl (r0),r0 # return cadr of list +++ movl 4(r0),r0 +++ subl2 $8,r6 #unstack args +++ rsb + + +++nilpli: movl _lispsys+64*4,r0 # want nil prop list, get it specially +++ jneq lp # and process if anything there +++ subl2 $8,r6 #unstack args +++ rsb # else fail +++ +++notsymb: +++ movab -8(r6),r7 # must set up r7 before calling +++ calls $0,_Lget # not a symbol, call C routine to error check +++ subl2 $8,r6 #unstack args +++ rsb # and return what it returned. + + diff --cc usr/src/cmd/lisp/reset.s index 0000000000,32d2659f3e,0000000000..1ea6cd379d mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/reset.s +++ b/usr/src/cmd/lisp/reset.s @@@@ -1,0 -1,72 -1,0 +1,80 @@@@ +++ .asciz "@(#)reset.s 34.1 10/3/80" + +# C library -- reset, setexit - + +# reset(x) + +# will generate a "return" from + +# the last call to + +# setexit() + +# by restoring r6 - r12, ap, fp + +# and doing a return. + +# The returned value is x; on the original + +# call the returned value is 0. + +# + +# useful for going back to the main loop + +# after a horrible error in a lowlevel + +# routine. - +++# Changed by M. Marcus (4/4/80) to chain saved frames. Should be rewritten +++# to only use the stack, avoiding need for resexit and getexit. +++# Setexit works as before, but getexit adds pointer +++# to the saved block when it pushes saved state onto stack. +++# resexit restores this link by moving back extra word. +++# getexit and setexit are to be thought of as an (almost) unitary action. + +.globl _setexit + +.globl _getexit + +.globl _reset + +.globl _resexit + +.globl _setsav +++.globl _exitlnk + +.globl _svkludg + + + +_setexit: + + .word 0x0000 + + movab _setsav,r0 + + movq r6,(r0)+ + + movq r8,(r0)+ + + movq r10,(r0)+ + + movq 8(fp),(r0)+ # ap, fp + + movab 4(ap),(r0)+ # sp + + movl 16(fp),(r0) # pc + + clrl r0 + + ret + + + +_reset: + + .word 0x0000 + + movl 4(ap),r0 # returned value + + movab _setsav,r1 + + movq (r1)+,r6 + + movq (r1)+,r8 + + movq (r1)+,r10 + + movq (r1)+,r12 + + movl (r1)+,sp + + jmp *(r1) + + + +_resexit: + + .word 0x0000 - movc3 $40,*4(ap),_setsav +++ movc3 $44,*4(ap),_setsav + + ret + +_svkludg: + + movl (sp)+,out + + movq r0,myregs + + movq r2,myregs+8 + + movq r4,myregs+16 - subl2 $40,sp - movc3 $40,_setsav,(sp) +++ subl2 $44,sp +++ movc3 $44,_setsav,(sp) + + movq myregs,r0 + + movq myregs+8,r2 + + movq myregs+16,r4 + + jmp *out + + + +_getexit: + + .word 0x0000 - movc3 $40,_setsav,*4(ap) +++ movc3 $44,_setsav,*4(ap) +++ movl 4(ap), _exitlnk + + ret + + - +++#exitlnk is to be thought of as the last word of the setsav area (11 longs long) + + .data + +_setsav:.space 10*4 +++_exitlnk:.space 4 + +out: .space 4 + +myregs: .space 6*4 + + diff --cc usr/src/cmd/lisp/rlc.c index 0000000000,0000000000,0000000000..72c50c28f9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/rlc.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++static char *sccsid = "@(#)rlc.c 34.2 10/9/80"; +++ +++#define TRUE 1 +++extern char holend[], end[]; +++extern int usehole; +++extern char *curhbeg; +++ +++rlc() +++{ +++ char *cp, *dp; +++ +++ brk(end); +++ dp = holend; +++ cp = dp - HOLE; +++ while (dp < end) +++ *dp++ = *cp++; +++ curhbeg = holend - HOLE; /* set up the hole */ +++ usehole = TRUE; +++} diff --cc usr/src/cmd/lisp/subbig.c index 0000000000,5927778eb2,0000000000..82a62dd47c mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/subbig.c +++ b/usr/src/cmd/lisp/subbig.c @@@@ -1,0 -1,26 -1,0 +1,29 @@@@ +++static char *sccsid = "@(#)subbig.c 34.1 10/3/80"; +++ + +#include "global.h" + + + +lispval + +subbig(pos,neg) + +lispval pos, neg; + +{ + + register lispval work; + + int *sp(); lispval adbig(); + + register int *mysp = sp() - 2; + + register int *ersatz = mysp; +++ snpand(3); + + - for(work = neg; work!=0; work = work->CDR) { +++ for(work = neg; work!=0; work = work->s.CDR) { + + stack(-work->i, (mysp -= 2)); + + } + + mysp[3] = 0; + + return(adbig(pos,ersatz)); + +} + +/* + + * subbig -- subtract one bignum from another. + + * + + * What this does is it negates each coefficient of a copy of the bignum + + * which is just pushed on the stack for convenience. This may give rise + + * to a bignum which is not in canonical form, but is nonetheless a repre + + * sentation of a bignum. Addbig then adds it to a bignum, and produces + + * a result in canonical form. + + */ diff --cc usr/src/cmd/lisp/sysat.c index 0000000000,84a54ac34e,0000000000..755fde2008 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/sysat.c +++ b/usr/src/cmd/lisp/sysat.c @@@@ -1,0 -1,466 -1,0 +1,610 @@@@ +++static char *sccsid = "@(#)sysat.c 34.13 11/11/80"; +++ + +#include "global.h" + +#include "lfuncs.h" + +#define MK(x,y,z) mfun(x,y,z) - #define FIDDLE(a,b,c,d) a->clb=newdot(); (a->clb->car=newint())->i=b->i; \ - a->clb->cdr=newdot(); (a->clb->cdr->car=newint())->i=c->i; \ - a->clb->cdr->cdr=newdot(); (a->clb->cdr->cdr->car=newint())->i=d; \ - b = a->clb->car; c = a->clb->cdr->car; \ - copval(a,a->clb); a->clb = nil; +++#define FIDDLE(z,b,c,y) z->a.clb=newdot(); (z->a.clb->d.car=newint())->i=b->i; \ +++ z->a.clb->d.cdr=newdot(); (z->a.clb->d.cdr->d.car=newint())->i=c->i; \ +++ z->a.clb->d.cdr->d.cdr=newdot(); (z->a.clb->d.cdr->d.cdr->d.car=newint())->i=y; \ +++ b = z->a.clb->d.car; c = z->a.clb->d.cdr->d.car; \ +++ copval(z,z->a.clb); z->a.clb = nil; + + + +#define cforget(x) protect(x); Lforget(); unprot(); + + + +/* The following array serves as the temporary counters of the items */ + +/* and pages used in each space. */ + + - long int tint[18]={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}; +++long int tint[2*NUMSPACES]; + + - long int tgcthresh = 15; - int initflag = TRUE; /* starts off TRUE to indicate unsafe to gc */ +++extern int tgcthresh; +++extern int initflag; /* starts off TRUE to indicate unsafe to gc */ + + +++extern int *beginsweep; /* place for garbage collector to begin sweeping */ + +#define PAGE_LIMIT 3800 + + + +extern Iaddstat(); + + + +makevals() + + { +++ int i; + + lispval temp; + + + + /* system list structure and atoms are initialized. */ + + + + /* Before any lisp data can be created, the space usage */ + + /* counters must be set up, temporarily in array tint. */ + + + + atom_items = (lispval) &tint[0]; + + atom_pages = (lispval) &tint[1]; + + str_items = (lispval) &tint[2]; + + str_pages = (lispval) &tint[3]; + + int_items = (lispval) &tint[4]; + + int_pages = (lispval) &tint[5]; + + dtpr_items = (lispval) &tint[6]; + + dtpr_pages = (lispval) &tint[7]; + + doub_items = (lispval) &tint[8]; + + doub_pages = (lispval) &tint[9]; + + sdot_items = (lispval) &tint[10]; + + sdot_pages = (lispval) &tint[11]; + + array_items = (lispval) &tint[12]; + + array_pages = (lispval) &tint[13]; + + val_items = (lispval) &tint[14]; + + val_pages = (lispval) &tint[15]; + + funct_items = (lispval) &tint[16]; + + funct_pages = (lispval) &tint[17]; + + +++ for (i=0; i < 8; i++) +++ { +++ hunk_pages[i] = (lispval) &tint[18+i*2]; +++ hunk_items[i] = (lispval) &tint[19+i*2]; +++ } +++ + + /* This also applies to the garbage collection threshhold */ + + + + gcthresh = (lispval) &tgcthresh; + + + + /* Now we commence constructing system lisp structures. */ + + + + /* nil is a special case, constructed especially at location zero */ + + - hasht['n'^'i'^'l'] = (struct atom *)nil; +++ hasht[hashfcn("nil")] = (struct atom *)nil; + + +++/* +++ * Names of various spaces and things +++ */ + + + + atom_name = matom("symbol"); + + str_name = matom("string"); + + int_name = matom("fixnum"); + + dtpr_name = matom("list"); + + doub_name = matom("flonum"); + + sdot_name = matom("bignum"); + + array_name = matom("array"); + + val_name = matom("value"); + + funct_name = matom("binary"); +++ port_name = matom("port"); /* not really a space */ + + +++ { +++ char name[6]; + + - /* set up the name stack as an array of pointers */ +++ strcpy(name, "hunk0"); +++ for (i=0; i< 8; i++) { +++ hunk_name[i] = matom(name); +++ name[4]++; +++ } +++ } +++ +++ /* allocate space for namestack and bindstack first +++ * then set up beginsweep variable so that the sweeper will +++ * ignore these `always in use' pages +++ */ + + - lbot = orgnp = np = ((struct argent *)csegment(val_name,NAMESIZE)); - nplim = orgnp+NAMESIZE-5; +++ lbot = orgnp = np = ((struct argent *)csegment(val_name,NAMESIZE,FALSE)); +++ orgbnp = bnp = ((struct nament *)csegment(dtpr_name,NAMESIZE,FALSE)); +++ beginsweep = (int *) sbrk(0); +++ +++ /* set up the name stack as an array of pointers */ +++ nplim = orgnp+NAMESIZE-6*NAMINC; + + temp = matom("namestack"); - nstack = temp->fnbnd = newarray(); - nstack->data = (char *) (np); - (nstack->length = newint())->i = NAMESIZE; - (nstack->delta = newint())->i = sizeof(struct argent); +++ nstack = temp->a.fnbnd = newarray(); +++ nstack->ar.data = (char *) (np); +++ (nstack->ar.length = newint())->i = NAMESIZE; +++ (nstack->ar.delta = newint())->i = sizeof(struct argent); +++ Vnogbar = matom("unmarked_array"); +++ /* marking of the namestack will be done explicitly in gc1 */ +++ (nstack->ar.aux = newdot())->d.car = Vnogbar; +++ + + + + /* set up the binding stack as an array of dotted pairs */ + + - orgbnp = bnp = ((struct nament *)csegment(dtpr_name,NAMESIZE)); + + bnplim = orgbnp+NAMESIZE-5; + + temp = matom("bindstack"); - bstack = temp->fnbnd = newarray(); - bstack->data = (char *) (bnp); - (bstack->length = newint())->i = NAMESIZE; - (nstack->delta = newint())->i = sizeof(struct nament); +++ bstack = temp->a.fnbnd = newarray(); +++ bstack->ar.data = (char *) (bnp); +++ (bstack->ar.length = newint())->i = NAMESIZE; +++ (bstack->ar.delta = newint())->i = sizeof(struct nament); +++ /* marking of the bindstack will be done explicitly in gc1 */ +++ (bstack->ar.aux = newdot())->d.car = Vnogbar; + + + + /* more atoms */ + + + + tatom = matom("t"); - tatom->clb = tatom; +++ tatom->a.clb = tatom; + + lambda = matom("lambda"); + + nlambda = matom("nlambda"); + + macro = matom("macro"); + + ibase = matom("ibase"); /* base for input conversion */ - ibase->clb = inewint(10); +++ ibase->a.clb = inewint(10); +++ rsetatom = matom("*rset"); +++ rsetatom->a.clb = nil; +++ Vsubrou = matom("subroutine"); + + Vpiport = matom("piport"); - Vpiport->clb = P(piport = stdin); /* standard input */ +++ Vpiport->a.clb = P(piport = stdin); /* standard input */ + + Vpoport = matom("poport"); - Vpoport->clb = P(poport = stdout); /* stand. output */ - matom("errport")->clb = (P(errport = stderr));/* stand. err. */ - (Vreadtable = matom("readtable"))->clb = Imkrtab(0); +++ Vpoport->a.clb = P(poport = stdout); /* stand. output */ +++ matom("errport")->a.clb = (P(errport = stderr));/* stand. err. */ +++ ioname[PN(stdin)] = (lispval) inewstr("$stdin"); +++ ioname[PN(stdout)] = (lispval) inewstr("$stdout"); +++ ioname[PN(stderr)] = (lispval) inewstr("$stderr"); +++ (Vreadtable = matom("readtable"))->a.clb = Imkrtab(0); + + strtab = Imkrtab(0); +++ Vptport = matom("ptport"); +++ Vptport->a.clb = nil; /* protocal port */ +++ +++ Vcntlw = matom("^w"); /* when non nil, inhibits output to term */ +++ Vcntlw->a.clb = nil; + + +++ Vprinlevel = matom("prinlevel"); /* printer recursion count */ +++ Vprinlevel->a.clb = nil; /* infinite recursion */ +++ +++ Vprinlength = matom("prinlength"); /* printer element count */ +++ Vprinlength->a.clb = nil; /* infinite elements */ + + /* The following atoms are used as tokens by the reader */ + + + + perda = matom("."); + + lpara = matom("("); + + rpara = matom(")"); + + lbkta = matom("["); + + rbkta = matom("]"); + + snqta = matom("'"); + + exclpa = matom("!"); + + + + - (Eofa = matom("eof"))->clb = eofa; +++ (Eofa = matom("eof"))->a.clb = eofa; + + cara = MK("car",Lcar,lambda); + + cdra = MK("cdr",Lcdr,lambda); + + + + /* The following few atoms have values the reader tokens. */ + + /* Perhaps this is a kludge which should be abandoned. */ + + /* On the other hand, perhaps it is an inspiration. */ + + - matom("perd")->clb = perda; - matom("lpar")->clb = lpara; - matom("rpar")->clb = rpara; - matom("lbkt")->clb = lbkta; - matom("rbkt")->clb = rbkta; +++ matom("perd")->a.clb = perda; +++ matom("lpar")->a.clb = lpara; +++ matom("rpar")->a.clb = rpara; +++ matom("lbkt")->a.clb = lbkta; +++ matom("rbkt")->a.clb = rbkta; + + + + noptop = matom("noptop"); + + + + /* atoms used in connection with comments. */ + + + + commta = matom("comment"); + + rcomms = matom("readcomments"); + + + + /* the following atoms are used for lexprs */ + + + + lexpr_atom = matom("last lexpr binding\7"); + + lexpr = matom("lexpr"); + + +++ /* the following atom is used to reference the bind stack for eval */ +++ bptr_atom = matom("eval1 binding pointer\7"); +++ bptr_atom->a.clb = nil; +++ +++ /* the following atoms are used for evalhook hackery */ +++ evalhatom = matom("evalhook"); +++ evalhatom->a.clb = nil; +++ evalhcall = matom("evalhook call flag\7"); +++ + + sysa = matom("sys"); + + plima = matom("pagelimit"); /* max number of pages */ - Veval = MK("eval",Leval,lambda); +++ Veval = MK("eval",Leval1,lambda); + + MK("asin",Lasin,lambda); + + MK("acos",Lacos,lambda); + + MK("atan",Latan,lambda); + + MK("cos",Lcos,lambda); + + MK("sin",Lsin,lambda); + + MK("sqrt",Lsqrt,lambda); + + MK("exp",Lexp,lambda); + + MK("log",Llog,lambda); +++ MK("lsh",Llsh,lambda); +++ MK("rot",Lrot,lambda); + + MK("random",Lrandom,lambda); + + MK("atom",Latom,lambda); + + MK("apply",Lapply,lambda); + + MK("funcall",Lfuncal,lambda); + + MK("return",Lreturn,lambda); + + MK("retbrk",Lretbrk,lambda); - MK("cont",Lreturn,lambda); +++/* MK("cont",Lreturn,lambda); */ + + MK("cons",Lcons,lambda); + + MK("scons",Lscons,lambda); + + MK("cadr",Lcadr,lambda); + + MK("caar",Lcaar,lambda); + + MK("cddr",Lc02r,lambda); + + MK("caddr",Lc12r,lambda); + + MK("cdddr",Lc03r,lambda); + + MK("cadddr",Lc13r,lambda); + + MK("cddddr",Lc04r,lambda); + + MK("caddddr",Lc14r,lambda); + + MK("nthelem",Lnthelem,lambda); + + MK("eq",Leq,lambda); + + MK("equal",Lequal,lambda); +++ MK("zqual",Zequal,lambda); + + MK("numberp",Lnumberp,lambda); + + MK("dtpr",Ldtpr,lambda); + + MK("bcdp",Lbcdp,lambda); + + MK("portp",Lportp,lambda); + + MK("arrayp",Larrayp,lambda); + + MK("valuep",Lvaluep,lambda); + + MK("get_pname",Lpname,lambda); +++ MK("ptr",Lptr,lambda); + + MK("arrayref",Larrayref,lambda); + + MK("marray",Lmarray,lambda); + + MK("getlength",Lgetl,lambda); + + MK("putlength",Lputl,lambda); + + MK("getaccess",Lgeta,lambda); + + MK("putaccess",Lputa,lambda); + + MK("getdelta",Lgetdel,lambda); + + MK("putdelta",Lputdel,lambda); + + MK("getaux",Lgetaux,lambda); + + MK("putaux",Lputaux,lambda); +++ MK("getdata",Lgetdata,lambda); +++ MK("putdata",Lputdata,lambda); + + MK("mfunction",Lmfunction,lambda); + + MK("getentry",Lgetentry,lambda); + + MK("getdisc",Lgetdisc,lambda); +++ MK("putdisc",Lputdisc,lambda); + + MK("segment",Lsegment,lambda); + + MK("rplaca",Lrplaca,lambda); + + MK("rplacd",Lrplacd,lambda); + + MK("set",Lset,lambda); + + MK("replace",Lreplace,lambda); + + MK("infile",Linfile,lambda); + + MK("outfile",Loutfile,lambda); + + MK("terpr",Lterpr,lambda); + + MK("print",Lprint,lambda); + + MK("close",Lclose,lambda); + + MK("patom",Lpatom,lambda); + + MK("pntlen",Lpntlen,lambda); + + MK("read",Lread,lambda); + + MK("ratom",Lratom,lambda); + + MK("readc",Lreadc,lambda); + + MK("implode",Limplode,lambda); + + MK("maknam",Lmaknam,lambda); + + MK("concat",Lconcat,lambda); + + MK("uconcat",Luconcat,lambda); + + MK("putprop",Lputprop,lambda); +++ MK("monitor",Lmonitor,lambda); + + MK("get",Lget,lambda); + + MK("getd",Lgetd,lambda); + + MK("putd",Lputd,lambda); + + MK("prog",Nprog,nlambda); + + quota = MK("quote",Nquote,nlambda); + + MK("function",Nfunction,nlambda); + + MK("go",Ngo,nlambda); + + MK("*catch",Ncatch,nlambda); + + MK("errset",Nerrset,nlambda); + + MK("status",Nstatus,nlambda); + + MK("sstatus",Nsstatus,nlambda); + + MK("err",Lerr,lambda); + + MK("*throw",Nthrow,lambda); /* this is a lambda now !! */ - MK("reset",Nreset,nlambda); +++ reseta = MK("reset",Nreset,nlambda); + + MK("break",Nbreak,nlambda); + + MK("exit",Lexit,lambda); + + MK("def",Ndef,nlambda); + + MK("null",Lnull,lambda); + + MK("and",Nand,nlambda); + + MK("or",Nor,nlambda); + + MK("setq",Nsetq,nlambda); + + MK("cond",Ncond,nlambda); + + MK("list",Llist,lambda); + + MK("load",Lload,lambda); + + MK("nwritn",Lnwritn,lambda); + + MK("process",Nprocess,nlambda); /* execute a shell command */ + + MK("allocate",Lalloc,lambda); /* allocate a page */ + + MK("sizeof",Lsizeof,lambda); /* size of one item of a data type */ - MK("dumplisp",Ndumpli,nlambda); /* save the world */ +++ MK("odumplisp",Ndumplisp,nlambda); /* OLD save the world */ +++ MK("dumplisp",Nndumplisp,nlambda); /* NEW save the world */ +++#ifdef VMS +++ MK("savelisp",Lsavelsp,lambda); /* save lisp data */ +++ MK("restorelisp",Lrestlsp,lambda); +++#endif + + MK("top-level",Ntpl,nlambda); /* top level eval-print read loop */ + + startup = matom("startup"); /* used by save and restore */ + + MK("mapcar",Lmapcar,lambda); + + MK("maplist",Lmaplist,lambda); + + MK("mapcan",Lmapcan,lambda); + + MK("mapcon",Lmapcon,lambda); + + MK("assq",Lassq,lambda); + + MK("mapc",Lmapc,lambda); + + MK("map",Lmap,lambda); - MK("flatsize",Lflatsi,lambda); +++ MK("flatc",Lflatsi,lambda); + + MK("alphalessp",Lalfalp,lambda); + + MK("drain",Ldrain,lambda); + + MK("killcopy",Lkilcopy,lambda); /* forks aand aborts for adb */ + + MK("opval",Lopval,lambda); /* sets and retrieves system variables */ + + MK("ncons",Lncons,lambda); + + sysa = matom("sys"); /* sys indicator for system variables */ + + MK("remob",Lforget,lambda); /* function to take atom out of hash table */ + + splice = matom("splicing"); + + MK("not",Lnull,lambda); + + MK("plus",Ladd,lambda); + + MK("add",Ladd,lambda); + + MK("times",Ltimes,lambda); + + MK("difference",Lsub,lambda); + + MK("quotient",Lquo,lambda); + + MK("mod",Lmod,lambda); + + MK("minus",Lminus,lambda); + + MK("absval",Labsval,lambda); + + MK("add1",Ladd1,lambda); + + MK("sub1",Lsub1,lambda); + + MK("greaterp",Lgreaterp,lambda); + + MK("lessp",Llessp,lambda); +++ MK("any-zerop",Lzerop,lambda); /* used when bignum arg possible */ + + MK("zerop",Lzerop,lambda); + + MK("minusp",Lnegp,lambda); + + MK("onep",Lonep,lambda); + + MK("sum",Ladd,lambda); + + MK("product",Ltimes,lambda); + + MK("do",Ndo,nlambda); + + MK("progv",Nprogv,nlambda); + + MK("progn",Nprogn,nlambda); + + MK("prog2",Nprog2,nlambda); + + MK("oblist",Loblist,lambda); - MK("baktrace",Lbaktra,lambda); +++ MK("baktrace",Lbaktrace,lambda); + + MK("tyi",Ltyi,lambda); + + MK("tyipeek",Ltyipeek,lambda); + + MK("tyo",Ltyo,lambda); + + MK("setsyntax",Lsetsyn,lambda); + + MK("makereadtable",Lmakertbl,lambda); - MK("zapline",Lzaplin,lambda); +++ MK("zapline",Lzapline,lambda); + + MK("aexplode",Lexplda,lambda); + + MK("aexplodec",Lexpldc,lambda); + + MK("aexploden",Lexpldn,lambda); +++ MK("hashtabstat",Lhashst,lambda); +++#ifdef METER +++ MK("gcstat",Lgcstat,lambda); +++#endif + + MK("argv",Largv,lambda); + + MK("arg",Larg,lambda); +++ MK("setarg",Lsetarg,lambda); + + MK("showstack",Lshostk,lambda); - MK("resetio",Nreseti,nlambda); +++ MK("freturn",Lfretn,lambda); +++ MK("*rset",Lrset,lambda); +++ MK("eval1",Leval1,lambda); +++ MK("evalframe",Levalf,lambda); +++ MK("evalhook",Levalhook,lambda); +++ MK("resetio",Nresetio,nlambda); + + MK("chdir",Lchdir,lambda); + + MK("ascii",Lascii,lambda); + + MK("boole",Lboole,lambda); + + MK("type",Ltype,lambda); /* returns type-name of argument */ + + MK("fix",Lfix,lambda); + + MK("float",Lfloat,lambda); + + MK("fact",Lfact,lambda); + + MK("cpy1",Lcpy1,lambda); + + MK("Divide",LDivide,lambda); + + MK("Emuldiv",LEmuldiv,lambda); + + MK("readlist",Lreadli,lambda); + + MK("plist",Lplist,lambda); /* gives the plist of an atom */ + + MK("setplist",Lsetpli,lambda); /* get plist of an atom */ + + MK("eval-when",Nevwhen,nlambda); - MK("syscall",Nsyscall,nlambda); +++ MK("syscall",Lsyscall,lambda); +++ MK("intern",Lintern,lambda); + + MK("ptime",Lptime,lambda); /* return process user time */ + +/* + + MK("fork",Lfork,lambda); + + MK("wait",Lwait,lambda); + + MK("pipe",Lpipe,lambda); + + MK("fdopen",Lfdopen,lambda); +++*/ + + MK("exece",Lexece,lambda); - */ + + MK("gensym",Lgensym,lambda); + + MK("remprop",Lremprop,lambda); + + MK("bcdad",Lbcdad,lambda); + + MK("symbolp",Lsymbolp,lambda); + + MK("stringp",Lstringp,lambda); + + MK("rematom",Lrematom,lambda); + + MK("prname",Lprname,lambda); + + MK("getenv",Lgetenv,lambda); +++ MK("I-throw-err",Lctcherr,lambda); /* directly force a throw or error */ + + MK("makunbound",Lmakunb,lambda); + + MK("haipart",Lhaipar,lambda); + + MK("haulong",Lhau,lambda); + + MK("signal",Lsignal,lambda); - MK("fasl",Lfasl,lambda); /* read in compiled file */ - MK("bind",Lbind,lambda); /* like fasl but for functions - loaded in when the lisp system - was constructed by ld */ +++ MK("fasl",Lnfasl,lambda); /* NEW - new fasl loader */ +++ MK("cfasl",Lcfasl,lambda); /* read in compiled C file */ +++ MK("getaddress",Lgetaddress,lambda); +++ /* bind symbols without doing cfasl */ + + MK("boundp",Lboundp,lambda); /* tells if an atom is bound */ + + MK("fake",Lfake,lambda); /* makes a fake lisp pointer */ + + MK("od",Lod,lambda); /* dumps info */ - MK("what",Lwhat,lambda); /* converts a pointer to an integer */ +++ MK("maknum",Lmaknum,lambda); /* converts a pointer to an integer */ +++ MK("*mod",LstarMod,lambda); /* return fixnum modulus */ +++ +++ MK("fseek",Lfseek,lambda); /* seek to a specific byte in a file */ +++ MK("fileopen", Lfileopen, lambda); +++ /* open a file for read/write/append */ +++ + + MK("pv%",Lpolyev,lambda); /* polynomial evaluation instruction */ +++ MK("cprintf",Lcprintf,lambda); /* formatted print */ +++ MK("copyint*",Lcopyint,lambda); /* copyint* */ +++ +++/* +++ * Hunk stuff +++ */ +++ +++ MK("*makhunk",LMakhunk,lambda); /* special hunk creater */ +++ MK("hunkp",Lhunkp,lambda); /* test a hunk */ +++ MK("cxr",Lcxr,lambda); /* cxr of a hunk */ +++ MK("rplacx",Lrplacx,lambda); /* replace element of a hunk */ +++ MK("*rplacx",Lstarrpx,lambda); /* rplacx used by hunk */ +++ MK("hunksize",Lhunksize,lambda); /* size of a hunk */ +++ +++ MK("probef",Lprobef,lambda); /* test file existance */ +++ MK("substring",Lsubstring,lambda); +++ MK("substringn",Lsubstringn,lambda); + + odform = matom("odformat"); /* format for printf's used in od */ + + rdrsdot = newsdot(); /* used in io conversions of bignums */ +++ rdrsdot2 = newsdot(); /* used in io conversions of bignums */ + + rdrint = newint(); /* used as a temporary integer */ - (nilplist = newdot())->cdr = newdot(); +++ (nilplist = newdot())->d.cdr = newdot(); + + /* used as property list for nil, + + since nil will eventually be put at + + 0 (consequently in text and not + + writable) */ + + + + /* error variables */ - (Vererr = matom("ER%err"))->clb = nil; - (Vertpl = matom("ER%tpl"))->clb = nil; - (Verall = matom("ER%all"))->clb = nil; - (Vermisc = matom("ER%misc"))->clb = nil; - (Vlerall = newdot())->car = Verall; /* list (ER%all) */ +++ (Vererr = matom("ER%err"))->a.clb = nil; +++ (Vertpl = matom("ER%tpl"))->a.clb = nil; +++ (Verall = matom("ER%all"))->a.clb = nil; +++ (Vermisc = matom("ER%misc"))->a.clb = nil; +++ (Verbrk = matom("ER%brk"))->a.clb = nil; +++ (Verundef = matom("ER%undef"))->a.clb = nil; +++ (Vlerall = newdot())->d.car = Verall; /* list (ER%all) */ +++ (Veruwpt = matom("ER%unwind-protect"))->a.clb = nil; +++ (Verrset = matom("errset"))->a.clb = nil; + + + + + + /* set up the initial status list */ + + + + stlist = nil; /* initially nil */ + + Iaddstat(matom("features"),ST_READ,ST_NO,nil); + + Iaddstat(matom("feature"),ST_FEATR,ST_FEATW,nil); + + Isstatus(matom("feature"),matom("franz")); +++ Isstatus(matom("feature"),matom(OS)); +++ Isstatus(matom("feature"),matom("string")); +++ Isstatus(matom("feature"),matom(MACHINE)); +++ Isstatus(matom("feature"),matom(SITE)); + + + + Iaddstat(matom("nofeature"),ST_NFETR,ST_NFETW,nil); + + Iaddstat(matom("syntax"),ST_SYNT,ST_NO,nil); + + Iaddstat(matom("uctolc"),ST_READ,ST_TOLC,nil); + + Iaddstat(matom("dumpcore"),ST_READ,ST_CORE,nil); + + Isstatus(matom("dumpcore"),nil); /*set up signals*/ + + + + Iaddstat(matom("chainatom"),ST_RINTB,ST_INTB,inewint(0)); + + Iaddstat(matom("dumpmode"),ST_DMPR,ST_DMPW,nil); +++ Iaddstat(matom("appendmap"),ST_READ,ST_SET,nil); /* used by fasl */ +++ Iaddstat(matom("debugging"),ST_READ,ST_SET,nil); +++ Iaddstat(matom("evalhook"),ST_RINTB,ST_INTB,inewint(3)); +++ Isstatus(matom("evalhook"),nil); /*evalhook switch off */ +++ Iaddstat(matom("bcdtrace"),ST_READ,ST_BCDTR,nil); +++ Iaddstat(matom("ctime"),ST_CTIM,ST_NO,nil); +++ Iaddstat(matom("localtime"),ST_LOCT,ST_NO,nil); +++ Iaddstat(matom("isatty"),ST_ISTTY,ST_NO,nil); +++ Iaddstat(matom("ignoreeof"),ST_READ,ST_SET,nil); +++ Iaddstat(matom("version"),ST_READ,ST_NO,mstr("Franz Lisp, Opus 34")); +++ Iaddstat(matom("automatic-reset"),ST_READ,ST_AUTR,nil); +++ Iaddstat(matom("translink"),ST_READ,ST_TRAN,nil); +++ Isstatus(matom("translink"),tatom); /* turn on tran links */ +++ Iaddstat(matom("undeffunc"),ST_UNDEF,ST_NO,nil); /* list undef funcs */ +++ + + /* garbage collector things */ + + + + MK("gc",Ngc,nlambda); + + gcafter = MK("gcafter",Ngcafter,nlambda); /* garbage collection wind-up */ + + gcport = matom("gcport"); /* port for gc dumping */ + + gccheck = matom("gccheck"); /* flag for checking during gc */ - gcdis = matom("gcdisable"); /* option for disabling the gc */ +++ gcdis = matom("gcdisable"); /* variable for disabling the gc */ +++ gcdis->a.clb = nil; + + gcload = matom("gcload"); /* option for gc while loading */ + + loading = matom("loading"); /* flag--in loader if = t */ + + noautot = matom("noautotrace"); /* option to inhibit auto-trace */ + + (gcthresh = newint())->i = tgcthresh; + + gccall1 = newdot(); gccall2 = newdot(); /* used to call gcafter */ - gccall1->car = gcafter; /* start constructing a form for eval */ +++ gccall1->d.car = gcafter; /* start constructing a form for eval */ + + + + arrayst = mstr("ARRAY"); /* array marker in name stack */ + + bcdst = mstr("BINARY"); /* binary function marker */ + + listst = mstr("INTERPRETED"); /* interpreted function marker */ + + macrost = mstr("MACRO"); /* macro marker */ + + protst = mstr("PROTECTED"); /* protection marker */ + + badst = mstr("BADPTR"); /* bad pointer marker */ + + argst = mstr("ARGST"); /* argument marker */ +++ hunkfree = mstr("EMPTY"); /* empty hunk cell value */ + + + + /* type names */ + + + + FIDDLE(atom_name,atom_items,atom_pages,ATOMSPP); + + FIDDLE(str_name,str_items,str_pages,STRSPP); + + FIDDLE(int_name,int_items,int_pages,INTSPP); + + FIDDLE(dtpr_name,dtpr_items,dtpr_pages,DTPRSPP); + + FIDDLE(doub_name,doub_items,doub_pages,DOUBSPP); + + FIDDLE(sdot_name,sdot_items,sdot_pages,SDOTSPP); + + FIDDLE(array_name,array_items,array_pages,ARRAYSPP); + + FIDDLE(val_name,val_items,val_pages,VALSPP); + + FIDDLE(funct_name,funct_items,funct_pages,BCDSPP); + + +++ FIDDLE(hunk_name[0], hunk_items[0], hunk_pages[0], HUNK2SPP); +++ FIDDLE(hunk_name[1], hunk_items[1], hunk_pages[1], HUNK4SPP); +++ FIDDLE(hunk_name[2], hunk_items[2], hunk_pages[2], HUNK8SPP); +++ FIDDLE(hunk_name[3], hunk_items[3], hunk_pages[3], HUNK16SPP); +++ FIDDLE(hunk_name[4], hunk_items[4], hunk_pages[4], HUNK32SPP); +++ FIDDLE(hunk_name[5], hunk_items[5], hunk_pages[5], HUNK64SPP); +++ FIDDLE(hunk_name[6], hunk_items[6], hunk_pages[6], HUNK128SPP); +++ + + (plimit = newint())->i = PAGE_LIMIT; + + copval(plima,plimit); /* default value */ + + + + /* the following atom is used when reading caar, cdar, etc. */ + + + + xatom = matom("??"); + + + + /* now it is OK to collect garbage */ + + + + initflag = FALSE; + + } + + + +/* matom("name") ******************************************************/ + +/* */ + +/* simulates an atom being read in from the reader and returns a */ + +/* pointer to it. */ + +/* */ + +/* BEWARE: if an atom becomes "truly worthless" and is collected, */ + +/* the pointer becomes obsolete. */ + +/* */ + +lispval + +matom(string) + +char *string; + + { - strcpy(strbuf,string); +++ strbuf[0] = 0; +++ strcatn(strbuf,string,STRBLEN); + + return(getatom()); + + } + + + +/* mstr ***************************************************************/ + +/* */ + +/* Makes a string. Uses matom. */ + +/* Not the most efficient but will do until the string from the code */ + +/* itself can be used as a lispval. */ + + + +lispval mstr(string) char *string; + + { + + return((lispval)(inewstr(string))); + + } + + + +/* mfun("name",entry) *************************************************/ + +/* */ + +/* Same as matom, but entry point to c code is associated with */ + +/* "name" as function binding. */ + +/* A pointer to the atom is returned. */ + +/* */ + +lispval mfun(string,entry,discip) char *string; lispval (*entry)(), discip; + + { + + lispval v; + + v = matom(string); - v -> fnbnd = newfunct(); - v->fnbnd->entry = entry; - v->fnbnd->discipline = discip; +++ v->a.fnbnd = newfunct(); +++ v->a.fnbnd->bcd.entry = entry; +++ v->a.fnbnd->bcd.discipline = discip; + + return(v); + + } diff --cc usr/src/cmd/lisp/trace.c index 0000000000,0000000000,0000000000..59405bd4c4 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/lisp/trace.c @@@@ -1,0 -1,0 -1,0 +1,63 @@@@ +++static char *sccsid = "@(#)trace.c 34.1 10/3/80"; +++ +++#include "global.h" +++lispval +++Leval1(){ +++ register struct nament *bindptr; +++ register lispval handy; +++ snpand(2); +++ if (np-lbot == 2) { /*if two arguments to eval */ +++ if (TYPE((lbot+1)->val) != INT) +++ error("Eval: 2nd arg not legal alist pointer", FALSE); +++ bindptr = orgbnp + (lbot+1)->val->i; +++ if (rsetsw == 0 || rsetatom->a.clb == nil) +++ error("Not in *rsetmode; second arg is useless - eval", TRUE); +++ if (bptr_atom->a.clb != nil) +++ error("WARNING - Nesting 2nd args to eval will give spurious values", TRUE); +++ if (bindptr < orgbnp || bindptr >bnplim) +++ error("Illegal pdl pointer as 2nd arg - eval", FALSE); +++ handy = newdot(); +++ handy->d.car = (lispval)bindptr; +++ handy->d.cdr = (lispval)bnp; +++ PUSHDOWN(bptr_atom, handy); +++ handy = eval(lbot->val); +++ POP; +++ return(handy); +++ } else { /* normal case - only one arg */ +++ chkarg(1,"eval"); +++ handy = eval(lbot->val); +++ return(handy); +++ }; +++} +++ +++lispval +++Levalhook() +++{ +++ register lispval handy; +++ snpand(1); +++ chkarg(2,"evalhook"); +++ if (evalhsw == 0) +++ error("evalhook called before doing sstatus-evalhook", TRUE); +++ if (rsetsw == 0 || rsetatom->a.clb == nil) +++ error("evalhook called while not in *rset mode", TRUE); +++ PUSHDOWN(evalhatom,(lispval)(lbot+1)->val); +++ /* eval checks evalhcall to see if this is a LISP call to evalhook +++ in which case it avoids call to evalhook function, but clobbers +++ value to nil so recursive calls will check. */ +++ PUSHDOWN(evalhcall,tatom); +++ handy = eval(lbot->val); +++ POP; +++ POP; +++ return(handy); +++} +++ +++lispval +++Lrset () +++ { +++ chkarg(1,"rset"); +++ +++ rsetsw = (lbot->val == nil) ? 0 : 1; +++ rsetatom->a.clb = (lbot->val == nil) ? nil: tatom; +++ return(lbot->val); +++} +++ diff --cc usr/src/cmd/lisp/vsyscall.s index 0000000000,024fc8c46c,0000000000..0a18774fa7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lisp/vsyscall.s +++ b/usr/src/cmd/lisp/vsyscall.s @@@@ -1,0 -1,17 -1,0 +1,18 @@@@ +++ .asciz "@(#)vsyscall.s 34.1 10/3/80" + + .globl _vsyscall + + .globl cerror + +_vsyscall: + + .word 0x0000 + + movl 4(ap),r0 # point at arg array + + movl (r0)+,r1 # syscall number + + movl $10,r2 + +Loop: + + pushl (r0)[r2] # push argument + + sobgeq r2,Loop # push 10 arguments + + pushl $10 # arg count + + movl sp,ap # point at args + + chmk r1 # do it + + bcs L1 + + ret + +L1: + + jmp cerror diff --cc usr/src/cmd/liszt/cadr.l index 0000000000,0000000000,0000000000..ab4dc06f60 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/liszt/cadr.l @@@@ -1,0 -1,0 -1,0 +1,1096 @@@@ +++ +++ +++; l i s z t v 4 +++ +++ +++ +++ +++; Copyright (c) 1980 , The Regents of the University of California. +++; All rights reserved. +++; author: j. foderaro +++ +++; Section EXPR -- general expression compiler +++ +++(include "caspecs.l") +++ +++(eval-when (compile eval) +++ (cond ((not (getd 'If)) +++ (fasl 'camacs)))) +++ +++(setq sectioncadrid "@(#)cadr.l 5.4 10/22/80") ; id for SCCS +++ +++;--- d-exp :: compile a lisp expression = d-exp = +++; v-form : a lisp expression to compile +++; returns an IADR which tells where the value was located. +++; +++(defun d-exp (v-form) +++ (prog (first resloc tmp ftyp) +++ +++ begin +++ (If (atom v-form) +++ then (setq tmp (d-loc v-form)) ;locate vrble +++ (If (null g-loc) +++ then (If g-cc then (d-tst tmp)) +++ else (d-move tmp g-loc)) +++ (d-handlecc) +++ (return tmp) +++ +++ elseif (atom (setq first (car v-form))) +++ then (If (and fl-xref (not (get first g-refseen))) +++ then (Push g-reflst first) +++ (putprop first t g-refseen)) +++ (setq ftyp (d-functyp first)) +++ (If (eq 'macro ftyp) +++ then (setq v-form (apply first v-form)) +++ (go begin) +++ elseif (setq tmp (get first 'fl-exprcc)) +++ then (return (funcall tmp)) +++ elseif (setq tmp (get first 'fl-exprm)) +++ then (setq v-form (funcall tmp)) +++ (go begin) +++ elseif (setq tmp (get first 'fl-expr)) +++ then (funcall tmp) +++ elseif (setq tmp (or (and (eq 'car first) +++ '( a )) +++ (and (eq 'cdr first) +++ '( d )) +++ (d-cxxr first))) +++ then (return (cc-cxxr (cadr v-form) tmp)) +++ elseif (eq 'nlambda ftyp) +++ then (d-callbig first `(',(cdr v-form))) +++ elseif (or (eq 'lambda ftyp) (eq 'lexpr ftyp)) +++ then (setq tmp (length v-form)) +++ +++ (d-callbig first (cdr v-form))) +++ elseif (eq 'lambda (car first)) +++ then (c-lambexp) +++ +++ elseif (or (eq 'quote (car first)) (eq 'function (car first))) +++ then (comp-warn "bizzare function name " (or first)) +++ (setq v-form (cons (cadr first) (cdr v-form))) +++ (go begin) +++ +++ else (comp-err "bad expression" (or v-form))) +++ +++(If (null g-loc) +++ then (If g-cc then (d-tst 'reg)) +++ elseif (eq g-loc 'reg) +++ then (If g-cc then (d-tst 'reg)) +++ else (d-move 'reg g-loc)) +++(If g-cc then (d-handlecc)))) +++ +++;--- d-functyp :: return the type of function +++; - name : function name +++; +++(defun d-functyp (name) +++ (let (ftyp ) +++ (If (atom name) then +++ (If (setq ftyp (getd name)) +++ then (If (bcdp ftyp) +++ then (getdisc ftyp) +++ elseif (dtpr ftyp) +++ then (car ftyp)) +++ elseif (get name g-functype) thenret +++ else 'lambda)))) ; default is lambda +++ +++ +++;--- d-exps :: compile a list of expressions +++; - exps : list of expressions +++; the last expression is evaluated according to g-loc and g-cc, the others +++; are evaluated with g-loc and g-cc nil. +++; +++(defun d-exps (exps) +++ (d-exp (do ((ll exps (cdr ll)) +++ (g-loc nil) +++ (g-cc nil) +++ (g-ret nil)) +++ ((null (cdr ll)) (car ll)) +++ (d-exp (car ll))))) +++ +++ +++;--- d-pushargs :: compile and push a list of expressions +++; - exps : list of expressions +++; compiles and stacks a list of expressions +++; +++(defun d-pushargs (args) +++ (If args then (do ((ll args (cdr ll)) +++ (g-loc 'stack) +++ (g-cc nil) +++ (g-ret nil)) +++ ((null ll)) +++ (d-exp (car ll)) +++ (Push g-locs nil) +++ (incr g-loccnt)))) +++ +++;--- d-cxxr :: split apart a cxxr function name +++; - name : a possible cxxr function name +++; returns the a's and d's between c and r in reverse order, or else +++; returns nil if this is not a cxxr name +++; +++(defun d-cxxr (name) +++ (let ((expl (explodec name))) +++ (If (eq 'c (car expl)) ; must begin with c +++ then (do ((ll (cdr expl) (cdr ll)) +++ (tmp) +++ (res)) +++ (nil) +++ (setq tmp (car ll)) +++ (If (null (cdr ll)) +++ then (If (eq 'r tmp) ; must end in r +++ then (return res) +++ else (return nil)) +++ elseif (or (eq 'a tmp) ; and contain only a's and d's +++ (eq 'd tmp)) +++ then (setq res (cons tmp res)) +++ else (return nil)))))) +++ +++;--- d-call :: call another function +++; - name : name of funtion to call +++; - nargs : number of args stacked (including the function name) +++; +++(defun d-call (name nargs) +++ (prog (tmp) +++ (forcecomment `(calling ,name)) +++ (If (null (setq tmp (cdr (assoc nargs +++ '( (1 . (* -8 #.bind-reg)) +++ (2 . (* -12 #.bind-reg)) +++ (3 . (* -16 #.bind-reg)) +++ (4 . (* -20 #.bind-reg)) +++ (5 . (* -24 #.bind-reg))))))) +++ then ; lbot will not be set up automatically +++ (e-write3 'movab ; must set up lbot +++ `(,(* -4 nargs) #.Np-reg) +++ '#.Lbot-reg) +++ (setq tmp '(* -28 #.bind-reg))) +++ (e-write2 'jsb tmp))) +++ +++;--- d-callbig :: call a local or global function +++; +++; +++(defun d-callbig (name args) +++ (let ((tmp (get name g-localf)) +++ c) +++ (forcecomment `(calling ,name)) +++ (If (d-dotailrecursion name args) thenret +++ elseif tmp then ;-- local function call +++ (d-pushargs args) +++ (e-write2 'jsb (car tmp)) +++ (setq g-locs (nthcdr (setq c (length args)) g-locs)) +++ (setq g-loccnt (- g-loccnt c)) +++ else (If fl-tran ;-- transfer table linkage +++ then (d-pushargs args) +++ (setq c (length args)) +++ (d-calltran name c) +++ else ;--- standard function call +++ (d-pushargs `(',name ,@args)) +++ (d-call name (setq c (1+ (length args))))) +++ (setq g-locs (nthcdr c g-locs)) +++ (setq g-loccnt (- g-loccnt c))) +++ (d-clearreg))) +++ +++ +++;--- d-calltran :: call a function through the transfer table = d-calltran = +++; name - name of function to call +++; c - number of arguments to the function +++; +++(defun d-calltran (name c) +++ (e-write3 'movab `(,(* -4 c) #.Np-reg) '#.Lbot-reg) +++ (e-write3 'calls '$0 (concat "*trantb+" (d-tranloc name))) +++ (e-write3 'movl '#.Lbot-reg '#.Np-reg)) +++ +++;--- d-tranloc :: locate a function in the transfer table = d-tranloc = +++; +++; return the offset we should use for this function call +++; +++(defun d-tranloc (fname) +++ (cond ((get fname g-tranloc)) +++ (t (Push g-tran fname) +++ (let ((newval (* 8 g-trancnt))) +++ (putprop fname newval g-tranloc) +++ (incr g-trancnt) +++ newval)))) +++ +++;--- d-dotailrecursion :: do tail recursion if possible +++; name - function name we are to call +++; args - arguments to give to function +++; +++; return t iff we were able to do tail recursion +++; We can do tail recursion if: +++; g-ret is set indicating that the result of this call will be returned +++; as the value of the function we are compiling +++; the function we are calling, name, is the same as the function we are +++; compiling, g-fname +++; there are no variables shallow bound, since we would have to unbind +++; them, which may cause problems in the function. +++; +++(defun d-dotailrecursion (name args) +++ (If (and g-ret +++ (eq name g-fname) +++ (do ((loccnt 0) +++ (ll g-locs (cdr ll))) +++ ((null ll) (return t)) +++ (If (dtpr (car ll)) +++ then (If (or (eq 'catcherrset (caar ll)) +++ (greaterp (cdar ll) 0)) +++ then (return nil)) +++ else (incr loccnt)))) +++ then +++ ; evalate the arguments and pop them back to the location of +++ ; the original args. +++ (makecomment '(tail merging)) +++ (comp-note "Tail merging being done: " v-form) +++ (let ((g-locs g-locs) +++ (g-loccnt g-loccnt)) +++ (d-pushargs args)) ; push then forget about +++ (let (base-reg nargs) +++ (If (eq g-ftype 'lexpr) +++ then ; the beginning of the local variables +++ ;has been stacked +++ (e-write3 'addl2 '$4 'sp) ; pop off arg count +++ (e-write4 'addl3 '$4 "(sp)" Lbot-reg) +++ (setq base-reg Lbot-reg) ; will push from bot +++ else (setq base-reg oLbot-reg)) ; will push from olbot +++ (setq nargs (length args)) +++ (do ((i nargs (1- i)) +++ (top (* nargs -4) (+ top 4)) +++ (bot 0 (+ bot 4))) +++ ((zerop i)) +++ (e-write3 'movl `(,top ,Np-reg) `(,bot ,base-reg))) +++ (e-write3 'movab `(,(* 4 nargs) ,base-reg) Np-reg) +++ (e-goto g-topsym)) +++ t)) ; return t to indicate that tailrecursion was successful +++ +++ +++ +++ +++; Section xxx -- specific function compilers +++; +++ +++;--- cc-and :: compile an and expression +++; We evaluate forms from left to right as long as they evaluate to +++; a non nil value. We only have to worry about storing the value of +++; the last expression in g-loc. +++; +++(defun cc-and nil +++ (let ((finlab (d-genlab)) +++ (finlab2) +++ (exps (If (cdr v-form) thenret else '(t)))) ; (and) ==> t +++ (If (null (cdr g-cc)) +++ then (d-exp (do ((g-cc (cons nil finlab)) +++ (g-loc) +++ (g-ret) +++ (ll exps (cdr ll))) +++ ((null (cdr ll)) (car ll)) +++ (d-exp (car ll)))) +++ (If g-loc then (setq finlab2 (d-genlab)) +++ (e-goto finlab2) +++ (e-label finlab) +++ (d-move 'Nil g-loc) +++ (e-label finlab2) +++ else (e-label finlab)) +++ else ;--- cdr g-cc is non nil, thus there is +++ ; a quick escape possible if one of the +++ ; expressions evals to nil +++ +++ (If (null g-loc) then (setq finlab (cdr g-cc))) +++ (d-exp (do ((g-cc (cons nil finlab)) +++ (g-loc) +++ (g-ret) +++ (ll exps (cdr ll))) +++ ((null (cdr ll)) (car ll)) +++ (d-exp (car ll)))) +++ ; if g-loc is non nil, then we have evaled the and +++ ; expression to yield nil, which we must store in +++ ; g-loc and then jump to where the cdr of g-cc takes us +++ (If g-loc then (setq finlab2 (d-genlab)) +++ (e-goto finlab2) +++ (e-label finlab) +++ (d-move 'Nil g-loc) +++ (e-goto (cdr g-cc)) +++ (e-label finlab2)))) +++ (d-clearreg)) ; we cannot predict the state of the registers +++ +++ +++ +++ +++;--- cc-arg :: get the nth arg from the current lexpr = cc-arg = +++; +++; the syntax for Franz lisp is (arg i) +++; for interlisp the syntax is (arg x i) where x is not evaluated and is +++; the name of the variable bound to the number of args. We can only handle +++; the case of x being the variable for the current lexpr we are compiling +++; +++(defun cc-arg nil +++ (let ((nillab (d-genlab)) (finlab (d-genlab))) +++ (If (not (eq 'lexpr g-ftype)) +++ then (comp-err " arg only allowed in lexprs")) +++ (If (and (eq (length (cdr v-form)) 2) fl-inter) +++ then (If (not (eq (car g-args) (cadr v-form))) +++ then (comp-err " arg expression is for non local lexpr " +++ v-form) +++ else (setq v-form (cdr v-form)))) +++ (If (or g-loc g-cc) +++ then (let ((g-loc 'reg) +++ (g-cc (cons nil nillab)) +++ (g-ret)) +++ (d-exp `(cdr ,(cadr v-form)))) ; calc the numeric arg +++ (If g-loc then (d-move '"*-4(fp)[r0]" g-loc) +++ else (e-tst '"*-4(fp)[r0]")) +++ (d-handlecc) +++ (e-goto finlab) +++ (e-label nillab) +++ ; here we are doing (arg nil) which returns the number of args +++ ; which is always true if anyone is testing +++ (If g-loc then (d-move '"-8(fp)" g-loc) +++ (d-handlecc) +++ elseif (car g-cc) then (e-goto (car g-cc))) ;always true +++ (e-label finlab)))) +++ +++ +++;--- cc-atom :: test for atomness = cc-atom = +++; +++(defun cc-atom nil +++ (d-typecmplx (cadr v-form) +++ '#.(concat '$ (plus 1_0 1_1 1_2 1_4 1_5 1_6 1_7 1_9 1_10)))) +++ +++ +++;--- cc-bcdp :: check for bcdpness = cc-bcdp = +++; +++(defun cc-bcdp nil +++ (d-typesimp (cadr v-form) '$5)) +++ +++ +++;--- cc-bigp :: check for bignumness = cc-bigp = +++; +++(defun cc-bigp nil +++ (d-typesimp (cadr v-form) '$9)) +++ +++;--- c-*catch :: compile a *catch expression = c-*catch = +++; +++; the form of *catch is (*catch 'tag 'val) +++; we evaluate 'tag and set up a catch frame, and then eval 'val +++; +++(defun c-*catch nil +++ (let ((g-loc 'reg) +++ (g-cc nil) +++ (g-ret nil) +++ (finlab (d-genlab))) +++ (d-exp (cadr v-form)) ; calculate tag into r0 +++ (d-catcherrset finlab 'reg 'T (caddr v-form)) +++ (e-label finlab))) +++ +++ +++ +++;--- d-catcherrset :: common code to catch and errset +++; +++(defun d-catcherrset (finlab tagloc flagloc expr) +++ (e-write2 'pushab finlab) +++ (e-write2 'pushr '$0x2540) ; save registers +++ (e-write2 'jsb '_svkludg) ; save rest of state +++ (e-write2 'pushl Bnp-val) +++ (e-write2 'pushl (e-cvt tagloc)) ; push tag +++ (e-write2 'pushl (e-cvt flagloc)) ; non-nil flag +++ (e-write2 'pushl '_errp) ; old error pointer +++ (e-write3 'movl 'sp '_errp) ; set up new error pointer +++ (Push g-locs '(catcherrset . 0)) +++ (d-exp expr) ; now do the expression +++ (unpush g-locs) +++ (e-write3 'movl '"(sp)" '_errp) ; unlink this error frame +++ (e-write3 'addl2 '$80 'sp) +++ (d-clearreg)) ; cant predict contents after retune +++ +++ +++;--- c-cond :: compile a "cond" expression = c-cond = +++; +++; not that this version of cond is a 'c' rather than a 'cc' . +++; this was done to make coding this routine easier and because +++; it is believed that it wont harm things much if at all +++; +++(defun c-cond nil +++ (makecomment '(beginning cond)) +++ (do ((clau (cdr v-form) (cdr clau)) +++ (finlab (d-genlab)) +++ (nxtlab) +++ (save-reguse) +++ (seent)) +++ ((or (null clau) seent) +++ ; end of cond +++ ; if haven't seen a t must store a nil in r0 +++ (If (null seent) then (d-move 'Nil 'reg)) +++ (e-label finlab)) +++ +++ ; case 1 - expr +++ (If (atom (car clau)) +++ then (comp-err "bad cond clause " (car clau)) +++ ; case 2 - (expr) +++ elseif (null (cdar clau)) +++ then (let ((g-loc (If (or g-cc g-loc) then 'reg)) +++ (g-cc (cons finlab nil)) +++ (g-ret)) +++ (d-exp (caar clau))) +++ ; case 3 - (t expr1 expr2 ...) +++ elseif (or (eq t (caar clau)) +++ (equal ''t (caar clau))) +++ then (let ((g-loc (If (or g-cc g-loc) then 'reg)) +++ g-cc) +++ (d-exps (cdar clau))) +++ (setq seent t) +++ ; case 4 - (expr1 expr2 ...) +++ else (let ((g-loc nil) +++ (g-cc (cons nil (setq nxtlab (d-genlab)))) +++ (g-ret nil)) +++ (d-exp (caar clau))) +++ (setq save-reguse (copy g-reguse)) +++ (let ((g-loc (If (or g-cc g-loc) then 'reg)) +++ g-cc) +++ (d-exps (cdar clau))) +++ (If (or (cdr clau) (null seent)) then (e-goto finlab)) +++ (e-label nxtlab) +++ (setq g-reguse save-reguse))) +++ +++ (d-clearreg)) +++ +++ +++ +++;--- c-cons :: do a cons instruction quickly = c-cons = +++; +++(defun c-cons nil +++ (d-pushargs (cdr v-form)) ; there better be 2 args +++ (e-write2 'jsb '_qcons) +++ (setq g-locs (cddr g-locs)) +++ (setq g-loccnt (- g-loccnt 2)) +++ (d-clearreg)) +++ +++ +++;--- c-cxr :: compile a cxr instruction = c-cxr = +++; +++; this code would also be useful for accessing any vector of lispvals. +++; +++(defun c-cxr nil +++ (prog (arg1 arg2 arg1loc arg2loc) +++ (setq arg1loc (d-simple (setq arg1 (list 'cdr (cadr v-form)))) +++ arg2loc (d-simple (setq arg2 (caddr v-form)))) +++ +++ (If (not (and (dtpr arg1loc) (eq 'immed (car arg1loc)))) +++ then +++ (If arg2loc +++ then (If (null arg1loc) +++ then (let ((g-loc 'r1) +++ (g-cc)) +++ (d-exp arg1)) +++ else (d-move arg1loc 'r1)) +++ (d-move arg2loc 'r0) +++ else (d-pushargs (ncons arg1)) +++ (let ((g-loc 'r0) +++ (g-cc)) +++ (d-exp arg2)) +++ (d-move 'unstack 'r1) +++ (decr g-loccnt) +++ (Pop g-locs)) +++ (d-inreg 'r1 nil) ; register clobbered +++ (If g-loc then (e-move `(0 r0 r1) (e-cvt g-loc)) +++ (d-handlecc) +++ elseif g-cc then (e-tst `(0 r0 r1)) +++ (d-handlecc)) +++ else (let ((g-loc 'r0) +++ (g-cc)) +++ (d-exp arg2)) +++ (setq arg1loc (list (* 4 (cadr arg1loc)) 'r0)) +++ (If g-loc then (e-move arg1loc (e-cvt g-loc)) +++ (d-handlecc) +++ elseif g-cc then (e-tst arg1loc) +++ (d-handlecc))))) +++ +++ +++;--- cc-cxxr :: compile a "c*r" instr where * = c-cxxr = +++; is any sequence of a's and d's +++; - arg : argument of the cxxr function +++; - pat : a list of a's and d's in the reverse order of that +++; which appeared between the c and r +++; +++(defun cc-cxxr (arg pat) +++ (prog (resloc loc qloc sofar togo keeptrack) +++ ; check for the special case of nil, since car's and cdr's +++ ; are nil anyway +++ (If (null arg) then (If g-loc then (d-move 'Nil g-loc) +++ (d-handlecc) +++ elseif (cdr g-cc) then (e-goto (cdr g-cc))) +++ (return)) +++ +++ (If (and (symbolp arg) (setq qloc (d-bestreg arg pat))) +++ then (setq resloc (car qloc) +++ loc resloc +++ sofar (cadr qloc) +++ togo (caddr qloc)) +++ else (setq resloc (If (d-simple arg) thenret +++ else (let ((g-loc 'reg) +++ (g-cc nil) +++ (g-ret nil)) +++ (d-exp arg)) +++ 'r0)) +++ (setq sofar nil +++ togo pat)) +++ +++ (If (and arg (symbolp arg)) then (setq keeptrack t)) +++ +++ ; if resloc is a global variable, we must move it into a register +++ ; right away to be able to do car's and cdr's +++ (If (and (dtpr resloc) (or (eq (car resloc) 'bind) +++ (eq (car resloc) 'vstack))) +++ then (d-move resloc 'reg) +++ (setq resloc 'r0)) +++ +++ ; now do car's and cdr's . Values are placed in r0. We stop when +++ ; we can get the result in one machine instruction. At that point +++ ; we see whether we want the value or just want to set the cc's. +++ ; If the intermediate value is in a register, +++ ; we can do : car cdr cddr cdar +++ ; If the intermediate value is on the local vrbl stack or lbind +++ ; we can do : cdr +++ (do ((curp togo newp) +++ (newp)) +++ ((null curp) (If g-loc then (d-movespec loc g-loc) +++ elseif g-cc then (e-tst loc)) +++ (d-handlecc)) +++ (If (symbolp resloc) +++ then (If (eq 'd (car curp)) +++ then (If (or (null (cdr curp)) +++ (eq 'a (cadr curp))) +++ then (setq newp (cdr curp) ; cdr +++ loc `(0 ,resloc) +++ sofar (append sofar (list 'd))) +++ else (setq newp (cddr curp) ; cddr +++ loc `(* 0 ,resloc) +++ sofar (append sofar (list 'd 'd)))) +++ else (If (or (null (cdr curp)) +++ (eq 'a (cadr curp))) +++ then (setq newp (cdr curp) ; car +++ loc `(4 ,resloc) +++ sofar (append sofar (list 'a))) +++ else (setq newp (cddr curp) ; cdar +++ loc `(* 4 ,resloc) +++ sofar (append sofar (list 'a 'd))))) +++ elseif (and (eq 'd (car curp)) +++ (not (eq '* (car (setq loc (e-cvt resloc)))))) +++ then (setq newp (cdr curp) ; (cdr ) +++ loc (cons '* loc) +++ sofar (append sofar (list 'd))) +++ else (setq loc (e-cvt resloc) +++ newp curp)) +++ (If newp ; if this is not the last move +++ then (setq resloc (d-allocreg (If keeptrack then nil else 'r0))) +++ (d-movespec loc resloc) +++ (If keeptrack then (d-inreg resloc (cons arg sofar))))))) +++ +++;--- c-declare :: handle the "declare" form +++; if a declare is seen inside a function definition, we just +++; ignore it. We probably should see what it is declareing, as it +++; might be declaring a special. +++; +++(defun c-declare nil) +++ +++;--- c-do :: compile a "do" expression = c-do = +++; +++; a do has this form: +++; (do vrbls tst . body) +++; we note the special case of tst being nil, in which case the loop +++; is evaluated only once, and thus acts like a let with labels allowed. +++; The do statement is a cross between a prog and a lambda. It is like +++; a prog in that labels are allowed. It is like a lambda in that +++; we stack the values of all init forms then bind to the variables, just +++; like a lambda expression (that is the initial values of even specials +++; are stored on the stack, and then copied into the value cell of the +++; atom during the binding phase. From then on the stack location is +++; not used). +++; +++(defun c-do nil +++ (prog (b-vrbls b-tst b-body chklab bodylab x-repeat x-vrbs x-fst +++ g-loc g-cc oldreguse) +++ (forcecomment '(beginning do)) +++ (setq g-loc 'reg chklab (d-genlab) bodylab (d-genlab)) +++ +++ (If (and (cadr v-form) (atom (cadr v-form))) +++ then (setq v-form (d-olddo-to-newdo (cdr v-form)))) +++ +++ (Push g-locs (cons 'do 0 )) ; begin our frame +++ +++ (setq b-vrbls (cadr v-form) +++ b-tst (caddr v-form) +++ b-body (cdddr v-form)) +++ +++ ; push value of init forms on stack +++ (d-pushargs (mapcar '(lambda (x) +++ (If (atom x) then nil ; no init form => nil +++ else (cadr x))) +++ b-vrbls)) +++ +++ ; now bind to the variables in the vrbls form +++ (d-bindlamb (mapcar '(lambda (x) +++ (If (atom x) then x +++ else (car x))) +++ b-vrbls)) +++ +++ ; search through body for all labels and assign them gensymed labels +++ (Push g-labs (cons (d-genlab) +++ (do ((ll b-body (cdr ll)) +++ (res)) +++ ((null ll) res) +++ (If (and (car ll) (symbolp (car ll))) +++ then (Push res (cons (car ll) (d-genlab))))))) +++ +++ ; if the test is non nil, we do the test +++ ; another strange thing, a test form of (pred) will not return +++ ; the value of pred if it is not nil! it will return nil (in this +++ ; way, it is not like a cond clause) +++ (d-clearreg) +++ (If b-tst then (e-label chklab) +++ (let ((g-cc (cons nil bodylab)) g-loc g-ret) +++ (d-exp (car b-tst))) ; eval test +++ ; if false, do body +++ (If (cdr b-tst) +++ then (setq oldreguse (copy g-reguse)) +++ (d-exps (cdr b-tst)) +++ (setq g-reguse oldreguse) +++ else (d-move 'Nil 'reg)) +++ (e-goto (caar g-labs)) ; leave do +++ (e-label bodylab)) ; begin body +++ +++ ; process body +++ (do ((ll b-body (cdr ll)) +++ (g-cc) (g-loc)(g-ret)) +++ ((null ll)) +++ (If (or (null (car ll)) (not (symbolp (car ll)))) +++ then (d-exp (car ll)) +++ else (e-label (cdr (assoc (car ll) (cdar g-labs)))) +++ (d-clearreg))) +++ +++ (If b-tst then ; determine all repeat forms which must be +++ ; evaluated, and all the variables affected. +++ ; store the results in x-repeat and x-vrbs +++ ; if there is just one repeat form, we calculate +++ ; its value directly into where it is stored, +++ ; if there is more than one, we stack them +++ ; and then store them back at once. +++ (do ((ll b-vrbls (cdr ll))) +++ ((null ll)) +++ (If (and (dtpr (car ll)) (cddar ll)) +++ then (Push x-repeat (caddar ll)) +++ (Push x-vrbs (caar ll)))) +++ (If x-vrbs +++ then (If (null (cdr x-vrbs)) ; if just one repeat.. +++ then (let ((g-loc (d-locv (car x-vrbs))) +++ (g-cc nil)) +++ (d-exp (car x-repeat))) +++ else (setq x-fst (car x-repeat)) +++ (d-pushargs (nreverse (cdr x-repeat))) +++ (let ((g-loc (d-locv (car x-vrbs))) +++ (g-cc) +++ (g-ret)) +++ (d-exp x-fst)) +++ (do ((ll (cdr x-vrbs) (cdr ll))) +++ ((null ll)) +++ (d-move 'unstack (d-locv (car ll))) +++ (setq g-locs (cdr g-locs)) +++ (decr g-loccnt)))) +++ (e-goto chklab)) +++ +++ (e-label (caar g-labs)) ; end of do label +++ (d-clearreg) +++ (d-unbind) +++ (setq g-labs (cdr g-labs)))) +++ +++ +++;--- d-olddo-to-newdo :: map old do to new do +++; +++; form of old do is (do var tst . body) +++; where var is a symbol, not nil +++; +++(defun d-olddo-to-newdo (v-l) +++ `(do ((,(car v-l) ,(cadr v-l) ,(caddr v-l))) +++ (,(cadddr v-l)) +++ ,@(cddddr v-l))) +++ +++ +++ +++;--- cc-dtpr :: check for dtprness = cc-dtpr = +++; +++(defun cc-dtpr nil +++ (d-typesimp (cadr v-form) '$3)) +++ +++ +++;--- cc-eq :: compile an "eq" expression = cc-eq = +++; +++(defun cc-eq nil +++ (let ((arg1 (cadr v-form)) +++ (arg2 (caddr v-form)) +++ arg1loc +++ arg2loc) +++ (If (setq arg2loc (d-simple arg2)) +++ then (If (setq arg1loc (d-simple arg1)) +++ then ; eq +++ (d-cmp arg1loc arg2loc) +++ else ; eq +++ (let ((g-loc 'reg) ; put in r0 +++ g-cc +++ g-ret) +++ (d-exp arg1)) +++ (d-cmp 'reg arg2loc)) +++ else ; since second is nonsimple, must stack first +++ ; arg out of harms way +++ (let ((g-loc 'stack) +++ g-cc +++ g-ret) +++ (d-exp arg1) +++ (Push g-locs nil) +++ (incr g-loccnt) +++ (setq g-loc 'reg) ; second arg to r0 +++ (d-exp arg2)) +++ (d-cmp 'unstack 'reg) +++ (setq g-locs (cdr g-locs)) +++ (decr g-loccnt))) +++ +++ (d-invert)) +++ +++(defun cc-equal nil +++ (let ((lab1 (d-genlab)) +++ (lab11 (d-genlab)) +++ lab2) +++ (d-pushargs (cdr v-form)) +++ (e-write3 'cmpl "-8(r6)" "-4(r6)") +++ (e-gotonil lab1) +++ (d-calltran 'equal '2) ; not eq, try equal. +++ (d-clearreg) +++ (e-write2 'tstl 'r0) +++ (e-gotot lab11) +++ (If g-loc then (d-move 'Nil g-loc)) +++ (If (cdr g-cc) then (e-goto (cdr g-cc)) +++ else (e-goto (setq lab2 (d-genlab)))) +++ (e-writel lab1) +++ (e-dropnp 2) +++ (e-writel lab11) +++ (If g-loc then (d-move 'T g-loc)) +++ (If (car g-cc) then (e-goto (car g-cc))) +++ (If lab2 then (e-writel lab2)) +++ (setq g-locs (cddr g-locs)) +++ (setq g-loccnt (- g-loccnt 2)))) +++ +++ +++ +++ +++;--- c-errset :: compile an errset expression = c-errset = +++; +++; the errset has this form: (errset 'value ['tag]) +++; where tag defaults to t. +++; +++(defun c-errset nil +++ (let ((g-loc 'reg) +++ (g-cc nil) +++ (g-ret nil) +++ (finlab (d-genlab))) +++ (d-exp (If (cddr v-form) then (caddr v-form) else t)) +++ (d-catcherrset finlab (d-loclit '(ER%all) nil) 'reg (cadr v-form)) +++ (d-move 'reg 'stack) +++ (d-calltran 'ncons 1) +++ (e-label finlab) +++ (d-clearreg))) +++ +++ +++;--- cc-fixp :: check for a fixnum or bignum = cc-fixp = +++; +++(defun cc-fixp nil +++ (d-typecmplx (cadr v-form) +++ '#.(concat '$ (plus 1_2 1_9)))) +++ +++ +++;--- cc-floatp :: check for a flonum = cc-floatp = +++; +++(defun cc-floatp nil +++ (d-typesimp (cadr v-form) '$4)) +++ +++ +++;--- c-get :: do a get from the prop list +++; +++(defun c-get nil +++ (If (not (eq 2 (length (cdr v-form)))) +++ then (comp-err "Wrong number of args to get " v-form)) +++ (d-pushargs (cdr v-form)) ; there better be 2 args +++ (e-write2 'jsb '_qget) +++ (d-clearreg) +++ (setq g-locs (cddr g-locs)) +++ (setq g-loccnt (- g-loccnt 2))) +++ +++;--- c-go :: compile a "go" expression = c-go = +++; +++; we only compile the (go symbol)type expression, we do not +++; allow symbol to be anything by a non null symbol. +++; +++(defun c-go nil +++ ; find number of frames we have to go down to get to the label +++ (do ((labs g-labs (cdr labs)) +++ (locs g-locs) +++ (locals 0) +++ (specials 0) +++ (catcherrset 0) +++ (label)) +++ ((null labs) (comp-err "go label not found for expression: " (or v-form))) +++ ; if there are any enclosing *catches or errsets, they will be +++ ; first in g-locs +++ (do nil +++ ((not (and (dtpr (car locs)) (eq (caar locs) 'catcherrset)))) +++ (incr catcherrset) +++ (unpush locs)) +++ +++ (If (car labs) +++ then (If (setq label (do ((lbs (cdar labs) (cdr lbs))) +++ ((null lbs)) +++ (If (eq (caar lbs) (cadr v-form)) +++ then (return (cdar lbs))))) +++ then (If (not (eq labs g-labs)) +++ then (comp-warn "non local go used : " (or v-form))) +++ (If (greaterp catcherrset 0) +++ then (comp-warn "Go through a catch or errset " v-form) +++ (do ((i 0 (1+ i))) +++ ((equal catcherrset i)) +++ (e-write3 'movl "(sp)" '_errp) +++ (e-write3 'addl2 '$80 'sp))) +++ (e-pop locals) +++ (If (greaterp specials 0) +++ then (e-unshallowbind specials)) +++ (e-goto label) +++ (return))) +++ ; tally all locals and specials used in this frame +++ (do () +++ ((dtpr (car locs)) (setq specials (+ specials (cdar locs)) +++ locs (cdr locs))) +++ (setq locs (cdr locs)) +++ (incr locals)))) +++ +++ +++;--- cc-ingnore :: just ignore this code +++; +++(defun cc-ignore nil +++ nil) +++ +++;--- c-lambexp :: compile a lambda expression = c-lambexp = +++; +++(defun c-lambexp nil +++ (let ((g-loc (If (or g-loc g-cc) then 'reg)) +++ (g-cc nil)) +++ (Push g-locs (cons 'lambda 0)) ; add null lambda header +++ (d-pushargs (cdr v-form)) ; then push vals +++ (d-lambbody (car v-form)) +++ (d-clearreg))) +++ +++;--- d-lambbody :: do a lambda body +++; - body : body of lambda expression, eg (lambda () dld) +++; +++(defun d-lambbody (body) +++ (d-bindlamb (cadr body)) ; bind locals +++ (setq g-labs (cons nil g-labs)) ; no labels allowed +++ (d-clearreg) +++ (d-exp (do ((ll (cddr body) (cdr ll)) +++ (g-loc) +++ (g-cc) +++ (g-ret)) +++ ((null (cdr ll)) (car ll)) +++ (d-exp (car ll)))) +++ +++ (setq g-labs (cdr g-labs)) +++ (d-unbind)) ; unbind this frame +++ +++ +++;--- d-bindlamb :: bind variables in lambda list +++; - vrbs : list of lambda variables, may include nil meaning ignore +++; +++(defun d-bindlamb (vrbs) +++ (let ((res (d-bindlrec (reverse vrbs) g-locs 0 g-loccnt))) +++ (If res then (e-setupbind) +++ (mapc '(lambda (vrb) (e-shallowbind (car vrb) (cdr vrb))) +++ res) +++ (e-unsetupbind)))) +++ +++;--- d-bindlrec :: recusive routine to bind lambda variables +++; - vrb : list of variables yet to bind +++; - locs : current location in g-loc +++; - specs : number of specials seen so far +++; - lev : how far up from the bottom of stack we are. +++; returns: list of elements, one for each special, of this form: +++; ( stack ) +++; where specialvrbname is the name of the special variable, and n is +++; the distance from the top of the stack where its initial value is +++; located +++; also: puts the names of the local variables in the g-locs list, as well +++; as placing the number of special variables in the lambda header. +++; +++(defun d-bindlrec (vrb locs specs lev) +++ (If vrb +++ then (let ((spcflg (d-specialp (car vrb))) +++ retv) +++ (If spcflg then (setq specs (1+ specs))) +++ +++ (If (cdr vrb) ; if more vrbls to go ... +++ then (setq retv (d-bindlrec (cdr vrb) +++ (cdr locs) +++ specs +++ (1- lev))) +++ else (rplacd (cadr locs) specs)) ; else fix up lambda hdr +++ +++ (If (not spcflg) then (rplaca locs (car vrb)) +++ else (Push retv `(,(car vrb) stack ,lev))) +++ +++ retv))) +++;--- c-list :: compile a list expression = c-list = +++; +++; this is compiled as a bunch of conses with a nil pushed on the +++; top for good measure +++; +++(defun c-list nil +++ (prog (nargs) +++ (setq nargs (length (cdr v-form))) +++ (makecomment '(list expression)) +++ (If (zerop nargs) then (d-move 'Nil 'reg) ; (list) ==> nil +++ (return)) +++ (d-pushargs (cdr v-form)) +++ (e-write2 'clrl '(+ #.Np-reg)) ; stack one nil +++ +++ ; now do the consing +++ (do ((i (max 1 nargs) (1- i))) +++ ((zerop i)) +++ (e-write2 'jsb '_qcons) +++ (d-clearreg) +++ (If (> i 1) then (d-move 'reg 'stack))) +++ +++ (setq g-locs (nthcdr nargs g-locs) +++ g-loccnt (- g-loccnt nargs)))) +++ +++ +++ +++;--- d-mapconvert - access : function to access parts of lists +++; - join : function to join results +++; - resu : function to apply to result +++; - form : mapping form +++; This function converts maps to an equivalent do form. +++; +++(defun d-mapconvert (access join resu form ) +++ (prog (vrbls finvar acc accform compform tmp) +++ +++ (setq finvar (gensym 'X) ; holds result +++ +++ vrbls (reverse +++ (maplist '(lambda (arg) +++ ((lambda (temp) +++ (cond ((or resu (cdr arg)) +++ `(,temp ,(car arg) +++ (cdr ,temp))) +++ (t `(,temp +++ (setq ,finvar ,(car arg)) +++ (cdr ,temp))))) +++ (gensym 'X))) +++ (reverse (cdr form)))) +++ +++ acc (mapcar '(lambda (tem) +++ (cond (access `(,access ,(car tem))) +++ (t (car tem)))) +++ vrbls) +++ +++ accform (cond ((or (atom (setq tmp (car form))) +++ (null (setq tmp (d-macroexpand tmp))) +++ (not (member (car tmp) '(quote function)))) +++ `(funcall ,tmp ,@acc)) +++ (t `(,(cadr tmp) ,@acc)))) +++ (return +++ `((lambda (,finvar) +++ (do ( ,@vrbls) +++ ((null ,(caar vrbls))) +++ ,(cond ((eq join 'nconc) +++ `(setq ,finvar (nconc ,finvar ,accform))) +++ (join `(setq ,finvar (,join ,accform ,finvar))) +++ (t accform))) +++ ,(cond ((eq resu 'identity) finvar) +++ (resu `(,resu ,finvar)) +++ (t finvar))) +++ nil )))) +++; apply to successive elements, return second arg +++(defun cm-mapc nil +++ (d-mapconvert 'car nil nil (cdr v-form))) +++ +++; apply to successive elements, return list of results +++(defun cm-mapcar nil +++ (d-mapconvert 'car 'cons 'nreverse (cdr v-form))) +++ +++; apply to successive elements, returned nconc of results +++(defun cm-mapcan nil +++ (d-mapconvert 'car 'nconc 'identity (cdr v-form))) +++ +++ +++; apply to successive sublists, return second arg +++(defun cm-map nil +++ (d-mapconvert nil nil nil (cdr v-form))) +++ +++ +++; apply to successive sublists, return list of results +++(defun cm-maplist nil +++ (d-mapconvert nil 'cons 'reverse (cdr v-form))) +++ +++; apply to successive sublists, return nconc of results +++(defun cm-mapcon nil +++ (d-mapconvert nil 'nconc 'identity (cdr v-form))) +++ +++ +++;--- cc-memq :: compile a memq expression = cc-memq = +++; +++(defun cc-memq nil +++ (let ((loc1 (d-simple (cadr v-form))) +++ (loc2 (d-simple (caddr v-form))) +++ looploc finlab) +++ (If loc2 then (d-clearreg 'r1) +++ (If loc1 then (d-move loc1 'r1) +++ else (let ((g-loc 'r1) +++ g-cc +++ g-ret) +++ (d-exp (cadr v-form)))) +++ (d-move loc2 'reg) +++ else (let ((g-loc 'stack) +++ g-cc +++ g-ret) +++ (d-exp (cadr v-form))) +++ (Push g-locs nil) +++ (incr g-loccnt) +++ (let ((g-loc 'reg) +++ g-cc +++ g-ret) +++ (d-exp (caddr v-form))) +++ (d-move 'unstack 'r1) +++ (d-clearreg 'r1) +++ (unpush g-locs) +++ (decr g-loccnt)) +++ ; now set up the jump addresses +++ (If (null g-loc) +++ then (setq loc1 (If (car g-cc) thenret +++ else (d-genlab)) +++ loc2 (If (cdr g-cc) thenret +++ else (d-genlab))) +++ else (setq loc1 (d-genlab) +++ loc2 (d-genlab))) +++ +++ (setq looploc (d-genlab)) +++ +++ (e-write2 'tstl 'r0) +++ (e-write2 'jeql loc2) +++ (e-label looploc) +++ (e-write3 'cmpl 'r1 "4(r0)") +++ (e-write2 'jeql loc1) +++ (e-write3 'movl "(r0)" 'r0) +++ (e-write2 'jneq looploc) +++ (If g-loc then (e-label loc2) ; nil result +++ (d-move 'reg g-loc) +++ (If (cdr g-cc) then (e-goto (cdr g-cc)) +++ else (e-goto (setq finlab (d-genlab)))) +++ else (If (cdr g-cc) then (e-goto (cdr g-cc)) +++ else (e-label loc2))) +++ (If g-loc then (e-label loc1) ; non nil result +++ (d-move 'reg g-loc) +++ (If (car g-cc) then (e-goto (car g-cc))) +++ else (If (null (car g-cc)) then (e-label loc1))) +++ (If finlab then (e-label finlab)))) +++ diff --cc usr/src/cmd/liszt/camacs.l index 0000000000,0000000000,0000000000..48c88947ff new file mode 100644 --- /dev/null +++ b/usr/src/cmd/liszt/camacs.l @@@@ -1,0 -1,0 -1,0 +1,138 @@@@ +++ +++;----------- macros for the compiler ------------- +++ +++ +++(setq sectioncamacsid "@(#)camacs.l 5.2 11/11/80") ; id for SCCS +++ +++; Copyright (c) 1980 , The Regents of the University of California. +++; All rights reserved. +++; author: j. foderaro +++ +++(declare (macros t)) ; compile and save macros +++ +++;--- comp-err +++; comp-warn +++; comp-note +++; comp-gerr +++; these are the compiler message producing macros. The form is +++; (comp-xxxx val1 val2 val3 ... valn) , all values are printed according +++; to this scheme. If vali is an atom, it is patomed, if vali is a +++; list, it is evaluated and printed. If vali is N a newline is printed +++; +++; furthermore +++; the name of the current function is printed first +++; after comp-err prints the message, it does a throw to Comp-err . +++; errors are preceeded by Error: +++; warnings by %Warning: and +++; notes by %Note: +++; The message is sent to the message file +++; +++(def comp-err +++ (macro (l) +++ `(progn ,@(comp-msg +++ `( "Error: " g-fname ": " ,@(cdr l) N)) +++ (setq er-fatal (1+ er-fatal)) +++ (throw nil Comp-error)))) +++ +++(def comp-warn +++ (macro (l) +++ `(progn (cond (fl-warn +++ ,@(comp-msg +++ `( "%Warning: " g-fname ": " ,@(cdr l) N))))))) +++ +++(def comp-note +++ (macro (l) +++ `(progn (cond (fl-verb +++ ,@(comp-msg +++ `( "%Note: " ,@(cdr l) N))))))) +++ +++(def comp-gerr +++ (macro (l) +++ `(progn ,@(comp-msg +++ `("?Error: " ,@(cdr l) N)) +++ (setq er-fatal (1+ er-fatal))))) +++ +++;--- comp-msg - port +++; - lst +++; prints the lst to the given port. The lst is printed in the manner +++; described above, that is atoms are patomed, and lists are evaluated +++; and printed, and N prints a newline. The output is always drained. +++; +++(eval-when (compile load eval) +++ (def comp-msg +++ (lambda (lis) +++ (cond ((null lis) `((drain))) +++ (t `(,(cond ((atom (car lis)) +++ (cond ((eq (car lis) 'N) +++ `(terpr)) +++ (t `(niceprint ,(car lis))))) +++ (t `(niceprint ,(car lis)))) +++ ,@(comp-msg (cdr lis))))))) +++ (def niceprint +++ (macro (l) +++ `((lambda (val) +++ (cond ((floatp val) +++ (patom (quotient (fix (times val 100)) 100.0))) +++ (t (patom val)))) +++ ,(cadr l))))) +++ +++;--- super if macro +++(defun If macro (lis) +++ (prog (majlis minlis revl) +++ (do ((revl (reverse lis) (cdr revl))) +++ ((null revl)) +++ (cond ((eq (car revl) 'else) +++ (setq majlis `((t ,@minlis) ,@majlis) +++ minlis nil)) +++ ((or (eq (car revl) 'then) (eq (car revl) 'thenret)) +++ (setq revl (cdr revl) +++ majlis `((,(car revl) ,@minlis) ,@majlis) +++ minlis nil)) +++ ((eq (car revl) 'elseif)) +++ ((eq (car revl) 'If) +++ (setq majlis `(cond ,@majlis))) +++ (t (setq minlis `( ,(car revl) ,@minlis))))) +++ ; we displace the previous macro, that is we actually replace +++ ; the if list structure with the corresponding cond, meaning +++ ; that the expansion is done only once +++ (rplaca lis (car majlis)) +++ (rplacd lis (cdr majlis)) +++ (return majlis))) +++ +++;--- standard push macro +++; (Push stackname valuetoadd) +++ +++(defmacro Push (atm val) +++ `(setq ,atm (cons ,val ,atm))) +++ +++;--- pop macro +++ +++(defmacro Pop (val) +++ `(prog1 (car ,val) (setq ,val (cdr ,val)))) +++ +++;--- unpush macro - like pop except top value is thrown away +++(defmacro unpush (atm) +++ `(setq ,atm (cdr ,atm))) +++ +++;--- and an increment macro +++ +++(defmacro incr (atm) +++ `(setq ,atm (1+ ,atm))) +++ +++(defmacro decr (atm) +++ `(setq ,atm (1- ,atm))) +++;--- add a comment +++ +++(defmacro makecomment (arg) +++ `(cond (fl-comments (setq g-comments (cons ,arg g-comments))))) +++ +++;--- add a comment irregardless of the fl-comments flag +++(defmacro forcecomment (arg) +++ `(setq g-comments (cons ,arg g-comments))) +++ +++;--- write to the .s file +++ +++(defmacro sfilewrite (arg) +++ `(patom ,arg vp-sfile)) +++ +++ diff --cc usr/src/cmd/liszt/car.l index 0000000000,0000000000,0000000000..cc4ba19182 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/liszt/car.l @@@@ -1,0 -1,0 -1,0 +1,822 @@@@ +++; l i s z t v 4 +++; +++; +++; +++; A compiler for Franz lisp +++; +++; Copyright (c) 1980 , The Regents of the University of California. +++; All rights reserved. +++; author: j. foderaro +++; +++; Section INIT -- initialization and macros +++ +++(include "caspecs.l") +++ +++(eval-when (compile eval) +++ (cond ((not (getd 'If)) +++ (fasl 'camacs)))) +++ +++;the version number is maintained by hand, and is written twice +++; once for the benefit of the user +++(setq compiler-name "Lisp Compiler 5.0") +++; and the other time for SCCS's what command +++(setq sccs-compiler-name "@(#)Liszt version 5.0") +++ +++(setq sectioncarid "@(#)car.l 5.4 11/11/80") ; id for SCCS +++ +++(setq original-readtable readtable) +++(setq raw-readtable (makereadtable t)) +++ +++;--- special handlers +++(putprop 'and 'cc-and 'fl-exprcc) +++(putprop 'arg 'cc-arg 'fl-exprcc) +++(putprop 'atom 'cc-atom 'fl-exprcc) +++(putprop 'bigp 'cc-bigp 'fl-exprcc) +++(putprop 'bcdp 'cc-bcdp 'fl-exprcc) +++(putprop '*catch 'c-*catch 'fl-expr) +++(putprop 'comment 'cc-ignore 'fl-exprcc) +++(putprop 'cond 'c-cond 'fl-expr) +++(putprop 'cons 'c-cons 'fl-expr) +++(putprop 'cxr 'c-cxr 'fl-exprcc) +++(putprop 'declare 'c-declare 'fl-expr) +++(putprop 'do 'c-do 'fl-expr) +++(putprop 'dtpr 'cc-dtpr 'fl-exprcc) +++(putprop 'eq 'cc-eq 'fl-exprcc) +++(putprop 'equal 'cc-equal 'fl-exprcc) +++(putprop '= 'cc-equal 'fl-exprcc) +++(putprop 'errset 'c-errset 'fl-expr) +++(putprop 'fixp 'cc-fixp 'fl-exprcc) +++(putprop 'floatp 'cc-floatp 'fl-exprcc) +++(putprop 'get 'c-get 'fl-expr) +++(putprop 'go 'c-go 'fl-expr) +++(putprop 'list 'c-list 'fl-expr) +++(putprop 'map 'cm-map 'fl-exprm) +++(putprop 'mapc 'cm-mapc 'fl-exprm) +++(putprop 'mapcan 'cm-mapcan 'fl-exprm) +++(putprop 'mapcar 'cm-mapcar 'fl-exprm) +++(putprop 'mapcon 'cm-mapcon 'fl-exprm) +++(putprop 'maplist 'cm-maplist 'fl-exprm) +++(putprop 'memq 'cc-memq 'fl-exprcc) +++(putprop 'not 'cc-not 'fl-exprcc) +++(putprop 'null 'cc-not 'fl-exprcc) +++(putprop 'numberp 'cc-numberp 'fl-exprcc) +++(putprop 'or 'cc-or 'fl-exprcc) +++(putprop 'prog 'c-prog 'fl-expr) +++(putprop 'progn 'cm-progn 'fl-exprm) +++(putprop 'prog1 'cm-prog1 'fl-exprm) +++(putprop 'prog2 'cm-prog2 'fl-exprm) +++(putprop 'quote 'cc-quote 'fl-exprcc) +++(putprop 'return 'c-return 'fl-expr) +++(putprop 'rplaca 'c-rplaca 'fl-expr) +++(putprop 'rplacd 'c-rplacd 'fl-expr) +++(putprop 'setarg 'c-setarg 'fl-expr) +++(putprop 'setq 'cc-setq 'fl-exprcc) +++(putprop 'stringp 'cc-stringp 'fl-exprcc) +++(putprop 'symbolp 'cc-symbolp 'fl-exprcc) +++(putprop 'symeval 'cm-symeval 'fl-exprm) +++(putprop '*throw 'c-*throw 'fl-expr) +++(putprop 'typep 'cc-typep 'fl-exprcc) +++(putprop 'zerop 'cm-zerop 'fl-exprm) +++ +++(putprop '1+ 'c-1+ 'fl-expr) +++(putprop '1- 'c-1- 'fl-expr) +++(putprop '+ 'c-+ 'fl-expr) +++(putprop '- 'c-- 'fl-expr) +++(putprop '* 'c-* 'fl-expr) +++(putprop '/ 'c-/ 'fl-expr) +++(putprop '\\ 'c-\\ 'fl-expr) +++ +++ +++ +++ +++; Section INTERF -- user interface +++ +++ +++;--- lisztinit : called upon compiler startup. If there are any args +++; on the command line, we build up a call to lcf, which +++; will do the compile. Afterwards we exit. +++; +++(def lisztinit +++ (lambda nil +++ (cond ((greaterp (argv -1) 1) ; build up list of args +++ (do ((i (1- (argv -1)) (1- i)) (arglis)) +++ ((lessp i 1) +++ (setq user-top-level nil) +++ (exit (apply 'liszt arglis))) +++ (setq arglis (cons (argv i) arglis)))) +++ (t (patom compiler-name) +++ (terpr poport) +++ (setq user-top-level nil))))) +++ +++(setq user-top-level 'lisztinit) +++ +++ +++ +++;--- lcf - v-x : list containing file name to compile and optionaly +++; and output file name for the assembler source. +++; +++(def liszt +++ (nlambda (v-x) +++ (prog (piport v-root v-ifile v-sfile v-ofile +++ vp-ifile vp-sfile vps-crap +++ vps-include +++ tmp rootreal +++ g-fname +++ tem temr starttime startptime startgccount +++ fl-asm fl-warn fl-verb fl-inter fl-xref fl-uci +++ g-skipcode g-dropnpcnt) +++ +++ ; turn on monitoring if it exists +++ #+monitoring +++ (errset (progn (monitor t) ; turn it on +++ (print 'monitor-on) +++ (terpr)) +++ nil) +++ (setq starttime (syscall 13) ; real time in seconds +++ startptime (ptime) +++ startgccount $gccount$) +++ (cond ((null (boundp 'internal-macros)) +++ (setq internal-macros nil))) +++ (cond ((null (boundp 'macros)) +++ (setq macros nil))) +++ (setq er-fatal 0) +++ (setq vps-include nil) +++ (setq twa-list nil) +++ (setq liszt-eof-forms nil) +++ +++ ; set up once only g variables +++ (setq g-comments nil +++ g-current nil ; current function name +++ g-funcs nil +++ g-lits nil +++ g-trueloc nil +++ g-tran nil +++ g-allf nil ; used in xrefs +++ g-reguse '((r5 0 . nil) (r4 0 . nil) (r3 0 . nil) +++ (r2 0 . nil) (r7 0 . nil) (r1 0 . nil)) +++ g-trancnt 0 +++ g-ignorereg nil +++ g-litcnt 0) +++ (setq g-spec (gensym 'S)) ; flag for special atom +++ (setq special nil) ; t if all vrbs are special +++ (setq g-functype (gensym) +++ g-bindloc (gensym) +++ g-localf (gensym) +++ g-tranloc (gensym)) +++ +++ ; declare these special +++ +++ (sstatus feature complr) +++ (d-makespec 't) ; always special +++ +++ ; process input form +++ (setq fl-asm t ; assembler file assembled +++ fl-warn t ; print warnings +++ fl-verb t ; be verbose +++ fl-macl nil ; compile maclisp file +++ fl-inter nil ; do interlisp compatablity +++ fl-tty nil ; put .s on tty +++ fl-comments nil ; put in comments +++ fl-profile nil ; profiling +++ fl-tran t ; use transfer tables +++ fl-vms nil ; vms hacks +++ fl-xref nil ; xrefs +++ fl-uci nil ; uci lisp compatibility +++ ) +++ +++ (do ((i v-x (cdr i))) ; for each argument +++ ((null i)) +++ (setq tem (aexplodec (car i))) +++ +++ (cond ((eq '- (car tem)) ; if switch +++ (do ((j (cdr tem) (cdr j))) +++ ((null j)) +++ (cond ((eq 'S (car j)) (setq fl-asm nil)) +++ ((eq 'C (car j)) (setq fl-comments t)) +++ ((eq 'm (car j)) (setq fl-macl t)) +++ ((eq 'o (car j)) (setq v-ofile (cadr i) +++ i (cdr i))) +++ ((eq 'w (car j)) (setq fl-warn nil)) +++ ((eq 'q (car j)) (setq fl-verb nil)) +++ ((eq 'T (car j)) (setq fl-tty t)) +++ ((eq 'i (car j)) (setq fl-inter t)) +++ ((eq 'p (car j)) (setq fl-profile t)) +++ ((eq 'F (car j)) (setq fl-tran nil)) +++ ((eq 'v (car j)) (setq fl-vms t)) +++ ((eq 'x (car j)) (setq fl-xref t)) +++ ((eq 'u (car j)) (setq fl-uci t)) +++ (t (comp-gerr "Unknown switch: " +++ (car j)))))) +++ ((null v-root) +++ (setq temr (reverse tem)) +++ (cond ((and (eq 'l (car temr)) +++ (eq '\. (cadr temr))) +++ (setq rootreal nil) +++ (setq v-root (apply 'concat (reverse (cddr temr))))) +++ (t (setq v-root (car i) +++ rootreal t)))) +++ +++ (t (comp-gerr "Extra input file name: " (car i))))) +++ +++ +++ (cond (fl-vms (setq fl-tran nil))) ; no transfer tables in vms +++ +++ ; now see what the arguments have left us +++ +++ (cond ((null v-root) +++ (comp-gerr "No file for input")) +++ ((or (portp +++ (setq vp-ifile +++ (car (errset (infile +++ (setq v-ifile +++ (concat v-root '".l"))) +++ nil)))) +++ (and rootreal +++ (portp +++ (setq vp-ifile +++ (car (errset +++ (infile (setq v-ifile v-root)) +++ nil))))))) +++ (t (comp-gerr "Couldn't open the source file :" +++ (or v-ifile)))) +++ +++ +++ ; determine the name of the .s file +++ ; strategy: if fl-asm is t (only assemble) use (v-root).s +++ ; else use /tmp/(PID).s +++ ; +++ ; direct asm to tty temporarily +++ (setq v-sfile '"tty") +++ (setq vp-sfile nil) +++ (If (null fl-tty) then +++ (cond (fl-asm (setq v-sfile (concat '"/tmp/jkf" +++ (boole 1 65535 +++ (syscall 20)) +++ '".s"))) +++ (t (setq v-sfile (concat v-root '".s")))) +++ +++ (cond ((not (portp (setq vp-sfile +++ (car (errset (outfile v-sfile) +++ nil))))) +++ (comp-gerr "Couldn't open the .s file: " +++ (or v-sfile))))) +++ +++ +++ ; determine the name of the .o file (object file) +++ ; strategy: if we aren't supposed to assemble the .s file +++ ; don't worry about a name +++ ; else if a name is given, use it +++ ; else if use (v-root).o +++ ; if profiling, use .o +++ (cond ((or v-ofile (null fl-asm))) ;ignore +++ ((null fl-profile) (setq v-ofile (concat v-root '".o"))) +++ (t (setq v-ofile (concat v-root ".o")))) +++ +++ ; determine the name of the .x file (xref file) +++ ; strategy: if fl-xref is true, then use (v-root).x +++ ; +++ (cond (fl-xref +++ (cond ((not +++ (portp +++ (setq vp-xfile +++ (car (errset (outfile (setq v-xfile +++ (concat v-root ".x")))))))) +++ (comp-gerr "Can't open the .x file" (or v-xfile)))))) +++ (cond ((checkfatal) (return 1))) +++ +++ (setq readtable (makereadtable nil)) ; use new readtable +++ +++ +++ ; if the macsyma flag is set, change the syntax to the +++ ; maclisp standard syntax. We must be careful that we +++ ; dont clobber any syntax changes made by files preloaded +++ ; into the compiler. +++ +++ (cond (fl-macl (setsyntax '\/ 143) ; 143 = vesc +++ +++ (cond ((equal 143 (status syntax \\)) +++ (setsyntax '\\ 2))) +++ +++ (setsyntax '\| 138) ; 138 = vdq +++ (cond ((equal 198 (status syntax \[)) +++ (setsyntax '\[ 2) +++ (setsyntax '\] 2))) +++ (setq ibase 8.) +++ (sstatus uctolc t) +++ +++ (d-makespec 'ibase) ; to be special +++ (d-makespec 'base) +++ (d-makespec 'tty) +++ +++ (errset (cond ((null (getd 'macsyma-env)) +++ (fasl '/usr/lib/lisp/machacks))) +++ nil)) +++ (fl-uci (load "/usr/lib/lisp/ucifnc") +++ (cvttoucilisp))) +++ +++ (cond (fl-inter (putprop '* 'cc-ignore 'fl-exprcc) ;comment +++ (remprop '* 'fl-expr) +++ )) +++ +++ (cond ((checkfatal) (return 1))) ; leave if fatal errors +++ +++ (comp-note "Compilation begins with " compiler-name) +++ (comp-note "source: " v-ifile ", result: " +++ (cond (fl-asm v-ofile) (t v-sfile))) +++ (setq piport vp-ifile) ; set to standard input +++ (setq liszt-root-name v-root +++ liszt-file-name v-ifile) +++ +++ +++ (If fl-profile then (e-write1 '".globl mcount")) +++ loop +++ +++ (cond ((atom (errset ; list for debugging, +++ ; errset for production. +++ (do ((i (read piport '<>) +++ (read piport '<>))) +++ ((eq i '<>) nil) +++ (catch (liszt-form i) Comp-error)))) +++ (comp-note "Lisp error during compilation") +++ (setq piport nil) +++ (setq er-fatal (1+ er-fatal)) +++ (return 1))) +++ +++ (close piport) +++ +++ (cond ((checkfatal) (return 1))) +++ +++ ; if doing special character stuff (maclisp) reassert +++ ; the state +++ +++ (cond (vps-include +++ (comp-note " done include") +++ (setq piport (car vps-include)) +++ (setq vps-include (cdr vps-include)) +++ (go loop))) +++ +++ (cond (liszt-eof-forms +++ (do ((ll liszt-eof-forms (cdr ll))) +++ ((null ll)) +++ (cond ((atom (errset (liszt-form (car ll)))) +++ (comp-note "Lisp error during eof forms") +++ (setq piport nil) +++ (return 1)))))) +++ +++ ; reset input base +++ (setq ibase 10.) +++ (setq readtable (makereadtable t)) +++ (d-bindtab) +++ +++ +++ (close vp-sfile) ; close assembler language file +++ (comp-note "Compilation complete") +++ +++ (setq tem (Divide (difference (syscall 13) starttime) 60)) +++ (comp-note " Real time: " (car tem) " minutes, " +++ (cadr tem) " seconds") +++ (setq tem (ptime)) +++ (setq temr (Divide (difference (car tem) (car startptime)) +++ 3600)) +++ (comp-note " CPU time: " (car temr) " minutes, " +++ (quotient (cadr temr) 60.0) " seconds") +++ (setq temr (Divide (difference (cadr tem) (cadr startptime)) +++ 3600)) +++ (comp-note " of which " (car temr) " minutes and " +++ (quotient (cadr temr) 60.0) +++ " seconds were for the " +++ (difference $gccount$ startgccount) +++ " gcs which were done") +++ +++ (cond (fl-xref +++ (comp-note "Cross reference being generated") +++ (print (list 'File v-ifile) vp-xfile) +++ (terpr vp-xfile) +++ (do ((ii g-allf (cdr ii))) +++ ((null ii)) +++ (print (car ii) vp-xfile) +++ (terpr vp-xfile)) +++ (close vp-xfile))) +++ +++ +++ ; the assember we use must generate the new a.out format +++ ; with a string table. We will assume that the assembler +++ ; is in /usr/lib/lisp/as so that other sites can run +++ ; the new assembler without installing the new assembler +++ ; as /bin/as +++ (cond (fl-asm ; assemble file +++ (comp-note "Assembly begins") +++ (cond ((not +++ (zerop +++ (setq tmp +++ (apply 'process +++ (ncons (concat +++ "/usr/lib/lisp/as -o " +++ v-ofile +++ '" " +++ v-sfile)))))) +++ (comp-gerr "Assembler detected error, code: " +++ tmp) +++ (comp-note "Assembler temp file " v-sfile +++ " is not unlinked")) +++ (t (comp-note "Assembly completed successfully") +++ (syscall 10 v-sfile))))) ; unlink tmp file +++ +++ (setq readtable original-readtable) +++ #+monitoring +++ (errset (progn (monitor) ; turn off monitoring +++ (print 'monitor-off)) +++ nil) +++ (return 0)))) +++ +++(def checkfatal +++ (lambda nil +++ (cond ((greaterp er-fatal 0) +++ (comp-note "Compilation aborted") +++ t)))) +++ +++;--- liszt-form - i : form to compile +++; This compiles one form. +++; +++(def liszt-form +++ (lambda (i) +++ (prog (tmp v-x) +++ ; macro expand +++ loop +++ (If (and (dtpr i) (eq 'macro (d-functyp (car i)))) +++ then (setq i (apply (car i) i)) +++ (go loop)) +++ ; now look at what is left +++ (cond ((eq (car i) 'def) ; jkf mod +++ (cond (fl-verb (print (cadr i)) (terpr)(drain))) +++ (d-dodef i)) +++ ((eq (car i) 'declare) (funcall 'complr-declare (cdr i))) +++ ((eq (car i) 'eval-when) (doevalwhen i)) +++ ((and (eq (car i) 'progn) (equal (cadr i) '(quote compile))) +++ ((lambda (internal-macros) ; compile macros too +++ (mapc 'liszt-form (cddr i))) +++ t)) +++ ((or (and (eq (car i) 'includef) (setq tmp (eval (cadr i)))) +++ (and (eq (car i) 'include ) (setq tmp (cadr i)))) +++ (cond ((or (portp (setq v-x +++ (car (errset (infile tmp) nil)))) +++ (portp (setq v-x +++ (car (errset (infile (concat '"/usr/lib/lisp" +++ tmp)) +++ nil)))) +++ (portp (setq v-x +++ (car (errset (infile (concat tmp +++ '".l")) +++ nil))))) +++ (setq vps-include (cons piport vps-include)) +++ (setq piport v-x) +++ (comp-note " INCLUDEing file: " tmp)) +++ (t (comp-gerr "Cannot open include file: " tmp)))) +++ ((eq (car i) 'comment) nil) ; just ignore comments +++ (t (Push g-funcs `(eval ,i))))))) +++ +++;--- d-dodef :: handle the def form +++; - form : a def form: (def name (type args . body)) +++; +++(defun d-dodef (form) +++ (prog nil +++ +++ loop +++ +++ (let ( ((g-fname (g-ftype g-args . body)) (cdr form)) +++ (lambdaform (caddr form)) +++ (symlab (gensym 'F))) +++ (If (or (memq '&rest g-args) +++ (memq '&optional g-args) +++ (memq '&aux g-args)) +++ then (setq form +++ `(def ,(cadr form) ,(lambdacvt (cdr lambdaform)))) +++ (go loop)) +++ (If (null (atom g-fname)) +++ then (comp-err "bad function name") +++ else (setq g-flocal (get g-fname g-localf)) +++ (If (eq g-ftype 'macro) +++ then (eval form) +++ (If (and (null macros) +++ (null internal-macros)) +++ then (comp-note " macro will not be compiled") +++ (return nil)) +++ (Push g-funcs `(macro ,symlab ,g-fname)) +++ elseif g-flocal +++ then (If (null (or (eq g-ftype 'lambda) +++ (eq g-ftype 'nlambda))) +++ then (comp-err "bad type for fcn" (or g-ftype))) +++ elseif (or (eq g-ftype 'lambda) +++ (eq g-ftype 'lexpr)) +++ then (Push g-funcs `(lambda ,symlab ,g-fname)) +++ elseif (eq g-ftype 'nlambda) +++ then (Push g-funcs `(nlambda ,symlab ,g-fname)) +++ else (comp-err " bad function type " g-ftype))) +++ (setq g-skipcode nil) ;make sure we aren't skipping code +++ (forcecomment `(fcn ,g-ftype ,g-fname)) +++ (If g-flocal +++ then (comp-note "is a local function") +++ (e-writel (car g-flocal)) +++ else +++ (If (null fl-vms) then (e-write2 '".globl" symlab)) +++ (e-writel symlab)) +++ (setq g-locs nil g-loccnt 0 g-labs nil g-loc 'reg g-cc nil +++ g-ret t g-topsym (d-genlab)) +++ (If fl-xref then (setq g-refseen (gensym) g-reflst nil)) +++ (d-clearreg) +++ (Push g-locs (cons 'lambda 0)) +++ (setq g-currentargs (length g-args)) +++ (mapc '(lambda (x) (Push g-locs nil) (incr g-loccnt)) +++ g-args) +++ (d-prelude) ; do beginning stuff +++ (d-lambbody lambdaform) ; emit code +++ (d-fini) +++ (If fl-xref then +++ (Push g-allf +++ (cons g-fname +++ (cons (cond (g-flocal (cons g-ftype 'local)) +++ (t g-ftype)) +++ g-reflst))))))) +++ +++ +++;--- d-prelude :: emit code common to beginning of all functions +++; +++(defun d-prelude nil +++ (If g-flocal +++ then (e-write3 'movl 'r10 '"-(sp)") ; (faster than pushl) +++ (e-write3 'movab `(,(* -4 g-currentargs) r6) 'r10) +++ (e-writel g-topsym) +++ else +++ (e-write2 '".word" '0x5c0) +++ (If fl-profile +++ then (e-write3 'movab 'mcounts 'r0) +++ (e-write2 'jsb 'mcount)) +++ (e-write3 'movab 'linker '#.bind-reg) +++ (If (eq g-ftype 'lexpr) +++ then +++ (e-write4 'subl3 '$4 Lbot-reg '"-(sp)") ; set up base for (arg) +++ (e-writel g-topsym) +++ (e-write3 'movl Np-reg oLbot-reg) ; will stack num of args +++ (e-write4 'subl3 Lbot-reg Np-reg 'r0) ; arg cnt again +++ (e-write3 'movab '"0x1400(r0)" np-plus) ; stack lispval +++ (e-write3 'movl '(0 #.oLbot-reg) '"-(sp)") ; also on runtime stk +++ else +++ ; set up old lbot register, base register for variable +++ ; references +++ (e-write3 'movl '#.Lbot-reg '#.oLbot-reg) +++ ; make sure the np register points where it should since +++ ; the caller might have given too few or too many args +++ (e-write3 'movab `(,(* 4 g-currentargs) #.oLbot-reg) +++ '#.Np-reg) +++ (e-writel g-topsym)))) +++ +++;--- d-fini :: emit code at end of function +++ +++(defun d-fini nil +++ (If g-flocal then (e-write3 'movl '"(sp)+" 'r10) +++ (e-write1 'rsb) +++ else (e-return))) +++ +++ +++;--- d-bindtab :: emit binder table when all functions compiled +++; +++(defun d-bindtab nil +++ (setq g-skipcode nil) ; make sure this isnt ignored +++ (e-writel "bind_org") +++ (e-write2 ".set linker_size," (length g-lits)) +++ (e-write2 ".set trans_size," (length g-tran)) +++ (do ((ll (setq g-funcs (nreverse g-funcs)) (cdr ll))) +++ ((null ll)) +++ (If (memq (caar ll) '(lambda nlambda macro eval)) +++ then (e-write2 '".long" (cdr (assoc (caar ll) +++ '((lambda . 0) +++ (nlambda . 1) +++ (macro . 2) +++ (eval . 99))))) +++ else (comp-err " bad type in lit list " (car ll)))) +++ +++ (e-write1 ".long -1") +++ (e-write1 '"lit_org:") +++ (d-asciiout (nreverse g-lits)) +++ (If g-tran then (d-asciiout (nreverse g-tran))) +++ (d-asciiout (mapcar '(lambda (x) (If (eq (car x) 'eval) +++ then (cadr x) +++ else (caddr x))) +++ g-funcs)) +++ +++ (e-write1 '"lit_end:")) +++ +++;--- d-asciiout :: print a list of asciz strings +++; +++(defun d-asciiout (args) +++ (do ((lits args (cdr lits)) +++ (form)) +++ ((null lits)) +++ (setq form (explode (car lits)) +++ formsiz (length form)) +++ (do ((remsiz formsiz) +++ (curform form) +++ (thissiz)) +++ ((zerop remsiz)) +++ (If (greaterp remsiz 60) then (sfilewrite '".ascii \"") +++ else (sfilewrite '".asciz \"")) +++ (setq thissiz (min 60 remsiz)) +++ (do ((count thissiz (1- count))) +++ ((zerop count) +++ (sfilewrite (concat '\" (ascii 10))) +++ (setq remsiz (difference remsiz thissiz))) +++ (If (eq ch-newline (car curform)) +++ then (sfilewrite '\\012) +++ else (If (or (eq '\\ (car curform)) +++ (eq '\" (car curform))) +++ then (sfilewrite '\\)) +++ (sfilewrite (car curform))) +++ (setq curform (cdr curform)))))) +++ +++;--- doevalwhen, process evalwhen directive. This is inadequate. +++; +++(def doevalwhen +++ (lambda (v-f) +++ (prog (docom dolod) +++ (setq docom (memq 'compile (cadr v-f)) +++ +++ dolod (memq 'load (cadr v-f))) +++ (mapc '(lambda (frm) (cond (docom (eval frm))) +++ (cond (dolod +++ ((lambda (internal-macros) +++ (liszt-form frm)) +++ t)))) +++ (cddr v-f))))) +++ +++ +++;---- dodcl - forms declare form +++; process the declare form given. We evaluate each arg +++; +++(defun complr-declare fexpr (forms) +++ (do ((i forms (cdr i))) +++ ((null i)) +++ (cond ((and (atom (caar i)) +++ (getd (caar i))) +++ (eval (car i))) ; if this is a function +++ (t (comp-warn "Unknown declare attribute: " (car i)))))) +++ +++;---> handlers for declare forms +++; +++(def *fexpr +++ (nlambda (args) +++ (mapc '(lambda (v-a) +++ (putprop v-a 'nlambda g-functype)) +++ args))) +++ +++(def nlambda +++ (nlambda (args) +++ (mapc '(lambda (v-a) +++ (putprop v-a 'nlambda g-functype)) +++ args))) +++ +++(def special +++ (nlambda (v-l) +++ (mapc '(lambda (v-a) +++ (putprop v-a t g-spec) ) +++ v-l) +++ t)) +++(def unspecial +++ (nlambda (v-l) +++ (mapc '(lambda (v-a) +++ (putprop v-a nil g-spec)) +++ v-l) +++ t)) +++ +++(def *expr +++ (nlambda (args) +++ (mapc +++ '(lambda (v-a) +++ (cond ((atom v-a) (putprop v-a 'lambda g-functype)) +++ (t (comp-warn "Bad declare form " v-a +++ " in list " args)))) +++ args) +++ t)) +++ +++(def *lexpr +++ (nlambda (args) +++ (mapc '(lambda (v-a) +++ (putprop v-a 'lexpr g-functype)) +++ args) +++ t)) ; ignore +++ +++(def fixnum +++ (nlambda (args) +++ nil)) ; ignore +++ +++(def flonum +++ (nlambda (args) +++ nil)) ; ignore +++ +++(def macros +++ (nlambda (args) (setq macros (car args)))) +++ +++(def localf +++ (nlambda (args) (mapc '(lambda (ar) +++ (If (null (get ar g-localf)) +++ then (putprop ar +++ (cons (d-genlab) -1) +++ g-localf))) +++ args))) +++;---> end declare form handlers +++ +++ +++ +++ +++ +++ +++ +++ +++ +++;--- lambdacvt +++; converts a lambda expression with &optional, &rest and &aux forms in +++; the argument list into a lexpr which will do the desired function. +++; method of operation +++; the argument list is examined and the following lists are made: +++; vbs - list of variables to be lambda bound +++; opl - list of optional forms +++; vals - list of values to be assigned to the vbs +++; +++(def lambdacvt +++ (lambda (exp) +++ (prog (arg vbs vals opl rest opflg restflg narg narg2 narg3 auxflg +++ avbs) +++ (do ((ll (car exp) (cdr ll)) +++ (count 1 (1+ count))) +++ ((null ll)) +++ (cond ((eq '&rest (car ll)) +++ (setq restflg t opflg nil count (1- count))) +++ ((eq '&optional (car ll)) +++ (setq opflg t count (1- count))) +++ ((eq '&aux (car ll)) +++ (setq auxflg t +++ opflg nil +++ restflg nil +++ count (1- count))) +++ (opflg +++ (cond ((atom (setq arg (car ll))) +++ (setq opl (cons (cons (ncons arg) count) opl) +++ vbs (cons arg vbs) +++ vals (cons nil vals))) +++ ((cddr arg) +++ (setq vbs (cons (car arg) +++ (cons (caddr arg) +++ vbs)) +++ vals (cons nil +++ (cons nil vals)) +++ opl (cons (cons arg count) opl))) +++ (t (setq vbs (cons (car arg) vbs) +++ vals (cons nil vals) +++ opl (cons (cons arg count) opl))))) +++ (restflg +++ (setq vbs (cons (car ll) vbs) +++ vals (cons nil vals) +++ rest (cons (car ll) count))) +++ (auxflg +++ (setq count (1- count)) +++ (cond ((atom (setq arg (car ll))) +++ (setq avbs (cons (ncons arg) avbs))) +++ (t (setq avbs (cons arg avbs))))) +++ (t (setq vbs (cons (car ll) vbs) +++ vals (cons `(arg ,count) vals))))) +++ (setq narg (gensym)) +++ +++ (return +++ `(lexpr (,narg) +++ ((lambda ,(nreverse vbs) +++ ,@(mapcar +++ '(lambda (arg) +++ `(cond ((greaterp ,(cdr arg) +++ ,narg) +++ ,@(cond ((cadar arg) +++ `((setq ,(caar arg) +++ ,(cadar arg)))))) +++ (t (setq ,(caar arg) (arg ,(cdr arg))) +++ ,@(cond ((cddar arg) +++ `((setq ,(caddar arg) +++ t))))))) +++ (nreverse opl)) +++ ,@(cond (rest (setq narg2 (gensym) +++ narg3 (gensym)) +++ `((do ((,narg2 ,narg (1- ,narg2)) +++ (,narg3 nil (cons (arg ,narg2) +++ ,narg3))) +++ ((lessp ,narg2 ,(cdr rest)) +++ (setq ,(car rest) ,narg3)))))) +++ ,@(cond (auxflg `((let* ,(nreverse avbs) +++ ,@(cdr exp)))) +++ (t (cdr exp)))) +++ ,@(nreverse vals))))))) +++ +++; this routine is copied from ccb.l so we can make it a local function +++; in both files +++ +++;--- d-genlab :: generate a pseudo label +++; +++(defun d-genlab nil +++ (gensym 'L)) +++ diff --cc usr/src/cmd/liszt/caspecs.l index 0000000000,0000000000,0000000000..37b78ed999 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/liszt/caspecs.l @@@@ -1,0 -1,0 -1,0 +1,61 @@@@ +++ +++;------ special variables -------- +++ +++ +++ +++;sccs id: @(#)caspecs.l 5.3 10/22/80 +++ +++; Copyright (c) 1980 , The Regents of the University of California. +++; All rights reserved. +++; author: j. foderaro +++ +++(declare (special v-form g-loc g-cc g-locs g-loccnt g-labs g-args +++ g-ret g-skipcode g-dropnpcnt +++ g-bindloc fl-comments g-tran g-trancnt g-tranloc +++ g-topsym g-reguse g-ignorereg +++ fl-inter fl-xref +++ g-lits g-litcnt g-funcs g-spec Np-reg +++ Lbot-reg bind-reg np-plus bNp-reg +++ oLbot-reg Bnp-val ch-newline +++ compiler-name internal-macros +++ old-top-level poport piport compiler-name +++ readtable original-readtable er-fatal ibase +++ fl-macl fl-tty g-functype g-spec g-litcnt +++ g-trueloc g-lits g-funcs g-fname g-comments +++ g-localf g-flocal g-ftype +++ twa-list old-declare-fcn vps-include fl-verb +++ user-top-level $gccount$ macros g-current +++ fl-profile fl-tran +++ g-allf fl-vms vp-xfile v-xfile +++ vms-pointers g-refseen g-reflst fl-warn +++ g-currentargs +++ $gc-count$ +++ special +++ liszt-eof-forms +++ liszt-root-name +++ liszt-file-name +++ k-ftype vp-sfile formsiz) +++ ;local functions in car.l +++ (localf lcfform dodef d-prelude d-fini d-bindtab +++ d-asciiout +++ doevalwhen lambdacvt) +++ ;local functions for cadr and cddr must be calculated +++ ) +++ +++ +++;--- parameters: these must be evaluated at compile time so readmacros will +++; work +++ +++(eval-when (compile load eval) +++ (setq Np-reg 'r6 +++ Lbot-reg 'r7 +++ bind-reg 'r8 +++ np-plus '(+ r6) +++ bNp-reg 'r5 +++ oLbot-reg 'r10 +++ ch-newline (ascii #\lf))) +++ +++(eval-when (compile load eval) +++ (setq Bnp-val '_bnp)) +++ +++ diff --cc usr/src/cmd/liszt/cddr.l index 0000000000,0000000000,0000000000..83cd6a18ce new file mode 100644 --- /dev/null +++ b/usr/src/cmd/liszt/cddr.l @@@@ -1,0 -1,0 -1,0 +1,1195 @@@@ +++(include "caspecs.l") +++(eval-when (compile) +++ (fasl 'camacs)) +++ +++(setq sectioncddrid "@(#)cddr.l 5.4 11/11/80") ; id for SCCS +++ +++; cc-not :: compile a "not" or "null" expression = cc-not = +++; +++(defun cc-not nil +++ (makecomment '(beginning not)) +++ (If (null g-loc) +++ then (let ((g-cc (cons (cdr g-cc) (car g-cc))) +++ (g-ret nil)) +++ (d-exp (cadr v-form))) +++ else (let ((finlab (d-genlab)) +++ (finlab2 (d-genlab)) +++ (g-ret nil)) +++ ; eval arg and jump to finlab if nil +++ (let ((g-cc (cons finlab nil)) +++ g-loc) +++ (d-exp (cadr v-form))) +++ ; didn't jump, answer must be t +++ (d-move 'T g-loc) +++ (If (car g-cc) then (e-goto (car g-cc)) +++ else (e-goto finlab2)) +++ (e-label finlab) +++ ; answer is nil +++ (d-move 'Nil g-loc) +++ (If (cdr g-cc) then (e-goto (cdr g-cc))) +++ (e-label finlab2)))) +++ +++ +++;--- cc-numberp :: check for numberness = cc-numberp = +++; +++(defun cc-numberp nil +++ (d-typecmplx (cadr v-form) +++ '#.(concat '$ (plus 1_2 1_4 1_9)))) +++ +++ +++;--- cc-or :: compile an "or" expression = cc-or = +++; +++(defun cc-or nil +++ (let ((finlab (d-genlab)) +++ (finlab2) +++ (exps (If (cdr v-form) thenret else '(nil)))) ; (or) => nil +++ (If (null (car g-cc)) +++ then (d-exp (do ((g-cc (cons finlab nil)) +++ (g-loc (If g-loc then 'reg)) +++ (g-ret nil) +++ (ll exps (cdr ll))) +++ ((null (cdr ll)) (car ll)) +++ (d-exp (car ll)))) +++ (If g-loc then (setq finlab2 (d-genlab)) +++ (e-goto finlab2) +++ (e-label finlab) +++ (d-move 'reg g-loc) +++ (e-label finlab2) +++ else (e-label finlab)) +++ else (If (null g-loc) then (setq finlab (car g-cc))) +++ (d-exp (do ((g-cc (cons finlab nil)) +++ (g-loc (If g-loc then 'reg)) +++ (g-ret nil) +++ (ll exps (cdr ll))) +++ ((null (cdr ll)) (car ll)) +++ (d-exp (car ll)))) +++ (If g-loc then (setq finlab2 (d-genlab)) +++ (e-goto finlab2) +++ (e-label finlab) +++ (d-move 'reg g-loc) +++ (e-goto (car g-cc)) ; result is t +++ (e-label finlab2))) +++ (d-clearreg))) ; we are not sure of the state due to possible branches. +++ +++ +++;--- c-prog :: compile a "prog" expression = c-prog = +++; +++; for interlisp compatibility, we allow the formal variable list to +++; contain objects of this form (vrbl init) which gives the initial value +++; for that variable (instead of nil) +++; +++(defun c-prog nil +++ (let (g-loc g-cc seeninit initf ((spcs locs initsv . initsn) +++ (d-classify (cadr v-form))) +++ (p-rettrue g-ret) (g-ret nil)) +++ +++ (e-pushnil (length locs)) ; locals initially nil +++ (d-bindprg spcs locs) ; bind locs and specs +++ +++ (cond (initsv (d-pushargs initsv) +++ (mapc '(lambda (x) +++ (d-move 'unstack (d-loc x)) +++ (decr g-loccnt) +++ (unpush g-locs)) +++ (nreverse initsn)))) +++ +++ ; determine all possible labels +++ (do ((ll (cddr v-form) (cdr ll)) +++ (labs nil)) +++ ((null ll) (setq g-labs `((,(d-genlab) ,@labs) +++ ,@g-labs))) +++ (If (and (car ll) (symbolp (car ll))) +++ then (If (assq (car ll) labs) +++ then (comp-err "label is mulitiply defined " (car ll)) +++ else (setq labs (cons (cons (car ll) (d-genlab)) +++ labs))))) +++ +++ ; compile each form which is not a label +++ (d-clearreg) ; unknown state after binding +++ (do ((ll (cddr v-form) (cdr ll))) +++ ((null ll)) +++ (If (or (null (car ll)) (not (symbolp (car ll)))) +++ then (d-exp (car ll)) +++ else (e-label (cdr (assq (car ll) (cdar g-labs)))) +++ (d-clearreg)))) ; dont know state after label +++ +++ ; result is nil if fall out and care about value +++ (If (or g-cc g-loc) then (d-move 'Nil 'reg)) +++ +++ (e-label (caar g-labs)) ; return to label +++ (setq g-labs (cdr g-labs)) +++ (d-unbind)) ; unbind our frame +++ +++ +++;--- d-bindprg :: do binding for a prog expression +++; - spcs : list of special variables +++; - locs : list of local variables +++; - specinit : init values for specs (or nil if all are nil) +++; +++(defun d-bindprg (spcs locs) +++ +++ +++ ; place the local vrbls and prog frame entry on the stack +++ (setq g-loccnt (+ g-loccnt (length locs)) +++ g-locs (nconc locs `((prog . ,(length spcs)) ,@g-locs))) +++ +++ ; now bind the specials, if any, to nil +++ (If spcs then (e-setupbind) +++ (mapc '(lambda (vrb) +++ (e-shallowbind vrb 'Nil)) +++ spcs) +++ (e-unsetupbind))) +++ +++;--- d-unbind :: remove one frame from g-locs +++; +++(defun d-unbind nil +++ (do ((count 0 (1+ count))) +++ ((dtpr (car g-locs)) +++ (If (not (zerop (cdar g-locs))) +++ then (e-unshallowbind (cdar g-locs))) +++ (cond ((not (zerop count)) +++ (e-dropnp count) +++ +++ (setq g-loccnt (- g-loccnt count)))) +++ (setq g-locs (cdr g-locs))) +++ (setq g-locs (cdr g-locs)))) +++ +++ +++;--- d-classify :: seperate variable list into special and non-special +++; - lst : list of variables +++; returns ( xxx yyy zzz . aaa) +++; where xxx is the list of special variables and +++; yyy is the list of local variables +++; zzz are the non nil initial values for prog variables +++; aaa are the names corresponding to the values in zzz +++; +++(defun d-classify (lst) +++ (do ((ll lst (cdr ll)) +++ (locs) (spcs) (init) (initsv) (initsn) +++ (name)) +++ ((null ll) (cons spcs (cons locs (cons initsv initsn)))) +++ (If (atom (car ll)) then (setq name (car ll)) +++ else (setq name (caar ll)) +++ (Push initsn name) +++ (Push initsv (cadar ll))) +++ (If (d-specialp name) +++ then (Push spcs name) +++ else (Push locs name)))) +++ +++; cm-progn :: compile a "progn" expression = cm-progn = +++; +++(defun cm-progn nil +++ `((lambda nil ,@(cdr v-form)))) +++ +++ +++; cm-prog1 :: compile a "prog1" expression = cm-prog1 = +++; +++(defun cm-prog1 nil +++ (let ((gl (d-genlab))) +++ `((lambda (,gl) +++ ,@(cddr v-form) +++ ,gl) +++ ,(cadr v-form)))) +++ +++ +++; cm-prog2 :: compile a "prog2" expression = cm-prog2 = +++; +++(defun cm-prog2 nil +++ (let ((gl (d-genlab))) +++ `((lambda (,gl) ,(cadr v-form) +++ (setq ,gl ,(caddr v-form)) +++ ,@(cdddr v-form) +++ ,gl) +++ nil))) +++ +++ +++;--- cc-quote : compile a "quote" expression = cc-quote = +++; +++; if we are just looking to set the ; cc, we just make sure +++; we set the cc depending on whether the expression quoted is +++; nil or not. +++(defun cc-quote nil +++ (let ((arg (cadr v-form)) +++ argloc) +++ +++ (If (null g-loc) +++ then (If (and (null arg) (cdr g-cc) +++ then (e-goto (cdr g-cc)) +++ elseif (and arg (car g-cc)) +++ then (e-goto (car g-cc))) +++ elseif (null g-cc) +++ then (comp-warn "losing the value of this expression " (or v-form))) +++ else (d-move (d-loclit arg nil) g-loc) +++ (d-handlecc)))) +++ +++ +++;--- d-loc :: return the location of the variable or value in IADR form +++; - form : form whose value we are to locate +++; +++; if we are given a xxx as form, we check yyy; +++; xxx yyy +++; -------- --------- +++; nil Nil is always returned +++; symbol return the location of the symbols value, first looking +++; in the registers, then on the stack, then the bind list. +++; If g-ingorereg is t then we don't check the registers. +++; We would want to do this if we were interested in storing +++; something in the symbol's value location. +++; number always return the location of the number on the bind +++; list (as a (lbind n)) +++; other always return the location of the other on the bind +++; list (as a (lbind n)) +++; +++(defun d-loc (form) +++ (If (null form) then 'Nil +++ elseif (numberp form) then +++ (If (and (fixp form) (greaterp form -1025) (lessp form 1024)) +++ then `(fixnum ,form) ; small fixnum +++ else (d-loclit form nil)) +++ elseif (symbolp form) +++ then (If (and (null g-ignorereg) (car (d-bestreg form nil))) thenret +++ else (If (d-specialp form) then (d-loclit form t) +++ else +++ (do ((ll g-locs (cdr ll)) ; check stack +++ (n g-loccnt)) +++ ((null ll) +++ (comp-warn (or form) " declared special by compiler") +++ (d-makespec form) +++ (d-loclit form t)) +++ (If (atom (car ll)) +++ then (If (eq form (car ll)) +++ then (return `(stack ,n)) +++ else (setq n (1- n))))))) +++ else (d-loclit form nil))) +++ +++ +++;--- d-loclit :: locate or add litteral to bind list +++; - form : form to check for and add if not present +++; - flag : if t then if we are given a symbol, return the location of +++; its value, else return the location of the symbol itself +++; +++; scheme: we share the locations of atom (symbols,numbers,string) but always +++; create a fresh copy of anything else. +++(defun d-loclit (form flag) +++ (prog (loc onplist symboltype) +++ (If (null form) +++ then (return 'Nil) +++ elseif (symbolp form) +++ then (setq symboltype t) +++ (cond ((setq loc (get form g-bindloc)) +++ (setq onplist t))) +++ elseif (atom form) +++ then (do ((ll g-lits (cdr ll)) ; search for atom on list +++ (n g-litcnt (1- n))) +++ ((null ll)) +++ (If (eq form (car ll)) +++ then (setq loc n) ; found it +++ (return)))) ; leave do +++ (If (null loc) +++ then (Push g-lits form) +++ (setq g-litcnt (1+ g-litcnt) +++ loc g-litcnt) +++ (cond ((and symboltype (null onplist)) +++ (putprop form loc g-bindloc)))) +++ +++ (return (If (and flag symboltype) then `(bind ,loc) +++ else `(lbind ,loc))))) +++ +++ +++ +++;--- d-locv :: find the location of a value cell, and dont return a register +++; +++(defun d-locv (sm) +++ (let ((g-ignorereg t)) +++ (d-loc sm))) +++ +++ +++;--- c-setarg :: set a lexpr's arg = cc-setarg = +++; form is (setarg index value) +++; +++(defun c-setarg nil +++ (If (not (eq 'lexpr g-ftype)) +++ then (comp-err "setarg only allowed in lexprs")) +++ (If (and fl-inter (eq (length (cdr v-form)) 3)) ; interlisp setarg +++ then (If (not (eq (cadr v-form) (car g-args))) +++ then (comp-err "setarg: can only compile local setargs " v-form) +++ else (setq v-form (cdr v-form)))) +++ (d-pushargs (list (cadr v-form))) ; stack index +++ (let ((g-loc 'reg) +++ (g-cc nil) +++ (g-ret nil)) +++ (d-exp (caddr v-form))) +++ (d-clearreg 'r1) ; indicate we are clobbering r1 +++ (e-write3 'movl `(* -4 #.Np-reg) 'r1) ; actual number to r1 +++ (e-write3 'movl 'r0 "*-4(fp)[r1]") ; store value in +++ (e-pop 1) +++ (unpush g-locs) +++ (decr g-loccnt)) +++ +++;--- cc-stringp :: check for string ness = cc-stringp = +++; +++(defun cc-stringp nil +++ (d-typesimp (cadr v-form) '$0)) +++ +++ +++;--- cc-symbolp :: check for symbolness = cc-symbolp = +++; +++(defun cc-symbolp nil +++ (d-typesimp (cadr v-form) '$1)) +++ +++ +++ +++;--- c-return :: compile a "return" statement = c-return = +++; +++(defun c-return nil +++ ; value is always put in r0 +++ (let ((g-loc 'reg) +++ g-cc +++ g-ret) +++ (d-exp (cadr v-form))) +++ +++ ; if we are doing a non local return, compute number of specials to unbind +++ ; and locals to pop +++ (If (car g-labs) then (e-goto (caar g-labs)) +++ else (do ((loccnt 0) +++ (speccnt 0) +++ (ll g-labs (cdr ll)) +++ (locs g-locs)) +++ ((null ll) (comp-err "return used not within a prog or do")) +++ (If (car ll) then (comp-warn " non local return used ") +++ ; unbind down to but not including +++ ; this frame. +++ (If (greaterp loccnt 0) +++ then (e-pop loccnt)) +++ (If (greaterp speccnt 0) +++ then (e-unshallowbind speccnt)) +++ (e-goto (caar ll)) +++ (return) +++ else ; determine number of locals and special on +++ ; stack for this frame, add to running +++ ; totals +++ (do () +++ ((dtpr (car locs)) +++ (setq speccnt (+ speccnt (cdar locs)) +++ locs (cdr locs))) +++ (incr loccnt) +++ (setq locs (cdr locs))))))) +++ +++ +++; c-rplaca :: compile a "rplaca" expression = c-rplaca = +++; +++(defun c-rplaca nil +++ (let ((ssimp (d-simple (caddr v-form))) +++ (g-ret nil)) +++ (let ((g-loc (If ssimp then 'reg else 'stack)) +++ (g-cc nil)) +++ (d-exp (cadr v-form))) +++ (If (null ssimp) then (Push g-locs nil) +++ (incr g-loccnt) +++ (let ((g-loc 'r1) +++ (g-cc nil)) +++ (d-exp (caddr v-form))) +++ (d-move 'unstack 'reg) +++ (unpush g-locs) +++ (decr g-loccnt) +++ (e-move 'r1 '(4 r0)) +++ else (e-move (e-cvt ssimp) '(4 r0))) +++ (d-clearreg))) ; cant tell what we are clobbering +++ +++ +++; c-rplacd :: compile a "rplacd" expression = c-rplacd = +++; +++(defun c-rplacd nil +++ (let ((ssimp (d-simple (caddr v-form))) +++ (g-ret nil)) +++ (let ((g-loc (If ssimp then 'reg else 'stack)) +++ (g-cc nil)) +++ (d-exp (cadr v-form))) +++ (If (null ssimp) then (Push g-locs nil) +++ (incr g-loccnt) +++ (let ((g-loc 'r1) +++ (g-cc nil)) +++ (d-exp (caddr v-form))) +++ (d-move 'unstack 'reg) +++ (unpush g-locs) +++ (decr g-loccnt) +++ (e-move 'r1 '(0 r0)) +++ else (e-move (e-cvt ssimp) '(0 r0))) +++ (d-clearreg))) +++ +++; c-set :: compile a "set" expression = c-set = +++ +++ +++;--- cc-setq :: compile a "setq" expression = c-setq = +++; +++(defun cc-setq nil +++ (let (tmp) +++ (If (oddp (length (cdr v-form))) +++ then (comp-err "wrong number of args to setq " +++ (or v-form)) +++ elseif (cdddr v-form) ; if multiple setq's +++ then (do ((ll (cdr v-form) (cddr ll)) +++ (g-loc) +++ (g-cc nil)) +++ ((null (cddr ll)) (setq tmp ll)) +++ (setq g-loc (d-locv (car ll))) +++ (d-exp (cadr ll)) +++ (d-clearuse (car ll))) +++ else (setq tmp (cdr v-form))) +++ +++ ; do final setq +++ (let ((g-loc (d-locv (car tmp))) +++ (g-cc (If g-loc then nil else g-cc)) +++ (g-ret nil)) +++ (d-exp (cadr tmp)) +++ (d-clearuse (car tmp))) +++ (If g-loc then (d-move (d-locv (car tmp)) g-loc) +++ (If g-cc then (d-handlecc))))) +++ +++ +++ +++; cc-typep :: compile a "typep" expression = cc-typep = +++; +++; this returns the type of the expression, it is always non nil +++; +++(defun cc-typep nil +++ (let ((argloc (d-simple (cadr v-form))) +++ (g-ret)) +++ (If (null argloc) then (let ((g-loc 'reg) g-cc) +++ (d-exp (cadr v-form))) +++ (setq argloc 'reg)) +++ (If g-loc then (e-write4 'ashl '$-9 (e-cvt argloc) 'r0) +++ (e-write3 'cvtbl "_typetable+1[r0]" 'r0) +++ (e-write3 'movl "_tynames+4[r0]" 'r0) +++ (e-write3 'movl "(r0)" (e-cvt g-loc))) +++ (If (car g-cc) then (e-goto (car g-cc))))) +++ +++ +++ +++; cm-symeval :: compile a symeval expression. +++; the symbol cell in franz lisp is just the cdr. +++; +++(defun cm-symeval nil +++ `(cdr ,(cadr v-form))) +++ +++ +++; c-*throw :: compile a "*throw" expression =c-*throw = +++; +++; the form of *throw is (*throw 'tag 'val) . +++; we calculate and stack the value of tag, then calculate val +++; we call Idothrow to do the actual work, and only return if the +++; throw failed. +++; +++(defun c-*throw nil +++ (let ((arg2loc (d-simple (caddr v-form))) +++ g-cc +++ g-ret +++ arg1loc) +++ (If arg2loc then (If (setq arg1loc (d-simple (cadr v-form))) +++ then (e-write2 'pushl (e-cvt arg2loc)) +++ (e-write2 'pushl (e-cvt arg1loc)) +++ else (let ((g-loc 'reg)) +++ (d-exp (cadr v-form)) ; calc tag +++ (e-write2 'pushl (e-cvt arg2loc)) +++ (e-write2 'pushl (e-cvt 'reg)))) +++ else (let ((g-loc 'stack)) +++ (d-exp (cadr v-form)) ; calc tag to stack +++ (Push g-locs nil) +++ (incr g-loccnt) +++ (setq g-loc 'reg) +++ (d-exp (caddr v-form)) ; calc value into r0 +++ (e-write2 'pushl (e-cvt 'reg)) +++ (e-write2 'pushl (e-cvt 'unstack)) +++ (unpush g-locs) +++ (decr g-loccnt))) +++ (e-write3 'calls '$0 '_Idothrow) +++ (e-write2 'clrl '"-(sp)") ; non contuable error +++ (e-write2 'pushab '__erthrow) ; string to print +++ (e-write3 'calls '$2 '_error))) +++ +++ +++ +++;--- cm-zerop :: convert zerop to a quick test = cm-zerop = +++; zerop is only allowed on fixnum and flonum arguments. In both cases, +++; if the value of the first 32 bits is zero, then we have a zero. +++; thus we can define it as a macro: +++(defun cm-zerop nil +++ (cond ((atom (cadr v-form)) +++ `(and (null (cdr ,(cadr v-form))) (not (bigp ,(cadr v-form))))) +++ (t (let ((gnsy (gensym))) +++ `((lambda (,gnsy) +++ (and (null (cdr ,gnsy)) +++ (not (bigp ,gnsy)))) +++ ,(cadr v-form)))))) +++ +++ +++ +++;------- FIXNUM arithmetic section --------- +++; beware all ye who read this section +++; +++ +++ +++ +++(declare (localf d-upordown d-fixop)) +++ +++;--- c-1+ :: fixnum add1 function +++; +++(defun c-1+ nil +++ (d-upordown 'addl3)) +++ +++;--- c-1- :: fixnum sub1 function +++; +++(defun c-1- nil +++ (d-upordown 'subl3)) +++ +++(defun d-upordown (opcode) +++ (let ((arg (cadr v-form)) +++ argloc) +++ (If (setq argloc (d-simple `(cdr ,arg))) +++ then (e-write4 opcode '$1 (e-cvt argloc) 'r5) +++ else (let ((g-loc 'reg) +++ g-ret +++ g-cc) +++ (d-exp arg)) +++ (e-write4 opcode '$1 "(r0)" 'r5)) +++ (e-write2 "jsb" "_qnewint") +++ (d-clearreg))) +++ +++ +++;--- c-+ :: fixnum add = c-+ = +++; +++(defun c-+ nil +++ (d-fixop 'addl3 'plus)) +++ +++(defun c-- nil +++ (d-fixop 'subl3 'difference)) +++ +++(defun c-* nil +++ (d-fixop 'mull3 'times)) +++ +++(defun c-/ nil +++ (d-fixop 'divl3 'quotient)) +++ +++(defun c-\\ nil +++ (d-fixop 'ediv 'remainder)) +++ +++(defun d-fixop (opcode lispopcode) +++ (prog (op1 op2 rop1 rop2 simpleop1) +++ (If (not (eq 3 (length v-form))) ; only handle two ops for now +++ then (d-callbig lispopcode (cdr v-form)) +++ else (setq op1 (cadr v-form) +++ op2 (caddr v-form)) +++ (If (fixp op1) +++ then (setq rop1 (concat '$ op1) ; simple int +++ simpleop1 t) +++ else (If (setq rop1 (d-simple `(cdr ,op1))) +++ then (setq rop1 (e-cvt rop1)) +++ else (let ((g-loc 'reg) g-cc g-ret) +++ (d-exp op1)) +++ (setq rop1 '|(r0)|))) +++ (If (fixp op2) +++ then (setq rop2 (concat '$ op2)) +++ else (If (setq rop2 (d-simple `(cdr ,op2))) +++ then (setq rop2 (e-cvt rop2)) +++ else (e-write3 'movl rop1 "-(sp)") +++ (setq rop1 "(sp)+") +++ (let ((g-loc 'reg) +++ g-cc g-ret) +++ (d-exp op2)) +++ (setq rop2 '|(r0)|))) +++ (If (eq opcode 'ediv) +++ then (If (not simpleop1) then (e-write3 'movl rop1 'r2) ; need quad +++ (e-write4 'ashq '$-32 'r1 'r1) +++ (setq rop1 'r1)) ; word div. +++ (e-write5 'ediv rop2 rop1 'r0 'r5) +++ else (e-write4 opcode rop2 rop1 'r5)) +++ +++ (e-write2 'jsb "_qnewint") +++ (d-clearreg)))) +++ +++ +++ +++ +++;---- d routines (general ones, others are near function using them) +++ +++ +++ +++;--- d-cmp :: compare two IADR values +++; +++(defun d-cmp (arg1 arg2) +++ (e-write3 'cmpl (e-cvt arg1) (e-cvt arg2))) +++ +++ +++;--- d-handlecc :: handle g-cc +++; at this point the Z condition code has been set up and if g-cc is +++; non nil, we must jump on condition to the label given in g-cc +++; +++(defun d-handlecc nil +++ (If (car g-cc) then (e-gotot (car g-cc)) +++ elseif (cdr g-cc) then (e-gotonil (cdr g-cc)))) +++ +++ +++;--- d-invert :: handle inverted condition codes +++; this routine is called if a result has just be computed which alters +++; the condition codes such that Z=1 if the result is t, and Z=0 if the +++; result is nil (this is the reverse of the usual sense). The purpose +++; of this routine is to handle g-cc and g-loc. That is if g-loc is +++; specified, we must convert the value of the Z bit of the condition +++; code to t or nil and store that in g-loc. After handling g-loc we +++; must handle g-cc, that is if the part of g-cc is non nil which matches +++; the inverse of the current condition code, we must jump to that. +++; +++(defun d-invert nil +++ (If (null g-loc) +++ then (If (car g-cc) then (e-gotonil (car g-cc)) +++ elseif (cdr g-cc) then (e-gotot (cdr g-cc))) +++ else (let ((lab1 (d-genlab)) +++ (lab2 (If (cdr g-cc) thenret else (d-genlab)))) +++ (e-gotonil lab1) +++ ; Z=1, but remember that this implies nil due to inversion +++ (d-move 'Nil g-loc) +++ (e-goto lab2) +++ (e-label lab1) +++ ; Z=0, which means t +++ (d-move 'T g-loc) +++ (If (car g-cc) then (e-goto (car g-cc))) +++ (If (null (cdr g-cc)) then (e-label lab2))))) +++ +++ +++;--- d-noninvert :: handle g-cc and g-loc assuming cc non inverted +++; +++; like d-invert except Z=0 implies nil, and Z=1 implies t +++; +++(defun d-noninvert nil +++ (If (null g-loc) +++ then (If (car g-cc) then (e-gotot (car g-cc)) +++ elseif (cdr g-cc) then (e-gotonil (cdr g-cc))) +++ else (let ((lab1 (d-genlab)) +++ (lab2 (If (cdr g-cc) thenret else (d-genlab)))) +++ (e-gotot lab1) +++ ; Z=0, this implies nil +++ (d-move 'Nil g-loc) +++ (e-goto lab2) +++ (e-label lab1) +++ ; Z=1, which means t +++ (d-move 'T g-loc) +++ (If (car g-cc) then (e-goto (car g-cc))) +++ (If (null (cdr g-cc)) then (e-label lab2))))) +++ +++;--- d-macroexpand :: macro expand a form as much as possible +++; +++(defun d-macroexpand (form) +++ (prog nil +++ loop +++ (If (and (dtpr form) +++ (symbolp (car form)) +++ (eq 'macro (d-functyp (car form)))) +++ then (setq form (apply (car form) form)) +++ (go loop)) +++ (return form))) +++ +++;--- d-makespec :: declare a variable to be special +++; +++(defun d-makespec (vrb) +++ (putprop vrb t g-spec)) +++ +++ +++;--- d-move :: emit instructions to move value from one place to another +++; +++(defun d-move (from to) +++ (makecomment `(from ,(e-uncvt from) to ,(e-uncvt to))) +++ (cond ((eq 'Nil from) (e-write2 'clrl (e-cvt to))) +++ (t (e-write3 'movl (e-cvt from) (e-cvt to))))) +++ +++ +++;--- d-simple :: see of arg can be addresses in one instruction +++; we define simple and really simple as follows +++; ::= number +++; quoted anything +++; local symbol +++; t +++; nil +++; ::= +++; (cdr ) +++; global symbol +++; +++(defun d-simple (arg) +++ (let (tmp) +++ (If (d-rsimple arg) thenret +++ elseif (symbolp arg) then (d-loc arg) +++ elseif (and (memq (car arg) '(cdr car cddr cdar)) +++ (setq tmp (d-rsimple (cadr arg)))) +++ then (If (eq 'Nil tmp) then tmp +++ elseif (atom tmp) +++ then (If (eq 'car (car arg)) then `(racc 4 ,tmp) +++ elseif (eq 'cdr (car arg)) then `(racc 0 ,tmp) +++ elseif (eq 'cddr (car arg)) then `(racc * 0 ,tmp) +++ elseif (eq 'cdar (car arg)) then `(racc * 4 ,tmp)) +++ elseif (not (eq 'cdr (car arg))) then nil +++ elseif (eq 'lbind (car tmp)) then `(bind ,(cadr tmp)) +++ elseif (eq 'stack (car tmp)) then `(vstack ,(cadr tmp)) +++ elseif (eq 'fixnum (car tmp)) then `(immed ,(cadr tmp)) +++ elseif (atom (car tmp)) then `(0 ,(cadr tmp)) +++ else (comp-err "bad arg to d-simple: " (or arg)))))) +++ +++(defun d-rsimple (arg) +++ (If (atom arg) then +++ (If (null arg) then 'Nil +++ elseif (eq t arg) then 'T +++ elseif (or (numberp arg) +++ (memq arg g-locs)) +++ then (d-loc arg) +++ else (car (d-bestreg arg nil))) +++ elseif (eq 'quote (car arg)) then (d-loclit (cadr arg) nil))) +++ +++;--- d-movespec :: move from loc to loc where the first addr given is +++; an EIADR +++; - from : EIADR +++; - to : IADR +++; +++(defun d-movespec (from to) +++ (makecomment `(fromspec ,from to ,(e-uncvt to))) +++ (e-write3 'movl from (e-cvt to))) +++ +++ +++;--- d-specialp :: check if a variable is special +++; a varible is special if it has been declared as such, or if +++; the variable special is t +++(defun d-specialp (vrb) +++ (or special (get vrb g-spec))) +++ +++ +++;--- d-tst :: test the given value (set the cc) +++; +++(defun d-tst (arg) +++ (e-write2 'tstl (e-cvt arg))) +++ +++;--- d-typesimp :: determine the type of the argument +++; +++(defun d-typesimp (arg val) +++ (let ((argloc (d-simple arg))) +++ (If (null argloc) then (let ((g-loc 'reg) +++ g-cc g-ret) +++ (d-exp arg)) +++ (setq argloc 'reg)) +++ (e-write4 'ashl '$-9 (e-cvt argloc) 'r0) +++ (e-write3 'cmpb '"_typetable+1[r0]" val) +++ (d-invert))) +++ +++;--- d-typecmplx :: determine if arg has one of many types +++; - arg : lcode argument to be evaluated and checked +++; - vals : fixnum with a bit in position n if we are to check type n +++; +++(defun d-typecmplx (arg vals) +++ (let ((argloc (d-simple arg)) +++ (reg)) +++ (If (null argloc) then (let ((g-loc 'reg) +++ g-cc g-ret) +++ (d-exp arg)) +++ (setq argloc 'reg)) +++ (setq reg 'r0) +++ (e-write4 'ashl '$-9 (e-cvt argloc) reg) +++ (e-write3 'cvtbl (concat "_typetable+1[" reg "]") reg) +++ (e-write4 'ashl reg '$1 reg) +++ (e-write3 'bitw vals reg) +++ (d-noninvert))) +++ +++ +++;---- register handling routines. +++ +++;--- d-allocreg :: allocate a register +++; name - the name of the register to allocate or nil if we should +++; allocate the least recently used. +++; +++(defun d-allocreg (name) +++ (If name +++ then (let ((av (assoc name g-reguse))) +++ (If av then (rplaca (cdr av) (1+ (cadr av)))) ; inc used count +++ name) +++ else ; find smallest used count +++ (do ((small (car g-reguse)) +++ (smc (cadar g-reguse)) +++ (lis (cdr g-reguse) (cdr lis))) +++ ((null lis) +++ (rplaca (cdr small) (1+ smc)) +++ (car small)) +++ (If (< (cadar lis) smc) +++ then (setq small (car lis) +++ smc (cadr small)))))) +++ +++ +++;--- d-bestreg :: determine the register which is closest to what we have +++; name - name of variable whose subcontents we want +++; pat - list of d's and a's which tell which part we want +++; +++(defun d-bestreg (name pat) +++ (do ((ll g-reguse (cdr ll)) +++ (val) +++ (best) +++ (tmp) +++ (bestv -1)) +++ ((null ll) (If best then (rplaca (cdr best) (1+ (cadr best))) +++ (list (car best) +++ (If (> bestv 0) +++ then (rplacd (nthcdr (1- bestv) +++ (setq tmp +++ (copy pat))) +++ nil) +++ tmp +++ else nil) +++ (nthcdr bestv pat)))) +++ (If (and (setq val (cddar ll)) +++ (eq name (car val))) +++ then (If (> (setq tmp (d-matchcnt pat (cdr val))) +++ bestv) +++ then (setq bestv tmp +++ best (car ll)))))) +++ +++;--- d-matchcnt :: determine how many parts of a pattern match +++; want - pattern we want to achieve +++; have - pattern whose value exists in a register +++; +++; we return a count of the number of parts of the pattern match. +++; If this pattern will be any help at all, we return a value from +++; 0 to the length of the pattern. +++; If this pattern will not work at all, we return a number smaller +++; than -1. +++; For `have' to be useful for `want', `have' must be a substring of +++; `want'. If it is a substring, we return the length of `have'. +++; +++(defun d-matchcnt (want have) +++ (let ((length 0)) +++ (If (do ((hh have (cdr hh)) +++ (ww want (cdr ww))) +++ ((null hh) t) +++ (If (or (null ww) (not (eq (car ww) (car hh)))) +++ then (return nil) +++ else (incr length))) +++ then length +++ else -2))) +++ +++ +++ +++;--- d-clearreg :: clear all values in registers or just one +++; if no args are given, clear all registers. +++; if an arg is given, clear that register +++; +++(defun d-clearreg n +++ (cond ((zerop n) +++ (mapc '(lambda (x) (rplaca (cdr x) 0) +++ (rplacd (cdr x) nil)) +++ g-reguse)) +++ (t (let ((av (assoc (arg 1) g-reguse))) +++ (If av then (rplaca (cdr av) 0) +++ (rplacd (cdr av) nil)))))) +++ +++ +++;--- d-clearuse :: clear all register which reference a given variable +++; +++(defun d-clearuse (varib) +++ (mapc '(lambda (x) +++ (If (eq (caddr x) varib) then (rplacd (cdr x) nil))) +++ g-reguse)) +++ +++ +++;--- d-inreg :: declare that a value is in a register +++; name - register name +++; value - value in a register +++; +++(defun d-inreg (name value) +++ (let ((av (assoc name g-reguse))) +++ (If av then (rplacd (cdr av) value)) +++ name)) +++ +++ +++;---- e routines +++ +++ +++ +++(defun e-cvt (arg) +++ (If (eq 'reg arg) then 'r0 +++ elseif (eq 'Nil arg) then '$0 +++ elseif (eq 'T arg) then (If g-trueloc thenret +++ else (setq g-trueloc (e-cvt (d-loclit t nil)))) +++ elseif (eq 'stack arg) then '(+ #.Np-reg) +++ elseif (eq 'unstack arg) then '(- #.Np-reg) +++ elseif (atom arg) then arg +++ elseif (dtpr arg) then (If (eq 'stack (car arg)) +++ then `(,(* 4 (1- (cadr arg))) #.oLbot-reg) +++ elseif (eq 'vstack (car arg)) +++ then `(* ,(* 4 (1- (cadr arg))) #.oLbot-reg) +++ elseif (eq 'bind (car arg)) +++ then `(* ,(* 4 (1- (cadr arg))) #.bind-reg) +++ elseif (eq 'lbind (car arg)) +++ then `( ,(* 4 (1- (cadr arg))) #.bind-reg) +++ elseif (eq 'fixnum (car arg)) +++ then `(\# ,(cadr arg)) +++ elseif (eq 'immed (car arg)) +++ then `($ ,(cadr arg)) +++ elseif (eq 'racc (car arg)) +++ then (cdr arg) +++ else (comp-err " bad arg to e-cvt : " +++ (or arg))) +++ else (comp-warn "bad arg to e-cvt : " (or arg)))) +++ +++ +++;--- e-uncvt :: inverse of e-cvt, used for making comments pretty +++; +++(defun e-uncvt (arg) +++ (If (atom arg) then (If (eq 'Nil arg) then nil +++ else arg) +++ elseif (eq 'stack (car arg)) +++ then (do ((i g-loccnt) +++ (ll g-locs)) +++ ((and (equal i (cadr arg)) (atom (car ll))) (car ll)) +++ (If (atom (car ll)) then (setq ll (cdr ll) +++ i (1- i)) +++ else (setq ll (cdr ll)))) +++ elseif (or (eq 'bind (car arg)) (eq 'lbind (car arg))) +++ then (do ((i g-litcnt (1- i)) +++ (ll g-lits (cdr ll))) +++ ((equal i (cadr arg)) (cond ((eq 'lbind (car arg)) +++ (list 'quote (car ll))) +++ (t (car ll))))) +++ else arg)) +++ +++;--- e-cvtas :: convert an EIADR to vax unix assembler fmt and print it +++; - form : an EIADR form +++; +++(defun e-cvtas (form) +++ (If (atom form) +++ then (sfilewrite form) +++ else (If (eq '* (car form)) then (If (eq '\# (cadr form)) +++ then (setq form `($ ,(caddr form))) +++ else (sfilewrite "*") +++ (setq form (cdr form)))) +++ (If (numberp (car form)) +++ then (sfilewrite (car form)) +++ (sfilewrite "(") +++ (sfilewrite (cadr form)) +++ (sfilewrite ")") +++ (If (caddr form) +++ then (sfilewrite "[") +++ (sfilewrite (caddr form)) +++ (sfilewrite "]")) +++ elseif (eq '+ (car form)) +++ then (sfilewrite '"(") +++ (sfilewrite (cadr form)) +++ (sfilewrite '")+") +++ elseif (eq '- (car form)) +++ then (sfilewrite '"-(") +++ (sfilewrite (cadr form)) +++ (sfilewrite '")") +++ elseif (eq '\# (car form)) ; 5120 is base of small fixnums +++ then (sfilewrite (concat "$" (+ (* (cadr form) 4) 5120))) +++ elseif (eq '$ (car form)) +++ then (sfilewrite '"$") +++ (sfilewrite (cadr form))))) +++;--- e-cmp :: emit code to compare the two given args +++; - arg1, arg2 : EIADRs +++; +++(defun e-cmp (arg1 arg2) +++ (e-write3 'cmpl arg1 arg2)) +++ +++;--- e-docomment :: print any comment lines +++; +++(defun e-docomment nil +++ (If g-comments +++ then (do ((ll (nreverse g-comments) (cdr ll))) +++ ((null ll)) +++ (sfilewrite '" #") +++ (sfilewrite (car ll)) +++ (terpr vp-sfile)) +++ (setq g-comments nil) +++ else (terpr vp-sfile))) +++;--- e-goto :: emit code to jump to the location given +++; +++(defun e-goto (lbl) +++ (e-jump lbl)) +++ +++;--- e-gotonil :: emit code to jump if nil was last computed +++; +++(defun e-gotonil (lbl) +++ (e-write2 'jeql lbl)) +++ +++;--- e-gotot :: emit code to jump if t was last computed +++(defun e-gotot (lbl) +++ (e-write2 'jneq lbl)) +++ +++;--- e-label :: emit a label +++(defun e-label (lbl) +++ (setq g-skipcode nil) +++ (e-writel lbl)) +++ +++;--- e-move :: move value from one place to anther +++; this corresponds to d-move except the args are EIADRS +++; +++(defun e-move (from to) +++ (If (equal 0 from) then (e-write2 'clrl to) +++ else (e-write3 'movl from to))) +++ +++;--- e-pop :: pop the given number of args from the stack +++; g-locs is not! fixed +++; +++(defun e-pop (nargs) +++ (If (greaterp nargs 0) +++ then (e-dropnp nargs))) +++ +++ +++;--- e-pushnil :: push a given number of nils on the stack +++; +++(defun e-pushnil (nargs) +++ (do ((i nargs)) +++ ((zerop i)) +++ (If (greaterp i 1) then (e-write2 'clrq np-plus) +++ (setq i (- i 2)) +++ elseif (equal i 1) then (e-write2 'clrl np-plus) +++ (setq i (1- i))))) +++ +++;--- e-tst :: test a value, arg is an EIADR +++; +++(defun e-tst (arg) +++ (e-write2 'tstl arg)) +++;--- e-setupbind :: setup for shallow binding +++; +++(defun e-setupbind nil +++ (e-write3 'movl '#.Bnp-val '#.bNp-reg)) +++ +++;--- e-unsetupbind :: restore temp value of bnp to real loc +++; +++(defun e-unsetupbind nil +++ (e-write3 'movl '#.bNp-reg '#.Bnp-val)) +++ +++;--- e-shallowbind :: shallow bind value of variable and initialize it +++; - name : variable name +++; - val : IADR value for variable +++; +++(defun e-shallowbind (name val) +++ (let ((vloc (d-loclit name t))) +++ (e-write3 'movl (e-cvt vloc) '(+ #.bNp-reg)) ; store old val +++ (e-write3 'movl (e-cvt `(lbind ,@(cdr vloc))) +++ '(+ #.bNp-reg)) ; now name +++ (d-move val vloc))) +++ +++;--- e-unshallowbind :: un shallow bind n variable from top of stack +++; +++(defun e-unshallowbind (n) +++ (e-setupbind) ; set up binding register +++ (do ((i 1 (1+ i))) +++ ((greaterp i n)) +++ (e-write3 'movl `(,(* -8 i) ,bNp-reg) `(* ,(+ 4 (* -8 i)) ,bNp-reg))) +++ (e-write4 'subl3 `($ ,(* 8 n)) bNp-reg Bnp-val)) +++ +++;----------- very low level routines +++; all output to the assembler file goes through these routines. +++; They filter out obviously extraneous instructions as well as +++; combine sequential drops of np. +++ +++;--- e-dropnp :: unstack n values from np. +++; rather than output the instruction now, we just remember that it +++; must be done before any other instructions are done. This will +++; enable us to catch sequential e-dropnp's +++; +++(defun e-dropnp (n) +++ (If (not g-skipcode) +++ then (setq g-dropnpcnt (+ n (If g-dropnpcnt thenret else 0))))) +++ +++;--- em-checknpdrop :: check if we have a pending npdrop +++; and do it if so. +++; +++(defmacro em-checknpdrop nil +++ `(If g-dropnpcnt then (let ((dr g-dropnpcnt)) +++ (setq g-dropnpcnt nil) +++ (e-write3 'subl2 `($ ,(* dr 4)) Np-reg)))) +++ +++;--- em-checkskip :: check if we are skipping this code due to jump +++; +++(defmacro em-checkskip nil +++ '(If g-skipcode then (sfilewrite "# "))) +++ +++ +++;--- e-jump :: jump to given label +++; and set g-skipcode so that all code following until the next label +++; will be skipped. +++; +++(defun e-jump (l) +++ (em-checknpdrop) +++ (e-write2 'jbr l) +++ (setq g-skipcode t)) +++ +++;--- e-return :: do return, and dont check for np drop +++; +++(defun e-return nil +++ (setq g-dropnpcnt nil) ; we dont need to worry about nps +++ (e-write1 'ret)) +++ +++ +++;--- e-writel :: write out a label +++; +++(defun e-writel (label) +++ (setq g-skipcode nil) +++ (em-checknpdrop) +++ (sfilewrite label) +++ (sfilewrite '":") +++ (e-docomment)) +++ +++;--- e-write1 :: write out one litteral +++; +++(defun e-write1 (lit) +++ (em-checkskip) +++ (em-checknpdrop) +++ (sfilewrite lit) +++ (e-docomment)) +++ +++;--- e-write2 :: write one one litteral, and one operand +++; +++(defun e-write2 (lit frm) +++ (em-checkskip) +++ (em-checknpdrop) +++ (sfilewrite lit) +++ (sfilewrite '" ") +++ (e-cvtas frm) +++ (e-docomment)) +++ +++;--- e-write3 :: write one one litteral, and two operands +++; +++(defun e-write3 (lit frm1 frm2) +++ (em-checkskip) +++ (em-checknpdrop) +++ (sfilewrite lit) +++ (sfilewrite '" ") +++ (e-cvtas frm1) +++ (sfilewrite '",") +++ (e-cvtas frm2) +++ (e-docomment)) +++ +++;--- e-write4 :: write one one litteral, and three operands +++; +++(defun e-write4 (lit frm1 frm2 frm3) +++ (em-checkskip) +++ (em-checknpdrop) +++ (sfilewrite lit) +++ (sfilewrite '" ") +++ (e-cvtas frm1) +++ (sfilewrite '",") +++ (e-cvtas frm2) +++ (sfilewrite '",") +++ (e-cvtas frm3) +++ (e-docomment)) +++ +++ +++;--- e-write5 :: write one one litteral, and four operands +++; +++(defun e-write5 (lit frm1 frm2 frm3 frm4) +++ (em-checkskip) +++ (em-checknpdrop) +++ (sfilewrite lit) +++ (sfilewrite '" ") +++ (e-cvtas frm1) +++ (sfilewrite '",") +++ (e-cvtas frm2) +++ (sfilewrite '",") +++ (e-cvtas frm3) +++ (sfilewrite '",") +++ (e-cvtas frm4) +++ (e-docomment)) diff --cc usr/src/cmd/ln.c index 0000000000,ac6c619108,0000000000..b2643683e3 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ln.c +++ b/usr/src/cmd/ln.c @@@@ -1,0 -1,56 -1,0 +1,72 @@@@ +++static char sccsid[] = "@(#)ln.c 4.1 10/1/80"; + +/* - * ln [ -f ] target [ new name ] +++ * ln + + */ - +++#include + +#include + +#include - #include "stdio.h" +++ +++struct stat stb; +++int fflag; /* force flag set? */ +++char name[BUFSIZ]; + +char *rindex(); + + + +main(argc, argv) - char **argv; +++ int argc; +++ register char **argv; + +{ - struct stat statb; - register char *np; - int fflag = 0; - char nb[100], *name=nb, *arg2; - int statres; +++ register int i, r; + + - if (argc >1 && strcmp(argv[1], "-f")==0) { - argc--; - argv++; +++ argc--, argv++; +++ if (argc && strcmp(argv[0], "-f") == 0) { + + fflag++; +++ argv++; +++ argc--; + + } - if (argc<2 || argc>3) { - printf("Usage: ln target [ newname ]\n"); - exit(1); +++ if (argc == 0) +++ goto usage; +++ else if (argc == 1) { +++ argv[argc] = "."; +++ argc++; + + } - np = rindex(argv[1], '/'); - if (np==0) - np = argv[1]; - else - np++; - if (argc==2) - arg2 = np; - else - arg2 = argv[2]; - statres = stat(argv[1], &statb); - if (statres<0) { - printf ("ln: %s does not exist\n", argv[1]); - exit(1); +++ if (argc > 2) { +++ if (stat(argv[argc-1], &stb) < 0) +++ goto usage; +++ if ((stb.st_mode&S_IFMT) != S_IFDIR) +++ goto usage; +++ } +++ r = 0; +++ for(i = 0; i < argc-1; i++) +++ r |= linkit(argv[i], argv[argc-1]); +++ exit(r); +++usage: +++ fprintf(stderr, "Usage: ln f1\nor: ln f1 f2\nln f1 ... fn d2\n"); +++ exit(1); +++} +++ +++linkit(from, to) +++ char *from, *to; +++{ +++ char *tail; +++ +++ /* is target a directory? */ +++ if (fflag == 0 && stat(from, &stb) >= 0 +++ && (stb.st_mode&S_IFMT) == S_IFDIR) { +++ printf("%s is a directory\n", from); +++ return (1); + + } - if (fflag==0 && (statb.st_mode&S_IFMT) == S_IFDIR) { - printf("ln: %s is a directory\n", argv[1]); - exit(1); +++ if (stat(to, &stb) >=0 && (stb.st_mode&S_IFMT) == S_IFDIR) { +++ tail = rindex(from, '/'); +++ if (tail == 0) +++ tail = from; +++ else +++ tail++; +++ sprintf(name, "%s/%s", to, tail); +++ to = name; + + } - statres = stat(arg2, &statb); - if (statres>=0 && (statb.st_mode&S_IFMT) == S_IFDIR) - sprintf(name, "%s/%s", arg2, np); - else - name = arg2; - if (link(argv[1], name)<0) { - perror("ln"); - exit(1); +++ if (link(from, to) < 0) { +++ perror(from); +++ return (1); + + } - exit(0); +++ return(0); + +} diff --cc usr/src/cmd/lock.c index 0000000000,d0925cb444,0000000000..21341d54c4 mode 000000,100644,000000..100644 --- a/usr/src/cmd/lock.c +++ b/usr/src/cmd/lock.c @@@@ -1,0 -1,50 -1,0 +1,52 @@@@ +++static char *sccsid = "@(#)lock.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +#include + +#include + + + +/* + + * Lock a terminal up until the knowledgeable Joe returns. + + */ + +char masterp[] = "hasta la vista\n"; + +struct sgttyb tty, ntty; + +char s[BUFSIZ], s1[BUFSIZ]; + + + +main(argc, argv) + + char **argv; + +{ + + register int t; + + struct stat statb; + + + + for (t = 1; t <= 16; t++) +++ if (t != SIGHUP) + + signal(t, SIG_IGN); + + if (argc > 0) + + argv[0] = 0; + + if (gtty(0, &tty)) + + exit(1); + + ntty = tty; ntty.sg_flags &= ~ECHO; + + stty(0, &ntty); + + printf("Key: "); + + fgets(s, sizeof s, stdin); + + printf("\nAgain: "); + + fgets(s1, sizeof s1, stdin); + + putchar('\n'); + + if (strcmp(s1, s)) { + + putchar(07); + + stty(0, &tty); + + exit(1); + + } + + s[0] = 0; + + for (;;) { + + fgets(s, sizeof s, stdin); + + if (strcmp(s1, s) == 0) + + break; + + if (strcmp(s, masterp) == 0) + + break; + + putchar(07); + + if (gtty(0, &ntty)) + + exit(1); + + } + + stty(0, &tty); + +} diff --cc usr/src/cmd/login.c index 0000000000,cea69ade57,0000000000..656910dcc7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/login.c +++ b/usr/src/cmd/login.c @@@@ -1,0 -1,230 -1,0 +1,267 @@@@ +++static char *sccsid = "@(#)login.c 4.6 (Berkeley) 11/11/80"; + +/* + + * login [ name ] + + */ + + + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include +++#include + +#define SCPYN(a, b) strncpy(a, b, sizeof(a)) + + +++#define NMAX sizeof(utmp.ut_name) +++#define LMAX sizeof(utmp.ut_line) +++ +++char user[20]; + +char maildir[30] = "/usr/spool/mail/"; + +char lastlog[] = "/usr/adm/lastlog"; + +struct passwd nouser = {"", "nope"}; + +struct sgttyb ttyb; + +struct utmp utmp; + +char minusnam[16] = "-"; + +char homedir[64] = "HOME="; + +char shell[64] = "SHELL="; + +char term[64] = "TERM="; - char *envinit[] = {homedir, shell, "PATH=:/usr/ucb:/bin:/usr/bin", term, 0}; +++char *envinit[] = {homedir, shell, "PATH=:/usr/ucb:/bin:/usr/bin", term, user,0}; + +struct passwd *pwd; + + + +struct passwd *getpwnam(); + +char *strcat(); + +int setpwent(); + +char *ttyname(); + +char *crypt(); + +char *getpass(); + +char *rindex(); + +char *stypeof(); + +extern char **environ; + + +++#define CTRL(c) ('c'&037) +++#define CERASE '#' +++#define CEOT CTRL(d) +++#define CKILL '@' +++#define CQUIT 034 /* FS, cntl shift L */ +++#define CINTR 0177 /* DEL */ +++#define CSTOP CTRL(s) +++#define CSTART CTRL(q) +++#define CBRK 0377 +++struct tchars tc = { +++ CINTR, CQUIT, CSTART, CSTOP, CEOT, CBRK +++}; +++struct ltchars ltc = { +++ CTRL(z), CTRL(y), CTRL(r), CTRL(o), CTRL(w), CTRL(v) +++}; +++ + +main(argc, argv) + +char **argv; + +{ + + register char *namep; + + int t, f, c; + + char *ttyn; +++ int ldisc = 0; + + + + alarm(60); + + signal(SIGQUIT, SIG_IGN); + + signal(SIGINT, SIG_IGN); + + nice(-100); + + nice(20); + + nice(0); +++ ioctl(0, TIOCLSET, 0); +++ ioctl(0, TIOCNXCL, 0); + + gtty(0, &ttyb); + + ttyb.sg_erase = '#'; + + ttyb.sg_kill = '@'; + + stty(0, &ttyb); +++ ioctl(0, TIOCSETC, &tc); +++ ioctl(0, TIOCSLTC, <c); + + for (t=3; t<20; t++) + + close(t); + + ttyn = ttyname(0); + + if (ttyn==0) + + ttyn = "/dev/tty??"; + + + + loop: +++ ldisc = 0; +++ ioctl(0, TIOCSETD, &ldisc); + + SCPYN(utmp.ut_name, ""); + + if (argc>1) { + + SCPYN(utmp.ut_name, argv[1]); + + argc = 0; + + } + + while (utmp.ut_name[0] == '\0') { + + namep = utmp.ut_name; + + printf("login: "); + + while ((c = getchar()) != '\n') { + + if(c == ' ') + + c = '_'; + + if (c == EOF) + + exit(0); - if (namep < utmp.ut_name+8) +++ if (namep < utmp.ut_name+NMAX) + + *namep++ = c; + + } + + } + + setpwent(); + + if ((pwd = getpwnam(utmp.ut_name)) == NULL) + + pwd = &nouser; + + endpwent(); +++ if (!strcmp(pwd->pw_shell, "/bin/csh")) { +++ ldisc = NTTYDISC; +++ ioctl(0, TIOCSETD, &ldisc); +++ } + + if (*pwd->pw_passwd != '\0') { +++ nice(-4); + + namep = crypt(getpass("Password:"),pwd->pw_passwd); +++ nice(4); + + if (strcmp(namep, pwd->pw_passwd)) { + +bad: + + printf("Login incorrect\n"); - if (ttyn[8] == 'd') { +++ if (ttyn[LMAX] == 'd') { + + FILE *console = fopen("/dev/console", "w"); + + if (console != NULL) { + + fprintf(console, "\r\nBADDIALUP %s %s\r\n", ttyn+5, utmp.ut_name); + + fclose(console); + + } + + } + + goto loop; + + } + + } - /* +++ sprintf(user, "USER=%.*s", NMAX, pwd->pw_name); +++#ifdef ERNIE + + if (pwd->pw_uid == 0 && ttyn[5] != 'c') + + goto bad; - */ - if (ttyn[8] == 'd') { +++#endif +++ if (ttyn[LMAX] == 'd') { + + FILE *console = fopen("/dev/console", "w"); + + if (console != NULL) { + + fprintf(console, "\r\nDIALUP %s %s\r\n", ttyn+5, pwd->pw_name); + + fclose(console); + + } + + } + + if((f = open(lastlog, 2)) >= 0) { + + struct lastlog ll; + + - lseek(f, pwd->pw_uid * sizeof (struct lastlog), 0); +++ lseek(f, (long) pwd->pw_uid * sizeof (struct lastlog), 0); + + if (read(f, (char *) &ll, sizeof ll) == sizeof ll && ll.ll_time != 0) { + + register char *ep = (char *) ctime(&ll.ll_time); + + printf("Last login: "); + + ep[24 - 5] = 0; - printf("%s on %.8s\n", ep, ll.ll_line); +++ printf("%s on %.*s\n", ep, LMAX, ll.ll_line); + + } - lseek(f, pwd->pw_uid * sizeof (struct lastlog), 0); +++ lseek(f, (long) pwd->pw_uid * sizeof (struct lastlog), 0); + + time(&ll.ll_time); - strcpyn(ll.ll_line, ttyn+5, 8); +++ strcpyn(ll.ll_line, ttyn+5, LMAX); + + write(f, (char *) &ll, sizeof ll); +++ close(f); + + } + + if(chdir(pwd->pw_dir) < 0) { + + printf("No directory\n"); + + goto loop; + + } + + time(&utmp.ut_time); + + t = ttyslot(); + + if (t>0 && (f = open("/etc/utmp", 1)) >= 0) { + + lseek(f, (long)(t*sizeof(utmp)), 0); + + SCPYN(utmp.ut_line, rindex(ttyn, '/')+1); + + write(f, (char *)&utmp, sizeof(utmp)); + + close(f); + + } + + if (t>0 && (f = open("/usr/adm/wtmp", 1)) >= 0) { + + lseek(f, 0L, 2); + + write(f, (char *)&utmp, sizeof(utmp)); + + close(f); + + } + + chown(ttyn, pwd->pw_uid, pwd->pw_gid); + + setgid(pwd->pw_gid); + + setuid(pwd->pw_uid); + + if (*pwd->pw_shell == '\0') + + pwd->pw_shell = "/bin/sh"; + + environ = envinit; + + strncat(homedir, pwd->pw_dir, sizeof(homedir)-6); + + strncat(shell, pwd->pw_shell, sizeof(shell)-7); + + strncat(term, stypeof(ttyn), sizeof(term)-6); + + if ((namep = rindex(pwd->pw_shell, '/')) == NULL) + + namep = pwd->pw_shell; + + else + + namep++; + + strcat(minusnam, namep); + + alarm(0); + + umask(022); + + showmotd(); + + strcat(maildir, pwd->pw_name); + + if(access(maildir,4)==0) { + + struct stat statb; + + stat(maildir, &statb); + + if (statb.st_size) + + printf("You have mail.\n"); + + } + + signal(SIGQUIT, SIG_DFL); + + signal(SIGINT, SIG_DFL); + + execlp(pwd->pw_shell, minusnam, 0); + + printf("No shell\n"); + + exit(0); + +} + + + +int stopmotd; + +catch() + +{ + + signal(SIGINT, SIG_IGN); + + stopmotd++; + +} + + + +showmotd() + +{ + + FILE *mf; + + register c; + + + + signal(SIGINT, catch); + + if((mf = fopen("/etc/motd","r")) != NULL) { + + while((c = getc(mf)) != EOF && stopmotd == 0) + + putchar(c); + + fclose(mf); + + } + + signal(SIGINT, SIG_IGN); + +} + + + +#define UNKNOWN "su" + + + +char * + +stypeof(ttyid) + +char *ttyid; + +{ + + static char typebuf[16]; + + char buf[50]; + + register FILE *f; + + register char *p, *t, *q; + + + + if (ttyid == NULL) + + return (UNKNOWN); + + f = fopen("/etc/ttytype", "r"); + + if (f == NULL) + + return (UNKNOWN); + + /* split off end of name */ + + for (p = q = ttyid; *p != 0; p++) + + if (*p == '/') + + q = p + 1; + + + + /* scan the file */ + + while (fgets(buf, sizeof buf, f) != NULL) + + { + + for (t=buf; *t!=' '; t++) + + ; + + *t++ = 0; + + for (p=t; *p>' '; p++) + + ; + + *p = 0; + + if (strcmp(q,t)==0) { + + strcpy(typebuf, buf); + + fclose(f); + + return (typebuf); + + } + + } + + fclose (f); + + return (UNKNOWN); + +} diff --cc usr/src/cmd/look.c index 0000000000,b2a9980581,0000000000..39e8484443 mode 000000,100644,000000..100644 --- a/usr/src/cmd/look.c +++ b/usr/src/cmd/look.c @@@@ -1,0 -1,162 -1,0 +1,163 @@@@ +++static char *sccsid = "@(#)look.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + + + +FILE *dfile; + +char *filenam = "/usr/dict/words"; + + + +int fold; + +int dict; + +int tab; + +char entry[250]; + +char word[250]; + +char key[50]; + + + +main(argc,argv) + +char **argv; + +{ + + register c; + + long top,bot,mid; + + while(argc>=2 && *argv[1]=='-') { + + for(;;) { + + switch(*++argv[1]) { + + case 'd': + + dict++; + + continue; + + case 'f': + + fold++; + + continue; + + case 't': + + tab = argv[1][1]; + + if(tab) + + ++argv[1]; + + continue; + + case 0: + + break; + + default: + + continue; + + } + + break; + + } + + argc --; + + argv++; + + } + + if(argc<=1) + + return; + + if(argc==2) { + + fold++; + + dict++; + + } else + + filenam = argv[2]; + + dfile = fopen(filenam,"r"); + + if(dfile==NULL) { + + fprintf(stderr,"look: can't open %s\n",filenam); + + exit(2); + + } + + canon(argv[1],key); + + bot = 0; + + fseek(dfile,0L,2); + + top = ftell(dfile); + + for(;;) { + + mid = (top+bot)/2; + + fseek(dfile,mid,0); + + do { + + c = getc(dfile); + + mid++; + + } while(c!=EOF && c!='\n'); + + if(!getword(entry)) + + break; + + canon(entry,word); + + switch(compare(key,word)) { + + case -2: + + case -1: + + case 0: + + if(top<=mid) + + break; + + top = mid; + + continue; + + case 1: + + case 2: + + bot = mid; + + continue; + + } + + break; + + } + + fseek(dfile,bot,0); + + while(ftell(dfile) + +#include + +#include + +#include + +#include +++#include +++#include +++#include + + +++struct utmp utmp; +++#define NMAX (sizeof utmp.ut_name) + + - #define NFILES 1024 +++#define MAXFILEWIDTH 14 +++#define NFILES 1024 + +FILE *pwdf, *dirf; + + + +struct lbuf { + + union { + + char lname[15]; + + char *namep; + + } ln; + + char ltype; - short lnum; +++ ino_t lnum; + + short lflags; + + short lnl; + + short luid; + + short lgid; + + long lsize; + + long lmtime; + +}; + + - int aflg, dflg, lflg, sflg, tflg, uflg, iflg, fflg, gflg, cflg; - int Aflg, nflg, qflg, across; +++struct dchain { +++ char *dc_name; /* the path name */ +++ struct dchain *dc_next; /* the next directory on the chain */ +++}; +++ +++struct dchain *dfirst; /* the start of the directory chain */ +++struct dchain *cdfirst; /* the start of the current directory chain */ +++struct dchain *dtemp; /* temporary used when linking */ +++char *curdir; /* the current directory */ +++ +++int aflg, bflg, dflg, lflg, sflg, tflg, uflg, iflg, fflg, gflg, cflg; +++int Aflg, nflg, qflg, Fflg, Rflg, across, Cflg; + +int nopad; - char buff[32]; +++int tabflg; + +int rflg = 1; + +long year; + +int flags; - int lastuid = -1; - char tbuf[16]; + +long tblocks; + +int statreq; +++int xtraent; /* for those switches which print out a total */ + +struct lbuf *flist[NFILES]; + +struct lbuf **lastp = flist; + +struct lbuf **firstp = flist; + +char *dotp = "."; + + + +char *makename(); + +struct lbuf *gstat(); + +char *ctime(); + +long nblock(); +++char *getname(); + + - #define ISARG 0100000 - int colwidth = 15; +++#define ISARG 0100000 +++int colwidth; +++int filewidth; +++int fixedwidth; + +int outcol; + + + +char obuf[BUFSIZ]; + + + +main(argc, argv) +++int argc; + +char *argv[]; + +{ - int i; - register struct lbuf *ep, **ep1; +++#include +++ +++ int i, width; +++ register struct lbuf *ep; + + register struct lbuf **slastp; + + struct lbuf **epp; + + struct lbuf lb; + + char *t; + + char *cp; + + int compar(); +++ struct sgttyb sgbuf; + + +++ Fflg = 0; +++ tabflg = 0; + + Aflg = getuid() == 0; + + setbuf(stdout, obuf); - time(&lb.lmtime); +++ lb.lmtime = time((long *) 0); + + year = lb.lmtime - 6L*30L*24L*60L*60L; /* 6 months ago */ - qflg = gtty(1, buff) == 0; +++ qflg = gtty(1, &sgbuf) == 0; +++ +++ /* guarantee at least on column width */ +++ fixedwidth = 2; +++ + + /* + + * If the standard output is not a teletype, + + * then we default to one-per-line format + + * otherwise decide between stream and + + * columnar based on our name. + + */ + + if (qflg) { - cflg = 1; +++ Cflg = 1; +++ if ((sgbuf.sg_flags & XTABS) == 0) +++ tabflg++; + + for (cp = argv[0]; cp[0] && cp[1]; cp++) + + continue; + + /* - * Name ends in l => stream +++ * Certain kinds of links (l, ll, lr, lf, lx) cause some +++ * various options to be turned on. + + */ - if (cp[0] == 'l') - nopad = 1, cflg = 0; - /* - * ... if doesn't end in l or s ==> columns sorted across - * - else if (cp[0] == 'x') +++ switch (cp[0]) { +++ case 'l': +++ if (cp[-1] == 'l') { +++ /* ll => -l */ +++ lflg = 1; +++ statreq++; +++ xtraent++; +++ } else { +++ /* l => -m */ +++ nopad = 1; +++ Cflg = 0; +++ } +++ break; +++ case 'x': /* lx => -x */ + + across = 1; - */ +++ break; +++ case 'f': /* lf => -F */ +++ Fflg = 1; +++ break; +++ case 'r': /* lr => -R */ +++ Rflg = 1; +++ break; +++ } +++ } else { +++ tabflg++; + + } - if (--argc > 0 && *argv[1] == '-') { +++ +++ while (--argc > 0 && *argv[1] == '-') { + + argv++; + + while (*++*argv) switch (**argv) { + + /* - * c - force columnar output +++ * C - force columnar output + + */ - case 'c': - cflg = 1; +++ case 'C': +++ Cflg = 1; + + nopad = 0; + + continue; + + /* + + * m - force stream output + + */ + + case 'm': - cflg = 0; +++ Cflg = 0; + + nopad = 1; + + continue; + + /* + + * x - force sort across + + */ + + case 'x': + + across = 1; + + nopad = 0; - cflg = 1; +++ Cflg = 1; + + continue; + + /* + + * q - force ?'s in output + + */ + + case 'q': + + qflg = 1; +++ bflg = 0; +++ continue; +++ /* +++ * b - force octal value in output +++ */ +++ case 'b': +++ bflg = 1; +++ qflg = 0; + + continue; + + /* + + * 1 - force 1/line in output + + */ + + case '1': - cflg = 0; +++ Cflg = 0; + + nopad = 0; + + continue; + + /* STANDARD FLAGS */ + + case 'a': + + aflg++; + + continue; + + + + case 'A': + + Aflg = !Aflg; + + continue; + + +++ case 'c': +++ cflg++; +++ continue; +++ + + case 's': - colwidth += 5; +++ fixedwidth += 5; + + sflg++; + + statreq++; +++ xtraent++; + + continue; + + + + case 'd': + + dflg++; + + continue; + + + + /* + + * n - don't look in password file + + */ + + case 'n': + + nflg++; + + case 'l': + + lflg++; + + statreq++; +++ xtraent++; + + continue; + + + + case 'r': + + rflg = -1; + + continue; + + + + case 't': + + tflg++; + + statreq++; + + continue; + + + + case 'u': + + uflg++; + + continue; + + + + case 'i': - colwidth += 5; +++ fixedwidth += 6; + + iflg++; + + continue; + + + + case 'f': + + fflg++; + + continue; + + + + case 'g': + + gflg++; + + continue; + + - default: +++ case 'F': +++ Fflg++; +++ continue; +++ +++ case 'R': +++ Rflg++; + + continue; +++ +++ default: +++ fprintf (stderr, "usage: ls [-1ACFRabcdfgilmnqrstux] [files]\n"); +++ exit(1); + + } - argc--; + + } +++ if (Fflg) +++#ifdef UCB +++ fixedwidth++; +++#else +++ fixedwidth += 2; +++#endif + + if (fflg) { + + aflg++; + + lflg = 0; + + sflg = 0; + + tflg = 0; + + statreq = 0; +++ xtraent = 0; + + } + + if(lflg) { - cflg = 0; +++ Cflg = 0; + + t = "/etc/passwd"; + + if (gflg) + + t = "/etc/group"; + + nopad = 0; - colwidth = 70; +++ fixedwidth = 70; + + pwdf = fopen(t, "r"); + + } + + if (argc==0) { + + argc++; + + argv = &dotp - 1; + + } + + for (i=0; i < argc; i++) { - if ((ep = gstat(*++argv, 1))==NULL) +++ argv++; +++ if (Cflg) { +++ width = strlen (*argv); +++ if (width > filewidth) +++ filewidth = width; +++ } +++ if ((ep = gstat(*argv, 1))==NULL) + + continue; + + ep->ln.namep = *argv; + + ep->lflags |= ISARG; + + } +++ if (!Cflg) +++ filewidth = MAXFILEWIDTH; +++ else +++ colwidth = fixedwidth + filewidth; + + qsort(firstp, lastp - firstp, sizeof *lastp, compar); + + slastp = lastp; +++ /* For each argument user typed */ + + for (epp=firstp; eppltype=='d' && dflg==0 || fflg) { - if (argc>1) - printf("\n%s:\n", ep->ln.namep); - lastp = slastp; - readdir(ep->ln.namep); - if (fflg==0) - qsort(slastp,lastp - slastp,sizeof *lastp,compar); - if (lflg || sflg) - printf("total %D", tblocks); - pem(slastp, lastp); - newline(); - } else +++ if (ep->ltype=='d' && dflg==0 || fflg) +++ pdirectory(ep->ln.namep, (argc>1), slastp); +++ else + + pentry(ep); +++ +++ /* -R: print subdirectories found */ +++ while (dfirst || cdfirst) { +++ /* Place direct subdirs on front in right order */ +++ while (cdfirst) { +++ /* reverse cdfirst onto front of dfirst */ +++ dtemp = cdfirst; +++ cdfirst = cdfirst -> dc_next; +++ dtemp -> dc_next = dfirst; +++ dfirst = dtemp; +++ } +++ /* take off first dir on dfirst & print it */ +++ dtemp = dfirst; +++ dfirst = dfirst->dc_next; +++ pdirectory (dtemp->dc_name, 1, firstp); +++ cfree (dtemp->dc_name); +++ cfree (dtemp); +++ } + + } + + if (outcol) + + putc('\n', stdout); + + fflush(stdout); + +} + + +++/* +++ * pdirectory: print the directory name, labelling it if title is +++ * nonzero, using lp as the place to start reading in the dir. +++ */ +++pdirectory (name, title, lp) +++char *name; +++int title; +++struct lbuf **lp; +++{ +++ register struct dchain *dp; +++ register struct lbuf *ap; +++ register char *pname; +++ struct lbuf **app; +++ +++ filewidth = 0; +++ curdir = name; +++ if (title) +++ printf("\n%s:\n", name); +++ lastp = lp; +++ readdir(name); +++ if (!Cflg) +++ filewidth = MAXFILEWIDTH; +++ colwidth = fixedwidth + filewidth; +++#ifdef notdef +++ /* Taken out because it appears this is done below in pem. */ +++ if (tabflg) { +++ if (colwidth <= 8) +++ colwidth = 8; +++ else +++ if (colwidth <= 16) +++ colwidth = 16; +++ } +++#endif +++ if (fflg==0) +++ qsort(lp,lastp - lp,sizeof *lastp,compar); +++ if (Rflg) for (app=lastp-1; app>=lp; app--) { +++ ap = *app; +++ if (ap->ltype == 'd' && strcmp(ap->ln.lname, ".") && +++ strcmp(ap->ln.lname, "..")) { +++ dp = (struct dchain *) calloc(1, sizeof(struct dchain)); +++ pname = makename (curdir, ap->ln.lname); +++ dp->dc_name = (char *) calloc(1, strlen(pname)+1); +++ strcpy(dp->dc_name, pname); +++ dp -> dc_next = dfirst; +++ dfirst = dp; +++ } +++ } +++ if (lflg || sflg) +++ printf("total %D", tblocks); +++ pem(lp, lastp); +++ newline(); +++} +++ +++/* +++ * pem: print 'em. Print a list of files (e.g. a directory) bounded +++ * by slp and lp. +++ */ + +pem(slp, lp) + + register struct lbuf **slp, **lp; + +{ + + int ncols, nrows, row, col; + + register struct lbuf **ep; + + +++ if (tabflg) { +++ if (colwidth <= 9) +++ colwidth = 8; +++ else +++ if (colwidth <= 17) +++ colwidth = 16; +++ } + + ncols = 80 / colwidth; - if (ncols == 1 || cflg == 0) { +++ if (ncols == 1 || Cflg == 0) { + + for (ep = slp; ep < lp; ep++) + + pentry(*ep); + + return; + + } + + if (across) { + + for (ep = slp; ep < lp; ep++) + + pentry(*ep); + + return; + + } - if (statreq) +++ if (xtraent) + + slp--; + + nrows = (lp - slp - 1) / ncols + 1; + + for (row = 0; row < nrows; row++) { - col = row == 0 && statreq; +++ col = row == 0 && xtraent; + + for (; col < ncols; col++) { + + ep = slp + (nrows * col) + row; + + if (ep < lp) + + pentry(*ep); + + } + + if (outcol) + + printf("\n"); + + } + +} + + +++/* +++ * pputchar: like putchar but knows how to handle control chars. +++ * CAUTION: if you make ctrl chars print in ^x notation, or any +++ * other notation which is wider than one character, the column +++ * nature of things (such as files with 14 letter names) will be +++ * messed up. Weigh this carefully! +++ */ + +pputchar(c) + + char c; + +{ +++ char cc; + + + + switch (c) { + + case '\t': + + outcol = (outcol + 8) &~ 7; + + break; + + case '\n': + + outcol = 0; + + break; + + default: - if (qflg && (c < ' ' || c >= 0177)) - c = '?'; +++ if (c < ' ' || c >= 0177) { +++ if (qflg) +++ c = '?'; +++ else if (bflg) { +++ outcol += 3; +++ putc ('\\', stdout); +++ cc = '0' + (c>>6 & 07); +++ putc (cc, stdout); +++ cc = '0' + (c>>3 & 07); +++ putc (cc, stdout); +++ c = '0' + (c & 07); +++ } +++ } + + outcol++; + + break; + + } + + putc(c, stdout); + +} + + + +newline() + +{ + + if (outcol) + + putc('\n', stdout); + + outcol = 0; + +} + + +++/* +++ * column: get to the beginning of the next column. +++ */ + +column() + +{ + + + + if (outcol == 0) + + return; + + if (nopad) { + + putc(',', stdout); + + outcol++; + + if (outcol + colwidth + 2 > 80) { + + putc('\n', stdout); + + outcol = 0; + + return; + + } + + putc(' ', stdout); + + outcol++; + + return; + + } - if (cflg == 0) { +++ if (Cflg == 0) { + + putc('\n', stdout); + + return; + + } + + if ((outcol / colwidth + 2) * colwidth > 80) { + + putc('\n', stdout); + + outcol = 0; + + return; + + } +++ if (tabflg && (colwidth <= 16)) { +++ if (colwidth > 8) +++ if ((outcol % 16) < 8) { +++ outcol += 8 - (outcol % 8); +++ putc ('\t', stdout); +++ } +++ outcol += 8 - (outcol % 8); +++ putc ('\t', stdout); +++ return; +++ } + + do { + + outcol++; + + putc(' ', stdout); + + } while (outcol % colwidth); + +} + + + + - getname(uid, buf) - int uid; - char buf[]; - { - int j, c, n, i; - - if (uid==lastuid) - return(0); - if(pwdf == NULL) - return(-1); - rewind(pwdf); - lastuid = -1; - do { - i = 0; - j = 0; - n = 0; - while((c=fgetc(pwdf)) != '\n') { - if (c==EOF) - return(-1); - if (c==':') { - j++; - c = '0'; - } - if (j==0) - buf[i++] = c; - if (j==2) - n = n*10 + c - '0'; - } - } while (n != uid); - buf[i++] = '\0'; - lastuid = uid; - return(0); - } - +++/* +++ * nblock: the number of 512 byte blocks a size byte file takes up. +++ * (Note: the number stays 512 no matter what BUFSIZ or the filesystem uses.) +++ */ + +long + +nblock(size) + +long size; + +{ + + return((size+511)>>9); + +} + + +++/* +++ * This code handles the rwx- business. +++ * You figure it out. +++ */ + +int m1[] = { 1, S_IREAD>>0, 'r', '-' }; + +int m2[] = { 1, S_IWRITE>>0, 'w', '-' }; + +int m3[] = { 2, S_ISUID, 's', S_IEXEC>>0, 'x', '-' }; + +int m4[] = { 1, S_IREAD>>3, 'r', '-' }; + +int m5[] = { 1, S_IWRITE>>3, 'w', '-' }; + +int m6[] = { 2, S_ISGID, 's', S_IEXEC>>3, 'x', '-' }; + +int m7[] = { 1, S_IREAD>>6, 'r', '-' }; + +int m8[] = { 1, S_IWRITE>>6, 'w', '-' }; + +int m9[] = { 2, S_ISVTX, 't', S_IEXEC>>6, 'x', '-' }; + + + +int *m[] = { m1, m2, m3, m4, m5, m6, m7, m8, m9}; + + + +pmode(aflag) + +{ + + register int **mp; + + + + flags = aflag; + + for (mp = &m[0]; mp < &m[sizeof(m)/sizeof(m[0])];) + + select(*mp++); + +} + + + +select(pairp) + +register int *pairp; + +{ + + register int n; + + + + n = *pairp++; + + while (--n>=0 && (flags&*pairp++)==0) + + pairp++; + + pputchar(*pairp); + +} + + +++/* +++ * returns cat(dir, "/", file), unless dir ends in /, when it doesn't // +++ */ + +char * + +makename(dir, file) + +char *dir, *file; + +{ + + static char dfile[100]; + + register char *dp, *fp; + + register int i; + + + + dp = dfile; + + fp = dir; + + while (*fp) + + *dp++ = *fp++; +++ if (*(dp-1) != '/') + + *dp++ = '/'; + + fp = file; + + for (i=0; i filewidth) +++ filewidth = width; +++ } +++ ep = gstat(makename(dir, dentry.d_name), Fflg || Rflg); + + if (ep==NULL) + + continue; + + if (ep->lnum != -1) + + ep->lnum = dentry.d_ino; + + for (j=0; jln.lname[j] = dentry.d_name[j]; + + } + + fclose(dirf); + +} + + +++/* +++ * stat the given file and return an lbuf containing it. +++ * argfl is nonzero if a stat is required because the file is +++ * an argument, rather than having been found in a directory. +++ */ + +struct lbuf * + +gstat(file, argfl) + +char *file; + +{ + + struct stat statb; + + register struct lbuf *rep; + + static int nomocore; + + + + if (nomocore) + + return(NULL); + + rep = (struct lbuf *)malloc(sizeof(struct lbuf)); + + if (rep==NULL) { + + fprintf(stderr, "ls: out of memory\n"); + + nomocore = 1; + + return(NULL); + + } + + if (lastp >= &flist[NFILES]) { + + static int msg; + + lastp--; + + if (msg==0) { + + fprintf(stderr, "ls: too many files\n"); + + msg++; + + } + + } + + *lastp++ = rep; + + rep->lflags = 0; + + rep->lnum = 0; + + rep->ltype = '-'; + + if (argfl || statreq) { + + if (stat(file, &statb)<0) { + + printf("%s not found\n", file); + + statb.st_ino = -1; + + statb.st_size = 0; + + statb.st_mode = 0; + + if (argfl) { + + lastp--; + + return(0); + + } + + } + + rep->lnum = statb.st_ino; + + rep->lsize = statb.st_size; + + switch(statb.st_mode&S_IFMT) { + + + + case S_IFDIR: + + rep->ltype = 'd'; + + break; + + + + case S_IFBLK: + + rep->ltype = 'b'; + + rep->lsize = statb.st_rdev; + + break; + + + + case S_IFCHR: + + rep->ltype = 'c'; + + rep->lsize = statb.st_rdev; + + break; +++ +++ case S_IFMPB: +++ rep->ltype = 'M'; +++ rep->lsize = statb.st_rdev; +++ break; +++ +++ case S_IFMPC: +++ rep->ltype = 'm'; +++ rep->lsize = statb.st_rdev; +++ break; + + } + + rep->lflags = statb.st_mode & ~S_IFMT; + + rep->luid = statb.st_uid; + + rep->lgid = statb.st_gid; + + rep->lnl = statb.st_nlink; + + if(uflg) + + rep->lmtime = statb.st_atime; + + else if (cflg) + + rep->lmtime = statb.st_ctime; + + else + + rep->lmtime = statb.st_mtime; + + tblocks += nblock(statb.st_size); + + } + + return(rep); + +} + + +++/* +++ * decide whether to print pp1 before or after pp2, based on their +++ * names, various times, and the r flag. +++ */ + +compar(pp1, pp2) + +struct lbuf **pp1, **pp2; + +{ + + register struct lbuf *p1, *p2; + + + + p1 = *pp1; + + p2 = *pp2; + + if (dflg==0) { + + if (p1->lflags&ISARG && p1->ltype=='d') { + + if (!(p2->lflags&ISARG && p2->ltype=='d')) + + return(1); + + } else { + + if (p2->lflags&ISARG && p2->ltype=='d') + + return(-1); + + } + + } + + if (tflg) { + + if(p2->lmtime == p1->lmtime) + + return(0); + + if(p2->lmtime > p1->lmtime) + + return(rflg); + + return(-rflg); + + } + + return(rflg * strcmp(p1->lflags&ISARG? p1->ln.namep: p1->ln.lname, + + p2->lflags&ISARG? p2->ln.namep: p2->ln.lname)); + +} +++ +++/* +++ * print the entry pointed at by ap +++ */ + +pentry(ap) + +struct lbuf *ap; + +{ + + struct { char dminor, dmajor;}; - register t; + + register struct lbuf *p; + + register char *cp; +++ char fname[100]; +++ char *pname; +++ struct passwd *getpwuid(); +++ struct passwd *pwptr; +++ struct group *getgrgid(); +++ struct group *grptr; + + +++ fname[0] = 0; + + p = ap; + + if (p->lnum == -1) + + return; + + column(); + + if (iflg) + + if (nopad && !lflg) + + printf("%d ", p->lnum); + + else + + printf("%5d ", p->lnum); + + if (sflg) + + if (nopad && !lflg) + + printf("%D ", nblock(p->lsize)); + + else + + printf("%4D ", nblock(p->lsize)); + + if (lflg) { + + pputchar(p->ltype); + + pmode(p->lflags); + + printf("%2d ", p->lnl); - t = p->luid; - if(gflg) - t = p->lgid; - if (nflg == 0 && getname(t, tbuf)==0) - printf("%-8.8s", tbuf); - else - printf("%-8d", t); - if (p->ltype=='b' || p->ltype=='c') - printf("%3d,%3d", major((int)p->lsize), minor((int)p->lsize)); - else +++ if(gflg) { +++ grptr = getgrgid(p->lgid); +++ if (nflg == 0 && grptr != 0) +++ printf("%-8.8s", grptr->gr_name); +++ else +++ printf("%-8d", p->lgid); +++ } else { +++#ifndef UCB_PWHASH +++ char *name; +++ if (nflg == 0 && (name = getname(p->luid))) { +++ printf("%-8.8s", name); +++ } +++#else +++ pwptr = getpwuid(p->luid); +++ if (nflg == 0 && pwptr != 0) +++ printf("%-8.8s", pwptr->pw_name); +++#endif +++ else +++ printf("%-8d", p->luid); +++ } +++ switch (p->ltype) { +++ +++ case 'b': +++ case 'c': +++ case 'm': +++ case 'M': +++ printf("%3d,%3d", +++ major((int)p->lsize), minor((int)p->lsize)); +++ break; +++ default: + + printf("%7ld", p->lsize); +++ } + + cp = ctime(&p->lmtime); + + if(p->lmtime < year) + + printf(" %-7.7s %-4.4s ", cp+4, cp+20); else + + printf(" %-12.12s ", cp+4); + + } - if (p->lflags&ISARG) - printf("%s", p->ln.namep); +++#ifndef UCB +++ if (Fflg) { +++ if (p->ltype == 'd') +++ strcat (fname, "["); +++ else if (p->lflags & 0111) +++ strcat (fname, "*"); +++ else if (!nopad) +++ strcat (fname, " "); +++ } +++#endif +++ if (p->lflags & ISARG) +++ strncat (fname, p->ln.namep, 98); + + else - printf("%.14s", p->ln.lname); +++ strncat (fname, p->ln.lname, 14); +++#ifndef UCB +++ if (Fflg) { +++ if (p->ltype == 'd') +++ strcat (fname, "]"); +++ else if (!nopad) +++ strcat (fname, " "); +++ } +++#else +++ if (Fflg) { +++ if (p->ltype == 'd') +++ strcat (fname, "/"); +++ else if (p->lflags & 0111) +++ strcat (fname, "*"); +++ else if (!nopad) +++ strcat (fname, " "); +++ } +++#endif +++ printf ("%s", fname); +++ free(ap); + +} +++ + +/* char printf_id[] = "@(#) printf.c:2.2 6/5/79";*/ +++ + +#include "varargs.h" - /* This version of printf is compatible with the Version 7 C +++ +++/* +++ * This version of printf is compatible with the Version 7 C + + * printf. The differences are only minor except that this + + * printf assumes it is to print through pputchar. Version 7 + + * printf is more general (and is much larger) and includes + + * provisions for floating point. + + */ - + + - #define MAXOCT 11 /* Maximum octal digits in a long */ - #define MAXINT 32767 /* largest normal length positive integer */ +++#define MAXOCT 11 /* Maximum octal digits in a long */ +++#define MAXINT 32767 /* largest normal length positive integer */ + +#define BIG 1000000000 /* largest power of 10 less than an unsigned long */ - #define MAXDIGS 10 /* number of digits in BIG */ +++#define MAXDIGS 10 /* number of digits in BIG */ + + + +static int width, sign, fill; + + + +char *b_dconv(); + + + +printf(va_alist) + + va_dcl + +{ + + va_list ap; + + register char *fmt; + + char fcode; + + int prec; + + int length,mask1,nbits,n; + + long int mask2, num; + + register char *bptr; + + char *ptr; + + char buf[134]; + + + + va_start(ap); + + fmt = va_arg(ap,char *); + + for (;;) { + + /* process format string first */ + + while ((fcode = *fmt++)!='%') { + + /* ordinary (non-%) character */ + + if (fcode=='\0') + + return; + + pputchar(fcode); + + } + + /* length modifier: -1 for h, 1 for l, 0 for none */ + + length = 0; + + /* check for a leading - sign */ + + sign = 0; + + if (*fmt == '-') { + + sign++; + + fmt++; + + } + + /* a '0' may follow the - sign */ + + /* this is the requested fill character */ + + fill = 1; + + if (*fmt == '0') { + + fill--; + + fmt++; + + } + + + + /* Now comes a digit string which may be a '*' */ + + if (*fmt == '*') { + + width = va_arg(ap, int); + + if (width < 0) { + + width = -width; + + sign = !sign; + + } + + fmt++; + + } + + else { + + width = 0; + + while (*fmt>='0' && *fmt<='9') + + width = width * 10 + (*fmt++ - '0'); + + } + + + + /* maybe a decimal point followed by more digits (or '*') */ + + if (*fmt=='.') { + + if (*++fmt == '*') { + + prec = va_arg(ap, int); + + fmt++; + + } + + else { + + prec = 0; + + while (*fmt>='0' && *fmt<='9') + + prec = prec * 10 + (*fmt++ - '0'); + + } + + } + + else + + prec = -1; + + + + /* + + * At this point, "sign" is nonzero if there was + + * a sign, "fill" is 0 if there was a leading + + * zero and 1 otherwise, "width" and "prec" + + * contain numbers corresponding to the digit + + * strings before and after the decimal point, + + * respectively, and "fmt" addresses the next + + * character after the whole mess. If there was + + * no decimal point, "prec" will be -1. + + */ + + switch (*fmt) { + + case 'L': + + case 'l': + + length = 2; + + /* no break!! */ + + case 'h': + + case 'H': + + length--; + + fmt++; + + break; + + } + + + + /* + + * At exit from the following switch, we will + + * emit the characters starting at "bptr" and + + * ending at "ptr"-1, unless fcode is '\0'. + + */ + + switch (fcode = *fmt++) { + + /* process characters and strings first */ + + case 'c': + + buf[0] = va_arg(ap, int); + + ptr = bptr = &buf[0]; + + if (buf[0] != '\0') + + ptr++; + + break; + + case 's': + + bptr = va_arg(ap,char *); + + if (bptr==0) + + bptr = "(null pointer)"; + + if (prec < 0) + + prec = MAXINT; + + for (n=0; *bptr++ && n < prec; n++) ; + + ptr = --bptr; + + bptr -= n; + + break; + + case 'O': + + length = 1; + + fcode = 'o'; + + /* no break */ + + case 'o': + + case 'X': + + case 'x': + + if (length > 0) + + num = va_arg(ap,long); + + else + + num = (unsigned)va_arg(ap,int); + + if (fcode=='o') { + + mask1 = 0x7; + + mask2 = 0x1fffffffL; + + nbits = 3; + + } + + else { + + mask1 = 0xf; + + mask2 = 0x0fffffffL; + + nbits = 4; + + } + + n = (num!=0); + + bptr = buf + MAXOCT + 3; + + /* shift and mask for speed */ + + do + + if (((int) num & mask1) < 10) - *--bptr = ((int) num & mask1) + 060; +++ *--bptr = ((int) num & mask1) + 060; + + else + + *--bptr = ((int) num & mask1) + 0127; + + while (num = (num >> nbits) & mask2); + + + + if (fcode=='o') { + + if (n) + + *--bptr = '0'; + + } + + else + + if (!sign && fill <= 0) { + + pputchar('0'); + + pputchar(fcode); + + width -= 2; + + } + + else { + + *--bptr = fcode; + + *--bptr = '0'; + + } + + ptr = buf + MAXOCT + 3; + + break; + + case 'D': + + case 'U': + + case 'I': + + length = 1; - fcode = fcode + 'a' - 'A'; +++ +++ fcode = fcode + 'a' - 'A'; + + /* no break */ + + case 'd': + + case 'i': + + case 'u': + + if (length > 0) + + num = va_arg(ap,long); + + else { + + n = va_arg(ap,int); + + if (fcode=='u') + + num = (unsigned) n; + + else + + num = (long) n; + + } + + if (n = (fcode != 'u' && num < 0)) + + num = -num; + + /* now convert to digits */ + + bptr = b_dconv(num, buf); + + if (n) + + *--bptr = '-'; + + if (fill == 0) + + fill = -1; + + ptr = buf + MAXDIGS + 1; + + break; + + default: + + /* not a control character, + + * print it. + + */ + + ptr = bptr = &fcode; + + ptr++; + + break; + + } + + if (fcode != '\0') + + b_emit(bptr,ptr); + + } + + va_end(ap); + +} + + + +/* b_dconv converts the unsigned long integer "value" to + + * printable decimal and places it in "buffer", right-justified. + + * The value returned is the address of the first non-zero character, + + * or the address of the last character if all are zero. + + * The result is NOT null terminated, and is MAXDIGS characters long, + + * starting at buffer[1] (to allow for insertion of a sign). + + * + + * This program assumes it is running on 2's complement machine + + * with reasonable overflow treatment. + + */ + +char * + +b_dconv(value, buffer) + + long value; + + char *buffer; + +{ + + register char *bp; + + register int svalue; + + int n; + + long lval; + + + + bp = buffer; + + + + /* zero is a special case */ + + if (value == 0) { + + bp += MAXDIGS; + + *bp = '0'; + + return(bp); + + } + + + + /* develop the leading digit of the value in "n" */ + + n = 0; + + while (value < 0) { + + value -= BIG; /* will eventually underflow */ + + n++; + + } + + while ((lval = value - BIG) >= 0) { + + value = lval; + + n++; + + } + + + + /* stash it in buffer[1] to allow for a sign */ + + bp[1] = n + '0'; + + /* + + * Now develop the rest of the digits. Since speed counts here, + + * we do it in two loops. The first gets "value" down until it + + * is no larger than MAXINT. The second one uses integer divides + + * rather than long divides to speed it up. + + */ + + bp += MAXDIGS + 1; + + while (value > MAXINT) { + + *--bp = (int)(value % 10) + '0'; + + value /= 10; + + } + + + + /* cannot lose precision */ + + svalue = value; + + while (svalue > 0) { + + *--bp = (svalue % 10) + '0'; + + svalue /= 10; + + } + + + + /* fill in intermediate zeroes if needed */ + + if (buffer[1] != '0') { + + while (bp > buffer + 2) + + *--bp = '0'; + + --bp; + + } + + return(bp); + +} + + + +/* + + * This program sends string "s" to pputchar. The character after + + * the end of "s" is given by "send". This allows the size of the + + * field to be computed; it is stored in "alen". "width" contains the + + * user specified length. If width width) + + width = alen; + + cfill = fill>0? ' ': '0'; + + + + /* we may want to print a leading '-' before anything */ + + if (*s == '-' && fill < 0) { + + pputchar(*s++); + + alen--; + + width--; + + } + + npad = width - alen; + + + + /* emit any leading pad characters */ + + if (!sign) + + while (--npad >= 0) + + pputchar(cfill); + + + + /* emit the string itself */ + + while (--alen >= 0) + + pputchar(*s++); + + + + /* emit trailing pad characters */ + + if (sign) + + while (--npad >= 0) + + pputchar(cfill); + +} +++ +++#ifndef UCB_PWHASH +++#define NUID 2048 +++ +++char names[NUID][NMAX+1]; +++ +++char * +++getname(uid) +++{ +++ register struct passwd *pw; +++ static init; +++ struct passwd *getpwent(); +++ +++ if (uid >= 0 && uid < NUID && names[uid][0]) +++ return (&names[uid][0]); +++ if (init == 2) +++ return (0); +++ if (init == 0) +++ setpwent(), init = 1; +++ while (pw = getpwent()) { +++ if (pw->pw_uid < 0 || pw->pw_uid >= NUID) +++ continue; +++ if (names[pw->pw_uid][0]) +++ continue; +++ strncpy(names[pw->pw_uid], pw->pw_name, NMAX); +++ if (pw->pw_uid == uid) +++ return (&names[uid][0]); +++ } +++ init = 2; +++ endpwent(); +++ return (0); +++} +++#endif diff --cc usr/src/cmd/mail.c index 0000000000,5dce570105,0000000000..9f6a2e1663 mode 000000,100644,000000..100644 --- a/usr/src/cmd/mail.c +++ b/usr/src/cmd/mail.c @@@@ -1,0 -1,774 -1,0 +1,835 @@@@ + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include +++#include +++ +++static char SccsId[] = "@(#)mail.c 4.1 10/1/80"; +++ +++#define DELIVERMAIL "/etc/delivermail" +++ + + + +/*copylet flags */ + + /*remote mail, add rmtmsg */ + +#define REMOTE 1 + + /* zap header and trailing empty line */ + +#define ZAP 3 + +#define ORDINARY 2 + +#define FORWARD 4 + +#define LSIZE 256 + +#define MAXLET 300 /* maximum number of letters */ + +#define MAILMODE (~0644) /* mode of created mail */ +++# ifndef DELIVERMAIL + +#define RMAIL "/usr/net/bin/sendberkmail" + +#define LOCNAM1 "csvax" + +#define LOCNAM2 "ucbvax" + +#define LOCNAM3 "vax" + +#define LOCNAM4 "v" +++# endif + + + +char line[LSIZE]; + +char resp[LSIZE]; + +struct let { + + long adr; + + char change; + +} let[MAXLET]; + +int nlet = 0; + +char lfil[50]; + +long iop, time(); + +char *getenv(); + +char *index(); + +char lettmp[] = "/tmp/maXXXXX"; + +char maildir[] = "/usr/spool/mail/"; - char mailfile[] = "/usr/spool/mail/xxxxxxxxxxxxxxxxxxxxxxx"; +++char mailfile[] = "/usr/spool/mail/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; + +char dead[] = "dead.letter"; + +char *thissys = sysname; + +char *netname = "vax"; + +char forwmsg[] = " forwarded\n"; + +FILE *tmpf; + +FILE *malf; + +char *my_name; + +char *getlogin(); + +struct passwd *getpwuid(); + +int error; + +int changed; + +int forward; + +char from[] = "From "; + +long ftell(); + +int delete(); + +char *ctime(); + +int flgf; + +int flgp; + +int delflg = 1; + +int hseqno; + +jmp_buf sjbuf; +++int rmail; + + + +main(argc, argv) + +char **argv; + +{ + + register i; + + char sobuf[BUFSIZ]; + + + + setbuf(stdout, sobuf); + + mktemp(lettmp); + + unlink(lettmp); + + my_name = getlogin(); + + if (my_name == NULL || strlen(my_name) == 0) { + + struct passwd *pwent; + + pwent = getpwuid(getuid()); + + if (pwent==NULL) + + my_name = "???"; + + else + + my_name = pwent->pw_name; + + } + + if(setjmp(sjbuf)) done(); + + for (i=0; i<20; i++) + + setsig(i, delete); + + tmpf = fopen(lettmp, "w"); + + if (tmpf == NULL) { + + fprintf(stderr, "mail: cannot open %s for writing\n", lettmp); + + done(); + + } +++ if (argv[0][0] == 'r') +++ rmail++; + + if (argv[0][0] != 'r' && /* no favors for rmail*/ - (argc == 1 || argv[1][0] == '-' && !any(argv[1][1], "rh"))) +++ (argc == 1 || argv[1][0] == '-' && !any(argv[1][1], "rhd"))) + + printmail(argc, argv); + + else + + sendmail(argc, argv); + + done(); + +} + + + +setsig(i, f) + +int i; + +int (*f)(); + +{ + + if(signal(i, SIG_IGN)!=SIG_IGN) + + signal(i, f); + +} + + + +any(c, str) + + register int c; + + register char *str; + +{ + + + + while (*str) + + if (c == *str++) + + return(1); + + return(0); + +} + + + +printmail(argc, argv) + +char **argv; + +{ + + int flg, i, j, print; + + char *p, *getarg(); +++ struct stat statb; + + + + setuid(getuid()); + + cat(mailfile, maildir, my_name); +++ if (stat(mailfile, &statb) >= 0 +++ && (statb.st_mode & S_IFMT) == S_IFDIR) { +++ strcat(mailfile, "/"); +++ strcat(mailfile, my_name); +++ } + + for (; argc>1; argv++, argc--) { + + if (argv[1][0]=='-') { + + if (argv[1][1]=='q') + + delflg = 0; + + else if (argv[1][1]=='p') { + + flgp++; + + delflg = 0; + + } else if (argv[1][1]=='f') { + + if (argc>=3) { + + strcpy(mailfile, argv[2]); + + argv++; + + argc--; + + } + + } else if (argv[1][1]=='r') { + + forward = 1; + + } else if (argv[1][1]=='h') { + + forward = 1; + + } else { + + fprintf(stderr, "mail: unknown option %c\n", argv[1][1]); + + done(); + + } + + } else + + break; + + } + + malf = fopen(mailfile, "r"); + + if (malf == NULL) { + + fprintf(stdout, "No mail.\n"); + + return; + + } + + lock(mailfile); + + copymt(malf, tmpf); + + fclose(malf); + + fclose(tmpf); + + unlock(); + + tmpf = fopen(lettmp, "r"); + + + + changed = 0; + + print = 1; + + for (i = 0; i < nlet; ) { + + j = forward ? i : nlet - i - 1; + + if(setjmp(sjbuf)) { + + print=0; + + } else { + + if (print) + + copylet(j, stdout, ORDINARY); + + print = 1; + + } + + if (flgp) { + + i++; + + continue; + + } + + setjmp(sjbuf); + + fprintf(stdout, "? "); + + fflush(stdout); + + if (fgets(resp, LSIZE, stdin) == NULL) + + break; + + switch (resp[0]) { + + + + default: + + fprintf(stderr, "usage\n"); + + case '?': + + print = 0; + + fprintf(stderr, "q\tquit\n"); + + fprintf(stderr, "x\texit without changing mail\n"); + + fprintf(stderr, "p\tprint\n"); + + fprintf(stderr, "s[file]\tsave (default mbox)\n"); + + fprintf(stderr, "w[file]\tsame without header\n"); + + fprintf(stderr, "-\tprint previous\n"); + + fprintf(stderr, "d\tdelete\n"); + + fprintf(stderr, "+\tnext (no delete)\n"); + + fprintf(stderr, "m user\tmail to user\n"); + + fprintf(stderr, "! cmd\texecute cmd\n"); + + break; + + + + case '+': + + case 'n': + + case '\n': + + i++; + + break; + + case 'x': + + changed = 0; + + case 'q': + + goto donep; + + case 'p': + + break; + + case '^': + + case '-': + + if (--i < 0) + + i = 0; + + break; + + case 'y': + + case 'w': + + case 's': + + flg = 0; + + if (resp[1] != '\n' && resp[1] != ' ') { + + printf("illegal\n"); + + flg++; + + print = 0; + + continue; + + } + + if (resp[1] == '\n' || resp[1] == '\0') { + + p = getenv("HOME"); + + if(p != 0) + + cat(resp+1, p, "/mbox"); + + else + + cat(resp+1, "", "mbox"); + + } + + for (p = resp+1; (p = getarg(lfil, p)) != NULL; ) { + + malf = fopen(lfil, "a"); + + if (malf == NULL) { + + fprintf(stdout, "mail: cannot append to %s\n", lfil); + + flg++; + + continue; + + } + + copylet(j, malf, resp[0]=='w'? ZAP: ORDINARY); + + fclose(malf); + + } + + if (flg) + + print = 0; + + else { + + let[j].change = 'd'; + + changed++; + + i++; + + } + + break; + + case 'm': + + flg = 0; + + if (resp[1] == '\n' || resp[1] == '\0') { + + i++; + + continue; + + } + + if (resp[1] != ' ') { + + printf("invalid command\n"); + + flg++; + + print = 0; + + continue; + + } + + for (p = resp+1; (p = getarg(lfil, p)) != NULL; ) + + if (!sendrmt(j, lfil, "/bin/mail")) /* couldn't send it */ + + flg++; + + if (flg) + + print = 0; + + else { + + let[j].change = 'd'; + + changed++; + + i++; + + } + + break; + + case '!': + + system(resp+1); + + printf("!\n"); + + print = 0; + + break; + + case 'd': + + let[j].change = 'd'; + + changed++; + + i++; + + if (resp[1] == 'q') + + goto donep; + + break; + + } + + } + + donep: + + if (changed) + + copyback(); + +} + + + +copyback() /* copy temp or whatever back to /usr/spool/mail */ + +{ + + register i, n, c; + + int new = 0; + + struct stat stbuf; + + + + signal(SIGINT, SIG_IGN); + + signal(SIGHUP, SIG_IGN); + + signal(SIGQUIT, SIG_IGN); + + lock(mailfile); + + stat(mailfile, &stbuf); + + if (stbuf.st_size != let[nlet].adr) { /* new mail has arrived */ + + malf = fopen(mailfile, "r"); + + if (malf == NULL) { + + fprintf(stdout, "mail: can't re-read %s\n", mailfile); + + done(); + + } + + fseek(malf, let[nlet].adr, 0); + + fclose(tmpf); + + tmpf = fopen(lettmp, "a"); + + fseek(tmpf, let[nlet].adr, 0); + + while ((c = fgetc(malf)) != EOF) + + fputc(c, tmpf); + + fclose(malf); + + fclose(tmpf); + + tmpf = fopen(lettmp, "r"); + + let[++nlet].adr = stbuf.st_size; + + new = 1; + + } + + malf = fopen(mailfile, "w"); + + if (malf == NULL) { + + fprintf(stderr, "mail: can't rewrite %s\n", lfil); + + done(); + + } + + n = 0; + + for (i = 0; i < nlet; i++) + + if (let[i].change != 'd') { + + copylet(i, malf, ORDINARY); + + n++; + + } + + fclose(malf); + + if (new) + + fprintf(stdout, "new mail arrived\n"); + + unlock(); + +} + + + +copymt(f1, f2) /* copy mail (f1) to temp (f2) */ + +FILE *f1, *f2; + +{ + + long nextadr; + + + + nlet = nextadr = 0; + + let[0].adr = 0; + + while (fgets(line, LSIZE, f1) != NULL) { + + if (isfrom(line)) + + let[nlet++].adr = nextadr; + + nextadr += strlen(line); + + fputs(line, f2); + + } + + let[nlet].adr = nextadr; /* last plus 1 */ + +} + + + +copylet(n, f, type) FILE *f; + +{ int ch, k; + + fseek(tmpf, let[n].adr, 0); + + k = let[n+1].adr - let[n].adr; + + while(k-- > 1 && (ch=fgetc(tmpf))!='\n') + + if(type!=ZAP) fputc(ch,f); + + if(type==REMOTE) + + fprintf(f, " remote from %s\n", thissys); + + else if (type==FORWARD) + + fprintf(f, forwmsg); + + else if(type==ORDINARY) + + fputc(ch,f); + + while(k-->1) + + fputc(ch=fgetc(tmpf), f); + + if(type!=ZAP || ch!= '\n') + + fputc(fgetc(tmpf), f); + +} + + + +isfrom(lp) + +register char *lp; + +{ + + register char *p; + + + + for (p = from; *p; ) + + if (*lp++ != *p++) + + return(0); + + return(1); + +} + + + +sendmail(argc, argv) + +char **argv; + +{ + + char truename[100]; + + int first; + + register char *cp; + + int gaver = 0; +++# ifdef DELIVERMAIL +++ char *newargv[1000]; +++ register char **ap; +++ register char **vp; +++ int dflag; +++ +++ dflag = 0; +++ if (argc < 1) +++ fprintf(stderr, "puke\n"); +++ for (vp = argv, ap = newargv + 1; (*ap = *vp++) != 0; ap++) +++ { +++ if (ap[0][0] == '-' && ap[0][1] == 'd') +++ dflag++; +++ } +++ if (!dflag) +++ { +++ /* give it to delivermail, rah rah! */ +++ unlink(lettmp); +++ ap = newargv+1; +++ if (rmail) +++ *ap-- = "-s"; +++ *ap = "-delivermail"; +++ execv(DELIVERMAIL, ap); +++ perror(DELIVERMAIL); +++ exit(EX_UNAVAILABLE); +++ } +++# endif DELIVERMAIL + + + + truename[0] = 0; + + line[0] = '\0'; + + + + /* + + * When we fall out of this, argv[1] should be first name, + + * argc should be number of names + 1. + + */ + + + + while (argc > 1 && *argv[1] == '-') { + + cp = *++argv; + + argc--; + + switch (cp[1]) { + + case 'r': + + if (argc <= 0) { + + usage(); + + done(); + + } + + gaver++; + + strcpy(truename, argv[1]); + + fgets(line, LSIZE, stdin); + + if (strcmpn("From", line, 4) == 0) + + line[0] = '\0'; + + argv++; + + argc--; + + break; + + + + case 'h': + + if (argc <= 0) { + + usage(); + + done(); + + } + + hseqno = atoi(argv[1]); + + argv++; + + argc--; + + break; + + +++# ifdef DELIVERMAIL +++ case 'd': +++ break; +++# endif DELIVERMAIL +++ + + default: + + usage(); + + done(); + + } + + } + + if (argc <= 1) { + + usage(); + + done(); + + } + + if (gaver == 0) + + strcpy(truename, my_name); + + /* + + if (argc > 4 && strcmp(argv[1], "-r") == 0) { + + strcpy(truename, argv[2]); + + argc -= 2; + + argv += 2; + + fgets(line, LSIZE, stdin); + + if (strcmpn("From", line, 4) == 0) + + line[0] = '\0'; + + } else + + strcpy(truename, my_name); + + */ + + time(&iop); + + fprintf(tmpf, "%s%s %s", from, truename, ctime(&iop)); + + iop = ftell(tmpf); + + flgf = 1; + + for (first = 1;; first = 0) { + + if (first && line[0] == '\0' && fgets(line, LSIZE, stdin) == NULL) + + break; + + if (!first && fgets(line, LSIZE, stdin) == NULL) + + break; + + if (line[0] == '.' && line[1] == '\n' && isatty(fileno(stdin))) + + break; + + if (isfrom(line)) + + fputs(">", tmpf); + + fputs(line, tmpf); + + flgf = 0; + + } + + fputs("\n", tmpf); + + nlet = 1; + + let[0].adr = 0; + + let[1].adr = ftell(tmpf); + + fclose(tmpf); + + if (flgf) + + return; + + tmpf = fopen(lettmp, "r"); + + if (tmpf == NULL) { + + fprintf(stderr, "mail: cannot reopen %s for reading\n", lettmp); + + return; + + } + + while (--argc > 0) + + if (!send(0, *++argv, truename)) + + error++; + + if (error) { + + setuid(getuid()); + + malf = fopen(dead, "w"); + + if (malf == NULL) { + + fprintf(stdout, "mail: cannot open %s\n", dead); + + fclose(tmpf); + + return; + + } + + copylet(0, malf, ZAP); + + fclose(malf); + + fprintf(stdout, "Mail saved in %s\n", dead); + + } + + fclose(tmpf); + +} + + + +sendrmt(n, name, rcmd) + +char *name; + +char *rcmd; + +{ + + FILE *rmf, *popen(); + + register char *p; + + char rsys[64], cmd[64]; + + register local, pid; + + int sts; + + + + local = 0; + + if (index(name, '^')) { + + while (p = index(name, '^')) + + *p = '!'; + + if (strncmp(name, "researc", 7)) { + + strcpy(rsys, "research"); + + if (*name != '!') + + --name; + + goto skip; + + } + + } + + if (*name=='!') + + name++; + + for(p=rsys; *name!='!'; *p++ = *name++) + + if (*name=='\0') { + + local++; + + break; + + } + + *p = '\0'; + + if ((!local && *name=='\0') || (local && *rsys=='\0')) { + + fprintf(stdout, "null name\n"); + + return(0); + + } + +skip: + + if ((pid = fork()) == -1) { + + fprintf(stderr, "mail: can't create proc for remote\n"); + + return(0); + + } + + if (pid) { + + while (wait(&sts) != pid) { + + if (wait(&sts)==-1) + + return(0); + + } + + return(!sts); + + } + + setuid(getuid()); + + if (local) + + sprintf(cmd, "%s %s", rcmd, rsys); + + else { + + if (index(name+1, '!')) + + sprintf(cmd, "uux - %s!rmail \\(%s\\)", rsys, name+1); + + else + + sprintf(cmd, "uux - %s!rmail %s", rsys, name+1); + + } + + if ((rmf=popen(cmd, "w")) == NULL) + + exit(1); + + copylet(n, rmf, local ? !strcmp(rcmd, "/bin/mail") ? FORWARD : ORDINARY : REMOTE); + + pclose(rmf); + + exit(0); + +} + + +++# ifndef DELIVERMAIL + +/* + + * Send mail on the Berkeley network. + + * Sorry Bill, sendrmt() is so awful we just gave up. + + */ + + + +sendberkmail(n, name, fromaddr) + + char name[]; + + char fromaddr[]; + +{ + + char cmd[200]; + + register FILE *cmdf; + + + + sprintf(cmd, "%s -h %d -f %s -t %s", RMAIL, hseqno, fromaddr, name); + + if ((cmdf = popen(cmd, "w")) == NULL) { + + perror(RMAIL); + + return(0); + + } + + copylet(n, cmdf, ORDINARY); + + pclose(cmdf); + + return(9); + +} +++# endif + + + +usage() + +{ + + + + fprintf(stderr, "Usage: mail [ -f ] people . . .\n"); + +} + + + +send(n, name, fromaddr) + +int n; + +char *name; + +char *fromaddr; + +{ - char file[50]; +++ char file[100]; + + register char *p; + + register mask; + + struct passwd *pw, *getpwnam(); +++ struct stat statb; + + +++# ifndef DELIVERMAIL + + stripfx(LOCNAM1, &name); + + stripfx(LOCNAM2, &name); + + stripfx(LOCNAM3, &name); + + stripfx(LOCNAM4, &name); + + if(*name == ':')name++; /* skip colon in to-name */ - for(p=name; *p!=':' &&*p!='\0'; p++); +++ for(p=name; *p!=':' && *p!='!' && *p!='^' &&*p!='\0'; p++); + + /* if(*p == ':') return(sendrmt(n, name, RMAIL)); */ + + if (*p == ':') + + return(sendberkmail(n, name, fromaddr)); - else if (strcmp(name, "msgs") == 0) return(sendrmt(n, "-s", "/usr/ucb/msgs")); +++ else if (*p=='\0' && strcmp(name, "msgs") == 0) +++ return(sendrmt(n, "-s", "/usr/ucb/msgs")); +++# endif + + for(p=name; *p!='!'&&*p!='^' &&*p!='\0'; p++) + + ; + + if (*p == '!'|| *p=='^') + + return(sendrmt(n, name, 0)); + + if ((pw = getpwnam(name)) == NULL) { + + fprintf(stdout, "mail: can't send to %s\n", name); + + return(0); + + } + + cat(file, maildir, name); +++ if (stat(file, &statb) >= 0 && (statb.st_mode & S_IFMT) == S_IFDIR) { +++ strcat(file, "/"); +++ strcat(file, name); +++ } + + mask = umask(MAILMODE); + + malf = fopen(file, "a"); + + umask(mask); + + if (malf == NULL) { + + fprintf(stdout, "mail: cannot append to %s\n", file); + + return(0); + + } + + lock(file); + + chown(file, pw->pw_uid, pw->pw_gid); + + copylet(n, malf, ORDINARY); + + fclose(malf); + + unlock(); + + return(1); + +} + + + +delete(i) + +{ + + setsig(i, delete); + + fprintf(stderr, "\n"); + + if(delflg) + + longjmp(sjbuf, 1); + + done(); + +} + + + +/* + + * Lock the specified mail file by setting the file mailfile.lock. + + * We must, of course, be careful to unlink the lock file by a call + + * to unlock before we stop. The algorithm used here is to see if + + * the lock exists, and if it does, to check its modify time. If it + + * is older than 30 seconds, we assume error and set our own file. + + * Otherwise, we wait for 5 seconds and try again. + + */ + + + +char *maillock = ".lock"; /* Lock suffix for mailname */ + +char *lockname = "/usr/spool/mail/tmXXXXXX"; + +char locktmp[30]; /* Usable lock temporary */ + +char curlock[50]; /* Last used name of lock */ + +int locked; /* To note that we locked it */ + + + +lock(file) + +char *file; + +{ + + register int f; + + struct stat sbuf; + + long curtime; + + int statfailed; + + + + if (locked || flgf) + + return(0); + + strcpy(curlock, file); + + strcat(curlock, maillock); + + strcpy(locktmp, lockname); + + mktemp(locktmp); + + unlink(locktmp); + + statfailed = 0; + + for (;;) { + + f = lock1(locktmp, curlock); + + if (f == 0) { + + locked = 1; + + return(0); + + } + + if (stat(curlock, &sbuf) < 0) { + + if (statfailed++ > 5) + + return(-1); + + sleep(5); + + continue; + + } + + statfailed = 0; + + time(&curtime); + + if (curtime < sbuf.st_ctime + 30) { + + sleep(5); + + continue; + + } + + unlink(curlock); + + } + +} + + + +/* + + * Remove the mail lock, and note that we no longer + + * have it locked. + + */ + + + +unlock() + +{ + + + + unlink(curlock); + + locked = 0; + +} + + + +/* + + * Attempt to set the lock by creating the temporary file, + + * then doing a link/unlink. If it fails, return -1 else 0 + + */ + + + +lock1(tempfile, name) + + char tempfile[], name[]; + +{ + + register int fd; + + + + fd = creat(tempfile, 0); + + if (fd < 0) + + return(-1); + + close(fd); + + if (link(tempfile, name) < 0) { + + unlink(tempfile); + + return(-1); + + } + + unlink(tempfile); + + return(0); + +} + + + +done() + +{ + + if(locked) + + unlock(); + + unlink(lettmp); + + unlink(locktmp); + + exit(error); + +} + + + +cat(to, from1, from2) + +char *to, *from1, *from2; + +{ + + int i, j; + + + + j = 0; + + for (i=0; from1[i]; i++) + + to[j++] = from1[i]; + + for (i=0; from2[i]; i++) + + to[j++] = from2[i]; + + to[j] = 0; + +} + + + +char *getarg(s, p) /* copy p... into s, update p */ + +register char *s, *p; + +{ + + while (*p == ' ' || *p == '\t') + + p++; + + if (*p == '\n' || *p == '\0') + + return(NULL); + + while (*p != ' ' && *p != '\t' && *p != '\n' && *p != '\0') + + *s++ = *p++; + + *s = '\0'; + + return(p); + +} +++# ifndef DELIVERMAIL + +/* + + stripfx(prefix string, pointer to string) + + + + takes a ptr to string and compares it to prefix string. + + may be called multiple times + +*/ + +stripfx(pfx, name) + + char *pfx; + + char **name; + +{ + + register char *cp = *name; + + + + while (*pfx && (*cp == *pfx || *cp == toupper(*pfx))) + + cp++, pfx++; + + if (*cp != ':' || *pfx != 0) + + return; + + *name = cp; + +} +++# endif diff --cc usr/src/cmd/make/ident.c index 0000000000,722995424a,0000000000..17069ff0c6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/make/ident.c +++ b/usr/src/cmd/make/ident.c @@@@ -1,0 -1,99 -1,0 +1,100 @@@@ - char *xxxvers = "\nMAKE. VERSION 2.60 28 JANUARY 1980\n" ; +++char *xxxvers = "\n@(#) MAKE. VERSION 2.61 13 AUGUST 1980\n" ; + + + +/* + +2.1 4/24/76 Base version + + + +2.2 4/26/76 Error found by SRB in overriding pattern rules; + + corrected gram.y + + + +2.3 4/27/76 Further correction for overriding pattern rules; + + corrected doname.c + + + +2.4 Removed .CLEAR name, added .IGNORE. + + A .SUFFIXES rule without dependents clears the list + + + +2.5 Stripped output + + + +2.6 Changed doshell to accomodate new shell. + + + +2.7 Following SRB's sugestion, added ${...} as + + alternate macro name + + + +2.8 Defined macros AS and DTGEN in files.c. + + + +2.9 Put in a fix to prevent removal of files + + upon interrupt in a :: rule. + + + +2.10 Fixed bugs involving messages for :: + + and closing standard input + + + +2.11 Changed time test from <= to < + + (equal times are considered in sync) + + + +2.12 Installed -t flag (touch and update time of + + files rather than issue commands) + + Fixed bug in dosys + + + +2.13 Fixed lex.c to allow sharps (#) in commands + + + +2.14 Added .DEFAULT rule + + + +2.15 Changed to I/O System (stdio.h) + + + +2.16 Removed references to double floats and macro HAVELONGS; + + committed to use of long ints for times. + +2.17 Corrected metacharacter list in dosys.c. + +2.18 Miscellaneous fixes + +2.19 Updated files.c to use include file stat.h + +2.20 Added -q flag for Mike Lesk + +2.21 Added AWK rules and .w suffix to files.c + +2.22 Added colon to the list of metacharacters + +2.23 Macro substitutions on dependency lines. + + Redid argument and macro setting. + + Close files before exec'ing. + + Print > at beginning of command lines. + + No printing of commands beginnng with @. + +2.24 Parametrized propt sequence in doname.c (4/1/77) + +2.25 Added $? facility + +2.26 Fixed bug in macro expansion + +2.27 Repaired interrupt handling + +2.28 Repaired bug in -n + +2.29 Repaired bug in file closing and $? string creation + +2.30 Repaired bug in grammar about command lines + +2.31 Added -k flag, modified doname.c and defs + +2.32 Made "keepgoing" the default, added -S flag, + + changed handling of funny characters internally + +2.3 Small fixups to interrupt and quit handling. + + Changed default back to -k. + +2.34 Added .PRECIOUS rule for interrupts + +2.35 Added references to include files (due to TLL) + +2.36 Fixed bug in lex.c so = permitted in rules on :; line + +2.37 Miscellaneous code cleanups + +2.38 Sleep one second after each touch in -t mode + +2.39 Extended string[] declaration in doname.c + +2.40 Permit recursive macro references + +2.41 Separated YYLMAX into INMAX and OUTMAX macros, specifying longest + + input and output lines respectively. + +2.42 Fixed bug involving :: lines without dependents + +2.43 Main name is first name that contains a slash or doesn't + + begin with a dot + +2.44 Fixed bug involving $$ on command line + +2.45 Changed files.c to put .f before .e, .r and to use f77 instead of fc. + +2.46 Changed dosys.c to eliminate copying and to call execvp. + +2.47 Changed files.c to add ".out" suffix and rules. + +2.48 Changed misc.c to permit tabs preceding = in macro definition + +2.49 Added reference to . Removed -lS references from files.c + +2.50 General cleanup to reduce lint messages. (changes in declarations + + and in uses of variables) + +2.51 Further cleanup making use of new Yacc features. + +2.52 + +2.53 Changed handling of "touch" + +2.54 Fixed bug involving comments in lexical analyzer. + +2.55 Ignore commands that begin with a # are comments. + +2.56 Added = to list of META characters (to permit shell commands) + +2.57 Changed lookarch and getobj to fix bugs. + +2.58 Fixed interrupt handling. + +2.59 Changed references to sprintf to accomodate new function definition + + Also fixed extern declarations. + +2.60 Limited the number of open directories. +++2.61 Added code to handle archives with ascii headers. + +*/ diff --cc usr/src/cmd/makekey.c index 0000000000,1640e51135,0000000000..b99021a66c mode 000000,100644,000000..100644 --- a/usr/src/cmd/makekey.c +++ b/usr/src/cmd/makekey.c @@@@ -1,0 -1,19 -1,0 +1,20 @@@@ +++static char *sccsid = "@(#)makekey.c 4.1 (Berkeley) 10/1/80"; + +/* + + * You send it 10 bytes. + + * It sends you 13 bytes. + + * The transformation is expensive to perform + + * (a significant part of a second). + + */ + + + +char *crypt(); + + + +main() + +{ + + char key[8]; + + char salt[2]; + + + + read(0, key, 8); + + read(0, salt, 2); + + write(1, crypt(key, salt), 13); + + return(0); + +} diff --cc usr/src/cmd/mesg.c index 0000000000,77e8f998c1,0000000000..5a6e87931d mode 000000,100755,000000..100644 --- a/usr/src/cmd/mesg.c +++ b/usr/src/cmd/mesg.c @@@@ -1,0 -1,57 -1,0 +1,58 @@@@ +++static char *sccsid = "@(#)mesg.c 4.2 (Berkeley) 10/18/80"; + +/* + + * mesg -- set current tty to accept or + + * forbid write permission. + + * + + * mesg [y] [n] + + * y allow messages + + * n forbid messages + + */ + + + +#include + +#include + +#include + + + +struct stat sbuf; + + + +char *tty; + +char *ttyname(); + + + +main(argc, argv) + +char *argv[]; + +{ + + int r=0; + + tty = ttyname(2); + + if (tty == 0) + + exit(13); + + if(stat(tty, &sbuf) < 0) error("cannot stat"); + + if(argc < 2) { + + if(sbuf.st_mode & 02) + + fprintf(stderr,"is y\n"); + + else { r=1; + + fprintf(stderr,"is n\n"); + + } + + } else switch(*argv[1]) { + + case 'y': - newmode(0622); break; +++ newmode(sbuf.st_mode|022); break; + + + + case 'n': - newmode(0600); r=1; break; +++ newmode(sbuf.st_mode&~022); r=1; break; + + + + default: + + error("usage: mesg [y] [n]"); + + } + + exit(r); + +} + + + +error(s) + +char *s; + +{ + + fprintf(stderr,"mesg: %s\n",s); + + exit(-1); + +} + + + +newmode(m) + +{ + + if(chmod(tty,m)<0) + + error("cannot change mode"); + +} diff --cc usr/src/cmd/mkdir.c index 0000000000,0fb6f97fa2,0000000000..098321a2fa mode 000000,100644,000000..100644 --- a/usr/src/cmd/mkdir.c +++ b/usr/src/cmd/mkdir.c @@@@ -1,0 -1,71 -1,0 +1,72 @@@@ +++static char *sccsid = "@(#)mkdir.c 4.1 (Berkeley) 10/1/80"; + +/* + +** make directory + +*/ + + + +#include + +#include + + + +int Errors = 0; + +char *strcat(); + +char *strcpy(); + + + +main(argc, argv) + +char *argv[]; + +{ + + + + signal(SIGHUP, SIG_IGN); + + signal(SIGINT, SIG_IGN); + + signal(SIGQUIT, SIG_IGN); + + signal(SIGPIPE, SIG_IGN); + + signal(SIGTERM, SIG_IGN); + + + + if(argc < 2) { + + fprintf(stderr, "mkdir: arg count\n"); + + exit(1); + + } + + while(--argc) + + mkdir(*++argv); + + exit(Errors!=0); + +} + + + +mkdir(d) + +char *d; + +{ + + char pname[128], dname[128]; + + register i, slash = 0; + + + + pname[0] = '\0'; + + for(i = 0; d[i]; ++i) + + if(d[i] == '/') + + slash = i + 1; + + if(slash) + + strncpy(pname, d, slash); + + strcpy(pname+slash, "."); + + if (access(pname, 02)) { + + fprintf(stderr,"mkdir: cannot access %s\n", pname); + + ++Errors; + + return; + + } + + if ((mknod(d, 040777, 0)) < 0) { + + fprintf(stderr,"mkdir: cannot make directory %s\n", d); + + ++Errors; + + return; + + } + + chown(d, getuid(), getgid()); + + strcpy(dname, d); + + strcat(dname, "/."); + + if((link(d, dname)) < 0) { + + fprintf(stderr, "mkdir: cannot link %s\n", dname); + + unlink(d); + + ++Errors; + + return; + + } + + strcat(dname, "."); + + if((link(pname, dname)) < 0) { + + fprintf(stderr, "mkdir: cannot link %s\n",dname); + + dname[strlen(dname)] = '\0'; + + unlink(dname); + + unlink(d); + + ++Errors; + + } + +} diff --cc usr/src/cmd/mkfs.c index 0000000000,0c549f07b4,0000000000..7b1f75d270 mode 000000,100644,000000..100644 --- a/usr/src/cmd/mkfs.c +++ b/usr/src/cmd/mkfs.c @@@@ -1,0 -1,616 -1,0 +1,621 @@@@ +++static char *sccsid = "@(#)mkfs.c 4.1 (Berkeley) 10/1/80"; +++ + +/* + + * Make a file system prototype. + + * usage: mkfs filsys proto/size [ m n ] + + */ + +#define NIPB (BSIZE/sizeof(struct dinode)) + +#define NINDIR (BSIZE/sizeof(daddr_t)) + +#define NDIRECT (BSIZE/sizeof(struct direct)) + +#define LADDR 10 + +#define MAXFN 500 + +#ifndef STANDALONE + +#include + +#include + +#endif + +#include + +#include + +#include + +#include + +#include + +#include + +time_t utime; + +#ifndef STANDALONE + +FILE *fin; + +#else + +int fin; + +#endif + +int fsi; + +int fso; + +char *charp; + +char buf[BSIZE]; + +union { + + struct fblk fb; + + char pad1[BSIZE]; - } fbuf; +++} fbun; +++#define fbuf fbun.fb + +#ifndef STANDALONE + +struct exec head; + +#endif + +char string[50]; + +union { + + struct filsys fs; + + char pad2[BSIZE]; - } filsys; +++} fsun; +++#define filsys fsun.fs + +char *fsys; + +char *proto; + +int f_n = MAXFN; + +int f_m = 3; + +int error; + +ino_t ino; + +long getnum(); + +daddr_t alloc(); + + + +main(argc, argv) + +char *argv[]; + +{ + + int f, c; + + long n; + + + +#ifndef STANDALONE + + time(&utime); + + if(argc < 3) { + + printf("usage: mkfs filsys proto/size [ m n ]\n"); + + exit(1); + + } + + fsys = argv[1]; + + proto = argv[2]; + +#else + + { + + static char protos[60]; + + + + printf("file sys size: "); + + gets(protos); + + proto = protos; + + } + +#endif + +#ifdef STANDALONE + + { + + char fsbuf[100]; + + + + do { + + printf("file system: "); + + gets(fsbuf); + + fso = open(fsbuf, 1); + + fsi = open(fsbuf, 0); + + } while (fso < 0 || fsi < 0); + + } + + fin = NULL; + + argc = 0; + +#else + + fso = creat(fsys, 0666); + + if(fso < 0) { + + printf("%s: cannot create\n", fsys); + + exit(1); + + } + + fsi = open(fsys, 0); + + if(fsi < 0) { + + printf("%s: cannot open\n", fsys); + + exit(1); + + } + + fin = fopen(proto, "r"); + +#endif + + if(fin == NULL) { + + n = 0; + + for(f=0; c=proto[f]; f++) { + + if(c<'0' || c>'9') { + + printf("%s: cannot open\n", proto); + + exit(1); + + } + + n = n*10 + (c-'0'); + + } + + filsys.s_fsize = n; + + n = n/25; + + if(n <= 0) + + n = 1; + + if(n > 65500/NIPB) + + n = 65500/NIPB; + + filsys.s_isize = n + 2; + + printf("isize = %D\n", n*NIPB); + + charp = "d--777 0 0 $ "; + + goto f3; + + } + + + +#ifndef STANDALONE + + /* + + * get name of boot load program + + * and read onto block 0 + + */ + + + + getstr(); + + f = open(string, 0); + + if(f < 0) { + + printf("%s: cannot open init\n", string); + + goto f2; + + } + + read(f, (char *)&head, sizeof head); - if(head.a_magic != A_MAGIC1) { +++ if(head.a_magic != OMAGIC) { + + printf("%s: bad format\n", string); + + goto f1; + + } + + c = head.a_text + head.a_data; + + if(c > BSIZE) { + + printf("%s: too big\n", string); + + goto f1; + + } + + read(f, buf, c); + + wtfs((long)0, buf); + + + +f1: + + close(f); + + + + /* + + * get total disk size + + * and inode block size + + */ + + + +f2: + + filsys.s_fsize = getnum(); + + n = getnum(); + + n /= NIPB; + + filsys.s_isize = n + 3; + + + +#endif + +f3: + + if(argc >= 5) { + + f_m = atoi(argv[3]); + + f_n = atoi(argv[4]); + + if(f_n <= 0 || f_n >= MAXFN) + + f_n = MAXFN; + + if(f_m <= 0 || f_m > f_n) + + f_m = 3; + + } + + filsys.s_m = f_m; + + filsys.s_n = f_n; + + printf("m/n = %d %d\n", f_m, f_n); + + if(filsys.s_isize >= filsys.s_fsize) { + + printf("%ld/%ld: bad ratio\n", filsys.s_fsize, filsys.s_isize-2); + + exit(1); + + } + + filsys.s_tfree = 0; + + filsys.s_tinode = 0; + + for(c=0; c'7') { + + printf("%c/%s: bad octal mode digit\n", c, string); + + error = 1; + + c = 0; + + } + + in.i_mode |= (c-'0')<<(15-3*i); + + } + + in.i_uid = getnum(); + + in.i_gid = getnum(); + + + + /* + + * general initialization prior to + + * switching on format + + */ + + + + ino++; + + in.i_number = ino; + + for(i=0; i 0) { + + in.i_size += i; + + newblk(&dbc, db, &ibc, ib); + + } + + close(f); + + break; + + + + case IFBLK: + + case IFCHR: + + /* + + * special file + + * content is maj/min types + + */ + + + + i = getnum() & 0377; + + f = getnum() & 0377; + + in.i_un.i_addr[0] = (i<<8) | f; + + break; + + + + case IFDIR: + + /* + + * directory + + * put in extra links + + * call recursively until + + * name of "$" found + + */ + + + + par->i_nlink++; + + in.i_nlink++; + + entry(in.i_number, ".", &dbc, db, &ibc, ib); + + entry(par->i_number, "..", &dbc, db, &ibc, ib); + + in.i_size = 2*sizeof(struct direct); + + for(;;) { + + getstr(); + + if(string[0]=='$' && string[1]=='\0') + + break; + + entry(ino+1, string, &dbc, db, &ibc, ib); + + in.i_size += sizeof(struct direct); + + cfile(&in); + + } + + break; + + } + + if(dbc != 0) + + newblk(&dbc, db, &ibc, ib); + + iput(&in, &ibc, ib); + +} + + + +gmode(c, s, m0, m1, m2, m3) + +char c, *s; + +{ + + int i; + + + + for(i=0; s[i]; i++) + + if(c == s[i]) + + return((&m0)[i]); + + printf("%c/%s: bad mode\n", c, string); + + error = 1; + + return(0); + +} + + + +long + +getnum() + +{ + + int i, c; + + long n; + + + + getstr(); + + n = 0; + + i = 0; + + for(i=0; c=string[i]; i++) { + + if(c<'0' || c>'9') { + + printf("%s: bad number\n", string); + + error = 1; + + return((long)0); + + } + + n = n*10 + (c-'0'); + + } + + return(n); + +} + + + +getstr() + +{ + + int i, c; + + + +loop: + + switch(c=getch()) { + + + + case ' ': + + case '\t': + + case '\n': + + goto loop; + + + + case '\0': + + printf("EOF\n"); + + exit(1); + + + + case ':': + + while(getch() != '\n'); + + goto loop; + + + + } + + i = 0; + + + + do { + + string[i++] = c; + + c = getch(); + + } while(c!=' '&&c!='\t'&&c!='\n'&&c!='\0'); + + string[i] = '\0'; + +} + + + +rdfs(bno, bf) + +daddr_t bno; + +char *bf; + +{ + + int n; + + + + lseek(fsi, bno*BSIZE, 0); + + n = read(fsi, bf, BSIZE); + + if(n != BSIZE) { + + printf("read error: %ld\n", bno); + + exit(1); + + } + +} + + + +wtfs(bno, bf) + +daddr_t bno; + +char *bf; + +{ + + int n; + + + + lseek(fso, bno*BSIZE, 0); + + n = write(fso, bf, BSIZE); + + if(n != BSIZE) { + + printf("write error: %D\n", bno); + + exit(1); + + } + +} + + + +daddr_t + +alloc() + +{ + + int i; + + daddr_t bno; + + + + filsys.s_tfree--; + + bno = filsys.s_free[--filsys.s_nfree]; + + if(bno == 0) { + + printf("out of free space\n"); + + exit(1); + + } + + if(filsys.s_nfree <= 0) { + + rdfs(bno, (char *)&fbuf); + + filsys.s_nfree = fbuf.df_nfree; + + for(i=0; i= NICFREE) { + + fbuf.df_nfree = filsys.s_nfree; + + for(i=0; id_ino = inum; + + for(i=0; id_name[i] = 0; + + for(i=0; id_name[i] = str[i]) == 0) + + break; + + if(*adbc >= NDIRECT) + + newblk(adbc, db, aibc, ib); + +} + + + +newblk(adbc, db, aibc, ib) + +int *adbc, *aibc; + +char *db; + +daddr_t *ib; + +{ + + int i; + + daddr_t bno; + + + + bno = alloc(); + + wtfs(bno, db); + + for(i=0; i= NINDIR) { + + printf("indirect block full\n"); + + error = 1; + + *aibc = 0; + + } + +} + + + +getch() + +{ + + + +#ifndef STANDALONE + + if(charp) + +#endif + + return(*charp++); + +#ifndef STANDALONE + + return(getc(fin)); + +#endif + +} + + + +bflist() + +{ + + struct inode in; + + daddr_t ib[NINDIR]; + + int ibc; + + char flg[MAXFN]; + + int adr[MAXFN]; + + int i, j; + + daddr_t f, d; + + + + for(i=0; i 0; d -= f_n) + + for(i=0; i= filsys.s_isize) + + if(badblk(f)) { + + if(ibc >= NINDIR) { + + printf("too many bad blocks\n"); + + error = 1; + + ibc = 0; + + } + + ib[ibc] = f; + + ibc++; + + } else + + bfree(f); + + } + + iput(&in, &ibc, ib); + +} + + + +iput(ip, aibc, ib) + +struct inode *ip; + +int *aibc; + +daddr_t *ib; + +{ + + struct dinode *dp; + + daddr_t d; + + int i; + + + + filsys.s_tinode--; + + d = itod(ip->i_number); + + if(d >= filsys.s_isize) { + + if(error == 0) + + printf("ilist too small\n"); + + error = 1; + + return; + + } + + rdfs(d, buf); + + dp = (struct dinode *)buf; + + dp += itoo(ip->i_number); + + + + dp->di_mode = ip->i_mode; + + dp->di_nlink = ip->i_nlink; + + dp->di_uid = ip->i_uid; + + dp->di_gid = ip->i_gid; + + dp->di_size = ip->i_size; + + dp->di_atime = utime; + + dp->di_mtime = utime; + + dp->di_ctime = utime; + + + + switch(ip->i_mode&IFMT) { + + + + case IFDIR: + + case IFREG: + + for(i=0; i<*aibc; i++) { + + if(i >= LADDR) + + break; + + ip->i_un.i_addr[i] = ib[i]; + + } + + if(*aibc >= LADDR) { + + ip->i_un.i_addr[LADDR] = alloc(); + + for(i=0; ii_un.i_addr[LADDR], (char *)ib); + + } + + + + case IFBLK: + + case IFCHR: + + ltol3(dp->di_addr, ip->i_un.i_addr, NADDR); + + break; + + + + default: + + printf("bad mode %o\n", ip->i_mode); + + exit(1); + + } + + wtfs(d, buf); + +} + + + +badblk(bno) + +daddr_t bno; + +{ + + + + return(0); + +} diff --cc usr/src/cmd/mknod.c index 0000000000,4fccc28a4f,0000000000..d5809af93a mode 000000,100644,000000..100644 --- a/usr/src/cmd/mknod.c +++ b/usr/src/cmd/mknod.c @@@@ -1,0 -1,42 -1,0 +1,43 @@@@ +++static char *sccsid = "@(#)mknod.c 4.1 (Berkeley) 10/1/80"; + +main(argc, argv) + +int argc; + +char **argv; + +{ + + int m, a, b; + + + + if(argc != 5) { + + printf("arg count\n"); + + goto usage; + + } + + if(*argv[2] == 'b') + + m = 060666; else + + if(*argv[2] == 'c') + + m = 020666; else + + goto usage; + + a = number(argv[3]); + + if(a < 0) + + goto usage; + + b = number(argv[4]); + + if(b < 0) + + goto usage; + + if(mknod(argv[1], m, (a<<8)|b) < 0) + + perror("mknod"); + + exit(0); + + + +usage: + + printf("usage: mknod name b/c major minor\n"); + +} + + + +number(s) + +char *s; + +{ + + int n, c; + + + + n = 0; + + while(c = *s++) { + + if(c<'0' || c>'9') + + return(-1); + + n = n*10 + c-'0'; + + } + + return(n); + +} diff --cc usr/src/cmd/mkstr.c index 0000000000,9737d9367f,0000000000..014a193866 mode 000000,100644,000000..100644 --- a/usr/src/cmd/mkstr.c +++ b/usr/src/cmd/mkstr.c @@@@ -1,0 -1,267 -1,0 +1,268 @@@@ +++static char *sccsid = "@(#)mkstr.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +#define ungetchar(c) ungetc(c, stdin) + + + +long ftell(); + +char *calloc(); + +/* + + * mkstr - create a string error message file by massaging C source + + * + + * Bill Joy UCB August 1977 + + * + + * Modified March 1978 to hash old messages to be able to recompile + + * without addding messages to the message file (usually) + + * + + * Based on an earlier program conceived by Bill Joy and Chuck Haley + + * + + * Program to create a string error message file + + * from a group of C programs. Arguments are the name + + * of the file where the strings are to be placed, the + + * prefix of the new files where the processed source text + + * is to be placed, and the files to be processed. + + * + + * The program looks for 'error("' in the source stream. + + * Whenever it finds this, the following characters from the '"' + + * to a '"' are replaced by 'seekpt' where seekpt is a + + * pointer into the error message file. + + * If the '(' is not immediately followed by a '"' no change occurs. + + * + + * The optional '-' causes strings to be added at the end of the + + * existing error message file for recompilation of single routines. + + */ + + + + + +FILE *mesgread, *mesgwrite; + +char *progname; + +char usagestr[] = "usage: %s [ - ] mesgfile prefix file ...\n"; + +char name[100], *np; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + char addon = 0; + + + + argc--, progname = *argv++; + + if (argc > 1 && argv[0][0] == '-') + + addon++, argc--, argv++; + + if (argc < 3) + + fprintf(stderr, usagestr, progname), exit(1); + + mesgwrite = fopen(argv[0], addon ? "a" : "w"); + + if (mesgwrite == NULL) + + perror(argv[0]), exit(1); + + mesgread = fopen(argv[0], "r"); + + if (mesgread == NULL) + + perror(argv[0]), exit(1); + + inithash(); + + argc--, argv++; + + strcpy(name, argv[0]); + + np = name + strlen(name); + + argc--, argv++; + + do { + + strcpy(np, argv[0]); + + if (freopen(name, "w", stdout) == NULL) + + perror(name), exit(1); + + if (freopen(argv[0], "r", stdin) == NULL) + + perror(argv[0]), exit(1); + + process(); + + argc--, argv++; + + } while (argc > 0); + + exit(0); + +} + + + +process() + +{ + + register char *cp; + + register c; + + + + for (;;) { + + c = getchar(); + + if (c == EOF) + + return; + + if (c != 'e') { + + putchar(c); + + continue; + + } + + if (match("error(")) { + + printf("error("); + + c = getchar(); + + if (c != '"') + + putchar(c); + + else + + copystr(); + + } + + } + +} + + + +match(ocp) + + char *ocp; + +{ + + register char *cp; + + register c; + + + + for (cp = ocp + 1; *cp; cp++) { + + c = getchar(); + + if (c != *cp) { + + while (ocp < cp) + + putchar(*ocp++); + + ungetchar(c); + + return (0); + + } + + } + + return (1); + +} + + + +copystr() + +{ + + register c, ch; + + char buf[512]; + + register char *cp = buf; + + + + for (;;) { + + c = getchar(); + + if (c == EOF) + + break; + + switch (c) { + + + + case '"': + + *cp++ = 0; + + goto out; + + case '\\': + + c = getchar(); + + switch (c) { + + + + case 'b': + + c = '\b'; + + break; + + case 't': + + c = '\t'; + + break; + + case 'r': + + c = '\r'; + + break; + + case 'n': + + c = '\n'; + + break; + + case '\n': + + continue; + + case 'f': + + c = '\f'; + + break; + + case '0': + + c = 0; + + break; + + case '\\': + + break; + + default: + + if (!octdigit(c)) + + break; + + c -= '0'; + + ch = getchar(); + + if (!octdigit(ch)) + + break; + + c <<= 7, c += ch - '0'; + + ch = getchar(); + + if (!octdigit(ch)) + + break; + + c <<= 3, c+= ch - '0', ch = -1; + + break; + + } + + } + + *cp++ = c; + + } + +out: + + *cp = 0; + + printf("%d", hashit(buf, 1, NULL)); + +} + + + +octdigit(c) + + char c; + +{ + + + + return (c >= '0' && c <= '7'); + +} + + + +inithash() + +{ + + char buf[512]; + + int mesgpt = 0; + + + + rewind(mesgread); + + while (fgetNUL(buf, sizeof buf, mesgread) != NULL) { + + hashit(buf, 0, mesgpt); + + mesgpt += strlen(buf) + 2; + + } + +} + + + +#define NBUCKETS 511 + + + +struct hash { + + long hval; + + unsigned hpt; + + struct hash *hnext; + +} *bucket[NBUCKETS]; + + + +hashit(str, really, fakept) + + char *str; + + char really; + + unsigned fakept; + +{ + + int i; + + register struct hash *hp; + + char buf[512]; + + long hashval = 0; + + register char *cp; + + + + if (really) + + fflush(mesgwrite); + + for (cp = str; *cp;) + + hashval = (hashval << 1) + *cp++; + + i = hashval % NBUCKETS; + + if (i < 0) + + i += NBUCKETS; + + if (really != 0) + + for (hp = bucket[i]; hp != 0; hp = hp->hnext) + + if (hp->hval == hashval) { + + fseek(mesgread, (long) hp->hpt, 0); + + fgetNUL(buf, sizeof buf, mesgread); + +/* + + fprintf(stderr, "Got (from %d) %s\n", hp->hpt, buf); + +*/ + + if (strcmp(buf, str) == 0) + + break; + + } + + if (!really || hp == 0) { + + hp = (struct hash *) calloc(1, sizeof *hp); + + hp->hnext = bucket[i]; + + hp->hval = hashval; + + hp->hpt = really ? ftell(mesgwrite) : fakept; + + if (really) { + + fwrite(str, sizeof (char), strlen(str) + 1, mesgwrite); + + fwrite("\n", sizeof (char), 1, mesgwrite); + + } + + bucket[i] = hp; + + } + +/* + + fprintf(stderr, "%s hashed to %ld at %d\n", str, hp->hval, hp->hpt); + +*/ + + return (hp->hpt); + +} + + + +#include + +#include + + + +fgetNUL(obuf, rmdr, file) + + char *obuf; + + register int rmdr; + + FILE *file; + +{ + + register c; + + register char *buf = obuf; + + + + while (--rmdr > 0 && (c = getc(file)) != 0 && c != EOF) + + *buf++ = c; + + *buf++ = 0; + + getc(file); + + return ((feof(file) || ferror(file)) ? NULL : 1); + +} diff --cc usr/src/cmd/more.c index 0000000000,231a93a416,0000000000..aa8dd00fe8 mode 000000,100644,000000..100644 --- a/usr/src/cmd/more.c +++ b/usr/src/cmd/more.c @@@@ -1,0 -1,1350 -1,0 +1,1407 @@@@ +++static char *SCCS_ID = "@(#)more.c 4.1 (Berkeley) 10/16/80"; +++/* +++** more.c - General purpose tty output filter and file perusal program +++** +++** by Eric Shienbrood, UC Berkeley +++*/ +++ + +#include +++#ifdef V6 +++#include +++#endif + +#include +++#include + +#include +++#include + +#include + +#include + +#include + +#include + +#include +++#include +++ +++/* Help file will eventually go in libpath(more.help) on all systems */ +++ +++#ifdef INGRES +++#define VI "/usr/bin/vi" +++#define HELPFILE "/mntp/doucette/more/more.help" +++#endif +++ +++#ifndef INGRES +++#ifndef HELPFILE +++#define HELPFILE libpath(more.help) +++#endif +++#define VI binpath(vi) +++#endif + + - #ifdef CORY - #define MBIT RAW +++#define Fopen(s,m) (Currline = 0,file_pos=0,fopen(s,m)) +++#define Ftell(f) file_pos +++#define Fseek(f,off) (file_pos=off,fseek(f,off,0)) +++#define Getc(f) (++file_pos, getc(f)) +++#define Ungetc(c,f) (--file_pos, ungetc(c,f)) +++ +++#ifdef V6 +++#define MBIT RAW +++#define CBREAK ~RAW + +#else - #include - #define MBIT CBREAK +++#define MBIT CBREAK +++#define stty(fd,argp) ioctl(fd,TIOCSETN,argp) + +#endif + + + +#define TBUFSIZ 1024 + +#define LINSIZ 256 + +#define ctrl(letter) ('letter' & 077) + +#define RUBOUT '\177' + +#define ESC '\033' + +#define QUIT '\034' + + + +struct sgttyb otty; +++long file_pos, file_size; + +int fnum, no_intty, no_tty, slow_tty; + +int dum_opt, dlines, onquit(), end_it(); - int stop_opt = 1; +++#ifdef SIGTSTP +++int onsusp(); +++#endif +++int nscroll = 11; /* Number of lines scrolled by 'd' */ +++int fold_opt = 1; /* Fold long lines */ +++int stop_opt = 1; /* Stop after form feeds */ + +int promptlen; +++int Currline; /* Line we are currently at */ + +int startup = 1; + +int firstf = 1; + +int notell = 1; - int inwait, pause, errors; +++int bad_so; /* True if overwriting does not turn off standout */ +++int inwait, Pause, errors; + +int within; /* true if we are within a file, + + false if we are between files */ + +int hard, dumb, noscroll, hardtabs; - char **fnames; - int nfiles; - char *shell; +++int catch_susp; /* We should catch the SIGTSTP signal */ +++char **fnames; /* The list of file names */ +++int nfiles; /* Number of files left to process */ +++char *shell; /* The name of the shell to use */ +++int shellp; /* A previous shell command exists */ + +char ch; + +jmp_buf restore; + +char obuf[BUFSIZ]; /* stdout buffer */ - char Line[LINSIZ]; +++char Line[LINSIZ]; /* Line buffer */ + +int Lpp = 24; /* lines per page */ + +char *Clear; /* clear screen */ + +char *eraseln; /* erase line */ + +char *Senter, *Sexit;/* enter and exit standout mode */ + +char *tgetstr(); + +int Mcol = 80; /* number of columns */ + +int Wrap = 1; /* set if automargins */ +++long fseek(); +++struct { +++ long chrctr, line; +++} context, screen_start; + +extern char PC; /* pad character */ + +extern short ospeed; + + + + + +main(argc, argv) + +int argc; + +char *argv[]; + +{ + + register FILE *f; + + register char *s; + + register char *p; + + register char ch; + + register int left; + + int prnames = 0; + + int initopt = 0; + + int srchopt = 0; +++ int clearit = 0; + + int initline; - char buf[TBUFSIZ]; - char clearbuf[100]; + + char initbuf[80]; - char *clearptr; - char *getenv(); + + FILE *checkf(); + + + + nfiles = argc; + + fnames = argv; - /* Put terminal setup stuff in separate procedure ?? (From here...) */ - setbuf(stdout, obuf); - if (!(no_tty = gtty(1, &otty))) { - if (tgetent(buf, getenv("TERM")) <= 0) { - dumb++; - } - else { - if (((Lpp = tgetnum("li")) < 0) || tgetflag("hc")) { - hard++; /* Hard copy terminal */ - Lpp = 24; - } - if (!hard && tgetflag("ns")) - noscroll++; - if ((Mcol = tgetnum("co")) < 0) - Mcol = 80; - Wrap = tgetflag("am"); - clearptr = clearbuf; - eraseln = tgetstr("ce",&clearptr); - Clear = tgetstr("cl", &clearptr); - Senter = tgetstr("so", &clearptr); - Sexit = tgetstr("se", &clearptr); - PC = *tgetstr("pc", &clearptr); - } - if ((shell = getenv("SHELL")) == NULL) - shell = "/bin/sh"; - } - no_intty = gtty(0, &otty); - gtty(2, &otty); - ospeed = otty.sg_ospeed; - slow_tty = ospeed < B1200; - hardtabs = !(otty.sg_flags & XTABS); - if (!no_tty) { - otty.sg_flags &= ~ECHO; - if (MBIT == CBREAK || !slow_tty) - otty.sg_flags |= MBIT; - } - /* ... until here or so */ +++ initterm (); + + while (--nfiles > 0) { + + if ((ch = (*++fnames)[0]) == '-') { + + for (s = fnames[0] + 1, dlines = 0; *s != '\0'; s++) + + if (isdigit(*s)) + + dlines = dlines*10 + *s - '0'; + + else if (*s == 'd') + + dum_opt = 1; + + else if (*s == 'l') + + stop_opt = 0; +++ else if (*s == 'f') +++ fold_opt = 0; + + } + + else if (ch == '+') { + + s = *fnames; + + if (*++s == '/') { + + srchopt++; + + for (++s, p = initbuf; p < initbuf + 79 && *s != '\0';) + + *p++ = *s++; + + *p = '\0'; + + } + + else { + + initopt++; + + for (initline = 0; *s != '\0'; s++) + + if (isdigit (*s)) + + initline = initline*10 + *s -'0'; + + --initline; + + } + + } + + else break; + + } + + if (dlines == 0) - dlines = Lpp - 2; +++ dlines = Lpp - (noscroll ? 1 : 2); + + left = dlines; + + if (nfiles > 1) + + prnames++; + + if (!no_intty && nfiles == 0) { + + fputs("Usage: ",stderr); + + fputs(argv[0],stderr); - fputs(" [-dn] name1 name2 ...\n",stderr); +++ fputs(" [-dfln] [+linenum | +/pattern] name1 name2 ...\n",stderr); + + exit(1); + + } + + else + + f = stdin; + + if (!no_tty) { + + signal(SIGQUIT, onquit); + + signal(SIGINT, end_it); +++#ifdef SIGTSTP +++ if (signal (SIGTSTP, SIG_IGN) == SIG_DFL) { +++ signal(SIGTSTP, onsusp); +++ catch_susp++; +++ } +++#endif + + stty (2, &otty); + + } + + if (no_intty) { + + if (no_tty) + + copy_file (stdin); + + else { +++ if ((ch = Getc (f)) == '\f') +++ doclear (); +++ else { +++ Ungetc (ch, f); +++ if (noscroll) +++ doclear (); +++ } + + if (srchopt) + + search (initbuf, stdin, 1); + + else if (initopt) + + skiplns (initline, stdin); + + screen (stdin, left); + + } - end_it (); +++ no_intty = 0; +++ prnames++; +++ firstf = 0; + + } + + + + while (fnum < nfiles) { - if ((f = checkf (fnames[fnum])) != NULL) { +++ if ((f = checkf (fnames[fnum], &clearit)) != NULL) { +++ context.line = context.chrctr = 0; +++ Currline = 0; + + if (firstf) setjmp (restore); + + if (firstf) { + + firstf = 0; + + if (srchopt) + + search (initbuf, f, 1); + + else if (initopt) + + skiplns (initline, f); + + } + + else if (fnum < nfiles && !no_tty) { + + setjmp (restore); + + left = command (fnames[fnum], f); + + } + + if (left != 0) { +++ if (noscroll || clearit) +++ doclear (); + + if (prnames) { +++ if (bad_so) +++ erase (0); + + pr("::::::::::::::"); + + if (promptlen > 14) + + erase (14); - putchar ('\n'); - pr(fnames[fnum]); - pr("\n::::::::::::::\n"); +++ printf ("\n%s\n::::::::::::::\n", fnames[fnum]); + + if (left > Lpp - 4) + + left = Lpp - 4; + + } + + if (no_tty) + + copy_file (f); + + else { + + within++; + + screen(f, left); + + within = 0; + + } + + } + + setjmp (restore); + + fflush(stdout); + + fclose(f); +++ screen_start.line = screen_start.chrctr = 0L; +++ context.line = context.chrctr = 0L; + + } + + fnum++; + + firstf = 0; + + } - otty.sg_flags |= ECHO; - otty.sg_flags &= ~MBIT; - stty(2, &otty); +++ reset_tty (); + + exit(0); + +} + + + +/* + +** Check whether the file named by fs is an ASCII file which the user may + +** access. If it is, return the opened file. Otherwise return NULL. + +*/ + + + +FILE * - checkf (fs) +++checkf (fs, clearfirst) + +register char *fs; +++int *clearfirst; + +{ - #ifdef CORY - int space[3]; /* Why doesn't libretro have a V7 stat? */ - #endif + + struct stat stbuf; + + register FILE *f; + + char c; + + + + if (stat (fs, &stbuf) == -1) { + + fflush(stdout); + + perror(fs); + + return (NULL); + + } - if (stbuf.st_mode & S_IFDIR) { - pr("\n*** "); - pr(fs); - pr(": directory ***\n\n"); +++ if ((stbuf.st_mode & S_IFMT) == S_IFDIR) { +++ printf("\n*** %s: directory ***\n\n", fs); + + return (NULL); + + } - if ((f=fopen(fs, "r")) == NULL) { +++ if ((f=Fopen(fs, "r")) == NULL) { + + fflush(stdout); + + perror(fs); + + return (NULL); + + } - c = getc(f); +++ c = Getc(f); + + + + /* Try to see whether it is an ASCII file */ + + + + switch ((c | *f->_ptr << 8) & 0177777) { + + case 0405: + + case 0407: + + case 0410: + + case 0411: +++ case 0413: + + case 0177545: - pr("\n******** "); - pr(fs); - pr(": Not a text file ********\n\n"); +++ printf("\n******** %s: Not a text file ********\n\n", fs); + + fclose (f); + + return (NULL); + + default: + + break; + + } - if (c == '\f') { - c = 0; - doclear (); +++ if (c == '\f') +++ *clearfirst = 1; +++ else { +++ *clearfirst = 0; +++ Ungetc (c, f); + + } - ungetc (c, f); +++ if ((file_size = stbuf.st_size) == 0) +++ file_size = 0x7fffffffffffffffL; + + return (f); + +} + + + +/* + +** A real function, for the tputs routine in termlib + +*/ + + + +putch (ch) - register char ch; +++char ch; + +{ + + putchar (ch); + +} + + + +/* + +** Print out the contents of the file f, one screenful at a time. + +*/ + + + +#define STOP -10 + + + +screen (f, num_lines) + +register FILE *f; + +register int num_lines; + +{ + + register int c; - int nchars; +++ register int nchars; +++ int length; + + + + for (;;) { - while (num_lines > 0 && !pause) { - if ((nchars = getline (f)) == EOF) +++ while (num_lines > 0 && !Pause) { +++ if ((nchars = getline (f, &length)) == EOF) + + return; - if (Senter && *Senter == ' ' && promptlen > 0) +++ if (bad_so || (Senter && *Senter == ' ') && promptlen > 0) + + erase (0); - pr (Line); +++ prbuf (Line, length); + + if (nchars < promptlen) + + erase (nchars); /* erase () sets promptlen to 0 */ + + else promptlen = 0; - if (nchars < Mcol) +++ if (nchars < Mcol || !fold_opt) + + putchar('\n'); + + if (nchars == STOP) + + break; + + num_lines--; + + } + + fflush(stdout); - if ((c = getc(f)) == EOF) { - if (noscroll) - doclear(); - else - erase (0); +++ if ((c = Getc(f)) == EOF) + + return; - } - ungetc (c, f); +++ Ungetc (c, f); + + setjmp (restore); - pause = 0; startup = 0; +++ Pause = 0; startup = 0; + + if ((num_lines = command (NULL, f)) == 0) + + return; +++ if (hard && promptlen > 0) +++ erase (0); +++ if (noscroll && num_lines == dlines) +++ doclear (); +++ screen_start.line = Currline; +++ screen_start.chrctr = Ftell (f); + + } + +} + + + +/* + +** Come here if a quit signal is received + +*/ + + + +onquit() + +{ + + signal(SIGQUIT, SIG_IGN); + + if (!inwait) { + + putchar ('\n'); + + if (!startup) { + + signal(SIGQUIT, onquit); + + longjmp (restore, 1); + + } + + else - pause++; +++ Pause++; + + } + + else if (!dum_opt && notell) { + + write (2, "[Use q or Q to quit]", 20); + + promptlen += 20; + + notell = 0; + + } + + signal(SIGQUIT, onquit); + +} + + + +/* + +** Clean up terminal state and exit. Also come here if interrupt signal received + +*/ + + + +end_it () + +{ + + - otty.sg_flags &= ~MBIT; - otty.sg_flags |= ECHO; - stty(2, &otty); - if (promptlen > 0) +++ reset_tty (); +++ if (promptlen > 0) { + + kill_line (); +++ fflush (stdout); +++ } + + else - putchar ('\n'); - exit(0); +++ write (2, "\n", 1); +++ _exit(0); + +} + + + +copy_file(f) + +register FILE *f; + +{ + + register int c; + + + + while ((c = getc(f)) != EOF) + + putchar(c); + +} + + +++/* Simplified printf function */ +++ +++printf (fmt, args) +++register char *fmt; +++int args; +++{ +++ register int *argp; +++ register char ch; +++ register int ccount; +++ +++ ccount = 0; +++ argp = &args; +++ while (*fmt) { +++ while ((ch = *fmt++) != '%') { +++ if (ch == '\0') +++ return (ccount); +++ ccount++; +++ putchar (ch); +++ } +++ switch (*fmt++) { +++ case 'd': +++ ccount += printd (*argp); +++ break; +++ case 's': +++ ccount += pr ((char *)*argp); +++ break; +++ case '%': +++ ccount++; +++ argp--; +++ putchar ('%'); +++ break; +++ case '0': +++ return (ccount); +++ default: +++ break; +++ } +++ ++argp; +++ } +++ return (ccount); +++ +++} +++ +++/* +++** Print an integer as a string of decimal digits, +++** returning the length of the print representation. +++*/ + + + +printd (n) - register int n; +++int n; + +{ - register int a; +++ int a, nchars; + + + + if (a = n/10) - printd(a); - putchar(n % 10 + '0'); +++ nchars = 1 + printd(a); +++ else +++ nchars = 1; +++ putchar (n % 10 + '0'); +++ return (nchars); +++} +++ +++/* Put the print representation of an integer into a string */ +++static char *sptr; +++ +++scanstr (n, str) +++int n; +++char *str; +++{ +++ sptr = str; +++ sprintf (n); +++ *sptr = '\0'; +++} +++ +++sprintf (n) +++{ +++ int a; +++ +++ if (a = n/10) +++ sprintf (a); +++ *sptr++ = n % 10 + '0'; + +} + + + +static char bell = ctrl(G); + + + +strlen (s) + +char *s; + +{ + + register char *p; + + + + p = s; + + while (*p++) + + ; + + return (p - s - 1); + +} + + +++/* See whether the last component of the path name "path" is equal to the +++** string "string" +++*/ +++ +++tailequ (path, string) +++char *path; +++register char *string; +++{ +++ register char *tail; +++ +++ tail = path + strlen(path); +++ while (tail >= path) +++ if (*(--tail) == '/') +++ break; +++ ++tail; +++ while (*tail++ == *string++) +++ if (*tail == '\0') +++ return(1); +++ return(0); +++} +++ + +prompt (filename) + +char *filename; + +{ + + if (promptlen > 0) + + kill_line (); + + if (!hard) { + + promptlen = 8; + + if (Senter && Sexit) + + tputs (Senter, 1, putch); + + pr("--More--"); + + if (filename != NULL) { - pr("(Next file: "); - pr(filename); - putchar(')'); - promptlen += 13 + strlen(filename); +++ promptlen += printf ("(Next file: %s)", filename); +++ } +++ else if (!no_intty) { +++ promptlen += printf ("(%d%%)", (int)((file_pos * 100) / file_size)); + + } + + if (dum_opt) { - pr("[Hit space to continue, Rubout to abort]"); - promptlen += 40; +++ promptlen += pr("[Hit space to continue, Rubout to abort]"); + + } + + if (Senter && Sexit) + + tputs (Sexit, 1, putch); + + fflush(stdout); + + } + + else + + write (2, &bell, 1); + + inwait++; + +} + + + +/* + +** Get a logical line + +*/ + + - getline(f) +++getline(f, length) + +register FILE *f; +++int *length; + +{ - register char c; +++ register int c; + + register char *p; + + register int column; - register int i; + + static int colflg; + + + + p = Line; - i = column = 0; - c = getc (f); - if (colflg && c == '\n') c = getc (f); - for (i = 1; i < LINSIZ; i++) { +++ column = 0; +++ c = Getc (f); +++ if (colflg && c == '\n') { +++ Currline++; +++ c = Getc (f); +++ } +++ while (p < &Line[LINSIZ - 1]) { + + if (c == EOF) { + + if (p > Line) { + + *p = '\0'; +++ *length = p - Line; + + return (column); + + } +++ *length = p - Line; + + return (EOF); + + } - if (c == '\n') +++ if (c == '\n') { +++ Currline++; + + break; +++ } + + *p++ = c; + + if (c == '\t') + + if (hardtabs && column < promptlen && !hard) { + + if (eraseln && !dumb) { +++ column = 1 + (column | 7); + + tputs (eraseln, 1, putch); + + promptlen = 0; + + } + + else { - for (--p; column & 7; column++) +++ for (--p; column & 7 && p < &Line[LINSIZ - 1]; column++) { + + *p++ = ' '; +++ } + + if (column >= promptlen) promptlen = 0; + + } + + } + + else + + column = 1 + (column | 7); + + else if (c == '\b') + + column--; + + else if (c == '\r') + + column = 0; + + else if (c == '\f' && stop_opt) { + + p[-1] = '^'; + + *p++ = 'L'; - break; +++ column += 2; +++ Pause++; + + } - else if (c == EOF) +++ else if (c == EOF) { +++ *length = p - Line; + + return (column); - else if (c >= ' ') +++ } +++ else if (c >= ' ' && c != RUBOUT) + + column++; - if (column >= Mcol) break; - c = getc (f); +++ if (column >= Mcol && fold_opt) break; +++ c = Getc (f); + + } - if (Mcol > 0 && column >= Mcol) { +++ if (column >= Mcol && Mcol > 0) { + + if (!Wrap) { + + *p++ = '\n'; - i++; + + } + + } - colflg = (column == Mcol) || c == '\f'; +++ colflg = column == Mcol && fold_opt; +++ *length = p - Line; + + *p = 0; - if (c == '\f' && stop_opt) - return (STOP); + + return (column); + +} + + + +/* - ** Erase the rest of the prompt, assuming we are starting column col. +++** Erase the rest of the prompt, assuming we are starting at column col. + +*/ + + + +erase (col) + +register int col; + +{ + + - if (hard || promptlen == 0) +++ if (promptlen == 0) + + return; - if (col == 0) - putchar ('\r'); - if (!dumb && eraseln) - tputs (eraseln, 1, putch); - else - for (col = promptlen - col; col > 0; col--) - putchar (' '); +++ if (hard) { +++ putchar ('\n'); +++ } +++ else { +++ if (col == 0) +++ putchar ('\r'); +++ if (!dumb && eraseln) +++ tputs (eraseln, 1, putch); +++ else +++ for (col = promptlen - col; col > 0; col--) +++ putchar (' '); +++ } + + promptlen = 0; + +} + + + +/* + +** Erase the current line entirely + +*/ + + + +kill_line () + +{ + + erase (0); + + if (!eraseln || dumb) putchar ('\r'); + +} + + + +/* - ** Print string +++** Print string and return number of characters + +*/ + + + +pr(s1) + +char *s1; + +{ + + register char *s; + + register char c; + + + + for (s = s1; c = *s++; ) + + putchar(c); +++ return (s - s1 - 1); +++} +++ +++ +++/* Print a buffer of n characters */ +++ +++prbuf (s, n) +++register char *s; +++register int n; +++{ +++ while (n-- > 0) +++ putchar (*s++); + +} + + + +/* + +** Clear the screen + +*/ + + + +doclear() + +{ - if (Clear && Lpp > 0) +++ if (Clear && !hard) { + + tputs(Clear, 1, putch); +++ +++ /* Put out carriage return so that system doesn't +++ ** get confused by escape sequences when expanding tabs +++ */ +++ putchar ('\r'); +++ promptlen = 0; +++ } + +} + + +++static int lastcmd, lastarg, lastp; +++static int lastcolon; +++char shell_line[132]; + + + +/* + +** Read a command and do it. A command consists of an optional integer + +** argument followed by the command character. Return the number of lines + +** to display in the next screenful. If there is nothing more to display + +** in the current file, zero is returned. + +*/ + + + +command (filename, f) + +char *filename; + +register FILE *f; + +{ + + register int nlines; + + register int retval; + + register char c; - int id, done; +++ char colonch; +++ FILE *helpf; +++ int done; + + char comchar, cmdbuf[80], *p; + + + +#define ret(val) retval=val;done++;break + + + + done = 0; + + if (!errors) + + prompt (filename); + + else + + errors = 0; + + if (MBIT == RAW && slow_tty) { + + otty.sg_flags |= MBIT; + + stty(2, &otty); + + } + + for (;;) { + + nlines = number (&comchar); +++ lastp = colonch = 0; +++ if (comchar == '.') { /* Repeat last command */ +++ lastp++; +++ comchar = lastcmd; +++ nlines = lastarg; +++ if (lastcmd == ':') +++ colonch = lastcolon; +++ } +++ lastcmd = comchar; +++ lastarg = nlines; +++ if (comchar == otty.sg_erase) { +++ kill_line (); +++ prompt (filename); +++ continue; +++ } + + switch (comchar) { +++ case ':': +++ retval = colon (filename, colonch, nlines); +++ if (retval >= 0) +++ done++; +++ break; + + case ' ': + + case 'z': + + if (nlines == 0) nlines = dlines; + + else if (comchar == 'z') dlines = nlines; + + ret (nlines); + + case 'd': + + case ctrl(D): - ret (11); +++ if (nlines != 0) nscroll = nlines; +++ ret (nscroll); + + case RUBOUT: + + case 'q': + + case 'Q': + + end_it (); + + case 's': + + case 'f': + + if (nlines == 0) nlines++; + + if (comchar == 'f') + + nlines *= dlines; + + putchar ('\r'); + + erase (0); - pr("\n...skipping "); - printd(nlines); - pr(" line"); +++ printf("\n...skipping %d line", nlines); + + if (nlines > 1) + + pr("s\n\n"); + + else + + pr("\n\n"); + + while (nlines > 0) { - while ((c = getc (f)) != '\n') +++ while ((c = Getc (f)) != '\n') + + if (c == EOF) { + + retval = 0; + + done++; + + goto endsw; + + } +++ Currline++; + + nlines--; + + } + + ret (dlines); - break; + + case '\n': - ret (1); - case 'n': - if (nlines == 0) - nlines++; - putchar ('\r'); - erase (0); - skipf (nlines); - ret (0); - case 'p': - if (no_intty) { +++ if (nlines != 0) +++ dlines = nlines; +++ else +++ nlines = 1; +++ ret (nlines); +++ case '\f': +++ if (!no_intty) { +++ doclear (); +++ Fseek (f, screen_start.chrctr); +++ Currline = screen_start.line; +++ ret (dlines); +++ } +++ else { + + write (2, &bell, 1); + + break; + + } - putchar ('\r'); - erase (0); - if (nlines == 0) - nlines++; - skipf (-nlines); - ret (0); - case '/': +++ case '\'': +++ if (!no_intty) { +++ kill_line (); +++ pr ("\n***Back***\n\n"); +++ Fseek (f, context.chrctr); +++ Currline = context.line; +++ ret (dlines); +++ } +++ else { +++ write (2, &bell, 1); +++ break; +++ } +++ case '=': + + kill_line (); - pr ("/"); - promptlen = 1; +++ promptlen = printd (Currline); + + fflush (stdout); - ttyin (cmdbuf, 78, '/'); +++ break; +++ case 'n': +++ lastp++; +++ case '/': + + if (nlines == 0) nlines++; - write (2, "\r", 1); - search (cmdbuf, f, nlines); - ret (dlines); - case '!': + + kill_line (); - pr ("!"); +++ pr ("/"); + + promptlen = 1; + + fflush (stdout); - ttyin (cmdbuf, 78, '!'); - write (2, "\n", 1); - promptlen = 0; - otty.sg_flags |= ECHO; - otty.sg_flags &= ~MBIT; - stty(2, &otty); - while ((id = fork ()) < 0) - ; - if (id == 0) { - execl (shell, shell, "-c", cmdbuf, 0); - write (2, "exec failed\n", 12); - exit (1); +++ if (lastp) { +++ write (2,"\r", 1); +++ search (NULL, f, nlines); /* Use previous r.e. */ + + } - signal (SIGINT, SIG_IGN); - signal (SIGQUIT, SIG_IGN); - wait (0); - signal (SIGINT, end_it); - signal (SIGQUIT, onquit); - otty.sg_flags |= MBIT; - otty.sg_flags &= ~ECHO; - stty(2, &otty); - pr ("----------\n(continue)\n"); - fflush (stdout); +++ else { +++ ttyin (cmdbuf, 78, '/'); +++ write (2, "\r", 1); +++ search (cmdbuf, f, nlines); +++ } +++ ret (dlines); +++ case '!': +++ do_shell (filename); +++ break; +++ case 'h': +++ if ((helpf = fopen (HELPFILE, "r")) == NULL) +++ error ("Can't open help file"); +++ if (noscroll) doclear (); +++ copy_file (helpf); +++ close (helpf); +++ prompt (filename); + + break; +++ case 'v': /* This case should go right before default */ +++ if (!no_intty) { +++ kill_line (); +++ cmdbuf[0] = '+'; +++ scanstr (Currline, &cmdbuf[1]); +++ pr ("vi "); pr (cmdbuf); putchar (' '); pr (fnames[fnum]); +++ execute (filename, VI, "vi", cmdbuf, fnames[fnum], 0); +++ break; +++ } + + default: + + write (2, &bell, 1); + + break; + + } + + if (done) break; + + } + + putchar ('\r'); + +endsw: + + inwait = 0; + + notell++; + + if (MBIT == RAW && slow_tty) { + + otty.sg_flags &= ~MBIT; + + stty(2, &otty); + + } + + return (retval); + +} + + + +char ch; + + +++/* +++ * Execute a colon-prefixed command. +++ * Returns <0 if not a command that should cause +++ * more of the file to be printed. +++ */ +++ +++colon (filename, cmd, nlines) +++char *filename; +++int cmd; +++int nlines; +++{ +++ if (cmd == 0) +++ ch = readch (); +++ else +++ ch = cmd; +++ lastcolon = ch; +++ switch (ch) { +++ case 'f': +++ kill_line (); +++ if (!no_intty) +++ promptlen = printf ("\"%s\" line %d", fnames[fnum], Currline); +++ else +++ promptlen = printf ("[Not a file] line %d", Currline); +++ fflush (stdout); +++ return (-1); +++ case 'n': +++ if (nlines == 0) { +++ if (fnum >= nfiles - 1) +++ end_it (); +++ nlines++; +++ } +++ putchar ('\r'); +++ erase (0); +++ skipf (nlines); +++ return (0); +++ case 'p': +++ if (no_intty) { +++ write (2, &bell, 1); +++ return (-1); +++ } +++ putchar ('\r'); +++ erase (0); +++ if (nlines == 0) +++ nlines++; +++ skipf (-nlines); +++ return (0); +++ case '!': +++ do_shell (filename); +++ return (-1); +++ case 'q': +++ case 'Q': +++ end_it (); +++ default: +++ write (2, &bell, 1); +++ return (-1); +++ } +++} +++ + +/* + +** Read a decimal number from the terminal. Set cmd to the non-digit which + +** terminates the number. + +*/ + + + +number(cmd) + +char *cmd; + +{ - register int i; +++ register int i; +++ +++ i = 0; ch = otty.sg_kill; +++ for (;;) { +++ ch = readch (); +++ if (ch >= '0' && ch <= '9') +++ i = i*10 + ch - '0'; +++ else if (ch == otty.sg_kill) +++ i = 0; +++ else { +++ *cmd = ch; +++ break; +++ } +++ } +++ return (i); +++} + + - i = 0; ch = otty.sg_kill; - for (;;) { - read (2, &ch, 1); - if (ch >= '0' && ch <= '9') - i = i*10 + ch - '0'; - else if (ch == otty.sg_kill) - i = 0; +++do_shell (filename) +++char *filename; +++{ +++ char cmdbuf[80]; +++ +++ kill_line (); +++ pr ("!"); +++ fflush (stdout); +++ promptlen = 1; +++ if (lastp) +++ pr (shell_line); + + else { - *cmd = ch; - break; +++ ttyin (cmdbuf, 78, '!'); +++ if (expand (shell_line, cmdbuf)) { +++ kill_line (); +++ promptlen = printf ("!%s", shell_line); +++ } + + } +++ fflush (stdout); +++ write (2, "\n", 1); +++ promptlen = 0; +++ shellp = 1; +++ execute (filename, shell, shell, "-c", shell_line, 0); +++} +++ +++/* +++** Search for nth ocurrence of regular expression contained in buf in the file +++*/ +++ +++search (buf, file, n) +++char buf[]; +++FILE *file; +++register int n; +++{ +++ long startline = Ftell (file); +++ register long line1 = startline; +++ register long line2 = startline; +++ register long line3 = startline; +++ register int lncount; +++ int saveln, rv, re_exec(); +++ char *s, *re_comp(); +++ +++ context.line = saveln = Currline; +++ context.chrctr = startline; +++ lncount = 0; +++ if ((s = re_comp (buf)) != 0) +++ error (s); +++ while (!feof (file)) { +++ line3 = line2; +++ line2 = line1; +++ line1 = Ftell (file); +++ rdline (file); +++ lncount++; +++ if ((rv = re_exec (Line)) == 1) +++ if (--n == 0) { +++ if (lncount > 3 || (lncount > 1 && no_intty)) +++ pr ("\n...skipping\n"); +++ if (!no_intty) { +++ Currline -= (lncount >= 3 ? 3 : lncount); +++ Fseek (file, line3); +++ } +++ else { +++ kill_line (); +++ pr (Line); +++ putchar ('\n'); +++ } +++ break; +++ } +++ else if (rv == -1) +++ error ("Regular expression botch"); +++ } +++ if (feof (file)) { +++ if (!no_intty) { +++#ifdef V6 +++ file->_flag &= ~_IOEOF; /* why doesn't fseek do this ??!!??! */ +++#endif +++ Currline = saveln; +++ Fseek (file, startline); +++ } +++ else { +++ pr ("\nPattern not found\n"); +++ end_it (); +++ } +++ error ("Pattern not found"); + + } - return (i); + +} + + +++execute (filename, cmd, args) +++char *filename; +++char *cmd, *args; +++{ +++ int id; +++ +++ fflush (stdout); +++ reset_tty (); +++ while ((id = fork ()) < 0) +++ sleep (5); +++ if (id == 0) { +++ execv (cmd, &args); +++ write (2, "exec failed\n", 12); +++ exit (1); +++ } +++ signal (SIGINT, SIG_IGN); +++ signal (SIGQUIT, SIG_IGN); +++#ifdef SIGTSTP +++ if (catch_susp) +++ signal(SIGTSTP, SIG_DFL); +++#endif +++ wait (0); +++ signal (SIGINT, end_it); +++ signal (SIGQUIT, onquit); +++#ifdef SIGTSTP +++ if (catch_susp) +++ signal(SIGTSTP, onsusp); +++#endif +++ set_tty (); +++ pr ("------------------------\n"); +++ prompt (filename); +++} + +/* + +** Skip n lines in the file f + +*/ + + + +skiplns (n, f) + +register int n; + +register FILE *f; + +{ + + register char c; + + + + while (n > 0) { - while ((c = getc (f)) != '\n') +++ while ((c = Getc (f)) != '\n') + + if (c == EOF) + + return; + + n--; +++ Currline++; + + } + +} + + + +/* + +** Skip nskip files in the file list (from the command line). Nskip may be + +** negative. + +*/ + + + +skipf (nskip) + +register int nskip; + +{ + + if (nskip == 0) return; + + if (nskip > 0) { - if (fnum > nfiles - 1) - end_it (); +++ if (fnum + nskip > nfiles - 1) +++ nskip = nfiles - fnum - 1; + + } + + else if (within) + + ++fnum; + + fnum += nskip; + + if (fnum < 0) + + fnum = 0; - else if (fnum > nfiles - 1) - fnum = nfiles -1; + + pr ("\n...Skipping "); + + pr (nskip > 0 ? "to file " : "back to file "); + + pr (fnames[fnum]); + + pr ("\n\n"); + + --fnum; + +} + + - readch () +++/*----------------------------- Terminal I/O -------------------------------*/ +++ +++initterm () + +{ - char ch; +++ char buf[TBUFSIZ]; +++ char clearbuf[100]; +++ char *clearptr, *padstr; +++ char *getenv(); +++ int ldisc; +++ +++ setbuf(stdout, obuf); +++ if (!(no_tty = gtty(1, &otty))) { +++ if (tgetent(buf, getenv("TERM")) <= 0) { +++ dumb++; +++ } +++ else { +++ if (((Lpp = tgetnum("li")) < 0) || tgetflag("hc")) { +++ hard++; /* Hard copy terminal */ +++ Lpp = 24; +++ } +++ if (tailequ (fnames[0], "page") || !hard && tgetflag("ns")) +++ noscroll++; +++ if ((Mcol = tgetnum("co")) < 0) +++ Mcol = 80; +++ Wrap = tgetflag("am"); +++ bad_so = tgetflag ("xs"); +++ clearptr = clearbuf; +++ eraseln = tgetstr("ce",&clearptr); +++ Clear = tgetstr("cl", &clearptr); +++ Senter = tgetstr("so", &clearptr); +++ Sexit = tgetstr("se", &clearptr); +++ if (padstr = tgetstr("pc", &clearptr)) +++ PC = *padstr; +++ } +++ if ((shell = getenv("SHELL")) == NULL) +++ shell = "/bin/sh"; +++ } +++ no_intty = gtty(0, &otty); +++ gtty(2, &otty); +++ ospeed = otty.sg_ospeed; +++ slow_tty = ospeed < B1200; +++ hardtabs = !(otty.sg_flags & XTABS); +++ if (!no_tty) { +++ otty.sg_flags &= ~ECHO; +++ if (MBIT == CBREAK || !slow_tty) +++ otty.sg_flags |= MBIT; +++ } +++} + + - read (2, &ch, 1); - return (ch); +++readch () +++{ +++ char ch; +++ extern int errno; +++ +++ if (read (2, &ch, 1) <= 0) +++ if (errno != EINTR) +++ exit(0); +++ else +++ ch = otty.sg_kill; +++ return (ch); + +} + + + +static char BS = '\b'; + +static char CARAT = '^'; + + + +ttyin (buf, nmax, pchar) + +char buf[]; + +register int nmax; + +char pchar; + +{ + + register char *sptr; + + register char ch; + + register int slash = 0; + + int maxlen; + + char cbuf; + + + + sptr = buf; + + maxlen = 0; + + while (sptr - buf < nmax) { + + if (promptlen > maxlen) maxlen = promptlen; + + ch = readch (); + + if (ch == '\\') { + + slash++; + + } - else if (ch == otty.sg_erase && !slash) { +++ else if ((ch == otty.sg_erase) && !slash) { + + if (sptr > buf) { + + --promptlen; + + write (2, &BS, 1); + + --sptr; - if (*sptr < ' ' && *sptr != '\n') { +++ if ((*sptr < ' ' && *sptr != '\n') || *sptr == RUBOUT) { + + --promptlen; + + write (2, &BS, 1); + + } + + continue; + + } + + else { + + if (!eraseln) promptlen = maxlen; + + longjmp (restore, 1); + + } + + } - else if (ch == otty.sg_kill && !slash) { - if (hard) - pr (" XXX\n"); +++ else if ((ch == otty.sg_kill) && !slash) { +++ if (hard) { +++ show (ch); +++ putchar ('\n'); +++ putchar (pchar); +++ } + + else { + + putchar ('\r'); + + putchar (pchar); + + if (eraseln) + + erase (1); + + promptlen = 1; - sptr = buf; + + } +++ sptr = buf; + + fflush (stdout); + + continue; + + } + + if (slash && (ch == otty.sg_kill || ch == otty.sg_erase)) { + + write (2, &BS, 1); + + --sptr; + + } + + if (ch != '\\') + + slash = 0; + + *sptr++ = ch; - if (ch < ' ' && ch != '\n' && ch != ESC) { - ch += 0100; +++ if ((ch < ' ' && ch != '\n' && ch != ESC) || ch == RUBOUT) { +++ ch += ch == RUBOUT ? -0100 : 0100; + + write (2, &CARAT, 1); + + promptlen++; + + } + + cbuf = ch; + + if (ch != '\n' && ch != ESC) { + + write (2, &cbuf, 1); + + promptlen++; + + } - else break; +++ else +++ break; + + } + + *--sptr = '\0'; + + if (!eraseln) promptlen = maxlen; + + if (sptr - buf >= nmax - 1) + + error ("Line too long"); + +} + + - /* - ** Search for nth ocurrence of regular expression contained in buf in the file - */ - - search (buf, file, n) - char buf[]; - FILE *file; - register int n; - { - long startline = ftell (file); - register long line1 = startline; - register long line2 = startline; - register long line3 = startline; - register int lncount; - - lncount = 0; - compile (buf); - while (!feof (file)) { - line3 = line2; - line2 = line1; - line1 = ftell (file); - rdline (file); - lncount++; - if (execute (Line)) - if (--n == 0) { - if (lncount > 3 || (lncount > 1 && no_intty)) - pr ("\n...skipping\n"); - if (!no_intty) - fseek (file, line3, 0); - else { - kill_line (); - pr (Line); - putchar ('\n'); - } - break; - } - } - if (feof (file)) { - if (!no_intty) { - #ifdef CORY - file->_flag &= ~_IOEOF; /* why doesn't fseek do this ??!!??! */ - #endif - fseek (file, startline, 0); - } - else { - pr ("\nPattern not found\n"); - end_it (); - } - error ("Pattern not found"); - } - } - - /* - * The following are adapted from the editor - */ - - /* - * Internal form of regular expressions. - */ - #define CBRA 1 /* left \( bracket */ - #define CCHR 2 /* a particular character */ - #define CDOT 4 /* any char (.) */ - #define CCL 6 /* begin class ([) */ - #define NCCL 8 /* begin not class ([^) */ - #define CDOL 10 /* end of line ($) */ - #define CEOF 11 /* end of pattern */ - #define CKET 12 /* right \) bracket */ - #define CBACK 14 /* repeat previous match (\1, etc on lhs) */ - - #define STAR 01 /* or'ed with some symbols to indicate * suffix */ - - #define NBRA 5 /* max # of \( \) pairs */ - - char expbuf[BUFSIZ]; - char *braslist[NBRA]; - char *braelist[NBRA]; - int nbra; - int circfl; - char *loc1; - char *loc2; - char *locs; - - - /* - * compile: convert typed in regular expression into internal form. - * eof is the char that delimits the r.e. - * General structure of compiled r.e. in expbuf: A sequence of codes - * from #defines above (CCHR, CDOT, etc). Some of these take arguments - * which follow in line (e.g. CCHR is followed by the particular character - * it is required to match.) CEOF terminates the r.e. - */ - compile(inbuf) - char inbuf[]; +++expand (outbuf, inbuf) +++char *outbuf; +++char *inbuf; + +{ - register char c; - register char *ep; - register char *bp = inbuf; - char *lastep; - char bracket[NBRA], *bracketp; - int cclcnt; - - /* comerr: compilation error. Don't leave half baked r.e. around. */ - #define comerr(msg) {expbuf[0] = 0; nbra = 0; error(msg); } - ep = expbuf; - bracketp = bracket; - if ((c = *bp++) == '\0') { - /* null r.e.: just re-use last r.e., which is still there */ - if (*ep==0) - error("No previous regular expression"); - return; - } - nbra = 0; - /* circfl: true if have ^ (anchored search). */ - circfl = 0; - if (c == '^') { - c = *bp++; - circfl++; - } - lastep = 0; - --bp; - for (;;) { /* for each character in the r.e. */ - if (ep >= &expbuf[BUFSIZ]) - comerr("r.e. too long"); - c = *bp++; - if (c == '\0') { - /* Hit trailing delim: clean up and quit */ - if (bracketp != bracket) - comerr("unmatched \\("); - *ep++ = CEOF; - *ep++ = 0; - return; - } - if (c!='*') - lastep = ep; - switch (c) { - - case '\\': - if ((c = *bp++)=='(') { - /* \(: start of subexpression */ - if (nbra >= NBRA) - comerr("too many \\(\\) pairs"); - *bracketp++ = nbra; - *ep++ = CBRA; - *ep++ = nbra++; - continue; - } - if (c == ')') { - /* \): end of sub exp */ - if (bracketp <= bracket) - comerr("unmatched \\)"); - *ep++ = CKET; - *ep++ = *--bracketp; - continue; - } - if (c>='1' && c<'1'+NBRA) { - /* \1, \2, ...: rematch previous subexp */ - *ep++ = CBACK; - *ep++ = c-'1'; - continue; - } - /* Otherwise just force that char, not specially */ - *ep++ = CCHR; - if (c=='\n') - /* Newlines can't possibly be in lines */ - comerr("multi line r.e. not allowed"); - *ep++ = c; - continue; - - case '.': - /* .: match any character */ - *ep++ = CDOT; - continue; - - case '*': - /* *: Repeat last char indefinitely */ - if (lastep==0 || *lastep==CBRA || *lastep==CKET) - /* Not that smart, so treat * as nonspecial */ - goto defchar; - *lastep |= STAR; - continue; - - case '$': - /* $: match end of line */ - if (*bp != '\0') - /* $ only special at end of r.e. */ - goto defchar; - *ep++ = CDOL; - continue; - - case '[': - /* - * [...]: any of chars enclosed in brackets. - * Compiled form: CCL or NCCL, # of possible chars, - * then each char. -'s are expanded. - */ - *ep++ = CCL; - *ep++ = 0; - cclcnt = 1; - if ((c = *bp++) == '^') { - /* [^...]: reverse sense of match */ - c = *bp++; - ep[-2] = NCCL; - } - do { /* for each char in brackets */ - if (c=='\n') - comerr("missing ]"); - if (c == '-' && ep[-1] != 0) { - /* form ...a-z... but [- not special */ - if ((c = *bp++) == ']') { - /* -] not special either */ - *ep++ = '-'; - cclcnt++; - break; - } - while (ep[-1]=&expbuf[BUFSIZ]) - comerr("Too long"); - } - } - *ep++ = c; - cclcnt++; - if (ep >= &expbuf[BUFSIZ]) - comerr("Too long"); - } while ((c = *bp++) != ']'); - lastep[1] = cclcnt; /* backpatch count */ - continue; - - defchar: - default: - /* - * An ordinary char or one treated as ordinary. - * Store CCHR followed by that char, rather than - * just the char. This causes most r.e.'s to take - * up about twice the space you would expect. - * On the other hand, it makes r.e.'s beautifully - * portable, even though the codes could be real - * characters. - */ - *ep++ = CCHR; - *ep++ = c; - } - } - } - - /* - * execute: look for the compiled r.e. on line addr. - * gf is 0 if this is the first time on this line, otherwise nonzero. - * If not first, start looking at locs, otherwise at beg of linebuf. - * loc1 and loc2 are set to the ends of the pattern found, if any. - * 1 is returned if successful, otherwise 0. - */ - execute(lptr) - char *lptr; - { - register char *p1, *p2; - register int c; - - for (c=0; c= curlp) { - if (advance(lp, ep)) - return(1); - lp -= braelist[i] - braslist[i]; - } - continue; - - case CDOT|STAR: - curlp = lp; - while (*lp++) - ; - goto star; - - case CCHR|STAR: - curlp = lp; - while (*lp++ == *ep) - ; - ep++; - goto star; - - case CCL|STAR: - case NCCL|STAR: - curlp = lp; - while (cclass(ep, *lp++, ep[-1]==(CCL|STAR))) - ; - ep += *ep; - goto star; - - star: - /* - * star: special treatment. We have found as many of them - * as there are to find. Maybe this was too many, as dictated - * by what follows in the pattern. Try, starting from the - * end, to recursively advance after each char found, - * and return after first successful advance (thus finding - * largest possible string that matches). - */ - do { - lp--; - if (lp==locs) - break; - if (advance(lp, ep)) - return(1); - } while (lp > curlp); - /* star failed at all attempts, so whole pattern fails. */ - return(0); - +++ register char *instr; +++ register char *outstr; +++ register char ch; +++ char temp[200]; +++ int changed = 0; +++ +++ instr = inbuf; +++ outstr = temp; +++ while ((ch = *instr++) != '\0') +++ switch (ch) { +++ case '%': +++ if (!no_intty) { +++ strcpy (outstr, fnames[fnum]); +++ outstr += strlen (fnames[fnum]); +++ changed++; +++ } +++ else +++ *outstr++ = ch; +++ break; +++ case '!': +++ if (!shellp) +++ error ("No previous command to substitute for"); +++ strcpy (outstr, shell_line); +++ outstr += strlen (shell_line); +++ changed++; +++ break; +++ case '\\': +++ if (*instr == '%' || *instr == '!') { +++ *outstr++ = *instr++; +++ break; +++ } + + default: - longjmp (restore, 1); +++ *outstr++ = ch; + + } +++ *outstr++ = '\0'; +++ strcpy (outbuf, temp); +++ return (changed); + +} + + - /* - * backref: checks to see that text starting at lp matches previous - * sub-expression #i. Returns 1 if successful, else 0. (Used for \k - * on lhs.) - */ - backref(i, lp) - register int i; - register char *lp; +++show (ch) +++register char ch; + +{ - register char *bp; - - bp = braslist[i]; - while (*bp++ == *lp++) - if (bp >= braelist[i]) - return(1); - return(0); - } +++ char cbuf; + + - /* - * cclass: check to see if character c is in class starting at set. - * ([...] construction on lhs of r.e.) af is sense of success/failure: - * af=1 is normal (success returns 1), af=0 is reversed for [^ (success - * returns 0). - */ - int - cclass(set, c, af) - register char *set, c; - int af; - { - register n; - - if (c==0) - return(0); - n = *set++; - while (--n) - if (*set++ == c) - return(af); - return(!af); +++ if ((ch < ' ' && ch != '\n' && ch != ESC) || ch == RUBOUT) { +++ ch += ch == RUBOUT ? -0100 : 0100; +++ write (2, &CARAT, 1); +++ promptlen++; +++ } +++ cbuf = ch; +++ write (2, &cbuf, 1); +++ promptlen++; + +} + + + +error (mess) + +char *mess; + +{ - if (promptlen > 0) - if (hard) - putchar ('\n'); - else - kill_line (); +++ kill_line (); + + promptlen += strlen (mess); + + if (Senter && Sexit) { + + tputs (Senter, 1, putch); + + pr(mess); + + tputs (Sexit, 1, putch); + + } + + else + + pr (mess); - if (hard) - putchar ('\n'); + + fflush(stdout); + + errors++; + + longjmp (restore, 1); + +} + + +++ +++set_tty () +++{ +++ otty.sg_flags |= MBIT; +++ otty.sg_flags &= ~ECHO; +++ stty(2, &otty); +++} +++ +++reset_tty () +++{ +++ otty.sg_flags |= ECHO; +++ otty.sg_flags &= ~MBIT; +++ stty(2, &otty); +++} +++ + +rdline (f) + +register FILE *f; + +{ + + register char c; + + register char *p; + + + + p = Line; - while ((c = getc (f)) != '\n' && c != EOF && p - Line < LINSIZ - 1) +++ while ((c = Getc (f)) != '\n' && c != EOF && p - Line < LINSIZ - 1) + + *p++ = c; +++ if (c == '\n') +++ Currline++; + + *p = '\0'; + +} +++ +++/* Come here when we get a suspend signal from the terminal */ +++ +++#ifdef SIGTSTP +++onsusp () +++{ +++ reset_tty (); +++ fflush (stdout); +++ /* Send the TSTP signal to suspend our process group */ +++ kill (0, SIGTSTP); +++ /* Pause for station break */ +++ +++ /* We're back */ +++ signal (SIGTSTP, onsusp); +++ set_tty (); +++ if (inwait) +++ longjmp (restore); +++} +++#endif diff --cc usr/src/cmd/mount.c index 0000000000,6ec1d0088b,0000000000..69324cfc24 mode 000000,100644,000000..100644 --- a/usr/src/cmd/mount.c +++ b/usr/src/cmd/mount.c @@@@ -1,0 -1,65 -1,0 +1,137 @@@@ +++static char *sccsid = "@(#)mount.c 4.3 (Berkeley) 10/15/80"; + +#include +++#include + + +++/* +++ * mount +++ */ +++ +++int mountall; + +#define NMOUNT 16 + +#define NAMSIZ 32 + + + +struct mtab { + + char file[NAMSIZ]; + + char spec[NAMSIZ]; + +} mtab[NMOUNT]; + + +++int ro; + +main(argc, argv) + +char **argv; + +{ - register int ro; + + register struct mtab *mp; + + register char *np; + + int mf; + + +++ mountall = 0; + + mf = open("/etc/mtab", 0); + + read(mf, (char *)mtab, NMOUNT*2*NAMSIZ); + + if (argc==1) { + + for (mp = mtab; mp < &mtab[NMOUNT]; mp++) + + if (mp->file[0]) + + printf("%s on %s\n", mp->spec, mp->file); + + exit(0); + + } - if(argc < 3) { - fprintf(stderr,"arg count\n"); - exit(1); +++ +++ if (argc == 2){ +++ if (strcmp(argv[1], "-a") == 0) +++ mountall++; +++ else { +++ fprintf(stdout,"arg count\n"); +++ exit(1); +++ } + + } - ro = 0; - if(argc > 3) - ro++; - if(mount(argv[1], argv[2], ro) < 0) { - perror("mount"); - exit(1); +++ +++ if (!mountall){ +++ ro = 0; +++ if(argc > 3) +++ ro++; +++ if (mountfs(argv[1], argv[2], ro)){ +++ perror("mount"); +++ exit(1); +++ } +++ } else { +++ struct fstab *fsp; +++ close(2); dup(1); +++ if (setfsent() == 0) +++ perror(FSTAB), exit(1); +++ while ( (fsp = getfsent()) != 0){ +++ if (strcmp(fsp->fs_file, "/") == 0) +++ continue; +++ ro = !strcmp(fsp->fs_type, FSTAB_RO); +++ if (ro==0 && strcmp(fsp->fs_type, FSTAB_RW)) +++ continue; +++ if (mountfs(fsp->fs_spec, fsp->fs_file, ro)) +++ failed(fsp); +++ else +++ succeed(fsp); +++ } +++ endfsent(); + + } - np = argv[1]; +++ exit(0); +++} +++failed(fsp) +++ register struct fstab *fsp; +++{ +++ extern int errno; +++ extern char *sys_errlist[]; +++ int err = errno; +++ printf("Attempt to mount "); +++ location(fsp); +++ printf("FAILED: %s\n", sys_errlist[err]); +++} +++succeed(fsp) +++ register struct fstab *fsp; +++{ +++ printf("Mounted "); +++ location(fsp); +++ printf("\n"); +++} +++location(fsp) +++ register struct fstab *fsp; +++{ +++ extern int ro; +++ printf("%s on %s %s ", +++ fsp->fs_file, fsp->fs_spec, +++ ro ? "(Read Only)" : ""); +++} +++ +++mountfs(spec, name, ro) +++ char *spec, *name; +++ int ro; +++{ +++ register char *np; +++ register struct mtab *mp; +++ int mf; +++ +++ if(mount(spec, name, ro) < 0) { +++ return(1); +++ } +++ np = spec; + + while(*np++) + + ; + + np--; + + while(*--np == '/') + + *np = '\0'; - while(np > argv[1] && *--np != '/') +++ while(np > spec && *--np != '/') + + ; + + if(*np == '/') + + np++; - argv[1] = np; +++ spec = np; + + for (mp = mtab; mp < &mtab[NMOUNT]; mp++) { + + if (mp->file[0] == 0) { + + for (np = mp->spec; np < &mp->spec[NAMSIZ-1];) - if ((*np++ = *argv[1]++) == 0) - argv[1]--; +++ if ((*np++ = *spec++) == 0) +++ spec--; + + for (np = mp->file; np < &mp->file[NAMSIZ-1];) - if ((*np++ = *argv[2]++) == 0) - argv[2]--; +++ if ((*np++ = *name++) == 0) +++ name--; + + mp = &mtab[NMOUNT]; + + while ((--mp)->file[0] == 0); + + mf = creat("/etc/mtab", 0644); + + write(mf, (char *)mtab, (mp-mtab+1)*2*NAMSIZ); - exit(0); +++ return(0); + + } + + } - exit(0); +++ return(0); + +} diff --cc usr/src/cmd/mv.c index 0000000000,0e2b7017a3,0000000000..c020c6b508 mode 000000,100644,000000..100644 --- a/usr/src/cmd/mv.c +++ b/usr/src/cmd/mv.c @@@@ -1,0 -1,297 -1,0 +1,343 @@@@ +++static char *sccsid = "@(#)mv.c 4.1 (Berkeley) 10/6/80"; + +/* + + * mv file1 file2 + + */ + + + +#include + +#include + +#include + +#include + +#include + + + +#define DOT "." + +#define DOTDOT ".." + +#define DELIM '/' + +#define SDELIM "/" + +#define MAXN 100 + +#define MODEBITS 07777 + +#define ROOTINO 2 + + + +char *pname(); + +char *sprintf(); + +char *dname(); + +struct stat s1, s2; +++int iflag = 0; /* interactive flag. If this flag is set, +++ * the user is queried before files are +++ * destroyed by cp. +++ */ +++int fflag = 0; /* force flag. supercedes all restrictions */ + + + +main(argc, argv) + +register char *argv[]; + +{ + + register i, r; + + +++ /* get the flag(s) */ +++ +++ if (argc < 2) +++ goto usage; +++ if (*argv[1] == '-') { +++ argc--; +++ while (*++argv[1] != '\0') +++ switch (*argv[1]) { +++ +++ /* interactive mode */ +++ case 'i': +++ iflag++; +++ break; +++ +++ /* force moves */ +++ case 'f': +++ fflag++; +++ break; +++ +++ /* don't live with bad options */ +++ default: +++ goto usage; +++ } +++ argv++; +++ } + + if (argc < 3) + + goto usage; + + if (stat(argv[1], &s1) < 0) { + + fprintf(stderr, "mv: cannot access %s\n", argv[1]); + + return(1); + + } + + if ((s1.st_mode & S_IFMT) == S_IFDIR) { + + if (argc != 3) + + goto usage; + + return mvdir(argv[1], argv[2]); + + } + + setuid(getuid()); + + if (argc > 3) + + if (stat(argv[argc-1], &s2) < 0 || (s2.st_mode & S_IFMT) != S_IFDIR) + + goto usage; + + r = 0; + + for (i=1; i= 0) { + + if ((s2.st_mode & S_IFMT) == S_IFDIR) { + + sprintf(buf, "%s/%s", target, dname(source)); + + target = buf; + + } + + if (stat(target, &s2) >= 0) { + + if ((s2.st_mode & S_IFMT) == S_IFDIR) { + + fprintf(stderr, "mv: %s is a directory\n", target); + + return(1); +++ } else if (iflag && !fflag) { +++ fprintf(stderr, "remove %s? ", target); +++ i = c = getchar(); +++ while (c != '\n' && c != EOF) +++ c = getchar(); +++ if (i != 'y') +++ return(1); + + } + + if (s1.st_dev==s2.st_dev && s1.st_ino==s2.st_ino) { + + fprintf(stderr, "mv: %s and %s are identical\n", + + source, target); + + return(1); + + } - if (access(target, 2) < 0 && isatty(fileno(stdin))) { - fprintf(stderr, "mv: %s: %o mode ", target, - s2.st_mode & MODEBITS); +++ if (access(target, 2) < 0 && !fflag && isatty(fileno(stdin))) { +++ fprintf(stderr, "override protection %o for %s? ", +++ s2.st_mode & MODEBITS, target); + + i = c = getchar(); + + while (c != '\n' && c != EOF) + + c = getchar(); + + if (i != 'y') + + return(1); + + } + + if (unlink(target) < 0) { + + fprintf(stderr, "mv: cannot unlink %s\n", target); + + return(1); + + } + + } + + } + + if (link(source, target) < 0) { + + i = fork(); + + if (i == -1) { + + fprintf(stderr, "mv: try again\n"); + + return(1); + + } + + if (i == 0) { + + execl("/bin/cp", "cp", source, target, 0); + + fprintf(stderr, "mv: cannot exec cp\n"); + + exit(1); + + } + + while ((c = wait(&status)) != i && c != -1) + + ; + + if (status != 0) + + return(1); + + utime(target, &s1.st_atime); + + } + + if (unlink(source) < 0) { + + fprintf(stderr, "mv: cannot unlink %s\n", source); + + return(1); + + } + + return(0); + +} + + + +mvdir(source, target) + +char *source, *target; + +{ + + register char *p; + + register i; + + char buf[MAXN]; +++ char c,cc; + + + + if (stat(target, &s2) >= 0) { + + if ((s2.st_mode&S_IFMT) != S_IFDIR) { + + fprintf(stderr, "mv: %s exists\n", target); + + return(1); +++ } else if (iflag && !fflag) { +++ fprintf(stderr, "remove %s? ", target); +++ cc = c = getchar(); +++ while (c != '\n' && c != EOF) +++ c = getchar(); +++ if (cc != 'y') +++ return(1); + + } + + if (strlen(target) > MAXN-DIRSIZ-2) { + + fprintf(stderr, "mv :target name too long\n"); + + return(1); + + } + + strcpy(buf, target); + + target = buf; + + strcat(buf, SDELIM); + + strcat(buf, dname(source)); + + if (stat(target, &s2) >= 0) { + + fprintf(stderr, "mv: %s exists\n", buf); + + return(1); + + } + + } + + if (strcmp(source, target) == 0) { + + fprintf(stderr, "mv: ?? source == target, source exists and target doesnt\n"); + + return(1); + + } + + p = dname(source); + + if (!strcmp(p, DOT) || !strcmp(p, DOTDOT) || !strcmp(p, "") || p[strlen(p)-1]=='/') { + + fprintf(stderr, "mv: cannot rename %s\n", p); + + return(1); + + } + + if (stat(pname(source), &s1) < 0 || stat(pname(target), &s2) < 0) { + + fprintf(stderr, "mv: cannot locate parent\n"); + + return(1); + + } + + if (access(pname(target), 2) < 0) { + + fprintf(stderr, "mv: no write access to %s\n", pname(target)); + + return(1); + + } + + if (access(pname(source), 2) < 0) { + + fprintf(stderr, "mv: no write access to %s\n", pname(source)); + + return(1); + + } + + if (access(source, 2) < 0) { + + fprintf(stderr, "mv: no write access to %s\n", source); + + return(1); + + } + + if (s1.st_dev != s2.st_dev) { + + fprintf(stderr, "mv: cannot move directories across devices\n"); + + return(1); + + } + + if (s1.st_ino != s2.st_ino) { + + char dst[MAXN+5]; + + + + if (chkdot(source) || chkdot(target)) { + + fprintf(stderr, "mv: Sorry, path names including %s aren't allowed\n", DOTDOT); + + return(1); + + } + + stat(source, &s1); + + if (check(pname(target), s1.st_ino)) + + return(1); + + for (i = 1; i <= NSIG; i++) + + signal(i, SIG_IGN); + + if (link(source, target) < 0) { + + fprintf(stderr, "mv: cannot link %s to %s\n", target, source); + + return(1); + + } + + if (unlink(source) < 0) { + + fprintf(stderr, "mv: %s: cannot unlink\n", source); + + unlink(target); + + return(1); + + } + + strcat(dst, target); + + strcat(dst, "/"); + + strcat(dst, DOTDOT); + + if (unlink(dst) < 0) { + + fprintf(stderr, "mv: %s: cannot unlink\n", dst); + + if (link(target, source) >= 0) + + unlink(target); + + return(1); + + } + + if (link(pname(target), dst) < 0) { + + fprintf(stderr, "mv: cannot link %s to %s\n", + + dst, pname(target)); + + if (link(pname(source), dst) >= 0) + + if (link(target, source) >= 0) + + unlink(target); + + return(1); + + } + + return(0); + + } + + if (link(source, target) < 0) { + + fprintf(stderr, "mv: cannot link %s and %s\n", + + source, target); + + return(1); + + } + + if (unlink(source) < 0) { + + fprintf(stderr, "mv: ?? cannot unlink %s\n", source); + + return(1); + + } + + return(0); + +} + + + +char * + +pname(name) + +register char *name; + +{ + + register c; + + register char *p, *q; + + static char buf[MAXN]; + + + + p = q = buf; + + while (c = *p++ = *name++) + + if (c == DELIM) + + q = p-1; + + if (q == buf && *q == DELIM) + + q++; + + *q = 0; + + return buf[0]? buf : DOT; + +} + + + +char * + +dname(name) + +register char *name; + +{ + + register char *p; + + + + p = name; + + while (*p) + + if (*p++ == DELIM && *p) + + name = p; + + return name; + +} + + + +check(spth, dinode) + +char *spth; + +ino_t dinode; + +{ + + char nspth[MAXN]; + + struct stat sbuf; + + + + sbuf.st_ino = 0; + + + + strcpy(nspth, spth); + + while (sbuf.st_ino != ROOTINO) { + + if (stat(nspth, &sbuf) < 0) { + + fprintf(stderr, "mv: cannot access %s\n", nspth); + + return(1); + + } + + if (sbuf.st_ino == dinode) { + + fprintf(stderr, "mv: cannot move a directory into itself\n"); + + return(1); + + } + + if (strlen(nspth) > MAXN-2-sizeof(DOTDOT)) { + + fprintf(stderr, "mv: name too long\n"); + + return(1); + + } + + strcat(nspth, SDELIM); + + strcat(nspth, DOTDOT); + + } + + return(0); + +} + + + +chkdot(s) + +register char *s; + +{ + + do { + + if (strcmp(dname(s), DOTDOT) == 0) + + return(1); + + s = pname(s); + + } while (strcmp(s, DOT) != 0 && strcmp(s, SDELIM) != 0); + + return(0); + +} diff --cc usr/src/cmd/ncheck.c index 0000000000,3bbe4a2db4,0000000000..b78f36d8b8 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ncheck.c +++ b/usr/src/cmd/ncheck.c @@@@ -1,0 -1,322 -1,0 +1,323 @@@@ +++static char *sccsid = "@(#)ncheck.c 4.1 (Berkeley) 10/1/80"; + +/* + + * ncheck -- obtain file names from reading filesystem + + */ + + + +#define NI 16 - #define NB 100 +++#define NB 500 + +#define HSIZE 2503 + +#define NDIR (BSIZE/sizeof(struct direct)) + + + +#include + +#include + +#include + +#include + +#include + +#include + +#include + + + +struct filsys sblock; + +struct dinode itab[INOPB*NI]; + +daddr_t iaddr[NADDR]; + +ino_t ilist[NB]; + +struct htab + +{ + + ino_t h_ino; + + ino_t h_pino; + + char h_name[DIRSIZ]; + +} htab[HSIZE]; + + + +int aflg; + +int sflg; + +int fi; + +ino_t ino; + +int nhent; + +int nxfile; + + + +int nerror; + +daddr_t bmap(); + +long atol(); + +struct htab *lookup(); + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + long n; + + + + while (--argc) { + + argv++; + + if (**argv=='-') + + switch ((*argv)[1]) { + + + + case 'a': + + aflg++; + + continue; + + + + case 'i': + + for(i=0; i= mino) + + break; + + bread((daddr_t)i, (char *)itab, sizeof(itab)); + + for(j=0; j= mino) + + break; + + ino++; + + pass1(&itab[j]); + + } + + } + + ilist[nxfile+1] = 0; + + ino = 0; + + for(i=2;; i+=NI) { + + if(ino >= mino) + + break; + + bread((daddr_t)i, (char *)itab, sizeof(itab)); + + for(j=0; j= mino) + + break; + + ino++; + + pass2(&itab[j]); + + } + + } + + ino = 0; + + for(i=2;; i+=NI) { + + if(ino >= mino) + + break; + + bread((daddr_t)i, (char *)itab, sizeof(itab)); + + for(j=0; j= mino) + + break; + + ino++; + + pass3(&itab[j]); + + } + + } + +} + + + +pass1(ip) + +register struct dinode *ip; + +{ + + if((ip->di_mode & IFMT) != IFDIR) { + + if (sflg==0 || nxfile>=NB) + + return; + + if ((ip->di_mode&IFMT)==IFBLK || (ip->di_mode&IFMT)==IFCHR + + || ip->di_mode&(ISUID|ISGID)) + + ilist[nxfile++] = ino; + + return; + + } + + lookup(ino, 1); + +} + + + +pass2(ip) + +register struct dinode *ip; + +{ + + struct direct dbuf[NDIR]; + + long doff; + + struct direct *dp; + + register i, j; + + int k; + + struct htab *hp; + + daddr_t d; + + ino_t kno; + + + + if((ip->di_mode&IFMT) != IFDIR) + + return; + + l3tol(iaddr, ip->di_addr, NADDR); + + doff = 0; + + for(i=0;; i++) { + + if(doff >= ip->di_size) + + break; + + d = bmap(i); + + if(d == 0) + + break; + + bread(d, (char *)dbuf, sizeof(dbuf)); + + for(j=0; j= ip->di_size) + + break; + + doff += sizeof(struct direct); + + dp = dbuf+j; + + kno = dp->d_ino; + + if(kno == 0) + + continue; + + hp = lookup(kno, 0); + + if(hp == 0) + + continue; + + if(dotname(dp)) + + continue; + + hp->h_pino = ino; + + for(k=0; kh_name[k] = dp->d_name[k]; + + } + + } + +} + + + +pass3(ip) + +register struct dinode *ip; + +{ + + struct direct dbuf[NDIR]; + + long doff; + + struct direct *dp; + + register i, j; + + int k; + + daddr_t d; + + ino_t kno; + + + + if((ip->di_mode&IFMT) != IFDIR) + + return; + + l3tol(iaddr, ip->di_addr, NADDR); + + doff = 0; + + for(i=0;; i++) { + + if(doff >= ip->di_size) + + break; + + d = bmap(i); + + if(d == 0) + + break; + + bread(d, (char *)dbuf, sizeof(dbuf)); + + for(j=0; j= ip->di_size) + + break; + + doff += sizeof(struct direct); + + dp = dbuf+j; + + kno = dp->d_ino; + + if(kno == 0) + + continue; + + if(aflg==0 && dotname(dp)) + + continue; + + if(ilist[0] == 0) + + goto pr; + + for(k=0; ilist[k] != 0; k++) + + if(ilist[k] == kno) + + goto pr; + + continue; + + pr: + + printf("%u ", kno); + + pname(ino, 0); + + printf("/%.14s", dp->d_name); + + if (lookup(kno, 0)) + + printf("/."); + + printf("\n"); + + } + + } + +} + + + +dotname(dp) + +register struct direct *dp; + +{ + + + + if (dp->d_name[0]=='.') + + if (dp->d_name[1]==0 || (dp->d_name[1]=='.' && dp->d_name[2]==0)) + + return(1); + + return(0); + +} + + + +pname(i, lev) + +ino_t i; + +{ + + register struct htab *hp; + + + + if (i==ROOTINO) + + return; + + if ((hp = lookup(i, 0)) == 0) { + + printf("???"); + + return; + + } + + if (lev > 10) { + + printf("..."); + + return; + + } + + pname(hp->h_pino, ++lev); + + printf("/%.14s", hp->h_name); + +} + + + +struct htab * + +lookup(i, ef) + +ino_t i; + +{ + + register struct htab *hp; + + + + for (hp = &htab[i%HSIZE]; hp->h_ino;) { + + if (hp->h_ino==i) + + return(hp); + + if (++hp >= &htab[HSIZE]) + + hp = htab; + + } + + if (ef==0) + + return(0); + + if (++nhent >= HSIZE) { + + fprintf(stderr, "ncheck: out of core-- increase HSIZE\n"); + + exit(1); + + } + + hp->h_ino = i; + + return(hp); + +} + + + +bread(bno, buf, cnt) + +daddr_t bno; + +char *buf; + +{ + + register i; + + + + lseek(fi, bno*BSIZE, 0); + + if (read(fi, buf, cnt) != cnt) { + + fprintf(stderr, "ncheck: read error %d\n", bno); + + for(i=0; i NINDIR) { + + fprintf(stderr, "ncheck: %u - huge directory\n", ino); + + return((daddr_t)0); + + } + + bread(iaddr[NADDR-3], (char *)ibuf, sizeof(ibuf)); + + return(ibuf[i]); + +} diff --cc usr/src/cmd/newgrp.c index 0000000000,1982259f29,0000000000..8cd048f9e2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/newgrp.c +++ b/usr/src/cmd/newgrp.c @@@@ -1,0 -1,50 -1,0 +1,51 @@@@ +++static char *sccsid = "@(#)newgrp.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + + + +struct group *getgrnam(), *grp; + +struct passwd *getpwuid(), *pwd; + +char *getpass(), *crypt(); + + + +main(argc,argv) + +int argc; + +char **argv; + +{ + + register i; + + if(argc != 2) { + + printf("usage: newgrp groupname\n"); + + exit(13); + + } + + if((grp=getgrnam(argv[1])) == NULL) { + + printf("%s: no such group\n", argv[1]); + + exit(13); + + } + + if((pwd=getpwuid(getuid())) == NULL) { + + printf("You do not exist!\n"); + + exit(13); + + } + + for(i=0;grp->gr_mem[i];i++) + + if(strcmp(grp->gr_mem[i], pwd->pw_name) == 0) + + break; + + if(grp->gr_mem[i] == 0 && strcmp(grp->gr_name,"other")) { + + printf("Sorry\n"); + + exit(13); + + } + + + + if(grp->gr_passwd[0] != '\0' && pwd->pw_passwd[0] == '\0') { + + if(strcmp(grp->gr_passwd, crypt(getpass("Password:"),grp->gr_passwd)) != 0) { + + printf("Sorry\n"); + + exit(13); + + } + + } + + if(setgid(grp->gr_gid) < 0) { + + perror("setgid"); + + exit(13); + + } + + setuid(getuid()); + + for (i=3; i<15; i++) + + close(i); + + execl((pwd->pw_shell[0]?pwd->pw_shell:"/bin/sh"), "-i", 0); + + printf("No shell!\n"); + + exit(0); + +} diff --cc usr/src/cmd/nice.c index 0000000000,ed22a93cec,0000000000..d5b1f58ebd mode 000000,100644,000000..100644 --- a/usr/src/cmd/nice.c +++ b/usr/src/cmd/nice.c @@@@ -1,0 -1,26 -1,0 +1,27 @@@@ +++static char *sccsid = "@(#)nice.c 4.1 (Berkeley) 10/1/80"; + +/* nice */ + + + +#include + + + +main(argc, argv) + +int argc; + +char *argv[]; + +{ + + int nicarg = 10; + + extern errno; + + extern char *sys_errlist[]; + + + + if(argc > 1 && argv[1][0] == '-') { + + nicarg = atoi(&argv[1][1]); + + argc--; + + argv++; + + } + + if(argc < 2) { + + fputs("usage: nice [ -n ] command\n", stderr); + + exit(1); + + } + + nice(nicarg); + + execvp(argv[1], &argv[1]); + + fprintf(stderr, "%s: %s\n", sys_errlist[errno], argv[1]); + + exit(1); + +} diff --cc usr/src/cmd/nm.c index 0000000000,1c620f3804,0000000000..38b890641a mode 000000,100644,000000..100644 --- a/usr/src/cmd/nm.c +++ b/usr/src/cmd/nm.c @@@@ -1,0 -1,243 -1,0 +1,343 @@@@ +++static char sccsid[] = "@(#)nm.c 4.1 10/1/80"; + +/* - ** print symbol tables for - ** object or archive files - ** - ** nm [-goprun] [name ...] - */ - - - - #include - #include - #include - #include - #include - - #define MAGIC exp.a_magic - #define BADMAG MAGIC!=A_MAGIC1 && MAGIC!=A_MAGIC2 \ - && MAGIC!=A_MAGIC3 && MAGIC!=A_MAGIC4 && MAGIC != 0412 && MAGIC != 0413 - #define SELECT arch_flg ? arp.ar_name : *argv - int numsort_flg; - int undef_flg; - int revsort_flg = 1; - int globl_flg; - int nosort_flg; - int arch_flg; - int prep_flg; - struct ar_hdr arp; - struct exec exp; +++ * nm - print name list; VAX string table version +++ */ +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++ +++#define SELECT archive ? archdr.ar_name : *xargv +++ +++int aflg, gflg, nflg, oflg, pflg, uflg; +++int rflg = 1; +++char **xargv; +++int archive; +++struct ar_hdr archdr; +++union { +++ char mag_armag[SARMAG+1]; +++ struct exec mag_exp; +++} mag_un; +++#define OARMAG 0177545 + +FILE *fi; - long off; - long ftell(); +++off_t off; +++off_t ftell(); + +char *malloc(); + +char *realloc(); +++char *strp; +++char *stab(); +++off_t strsiz; +++int compare(); +++int narg; +++int errs; + + + +main(argc, argv) + +char **argv; + +{ - int narg; - int compare(); + + + + if (--argc>0 && argv[1][0]=='-' && argv[1][1]!=0) { + + argv++; + + while (*++*argv) switch (**argv) { - case 'n': /* sort numerically */ - numsort_flg++; - continue; + + - case 'g': /* globl symbols only */ - globl_flg++; +++ case 'n': +++ nflg++; + + continue; - - case 'u': /* undefined symbols only */ - undef_flg++; +++ case 'g': +++ gflg++; + + continue; - - case 'r': /* sort in reverse order */ - revsort_flg = -1; +++ case 'u': +++ uflg++; + + continue; - - case 'p': /* don't sort -- symbol table order */ - nosort_flg++; +++ case 'r': +++ rflg = -1; + + continue; - - case 'o': /* prepend a name to each line */ - prep_flg++; +++ case 'p': +++ pflg++; + + continue; - - default: /* oops */ - fprintf(stderr, "nm: invalid argument -%c\n", *argv[0]); - exit(1); +++ case 'o': +++ oflg++; +++ continue; +++ case 'a': +++ aflg++; +++ continue; +++ default: +++ fprintf(stderr, "nm: invalid argument -%c\n", +++ *argv[0]); +++ exit(2); + + } + + argc--; + + } + + if (argc == 0) { + + argc = 1; + + argv[1] = "a.out"; + + } + + narg = argc; - while(argc--) { - fi = fopen(*++argv,"r"); - if (fi == NULL) { - fprintf(stderr, "nm: cannot open %s\n", *argv); +++ xargv = argv; +++ while (argc--) { +++ ++xargv; +++ namelist(); +++ } +++ exit(errs); +++} +++ +++namelist() +++{ +++ register int j; +++ +++ archive = 0; +++ fi = fopen(*xargv, "r"); +++ if (fi == NULL) { +++ error(0, "cannot open"); +++ return; +++ } +++ off = SARMAG; +++ fread((char *)&mag_un, 1, sizeof(mag_un), fi); +++ if (mag_un.mag_exp.a_magic == OARMAG) { +++ error(0, "old archive"); +++ return; +++ } +++ if (strncmp(mag_un.mag_armag, ARMAG, SARMAG)==0) +++ archive++; +++ else if (N_BADMAG(mag_un.mag_exp)) { +++ error(0, "bad format"); +++ return; +++ } +++ fseek(fi, 0L, 0); +++ if (archive) { +++ nextel(fi); +++ if (narg > 1) +++ printf("\n%s:\n", *xargv); +++ } +++ do { +++ off_t o; +++ register i, n, c; +++ struct nlist *symp = NULL; +++ struct nlist sym; +++ struct stat stb; +++ +++ fread((char *)&mag_un.mag_exp, 1, sizeof(struct exec), fi); +++ if (N_BADMAG(mag_un.mag_exp)) +++ continue; +++ if (archive == 0) +++ fstat(fileno(fi), &stb); +++ o = N_SYMOFF(mag_un.mag_exp) - sizeof (struct exec); +++ fseek(fi, o, 1); +++ n = mag_un.mag_exp.a_syms / sizeof(struct nlist); +++ if (n == 0) { +++ error(0, "no name list"); + + continue; + + } - off = sizeof(exp.a_magic); - fread((char *)&exp, 1, sizeof(MAGIC), fi); /* get magic no. */ - if (MAGIC == ARMAG) - arch_flg++; - else if (BADMAG) { - fprintf(stderr, "nm: %s-- bad format\n", *argv); +++ if (N_STROFF(mag_un.mag_exp) + sizeof (off_t) > +++ (archive ? off : stb.st_size)) +++ error(1, "old format .o (no string table) or truncated file"); +++ i = 0; +++ if (strp) +++ free(strp), strp = 0; +++ while (--n >= 0) { +++ fread((char *)&sym, 1, sizeof(sym), fi); +++ if (gflg && (sym.n_type&N_EXT)==0) +++ continue; +++ if ((sym.n_type&N_STAB) && (!aflg||gflg||uflg)) +++ continue; +++ if (symp==NULL) +++ symp = (struct nlist *) +++ malloc(sizeof(struct nlist)); +++ else +++ symp = (struct nlist *) +++ realloc(symp, +++ (i+1)*sizeof(struct nlist)); +++ if (symp == NULL) +++ error(1, "out of memory"); +++ symp[i++] = sym; +++ } +++ if (archive && ftell(fi)+sizeof(off_t) >= off) { +++ error(0, "no string table (old format .o?)"); + + continue; + + } - fseek(fi, 0L, 0); - if (arch_flg) { - nextel(fi); - if (narg > 1) - printf("\n%s:\n", *argv); +++ if (fread((char *)&strsiz,sizeof(strsiz),1,fi) != 1) { +++ error(0, "no string table (old format .o?)"); +++ goto out; + + } - do { - long o; - register i, n, c; - struct nlist *symp = NULL; - struct nlist sym; - - fread((char *)&exp, 1, sizeof(struct exec), fi); - if (BADMAG) /* archive element not in */ - continue; /* proper format - skip it */ - o = (long)exp.a_text + exp.a_data + exp.a_trsize + exp.a_drsize; - if (MAGIC==0412 || MAGIC==0413) - o += PAGSIZ - sizeof(struct exec); - fseek(fi, o, 1); - n = exp.a_syms / sizeof(struct nlist); - if (n == 0) { - fprintf(stderr, "nm: %s-- no name list\n", SELECT); - continue; - } - i = 0; - while (--n >= 0) { - fread((char *)&sym, 1, sizeof(sym), fi); - if (globl_flg && (sym.n_type&N_EXT)==0) - continue; - if (symp==NULL) - symp = (struct nlist *)malloc(sizeof(struct nlist)); - else { - symp = (struct nlist *)realloc(symp, (i+1)*sizeof(struct nlist)); - } - if (symp == NULL) { - fprintf(stderr, "nm: out of memory on %s\n", *argv); - exit(2); - } - symp[i++] = sym; +++ strp = (char *)malloc(strsiz); +++ if (strp == NULL) +++ error(1, "ran out of memory"); +++ if (fread(strp+sizeof(strsiz),strsiz-sizeof(strsiz),1,fi) != 1) +++ error(1, "error reading string table"); +++ for (j = 0; j < i; j++) +++ if (symp[j].n_un.n_strx) +++ symp[j].n_un.n_name = +++ symp[j].n_un.n_strx + strp; +++ else +++ symp[j].n_un.n_name = ""; +++ if (pflg==0) +++ qsort(symp, i, sizeof(struct nlist), compare); +++ if ((archive || narg>1) && oflg==0) +++ printf("\n%s:\n", SELECT); +++ psyms(symp, i); +++ if (symp) +++ free((char *)symp), symp = 0; +++ if (strp) +++ free((char *)strp), strp = 0; +++ } while(archive && nextel(fi)); +++out: +++ fclose(fi); +++} +++ +++psyms(symp, nsyms) +++ register struct nlist *symp; +++ int nsyms; +++{ +++ register int n, c; +++ +++ for (n=0; n1) && prep_flg==0) - printf("\n%s:\n", SELECT); - for (n=0; nn_value > p2->n_value) - return(revsort_flg); +++ return(rflg); + + if (p1->n_value < p2->n_value) - return(-revsort_flg); +++ return(-rflg); + + } - for(i=0; in_name); i++) - if (p1->n_name[i] != p2->n_name[i]) { - if (p1->n_name[i] > p2->n_name[i]) - return(revsort_flg); - else - return(-revsort_flg); - } - return(0); +++ return (rflg * strcmp(p1->n_un.n_name, p2->n_un.n_name)); + +} + + + +nextel(af) + +FILE *af; + +{ +++ register char *cp; + + register r; +++ long arsize; + + + + fseek(af, off, 0); - r = fread((char *)&arp, 1, sizeof(struct ar_hdr), af); /* read archive header */ - if (r <= 0) +++ r = fread((char *)&archdr, 1, sizeof(struct ar_hdr), af); +++ if (r != sizeof(struct ar_hdr)) + + return(0); - if (arp.ar_size & 1) - ++arp.ar_size; - off = ftell(af) + arp.ar_size; /* offset to next element */ +++ for (cp = archdr.ar_name; cp < &archdr.ar_name[sizeof(archdr.ar_name)]; cp++) +++ if (*cp == ' ') +++ *cp = '\0'; +++ arsize = atol(archdr.ar_size); +++ if (arsize & 1) +++ ++arsize; +++ off = ftell(af) + arsize; /* beginning of next element */ + + return(1); + +} +++ +++error(n, s) +++char *s; +++{ +++ fprintf(stderr, "nm: %s:", *xargv); +++ if (archive) { +++ fprintf(stderr, "(%s)", archdr.ar_name); +++ fprintf(stderr, ": "); +++ } else +++ fprintf(stderr, " "); +++ fprintf(stderr, "%s\n", s); +++ if (n) +++ exit(2); +++ errs = 1; +++} +++ +++struct stabnames { +++ int st_value; +++ char *st_name; +++} stabnames[] ={ +++ N_GSYM, "GSYM", +++ N_FNAME, "FNAME", +++ N_FUN, "FUN", +++ N_STSYM, "STSYM", +++ N_LCSYM, "LCSYM", +++ N_RSYM, "RSYM", +++ N_SLINE, "SLINE", +++ N_SSYM, "SSYM", +++ N_SO, "SO", +++ N_LSYM, "LSYM", +++ N_SOL, "SOL", +++ N_PSYM, "PSYM", +++ N_ENTRY, "ENTRY", +++ N_LBRAC, "LBRAC", +++ N_RBRAC, "RBRAC", +++ N_BCOMM, "BCOMM", +++ N_ECOMM, "ECOMM", +++ N_ECOML, "ECOML", +++ N_LENG, "LENG", +++ N_PC, "PC", +++ 0, 0 +++}; +++ +++char * +++stab(val) +++{ +++ register struct stabnames *sp; +++ static char prbuf[32]; +++ +++ for (sp = stabnames; sp->st_name; sp++) +++ if (sp->st_value == val) +++ return (sp->st_name); +++ sprintf(prbuf, "%02x", val); +++ return (prbuf); +++} diff --cc usr/src/cmd/num.c index 0000000000,03366e976f,0000000000..35b08bb6d7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/num.c +++ b/usr/src/cmd/num.c @@@@ -1,0 -1,57 -1,0 +1,58 @@@@ +++static char *sccsid = "@(#)num.c 4.1 (Berkeley) 10/1/80"; + +#include "stdio.h" + +#define formfeed 0xc + + + +/* + + * number - a cat like program which prints a file with line + + * numbers. Printing of numbers is suppressed on blank + + * lines. + + * + + * Original Version by William Joy, June 1977 + + * Updated October 1979 by M. Kirk McKusick + + */ + +main(ac, av) + + int ac; + + char *av[]; + + { + + register int argc = ac; + + register char **argv = av; + + register int lino; + + register char *lineptr; + + register FILE *STDOUT = stdout; + + register FILE *STDIN = stdin; + + char line[512]; + + extern char _sibuf[], _sobuf[]; + + + + argv++; + + argc--; + + lino = 1; + + setbuf(STDIN,_sibuf); + + setbuf(STDOUT,_sobuf); + + do + + { + + if (argc) + + if (freopen(*argv++, "r", STDIN) == NULL) + + { + + perror(*--argv); + + exit(1); + + } + + for(;;) + + { + + lineptr = line; + + *lineptr = 0; + + fscanf(STDIN,"%[^\n]",lineptr); + + if (feof(STDIN)) + + break; + + if (*lineptr == formfeed) + + putc(*lineptr++,STDOUT); + + if (!*lineptr) + + putc('\n',STDOUT); + + else + + fprintf(STDOUT,"%6d %s\n",lino,lineptr); + + lino++; + + getc(STDIN); + + } + + } + + while (--argc > 0); + + exit(); + + } diff --cc usr/src/cmd/od.c index 0000000000,f0809c9338,0000000000..6fe9ddb860 mode 000000,100644,000000..100644 --- a/usr/src/cmd/od.c +++ b/usr/src/cmd/od.c @@@@ -1,0 -1,250 -1,0 +1,250 @@@@ +++static char *sccsid = "@(#)od.c 4.1 (Berkeley) 10/1/80"; + +/* + + * od -- octal (also hex, decimal, and character) dump + + */ + + + +#include + + + +unsigned short word[8]; + +unsigned short lastword[8]; + +int conv; + +int base = 010; + +int max; + +long addr; + + + +main(argc, argv) + +char **argv; + +{ + + register char *p; + + register n, f, same; + + - + + argv++; + + f = 0; + + if(argc > 1) { + + p = *argv; + + if(*p == '-') { + + while(*p != '\0') { + + switch(*p++) { + + case 'o': + + conv |= 001; + + f = 6; + + break; + + case 'd': + + conv |= 002; + + f = 5; + + break; + + case 'x': + + case 'h': + + conv |= 010; + + f = 4; + + break; + + case 'c': + + conv |= 020; + + f = 7; + + break; + + case 'b': + + conv |= 040; + + f = 7; + + break; + + } + + if(f > max) + + max = f; + + } + + argc--; + + argv++; + + } + + } + + if(!conv) { + + max = 6; + + conv = 1; + + } + + if(argc > 1) + + if(**argv != '+') { + + if (freopen(*argv, "r", stdin) == NULL) { + + printf("cannot open %s\n", *argv); + + exit(1); + + } + + argv++; + + argc--; + + } + + if(argc > 1) + + offset(*argv); + + + + same = -1; + + for ( ; (n = fread((char *)word, 1, sizeof(word), stdin)) > 0; addr += n) { + + if (same>=0) { + + for (f=0; f<8; f++) + + if (lastword[f] != word[f]) + + goto notsame; + + if (same==0) { + + printf("*\n"); + + same = 1; + + } + + continue; + + } + + notsame: + + line(addr, word, (n+sizeof(word[0])-1)/sizeof(word[0])); + + same = 0; + + for (f=0; f<8; f++) + + lastword[f] = word[f]; + + for (f=0; f<8; f++) + + word[f] = 0; + + } + + putn(addr, base, 7); + + putchar('\n'); + +} + + + +line(a, w, n) + +long a; + +unsigned short *w; + +{ + + register i, f, c; + + + + f = 1; + + for(c=1; c; c<<=1) { + + if((c&conv) == 0) + + continue; + + if(f) { + + putn(a, base, 7); + + putchar(' '); + + f = 0; + + } else + + putchar('\t'); + + for (i=0; i037 && c<0177) { + + printf(" "); + + putchar(c); + + return; + + } + + switch(c) { + + case '\0': + + printf(" \\0"); + + break; + + case '\b': + + printf(" \\b"); + + break; + + case '\f': + + printf(" \\f"); + + break; + + case '\n': + + printf(" \\n"); + + break; + + case '\r': + + printf(" \\r"); + + break; + + case '\t': + + printf(" \\t"); + + break; + + default: + + putn((long)c, 8, 3); + + } + +} + + + +putn(n, b, c) + +long n; + +{ + + register d; + + + + if(!c) + + return; + + putn(n/b, b, c-1); + + d = n%b; + + if (d > 9) + + putchar(d-10+'a'); + + else + + putchar(d+'0'); + +} + + + +pre(n) + +{ + + int i; + + + + for(i=n; i='0' && d<='9') + + a = a*base + d - '0'; + + else if (d>='a' && d<='f' && base==16) + + a = a*base + d + 10 - 'a'; + + else + + break; + + } + + if (*s == '.') + + s++; + + if(*s=='b' || *s=='B') + + a *= 512; + + fseek(stdin, a, 0); + + addr = a; + +} diff --cc usr/src/cmd/pascal/objfmt.h index 0000000000,0000000000,0000000000..ba55ea3067 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pascal/objfmt.h @@@@ -1,0 -1,0 -1,0 +1,88 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)objfmt.h 1.2 10/4/80"; */ +++ +++#ifdef OBJ +++ /* +++ * the creation time, the size and the magic number of the obj file +++ */ +++ struct pxhdr { +++ int maketime; +++ int objsize; +++ short magicnum; +++ }; +++ +++# define HEADER_BYTES 1024 /* the size of px_header */ +++# define PX_HEADER "/usr/lib/px_header" /* px_header's name */ +++# define PX_INTRP "/usr/ucb/px" /* the interpreter's name */ +++#endif OBJ +++ +++ /* +++ * the file of error messages created by mkstr +++ */ +++#ifdef OBJ +++# define ERR_STRNGS "/usr/lib/pi2.0strings" +++# define ERR_PATHLEN 9 +++#endif OBJ +++#ifdef PC +++# define ERR_STRNGS "/usr/lib/pc2.0strings" +++# define ERR_PATHLEN 9 +++#endif PC +++ +++ /* +++ * these are because of varying sizes of pointers +++ */ +++#ifdef VAX +++# define INDX 2 /* log2 of sizeof( * ) */ +++# define PTR_AS O_AS4 +++# define PTR_RV O_RV4 +++# define PTR_IND O_IND4 +++# define PTR_DCL unsigned long /* for pointer variables */ +++# define SHORTADDR 32768 /* maximum short address */ +++# define TOOMUCH 65536 /* maximum variable size */ +++# define MAXSET 65536 /* maximum set size */ +++ /* +++ * Offsets due to the structure of the runtime stack. +++ * DPOFF1 is the amount of fixed storage in each block allocated +++ * as local variables for the runtime system. +++ * since locals are allocated negative offsets, +++ * -DPOFF1 is the last used implicit local offset. +++ * DPOFF2 is the size of the block mark. +++ * since arguments are allocated positive offsets, +++ * DPOFF2 is the end of the implicit arguments. +++ * for obj, the first argument has the highest offset +++ * from the stackpointer. and the block mark is an +++ * implicit last parameter. +++ * for pc, the first argument has the lowest offset +++ * from the argumentpointer. and the block mark is an +++ * implicit first parameter. +++ */ +++# ifdef OBJ +++# define DPOFF1 0 +++# define DPOFF2 32 +++# define INPUT_OFF -8 /* offset of `input' */ +++# define OUTPUT_OFF -4 /* offset of `output' */ +++# endif OBJ +++# ifdef PC +++# define DPOFF1 ( sizeof rtlocs - sizeof rtlocs.unwind ) +++# define DPOFF2 ( sizeof (long) ) +++# define INPUT_OFF 0 +++# define OUTPUT_OFF 0 +++# endif PC +++# define MAGICNUM 0403 /* obj magic number */ +++#endif VAX +++ +++#ifdef PDP11 +++# define INDX 1 +++# define PTR_AS O_AS2 +++# define PTR_RV O_RV2 +++# define PTR_IND O_IND2 +++# define PTR_DCL char * +++# define TOOMUCH 50000 +++# define SHORTADDR 65536 +++# define MAXSET 65536 /* maximum set size */ +++# define DPOFF2 16 +++# define INPUT_OFF -2 +++# define OUTPUT_OFF -4 +++# define MAGICNUM 0404 +++#endif PDP11 diff --cc usr/src/cmd/pascal/pc.c index 0000000000,0000000000,0000000000..13a0d57aed new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pascal/pc.c @@@@ -1,0 -1,0 -1,0 +1,490 @@@@ +++static char sccsid[] = "@(#)pc.c 3.8 10/19/80"; +++#include +++#include +++#include +++ +++/* +++ * Pc - front end for Pascal compiler. +++ */ +++char *pc0 = "/usr/lib/pc0"; +++char *pc1 = "/lib/f1"; +++char *pc2 = "/usr/lib/pc2"; +++char *c2 = "/lib/c2"; +++char *pc3 = "/usr/lib/pc3"; +++char *ld = "/bin/ld"; +++char *as = "/bin/as"; +++char *lpc = "-lpc"; +++char *crt0 = "/lib/crt0.o"; +++char *mcrt0 = "/lib/mcrt0.o"; +++ +++char *mktemp(); +++char *tname[2]; +++char *tfile[2]; +++ +++char *setsuf(), *savestr(); +++ +++int Jflag, Sflag, Oflag, cflag, gflag, pflag; +++int debug; +++ +++#define NARGS 512 +++int ldargx = 3; +++int pc0argx = 3; +++char *pc0args[NARGS] = { "pc0", "-o", "XXX" }; +++char *pc1args[3] = { "pc1", 0, }; +++char *pc2args[2] = { "pc2", 0 }; +++char *c2args[4] = { "c2", 0, 0, 0 }; +++int pc3argx = 1; +++#define pc3args pc0args +++#define ldargs pc0args +++/* char *pc3args[NARGS] = { "pc3", 0 }; */ +++/* char *ldargs[NARGS] = { "ld", "-X", "/lib/crt0.o", 0, }; */ +++int asargx; +++char *asargs[6] = { "as", 0, }; +++ +++/* +++ * If the number of .p arguments (np) is 1, and the number of .o arguments +++ * (nxo) is 0, and we successfully create an ``a.out'', then we remove +++ * the one .ps .o file (onepso). +++ */ +++int np, nxo; +++char *onepso; +++int errs; +++ +++int onintr(); +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ register char *argp; +++ register int i; +++ int savargx; +++ char *t, c; +++ int j; +++ +++ argc--, argv++; +++ if (argc == 0) { +++ execl("/bin/cat", "cat", "/usr/lib/how_pc"); +++ exit(1); +++ } +++ if (signal(SIGINT, SIG_IGN) != SIG_IGN) { +++ signal(SIGINT, onintr); +++ signal(SIGTERM, onintr); +++ } +++ for (i = 0; i < argc; i++) { +++ argp = argv[i]; +++ if (argp[0] != '-') +++ continue; +++ switch (argp[1]) { +++ +++ case 'd': +++ if (argp[2] == 0) +++ debug++; +++ continue; +++ case 'i': +++ pc0args[pc0argx++] = "-i"; +++ while (i+1 < argc && argv[i+1][0] != '-' && +++ getsuf(argv[i+1]) != 'p') { +++ pc0args[pc0argx++] = argv[i+1]; +++ i++; +++ } +++ if (i+1 == argc) { +++ fprintf(stderr, "pc: bad -i construction\n"); +++ exit(1); +++ } +++ continue; +++ case 'o': +++ i++; +++ if (i == argc) { +++ fprintf(stderr, "pc: -o must specify file\n"); +++ exit(1); +++ } +++ c = getsuf(argv[i]); +++ if (c == 'o' || c == 'p' || c == 'c') { +++ fprintf(stderr, "pc: -o would overwrite %s\n", +++ argv[i]); +++ exit(1); +++ } +++ continue; +++ case 'O': +++ Oflag = 1; +++ continue; +++ case 'S': +++ Sflag = 1; +++ continue; +++ case 'J': +++ Jflag = 1; +++ continue; +++ case 'T': +++ switch (argp[2]) { +++ +++ case '0': +++ pc0 = "/usr/src/new/pc0/a.out"; +++ continue; +++ case '1': +++ pc1 = "/usr/src/new/pcc/pc1"; +++ continue; +++ case '2': +++ pc2 = "/usr/src/new/pc2/a.out"; +++ continue; +++ case '3': +++ pc3 = "/usr/src/new/pc3/a.out"; +++ continue; +++ case 'l': +++ lpc = "/usr/src/lib/libpc/pclib"; +++ continue; +++ } +++ continue; +++ case 'c': +++ cflag = 1; +++ continue; +++ case 'l': +++ if (argp[2]) +++ continue; +++ /* fall into ... */ +++ case 'b': +++ case 'g': +++ case 's': +++ case 'w': +++ case 'z': +++ case 'C': +++ pc0args[pc0argx++] = argp; +++ if (argp[1] == 'g') +++ gflag = 1; +++ continue; +++ case 't': +++ fprintf(stderr, "pc: -t is default; -C for checking\n"); +++ continue; +++ case 'p': +++ crt0 = mcrt0; +++ pflag++; +++ continue; +++ } +++ } +++ if (gflag && Oflag) { +++ fprintf(stderr, "pc: warning: -g overrides -O\n"); +++ Oflag = 0; +++ } +++ tname[0] = mktemp("/tmp/p0XXXXXX"); +++ tname[1] = mktemp("/tmp/p1XXXXXX"); +++ savargx = pc0argx; +++ for (i = 0; i < argc; i++) { +++ argp = argv[i]; +++ if (argp[0] == '-') +++ continue; +++ if (suffix(argp) == 's') { +++ asargx = 1; +++ if (Jflag) +++ asargs[asargx++] = "-J"; +++ asargs[asargx++] = argp; +++ asargs[asargx++] = "-o"; +++ tfile[1] = setsuf(argp, 'o'); +++ asargs[asargx++] = tfile[1]; +++ asargs[asargx] = 0; +++ if (dosys(as, asargs, 0, 0)) +++ continue; +++ tfile[1] = 0; +++ continue; +++ } +++ if (suffix(argp) != 'p') +++ continue; +++ tfile[0] = tname[0]; +++ pc0args[2] = tfile[0]; +++ pc0argx = savargx; +++ if (pflag) +++ pc0args[pc0argx++] = "-p"; +++ pc0args[pc0argx++] = argp; +++ pc0args[pc0argx] = 0; +++ if (dosys(pc0, pc0args, 0, 0)) +++ continue; +++ pc1args[1] = tfile[0]; +++ tfile[1] = tname[1]; +++ if (dosys(pc1, pc1args, 0, tfile[1])) +++ continue; +++ unlink(tfile[0]); +++ if (Sflag && !Oflag) +++ tfile[0] = setsuf(argp, 's'); +++ else +++ tfile[0] = tname[0]; +++ if (dosys(pc2, pc2args, tfile[1], tfile[0])) +++ continue; +++ unlink(tfile[1]); +++ tfile[1] = 0; +++ if (Oflag) { +++ if (Sflag) +++ tfile[1] = setsuf(argp, 's'); +++ else +++ tfile[1] = tname[1]; +++ if (dosys(c2, c2args, tfile[0], tfile[1])) +++ continue; +++ unlink(tfile[0]); +++ tfile[0] = tfile[1]; +++ tfile[1] = 0; +++ } +++ if (Sflag) { +++ tfile[0] = 0; +++ continue; +++ } +++ asargx = 1; +++ if (Jflag) +++ asargs[asargx++] = "-J"; +++ asargs[asargx++] = tfile[0]; +++ asargs[asargx++] = "-o"; +++ tfile[1] = setsuf(argp, 'o'); +++ asargs[asargx++] = tfile[1]; +++ asargs[asargx] = 0; +++ if (dosys(as, asargs, 0, 0)) +++ continue; +++ tfile[1] = 0; +++ remove(); +++ } +++ if (errs || cflag || Sflag) +++ done(); +++/* char *pc3args[NARGS] = { "pc3", 0 }; */ +++ pc3args[0] = "pc3"; +++ for (i = 0; i < argc; i++) { +++ argp = argv[i]; +++ if (!strcmp(argp, "-o")) +++ i++; +++ if (argp[0] == '-') +++ continue; +++ switch (getsuf(argp)) { +++ +++ case 'o': +++ pc3args[pc3argx++] = argp; +++ nxo++; +++ continue; +++ case 's': +++ case 'p': +++ onepso = pc3args[pc3argx++] = +++ savestr(setsuf(argp, 'o')); +++ np++; +++ continue; +++ } +++ } +++ pc3args[pc3argx] = 0; +++ if (dosys(pc3, pc3args, 0, 0)) +++ done(); +++/* char *ldargs[NARGS] = { "ld", "-X", "/lib/crt0.o", 0, }; */ +++ ldargs[0] = "ld"; +++ ldargs[1] = "-X"; +++ ldargs[2] = crt0; +++ for (i = 0; i < argc; i++) { +++ argp = argv[i]; +++ if (argp[0] != '-') { +++ switch (getsuf(argp)) { +++ +++ case 'p': +++ case 's': +++ ldargs[ldargx] = savestr(setsuf(argp, 'o')); +++ break; +++ default: +++ ldargs[ldargx] = argp; +++ break; +++ } +++ if (getsuf(ldargs[ldargx]) == 'o') +++ for (j = 0; j < ldargx; j++) +++ if (!strcmp(ldargs[j], ldargs[ldargx])) +++ goto duplicate; +++ ldargx++; +++duplicate: +++ continue; +++ } +++ switch (argp[1]) { +++ +++ case 'i': +++ while (i+1 < argc && argv[i+1][0] != '-' && +++ getsuf(argv[i+1]) != 'p') +++ i++; +++ continue; +++ case 'd': +++ if (argp[2] == 0) +++ continue; +++ ldargs[ldargx++] = argp; +++ continue; +++ case 'o': +++ ldargs[ldargx++] = argp; +++ i++; +++ ldargs[ldargx++] = argv[i]; +++ continue; +++ case 'l': +++ if (argp[2]) +++ ldargs[ldargx++] = argp; +++ continue; +++ case 'c': +++ case 'g': +++ case 'w': +++ case 'p': +++ case 'S': +++ case 'J': +++ case 'T': +++ case 'O': +++ case 'C': +++ case 'b': +++ case 's': +++ case 'z': +++ continue; +++ default: +++ ldargs[ldargx++] = argp; +++ continue; +++ } +++ } +++ ldargs[ldargx++] = lpc; +++ if (gflag) +++ ldargs[ldargx++] = "-lg"; +++ ldargs[ldargx++] = "-lm"; +++ ldargs[ldargx++] = "-lc"; +++ ldargs[ldargx] = 0; +++ if (dosys(ld, ldargs, 0, 0)==0 && np == 1 && nxo == 0) +++ unlink(onepso); +++ done(); +++} +++ +++dosys(cmd, argv, in, out) +++ char *cmd, **argv, *in, *out; +++{ +++ union wait status; +++ int pid; +++ +++ if (debug) { +++ int i; +++ printf("%s:", cmd); +++ for (i = 0; argv[i]; i++) +++ printf(" %s", argv[i]); +++ if (in) +++ printf(" <%s", in); +++ if (out) +++ printf(" >%s", out); +++ printf("\n"); +++ } +++ pid = vfork(); +++ if (pid < 0) { +++ fprintf(stderr, "pc: No more processes\n"); +++ done(); +++ } +++ if (pid == 0) { +++ if (in) { +++ close(0); +++ if (open(in, 0) != 0) { +++ perror(in); +++ exit(1); +++ } +++ } +++ if (out) { +++ close(1); +++ unlink(out); +++ if (creat(out, 0666) != 1) { +++ perror(out); +++ exit(1); +++ } +++ } +++ signal(SIGINT, SIG_DFL); +++ execv(cmd, argv); +++ perror(cmd); +++ exit(1); +++ } +++ while (wait(&status) != pid) +++ ; +++ if (WIFSIGNALED(status)) { +++ if (status.w_termsig != SIGINT) +++ fprintf(stderr, "Fatal error in %s\n", cmd); +++ errs = 100; +++ done(); +++ /*NOTREACHED*/ +++ } +++ if (status.w_retcode) { +++ errs = 1; +++ remove(); +++ } +++ return (status.w_retcode); +++} +++ +++done() +++{ +++ +++ remove(); +++ exit(errs); +++} +++ +++remove() +++{ +++ +++ if (tfile[0]) +++ unlink(tfile[0]); +++ if (tfile[1]) +++ unlink(tfile[1]); +++} +++ +++onintr() +++{ +++ +++ errs = 1; +++ done(); +++} +++ +++getsuf(cp) +++ char *cp; +++{ +++ +++ if (*cp == 0) +++ return; +++ while (cp[1]) +++ cp++; +++ if (cp[-1] != '.') +++ return (0); +++ return (*cp); +++} +++ +++char * +++setsuf(as, ch) +++ char *as; +++{ +++ register char *s, *s1; +++ +++ s = s1 = savestr(as); +++ while (*s) +++ if (*s++ == '/') +++ s1 = s; +++ s[-1] = ch; +++ return (s1); +++} +++ +++#define NSAVETAB 512 +++char *savetab; +++int saveleft; +++ +++char * +++savestr(cp) +++ register char *cp; +++{ +++ register int len; +++ +++ len = strlen(cp) + 1; +++ if (len > saveleft) { +++ saveleft = NSAVETAB; +++ if (len > saveleft) +++ saveleft = len; +++ savetab = (char *)malloc(saveleft); +++ if (savetab == 0) { +++ fprintf(stderr, "ran out of memory (savestr)\n"); +++ exit(1); +++ } +++ } +++ strncpy(savetab, cp, len); +++ cp = savetab; +++ savetab += len; +++ return (cp); +++} +++ +++suffix(cp) +++ char *cp; +++{ +++ +++ if (cp[0] == 0 || cp[1] == 0) +++ return (0); +++ while (cp[1]) +++ cp++; +++ if (cp[-1] == '.') +++ return (*cp); +++ return (0); +++} diff --cc usr/src/cmd/pascal/pc3.c index 0000000000,0000000000,0000000000..4df0d09837 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pascal/pc3.c @@@@ -1,0 -1,0 -1,0 +1,738 @@@@ +++ /* Copyright (c) 1980 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pc3.c 1.6 9/9/80"; +++ +++ /* +++ * Pc3 is a pass in the Berkeley Pascal compilation +++ * process that is performed just prior to linking Pascal +++ * object files. Its purpose is to enforce the rules of +++ * separate compilation for Berkeley Pascal. Pc3 is called +++ * with the same argument list of object files that is sent to +++ * the loader. These checks are performed by pc3 by examining +++ * the symbol tables of the object files: +++ * (1) All source and included files must be "up-to-date" with +++ * the object files of which they are components. +++ * (2) Each global Pascal symbol (label, constant, type, +++ * variable, procedure, or function name) must be uniquely +++ * declared, i.e. declared in only one included file or +++ * source file. +++ * (3) Each external function (or procedure) may be resolved +++ * at most once in a source file which included the +++ * external declaration of the function. +++ * +++ * The symbol table of each object file is scanned and +++ * each global Pascal symbol is placed in a hashed symbol +++ * table. The Pascal compiler has been modified to emit all +++ * Pascal global symbols to the object file symbol table. The +++ * information stored in the symbol table for each such symbol +++ * is: +++ * +++ * - the name of the symbol; +++ * - a subtype descriptor; +++ * - for file symbols, their last modify time; +++ * - the file which logically contains the declaration of +++ * the symbol (not an include file); +++ * - the file which textually contains the declaration of +++ * the symbol (possibly an include file); +++ * - the line number at which the symbol is declared; +++ * - the file which contains the resolution of the symbol. +++ * - the line number at which the symbol is resolved; +++ * +++ * If a symbol has been previously entered into the symbol +++ * table, a check is made that the current declaration is of +++ * the same type and from the same include file as the previous +++ * one. Except for files and functions and procedures, it is +++ * an error for a symbol declaration to be encountered more +++ * than once, unless the re-declarations come from the same +++ * included file as the original. +++ * +++ * As an include file symbol is encountered in a source +++ * file, the symbol table entry of each symbol declared in that +++ * include file is modified to reflect its new logical +++ * inclusion in the source file. File symbols are also +++ * encountered as an included file ends, signaling the +++ * continuation of the enclosing file. +++ * +++ * Functions and procedures which have been declared +++ * external may be resolved by declarations from source files +++ * which included the external declaration of the function. +++ * Functions and procedures may be resolved at most once across +++ * a set of object files. The loader will complain if a +++ * function is not resolved at least once. +++ */ +++ +++char program[] = "pc"; +++ +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include +++#include "pstab.h" +++#include "pc3.h" +++ +++int errors = 0; +++ +++ /* +++ * check each of the argument .o files (or archives of .o files). +++ */ +++main( argc , argv ) +++ int argc; +++ char **argv; +++ { +++ struct fileinfo ofile; +++ +++ while ( ++argv , --argc ) { +++# ifdef DEBUG +++ fprintf( stderr , "[main] *argv = %s\n" , *argv ); +++# endif DEBUG +++ ofile.name = *argv; +++ checkfile( &ofile ); +++ } +++ exit( errors ); +++ } +++ +++ /* +++ * check the namelist of a file, or all namelists of an archive. +++ */ +++checkfile( ofilep ) +++ struct fileinfo *ofilep; +++ { +++ union { +++ char mag_armag[ SARMAG + 1 ]; +++ struct exec mag_exec; +++ } mag_un; +++ int red; +++ struct stat filestat; +++ +++ ofilep -> file = fopen( ofilep -> name , "r" ); +++ if ( ofilep -> file == NULL ) { +++ error( WARNING , "cannot open: %s" , ofilep -> name ); +++ return; +++ } +++ fstat( fileno( ofilep -> file ) , &filestat ); +++ ofilep -> modtime = filestat.st_mtime; +++ red = fread( (char *) &mag_un , 1 , sizeof mag_un , ofilep -> file ); +++ if ( red != sizeof mag_un ) { +++ error( WARNING , "cannot read header: %s" , ofilep -> name ); +++ return; +++ } +++ if ( mag_un.mag_exec.a_magic == OARMAG ) { +++ error( WARNING , "old archive: %s" , ofilep -> name ); +++ return; +++ } +++ if ( strncmp( mag_un.mag_armag , ARMAG , SARMAG ) == 0 ) { +++ /* archive, iterate through elements */ +++# ifdef DEBUG +++ fprintf( stderr , "[checkfile] archive %s\n" , ofilep -> name ); +++# endif DEBUG +++ ofilep -> nextoffset = SARMAG; +++ while ( nextelement( ofilep ) ) { +++ checknl( ofilep ); +++ } +++ } else if ( N_BADMAG( mag_un.mag_exec ) ) { +++ /* not a file.o */ +++ error( WARNING , "bad format: %s" , ofilep -> name ); +++ return; +++ } else { +++ /* a file.o */ +++# ifdef DEBUG +++ fprintf( stderr , "[checkfile] .o file %s\n" , ofilep -> name ); +++# endif DEBUG +++ fseek( ofilep -> file , 0L , 0 ); +++ ofilep -> nextoffset = filestat.st_size; +++ checknl( ofilep ); +++ } +++ fclose( ofilep -> file ); +++ } +++ +++ /* +++ * check the namelist of this file for conflicts with +++ * previously entered symbols. +++ */ +++checknl( ofilep ) +++ register struct fileinfo *ofilep; +++ { +++ +++ long red; +++ struct exec oexec; +++ off_t symoff; +++ long numsyms; +++ register struct nlist *nlp; +++ register char *stringp; +++ long strsize; +++ long sym; +++ +++ red = fread( (char *) &oexec , 1 , sizeof oexec , ofilep -> file ); +++ if ( red != sizeof oexec ) { +++ error( WARNING , "error reading struct exec: %s" +++ , ofilep -> name ); +++ return; +++ } +++ if ( N_BADMAG( oexec ) ) { +++ return; +++ } +++ symoff = N_SYMOFF( oexec ) - sizeof oexec; +++ fseek( ofilep -> file , symoff , 1 ); +++ numsyms = oexec.a_syms / sizeof ( struct nlist ); +++ if ( numsyms == 0 ) { +++ error( WARNING , "no name list: %s" , ofilep -> name ); +++ return; +++ } +++ nlp = (struct nlist *) calloc( numsyms , sizeof ( struct nlist ) ); +++ if ( nlp == 0 ) { +++ error( FATAL , "no room for %d nlists" , numsyms ); +++ } +++ red = fread( ( char * ) nlp , numsyms , sizeof ( struct nlist ) +++ , ofilep -> file ); +++ if ( ftell( ofilep -> file ) + sizeof ( off_t ) +++ >= ofilep -> nextoffset ) { +++ error( WARNING , "no string table (old format .o?)" +++ , ofilep -> name ); +++ return; +++ } +++ red = fread( (char *) &strsize , sizeof strsize , 1 +++ , ofilep -> file ); +++ if ( red != 1 ) { +++ error( WARNING , "no string table (old format .o?)" +++ , ofilep -> name ); +++ return; +++ } +++ stringp = ( char * ) malloc( strsize ); +++ if ( stringp == 0 ) { +++ error( FATAL , "no room for %d bytes of strings" , strsize ); +++ } +++ red = fread( stringp + sizeof strsize +++ , strsize - sizeof ( strsize ) , 1 , ofilep -> file ); +++ if ( red != 1 ) { +++ error( WARNING , "error reading string table: %s" +++ , ofilep -> name ); +++ } +++# ifdef DEBUG +++ fprintf( stderr , "[checknl] %s: %d symbols\n" +++ , ofilep -> name , numsyms ); +++# endif DEBUG +++ for ( sym = 0 ; sym < numsyms ; sym++) { +++ if ( nlp[ sym ].n_un.n_strx ) { +++ nlp[ sym ].n_un.n_name = stringp + nlp[ sym ].n_un.n_strx; +++ } else { +++ nlp[ sym ].n_un.n_name = ""; +++ } +++ checksymbol( &nlp[ sym ] , ofilep ); +++ } +++ if ( nlp ) { +++ free( nlp ); +++ } +++ if ( stringp ) { +++ free( stringp ); +++ } +++ } +++ +++ /* +++ * check a symbol. +++ * look it up in the hashed symbol table, +++ * entering it if necessary. +++ * this maintains a state of which .p and .i files +++ * it is currently in the midst from the nlist entries +++ * for source and included files. +++ * if we are inside a .p but not a .i, pfilep == ifilep. +++ */ +++checksymbol( nlp , ofilep ) +++ struct nlist *nlp; +++ struct fileinfo *ofilep; +++ { +++ static struct symbol *pfilep = NIL; +++ static struct symbol *ifilep = NIL; +++ register struct symbol *symbolp; +++ +++# ifdef DEBUG +++ if ( pfilep && ifilep ) { +++ fprintf( stderr , "[checksymbol] pfile %s ifile %s\n" +++ , pfilep -> name , ifilep -> name ); +++ } +++ fprintf( stderr , "[checksymbol] ->name %s ->n_desc %x (%s)\n" +++ , nlp -> n_un.n_name , nlp -> n_desc +++ , classify( nlp -> n_desc ) ); +++# endif DEBUG +++ if ( nlp -> n_type != N_PC ) { +++ /* don't care about the others */ +++ return; +++ } +++ symbolp = entersymbol( nlp -> n_un.n_name ); +++ if ( symbolp -> lookup == NEW ) { +++# ifdef DEBUG +++ fprintf( stderr , "[checksymbol] ->name %s is NEW\n" +++ , symbolp -> name ); +++# endif DEBUG +++ symbolp -> desc = nlp -> n_desc; +++ switch ( symbolp -> desc ) { +++ case N_PGLABEL: +++ case N_PGCONST: +++ case N_PGTYPE: +++ case N_PGVAR: +++ case N_PGFUNC: +++ case N_PGPROC: +++ symbolp -> sym_un.sym_str.rfilep = ifilep; +++ symbolp -> sym_un.sym_str.rline = nlp -> n_value; +++ symbolp -> sym_un.sym_str.fromp = pfilep; +++ symbolp -> sym_un.sym_str.fromi = ifilep; +++ symbolp -> sym_un.sym_str.iline = nlp -> n_value; +++ return; +++ case N_PEFUNC: +++ case N_PEPROC: +++ symbolp -> sym_un.sym_str.rfilep = NIL; +++ symbolp -> sym_un.sym_str.rline = 0; +++ /* +++ * functions can only be declared external +++ * in included files. +++ */ +++ if ( pfilep == ifilep ) { +++ error( WARNING +++ , "%s, line %d: %s %s must be declared in included file" +++ , pfilep -> name , nlp -> n_value +++ , classify( symbolp -> desc ) +++ , symbolp -> name ); +++ } +++ symbolp -> sym_un.sym_str.fromp = pfilep; +++ symbolp -> sym_un.sym_str.fromi = ifilep; +++ symbolp -> sym_un.sym_str.iline = nlp -> n_value; +++ return; +++ case N_PSO: +++ pfilep = symbolp; +++ /* and fall through */ +++ case N_PSOL: +++ ifilep = symbolp; +++ symbolp -> sym_un.modtime = mtime( symbolp -> name ); +++ if ( symbolp -> sym_un.modtime > ofilep -> modtime ) { +++ error( WARNING , "%s is out of date with %s" +++ , ofilep -> name , symbolp -> name ); +++ } +++ return; +++ } +++ } else { +++# ifdef DEBUG +++ fprintf( stderr , "[checksymbol] ->name %s is OLD\n" +++ , symbolp -> name ); +++# endif DEBUG +++ switch ( symbolp -> desc ) { +++ case N_PSO: +++ /* +++ * finding a file again means you are back +++ * in it after finishing an include file. +++ */ +++ pfilep = symbolp; +++ /* and fall through */ +++ case N_PSOL: +++ /* +++ * include files can be seen more than once, +++ * but they still have to be timechecked. +++ * (this will complain twice for out of date +++ * include files which include other files. +++ * sigh.) +++ */ +++ ifilep = symbolp; +++ if ( symbolp -> sym_un.modtime > ofilep -> modtime ) { +++ error( WARNING , "%s is out of date with %s" +++ , ofilep -> name , symbolp -> name ); +++ } +++ return; +++ case N_PEFUNC: +++ case N_PEPROC: +++ /* +++ * we may see any number of external declarations, +++ * but they all have to come +++ * from the same include file. +++ */ +++ if ( nlp -> n_desc == N_PEFUNC +++ || nlp -> n_desc == N_PEPROC ) { +++ goto included; +++ } +++ /* +++ * an external function can be resolved by +++ * the resolution of the function +++ * if the resolving file +++ * included the external declaration. +++ */ +++ if ( ( symbolp -> desc == N_PEFUNC +++ && nlp -> n_desc != N_PGFUNC ) +++ || ( symbolp -> desc == N_PEPROC +++ && nlp -> n_desc != N_PGPROC ) +++ || symbolp -> sym_un.sym_str.fromp != pfilep ) { +++ break; +++ } +++ /* +++ * an external function can only be resolved once. +++ */ +++ if ( symbolp -> sym_un.sym_str.rfilep != NIL ) { +++ break; +++ } +++ symbolp -> sym_un.sym_str.rfilep = ifilep; +++ symbolp -> sym_un.sym_str.rline = nlp -> n_value; +++ return; +++ case N_PGFUNC: +++ case N_PGPROC: +++ /* +++ * functions may not be seen more than once. +++ * the loader will complain about +++ * `multiply defined', but we can, too. +++ */ +++ break; +++ case N_PGLABEL: +++ case N_PGCONST: +++ case N_PGTYPE: +++ case N_PGVAR: +++ /* +++ * labels, constants, types, variables +++ * and external declarations +++ * may be seen as many times as they want, +++ * as long as they come from the same include file. +++ * make it look like they come from this .p file. +++ */ +++included: +++ if ( nlp -> n_desc != symbolp -> desc +++ || symbolp -> sym_un.sym_str.fromi != ifilep ) { +++ break; +++ } +++ symbolp -> sym_un.sym_str.fromp = pfilep; +++ return; +++ } +++ /* +++ * this is the breaks +++ */ +++ error( WARNING , "%s, line %d: %s already defined (%s, line %d)." +++ , ifilep -> name , nlp -> n_value , nlp -> n_un.n_name +++ , symbolp -> sym_un.sym_str.rfilep -> name +++ , symbolp -> sym_un.sym_str.rline ); +++ } +++ } +++ +++ /* +++ * quadratically hashed symbol table. +++ * things are never deleted from the hash symbol table. +++ * as more hash table is needed, +++ * a new one is alloc'ed and chained to the end. +++ * search is by rehashing within each table, +++ * traversing chains to next table if unsuccessful. +++ */ +++struct symbol * +++entersymbol( name ) +++ char *name; +++ { +++ static struct symboltableinfo *symboltable = NIL; +++ char *enteredname; +++ long hashindex; +++ register struct symboltableinfo *tablep; +++ register struct symbol **herep; +++ register struct symbol **limitp; +++ register long increment; +++ +++ enteredname = enterstring( name ); +++ hashindex = SHORT_ABS( ( long ) enteredname ) % SYMBOLPRIME; +++ for ( tablep = symboltable ; /*return*/ ; tablep = tablep -> chain ) { +++ if ( tablep == NIL ) { +++# ifdef DEBUG +++ fprintf( stderr , "[entersymbol] calloc\n" ); +++# endif DEBUG +++ tablep = ( struct symboltableinfo * ) +++ calloc( sizeof ( struct symboltableinfo ) , 1 ); +++ if ( tablep == NIL ) { +++ error( FATAL , "ran out of memory (entersymbol)" ); +++ } +++ if ( symboltable == NIL ) { +++ symboltable = tablep; +++ } +++ } +++ herep = &( tablep -> entry[ hashindex ] ); +++ limitp = &( tablep -> entry[ SYMBOLPRIME ] ); +++ increment = 1; +++ do { +++# ifdef DEBUG +++ fprintf( stderr , "[entersymbol] increment %d\n" +++ , increment ); +++# endif DEBUG +++ if ( *herep == NIL ) { +++ /* empty */ +++ if ( tablep -> used > ( ( SYMBOLPRIME / 3 ) * 4 ) ) { +++ /* too full, break for next table */ +++ break; +++ } +++ tablep -> used++; +++ *herep = symbolalloc(); +++ ( *herep ) -> name = enteredname; +++ ( *herep ) -> lookup = NEW; +++# ifdef DEBUG +++ fprintf( stderr , "[entersymbol] name %s NEW\n" +++ , enteredname ); +++# endif DEBUG +++ return *herep; +++ } +++ /* a find? */ +++ if ( ( *herep ) -> name == enteredname ) { +++ ( *herep ) -> lookup = OLD; +++# ifdef DEBUG +++ fprintf( stderr , "[entersymbol] name %s OLD\n" +++ , enteredname ); +++# endif DEBUG +++ return *herep; +++ } +++ herep += increment; +++ if ( herep >= limitp ) { +++ herep -= SYMBOLPRIME; +++ } +++ increment += 2; +++ } while ( increment < SYMBOLPRIME ); +++ } +++ } +++ +++ /* +++ * allocate a symbol from the dynamically allocated symbol table. +++ */ +++struct symbol * +++symbolalloc() +++ { +++ static struct symbol *nextsymbol = NIL; +++ static long symbolsleft = 0; +++ struct symbol *newsymbol; +++ +++ if ( symbolsleft <= 0 ) { +++# ifdef DEBUG +++ fprintf( stderr , "[symbolalloc] malloc\n" ); +++# endif DEBUG +++ nextsymbol = ( struct symbol * ) malloc( SYMBOLALLOC ); +++ if ( nextsymbol == 0 ) { +++ error( FATAL , "ran out of memory (symbolalloc)" ); +++ } +++ symbolsleft = SYMBOLALLOC / sizeof( struct symbol ); +++ } +++ newsymbol = nextsymbol; +++ nextsymbol++; +++ symbolsleft--; +++ return newsymbol; +++ } +++ +++ /* +++ * hash a string based on all of its characters. +++ */ +++long +++hashstring( string ) +++ char *string; +++ { +++ register char *cp; +++ register long value; +++ +++ value = 0; +++ for ( cp = string ; *cp ; cp++ ) { +++ value = ( value * 2 ) + *cp; +++ } +++ return value; +++ } +++ +++ /* +++ * quadratically hashed string table. +++ * things are never deleted from the hash string table. +++ * as more hash table is needed, +++ * a new one is alloc'ed and chained to the end. +++ * search is by rehashing within each table, +++ * traversing chains to next table if unsuccessful. +++ */ +++char * +++enterstring( string ) +++ char *string; +++ { +++ static struct stringtableinfo *stringtable = NIL; +++ long hashindex; +++ register struct stringtableinfo *tablep; +++ register char **herep; +++ register char **limitp; +++ register long increment; +++ +++ hashindex = SHORT_ABS( hashstring( string ) ) % STRINGPRIME; +++ for ( tablep = stringtable ; /*return*/ ; tablep = tablep -> chain ) { +++ if ( tablep == NIL ) { +++# ifdef DEBUG +++ fprintf( stderr , "[enterstring] calloc\n" ); +++# endif DEBUG +++ tablep = ( struct stringtableinfo * ) +++ calloc( sizeof ( struct stringtableinfo ) , 1 ); +++ if ( tablep == NIL ) { +++ error( FATAL , "ran out of memory (enterstring)" ); +++ } +++ if ( stringtable == NIL ) { +++ stringtable = tablep; +++ } +++ } +++ herep = &( tablep -> entry[ hashindex ] ); +++ limitp = &( tablep -> entry[ STRINGPRIME ] ); +++ increment = 1; +++ do { +++# ifdef DEBUG +++ fprintf( stderr , "[enterstring] increment %d\n" +++ , increment ); +++# endif DEBUG +++ if ( *herep == NIL ) { +++ /* empty */ +++ if ( tablep -> used > ( ( STRINGPRIME / 3 ) * 4 ) ) { +++ /* too full, break for next table */ +++ break; +++ } +++ tablep -> used++; +++ *herep = charalloc( strlen( string ) ); +++ strcpy( *herep , string ); +++# ifdef DEBUG +++ fprintf( stderr , "[enterstring] string %s copied\n" +++ , *herep ); +++# endif DEBUG +++ return *herep; +++ } +++ /* quick, check the first chars and then the rest */ +++ if ( **herep == *string && strcmp( *herep , string ) == 0 ) { +++# ifdef DEBUG +++ fprintf( stderr , "[enterstring] string %s found\n" +++ , *herep ); +++# endif DEBUG +++ return *herep; +++ } +++ herep += increment; +++ if ( herep >= limitp ) { +++ herep -= STRINGPRIME; +++ } +++ increment += 2; +++ } while ( increment < STRINGPRIME ); +++ } +++ } +++ +++ /* +++ * copy a string to the dynamically allocated character table. +++ */ +++char * +++charalloc( length ) +++ register long length; +++ { +++ static char *nextchar = NIL; +++ static long charsleft = 0; +++ register long lengthplus1 = length + 1; +++ register long askfor; +++ char *newstring; +++ +++ if ( charsleft < lengthplus1 ) { +++ askfor = lengthplus1 > CHARALLOC ? lengthplus1 : CHARALLOC; +++# ifdef DEBUG +++ fprintf( stderr , "[charalloc] malloc( %d )\n" +++ , askfor ); +++# endif DEBUG +++ nextchar = ( char * ) malloc( askfor ); +++ if ( nextchar == 0 ) { +++ error( FATAL , "no room for %d characters" , askfor ); +++ } +++ charsleft = askfor; +++ } +++ newstring = nextchar; +++ nextchar += lengthplus1; +++ charsleft -= lengthplus1; +++ return newstring; +++ } +++ +++ /* +++ * read an archive header for the next element +++ * and find the offset of the one after this. +++ */ +++BOOL +++nextelement( ofilep ) +++ struct fileinfo *ofilep; +++ { +++ register char *cp; +++ register long red; +++ register off_t arsize; +++ struct ar_hdr archdr; +++ +++ fseek( ofilep -> file , ofilep -> nextoffset , 0 ); +++ red = fread( (char *) &archdr , 1 , sizeof archdr , ofilep -> file ); +++ if ( red != sizeof archdr ) { +++ return FALSE; +++ } +++ /* null terminate the blank-padded name */ +++ cp = &archdr.ar_name[ ( sizeof archdr.ar_name ) - 1 ]; +++ *cp = '\0'; +++ while ( *--cp == ' ' ) { +++ *cp = '\0'; +++ } +++ /* set up the address of the beginning of next element */ +++ arsize = atol( archdr.ar_size ); +++ /* archive elements are aligned on 0 mod 2 boundaries */ +++ if ( arsize & 1 ) { +++ arsize += 1; +++ } +++ ofilep -> nextoffset = ftell( ofilep -> file ) + arsize; +++ /* say we had one */ +++ return TRUE; +++ } +++ +++ /* +++ * variable number of arguments to error, like printf. +++ */ +++error( fatal , message , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 ) +++ int fatal; +++ char *message; +++ { +++ fprintf( stderr , "%s: " , program ); +++ fprintf( stderr , message , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 ); +++ fprintf( stderr , "\n" ); +++ if ( fatal == FATAL ) { +++ exit( 2 ); +++ } +++ errors = 1; +++ } +++ +++ /* +++ * find the last modify time of a file. +++ * on error, return the current time. +++ */ +++time_t +++mtime( filename ) +++ char *filename; +++ { +++ struct stat filestat; +++ +++# ifdef DEBUG +++ fprintf( stderr , "[mtime] filename %s\n" +++ , filename ); +++# endif DEBUG +++ if ( stat( filename , &filestat ) != 0 ) { +++ error( WARNING , "%s: cannot open" , filename ); +++ return ( (time_t) time( 0 ) ); +++ } +++ return filestat.st_mtime; +++ } +++ +++char * +++classify( type ) +++ unsigned char type; +++ { +++ switch ( type ) { +++ case N_PSO: +++ return "source file"; +++ case N_PSOL: +++ return "include file"; +++ case N_PGLABEL: +++ return "label"; +++ case N_PGCONST: +++ return "constant"; +++ case N_PGTYPE: +++ return "type"; +++ case N_PGVAR: +++ return "variable"; +++ case N_PGFUNC: +++ return "function"; +++ case N_PGPROC: +++ return "procedure"; +++ case N_PEFUNC: +++ return "external function"; +++ case N_PEPROC: +++ return "external procedure"; +++ default: +++ return "unknown symbol"; +++ } +++ } diff --cc usr/src/cmd/pascal/pc3.h index 0000000000,0000000000,0000000000..9bb9412fab new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pascal/pc3.h @@@@ -1,0 -1,0 -1,0 +1,124 @@@@ +++ /* Copyright (c) 1980 Regents of the University of California */ +++ +++ /* static char sccsid[] = "@(#)pc3.h 1.3 9/4/80"; */ +++ +++ /* +++ * a symbol table entry. +++ */ +++struct symbol { +++ char *name; /* pointer to string table */ +++ short desc; /* symbol description */ +++ int lookup; /* whether new or old */ +++ union { /* either */ +++ struct { /* for a symbol, */ +++ struct symbol *fromp; /* its defining .p file */ +++ struct symbol *fromi; /* its defining .i file */ +++ long iline; /* the .i file line */ +++ struct symbol *rfilep; /* its resolving file */ +++ long rline; /* resolving file line */ +++ } sym_str; +++ time_t modtime; /* for a file, its st_mtime */ +++ } sym_un; +++}; +++ +++ /* +++ * struct for an argument .o file. +++ */ +++struct fileinfo { +++ FILE *file; +++ char *name; +++ time_t modtime; +++ off_t nextoffset; +++}; +++ +++ /* +++ * old archive magic for error detection. +++ */ +++#define OARMAG 0177545 +++ +++ /* +++ * this is used to trim pointers into the range of a mod of a prime. +++ */ +++#define SHORT_ABS( n ) ( n & 077777 ) +++ +++ /* +++ * a prime number which gets sizeof( struct symboltableinfo ) +++ * up to a multiple of BUFSIZ. +++ */ +++#define SYMBOLPRIME 1021 +++ +++ /* +++ * number of entries used in this symbol table, +++ * a chain to the next symbol table, +++ * and the entries. (pointers to struct symbols.) +++ */ +++struct symboltableinfo { +++ long used; +++ struct symboltableinfo *chain; +++ struct symbol *entry[ SYMBOLPRIME ]; +++}; +++ +++ /* +++ * if new struct symbols are needed, +++ * allocate this much space and hack it up into struct symbols. +++ */ +++#define SYMBOLALLOC BUFSIZ +++ +++ /* +++ * a prime number which gets sizeof( struct stringtableinfo ) +++ * up to a multiple of BUFSIZ. +++ */ +++#define STRINGPRIME 1021 +++ +++ /* +++ * number of entries used in this string table, +++ * a chain to the next string table, +++ * and the entries. (pointers to the character table.) +++ */ +++struct stringtableinfo { +++ long used; +++ struct stringtableinfo *chain; +++ char *entry[ STRINGPRIME ]; +++}; +++ +++ /* +++ * if more character table space is needed, +++ * allocate this much and hack it up into strings. +++ */ +++#define CHARALLOC BUFSIZ +++ +++ /* +++ * uninitialized pointer +++ */ +++#define NIL 0 +++ +++ /* +++ * an enumeration for error types +++ */ +++#define FATAL 0 +++#define WARNING 1 +++ +++ /* +++ * an enumeration for lookups +++ */ +++#define NEW 0 +++#define OLD 1 +++ +++ /* +++ * booleans +++ */ +++#define BOOL int +++#define FALSE 0 +++#define TRUE 1 +++ +++ /* +++ * function types. +++ */ +++struct symbol *entersymbol(); +++struct symbol *symbolalloc(); +++long stringhash(); +++char *enterstring(); +++char *charalloc(); +++BOOL nextelement(); +++time_t mtime(); +++char *classify(); diff --cc usr/src/cmd/pascal/pstab.h index 0000000000,0000000000,0000000000..b86d9aec27 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pascal/pstab.h @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++ /* static char sccsid[] = "@(#)pstab.h 1.2 9/9/80"; */ +++ +++ /* +++ * subtypes within the above type +++ * subtypes N_PSO and N_PSOL are .stabs name,,0,subtype,0 +++ * others subtypes are .stabs name,,0,subtype,line +++ */ +++#define N_PSO 0x1 /* source file name */ +++#define N_PSOL 0x2 /* include file name */ +++#define N_PGLABEL 0x3 /* global label */ +++#define N_PGCONST 0x4 /* global constant */ +++#define N_PGTYPE 0x5 /* global type */ +++#define N_PGVAR 0x6 /* global variable */ +++#define N_PGFUNC 0x7 /* global function */ +++#define N_PGPROC 0x8 /* global procedure */ +++#define N_PEFUNC 0x9 /* external function */ +++#define N_PEPROC 0xa /* external procedure */ diff --cc usr/src/cmd/passwd.c index 0000000000,a19a09f014,0000000000..e964bb0fae mode 000000,100644,000000..100644 --- a/usr/src/cmd/passwd.c +++ b/usr/src/cmd/passwd.c @@@@ -1,0 -1,172 -1,0 +1,174 @@@@ +++static char *sccsid = "@(#)passwd.c 4.1 (Berkeley) 10/1/80"; + +/* + + * enter a password in the password file + + * this program should be suid with owner + + * with an owner with write permission on /etc/passwd + + */ + +#include + +#include + +#include + + + +char passwd[] = "/etc/passwd"; + +char temp[] = "/etc/ptmp"; + +struct passwd *pwd; + +struct passwd *getpwent(); + +int endpwent(); + +char *strcpy(); + +char *crypt(); + +char *getpass(); + +char *getlogin(); + +char *pw; + +char pwbuf[10]; + +char buf[BUFSIZ]; + + + +main(argc, argv) + +char *argv[]; + +{ + + char *p; + + int i; + + char saltc[2]; + + long salt; + + int u,fi,fo; + + int insist; + + int ok, flags; + + int c; + + int pwlen; + + FILE *tf; + + char *uname; + + + + insist = 0; + + if(argc < 2) { + + if ((uname = getlogin()) == NULL) { + + printf ("Usage: passwd user\n"); + + goto bex; + + } else { + + printf("Changing password for %s\n", uname); + + } + + } else { + + uname = argv[1]; + + } + + while(((pwd=getpwent()) != NULL)&&(strcmp(pwd->pw_name,uname)!=0)); + + u = getuid(); + + if((pwd==NULL) || (u!=0 && u != pwd->pw_uid)) + + { + + printf("Permission denied.\n"); + + goto bex; + + } + + endpwent(); + + if (pwd->pw_passwd[0] && u != 0) { + + strcpy(pwbuf, getpass("Old password:")); + + pw = crypt(pwbuf, pwd->pw_passwd); + + if(strcmp(pw, pwd->pw_passwd) != 0) { + + printf("Sorry.\n"); + + goto bex; + + } + + } + +tryagn: + + strcpy(pwbuf, getpass("New password:")); + + pwlen = strlen(pwbuf); + + if (pwlen == 0) { + + printf("Password unchanged.\n"); + + goto bex; + + } + + ok = 0; + + flags = 0; + + p = pwbuf; + + while(c = *p++){ + + if(c>='a' && c<='z') flags |= 2; + + else if(c>='A' && c<='Z') flags |= 4; + + else if(c>='0' && c<='9') flags |= 1; + + else flags |= 8; + + } + + if(flags >=7 && pwlen>= 4) ok = 1; + + if(((flags==2)||(flags==4)) && pwlen>=6) ok = 1; + + if(((flags==3)||(flags==5)||(flags==6))&&pwlen>=5) ok = 1; + + + + if((ok==0) && (insist<2)){ + + if(flags==1) + + printf("Please use at least one non-numeric character.\n"); + + else + + printf("Please use a longer password.\n"); + + insist++; + + goto tryagn; + + } + + + + if (strcmp(pwbuf,getpass("Retype new password:")) != 0) { + + printf ("Mismatch - password unchanged.\n"); + + goto bex; + + } + + + + time(&salt); + + salt += getpid(); + + + + saltc[0] = salt & 077; + + saltc[1] = (salt>>6) & 077; + + for(i=0;i<2;i++){ + + c = saltc[i] + '.'; + + if(c>'9') c += 7; + + if(c>'Z') c += 6; + + saltc[i] = c; + + } + + pw = crypt(pwbuf, saltc); + + signal(SIGHUP, SIG_IGN); + + signal(SIGINT, SIG_IGN); + + signal(SIGQUIT, SIG_IGN); + + + + if(access(temp, 0) >= 0) { + + printf("Temporary file busy -- try again\n"); + + goto bex; + + } +++ signal(SIGTSTP, SIG_IGN); + + close(creat(temp,0600)); + + if((tf=fopen(temp,"w")) == NULL) { + + printf("Cannot create temporary file\n"); + + goto bex; + + } + + + +/* + + * copy passwd to temp, replacing matching lines + + * with new password. + + */ + + + + while((pwd=getpwent()) != NULL) { + + if(strcmp(pwd->pw_name,uname) == 0) { + + u = getuid(); + + if(u != 0 && u != pwd->pw_uid) { + + printf("Permission denied.\n"); + + goto out; + + } + + pwd->pw_passwd = pw; + + if (pwd->pw_gecos[0] == '*') + + pwd->pw_gecos++; + + } + + fprintf(tf,"%s:%s:%d:%d:%s:%s:%s\n", + + pwd->pw_name, + + pwd->pw_passwd, + + pwd->pw_uid, + + pwd->pw_gid, + + pwd->pw_gecos, + + pwd->pw_dir, + + pwd->pw_shell); + + } + + endpwent(); + + fclose(tf); + + + +/* + + * copy temp back to passwd file + + */ + + + + if((fi=open(temp,0)) < 0) { + + printf("Temp file disappeared!\n"); + + goto out; + + } + + if((fo=creat(passwd, 0644)) < 0) { + + printf("Cannot recreat passwd file.\n"); + + goto out; + + } + + while((u=read(fi,buf,sizeof(buf))) > 0) write(fo,buf,u); + + + +out: + + unlink(temp); + + + +bex: + + exit(1); + +} diff --cc usr/src/cmd/pc0/0.h index 0000000000,0000000000,0000000000..566fc47a0d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/0.h @@@@ -1,0 -1,0 -1,0 +1,754 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)0.h 1.3 10/2/80"; */ +++ +++#define DEBUG +++#define CHAR +++#define STATIC +++#define hp21mx 0 +++ +++#include +++#include +++ +++#define bool short +++#define TRUE 1 +++#define FALSE 0 +++ +++/* +++ * Option flags +++ * +++ * The following options are recognized in the text of the program +++ * and also on the command line: +++ * +++ * b block buffer the file output +++ * +++ * i make a listing of the procedures and functions in +++ * the following include files +++ * +++ * l make a listing of the program +++ * +++ * n place each include file on a new page with a header +++ * +++ * p disable post mortem and statement limit counting +++ * +++ * t disable run-time tests +++ * +++ * u card image mode; only first 72 chars of input count +++ * +++ * w suppress special diagnostic warnings +++ * +++ * z generate counters for an execution profile +++ */ +++#ifdef DEBUG +++bool fulltrace, errtrace, testtrace, yyunique; +++#endif DEBUG +++ +++/* +++ * Each option has a stack of 17 option values, with opts giving +++ * the current, top value, and optstk the value beneath it. +++ * One refers to option `l' as, e.g., opt('l') in the text for clarity. +++ */ +++char opts[ 'z' - 'A' + 1]; +++short optstk[ 'z' - 'A' + 1]; +++ +++#define opt(c) opts[c-'A'] +++ +++/* +++ * Monflg is set when we are generating +++ * a pxp profile. this is set by the -z command line option. +++ */ +++bool monflg; +++ +++ /* +++ * profflag is set when we are generating a prof profile. +++ * this is set by the -p command line option. +++ */ +++bool profflag; +++ +++ +++/* +++ * NOTES ON THE DYNAMIC NATURE OF THE DATA STRUCTURES +++ * +++ * Pi uses expandable tables for +++ * its namelist (symbol table), string table +++ * hash table, and parse tree space. The following +++ * definitions specify the size of the increments +++ * for these items in fundamental units so that +++ * each uses approximately 1024 bytes. +++ */ +++ +++#define STRINC 1024 /* string space increment */ +++#define TRINC 512 /* tree space increment */ +++#define HASHINC 509 /* hash table size in words, each increment */ +++#define NLINC 56 /* namelist increment size in nl structs */ +++ +++/* +++ * The initial sizes of the structures. +++ * These should be large enough to compile +++ * an "average" sized program so as to minimize +++ * storage requests. +++ * On a small system or and 11/34 or 11/40 +++ * these numbers can be trimmed to make the +++ * compiler smaller. +++ */ +++#define ITREE 2000 +++#define INL 200 +++#define IHASH 509 +++ +++/* +++ * The following limits on hash and tree tables currently +++ * allow approximately 1200 symbols and 20k words of tree +++ * space. The fundamental limit of 64k total data space +++ * should be exceeded well before these are full. +++ */ +++/* +++ * TABLE_MULTIPLIER is for uniformly increasing the sizes of the tables +++ */ +++#define TABLE_MULTIPLIER 8 +++#define MAXHASH (4 * TABLE_MULTIPLIER) +++#define MAXNL (12 * TABLE_MULTIPLIER) +++#define MAXTREE (30 * TABLE_MULTIPLIER) +++/* +++ * MAXDEPTH is the depth of the parse stack. +++ * STACK_MULTIPLIER is for increasing its size. +++ */ +++#define STACK_MULTIPLIER 8 +++#define MAXDEPTH ( 150 * STACK_MULTIPLIER ) +++ +++/* +++ * ERROR RELATED DEFINITIONS +++ */ +++ +++/* +++ * Exit statuses to pexit +++ * +++ * AOK +++ * ERRS Compilation errors inhibit obj productin +++ * NOSTART Errors before we ever got started +++ * DIED We ran out of memory or some such +++ */ +++#define AOK 0 +++#define ERRS 1 +++#define NOSTART 2 +++#define DIED 3 +++ +++bool Recovery; +++ +++#define eholdnl() Eholdnl = 1 +++#define nocascade() Enocascade = 1 +++ +++bool Eholdnl, Enocascade; +++ +++ +++/* +++ * The flag eflg is set whenever we have a hard error. +++ * The character in errpfx will precede the next error message. +++ * When cgenflg is set code generation is suppressed. +++ * This happens whenver we have an error (i.e. if eflg is set) +++ * and when we are walking the tree to determine types only. +++ */ +++bool eflg; +++char errpfx; +++ +++#define setpfx(x) errpfx = x +++ +++#define standard() setpfx('s') +++#define warning() setpfx('w') +++#define recovered() setpfx('e') +++ +++bool cgenflg; +++ +++ +++/* +++ * The flag syneflg is used to suppress the diagnostics of the form +++ * E 10 a, defined in someprocedure, is neither used nor set +++ * when there were syntax errors in "someprocedure". +++ * In this case, it is likely that these warinings would be spurious. +++ */ +++bool syneflg; +++ +++/* +++ * The compiler keeps its error messages in a file. +++ * The variable efil is the unit number on which +++ * this file is open for reading of error message text. +++ * Similarly, the file ofil is the unit of the file +++ * "obj" where we write the interpreter code. +++ */ +++short efil; +++short ofil; +++short obuf[518]; +++ +++#define elineoff() Enoline++ +++#define elineon() Enoline = 0 +++ +++bool Enoline; +++ +++/* +++ * SYMBOL TABLE STRUCTURE DEFINITIONS +++ * +++ * The symbol table is henceforth referred to as the "namelist". +++ * It consists of a number of structures of the form "nl" below. +++ * These are contained in a number of segments of the symbol +++ * table which are dynamically allocated as needed. +++ * The major namelist manipulation routines are contained in the +++ * file "nl.c". +++ * +++ * The major components of a namelist entry are the "symbol", giving +++ * a pointer into the string table for the string associated with this +++ * entry and the "class" which tells which of the (currently 19) +++ * possible types of structure this is. +++ * +++ * Many of the classes use the "type" field for a pointer to the type +++ * which the entry has. +++ * +++ * Other pieces of information in more than one class include the block +++ * in which the symbol is defined, flags indicating whether the symbol +++ * has been used and whether it has been assigned to, etc. +++ * +++ * A more complete discussion of the features of the namelist is impossible +++ * here as it would be too voluminous. Refer to the "PI 1.0 Implementation +++ * Notes" for more details. +++ */ +++ +++/* +++ * The basic namelist structure. +++ * There are also two other variants, defining the real +++ * field as longs or integers given below. +++ * +++ * The array disptab defines the hash header for the symbol table. +++ * Symbols are hashed based on the low 6 bits of their pointer into +++ * the string table; see the routines in the file "lookup.c" and also "fdec.c" +++ * especially "funcend". +++ */ +++#ifdef PTREE +++# include "pTree.h" +++#endif PTREE +++struct nl { +++ char *symbol; +++ char class, nl_flags; +++#ifdef PC +++ char ext_flags; /* an extra flag is used for externals */ +++#endif PC +++ struct nl *type; +++ struct nl *chain, *nl_next; +++ int *ptr[4]; +++#ifdef PI +++ int entloc; +++#endif PI +++# ifdef PTREE +++ pPointer inTree; +++# endif PTREE +++} *nlp, *disptab[077+1]; +++ +++extern struct nl nl[INL]; +++ +++struct { +++ char *symbol; +++ char class, nl_flags; +++#ifdef PC +++ char ext_flags; +++#endif +++ struct nl *type; +++ struct nl *chain, *nl_next; +++ double real; +++}; +++ +++struct { +++ char *symbol; +++ char class, nl_block; +++#ifdef PC +++ char ext_flags; +++#endif +++ struct nl *type; +++ struct nl *chain, *nl_next; +++ long range[2]; +++}; +++ +++struct { +++ char *symbol; +++ char class, nl_flags; +++#ifdef PC +++ char ext_flags; +++#endif +++ struct nl *type; +++ struct nl *chain, *nl_next; +++ long value[4]; +++}; +++ +++/* +++ * NL FLAGS BITS +++ * +++ * Definitions of the usage of the bits in +++ * the nl_flags byte. Note that the low 5 bits of the +++ * byte are the "nl_block" and that some classes make use +++ * of this byte as a "width". +++ * +++ * The only non-obvious bit definition here is "NFILES" +++ * which records whether a structure contains any files. +++ * Such structures are not allowed to be dynamically allocated. +++ */ +++#define NUSED 0100 +++#define NMOD 0040 +++#define NFORWD 0200 +++#define NFILES 0200 +++ +++#ifdef PC +++#define NEXTERN 0001 /* flag used to mark external funcs and procs */ +++#endif +++ +++/* +++ * Definition of the commonly used "value" fields. +++ * The most important one is NL_OFFS which gives +++ * the offset of a variable in its stack mark. +++ */ +++#define NL_OFFS 0 +++ +++#define NL_CNTR 1 +++#define NL_FVAR 3 +++ +++#define NL_GOLEV 2 +++#define NL_GOLINE 3 +++#define NL_FORV 1 +++ +++#define NL_FLDSZ 1 +++#define NL_VARNT 2 +++#define NL_VTOREC 2 +++#define NL_TAG 3 +++ +++#define NL_ELABEL 3 +++ +++/* +++ * For BADUSE nl structures, NL_KINDS is a bit vector +++ * indicating the kinds of illegal usages complained about +++ * so far. For kind of bad use "kind", "1 << kind" is set. +++ * The low bit is reserved as ISUNDEF to indicate whether +++ * this identifier is totally undefined. +++ */ +++#define NL_KINDS 0 +++ +++#define ISUNDEF 1 +++ +++/* +++ * NAMELIST CLASSES +++ * +++ * The following are the namelist classes. +++ * Different classes make use of the value fields +++ * of the namelist in different ways. +++ * +++ * The namelist should be redesigned by providing +++ * a number of structure definitions with one corresponding +++ * to each namelist class, ala a variant record in Pascal. +++ */ +++#define BADUSE 0 +++#define CONST 1 +++#define TYPE 2 +++#define VAR 3 +++#define ARRAY 4 +++#define PTRFILE 5 +++#define RECORD 6 +++#define FIELD 7 +++#define PROC 8 +++#define FUNC 9 +++#define FVAR 10 +++#define REF 11 +++#define PTR 12 +++#define FILET 13 +++#define SET 14 +++#define RANGE 15 +++#define LABEL 16 +++#define WITHPTR 17 +++#define SCAL 18 +++#define STR 19 +++#define PROG 20 +++#define IMPROPER 21 +++#define VARNT 22 +++#define FPROC 23 +++#define FFUNC 24 +++ +++/* +++ * Clnames points to an array of names for the +++ * namelist classes. +++ */ +++char **clnames; +++ +++/* +++ * PRE-DEFINED NAMELIST OFFSETS +++ * +++ * The following are the namelist offsets for the +++ * primitive types. The ones which are negative +++ * don't actually exist, but are generated and tested +++ * internally. These definitions are sensitive to the +++ * initializations in nl.c. +++ */ +++#define TFIRST -7 +++#define TFILE -7 +++#define TREC -6 +++#define TARY -5 +++#define TSCAL -4 +++#define TPTR -3 +++#define TSET -2 +++#define TSTR -1 +++#define NIL 0 +++#define TBOOL 1 +++#define TCHAR 2 +++#define TINT 3 +++#define TDOUBLE 4 +++#define TNIL 5 +++#define T1INT 6 +++#define T2INT 7 +++#define T4INT 8 +++#define T1CHAR 9 +++#define T1BOOL 10 +++#define T8REAL 11 +++#define TLAST 11 +++ +++/* +++ * SEMANTIC DEFINITIONS +++ */ +++ +++/* +++ * NOCON and SAWCON are flags in the tree telling whether +++ * a constant set is part of an expression. +++ */ +++#define NOCON 0 +++#define SAWCON 1 +++ +++/* +++ * The variable cbn gives the current block number, +++ * the variable bn is set as a side effect of a call to +++ * lookup, and is the block number of the variable which +++ * was found. +++ */ +++short bn, cbn; +++ +++/* +++ * The variable line is the current semantic +++ * line and is set in stat.c from the numbers +++ * embedded in statement type tree nodes. +++ */ +++short line; +++ +++/* +++ * The size of the display +++ * which defines the maximum nesting +++ * of procedures and functions allowed. +++ * Because of the flags in the current namelist +++ * this must be no greater than 32. +++ */ +++#define DSPLYSZ 20 +++ +++/* +++ * The following structure is used +++ * to keep track of the amount of variable +++ * storage required by each block. +++ * "Max" is the high water mark, "off" +++ * the current need. Temporaries for "for" +++ * loops and "with" statements are allocated +++ * in the local variable area and these +++ * numbers are thereby changed if necessary. +++ */ +++struct om { +++ long om_off; +++ long om_max; +++} sizes[DSPLYSZ]; +++ +++ /* +++ * the following structure records whether a level declares +++ * any variables which are (or contain) files. +++ * this so that the runtime routines for file cleanup can be invoked. +++ */ +++bool dfiles[ DSPLYSZ ]; +++ +++/* +++ * Structure recording information about a constant +++ * declaration. It is actually the return value from +++ * the routine "gconst", but since C doesn't support +++ * record valued functions, this is more convenient. +++ */ +++struct { +++ struct nl *ctype; +++ short cival; +++ double crval; +++ int *cpval; +++} con; +++ +++/* +++ * The set structure records the lower bound +++ * and upper bound with the lower bound normalized +++ * to zero when working with a set. It is set by +++ * the routine setran in var.c. +++ */ +++struct { +++ short lwrb, uprbp; +++} set; +++ +++ /* +++ * structures of this kind are filled in by precset and used by postcset +++ * to indicate things about constant sets. +++ */ +++struct csetstr { +++ struct nl *csettype; +++ long paircnt; +++ long singcnt; +++ bool comptime; +++}; +++/* +++ * The following flags are passed on calls to lvalue +++ * to indicate how the reference is to affect the usage +++ * information for the variable being referenced. +++ * MOD is used to set the NMOD flag in the namelist +++ * entry for the variable, ASGN permits diagnostics +++ * to be formed when a for variable is assigned to in +++ * the range of the loop. +++ */ +++#define NOFLAGS 0 +++#define MOD 01 +++#define ASGN 02 +++#define NOUSE 04 +++ +++ /* +++ * the following flags are passed to lvalue and rvalue +++ * to tell them whether an lvalue or rvalue is required. +++ * the semantics checking is done according to the function called, +++ * but for pc, lvalue may put out an rvalue by indirecting afterwards, +++ * and rvalue may stop short of putting out the indirection. +++ */ +++#define LREQ 01 +++#define RREQ 02 +++ +++double MAXINT; +++double MININT; +++ +++/* +++ * Variables for generation of profile information. +++ * Monflg is set when we want to generate a profile. +++ * Gocnt record the total number of goto's and +++ * cnts records the current counter for generating +++ * COUNT operators. +++ */ +++short gocnt; +++short cnts; +++ +++/* +++ * Most routines call "incompat" rather than asking "!compat" +++ * for historical reasons. +++ */ +++#define incompat !compat +++ +++/* +++ * Parts records which declaration parts have been seen. +++ * The grammar allows the "label" "const" "type" "var" and routine +++ * parts to be repeated and to be in any order, so that +++ * they can be detected semantically to give better +++ * error diagnostics. +++ */ +++int parts[ DSPLYSZ ]; +++ +++#define LPRT 1 +++#define CPRT 2 +++#define TPRT 4 +++#define VPRT 8 +++#define RPRT 16 +++ +++/* +++ * Flags for the "you used / instead of div" diagnostic +++ */ +++bool divchk; +++bool divflg; +++ +++short errcnt[DSPLYSZ]; +++ +++/* +++ * Forechain links those types which are +++ * ^ sometype +++ * so that they can be evaluated later, permitting +++ * circular, recursive list structures to be defined. +++ */ +++struct nl *forechain; +++ +++/* +++ * Withlist links all the records which are currently +++ * opened scopes because of with statements. +++ */ +++struct nl *withlist; +++ +++struct nl *intset; +++struct nl *input, *output; +++struct nl *program; +++ +++/* progseen flag used by PC to determine if +++ * a routine segment is being compiled (and +++ * therefore no program statement seen) +++ */ +++bool progseen; +++ +++ +++/* +++ * STRUCTURED STATEMENT GOTO CHECKING +++ * +++ * The variable level keeps track of the current +++ * "structured statement level" when processing the statement +++ * body of blocks. This is used in the detection of goto's into +++ * structured statements in a block. +++ * +++ * Each label's namelist entry contains two pieces of information +++ * related to this check. The first `NL_GOLEV' either contains +++ * the level at which the label was declared, `NOTYET' if the label +++ * has not yet been declared, or `DEAD' if the label is dead, i.e. +++ * if we have exited the level in which the label was defined. +++ * +++ * When we discover a "goto" statement, if the label has not +++ * been defined yet, then we record the current level and the current line +++ * for a later error check. If the label has been already become "DEAD" +++ * then a reference to it is an error. Now the compiler maintains, +++ * for each block, a linked list of the labels headed by "gotos[bn]". +++ * When we exit a structured level, we perform the routine +++ * ungoto in stat.c. It notices labels whose definition levels have been +++ * exited and makes them be dead. For labels which have not yet been +++ * defined, ungoto will maintain NL_GOLEV as the minimum structured level +++ * since the first usage of the label. It is not hard to see that the label +++ * must eventually be declared at this level or an outer level to this +++ * one or a goto into a structured statement will exist. +++ */ +++short level; +++struct nl *gotos[DSPLYSZ]; +++ +++#define NOTYET 10000 +++#define DEAD 10000 +++ +++/* +++ * Noreach is true when the next statement will +++ * be unreachable unless something happens along +++ * (like exiting a looping construct) to save +++ * the day. +++ */ +++bool noreach; +++ +++/* +++ * UNDEFINED VARIABLE REFERENCE STRUCTURES +++ */ +++struct udinfo { +++ int ud_line; +++ struct udinfo *ud_next; +++ char nullch; +++}; +++ +++/* +++ * CODE GENERATION DEFINITIONS +++ */ +++ +++/* +++ * NSTAND is or'ed onto the abstract machine opcode +++ * for non-standard built-in procedures and functions. +++ */ +++#define NSTAND 0400 +++ +++#define codeon() cgenflg++ +++#define codeoff() --cgenflg +++ +++/* +++ * Codeline is the last lino output in the code generator. +++ * It used to be used to suppress LINO operators but no +++ * more since we now count statements. +++ * Lc is the intepreter code location counter. +++ * +++short codeline; +++ */ +++char *lc; +++ +++ +++/* +++ * Routines which need types +++ * other than "integer" to be +++ * assumed by the compiler. +++ */ +++double atof(); +++long lwidth(); +++long aryconst(); +++long a8tol(); +++struct nl *lookup(); +++double atof(); +++int *tree(); +++int *hash(); +++char *alloc(); +++int *calloc(); +++char *savestr(); +++struct nl *lookup1(); +++struct nl *hdefnl(); +++struct nl *defnl(); +++struct nl *enter(); +++struct nl *nlcopy(); +++struct nl *tyrecl(); +++struct nl *tyary(); +++struct nl *fields(); +++struct nl *variants(); +++struct nl *deffld(); +++struct nl *defvnt(); +++struct nl *tyrec1(); +++struct nl *reclook(); +++struct nl *asgnop1(); +++struct nl *gtype(); +++struct nl *call(); +++struct nl *lvalue(); +++struct nl *rvalue(); +++struct nl *cset(); +++ +++/* +++ * type cast NIL to keep lint happy (which is not so bad) +++ */ +++#define NLNIL ( (struct nl *) NIL ) +++ +++/* +++ * Funny structures to use +++ * pointers in wild and wooly ways +++ */ +++struct { +++ char pchar; +++}; +++struct { +++ short pint; +++ short pint2; +++}; +++struct { +++ long plong; +++}; +++struct { +++ double pdouble; +++}; +++ +++#define OCT 1 +++#define HEX 2 +++ +++/* +++ * MAIN PROGRAM VARIABLES, MISCELLANY +++ */ +++ +++/* +++ * Variables forming a data base referencing +++ * the command line arguments with the "i" option, e.g. +++ * in "pi -i scanner.i compiler.p". +++ */ +++char **pflist; +++short pflstc; +++short pfcnt; +++ +++char *filename; /* current source file name */ +++long tvec; +++extern char *snark; /* SNARK */ +++extern char *classes[ ]; /* maps namelist classes to string names */ +++ +++#define derror error +++ +++#ifdef PC +++ +++ /* +++ * the current function number, for [ lines +++ */ +++ int ftnno; +++ +++ /* +++ * the pc output stream +++ */ +++ FILE *pcstream; +++ +++#endif PC diff --cc usr/src/cmd/pc0/OPnames.h index 0000000000,0000000000,0000000000..5df08ce21f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/OPnames.h @@@@ -1,0 -1,0 -1,0 +1,260 @@@@ +++/* static char sccsid[] = "@(#)OPnames.h 1.2 10/2/80"; */ +++ +++char *otext[] = { +++ 0, +++ " NODUMP", +++ " BEG", +++ " END", +++ " CALL", +++ " FCALL", +++ " FRTN", +++ " FSAV", +++ " SDUP2", +++ " SDUP4", +++ " TRA", +++ " TRA4", +++ " GOTO", +++ " LINO", +++ " PUSH", +++ 0, +++ " IF", +++ " REL2", +++ " REL4", +++ " REL24", +++ " REL42", +++ " REL8", +++ " RELG", +++ " RELT", +++ " REL28", +++ " REL48", +++ " REL82", +++ " REL84", +++ " AND", +++ " OR", +++ " NOT", +++ 0, +++ " AS2", +++ " AS4", +++ " AS24", +++ " AS42", +++ " AS21", +++ " AS41", +++ " AS28", +++ " AS48", +++ " AS8", +++ " AS", +++ " INX2P2", +++ " INX4P2", +++ " INX2", +++ " INX4", +++ " OFF", +++ " NIL", +++ " ADD2", +++ " ADD4", +++ " ADD24", +++ " ADD42", +++ " ADD28", +++ " ADD48", +++ " ADD82", +++ " ADD84", +++ " SUB2", +++ " SUB4", +++ " SUB24", +++ " SUB42", +++ " SUB28", +++ " SUB48", +++ " SUB82", +++ " SUB84", +++ " MUL2", +++ " MUL4", +++ " MUL24", +++ " MUL42", +++ " MUL28", +++ " MUL48", +++ " MUL82", +++ " MUL84", +++ " ABS2", +++ " ABS4", +++ " ABS8", +++ 0, +++ " NEG2", +++ " NEG4", +++ " NEG8", +++ 0, +++ " DIV2", +++ " DIV4", +++ " DIV24", +++ " DIV42", +++ " MOD2", +++ " MOD4", +++ " MOD24", +++ " MOD42", +++ " ADD8", +++ " SUB8", +++ " MUL8", +++ " DVD8", +++ " STOI", +++ " STOD", +++ " ITOD", +++ " ITOS", +++ " DVD2", +++ " DVD4", +++ " DVD24", +++ " DVD42", +++ " DVD28", +++ " DVD48", +++ " DVD82", +++ " DVD84", +++ " RV1", +++ " RV14", +++ " RV2", +++ " RV24", +++ " RV4", +++ " RV8", +++ " RV", +++ " LV", +++ " LRV1", +++ " LRV14", +++ " LRV2", +++ " LRV24", +++ " LRV4", +++ " LRV8", +++ " LRV", +++ " LLV", +++ " IND1", +++ " IND14", +++ " IND2", +++ " IND24", +++ " IND4", +++ " IND8", +++ " IND", +++ 0, +++ " CON1", +++ " CON14", +++ " CON2", +++ " CON24", +++ " CON4", +++ " CON8", +++ " CON", +++ " LVCON", +++ " RANG2", +++ " RANG42", +++ " RSNG2", +++ " RSNG42", +++ " RANG4", +++ " RANG24", +++ " RSNG4", +++ " RSNG24", +++ " STLIM", +++ " LLIMIT", +++ " BUFF", +++ " HALT", +++ 0, +++ 0, +++ 0, +++ 0, +++ "*ORD2", +++ "*CONG", +++ "*CONC", +++ "*CONC4", +++ "*ABORT", +++ " PXPBUF", +++ " COUNT", +++ 0, +++ " CASE1OP", +++ " CASE2OP", +++ " CASE4OP", +++ "*CASEBEG", +++ "*CASE1", +++ "*CASE2", +++ "*CASE4", +++ "*CASEEND", +++ " ADDT", +++ " SUBT", +++ " MULT", +++ " INCT", +++ " CTTOT", +++ " CARD", +++ " IN", +++ " ASRT", +++ " FOR1U", +++ " FOR2U", +++ " FOR4U", +++ " FOR1D", +++ " FOR2D", +++ " FOR4D", +++ 0, +++ 0, +++ " READE", +++ " READ4", +++ " READC", +++ " READ8", +++ " READLN", +++ " EOF", +++ " EOLN", +++ 0, +++ " WRITEC", +++ " WRITES", +++ " WRITEF", +++ " WRITLN", +++ " PAGE", +++ " NAM", +++ " MAX", +++ " MIN", +++ " UNIT", +++ " UNITINP", +++ " UNITOUT", +++ " MESSAGE", +++ " GET", +++ " PUT", +++ " FNIL", +++ 0, +++ " DEFNAME", +++ " RESET", +++ " REWRITE", +++ " FILE", +++ " REMOVE", +++ " FLUSH", +++ 0, +++ 0, +++ " PACK", +++ " UNPACK", +++ " ARGC", +++ " ARGV", +++ 0, +++ 0, +++ 0, +++ 0, +++ " CLCK", +++ " WCLCK", +++ " SCLCK", +++ " DISPOSE", +++ " NEW", +++ " DATE", +++ " TIME", +++ " UNDEF", +++ " ATAN", +++ " COS", +++ " EXP", +++ " LN", +++ " SIN", +++ " SQRT", +++ " CHR2", +++ " CHR4", +++ " ODD2", +++ " ODD4", +++ " PRED2", +++ " PRED4", +++ " PRED24", +++ " SUCC2", +++ " SUCC4", +++ " SUCC24", +++ " SEED", +++ " RANDOM", +++ " EXPO", +++ " SQR2", +++ " SQR4", +++ " SQR8", +++ " ROUND", +++ " TRUNC" +++}; diff --cc usr/src/cmd/pc0/TRdata.c index 0000000000,0000000000,0000000000..229c7ca169 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/TRdata.c @@@@ -1,0 -1,0 -1,0 +1,204 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)TRdata.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#ifdef PI1 +++#ifdef DEBUG +++char *trnames[] +++{ +++ 0, +++ "MINUS", +++ "MOD", +++ "DIV", +++ "DIVD", +++ "MULT", +++ "ADD", +++ "SUB", +++ "EQ", +++ "NE", +++ "LT", +++ "GT", +++ "LE", +++ "GE", +++ "NOT", +++ "AND", +++ "OR", +++ "ASGN", +++ "PLUS", +++ "IN", +++ "LISTPP", +++ "PDEC", +++ "FDEC", +++ "PVAL", +++ "PVAR", +++ "PFUNC", +++ "PPROC", +++ "NIL", +++ "STRNG", +++ "CSTRNG", +++ "PLUSC", +++ "MINUSC", +++ "ID", +++ "INT", +++ "FINT", +++ "CINT", +++ "CFINT", +++ "TYPTR", +++ "TYPACK", +++ "TYSCAL", +++ "TYRANG", +++ "TYARY", +++ "TYFILE", +++ "TYSET", +++ "TYREC", +++ "TYFIELD", +++ "TYVARPT", +++ "TYVARNT", +++ "CSTAT", +++ "BLOCK", +++ "BSTL", +++ "LABEL", +++ "PCALL", +++ "FCALL", +++ "CASE", +++ "WITH", +++ "WHILE", +++ "REPEAT", +++ "FORU", +++ "FORD", +++ "GOTO", +++ "IF", +++ "ASRT", +++ "CSET", +++ "RANG", +++ "VAR", +++ "ARGL", +++ "ARY", +++ "FIELD", +++ "PTR", +++ "WEXP", +++ "PROG", +++ "BINT", +++ "CBINT", +++ "IFEL", +++ "IFX", +++ "TYID", +++ "COPSTR", +++ "BOTTLE", +++ "RFIELD", +++ "FLDLST", +++ "LAST" +++}; +++#endif +++#endif +++ +++char *trdesc[] +++{ +++ 0, +++ "dp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dpp", +++ "dp", +++ "dpp", +++ "dpp", +++ "npp", +++ "dp", +++ "dpp", +++ "pp", +++ "n\"pp", +++ "n\"pp", +++ "pp", +++ "pp", +++ "pp", +++ "p", +++ "d", +++ "dp", +++ "p", +++ "p", +++ "p", +++ "p", +++ "dp", +++ "dp", +++ "p", +++ "p", +++ "np", +++ "np", +++ "np", +++ "npp", +++ "npp", +++ "np", +++ "np", +++ "np", +++ "pp", +++ "nppp", +++ "npp", +++ "npp", +++ "np", +++ "np", +++ "n\"p", +++ "n\"p", +++ "n\"p", +++ "npp", +++ "npp", +++ "npp", +++ "npp", +++ "nppp", +++ "nppp", +++ "n\"", +++ "nppp", +++ "np", +++ "dp", +++ "pp", +++ "n\"p", +++ "p", +++ "p", +++ "pp", +++ "", +++ "ppp", +++ "n\"pp", +++ "dp", +++ "p", +++ "nppp", +++ "nppp", +++ "np", +++ "s", +++ "nnnnn", +++ "npp", +++ "npp", +++ "x" +++}; +++char *opnames[] +++{ +++ 0, +++ "unary -", +++ "mod", +++ "div", +++ "/", +++ "*", +++ "+", +++ "-", +++ "=", +++ "<>", +++ "<", +++ ">", +++ "<=", +++ ">=", +++ "not", +++ "and", +++ "or", +++ ":=", +++ "unary +", +++ "in" +++}; diff --cc usr/src/cmd/pc0/align.h index 0000000000,0000000000,0000000000..1191a47528 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/align.h @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)align.h 1.1 8/27/80"; */ +++ +++ /* +++ * alignment of various types in bytes. +++ * sizes are found using sizeof( type ). +++ */ +++#define A_CHAR 1 +++#define A_INT 4 +++#define A_FLOAT 4 +++#define A_DOUBLE 4 +++#define A_LONG 4 +++#define A_SHORT 2 +++#define A_POINT 4 +++#define A_STRUCT 1 +++#define A_STACK 4 +++#define A_FILET 4 +++#define A_SET 4 +++#define A_MIN 1 +++#define A_MAX 4 diff --cc usr/src/cmd/pc0/ato.c index 0000000000,0000000000,0000000000..c4888893ef new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/ato.c @@@@ -1,0 -1,0 -1,0 +1,40 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ato.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++ +++long +++a8tol(cp) +++ char *cp; +++{ +++ int err; +++ long l; +++ register CHAR c; +++ +++ l = 0; +++ err = 0; +++ while ((c = *cp++) != '\0') { +++ if (c == '8' || c == '9') +++ if (err == 0) { +++ error("8 or 9 in octal number"); +++ err++; +++ } +++ c -= '0'; +++ if ((l & 0160000000000L) != 0) +++ if (err == 0) { +++ error("Number too large for this implementation"); +++ err++; +++ } +++ l = (l << 3) | c; +++ } +++ return (l); +++} +++ +++/* +++ * Note that the version of atof +++ * used in this compiler does not +++ * (sadly) complain when floating +++ * point numbers are too large. +++ */ diff --cc usr/src/cmd/pc0/call.c index 0000000000,0000000000,0000000000..8480cc13a7 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/call.c @@@@ -1,0 -1,0 -1,0 +1,399 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)call.c 1.3 10/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++ +++bool slenflag = 0; +++bool floatflag = 0; +++ +++/* +++ * Call generates code for calls to +++ * user defined procedures and functions +++ * and is called by proc and funccod. +++ * P is the result of the lookup +++ * of the procedure/function symbol, +++ * and porf is PROC or FUNC. +++ * Psbn is the block number of p. +++ */ +++struct nl * +++call(p, argv, porf, psbn) +++ struct nl *p; +++ int *argv, porf, psbn; +++{ +++ register struct nl *p1, *q; +++ int *r; +++ +++# ifdef OBJ +++ int cnt; +++# endif OBJ +++# ifdef PC +++ long temp; +++ int firsttime; +++ int rettype; +++# endif PC +++ +++# ifdef OBJ +++ if (p->class == FFUNC || p->class == FPROC) +++ put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]); +++ if (porf == FUNC) +++ /* +++ * Push some space +++ * for the function return type +++ */ +++ put2(O_PUSH, even(-width(p->type))); +++# endif OBJ +++# ifdef PC +++ if ( porf == FUNC ) { +++ switch( classify( p -> type ) ) { +++ case TSTR: +++ case TSET: +++ case TREC: +++ case TFILE: +++ case TARY: +++ temp = sizes[ cbn ].om_off -= width( p -> type ); +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ if (sizes[cbn].om_off < sizes[cbn].om_max) { +++ sizes[cbn].om_max = sizes[cbn].om_off; +++ } +++ putRV( 0 , cbn , temp , P2STRTY ); +++ } +++ } +++ switch ( p -> class ) { +++ case FUNC: +++ case PROC: +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int funcbn; +++ int i; +++ +++ starthere = &extname[0]; +++ funcbn = p -> nl_block & 037; +++ for ( i = 1 ; i < funcbn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "call namelength" ); +++ } +++ putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); +++ } +++ break; +++ case FFUNC: +++ case FPROC: +++ /* +++ * start one of these: +++ * FRTN( frtn , ( *FCALL( frtn ) )(...args...) ) +++ */ +++ putleaf( P2ICON , 0 , 0 , p2type( p ) , "_FRTN" ); +++ putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2PTR , ADDTYPE( P2FTN , p2type( p ) ) ) +++ , "_FCALL" ); +++ putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY ); +++ putop( P2CALL , p2type( p ) ); +++ break; +++ default: +++ panic("call class"); +++ } +++ firsttime = TRUE; +++# endif PC +++ /* +++ * Loop and process each of +++ * arguments to the proc/func. +++ */ +++ if ( p -> class == FUNC || p -> class == PROC ) { +++ for (p1 = p->chain; p1 != NIL; p1 = p1->chain) { +++ if (argv == NIL) { +++ error("Not enough arguments to %s", p->symbol); +++ return (NIL); +++ } +++ switch (p1->class) { +++ case REF: +++ /* +++ * Var parameter +++ */ +++ r = argv[1]; +++ if (r != NIL && r[0] != T_VAR) { +++ error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++ q = lvalue( (int *) argv[1], MOD , LREQ ); +++ if (q == NIL) +++ break; +++ if (q != p1->type) { +++ error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++ break; +++ case VAR: +++ /* +++ * Value parameter +++ */ +++# ifdef OBJ +++ q = rvalue(argv[1], p1->type , RREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * structure arguments require lvalues, +++ * scalars use rvalue. +++ */ +++ switch( classify( p1 -> type ) ) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ q = rvalue( argv[1] , p1 -> type , LREQ ); +++ break; +++ case TINT: +++ case TSCAL: +++ case TBOOL: +++ case TCHAR: +++ precheck( p1 -> type , "_RANG4" , "_RSNG4" ); +++ q = rvalue( argv[1] , p1 -> type , RREQ ); +++ postcheck( p1 -> type ); +++ break; +++ default: +++ q = rvalue( argv[1] , p1 -> type , RREQ ); +++ if ( isa( p1 -> type , "d" ) +++ && isa( q , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ break; +++ } +++# endif PC +++ if (q == NIL) +++ break; +++ if (incompat(q, p1->type, argv[1])) { +++ cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++# ifdef OBJ +++ if (isa(p1->type, "bcsi")) +++ rangechk(p1->type, q); +++ if (q->class != STR) +++ convert(q, p1->type); +++# endif OBJ +++# ifdef PC +++ switch( classify( p1 -> type ) ) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ putstrop( P2STARG +++ , p2type( p1 -> type ) +++ , lwidth( p1 -> type ) +++ , align( p1 -> type ) ); +++ } +++# endif PC +++ break; +++ case FFUNC: +++ /* +++ * function parameter +++ */ +++ q = flvalue( (int *) argv[1] , FFUNC ); +++ if (q == NIL) +++ break; +++ if (q != p1->type) { +++ error("Function type not identical to type of function parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++ break; +++ case FPROC: +++ /* +++ * procedure parameter +++ */ +++ q = flvalue( (int *) argv[1] , FPROC ); +++ if (q != NIL) { +++ error("Procedure parameter %s of %s cannot have a type", p1->symbol, p->symbol); +++ } +++ break; +++ default: +++ panic("call"); +++ } +++# ifdef PC +++ /* +++ * if this is the nth (>1) argument, +++ * hang it on the left linear list of arguments +++ */ +++ if ( firsttime ) { +++ firsttime = FALSE; +++ } else { +++ putop( P2LISTOP , P2INT ); +++ } +++# endif PC +++ argv = argv[2]; +++ } +++ if (argv != NIL) { +++ error("Too many arguments to %s", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ } else if ( p -> class == FFUNC || p -> class == FPROC ) { +++ /* +++ * formal routines can only have by-value parameters. +++ * this will lose for integer actuals passed to real +++ * formals, and strings which people want blank padded. +++ */ +++# ifdef OBJ +++ cnt = 0; +++# endif OBJ +++ for ( ; argv != NIL ; argv = argv[2] ) { +++# ifdef OBJ +++ q = rvalue(argv[1], NIL, RREQ ); +++ cnt += even(lwidth(q)); +++# endif OBJ +++# ifdef PC +++ /* +++ * structure arguments require lvalues, +++ * scalars use rvalue. +++ */ +++ codeoff(); +++ p1 = rvalue( argv[1] , NIL , RREQ ); +++ codeon(); +++ switch( classify( p1 ) ) { +++ case TSTR: +++ if ( p1 -> class == STR && slenflag == 0 ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Implementation can't construct equal length strings"); +++ slenflag++; +++ } +++ /* and fall through */ +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ q = rvalue( argv[1] , p1 , LREQ ); +++ break; +++ case TINT: +++ if ( floatflag == 0 ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Implementation can't coerice integer to real"); +++ floatflag++; +++ } +++ /* and fall through */ +++ case TSCAL: +++ case TBOOL: +++ case TCHAR: +++ default: +++ q = rvalue( argv[1] , p1 , RREQ ); +++ break; +++ } +++ switch( classify( p1 ) ) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ putstrop( P2STARG , p2type( p1 ) , +++ lwidth( p1 ) , align( p1 ) ); +++ } +++ /* +++ * if this is the nth (>1) argument, +++ * hang it on the left linear list of arguments +++ */ +++ if ( firsttime ) { +++ firsttime = FALSE; +++ } else { +++ putop( P2LISTOP , P2INT ); +++ } +++# endif PC +++ } +++ } else { +++ panic("call class"); +++ } +++# ifdef OBJ +++ if ( p -> class == FFUNC || p -> class == FPROC ) { +++ put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]); +++ put(2, O_FCALL, cnt); +++ put(2, O_FRTN, even(lwidth(p->type))); +++ } else { +++ put2(O_CALL | psbn << 8+INDX, p->entloc); +++ } +++# endif OBJ +++# ifdef PC +++ if ( porf == FUNC ) { +++ rettype = p2type( p -> type ); +++ switch ( classify( p -> type ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ case TDOUBLE: +++ case TPTR: +++ if ( firsttime ) { +++ putop( P2UNARY P2CALL , rettype ); +++ } else { +++ putop( P2CALL , rettype ); +++ } +++ if (p -> class == FFUNC || p -> class == FPROC ) { +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , rettype ); +++ } +++ break; +++ default: +++ if ( firsttime ) { +++ putstrop( P2UNARY P2STCALL +++ , ADDTYPE( rettype , P2PTR ) +++ , lwidth( p -> type ) +++ , align( p -> type ) ); +++ } else { +++ putstrop( P2STCALL +++ , ADDTYPE( rettype , P2PTR ) +++ , lwidth( p -> type ) +++ , align( p -> type ) ); +++ } +++ if (p -> class == FFUNC || p -> class == FPROC ) { +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , ADDTYPE( rettype , P2PTR ) ); +++ } +++ putstrop( P2STASG , rettype , lwidth( p -> type ) +++ , align( p -> type ) ); +++ putLV( 0 , cbn , temp , rettype ); +++ putop( P2COMOP , P2INT ); +++ break; +++ } +++ } else { +++ if ( firsttime ) { +++ putop( P2UNARY P2CALL , P2INT ); +++ } else { +++ putop( P2CALL , P2INT ); +++ } +++ if (p -> class == FFUNC || p -> class == FPROC ) { +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putdot( filename , line ); +++ } +++# endif PC +++ return (p->type); +++} +++ +++rvlist(al) +++ register int *al; +++{ +++ +++ for (; al != NIL; al = al[2]) +++ rvalue( (int *) al[1], NLNIL , RREQ ); +++} diff --cc usr/src/cmd/pc0/case.c index 0000000000,0000000000,0000000000..76b947a95d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/case.c @@@@ -1,0 -1,0 -1,0 +1,187 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)case.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++ +++/* +++ * The structure used to +++ * hold information about +++ * each case label. +++ */ +++struct ct { +++ long clong; +++ int cline; +++}; +++ +++#ifdef OBJ +++/* +++ * Caseop generates the +++ * pascal case statement code +++ */ +++caseop(r) +++ int *r; +++{ +++ register struct nl *p; +++ register struct ct *ctab; +++ register *cs; +++ int *cl; +++ double low, high; +++ short *brtab; +++ char *brtab0; +++ char *csend; +++ int w, i, j, m, n; +++ int nr, goc; +++ +++ goc = gocnt; +++ /* +++ * Obtain selector attributes: +++ * p type +++ * w width +++ * low lwb(p) +++ * high upb(p) +++ */ +++ p = rvalue((int *) r[2], NLNIL , RREQ ); +++ if (p != NIL) { +++ if (isnta(p, "bcsi")) { +++ error("Case selectors cannot be %ss", nameof(p)); +++ p = NIL; +++ } else { +++ cl = p; +++ if (p->class != RANGE) +++ cl = p->type; +++ if (cl == NIL) +++ p = NIL; +++ else { +++ w = width(p); +++#ifdef DEBUG +++ if (hp21mx) +++ w = 2; +++#endif +++ low = cl->range[0]; +++ high = cl->range[1]; +++ } +++ } +++ } +++ /* +++ * Count # of cases +++ */ +++ n = 0; +++ for (cl = r[3]; cl != NIL; cl = cl[2]) { +++ cs = cl[1]; +++ if (cs == NIL) +++ continue; +++ for (cs = cs[2]; cs != NIL; cs = cs[2]) +++ n++; +++ } +++ /* +++ * Allocate case table space +++ */ +++ ctab = i = malloc(n * sizeof *ctab); +++ if (i == -1) { +++ error("Ran out of memory (case)"); +++ pexit(DIED); +++ } +++ /* +++ * Check the legality of the +++ * labels and count the number +++ * of good labels +++ */ +++ m = 0; +++ for (cl = r[3]; cl != NIL; cl = cl[2]) { +++ cs = cl[1]; +++ if (cs == NIL) +++ continue; +++ line = cs[1]; +++ for (cs = cs[2]; cs != NIL; cs = cs[2]) { +++ gconst(cs[1]); +++ if (p == NIL || con.ctype == NIL) +++ continue; +++ if (incompat(con.ctype, p, NIL )) { +++ cerror("Case label type clashed with case selector expression type"); +++ continue; +++ } +++ if (con.crval < low || con.crval > high) { +++ error("Case label out of range"); +++ continue; +++ } +++ ctab[m].clong = con.crval; +++ ctab[m].cline = line; +++ m++; +++ } +++ } +++ +++ /* +++ * Check for duplicate labels +++ */ +++ for (i = 0; i < m; i++) +++ for (j = 0; j < m; j++) +++ if (ctab[i].clong == ctab[j].clong) { +++ if (i == j) +++ continue; +++ if (j < i) +++ break; +++ error("Multiply defined label in case, lines %d and %d", ctab[i].cline, ctab[j].cline); +++ } +++ /* +++ * Put out case operator and +++ * leave space for the +++ * branch table +++ */ +++ if (p != NIL) { +++ put(2, O_CASE1OP + (w >> 1), n); +++ brtab = brtab0 = lc; +++ putspace(n * 2); +++ put(1, O_CASEBEG); +++ for (i=0; i> 1), ctab[i].clong); +++ put(1, O_CASEEND); +++ } +++ csend = getlab(); +++ put(2, O_TRA, csend); +++ /* +++ * Free the case +++ * table space. +++ */ +++ free(ctab); +++ /* +++ * Generate code for each +++ * statement. Patch branch +++ * table to beginning of each +++ * statement and follow each +++ * statement with a branch back +++ * to the TRA above. +++ */ +++ nr = 1; +++ for (cl = r[3]; cl != NIL; cl = cl[2]) { +++ cs = cl[1]; +++ if (cs == NIL) +++ continue; +++ if (p != NIL) +++ for (cs = cs[2]; cs != NIL; cs = cs[2]) { +++ patchfil(brtab - 1, lc - brtab0, 1); +++ brtab++; +++ } +++ cs = cl[1]; +++ putcnt(); +++ level++; +++ statement(cs[3]); +++ nr &= noreach; +++ noreach = 0; +++ put(2, O_TRA, csend); +++ level--; +++ if (gotos[cbn]) +++ ungoto(); +++ } +++ /* +++ * Patch the termination branch +++ */ +++ patch(csend); +++ noreach = nr; +++ if (goc != gocnt) +++ putcnt(); +++} +++#endif OBJ diff --cc usr/src/cmd/pc0/clas.c index 0000000000,0000000000,0000000000..c6b354482a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/clas.c @@@@ -1,0 -1,0 -1,0 +1,208 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)clas.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++ +++/* +++ * This is the array of class +++ * names for the classes returned +++ * by classify. The order of the +++ * classes is the same as the base +++ * of the namelist, with special +++ * negative index entries for structures, +++ * scalars, pointers, sets and strings +++ * to be collapsed into. +++ */ +++char *clnxxxx[] = +++{ +++ "file", /* -7 TFILE */ +++ "record", /* -6 TREC */ +++ "array", /* -5 TARY */ +++ "scalar", /* -4 TSCAL */ +++ "pointer", /* -3 TPTR */ +++ "set", /* -2 TSET */ +++ "string", /* -1 TSTR */ +++ "SNARK", /* 0 NIL */ +++ "Boolean", /* 1 TBOOL */ +++ "char", /* 2 TCHAR */ +++ "integer", /* 3 TINT */ +++ "real", /* 4 TREAL */ +++ "\"nil\"", /* 5 TNIL */ +++}; +++ +++char **clnames = &clnxxxx[-(TFIRST)]; +++ +++/* +++ * Classify takes a pointer +++ * to a type and returns one +++ * of several interesting group +++ * classifications for easy use. +++ */ +++classify(p1) +++ struct nl *p1; +++{ +++ register struct nl *p; +++ +++ p = p1; +++swit: +++ if (p == NIL) { +++ nocascade(); +++ return (NIL); +++ } +++ if (p == &nl[TSTR]) +++ return (TSTR); +++ if ( p == &nl[ TSET ] ) { +++ return TSET; +++ } +++ switch (p->class) { +++ case PTR: +++ return (TPTR); +++ case ARRAY: +++ if (p->type == nl+T1CHAR) +++ return (TSTR); +++ return (TARY); +++ case STR: +++ return (TSTR); +++ case SET: +++ return (TSET); +++ case RANGE: +++ p = p->type; +++ goto swit; +++ case TYPE: +++ if (p <= nl+TLAST) +++ return (p - nl); +++ panic("clas2"); +++ case FILET: +++ return (TFILE); +++ case RECORD: +++ return (TREC); +++ case SCAL: +++ return (TSCAL); +++ default: +++ panic("clas"); +++ } +++} +++ +++#ifndef PI0 +++/* +++ * Is p a text file? +++ */ +++text(p) +++ struct nl *p; +++{ +++ +++ return (p != NIL && p->class == FILET && p->type == nl+T1CHAR); +++} +++#endif +++ +++/* +++ * Scalar returns a pointer to +++ * the the base scalar type of +++ * its argument if its argument +++ * is a SCALar else NIL. +++ */ +++scalar(p1) +++ struct nl *p1; +++{ +++ register struct nl *p; +++ +++ p = p1; +++ if (p == NIL) +++ return (NIL); +++ if (p->class == RANGE) +++ p = p->type; +++ if (p == NIL) +++ return (NIL); +++ return (p->class == SCAL ? p : NIL); +++} +++ +++/* +++ * Isa tells whether p +++ * is one of a group of +++ * namelist classes. The +++ * classes wanted are specified +++ * by the characters in s. +++ * (Note that s would more efficiently, +++ * if less clearly, be given by a mask.) +++ */ +++isa(p, s) +++ register struct nl *p; +++ char *s; +++{ +++ register i; +++ register char *cp; +++ +++ if (p == NIL) +++ return (NIL); +++ /* +++ * map ranges down to +++ * the base type +++ */ +++ if (p->class == RANGE) +++ p = p->type; +++ /* +++ * the following character/class +++ * associations are made: +++ * +++ * s scalar +++ * b Boolean +++ * c character +++ * i integer +++ * d double (real) +++ * t set +++ */ +++ switch (p->class) { +++ case SET: +++ i = TDOUBLE+1; +++ break; +++ case SCAL: +++ i = 0; +++ break; +++ default: +++ i = p - nl; +++ } +++ if (i >= 0 && i <= TDOUBLE+1) { +++ i = "sbcidt"[i]; +++ cp = s; +++ while (*cp) +++ if (*cp++ == i) +++ return (1); +++ } +++ return (NIL); +++} +++ +++/* +++ * Isnta is !isa +++ */ +++isnta(p, s) +++{ +++ +++ return (!isa(p, s)); +++} +++ +++/* +++ * "shorthand" +++ */ +++nameof(p) +++{ +++ +++ return (clnames[classify(p)]); +++} +++ +++#ifndef PI0 +++nowexp(r) +++ int *r; +++{ +++ if (r[0] == T_WEXP) { +++ if (r[2] == NIL) +++ error("Oct/hex allowed only on writeln/write calls"); +++ else +++ error("Width expressions allowed only in writeln/write calls"); +++ return (1); +++ } +++ return (NIL); +++} +++#endif diff --cc usr/src/cmd/pc0/const.c index 0000000000,0000000000,0000000000..e18b0b2c3f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/const.c @@@@ -1,0 -1,0 -1,0 +1,252 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)const.c 1.4 9/4/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++ +++/* +++ * Const enters the definitions +++ * of the constant declaration +++ * part into the namelist. +++ */ +++#ifndef PI1 +++constbeg() +++{ +++ +++/* +++ * this allows for multiple declaration +++ * parts, unless the "standard" option +++ * has been specified. +++ * If a routine segment is being compiled, +++ * do level one processing. +++ */ +++ +++ if (!progseen) +++ level1(); +++ if (parts[ cbn ] & (TPRT|VPRT|RPRT)) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Constant declarations should precede type, var and routine declarations"); +++ } +++ if (parts[ cbn ] & CPRT) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All constants should be declared in one const part"); +++ } +++ parts[ cbn ] |= CPRT; +++} +++#endif PI1 +++ +++const(cline, cid, cdecl) +++ int cline; +++ register char *cid; +++ register int *cdecl; +++{ +++ register struct nl *np; +++ +++#ifdef PI0 +++ send(REVCNST, cline, cid, cdecl); +++#endif +++ line = cline; +++ gconst(cdecl); +++ np = enter(defnl(cid, CONST, con.ctype, con.cival)); +++#ifndef PI0 +++ np->nl_flags |= NMOD; +++#endif +++ +++#ifdef PC +++ if (cbn == 1) { +++ stabgconst( cid , line ); +++ } +++#endif PC +++ +++# ifdef PTREE +++ { +++ pPointer Const = ConstDecl( cid , cdecl ); +++ pPointer *Consts; +++ +++ pSeize( PorFHeader[ nesting ] ); +++ Consts = &( pDEF( PorFHeader[ nesting ] ).PorFConsts ); +++ *Consts = ListAppend( *Consts , Const ); +++ pRelease( PorFHeader[ nesting ] ); +++ } +++# endif +++ if (con.ctype == NIL) +++ return; +++ if ( con.ctype == nl + TSTR ) +++ np->ptr[0] = con.cpval; +++ if (isa(con.ctype, "i")) +++ np->range[0] = con.crval; +++ else if (isa(con.ctype, "d")) +++ np->real = con.crval; +++} +++ +++#ifndef PI0 +++#ifndef PI1 +++constend() +++{ +++ +++} +++#endif +++#endif +++ +++/* +++ * Gconst extracts +++ * a constant declaration +++ * from the tree for it. +++ * only types of constants +++ * are integer, reals, strings +++ * and scalars, the first two +++ * being possibly signed. +++ */ +++gconst(r) +++ int *r; +++{ +++ register struct nl *np; +++ register *cn; +++ char *cp; +++ int negd, sgnd; +++ long ci; +++ +++ con.ctype = NIL; +++ cn = r; +++ negd = sgnd = 0; +++loop: +++ if (cn == NIL || cn[1] == NIL) +++ return (NIL); +++ switch (cn[0]) { +++ default: +++ panic("gconst"); +++ case T_MINUSC: +++ negd = 1 - negd; +++ case T_PLUSC: +++ sgnd++; +++ cn = cn[1]; +++ goto loop; +++ case T_ID: +++ np = lookup(cn[1]); +++ if (np == NIL) +++ return; +++ if (np->class != CONST) { +++ derror("%s is a %s, not a constant as required", cn[1], classes[np->class]); +++ return; +++ } +++ con.ctype = np->type; +++ switch (classify(np->type)) { +++ case TINT: +++ con.crval = np->range[0]; +++ break; +++ case TDOUBLE: +++ con.crval = np->real; +++ break; +++ case TBOOL: +++ case TCHAR: +++ case TSCAL: +++ con.cival = np->value[0]; +++ con.crval = con.cival; +++ break; +++ case TSTR: +++ con.cpval = np->ptr[0]; +++ break; +++ case NIL: +++ con.ctype = NIL; +++ return; +++ default: +++ panic("gconst2"); +++ } +++ break; +++ case T_CBINT: +++ con.crval = a8tol(cn[1]); +++ goto restcon; +++ case T_CINT: +++ con.crval = atof(cn[1]); +++ if (con.crval > MAXINT || con.crval < MININT) { +++ derror("Constant too large for this implementation"); +++ con.crval = 0; +++ } +++restcon: +++ ci = con.crval; +++#ifndef PI0 +++ if (bytes(ci, ci) <= 2) +++ con.ctype = nl+T2INT; +++ else +++#endif +++ con.ctype = nl+T4INT; +++ break; +++ case T_CFINT: +++ con.ctype = nl+TDOUBLE; +++ con.crval = atof(cn[1]); +++ break; +++ case T_CSTRNG: +++ cp = cn[1]; +++ if (cp[1] == 0) { +++ con.ctype = nl+T1CHAR; +++ con.cival = cp[0]; +++ con.crval = con.cival; +++ break; +++ } +++ con.ctype = nl+TSTR; +++ con.cpval = savestr(cp); +++ break; +++ } +++ if (sgnd) { +++ if (isnta(con.ctype, "id")) +++ derror("%s constants cannot be signed", nameof(con.ctype)); +++ else { +++ if (negd) +++ con.crval = -con.crval; +++ ci = con.crval; +++ } +++ } +++} +++ +++#ifndef PI0 +++isconst(r) +++ register int *r; +++{ +++ +++ if (r == NIL) +++ return (1); +++ switch (r[0]) { +++ case T_MINUS: +++ r[0] = T_MINUSC; +++ r[1] = r[2]; +++ return (isconst(r[1])); +++ case T_PLUS: +++ r[0] = T_PLUSC; +++ r[1] = r[2]; +++ return (isconst(r[1])); +++ case T_VAR: +++ if (r[3] != NIL) +++ return (0); +++ r[0] = T_ID; +++ r[1] = r[2]; +++ return (1); +++ case T_BINT: +++ r[0] = T_CBINT; +++ r[1] = r[2]; +++ return (1); +++ case T_INT: +++ r[0] = T_CINT; +++ r[1] = r[2]; +++ return (1); +++ case T_FINT: +++ r[0] = T_CFINT; +++ r[1] = r[2]; +++ return (1); +++ case T_STRNG: +++ r[0] = T_CSTRNG; +++ r[1] = r[2]; +++ return (1); +++ } +++ return (0); +++} +++#endif diff --cc usr/src/cmd/pc0/conv.c index 0000000000,0000000000,0000000000..165ee80088 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/conv.c @@@@ -1,0 -1,0 -1,0 +1,340 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)conv.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#ifdef PI +++#include "0.h" +++#include "opcode.h" +++#ifdef PC +++# include "pcops.h" +++#endif PC +++ +++#ifndef PI0 +++/* +++ * Convert a p1 into a p2. +++ * Mostly used for different +++ * length integers and "to real" conversions. +++ */ +++convert(p1, p2) +++ struct nl *p1, *p2; +++{ +++ if (p1 == NIL || p2 == NIL) +++ return; +++ switch (width(p1) - width(p2)) { +++ case -7: +++ case -6: +++ put1(O_STOD); +++ return; +++ case -4: +++ put1(O_ITOD); +++ return; +++ case -3: +++ case -2: +++ put1(O_STOI); +++ return; +++ case -1: +++ case 0: +++ case 1: +++ return; +++ case 2: +++ case 3: +++ put1(O_ITOS); +++ return; +++ default: +++ panic("convert"); +++ } +++} +++#endif +++ +++/* +++ * Compat tells whether +++ * p1 and p2 are compatible +++ * types for an assignment like +++ * context, i.e. value parameters, +++ * indicies for 'in', etc. +++ */ +++compat(p1, p2, t) +++ struct nl *p1, *p2; +++{ +++ register c1, c2; +++ +++ c1 = classify(p1); +++ if (c1 == NIL) +++ return (NIL); +++ c2 = classify(p2); +++ if (c2 == NIL) +++ return (NIL); +++ switch (c1) { +++ case TBOOL: +++ case TCHAR: +++ if (c1 == c2) +++ return (1); +++ break; +++ case TINT: +++ if (c2 == TINT) +++ return (1); +++ case TDOUBLE: +++ if (c2 == TDOUBLE) +++ return (1); +++#ifndef PI0 +++ if (c2 == TINT && divflg == 0 && t != NIL ) { +++ divchk= 1; +++ c1 = classify(rvalue(t, NLNIL , RREQ )); +++ divchk = NIL; +++ if (c1 == TINT) { +++ error("Type clash: real is incompatible with integer"); +++ cerror("This resulted because you used '/' which always returns real rather"); +++ cerror("than 'div' which divides integers and returns integers"); +++ divflg = 1; +++ return (NIL); +++ } +++ } +++#endif +++ break; +++ case TSCAL: +++ if (c2 != TSCAL) +++ break; +++ if (scalar(p1) != scalar(p2)) { +++ derror("Type clash: non-identical scalar types"); +++ return (NIL); +++ } +++ return (1); +++ case TSTR: +++ if (c2 != TSTR) +++ break; +++ if (width(p1) != width(p2)) { +++ derror("Type clash: unequal length strings"); +++ return (NIL); +++ } +++ return (1); +++ case TNIL: +++ if (c2 != TPTR) +++ break; +++ return (1); +++ case TFILE: +++ if (c1 != c2) +++ break; +++ derror("Type clash: files not allowed in this context"); +++ return (NIL); +++ default: +++ if (c1 != c2) +++ break; +++ if (p1 != p2) { +++ derror("Type clash: non-identical %s types", clnames[c1]); +++ return (NIL); +++ } +++ if (p1->nl_flags & NFILES) { +++ derror("Type clash: %ss with file components not allowed in this context", clnames[c1]); +++ return (NIL); +++ } +++ return (1); +++ } +++ derror("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]); +++ return (NIL); +++} +++ +++#ifndef PI0 +++/* +++ * Rangechk generates code to +++ * check if the type p on top +++ * of the stack is in range for +++ * assignment to a variable +++ * of type q. +++ */ +++rangechk(p, q) +++ struct nl *p, *q; +++{ +++ register struct nl *rp; +++ register op; +++ int wq, wrp; +++ +++ if (opt('t') == 0) +++ return; +++ rp = p; +++ if (rp == NIL) +++ return; +++ if (q == NIL) +++ return; +++# ifdef OBJ +++ /* +++ * When op is 1 we are checking length +++ * 4 numbers against length 2 bounds, +++ * and adding it to the opcode forces +++ * generation of appropriate tests. +++ */ +++ op = 0; +++ wq = width(q); +++ wrp = width(rp); +++ op = wq != wrp && (wq == 4 || wrp == 4); +++ if (rp->class == TYPE) +++ rp = rp->type; +++ switch (rp->class) { +++ case RANGE: +++ if (rp->range[0] != 0) { +++# ifndef DEBUG +++ if (wrp <= 2) +++ put(3, O_RANG2+op, ( short ) rp->range[0], +++ ( short ) rp->range[1]); +++ else if (rp != nl+T4INT) +++ put(3, O_RANG4+op, rp->range[0], rp->range[1] ); +++# else +++ if (!hp21mx) { +++ if (wrp <= 2) +++ put(3, O_RANG2+op,( short ) rp->range[0], +++ ( short ) rp->range[1]); +++ else if (rp != nl+T4INT) +++ put(3, O_RANG4+op,rp->range[0], +++ rp->range[1]); +++ } else +++ if (rp != nl+T2INT && rp != nl+T4INT) +++ put(3, O_RANG2+op,( short ) rp->range[0], +++ ( short ) rp->range[1]); +++# endif +++ break; +++ } +++ /* +++ * Range whose lower bounds are +++ * zero can be treated as scalars. +++ */ +++ case SCAL: +++ if (wrp <= 2) +++ put(2, O_RSNG2+op, ( short ) rp->range[1]); +++ else +++ put( 2 , O_RSNG4+op, rp->range[1]); +++ break; +++ default: +++ panic("rangechk"); +++ } +++# endif OBJ +++# ifdef PC +++ /* +++ * what i want to do is make this and some other stuff +++ * arguments to a function call, which will do the rangecheck, +++ * and return the value of the current expression, or abort +++ * if the rangecheck fails. +++ * probably i need one rangecheck routine to return each c-type +++ * of value. +++ * also, i haven't figured out what the `other stuff' is. +++ */ +++ putprintf( "# call rangecheck" , 0 ); +++# endif PC +++} +++#endif +++#endif +++ +++#ifdef PC +++ /* +++ * if type p requires a range check, +++ * then put out the name of the checking function +++ * for the beginning of a function call which is completed by postcheck. +++ * (name1 is for a full check; name2 assumes a lower bound of zero) +++ */ +++precheck( p , name1 , name2 ) +++ struct nl *p; +++ char *name1 , *name2; +++ { +++ +++ if ( opt( 't' ) == 0 ) { +++ return; +++ } +++ if ( p == NIL ) { +++ return; +++ } +++ if ( p -> class == TYPE ) { +++ p = p -> type; +++ } +++ switch ( p -> class ) { +++ case RANGE: +++ if ( p != nl + T4INT ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , p -> range[0] != 0 ? name1 : name2 ); +++ } +++ break; +++ case SCAL: +++ /* +++ * how could a scalar ever be out of range? +++ */ +++ break; +++ default: +++ panic( "precheck" ); +++ break; +++ } +++ } +++ +++ /* +++ * if type p requires a range check, +++ * then put out the rest of the arguments of to the checking function +++ * a call to which was started by precheck. +++ * the first argument is what is being rangechecked (put out by rvalue), +++ * the second argument is the lower bound of the range, +++ * the third argument is the upper bound of the range. +++ */ +++postcheck( p ) +++ struct nl *p; +++ { +++ +++ if ( opt( 't' ) == 0 ) { +++ return; +++ } +++ if ( p == NIL ) { +++ return; +++ } +++ if ( p -> class == TYPE ) { +++ p = p -> type; +++ } +++ switch ( p -> class ) { +++ case RANGE: +++ if ( p != nl + T4INT ) { +++ if (p -> range[0] != 0 ) { +++ putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ } +++ putleaf( P2ICON , p -> range[1] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ break; +++ case SCAL: +++ break; +++ default: +++ panic( "postcheck" ); +++ break; +++ } +++ } +++#endif PC +++ +++#ifdef DEBUG +++conv(dub) +++ int *dub; +++{ +++ int newfp[2]; +++ double *dp = dub; +++ long *lp = dub; +++ register int exp; +++ long mant; +++ +++ newfp[0] = dub[0] & 0100000; +++ newfp[1] = 0; +++ if (*dp == 0.0) +++ goto ret; +++ exp = ((dub[0] >> 7) & 0377) - 0200; +++ if (exp < 0) { +++ newfp[1] = 1; +++ exp = -exp; +++ } +++ if (exp > 63) +++ exp = 63; +++ dub[0] &= ~0177600; +++ dub[0] |= 0200; +++ mant = *lp; +++ mant <<= 8; +++ if (newfp[0]) +++ mant = -mant; +++ newfp[0] |= (mant >> 17) & 077777; +++ newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1); +++ret: +++ dub[0] = newfp[0]; +++ dub[1] = newfp[1]; +++} +++#endif diff --cc usr/src/cmd/pc0/cset.c index 0000000000,0000000000,0000000000..e150a2df58 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/cset.c @@@@ -1,0 -1,0 -1,0 +1,413 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)cset.c 1.2 10/19/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#include "pc.h" +++#include "pcops.h" +++ +++/* +++ * rummage through a `constant' set (i.e. anything within [ ]'s) tree +++ * and decide if this is a compile time constant set or a runtime set. +++ * this information is returned in a structure passed from the caller. +++ * while rummaging, this also reorders the tree so that all ranges +++ * preceed all singletons. +++ */ +++bool +++precset( r , settype , csetp ) +++ int *r; +++ struct nl *settype; +++ struct csetstr *csetp; +++{ +++ register int *e; +++ register struct nl *t; +++ register struct nl *exptype; +++ register int *el; +++ register int *pairp; +++ register int *singp; +++ int *ip; +++ long lower; +++ long upper; +++ long rangeupper; +++ bool setofint; +++ +++ csetp -> csettype = NIL; +++ csetp -> paircnt = 0; +++ csetp -> singcnt = 0; +++ csetp -> comptime = TRUE; +++ setofint = FALSE; +++ if ( settype != NIL ) { +++ if ( settype -> class == SET ) { +++ /* +++ * the easy case, we are told the type of the set. +++ */ +++ exptype = settype -> type; +++ } else { +++ /* +++ * we are told the type, but it's not a set +++ * supposedly possible if someone tries +++ * e.g string context [1,2] = 'abc' +++ */ +++ error("Constant set involved in non set context"); +++ return csetp -> comptime; +++ } +++ } else { +++ /* +++ * So far we have no indication +++ * of what the set type should be. +++ * We "look ahead" and try to infer +++ * The type of the constant set +++ * by evaluating one of its members. +++ */ +++ e = r[2]; +++ if (e == NIL) { +++ /* +++ * tentative for [], return type of `intset' +++ */ +++ settype = lookup( intset ); +++ if ( settype == NIL ) { +++ panic( "empty set" ); +++ } +++ settype = settype -> type; +++ if ( settype == NIL ) { +++ return csetp -> comptime; +++ } +++ if ( isnta( settype , "t" ) ) { +++ error("Set default type \"intset\" is not a set"); +++ return csetp -> comptime; +++ } +++ csetp -> csettype = settype; +++ return csetp -> comptime; +++ } +++ e = e[1]; +++ if (e == NIL) { +++ return csetp -> comptime; +++ } +++ if (e[0] == T_RANG) { +++ e = e[1]; +++ } +++ codeoff(); +++ t = rvalue(e, NIL , RREQ ); +++ codeon(); +++ if (t == NIL) { +++ return csetp -> comptime; +++ } +++ /* +++ * The type of the set, settype, is +++ * deemed to be a set of the base type +++ * of t, which we call exptype. If, +++ * however, this would involve a +++ * "set of integer", we cop out +++ * and use "intset"'s current scoped +++ * type instead. +++ */ +++ if (isa(t, "r")) { +++ error("Sets may not have 'real' elements"); +++ return csetp -> comptime; +++ } +++ if (isnta(t, "bcsi")) { +++ error("Set elements must be scalars, not %ss", nameof(t)); +++ return csetp -> comptime; +++ } +++ if (isa(t, "i")) { +++ settype = lookup(intset); +++ if (settype == NIL) +++ panic("intset"); +++ settype = settype->type; +++ if (settype == NIL) +++ return csetp -> comptime; +++ if (isnta(settype, "t")) { +++ error("Set default type \"intset\" is not a set"); +++ return csetp -> comptime; +++ } +++ exptype = settype->type; +++ /* +++ * say we are doing an intset +++ * but, if we get out of range errors for intset +++ * we punt constructing the set at compile time. +++ */ +++ setofint = TRUE; +++ } else { +++ exptype = t->type; +++ if (exptype == NIL) +++ return csetp -> comptime; +++ if (exptype->class != RANGE) +++ exptype = exptype->type; +++ settype = defnl(0, SET, exptype, 0); +++ } +++ } +++ csetp -> csettype = settype; +++ setran( exptype ); +++ lower = set.lwrb; +++ upper = set.lwrb + set.uprbp; +++ pairp = NIL; +++ singp = NIL; +++ codeoff(); +++ while ( el = r[2] ) { +++ e = el[1]; +++ if (e == NIL) { +++ /* +++ * don't hang this one anywhere. +++ */ +++ csetp -> csettype = NIL; +++ r[2] = el[2]; +++ continue; +++ } +++ if (e[0] == T_RANG) { +++ if ( csetp -> comptime && constval( e[2] ) ) { +++ t = con.ctype; +++ if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) { +++ if ( setofint ) { +++ csetp -> comptime = FALSE; +++ } else { +++ error("Range upper bound of %d out of set bounds" , ((long)con.crval) ); +++ csetp -> csettype = NIL; +++ } +++ } +++ rangeupper = ((long)con.crval); +++ } else { +++ csetp -> comptime = FALSE; +++ t = rvalue(e[2], NIL , RREQ ); +++ if (t == NIL) { +++ rvalue(e[1], NIL , RREQ ); +++ goto pairhang; +++ } +++ } +++ if (incompat(t, exptype, e[2])) { +++ cerror("Upper bound of element type clashed with set type in constant set"); +++ } +++ if ( csetp -> comptime && constval( e[1] ) ) { +++ t = con.ctype; +++ if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) { +++ if ( setofint ) { +++ csetp -> comptime = FALSE; +++ } else { +++ error("Range lower bound of %d out of set bounds" , ((long)con.crval) ); +++ csetp -> csettype = NIL; +++ } +++ } +++ } else { +++ csetp -> comptime = FALSE; +++ t = rvalue(e[1], NIL , RREQ ); +++ if (t == NIL) { +++ goto pairhang; +++ } +++ } +++ if (incompat(t, exptype, e[1])) { +++ cerror("Lower bound of element type clashed with set type in constant set"); +++ } +++pairhang: +++ /* +++ * remove this range from the tree list and +++ * hang it on the pairs list. +++ */ +++ ip = el[2]; +++ el[2] = pairp; +++ pairp = r[2]; +++ r[2] = ip; +++ csetp -> paircnt++; +++ } else { +++ if ( csetp -> comptime && constval( e ) ) { +++ t = con.ctype; +++ if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) { +++ if ( setofint ) { +++ csetp -> comptime = FALSE; +++ } else { +++ error("Value of %d out of set bounds" , ((long)con.crval) ); +++ csetp -> csettype = NIL; +++ } +++ } +++ } else { +++ csetp -> comptime = FALSE; +++ t = rvalue((int *) e, NLNIL , RREQ ); +++ if (t == NIL) { +++ goto singhang; +++ } +++ } +++ if (incompat(t, exptype, e)) { +++ cerror("Element type clashed with set type in constant set"); +++ } +++singhang: +++ /* +++ * take this expression off the tree list and +++ * hang it on the list of singletons. +++ */ +++ ip = el[2]; +++ el[2] = singp; +++ singp = r[2]; +++ r[2] = ip; +++ csetp -> singcnt++; +++ } +++ } +++ codeon(); +++# ifdef PC +++ if ( pairp != NIL ) { +++ for ( el = pairp ; el[2] != NIL ; el = el[2] ) /* void */; +++ el[2] = singp; +++ r[2] = pairp; +++ } else { +++ r[2] = singp; +++ } +++# endif PC +++# ifdef OBJ +++ if ( singp != NIL ) { +++ for ( el = singp ; el[2] != NIL ; el = el[2] ) /* void */; +++ el[2] = pairp; +++ r[2] = singp; +++ } else { +++ r[2] = pairp; +++ } +++# endif OBJ +++ if ( csetp -> csettype == NIL ) { +++ csetp -> comptime = TRUE; +++ } +++ return csetp -> comptime; +++} +++ +++#define BITSPERLONG ( sizeof( long ) * BITSPERBYTE ) +++ /* +++ * mask[i] has the low i bits turned off. +++ */ +++long mask[] = { +++ 0xffffffff , 0xfffffffe , 0xfffffffc , 0xfffffff8 , +++ 0xfffffff0 , 0xffffffe0 , 0xffffffc0 , 0xffffff80 , +++ 0xffffff00 , 0xfffffe00 , 0xfffffc00 , 0xfffff800 , +++ 0xfffff000 , 0xffffe000 , 0xffffc000 , 0xffff8000 , +++ 0xffff0000 , 0xfffe0000 , 0xfffc0000 , 0xfff80000 , +++ 0xfff00000 , 0xffe00000 , 0xffc00000 , 0xff800000 , +++ 0xff000000 , 0xfe000000 , 0xfc000000 , 0xf8000000 , +++ 0xf0000000 , 0xe0000000 , 0xc0000000 , 0x80000000 , +++ 0x00000000 +++ }; +++ /* +++ * given a csetstr, either +++ * put out a compile time constant set and an lvalue to it. +++ * or +++ * put out rvalues for the singletons and the pairs +++ * and counts of each. +++ */ +++postcset( r , csetp ) +++ int *r; +++ struct csetstr *csetp; +++ { +++ register int *el; +++ register int *e; +++ int lower; +++ int upper; +++ int lowerdiv; +++ int lowermod; +++ int upperdiv; +++ int uppermod; +++ int label; +++ long *lp; +++ long *limit; +++ long tempset[ ( MAXSET / BITSPERLONG ) + 1 ]; +++ long temp; +++ char labelname[ BUFSIZ ]; +++ +++ if ( csetp -> comptime ) { +++ setran( ( csetp -> csettype ) -> type ); +++ limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ]; +++ for ( lp = &tempset[0] ; lp < limit ; lp++ ) { +++ *lp = 0; +++ } +++ for ( el = r[2] ; el != NIL ; el = el[2] ) { +++ e = el[1]; +++ if ( e[0] == T_RANG ) { +++ constval( e[1] ); +++ lower = (long) con.crval; +++ constval( e[2] ); +++ upper = (long) con.crval; +++ if ( upper < lower ) { +++ continue; +++ } +++ lowerdiv = ( lower - set.lwrb ) / BITSPERLONG; +++ lowermod = ( lower - set.lwrb ) % BITSPERLONG; +++ upperdiv = ( upper - set.lwrb ) / BITSPERLONG; +++ uppermod = ( upper - set.lwrb ) % BITSPERLONG; +++ temp = mask[ lowermod ]; +++ if ( lowerdiv == upperdiv ) { +++ temp &= ~mask[ uppermod + 1 ]; +++ } +++ tempset[ lowerdiv ] |= temp; +++ limit = &tempset[ upperdiv-1 ]; +++ for ( lp = &tempset[ lowerdiv+1 ] ; lp <= limit ; lp++ ) { +++ *lp |= ~0; +++ } +++ if ( lowerdiv != upperdiv ) { +++ tempset[ upperdiv ] |= ~mask[ uppermod + 1 ]; +++ } +++ } else { +++ constval( e ); +++ lowerdiv = ( ((long)con.crval) - set.lwrb ) / BITSPERLONG; +++ lowermod = ( ((long)con.crval) - set.lwrb ) % BITSPERLONG; +++ tempset[ lowerdiv ] |= ( 1 << lowermod ); +++ } +++ } +++ if ( cgenflg ) +++ return; +++# ifdef PC +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 2" , 0 ); +++ label = getlab(); +++ putlab( label ); +++ lp = &( tempset[0] ); +++ limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ]; +++ while ( lp < limit ) { +++ putprintf( " .long 0x%x" , 1 , *lp ++ ); +++ for ( temp = 2 ; ( temp <= 8 ) && lp < limit ; temp ++ ) { +++ putprintf( ",0x%x" , 1 , *lp++ ); +++ } +++ putprintf( "" , 0 ); +++ } +++ putprintf( " .text" , 0 ); +++ sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label ); +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2STRTY , labelname ); +++# endif PC +++# ifdef OBJ +++ put( 2, O_CON, (set.uprbp / BITSPERLONG + 1) * +++ (BITSPERLONG / BITSPERBYTE)); +++ lp = &( tempset[0] ); +++ limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ]; +++ while ( lp < limit ) { +++ put( 2, O_CASE4, *lp ++); +++ } +++# endif OBJ +++ } else { +++# ifdef PC +++ putleaf( P2ICON , csetp -> paircnt , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , csetp -> singcnt , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ for ( el = r[2] ; el != NIL ; el = el[2] ) { +++ e = el[1]; +++ if ( e[0] == T_RANG ) { +++ rvalue( e[2] , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ rvalue( e[1] , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ rvalue( e , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } +++ } +++# endif PC +++# ifdef OBJ +++ for ( el = r[2] ; el != NIL ; el = el[2] ) { +++ e = el[1]; +++ if ( e[0] == T_RANG ) { +++ stkrval( e[2] , NIL , RREQ ); +++ stkrval( e[1] , NIL , RREQ ); +++ } else { +++ stkrval( e , NIL , RREQ ); +++ } +++ } +++ put( 2 , O_CON24 , csetp -> singcnt ); +++ put( 2 , O_CON24 , csetp -> paircnt ); +++# endif OBJ +++ } +++} diff --cc usr/src/cmd/pc0/error.c index 0000000000,0000000000,0000000000..256ed2b71b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/error.c @@@@ -1,0 -1,0 -1,0 +1,135 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)error.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#ifndef PI1 +++#include "yy.h" +++#endif +++ +++char errpfx = 'E'; +++extern int yyline; +++/* +++ * Panic is called when impossible +++ * (supposedly, anyways) situations +++ * are encountered. +++ * Panic messages should be short +++ * as they do not go to the message +++ * file. +++ */ +++panic(s) +++ char *s; +++{ +++ +++#ifdef DEBUG +++#ifdef PI1 +++ printf("Snark (%s) line=%d\n", s, line); +++ abort(); +++#else +++ printf("Snark (%s) line=%d, yyline=%d\n", s, line, yyline); +++ abort () ; /* die horribly */ +++#endif +++#endif +++#ifdef PI1 +++ Perror( "Snark in pi1", s); +++#else +++ Perror( "Snark in pi", s); +++#endif +++ pexit(DIED); +++} +++ +++extern char *errfile; +++/* +++ * Error is called for +++ * semantic errors and +++ * prints the error and +++ * a line number. +++ */ +++ +++/*VARARGS*/ +++ +++error(a1, a2, a3, a4) +++ register char *a1; +++{ +++ char errbuf[256]; /* was extern. why? ...pbk */ +++ register int i; +++ +++ if (errpfx == 'w' && opt('w') != 0) { +++ errpfx = 'E'; +++ return; +++ } +++ Enocascade = 0; +++ geterr(a1, errbuf); +++ a1 = errbuf; +++ if (line < 0) +++ line = -line; +++#ifndef PI1 +++ if (opt('l')) +++ yyoutline(); +++#endif +++ yysetfile(filename); +++ if (errpfx == ' ') { +++ printf(" "); +++ for (i = line; i >= 10; i /= 10) +++ pchr( ' ' ); +++ printf("... "); +++ } else if (Enoline) +++ printf(" %c - ", errpfx); +++ else +++ printf("%c %d - ", errpfx, line); +++ printf(a1, a2, a3, a4); +++ if (errpfx == 'E') +++#ifndef PI0 +++ eflg++, codeoff(); +++#else +++ eflg++; +++#endif +++ errpfx = 'E'; +++ if (Eholdnl) +++ Eholdnl = 0; +++ else +++ pchr( '\n' ); +++} +++ +++/*VARAGRS*/ +++ +++cerror(a1, a2, a3, a4) +++{ +++ +++ if (Enocascade) +++ return; +++ setpfx(' '); +++ error(a1, a2, a3, a4); +++} +++ +++#ifdef PI1 +++ +++/*VARARGS*/ +++ +++derror(a1, a2, a3, a4) +++{ +++ +++ if (!holdderr) +++ error(a1, a2, a3, a4); +++ errpfx = 'E'; +++} +++ +++char *lastname, printed, hadsome; +++ +++ /* +++ * this yysetfile for PI1 only. +++ * the real yysetfile is in yyput.c +++ */ +++yysetfile(name) +++ char *name; +++{ +++ +++ if (lastname == name) +++ return; +++ printed =| 1; +++ gettime( name ); +++ printf("%s %s:\n" , myctime( &tvec ) , name ); +++ lastname = name; +++} +++#endif diff --cc usr/src/cmd/pc0/fdec.c index 0000000000,0000000000,0000000000..c15f3b1cbe new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/fdec.c @@@@ -1,0 -1,0 -1,0 +1,1110 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)fdec.c 1.7 10/28/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#include "align.h" +++ +++/* +++ * this array keeps the pxp counters associated with +++ * functions and procedures, so that they can be output +++ * when their bodies are encountered +++ */ +++int bodycnts[ DSPLYSZ ]; +++ +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++ +++#ifdef OBJ +++int cntpatch; +++int nfppatch; +++#endif OBJ +++ +++/* +++ * Funchdr inserts +++ * declaration of a the +++ * prog/proc/func into the +++ * namelist. It also handles +++ * the arguments and puts out +++ * a transfer which defines +++ * the entry point of a procedure. +++ */ +++ +++struct nl * +++funchdr(r) +++ int *r; +++{ +++ register struct nl *p; +++ register *il, **rl; +++ int *rll; +++ struct nl *cp, *dp, *sp; +++ int s, o, *pp; +++ +++ if (inpflist(r[2])) { +++ opush('l'); +++ yyretrieve(); /* kludge */ +++ } +++ pfcnt++; +++ parts[ cbn ] |= RPRT; +++ line = r[1]; +++ if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { +++ /* +++ * Symbol already defined +++ * in this block. it is either +++ * a redeclared symbol (error) +++ * a forward declaration, +++ * or an external declaration. +++ */ +++ if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { +++ /* +++ * Grammar doesnt forbid +++ * types on a resolution +++ * of a forward function +++ * declaration. +++ */ +++ if (p->class == FUNC && r[4]) +++ error("Function type should be given only in forward declaration"); +++ /* +++ * get another counter for the actual +++ */ +++ if ( monflg ) { +++ bodycnts[ cbn ] = getcnt(); +++ } +++# ifdef PC +++ enclosing[ cbn ] = p -> symbol; +++# endif PC +++# ifdef PTREE +++ /* +++ * mark this proc/func as forward +++ * in the pTree. +++ */ +++ pDEF( p -> inTree ).PorFForward = TRUE; +++# endif PTREE +++ return (p); +++ } +++ } +++ +++ /* if a routine segment is being compiled, +++ * do level one processing. +++ */ +++ +++ if ((r[0] != T_PROG) && (!progseen)) +++ level1(); +++ +++ +++ /* +++ * Declare the prog/proc/func +++ */ +++ switch (r[0]) { +++ case T_PROG: +++ progseen++; +++ if (opt('z')) +++ monflg++; +++ program = p = defnl(r[2], PROG, 0, 0); +++ p->value[3] = r[1]; +++ break; +++ case T_PDEC: +++ if (r[4] != NIL) +++ error("Procedures do not have types, only functions do"); +++ p = enter(defnl(r[2], PROC, 0, 0)); +++ p->nl_flags |= NMOD; +++# ifdef PC +++ enclosing[ cbn ] = r[2]; +++# endif PC +++ break; +++ case T_FDEC: +++ il = r[4]; +++ if (il == NIL) +++ error("Function type must be specified"); +++ else if (il[0] != T_TYID) { +++ il = NIL; +++ error("Function type can be specified only by using a type identifier"); +++ } else +++ il = gtype(il); +++ p = enter(defnl(r[2], FUNC, il, NIL)); +++ p->nl_flags |= NMOD; +++ /* +++ * An arbitrary restriction +++ */ +++ switch (o = classify(p->type)) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Functions should not return %ss", clnames[o]); +++ } +++# ifdef PC +++ enclosing[ cbn ] = r[2]; +++# endif PC +++ break; +++ default: +++ panic("funchdr"); +++ } +++ if (r[0] != T_PROG) { +++ /* +++ * Mark this proc/func as +++ * being forward declared +++ */ +++ p->nl_flags |= NFORWD; +++ /* +++ * Enter the parameters +++ * in the next block for +++ * the time being +++ */ +++ if (++cbn >= DSPLYSZ) { +++ error("Procedure/function nesting too deep"); +++ pexit(ERRS); +++ } +++ /* +++ * For functions, the function variable +++ */ +++ if (p->class == FUNC) { +++# ifdef OBJ +++ cp = defnl(r[2], FVAR, p->type, 0); +++# endif OBJ +++# ifdef PC +++ /* +++ * fvars used to be allocated and deallocated +++ * by the caller right before the arguments. +++ * the offset of the fvar was kept in +++ * value[NL_OFFS] of function (very wierd, +++ * but see asgnop). +++ * now, they are locals to the function +++ * with the offset kept in the fvar. +++ */ +++ +++ cp = defnl( r[2] , FVAR , p -> type +++ , -( roundup( DPOFF1+width( p -> type ) +++ , align( p -> type ) ) ) ); +++# endif PC +++ cp->chain = p; +++ p->ptr[NL_FVAR] = cp; +++ } +++ /* +++ * Enter the parameters +++ * and compute total size +++ */ +++ cp = sp = p; +++ +++# ifdef OBJ +++ o = 0; +++# endif OBJ +++# ifdef PC +++ /* +++ * parameters used to be allocated backwards, +++ * then fixed. for pc, they are allocated correctly. +++ * also, they are aligned. +++ */ +++ o = DPOFF2; +++# endif PC +++ for (rl = r[3]; rl != NIL; rl = rl[2]) { +++ p = NIL; +++ if (rl[1] == NIL) +++ continue; +++ /* +++ * Parametric procedures +++ * don't have types !?! +++ */ +++ if (rl[1][0] != T_PPROC) { +++ rll = rl[1][2]; +++ if (rll[0] != T_TYID) { +++ error("Types for arguments can be specified only by using type identifiers"); +++ p = NIL; +++ } else +++ p = gtype(rll); +++ } +++ for (il = rl[1][1]; il != NIL; il = il[2]) { +++ switch (rl[1][0]) { +++ default: +++ panic("funchdr2"); +++ case T_PVAL: +++ if (p != NIL) { +++ if (p->class == FILET) +++ error("Files cannot be passed by value"); +++ else if (p->nl_flags & NFILES) +++ error("Files cannot be a component of %ss passed by value", +++ nameof(p)); +++ } +++# ifdef OBJ +++ dp = defnl(il[1], VAR, p, o -= even(width(p))); +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , VAR , p +++ , o = roundup( o , A_STACK ) ); +++ o += width( p ); +++# endif PC +++ dp->nl_flags |= NMOD; +++ break; +++ case T_PVAR: +++# ifdef OBJ +++ dp = defnl(il[1], REF, p, o -= sizeof ( int * ) ); +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , REF , p +++ , o = roundup( o , A_STACK ) ); +++ o += sizeof(char *); +++# endif PC +++ break; +++ case T_PFUNC: +++# ifdef OBJ +++ dp = defnl(il[1], FFUNC, p, o -= sizeof ( int * ) ); +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , FFUNC , p +++ , o = roundup( o , A_STACK ) ); +++ o += sizeof(char *); +++# endif PC +++ dp -> nl_flags |= NMOD; +++ break; +++ case T_PPROC: +++# ifdef OBJ +++ dp = defnl(il[1], FPROC, p, o -= sizeof ( int * ) ); +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , FPROC , p +++ , o = roundup( o , A_STACK ) ); +++ o += sizeof(char *); +++# endif PC +++ dp -> nl_flags |= NMOD; +++ break; +++ } +++ if (dp != NIL) { +++ cp->chain = dp; +++ cp = dp; +++ } +++ } +++ } +++ cbn--; +++ p = sp; +++# ifdef OBJ +++ p->value[NL_OFFS] = -o+DPOFF2; +++ /* +++ * Correct the naivete (naievity) +++ * of our above code to +++ * calculate offsets +++ */ +++ for (il = p->chain; il != NIL; il = il->chain) +++ il->value[NL_OFFS] += p->value[NL_OFFS]; +++# endif OBJ +++# ifdef PC +++ p -> value[ NL_OFFS ] = roundup( o , A_STACK ); +++# endif PC +++ } else { +++ /* +++ * The wonderful +++ * program statement! +++ */ +++# ifdef OBJ +++ if (monflg) { +++ put(1, O_PXPBUF); +++ cntpatch = put(2, O_CASE4, 0); +++ nfppatch = put(2, O_CASE4, 0); +++ } +++# endif OBJ +++ cp = p; +++ for (rl = r[3]; rl; rl = rl[2]) { +++ if (rl[1] == NIL) +++ continue; +++ dp = defnl(rl[1], VAR, 0, 0); +++ cp->chain = dp; +++ cp = dp; +++ } +++ } +++ /* +++ * Define a branch at +++ * the "entry point" of +++ * the prog/proc/func. +++ */ +++ p->entloc = getlab(); +++ if (monflg) { +++ bodycnts[ cbn ] = getcnt(); +++ p->value[ NL_CNTR ] = 0; +++ } +++# ifdef OBJ +++ put(2, O_TRA4, p->entloc); +++# endif OBJ +++# ifdef PTREE +++ { +++ pPointer PF = tCopy( r ); +++ +++ pSeize( PorFHeader[ nesting ] ); +++ if ( r[0] != T_PROG ) { +++ pPointer *PFs; +++ +++ PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); +++ *PFs = ListAppend( *PFs , PF ); +++ } else { +++ pDEF( PorFHeader[ nesting ] ).GlobProg = PF; +++ } +++ pRelease( PorFHeader[ nesting ] ); +++ } +++# endif PTREE +++ return (p); +++} +++ +++funcfwd(fp) +++ struct nl *fp; +++{ +++ +++ /* +++ * save the counter for this function +++ */ +++ if ( monflg ) { +++ fp -> value[ NL_CNTR ] = bodycnts[ cbn ]; +++ } +++ return (fp); +++} +++ +++/* +++ * Funcext marks the procedure or +++ * function external in the symbol +++ * table. Funcext should only be +++ * called if PC, and is an error +++ * otherwise. +++ */ +++ +++funcext(fp) +++ struct nl *fp; +++{ +++ +++#ifdef PC +++ if (opt('s')) { +++ standard(); +++ error("External procedures and functions are not standard"); +++ } else { +++ if (cbn == 1) { +++ fp->ext_flags |= NEXTERN; +++ stabefunc( fp -> symbol , fp -> class , line ); +++ } +++ else +++ error("External procedures and functions can only be declared at the outermost level."); +++ } +++#endif PC +++#ifdef OBJ +++ error("Procedures or functions cannot be declared external."); +++#endif OBJ +++ +++ return(fp); +++} +++ +++/* +++ * Funcbody is called +++ * when the actual (resolved) +++ * declaration of a procedure is +++ * encountered. It puts the names +++ * of the (function) and parameters +++ * into the symbol table. +++ */ +++funcbody(fp) +++ struct nl *fp; +++{ +++ register struct nl *q, *p; +++ +++ cbn++; +++ if (cbn >= DSPLYSZ) { +++ error("Too many levels of function/procedure nesting"); +++ pexit(ERRS); +++ } +++ sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; +++ gotos[cbn] = NIL; +++ errcnt[cbn] = syneflg; +++ parts[ cbn ] = NIL; +++ dfiles[ cbn ] = FALSE; +++ if (fp == NIL) +++ return (NIL); +++ /* +++ * Save the virtual name +++ * list stack pointer so +++ * the space can be freed +++ * later (funcend). +++ */ +++ fp->ptr[2] = nlp; +++# ifdef PC +++ if ( fp -> class != PROG ) { +++ stabfunc( fp -> symbol , fp -> class , line , cbn - 1 ); +++ } else { +++ stabfunc( "program" , fp -> class , line , 0 ); +++ } +++# endif PC +++ if (fp->class != PROG) { +++ for (q = fp->chain; q != NIL; q = q->chain) { +++ enter(q); +++# ifdef PC +++ stabparam( q -> symbol , p2type( q -> type ) +++ , q -> value[ NL_OFFS ] +++ , lwidth( q -> type ) ); +++# endif PC +++ } +++ } +++ if (fp->class == FUNC) { +++ /* +++ * For functions, enter the fvar +++ */ +++ enter(fp->ptr[NL_FVAR]); +++# ifdef PC +++ q = fp -> ptr[ NL_FVAR ]; +++ sizes[cbn].om_off -= lwidth( q -> type ); +++ sizes[cbn].om_max = sizes[cbn].om_off; +++ stabvar( q -> symbol , p2type( q -> type ) , cbn +++ , q -> value[ NL_OFFS ] , lwidth( q -> type ) +++ , line ); +++# endif PC +++ } +++# ifdef PTREE +++ /* +++ * pick up the pointer to porf declaration +++ */ +++ PorFHeader[ ++nesting ] = fp -> inTree; +++# endif PTREE +++ return (fp); +++} +++ +++struct nl *Fp; +++int pnumcnt; +++/* +++ * Funcend is called to +++ * finish a block by generating +++ * the code for the statements. +++ * It then looks for unresolved declarations +++ * of labels, procedures and functions, +++ * and cleans up the name list. +++ * For the program, it checks the +++ * semantics of the program +++ * statement (yuchh). +++ */ +++funcend(fp, bundle, endline) +++ struct nl *fp; +++ int *bundle; +++ int endline; +++{ +++ register struct nl *p; +++ register int i, b; +++ int var, inp, out, chkref, *blk; +++ struct nl *iop; +++ char *cp; +++ extern int cntstat; +++# ifdef PC +++ int toplabel = getlab(); +++ int botlabel = getlab(); +++# endif PC +++ +++ cntstat = 0; +++/* +++ * yyoutline(); +++ */ +++ if (program != NIL) +++ line = program->value[3]; +++ blk = bundle[2]; +++ if (fp == NIL) { +++ cbn--; +++# ifdef PTREE +++ nesting--; +++# endif PTREE +++ return; +++ } +++#ifdef OBJ +++ /* +++ * Patch the branch to the +++ * entry point of the function +++ */ +++ patch4(fp->entloc); +++ /* +++ * Put out the block entrance code and the block name. +++ * the CONG is overlaid by a patch later! +++ */ +++ var = put(2, (lenstr(fp->symbol,0) << 8) +++ | (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0); +++ /* +++ * output the number of bytes of arguments +++ * this is only checked on formal calls. +++ */ +++ put(2, O_CASE4, cbn == 1 ? 0 : fp->value[NL_OFFS]-DPOFF2); +++ put(2, O_CASE2, bundle[1]); +++ putstr(fp->symbol, 0); +++#endif OBJ +++#ifdef PC +++ /* +++ * put out the procedure entry code +++ */ +++ if ( fp -> class == PROG ) { +++ putprintf( " .text" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ putprintf( " .globl _main" , 0 ); +++ putprintf( "_main:" , 0 ); +++ putprintf( " .word 0" , 0 ); +++ putprintf( " calls $0,_PCSTART" , 0 ); +++ putprintf( " movl 4(ap),__argc" , 0 ); +++ putprintf( " movl 8(ap),__argv" , 0 ); +++ putprintf( " calls $0,_program" , 0 ); +++ putprintf( " calls $0,_PCEXIT" , 0 ); +++ ftnno = fp -> entloc; +++ putprintf( " .text" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ putprintf( " .globl _program" , 0 ); +++ putprintf( "_program:" , 0 ); +++ } else { +++ ftnno = fp -> entloc; +++ putprintf( " .text" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ putprintf( " .globl " , 1 ); +++ for ( i = 1 ; i < cbn ; i++ ) { +++ putprintf( EXTFORMAT , 1 , enclosing[ i ] ); +++ } +++ putprintf( "" , 0 ); +++ for ( i = 1 ; i < cbn ; i++ ) { +++ putprintf( EXTFORMAT , 1 , enclosing[ i ] ); +++ } +++ putprintf( ":" , 0 ); +++ } +++ stablbrac( cbn ); +++ /* +++ * register save mask +++ */ +++ if ( opt( 't' ) ) { +++ putprintf( " .word 0x%x" , 0 , RUNCHECK | RSAVEMASK ); +++ } else { +++ putprintf( " .word 0x%x" , 0 , RSAVEMASK ); +++ } +++ putjbr( botlabel ); +++ putlab( toplabel ); +++ if ( profflag ) { +++ /* +++ * call mcount for profiling +++ */ +++ putprintf( " moval 1f,r0" , 0 ); +++ putprintf( " jsb mcount" , 0 ); +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 2" , 0 ); +++ putprintf( "1:" , 0 ); +++ putprintf( " .long 0" , 0 ); +++ putprintf( " .text" , 0 ); +++ } +++ /* +++ * set up unwind exception vector. +++ */ +++ putprintf( " moval %s,%d(%s)" , 0 +++ , UNWINDNAME , UNWINDOFFSET , P2FPNAME ); +++ /* +++ * save address of display entry, for unwind. +++ */ +++ putprintf( " moval %s+%d,%d(%s)" , 0 +++ , DISPLAYNAME , cbn * sizeof(struct dispsave) +++ , DPTROFFSET , P2FPNAME ); +++ /* +++ * save old display +++ */ +++ putprintf( " movq %s+%d,%d(%s)" , 0 +++ , DISPLAYNAME , cbn * sizeof(struct dispsave) +++ , DSAVEOFFSET , P2FPNAME ); +++ /* +++ * set up new display by saving AP and FP in appropriate +++ * slot in display structure. +++ */ +++ putprintf( " movq %s,%s+%d" , 0 +++ , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) ); +++ /* +++ * ask second pass to allocate known locals +++ */ +++ putlbracket( ftnno , -sizes[ cbn ].om_max ); +++ /* +++ * and zero them if checking is on +++ * by calling zframe( bytes of locals , highest local address ); +++ */ +++ if ( opt( 't' ) ) { +++ if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ZFRAME" ); +++ putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1 +++ , 0 , P2INT , 0 ); +++ putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ /* +++ * check number of longs of arguments +++ * this can only be wrong for formal calls. +++ */ +++ if ( fp -> class != PROG ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) , +++ "_NARGCHK" ); +++ putleaf( P2ICON , +++ (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) , +++ 0 , P2INT , 0 ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++#endif PC +++ if ( monflg ) { +++ if ( fp -> value[ NL_CNTR ] != 0 ) { +++ inccnt( fp -> value [ NL_CNTR ] ); +++ } +++ inccnt( bodycnts[ fp -> nl_block & 037 ] ); +++ } +++ if (fp->class == PROG) { +++ /* +++ * The glorious buffers option. +++ * 0 = don't buffer output +++ * 1 = line buffer output +++ * 2 = 512 byte buffer output +++ */ +++# ifdef OBJ +++ if (opt('b') != 1) +++ put(1, O_BUFF | opt('b') << 8); +++# endif OBJ +++# ifdef PC +++ if ( opt( 'b' ) != 1 ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" ); +++ putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++# endif PC +++ out = 0; +++ for (p = fp->chain; p != NIL; p = p->chain) { +++ if (strcmp(p->symbol, "input") == 0) { +++ inp++; +++ continue; +++ } +++ if (strcmp(p->symbol, "output") == 0) { +++ out++; +++ continue; +++ } +++ iop = lookup1(p->symbol); +++ if (iop == NIL || bn != cbn) { +++ error("File %s listed in program statement but not declared", p->symbol); +++ continue; +++ } +++ if (iop->class != VAR) { +++ error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]); +++ continue; +++ } +++ if (iop->type == NIL) +++ continue; +++ if (iop->type->class != FILET) { +++ error("File %s listed in program statement but defined as %s", +++ p->symbol, nameof(iop->type)); +++ continue; +++ } +++# ifdef OBJ +++ put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]); +++ i = lenstr(p->symbol,0); +++ put(2, O_LVCON, i); +++ putstr(p->symbol, 0); +++ do { +++ i--; +++ } while (p->symbol+i == 0); +++ put(2, O_CON24, i+1); +++ put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type)); +++ put(1, O_DEFNAME); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_DEFNAME" ); +++ putLV( p -> symbol , bn , iop -> value[NL_OFFS] +++ , p2type( iop ) ); +++ putCONG( p -> symbol , strlen( p -> symbol ) +++ , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , strlen( p -> symbol ) +++ , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON +++ , text(iop->type) ? 0 : width(iop->type->type) +++ , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++# endif PC +++ } +++ if (out == 0 && fp->chain != NIL) { +++ recovered(); +++ error("The file output must appear in the program statement file list"); +++ } +++ } +++ /* +++ * Process the prog/proc/func body +++ */ +++ noreach = 0; +++ line = bundle[1]; +++ statlist(blk); +++# ifdef PTREE +++ { +++ pPointer Body = tCopy( blk ); +++ +++ pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body; +++ } +++# endif PTREE +++# ifdef OBJ +++ if (cbn== 1 && monflg != 0) { +++ patchfil(cntpatch - 2, cnts, 2); +++ patchfil(nfppatch - 2, pfcnt, 2); +++ } +++# endif OBJ +++# ifdef PC +++ if ( fp -> class == PROG && monflg ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PMFLUSH" ); +++ putleaf( P2ICON , cnts , 0 , P2INT , 0 ); +++ putleaf( P2ICON , pfcnt , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++# endif PC +++ if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) { +++ recovered(); +++ error("Input is used but not defined in the program statement"); +++ } +++ /* +++ * Clean up the symbol table displays and check for unresolves +++ */ +++ line = endline; +++ b = cbn; +++ Fp = fp; +++ chkref = syneflg == errcnt[cbn] && opt('w') == 0; +++ for (i = 0; i <= 077; i++) { +++ for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { +++ /* +++ * Check for variables defined +++ * but not referenced +++ */ +++ if (chkref && p->symbol != NIL) +++ switch (p->class) { +++ case FIELD: +++ /* +++ * If the corresponding record is +++ * unused, we shouldn't complain about +++ * the fields. +++ */ +++ default: +++ if ((p->nl_flags & (NUSED|NMOD)) == 0) { +++ warning(); +++ nerror("%s %s is neither used nor set", classes[p->class], p->symbol); +++ break; +++ } +++ /* +++ * If a var parameter is either +++ * modified or used that is enough. +++ */ +++ if (p->class == REF) +++ continue; +++# ifdef OBJ +++ if ((p->nl_flags & NUSED) == 0) { +++ warning(); +++ nerror("%s %s is never used", classes[p->class], p->symbol); +++ break; +++ } +++# endif OBJ +++# ifdef PC +++ if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) { +++ warning(); +++ nerror("%s %s is never used", classes[p->class], p->symbol); +++ break; +++ } +++# endif PC +++ if ((p->nl_flags & NMOD) == 0) { +++ warning(); +++ nerror("%s %s is used but never set", classes[p->class], p->symbol); +++ break; +++ } +++ case LABEL: +++ case FVAR: +++ case BADUSE: +++ break; +++ } +++ switch (p->class) { +++ case BADUSE: +++ cp = "s"; +++ if (p->chain->ud_next == NIL) +++ cp++; +++ eholdnl(); +++ if (p->value[NL_KINDS] & ISUNDEF) +++ nerror("%s undefined on line%s", p->symbol, cp); +++ else +++ nerror("%s improperly used on line%s", p->symbol, cp); +++ pnumcnt = 10; +++ pnums(p->chain); +++ pchr('\n'); +++ break; +++ +++ case FUNC: +++ case PROC: +++# ifdef OBJ +++ if ((p->nl_flags & NFORWD)) +++ nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); +++# endif OBJ +++# ifdef PC +++ if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) +++ nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); +++# endif PC +++ break; +++ +++ case LABEL: +++ if (p->nl_flags & NFORWD) +++ nerror("label %s was declared but not defined", p->symbol); +++ break; +++ case FVAR: +++ if ((p->nl_flags & NMOD) == 0) +++ nerror("No assignment to the function variable"); +++ break; +++ } +++ } +++ /* +++ * Pop this symbol +++ * table slot +++ */ +++ disptab[i] = p; +++ } +++ +++# ifdef OBJ +++ put(1, O_END); +++# endif OBJ +++# ifdef PC +++ /* +++ * if there were file variables declared at this level +++ * call pclose( &__disply[ cbn ] ) to clean them up. +++ */ +++ if ( dfiles[ cbn ] ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PCLOSE" ); +++ putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave ) +++ , P2PTR | P2CHAR ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ /* +++ * if this is a function, +++ * the function variable is the return value. +++ * if it's a scalar valued function, return scalar, +++ * else, return a pointer to the structure value. +++ */ +++ if ( fp -> class == FUNC ) { +++ struct nl *fvar = fp -> ptr[ NL_FVAR ]; +++ long fvartype = p2type( fvar -> type ); +++ long label; +++ char labelname[ BUFSIZ ]; +++ +++ switch ( classify( fvar -> type ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ case TDOUBLE: +++ case TPTR: +++ putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 +++ , fvar -> value[ NL_OFFS ] , fvartype ); +++ break; +++ default: +++ label = getlab(); +++ sprintf( labelname , PREFIXFORMAT , +++ LABELPREFIX , label ); +++ putprintf( " .data" , 0 ); +++ putprintf( " .lcomm %s,%d" , 0 , +++ labelname , lwidth( fvar -> type ) ); +++ putprintf( " .text" , 0 ); +++ putleaf( P2NAME , 0 , 0 , fvartype , labelname ); +++ putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 +++ , fvar -> value[ NL_OFFS ] , fvartype ); +++ putstrop( P2STASG , fvartype , lwidth( fvar -> type ) , +++ align( fvar -> type ) ); +++ putdot( filename , line ); +++ putleaf( P2ICON , 0 , 0 , fvartype , labelname ); +++ break; +++ } +++ putop( P2FORCE , fvartype ); +++ putdot( filename , line ); +++ } +++ /* +++ * restore old display entry from save area +++ */ +++ +++ putprintf( " movq %d(%s),%s+%d" , 0 +++ , DSAVEOFFSET , P2FPNAME +++ , DISPLAYNAME , cbn * sizeof(struct dispsave) ); +++ stabrbrac( cbn ); +++ putprintf( " ret" , 0 ); +++ /* +++ * let the second pass allocate locals +++ */ +++ putlab( botlabel ); +++ putprintf( " subl2 $LF%d,sp" , 0 , ftnno ); +++ putrbracket( ftnno ); +++ putjbr( toplabel ); +++ /* +++ * declare pcp counters, if any +++ */ +++ if ( monflg && fp -> class == PROG ) { +++ putprintf( " .data" , 0 ); +++ putprintf( " .comm " , 1 ); +++ putprintf( PCPCOUNT , 1 ); +++ putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) ); +++ putprintf( " .text" , 0 ); +++ } +++# endif PC +++#ifdef DEBUG +++ dumpnl(fp->ptr[2], fp->symbol); +++#endif +++ /* +++ * Restore the +++ * (virtual) name list +++ * position +++ */ +++ nlfree(fp->ptr[2]); +++ /* +++ * Proc/func has been +++ * resolved +++ */ +++ fp->nl_flags &= ~NFORWD; +++ /* +++ * Patch the beg +++ * of the proc/func to +++ * the proper variable size +++ */ +++ if (Fp == NIL) +++ elineon(); +++# ifdef OBJ +++ patchfil(var, sizes[cbn].om_max, 2); +++# endif OBJ +++ cbn--; +++ if (inpflist(fp->symbol)) { +++ opop('l'); +++ } +++} +++ +++ +++/* +++ * Segend is called to check for +++ * unresolved variables, funcs and +++ * procs, and deliver unresolved and +++ * baduse error diagnostics at the +++ * end of a routine segment (a separately +++ * compiled segment that is not the +++ * main program) for PC. This +++ * routine should only be called +++ * by PC (not standard). +++ */ +++ segend() +++ { +++ register struct nl *p; +++ register int i,b; +++ char *cp; +++ +++#ifdef PC +++ if (opt('s')) { +++ standard(); +++ error("Separately compiled routine segments are not standard."); +++ } else { +++ b = cbn; +++ for (i=0; i<077; i++) { +++ for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { +++ switch (p->class) { +++ case BADUSE: +++ cp = 's'; +++ if (p->chain->ud_next == NIL) +++ cp++; +++ eholdnl(); +++ if (p->value[NL_KINDS] & ISUNDEF) +++ nerror("%s undefined on line%s", p->symbol, cp); +++ else +++ nerror("%s improperly used on line%s", p->symbol, cp); +++ pnumcnt = 10; +++ pnums(p->chain); +++ pchr('\n'); +++ break; +++ +++ case FUNC: +++ case PROC: +++ if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) +++ nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); +++ break; +++ +++ case FVAR: +++ if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) +++ nerror("No assignment to the function variable"); +++ break; +++ } +++ } +++ disptab[i] = p; +++ } +++ } +++#endif PC +++#ifdef OBJ +++ error("Missing program statement and program body"); +++#endif OBJ +++ +++} +++ +++ +++/* +++ * Level1 does level one processing for +++ * separately compiled routine segments +++ */ +++level1() +++{ +++ +++# ifdef OBJ +++ error("Missing program statement"); +++# endif OBJ +++# ifdef PC +++ if (opt('s')) { +++ standard(); +++ error("Missing program statement"); +++ } +++# endif PC +++ +++ cbn++; +++ sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; +++ gotos[cbn] = NIL; +++ errcnt[cbn] = syneflg; +++ parts[ cbn ] = NIL; +++ dfiles[ cbn ] = FALSE; +++ progseen++; +++} +++ +++ +++ +++pnums(p) +++ struct udinfo *p; +++{ +++ +++ if (p->ud_next != NIL) +++ pnums(p->ud_next); +++ if (pnumcnt == 0) { +++ printf("\n\t"); +++ pnumcnt = 20; +++ } +++ pnumcnt--; +++ printf(" %d", p->ud_line); +++} +++ +++nerror(a1, a2, a3) +++{ +++ +++ if (Fp != NIL) { +++ yySsync(); +++#ifndef PI1 +++ if (opt('l')) +++ yyoutline(); +++#endif +++ yysetfile(filename); +++ printf("In %s %s:\n", classes[Fp->class], Fp->symbol); +++ Fp = NIL; +++ elineoff(); +++ } +++ error(a1, a2, a3); +++} diff --cc usr/src/cmd/pc0/flvalue.c index 0000000000,0000000000,0000000000..0e5f4e23a0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/flvalue.c @@@@ -1,0 -1,0 -1,0 +1,133 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)flvalue.c 1.2 10/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++#ifdef OBJ +++/* +++ * define the display structure for purposes of allocating +++ * a temporary +++ */ +++struct dispsave { +++ char *ptr; +++}; +++#endif OBJ +++ +++ /* +++ * flvalue generates the code to either pass on a formal routine, +++ * or construct the structure which is the environment for passing. +++ * it tells the difference by looking at the tree it's given. +++ */ +++struct nl * +++flvalue( r , formalp ) +++ int *r; +++ struct nl *formalp; +++ { +++ struct nl *p; +++ long tempoff; +++ char *typename; +++ +++ if ( r == NIL ) { +++ return NIL; +++ } +++ typename = formalp -> class == FFUNC ? "function":"procedure"; +++ if ( r[0] != T_VAR ) { +++ error("Expression given, %s required for %s parameter %s" , +++ typename , typename , formalp -> symbol ); +++ return NIL; +++ } +++ p = lookup(r[2]); +++ if (p == NIL) { +++ return NIL; +++ } +++ switch ( p -> class ) { +++ case FFUNC: +++ case FPROC: +++ if ( r[3] != NIL ) { +++ error("Formal %s %s cannot be qualified" , +++ typename , p -> symbol ); +++ return NIL; +++ } +++# ifdef OBJ +++ put( 2 , PTR_RV | bn << 8+INDX , p -> value[NL_OFFS] ); +++# endif OBJ +++# ifdef PC +++ putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , +++ p2type( p ) ); +++# endif PC +++ return p -> type; +++ case FUNC: +++ case PROC: +++ if ( r[3] != NIL ) { +++ error("%s %s cannot be qualified" , typename , +++ p -> symbol ); +++ return NIL; +++ } +++ if (bn == 0) { +++ error("Built-in %s %s cannot be passed as a parameter" , +++ typename , p -> symbol ); +++ return NIL; +++ } +++ /* +++ * formal routine structure: +++ * +++ * struct formalrtn { +++ * long (*entryaddr)(); +++ * long cbn; +++ * struct dispsave disp[2*MAXLVL]; +++ * }; +++ */ +++ sizes[ cbn ].om_off -= sizeof (long (*)()) +++ + sizeof (long) +++ + 2*bn*sizeof (struct dispsave); +++ tempoff = sizes[ cbn ].om_off; +++ if ( sizes[ cbn ].om_off < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++# ifdef OBJ +++ put( 2 , O_LV | cbn << 8 + INDX , tempoff ); +++ put( 2 , O_FSAV | bn << 8 + INDX , p -> entloc ); +++# endif OBJ +++# ifdef PC +++ putlbracket( ftnno , -tempoff ); +++ putleaf( P2ICON , 0 , 0 , +++ ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , +++ "_FSAV" ); +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < bn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "flvalue namelength" ); +++ } +++ putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); +++ } +++ putleaf( P2ICON , bn , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putLV( 0 , cbn , tempoff , P2STRTY ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2PTR | P2STRTY ); +++# endif PC +++ return p -> type; +++ default: +++ error("Variable given, %s required for %s parameter %s" , +++ typename , typename , formalp -> symbol ); +++ return NIL; +++ } +++ } diff --cc usr/src/cmd/pc0/func.c index 0000000000,0000000000,0000000000..c99b600ed3 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/func.c @@@@ -1,0 -1,0 -1,0 +1,230 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)func.c 1.3 10/19/80"; +++ +++#include "whoami.h" +++#ifdef OBJ +++ /* +++ * the rest of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++ +++/* +++ * Funccod generates code for +++ * built in function calls and calls +++ * call to generate calls to user +++ * defined functions and procedures. +++ */ +++funccod(r) +++ int *r; +++{ +++ struct nl *p; +++ register struct nl *p1; +++ register int *al; +++ register op; +++ int argc, *argv; +++ int tr[2], tr2[4]; +++ +++ /* +++ * Verify that the given name +++ * is defined and the name of +++ * a function. +++ */ +++ p = lookup(r[2]); +++ if (p == NIL) { +++ rvlist(r[3]); +++ return (NIL); +++ } +++ if (p->class != FUNC && p->class != FFUNC) { +++ error("%s is not a function", p->symbol); +++ rvlist(r[3]); +++ return (NIL); +++ } +++ argv = r[3]; +++ /* +++ * Call handles user defined +++ * procedures and functions +++ */ +++ if (bn != 0) +++ return (call(p, argv, FUNC, bn)); +++ /* +++ * Count the arguments +++ */ +++ argc = 0; +++ for (al = argv; al != NIL; al = al[2]) +++ argc++; +++ /* +++ * Built-in functions have +++ * their interpreter opcode +++ * associated with them. +++ */ +++ op = p->value[0] &~ NSTAND; +++ if (opt('s') && (p->value[0] & NSTAND)) { +++ standard(); +++ error("%s is a nonstandard function", p->symbol); +++ } +++ switch (op) { +++ /* +++ * Parameterless functions +++ */ +++ case O_CLCK: +++ case O_SCLCK: +++ case O_WCLCK: +++ case O_ARGC: +++ if (argc != 0) { +++ error("%s takes no arguments", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ put1(op); +++ return (nl+T4INT); +++ case O_EOF: +++ case O_EOLN: +++ if (argc == 0) { +++ argv = tr; +++ tr[1] = tr2; +++ tr2[0] = T_VAR; +++ tr2[2] = input->symbol; +++ tr2[1] = tr2[3] = NIL; +++ argc = 1; +++ } else if (argc != 1) { +++ error("%s takes either zero or one argument", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ } +++ /* +++ * All other functions take +++ * exactly one argument. +++ */ +++ if (argc != 1) { +++ error("%s takes exactly one argument", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ /* +++ * Evaluate the argmument +++ */ +++ p1 = stkrval((int *) argv[1], NLNIL , RREQ ); +++ if (p1 == NIL) +++ return (NIL); +++ switch (op) { +++ case O_EXP: +++ case O_SIN: +++ case O_COS: +++ case O_ATAN: +++ case O_LN: +++ case O_SQRT: +++ case O_RANDOM: +++ case O_EXPO: +++ case O_UNDEF: +++ if (isa(p1, "i")) +++ convert(p1, nl+TDOUBLE); +++ else if (isnta(p1, "d")) { +++ error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ } +++ put1(op); +++ if (op == O_UNDEF) +++ return (nl+TBOOL); +++ else if (op == O_EXPO) +++ return (nl+T4INT); +++ else +++ return (nl+TDOUBLE); +++ case O_SEED: +++ if (isnta(p1, "i")) { +++ error("seed's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ put1(op); +++ return (nl+T4INT); +++ case O_ROUND: +++ case O_TRUNC: +++ if (isnta(p1, "d")) { +++ error("%s's argument must be a real, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ } +++ put1(op); +++ return (nl+T4INT); +++ case O_ABS2: +++ case O_SQR2: +++ if (isa(p1, "d")) { +++ put1(op + O_ABS8-O_ABS2); +++ return (nl+TDOUBLE); +++ } +++ if (isa(p1, "i")) { +++ put1(op + (width(p1) >> 2)); +++ return (nl+T4INT); +++ } +++ error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ case O_ORD2: +++ if (isa(p1, "bcis") || classify(p1) == TPTR) { +++ return (nl+T4INT); +++ } +++ error("ord's argument must be of scalar type or a pointer, not %s", nameof(p1)); +++ return (NIL); +++ case O_SUCC2: +++ case O_PRED2: +++ if (isa(p1, "bcs")) { +++ put1(op); +++ return (p1); +++ } +++ if (isa(p1, "i")) { +++ if (width(p1) <= 2) +++ op += O_PRED24-O_PRED2; +++ else +++ op++; +++ put1(op); +++ return (nl+T4INT); +++ } +++ if (isa(p1, "id")) { +++ error("%s is forbidden for reals", p->symbol); +++ return (NIL); +++ } +++ error("%s's argument must be of scalar type, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ case O_ODD2: +++ if (isnta(p1, "i")) { +++ error("odd's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ put1(op + (width(p1) >> 2)); +++ return (nl+TBOOL); +++ case O_CHR2: +++ if (isnta(p1, "i")) { +++ error("chr's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ put1(op + (width(p1) >> 2)); +++ return (nl+TCHAR); +++ case O_CARD: +++ if (isnta(p1, "t")) { +++ error("Argument to card must be a set, not %s", nameof(p1)); +++ return (NIL); +++ } +++ put2(O_CARD, width(p1)); +++ return (nl+T2INT); +++ case O_EOLN: +++ if (!text(p1)) { +++ error("Argument to eoln must be a text file, not %s", nameof(p1)); +++ return (NIL); +++ } +++ put1(op); +++ return (nl+TBOOL); +++ case O_EOF: +++ if (p1->class != FILET) { +++ error("Argument to eof must be file, not %s", nameof(p1)); +++ return (NIL); +++ } +++ put1(op); +++ return (nl+TBOOL); +++ case 0: +++ error("%s is an unimplemented 6000-3.4 extension", p->symbol); +++ default: +++ panic("func1"); +++ } +++} +++#endif OBJ diff --cc usr/src/cmd/pc0/gen.c index 0000000000,0000000000,0000000000..21c07d7844 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/gen.c @@@@ -1,0 -1,0 -1,0 +1,216 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)gen.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#ifdef OBJ +++ /* +++ * and the rest of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++ +++/* +++ * This array tells the type +++ * returned by an arithmetic +++ * operation. It is indexed +++ * by the logarithm of the +++ * lengths base 2. +++ */ +++#ifndef DEBUG +++char arret[] = { +++ T4INT, T4INT, T4INT, TDOUBLE, +++ T4INT, T4INT, T4INT, TDOUBLE, +++ T4INT, T4INT, T4INT, TDOUBLE, +++ TDOUBLE, TDOUBLE, TDOUBLE, TDOUBLE +++}; +++#else +++char arret0[] = { +++ T4INT, T4INT, T4INT, TDOUBLE, +++ T4INT, T4INT, T4INT, TDOUBLE, +++ T4INT, T4INT, T4INT, TDOUBLE, +++ TDOUBLE, TDOUBLE, TDOUBLE, TDOUBLE +++}; +++char arret1[] = { +++ T4INT, T4INT, T4INT, TDOUBLE, +++ T4INT, T4INT, T4INT, TDOUBLE, +++ T4INT, T4INT, T4INT, TDOUBLE, +++ TDOUBLE, TDOUBLE, TDOUBLE, TDOUBLE +++}; +++char *arret = arret0; +++#endif +++ +++/* +++ * These array of arithmetic and set +++ * operators are indexed by the +++ * tree nodes and is highly dependent +++ * on their order. They thus take +++ * on the flavor of magic. +++ */ +++int arop[] = { +++ 0, O_NEG2, O_MOD2, O_DIV2, O_DVD2, O_MUL2, O_ADD2, O_SUB2, +++ O_REL2, O_REL2, O_REL2, O_REL2, O_REL2, O_REL2 +++}; +++int setop[] = { +++ O_MULT, O_ADDT, O_SUBT, +++ O_RELT, O_RELT, O_RELT, O_RELT, O_RELT, O_RELT, +++}; +++ +++/* +++ * The following array is +++ * used when operating on +++ * two reals since they are +++ * shoved off in a corner in +++ * the interpreter table. +++ */ +++int ar8op[] = { +++ O_DVD8, O_MUL8, O_ADD8, O_SUB8, +++ O_REL8, O_REL8, O_REL8, O_REL8, O_REL8, O_REL8, +++}; +++ +++/* +++ * The following arrays, which are linearizations +++ * of two dimensional arrays, are the offsets for +++ * arithmetic, relational and assignment operations +++ * indexed by the logarithms of the argument widths. +++ */ +++#ifndef DEBUG +++char artab[] = { +++ O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, +++ O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, +++ O_ADD24-O_ADD2, O_ADD24-O_ADD2, O_ADD4-O_ADD2, O_ADD84-O_ADD2, +++ O_ADD28-O_ADD2, O_ADD28-O_ADD2, O_ADD48-O_ADD2, -1 +++}; +++#else +++char artab0[] = { +++ O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, +++ O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, +++ O_ADD24-O_ADD2, O_ADD24-O_ADD2, O_ADD4-O_ADD2, O_ADD84-O_ADD2, +++ O_ADD28-O_ADD2, O_ADD28-O_ADD2, O_ADD48-O_ADD2, -1 +++}; +++char artab1[] = { +++ O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD82-O_ADD2, +++ O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD82-O_ADD2, +++ O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD84-O_ADD2, +++ O_ADD28-O_ADD2, O_ADD28-O_ADD2, O_ADD28-O_ADD2, -1 +++}; +++char *artab = artab0; +++#endif +++#ifndef DEBUG +++char reltab[] = { +++ O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, +++ O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, +++ O_REL24-O_REL2, O_REL24-O_REL2, O_REL4-O_REL2, O_REL84-O_REL2, +++ O_REL28-O_REL2, O_REL28-O_REL2, O_REL48-O_REL2, O_REL8-O_REL2 +++}; +++#else +++char reltab0[] = { +++ O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, +++ O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, +++ O_REL24-O_REL2, O_REL24-O_REL2, O_REL4-O_REL2, O_REL84-O_REL2, +++ O_REL28-O_REL2, O_REL28-O_REL2, O_REL48-O_REL2, O_REL8-O_REL2 +++}; +++char reltab1[] = { +++ O_REL2-O_REL2, O_REL2-O_REL2, O_REL2-O_REL2, O_REL82-O_REL2, +++ O_REL2-O_REL2, O_REL2-O_REL2, O_REL2-O_REL2, O_REL82-O_REL2, +++ O_REL2-O_REL2, O_REL2-O_REL2, O_REL2-O_REL2, O_REL82-O_REL2, +++ O_REL28-O_REL2, O_REL28-O_REL2, O_REL28-O_REL2, O_REL8-O_REL2 +++}; +++char *reltab = reltab0; +++#endif +++ +++#ifndef DEBUG +++char asgntab[] = { +++ O_AS21-O_AS2, O_AS21-O_AS2, O_AS41-O_AS2, -1, +++ O_AS2-O_AS2, O_AS2-O_AS2, O_AS42-O_AS2, -1, +++ O_AS24-O_AS2, O_AS24-O_AS2, O_AS4-O_AS2, -1, +++ O_AS28-O_AS2, O_AS28-O_AS2, O_AS48-O_AS2, O_AS8-O_AS2, +++}; +++#else +++char asgntb0[] = { +++ O_AS21-O_AS2, O_AS21-O_AS2, O_AS41-O_AS2, -1, +++ O_AS2-O_AS2, O_AS2-O_AS2, O_AS42-O_AS2, -1, +++ O_AS24-O_AS2, O_AS24-O_AS2, O_AS4-O_AS2, -1, +++ O_AS28-O_AS2, O_AS28-O_AS2, O_AS48-O_AS2, O_AS8-O_AS2, +++}; +++char asgntb1[] = { +++ O_AS21-O_AS2, O_AS21-O_AS2, O_AS21-O_AS2, -1, +++ O_AS2-O_AS2, O_AS2-O_AS2, O_AS2-O_AS2, -1, +++ O_AS2-O_AS2, O_AS2-O_AS2, O_AS2-O_AS2, -1, +++ O_AS28-O_AS2, O_AS28-O_AS2, O_AS28-O_AS2, O_AS4-O_AS2, +++}; +++char *asgntab = asgntb0; +++#endif +++ +++#ifdef DEBUG +++genmx() +++{ +++ +++ arret = arret1; +++ artab = artab1; +++ reltab = reltab1; +++ asgntab = asgntb1; +++} +++#endif +++ +++/* +++ * Gen generates code for assignments, +++ * and arithmetic and string operations +++ * and comparisons. +++ */ +++struct nl * +++gen(p, o, w1, w2) +++ int p, o, w1, w2; +++{ +++ register i, j; +++ int op, off; +++ +++ switch (p) { +++ case O_AS2: +++ case NIL: +++ i = j = -1; +++ /* +++ * Take the log2 of the widths +++ * and linearize them for indexing. +++ * width for indexing. +++ */ +++#ifdef DEBUG +++ if (hp21mx) { +++ if (w1 == 4) +++ w1 = 8; +++ if (w2 == 4) +++ w2 = 8; +++ } +++#endif +++ do i++; while (w1 >>= 1); +++ do j++; while (w2 >>= 1); +++ i <<= 2; +++ i |= j; +++ if (p == O_AS2) { +++ put1(O_AS2 + asgntab[i]); +++ return (NIL); +++ } +++ op = arop[o]; +++ if (op == O_REL2) { +++ put1((op + reltab[i]) | (o - T_EQ) << 8+INDX); +++ return (nl+TBOOL); +++ } +++ put1(i == 15 ? ar8op[o-T_DIVD] : op | artab[i]); +++ return (op == O_DVD2 && !divchk ? nl+TDOUBLE : nl+arret[i]); +++ case TREC: +++ case TSTR: +++ put2(O_RELG | (o - T_EQ) << 8+INDX, w1); +++ return (nl+TBOOL); +++ case TSET: +++ op = setop[o-T_MULT]; +++ if (op == O_RELT) +++ op |= (o - T_EQ)<<8+INDX; +++ put2(op, w1); +++ return (o >= T_EQ ? nl+TBOOL : nl+TSET); +++ default: +++ panic("gen"); +++ } +++} +++#endif OBJ diff --cc usr/src/cmd/pc0/gram index 0000000000,0000000000,0000000000..c5d5aa633d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/gram @@@@ -1,0 -1,0 -1,0 +1,45 @@@@ +++"@(#)gram 1.3 8/27/80" +++/yyval/s//*&/ +++/\*yysterm\[]/,$d +++1;/yyactr/ka +++'a,$s/yypv/yyYpv/g +++'aa +++ register int **yyYpv; +++ register int *p, *q; +++ yyYpv = yypv; +++. +++1;/^##/-w! y.tab.h +++/^int yylval 0/d +++/extern int yychar,/s//extern/ +++/yyclearin/d +++/yyerrok/d +++1;/^##/d +++$a +++ +++yyEactr(__np__, var) +++int __np__; +++char *var; +++{ +++switch(__np__) { +++default: +++return (1); +++. +++g/case.*@@/s/@@//\ +++.m$ +++g/@@/ka\ +++'a;?case?,?case?t$\ +++'am$\ +++a\ +++}\ +++break; +++$a +++} +++} +++. +++1,$s/@@// +++/int nterms/d +++/int nnonter/d +++/int nstate/d +++/int yyerrval/d +++w! +++q diff --cc usr/src/cmd/pc0/hash.c index 0000000000,0000000000,0000000000..3420bec0f7 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/hash.c @@@@ -1,0 -1,0 -1,0 +1,180 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)hash.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * The definition for the segmented hash tables. +++ */ +++struct ht { +++ int *ht_low; +++ int *ht_high; +++ int ht_used; +++} htab[MAXHASH]; +++ +++/* +++ * This is the array of keywords and their +++ * token values, which are hashed into the table +++ * by inithash. +++ */ +++struct kwtab yykey[] = { +++ "and", YAND, +++ "array", YARRAY, +++ "assert", YASSERT, +++ "begin", YBEGIN, +++ "case", YCASE, +++ "const", YCONST, +++ "div", YDIV, +++ "do", YDO, +++ "downto", YDOWNTO, +++ "else", YELSE, +++ "end", YEND, +++ "file", YFILE, +++ "for", YFOR, +++ "forward", YFORWARD, +++ "function", YFUNCTION, +++ "goto", YGOTO, +++ "if", YIF, +++ "in", YIN, +++ "label", YLABEL, +++ "mod", YMOD, +++ "nil", YNIL, +++ "not", YNOT, +++ "of", YOF, +++ "or", YOR, +++ "packed", YPACKED, +++ "procedure", YPROCEDURE, +++ "program", YPROG, +++ "record", YRECORD, +++ "repeat", YREPEAT, +++ "set", YSET, +++ "then", YTHEN, +++ "to", YTO, +++ "type", YTYPE, +++ "until", YUNTIL, +++ "var", YVAR, +++ "while", YWHILE, +++ "with", YWITH, +++ "oct", YOCT, /* non-standard Pascal */ +++ "hex", YHEX, /* non-standard Pascal */ +++ "external", YEXTERN, /* non-standard Pascal */ +++ 0 +++}; +++ +++char *lastkey = &yykey[sizeof yykey/sizeof yykey[0]]; +++ +++/* +++ * Inithash initializes the hash table routines +++ * by allocating the first hash table segment using +++ * an already existing memory slot. +++ */ +++#ifndef PI0 +++inithash() +++#else +++inithash(hshtab) +++ int *hshtab; +++#endif +++{ +++ register int *ip; +++#ifndef PI0 +++ static int hshtab[HASHINC]; +++#endif +++ +++ htab[0].ht_low = hshtab; +++ htab[0].ht_high = &hshtab[HASHINC]; +++ for (ip = yykey; *ip; ip += 2) +++ hash(ip[0], 0)[0] = ip; +++} +++ +++/* +++ * Hash looks up the s(ymbol) argument +++ * in the string table, entering it if +++ * it is not found. If save is 0, then +++ * the argument string is already in +++ * a safe place. Otherwise, if hash is +++ * entering the symbol for the first time +++ * it will save the symbol in the string +++ * table using savestr. +++ */ +++int *hash(s, save) +++ char *s; +++ int save; +++{ +++ register int *h; +++ register i; +++ register char *cp; +++ int *sym; +++ struct ht *htp; +++ int sh; +++ +++ /* +++ * The hash function is a modular hash of +++ * the sum of the characters with the sum +++ * doubled before each successive character +++ * is added. +++ */ +++ cp = s; +++ if (cp == NIL) +++ cp = token; /* default symbol to be hashed */ +++ i = 0; +++ while (*cp) +++ i = i*2 + *cp++; +++ sh = (i&077777) % HASHINC; +++ cp = s; +++ if (cp == NIL) +++ cp = token; +++ /* +++ * There are as many as MAXHASH active +++ * hash tables at any given point in time. +++ * The search starts with the first table +++ * and continues through the active tables +++ * as necessary. +++ */ +++ for (htp = htab; htp < &htab[MAXHASH]; htp++) { +++ if (htp->ht_low == NIL) { +++ cp = (char *) calloc(sizeof ( int * ), HASHINC); +++ if (cp == -1) { +++ yerror("Ran out of memory (hash)"); +++ pexit(DIED); +++ } +++ htp->ht_low = cp; +++ htp->ht_high = htp->ht_low + HASHINC; +++ cp = s; +++ if (cp == NIL) +++ cp = token; +++ } +++ h = htp->ht_low + sh; +++ /* +++ * quadratic rehash increment +++ * starts at 1 and incremented +++ * by two each rehash. +++ */ +++ i = 1; +++ do { +++ if (*h == 0) { +++ if (htp->ht_used > (HASHINC * 3)/4) +++ break; +++ htp->ht_used++; +++ if (save != 0) { +++ *h = (int) savestr(cp); +++ } else +++ *h = s; +++ return (h); +++ } +++ sym = *h; +++ if (sym < lastkey && sym >= yykey) +++ sym = *sym; +++ if (sym->pchar == *cp && strcmp(sym, cp) == 0) +++ return (h); +++ h += i; +++ i += 2; +++ if (h >= htp->ht_high) +++ h -= HASHINC; +++ } while (i < HASHINC); +++ } +++ yerror("Ran out of hash tables"); +++ pexit(DIED); +++} diff --cc usr/src/cmd/pc0/iorec.h index 0000000000,0000000000,0000000000..975a158eb6 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/iorec.h @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)iorec.h 1.1 8/27/80"; */ +++ +++#include +++#define NAMSIZ 76 +++ +++struct iorec { +++ char *fileptr; /* ptr to file window */ +++ long lcount; /* number of lines printed */ +++ long llimit; /* maximum number of text lines */ +++ FILE *fbuf; /* FILE ptr */ +++ struct iorec *fchain; /* chain to next file */ +++ long *flev; /* ptr to associated file variable */ +++ char *pfname; /* ptr to name of file */ +++ long funit; /* file status flags */ +++ long size; /* size of elements in the file */ +++ char fname[NAMSIZ]; /* name of associated UNIX file */ +++ char buf[BUFSIZ]; /* I/O buffer */ +++ char window[1]; /* file window element */ +++}; diff --cc usr/src/cmd/pc0/lab.c index 0000000000,0000000000,0000000000..3fe3baeaa8 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/lab.c @@@@ -1,0 -1,0 -1,0 +1,233 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)lab.c 1.5 10/14/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++ +++/* +++ * Label enters the definitions +++ * of the label declaration part +++ * into the namelist. +++ */ +++label(r, l) +++ int *r, l; +++{ +++#ifndef PI0 +++ register *ll; +++ register struct nl *p, *lp; +++ +++ lp = NIL; +++#else +++ send(REVLAB, r); +++#endif +++ if ( ! progseen ) { +++ level1(); +++ } +++ line = l; +++#ifndef PI1 +++ if (parts[ cbn ] & (CPRT|TPRT|VPRT|RPRT)){ +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Label declarations should precede const, type, var and routine declarations"); +++ } +++ if (parts[ cbn ] & LPRT) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All labels should be declared in one label part"); +++ } +++ parts[ cbn ] |= LPRT; +++#endif +++#ifndef PI0 +++ for (ll = r; ll != NIL; ll = ll[2]) { +++ l = getlab(); +++ p = enter(defnl(ll[1], LABEL, 0, l)); +++ /* +++ * Get the label for the eventual target +++ */ +++ p->value[1] = getlab(); +++ p->chain = lp; +++ p->nl_flags |= (NFORWD|NMOD); +++ p->value[NL_GOLEV] = NOTYET; +++ p->entloc = l; +++ lp = p; +++# ifdef OBJ +++ /* +++ * This operator is between +++ * the bodies of two procedures +++ * and provides a target for +++ * gotos for this label via TRA. +++ */ +++ putlab(l); +++ put2(O_GOTO | cbn<<8+INDX, p->value[1]); +++# endif OBJ +++# ifdef PC +++ /* +++ * labels have to be .globl otherwise /lib/c2 may +++ * throw them away if they aren't used in the function +++ * which defines them. +++ */ +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < cbn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "lab decl namelength" ); +++ } +++ putprintf( " .globl " , 1 ); +++ putprintf( NAMEFORMAT , 0 , extname ); +++ if ( cbn == 1 ) { +++ stabglabel( extname , line ); +++ } +++ } +++# endif PC +++ } +++ gotos[cbn] = lp; +++# ifdef PTREE +++ { +++ pPointer Labels = LabelDCopy( r ); +++ +++ pDEF( PorFHeader[ nesting ] ).PorFLabels = Labels; +++ } +++# endif PTREE +++#endif +++} +++ +++#ifndef PI0 +++/* +++ * Gotoop is called when +++ * we get a statement "goto label" +++ * and generates the needed tra. +++ */ +++gotoop(s) +++ char *s; +++{ +++ register struct nl *p; +++ +++ gocnt++; +++ p = lookup(s); +++ if (p == NIL) +++ return (NIL); +++# ifdef OBJ +++ put2(O_TRA4, p->entloc); +++# endif OBJ +++# ifdef PC +++ if ( cbn != bn ) { +++ /* +++ * call goto to unwind the stack to the destination level +++ */ +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_GOTO" ); +++ putLV( DISPLAYNAME , 0 , bn * sizeof( struct dispsave ) +++ , P2PTR | P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < bn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "goto namelength" ); +++ } +++ putprintf( " jbr " , 1 ); +++ putprintf( NAMEFORMAT , 0 , extname ); +++ } +++# endif PC +++ if (bn == cbn) +++ if (p->nl_flags & NFORWD) { +++ if (p->value[NL_GOLEV] == NOTYET) { +++ p->value[NL_GOLEV] = level; +++ p->value[NL_GOLINE] = line; +++ } +++ } else +++ if (p->value[NL_GOLEV] == DEAD) { +++ recovered(); +++ error("Goto %s is into a structured statement", p->symbol); +++ } +++} +++ +++/* +++ * Labeled is called when a label +++ * definition is encountered, and +++ * marks that it has been found and +++ * patches the associated GOTO generated +++ * by gotoop. +++ */ +++labeled(s) +++ char *s; +++{ +++ register struct nl *p; +++ +++ p = lookup(s); +++ if (p == NIL) +++ return (NIL); +++ if (bn != cbn) { +++ error("Label %s not defined in correct block", s); +++ return; +++ } +++ if ((p->nl_flags & NFORWD) == 0) { +++ error("Label %s redefined", s); +++ return; +++ } +++ p->nl_flags &= ~NFORWD; +++# ifdef OBJ +++ patch4(p->entloc); +++# endif OBJ +++# ifdef PC +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < bn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "labeled namelength" ); +++ } +++ putprintf( NAMEFORMAT , 1 , extname ); +++ putprintf( ":" , 0 ); +++ } +++# endif PC +++ if (p->value[NL_GOLEV] != NOTYET) +++ if (p->value[NL_GOLEV] < level) { +++ recovered(); +++ error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]); +++ } +++ p->value[NL_GOLEV] = level; +++} +++#endif diff --cc usr/src/cmd/pc0/lookup.c index 0000000000,0000000000,0000000000..5c4201fe37 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/lookup.c @@@@ -1,0 -1,0 -1,0 +1,113 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)lookup.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++ +++/* +++ * Lookup is called to +++ * find a symbol in the +++ * block structure symbol +++ * table and returns a pointer to +++ * its namelist entry. +++ */ +++struct nl * +++lookup(s) +++ register char *s; +++{ +++ register struct nl *p; +++ register struct udinfo *udp; +++ +++ if (s == NIL) { +++ nocascade(); +++ return (NIL); +++ } +++ p = lookup1(s); +++ if (p == NIL) { +++ derror("%s is undefined", s); +++ return (NIL); +++ } +++ if (p->class == FVAR) { +++ p = p->chain; +++ bn--; +++ } +++ return (p); +++} +++ +++#ifndef PI0 +++int flagwas; +++#endif +++/* +++ * Lookup1 is an internal lookup. +++ * It is not an error to call lookup1 +++ * if the symbol is not defined. Also +++ * lookup1 will return FVARs while +++ * lookup never will, thus asgnop +++ * calls it when it thinks you are +++ * assigning to the function variable. +++ */ +++ +++struct nl * +++lookup1(s) +++ register char *s; +++{ +++ register struct nl *p; +++#ifndef PI0 +++ register struct nl *q; +++#endif +++ register int i; +++ +++ if (s == NIL) +++ return (NIL); +++ bn = cbn; +++#ifndef PI0 +++ /* +++ * We first check the field names +++ * of the currently active with +++ * statements (expensive since they +++ * are not hashed). +++ */ +++ for (p = withlist; p != NIL; p = p->nl_next) { +++ q = p->type; +++ if (q == NIL) +++ continue; +++ if (reclook(q, s) != NIL) +++ /* +++ * Return the WITHPTR, lvalue understands. +++ */ +++ return (p); +++ } +++#endif +++ /* +++ * Symbol table is a 64 way hash +++ * on the low bits of the character +++ * pointer value. (Simple, but effective) +++ */ +++ i = (int) s & 077; +++ for (p = disptab[i]; p != NIL; p = p->nl_next) +++ if (p->symbol == s && p->class != FIELD && p->class != BADUSE) { +++ bn = (p->nl_block & 037); +++#ifndef PI0 +++ flagwas = p->nl_flags; +++ p->nl_flags |= NUSED; +++#endif +++ return (p); +++ } +++ return (NIL); +++} +++ +++#ifndef PI01 +++nlfund(sp) +++ char *sp; +++{ +++ register struct nl *p; +++ register int i; +++ +++ i = (int) sp & 077; +++ for (p = disptab[i]; p != NIL; p = p->nl_next) +++ if (p->symbol == sp && (p->nl_block & 037) == 0) +++ return (nloff(p)); +++ return (0); +++} +++#endif diff --cc usr/src/cmd/pc0/lval.c index 0000000000,0000000000,0000000000..827bf7d66c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/lval.c @@@@ -1,0 -1,0 -1,0 +1,352 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)lval.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++ +++extern int flagwas; +++/* +++ * Lvalue computes the address +++ * of a qualified name and +++ * leaves it on the stack. +++ * for pc, it can be asked for either an lvalue or an rvalue. +++ * the semantics are the same, only the code is different. +++ */ +++struct nl * +++lvalue(r, modflag , required ) +++ int *r, modflag; +++ int required; +++{ +++ register struct nl *p; +++ struct nl *firstp, *lastp; +++ register *c, *co; +++ int f, o; +++ /* +++ * Note that the local optimizations +++ * done here for offsets would more +++ * appropriately be done in put. +++ */ +++ int tr[2], trp[3]; +++ +++ if (r == NIL) { +++ return (NIL); +++ } +++ if (nowexp(r)) { +++ return (NIL); +++ } +++ if (r[0] != T_VAR) { +++ error("Variable required"); /* Pass mesgs down from pt of call ? */ +++ return (NIL); +++ } +++# ifdef PC +++ /* +++ * pc requires a whole different control flow +++ */ +++ return pclvalue( r , modflag , required ); +++# endif PC +++ firstp = p = lookup(r[2]); +++ if (p == NIL) { +++ return (NIL); +++ } +++ c = r[3]; +++ if ((modflag & NOUSE) && !lptr(c)) { +++ p->nl_flags = flagwas; +++ } +++ if (modflag & MOD) { +++ p->nl_flags |= NMOD; +++ } +++ /* +++ * Only possibilities for p->class here +++ * are the named classes, i.e. CONST, TYPE +++ * VAR, PROC, FUNC, REF, or a WITHPTR. +++ */ +++ switch (p->class) { +++ case WITHPTR: +++ /* +++ * Construct the tree implied by +++ * the with statement +++ */ +++ trp[0] = T_LISTPP; +++ trp[1] = tr; +++ trp[2] = r[3]; +++ tr[0] = T_FIELD; +++ tr[1] = r[2]; +++ c = trp; +++# ifdef PTREE +++ /* +++ * mung r[4] to say which field this T_VAR is +++ * for VarCopy +++ */ +++ r[4] = reclook( p -> type , r[2] ); +++# endif +++ /* and fall through */ +++ case REF: +++ /* +++ * Obtain the indirect word +++ * of the WITHPTR or REF +++ * as the base of our lvalue +++ */ +++ put(2, PTR_RV | bn << 8+INDX , p->value[0] ); +++ f = 0; /* have an lv on stack */ +++ o = 0; +++ break; +++ case VAR: +++ f = 1; /* no lv on stack yet */ +++ o = p->value[0]; +++ break; +++ default: +++ error("%s %s found where variable required", classes[p->class], p->symbol); +++ return (NIL); +++ } +++ /* +++ * Loop and handle each +++ * qualification on the name +++ */ +++ if (c == NIL && (modflag&ASGN) && p->value[NL_FORV]) { +++ error("Can't modify the for variable %s in the range of the loop", p->symbol); +++ return (NIL); +++ } +++ for (; c != NIL; c = c[2]) { +++ co = c[1]; +++ if (co == NIL) { +++ return (NIL); +++ } +++ lastp = p; +++ p = p->type; +++ if (p == NIL) { +++ return (NIL); +++ } +++ switch (co[0]) { +++ case T_PTR: +++ /* +++ * Pointer qualification. +++ */ +++ lastp->nl_flags |= NUSED; +++ if (p->class != PTR && p->class != FILET) { +++ error("^ allowed only on files and pointers, not on %ss", nameof(p)); +++ goto bad; +++ } +++ if (f) { +++ put(2, PTR_RV | bn <<8+INDX , o ); +++ } else { +++ if (o) { +++ put2(O_OFF, o); +++ } +++ put(1, PTR_IND); +++ } +++ /* +++ * Pointer cannot be +++ * nil and file cannot +++ * be at end-of-file. +++ */ +++ put1(p->class == FILET ? O_FNIL : O_NIL); +++ f = o = 0; +++ continue; +++ case T_ARGL: +++ if (p->class != ARRAY) { +++ if (lastp == firstp) { +++ error("%s is a %s, not a function", r[2], classes[firstp->class]); +++ } else { +++ error("Illegal function qualificiation"); +++ } +++ return (NIL); +++ } +++ recovered(); +++ error("Pascal uses [] for subscripting, not ()"); +++ case T_ARY: +++ if (p->class != ARRAY) { +++ error("Subscripting allowed only on arrays, not on %ss", nameof(p)); +++ goto bad; +++ } +++ if (f) { +++ put2(O_LV | bn<<8+INDX, o); +++ } else { +++ if (o) { +++ put2(O_OFF, o); +++ } +++ } +++ switch (arycod(p, co[1])) { +++ case 0: +++ return (NIL); +++ case -1: +++ goto bad; +++ } +++ f = o = 0; +++ continue; +++ case T_FIELD: +++ /* +++ * Field names are just +++ * an offset with some +++ * semantic checking. +++ */ +++ if (p->class != RECORD) { +++ error(". allowed only on records, not on %ss", nameof(p)); +++ goto bad; +++ } +++ if (co[1] == NIL) { +++ return (NIL); +++ } +++ p = reclook(p, co[1]); +++ if (p == NIL) { +++ error("%s is not a field in this record", co[1]); +++ goto bad; +++ } +++# ifdef PTREE +++ /* +++ * mung co[3] to indicate which field +++ * this is for SelCopy +++ */ +++ co[3] = p; +++# endif +++ if (modflag & MOD) { +++ p->nl_flags |= NMOD; +++ } +++ if ((modflag & NOUSE) == 0 || lptr(c[2])) { +++ p->nl_flags |= NUSED; +++ } +++ o += p->value[0]; +++ continue; +++ default: +++ panic("lval2"); +++ } +++ } +++ if (f) { +++ put2(O_LV | bn<<8+INDX, o); +++ } else { +++ if (o) { +++ put2(O_OFF, o); +++ } +++ } +++ return (p->type); +++bad: +++ cerror("Error occurred on qualification of %s", r[2]); +++ return (NIL); +++} +++ +++lptr(c) +++ register int *c; +++{ +++ register int *co; +++ +++ for (; c != NIL; c = c[2]) { +++ co = c[1]; +++ if (co == NIL) { +++ return (NIL); +++ } +++ switch (co[0]) { +++ +++ case T_PTR: +++ return (1); +++ case T_ARGL: +++ return (0); +++ case T_ARY: +++ case T_FIELD: +++ continue; +++ default: +++ panic("lptr"); +++ } +++ } +++ return (0); +++} +++ +++/* +++ * Arycod does the +++ * code generation +++ * for subscripting. +++ */ +++arycod(np, el) +++ struct nl *np; +++ int *el; +++{ +++ register struct nl *p, *ap; +++ int i, d, v, v1; +++ int w; +++ +++ p = np; +++ if (el == NIL) { +++ return (0); +++ } +++ d = p->value[0]; +++ /* +++ * Check each subscript +++ */ +++ for (i = 1; i <= d; i++) { +++ if (el == NIL) { +++ error("Too few subscripts (%d given, %d required)", i-1, d); +++ return (-1); +++ } +++ p = p->chain; +++# ifdef PC +++ precheck( p , "_SUBSC" , "_SUBSCZ" ); +++# endif PC +++ ap = rvalue(el[1], NLNIL , RREQ ); +++ if (ap == NIL) { +++ return (0); +++ } +++# ifdef PC +++ postcheck( p ); +++# endif PC +++ if (incompat(ap, p->type, el[1])) { +++ cerror("Array index type incompatible with declared index type"); +++ if (d != 1) { +++ cerror("Error occurred on index number %d", i); +++ } +++ return (-1); +++ } +++ w = aryconst(np, i); +++# ifdef OBJ +++ if (opt('t') == 0) { +++ switch (w) { +++ case 8: +++ w = 6; +++ case 4: +++ case 2: +++ case 1: +++ put2((width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]); +++ el = el[2]; +++ continue; +++ } +++ } +++ put(4, width(ap) != 4 ? O_INX2 : O_INX4,w,( short ) p->range[0], +++ ( short ) ( p->range[1] - p->range[0] ) ); +++# endif OBJ +++# ifdef PC +++ /* +++ * subtract off the lower bound +++ */ +++ if ( p -> range[ 0 ] != 0 ) { +++ putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 ); +++ putop( P2MINUS , P2INT ); +++ } +++ /* +++ * multiply by the width of the elements +++ */ +++ if ( w != 1 ) { +++ putleaf( P2ICON , w , 0 , P2INT , 0 ); +++ putop( P2MUL , P2INT ); +++ } +++ /* +++ * and add it to the base address +++ */ +++ putop( P2PLUS , ADDTYPE( p2type( np -> type ) , P2PTR ) ); +++# endif PC +++ el = el[2]; +++ } +++ if (el != NIL) { +++ do { +++ el = el[2]; +++ i++; +++ } while (el != NIL); +++ error("Too many subscripts (%d given, %d required)", i-1, d); +++ return (-1); +++ } +++ return (1); +++} diff --cc usr/src/cmd/pc0/main.c index 0000000000,0000000000,0000000000..9687432807 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/main.c @@@@ -1,0 -1,0 -1,0 +1,409 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)main.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++#include +++#include "objfmt.h" +++ +++/* +++ * This version of pi has been in use at Berkeley since May 1977 +++ * and is very stable, except for the syntactic error recovery which +++ * has just been written. Please report any problems with the error +++ * recovery to the second author at the address given in the file +++ * READ_ME. The second author takes full responsibility for any bugs +++ * in the syntactic error recovery. +++ */ +++ +++char piusage[] = "pi [ -blnpstuw ] [ -i file ... ] name.p"; +++char pixusage[] = "pix [ -blnpstuw ] [ -i file ... ] name.p [ arg ... ]"; +++char pcusage[] = "pc [ options ] [ -o file ] [ -i file ... ] name.p"; +++ +++char *usageis = piusage; +++ +++char *errfile = ERR_STRNGS; +++ +++#ifdef OBJ +++ char *obj = "obj"; +++#endif OBJ +++#ifdef PC +++ char *pcname = "pc.pc1"; +++#endif PC +++#ifdef PTREE +++ char *pTreeName = "pi.pTree"; +++#endif PTREE +++ +++/* +++ * Be careful changing errfile and howfile. +++ * There are the "magic" constants 9 and 15 immediately below. +++ * errfile is now defined by ERR_STRNGS, in objfmt.h, +++ * and its leading path name length is ERR_PATHLEN long. +++ * this for executing out of the current directory if running as `a.something'. +++ */ +++#ifdef OBJ +++char *howfile = "/usr/lib/how_pi\0"; +++#endif OBJ +++#ifdef PC +++char *howfile = "/usr/lib/how_pc"; +++#endif PC +++ +++int onintr(); +++ +++extern char *lastname; +++ +++FILE *ibuf; +++FILE *pcstream = NULL; +++ +++/* +++ * these are made real variables +++ * so they can be changed +++ * if you are compiling on a smaller machine +++ */ +++double MAXINT = 2147483647.; +++double MININT = -2147483648.; +++ +++/* +++ * Main program for pi. +++ * Process options, then call yymain +++ * to do all the real work. +++ */ +++main(argc, argv) +++ int argc; +++ char *argv[]; +++{ +++ register char *cp; +++ register c; +++ int i; +++ +++ if (argv[0][0] == 'a') +++ errfile += ERR_PATHLEN , howfile += 9; +++# ifdef OBJ +++ if (argv[0][0] == '-' && argv[0][1] == 'o') { +++ obj = &argv[0][2]; +++ usageis = pixusage; +++ howfile[15] = 'x'; +++ ofil = 3; +++ } else { +++ ofil = creat(obj, 0755); +++ if (ofil < 0) { +++ perror(obj); +++ pexit(NOSTART); +++ } +++ } +++# endif OBJ +++ argv++, argc--; +++ if (argc == 0) { +++ i = fork(); +++ if (i == -1) +++ goto usage; +++ if (i == 0) { +++ execl("/bin/cat", "cat", howfile, 0); +++ goto usage; +++ } +++ while (wait(&i) != -1) +++ continue; +++ pexit(NOSTART); +++ } +++# ifdef OBJ +++ opt('p') = opt('t') = opt('b') = 1; +++ while (argc > 0) { +++ cp = argv[0]; +++ if (*cp++ != '-') +++ break; +++ while (c = *cp++) switch (c) { +++#ifdef DEBUG +++ case 'k': +++ case 'r': +++ case 'y': +++ togopt(c); +++ continue; +++ case 'K': +++ yycosts(); +++ pexit(NOSTART); +++ case 'A': +++ testtrace++; +++ case 'F': +++ fulltrace++; +++ case 'E': +++ errtrace++; +++ opt('r')++; +++ continue; +++ case 'U': +++ yyunique = 0; +++ continue; +++#endif +++ case 'b': +++ opt('b') = 2; +++ continue; +++ case 'i': +++ pflist = argv + 1; +++ pflstc = 0; +++ while (argc > 1) { +++ if (dotted(argv[1], 'p')) +++ break; +++ pflstc++, argc--, argv++; +++ } +++ if (pflstc == 0) +++ goto usage; +++ continue; +++ case 'l': +++ case 'n': +++ case 'p': +++ case 's': +++ case 't': +++ case 'u': +++ case 'w': +++ togopt(c); +++ continue; +++ case 'z': +++ monflg++; +++ continue; +++ default: +++ usage: +++ Perror( "Usage", usageis); +++ pexit(NOSTART); +++ } +++ argc--, argv++; +++ } +++# endif OBJ +++# ifdef PC +++ opt( 'b' ) = 1; +++ opt( 'g' ) = 0; +++ opt( 't' ) = 0; +++ opt( 'p' ) = 0; +++ usageis = pcusage; +++ while ( argc > 0 ) { +++ cp = argv[0]; +++ if ( *cp++ != '-' ) { +++ break; +++ } +++ c = *cp++; +++ switch( c ) { +++#ifdef DEBUG +++ case 'k': +++ case 'r': +++ case 'y': +++ togopt(c); +++ break; +++ case 'K': +++ yycosts(); +++ pexit(NOSTART); +++ case 'A': +++ testtrace++; +++ /* and fall through */ +++ case 'F': +++ fulltrace++; +++ /* and fall through */ +++ case 'E': +++ errtrace++; +++ opt('r')++; +++ break; +++ case 'U': +++ yyunique = 0; +++ break; +++#endif +++ case 'b': +++ opt('b') = 2; +++ break; +++ case 'i': +++ pflist = argv + 1; +++ pflstc = 0; +++ while (argc > 1) { +++ if (dotted(argv[1], 'p')) +++ break; +++ pflstc++, argc--, argv++; +++ } +++ if (pflstc == 0) +++ goto usage; +++ break; +++ /* +++ * output file for the first pass +++ */ +++ case 'o': +++ if ( argc < 2 ) { +++ goto usage; +++ } +++ argv++; +++ argc--; +++ pcname = argv[0]; +++ break; +++ case 'C': +++ /* +++ * since -t is an ld switch, use -C +++ * to turn on tests +++ */ +++ togopt( 't' ); +++ break; +++ case 'g': +++ /* +++ * sdb symbol table +++ */ +++ togopt( 'g' ); +++ break; +++ case 'l': +++ case 's': +++ case 'u': +++ case 'w': +++ togopt(c); +++ break; +++ case 'p': +++ /* +++ * -p on the command line means profile +++ */ +++ profflag++; +++ break; +++ case 'z': +++ monflg++; +++ break; +++ default: +++usage: +++ Perror( "Usage", usageis); +++ pexit(NOSTART); +++ } +++ argc--; +++ argv++; +++ } +++# endif PC +++ if (argc != 1) +++ goto usage; +++ efil = open ( errfile, 0 ); +++ if ( efil < 0 ) +++ perror(errfile), pexit(NOSTART); +++ filename = argv[0]; +++ if (!dotted(filename, 'p')) { +++ Perror(filename, "Name must end in '.p'"); +++ pexit(NOSTART); +++ } +++ close(0); +++ if ( ( ibuf = fopen( filename , "r" ) ) == NULL ) +++ perror(filename), pexit(NOSTART); +++ ibp = ibuf; +++# ifdef PC +++ if ( ( pcstream = fopen( pcname , "w" ) ) == NULL ) { +++ perror( pcname ); +++ pexit( NOSTART ); +++ } +++ stabsource( filename ); +++# endif PC +++# ifdef PTREE +++# define MAXpPAGES 16 +++ if ( ! pCreate( pTreeName , MAXpPAGES ) ) { +++ perror( pTreeName ); +++ pexit( NOSTART ); +++ } +++# endif PTREE +++ if ( signal( SIGINT , SIG_IGN ) != SIG_IGN ) +++ signal( SIGINT , onintr ); +++ if (opt('l')) { +++ opt('n')++; +++ yysetfile(filename); +++ opt('n')--; +++ } +++ yymain(); +++ /* No return */ +++} +++ +++pchr(c) +++ char c; +++{ +++ +++ putc ( c , stdout ); +++} +++ +++char ugh[] = "Fatal error in pi\n"; +++/* +++ * Exit from the Pascal system. +++ * We throw in an ungraceful termination +++ * message if c > 1 indicating a severe +++ * error such as running out of memory +++ * or an internal inconsistency. +++ */ +++pexit(c) +++ int c; +++{ +++ +++ if (opt('l') && c != DIED && c != NOSTART) +++ while (getline() != -1) +++ continue; +++ yyflush(); +++ switch (c) { +++ case DIED: +++ write(2, ugh, sizeof ugh); +++ case NOSTART: +++ case ERRS: +++# ifdef OBJ +++ if (ofil > 0) +++ unlink(obj); +++# endif OBJ +++# ifdef PC +++ if ( pcstream != NULL ) { +++ unlink( pcname ); +++ } +++# endif PC +++ break; +++ case AOK: +++# ifdef OBJ +++ pflush(); +++# endif OBJ +++# ifdef PC +++ puteof(); +++# endif PC +++ break; +++ } +++ /* +++ * this to gather statistics on programs being compiled +++ * taken 20 june 79 ... peter +++ * +++ * if (fork() == 0) { +++ * char *cp = "-0"; +++ * cp[1] += c; +++ * execl("/usr/lib/gather", "gather", cp, filename, 0); +++ * exit(1); +++ * } +++ */ +++# ifdef PTREE +++ pFinish(); +++# endif +++ exit(c); +++} +++ +++onintr() +++{ +++ +++ signal( SIGINT , SIG_IGN ); +++ pexit(NOSTART); +++} +++ +++/* +++ * Get an error message from the error message file +++ */ +++geterr(seekpt, buf) +++ int seekpt; +++ char *buf; +++{ +++ +++ lseek(efil, (long) seekpt, 0); +++ if (read(efil, buf, 256) <= 0) +++ perror(errfile), pexit(DIED); +++} +++ +++header() +++{ +++ extern char version[]; +++ static char anyheaders; +++ +++ gettime( filename ); +++ if (anyheaders && opt('n')) +++ putc( '\f' , stdout ); +++ anyheaders++; +++# ifdef OBJ +++ printf("Berkeley Pascal PI -- Version 2.0 (%s)\n\n%s %s\n\n", +++ version, myctime(&tvec), filename); +++# endif OBJ +++# ifdef PC +++ printf("Berkeley Pascal PC -- Version 2.0 (%s)\n\n%s %s\n\n", +++ version, myctime(&tvec), filename); +++# endif PC +++} diff --cc usr/src/cmd/pc0/makefile index 0000000000,0000000000,0000000000..1bec05a5ec new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/makefile @@@@ -1,0 -1,0 -1,0 +1,367 @@@@ +++SCCSID = "@(#)pcmakefile 1.14 10/28/80" +++WHOAMI = pc +++INSTALLNAME = $(DESTDIR)/usr/lib/pc0 +++VERSION = 2.0 +++ +++MKSTR = /usr/ucb/mkstr +++EYACC = /usr/ucb/eyacc +++RM = -rm -f +++GET = touch +++ +++CFLAGS = -O -w +++LDFLAGS = -z +++ +++LIBDIR = ${DESTDIR}/usr/lib +++TMPDIR = tmp +++ +++ERRORSTRINGS = ${WHOAMI}${VERSION}strings +++ +++SRCS = ato.c \ +++ call.c case.c clas.c const.c conv.c cset.c \ +++ error.c fdec.c flvalue.c func.c gen.c hash.c \ +++ lab.c lookup.c lval.c stklval.c \ +++ main.c nl.c proc.c put.c \ +++ rec.c rval.c stkrval.c\ +++ stat.c string.c subr.c \ +++ tree.c type.c var.c \ +++ TRdata.c \ +++ treen.c putn.c yycopy.c \ +++ yycosts.c yyerror.c yyget.c yyid.c yylex.c yymain.c yyoptions.c \ +++ yypanic.c yyparse.c yyprint.c yyput.c yyrecover.c yyseman.c yytree.c \ +++ p2put.c pcforop.c stab.c pcproc.c pcfunc.c pccaseop.c pclval.c +++ +++HDRS = 0.h OPnames.h align.h iorec.h objfmt.h pstab.h pc.h pcops.h \ +++ send.h tree.h whoami.h yy.h +++ +++OTHERS = pas.y opc.c version.c gram pic.c +++ +++OBJS = ato.o \ +++ call.o case.o clas.o const.o conv.o cset.o \ +++ error.o fdec.o flvalue.o func.o gen.o hash.o \ +++ lab.o lookup.o lval.o stklval.o \ +++ main.o nl.o proc.o put.o \ +++ rec.o rval.o stkrval.o\ +++ stat.o string.o subr.o \ +++ tree.o type.o var.o \ +++ TRdata.o \ +++ treen.o putn.o yycopy.o \ +++ y.tab.o \ +++ yycosts.o yyerror.o yyget.o yyid.o yylex.o yymain.o yyoptions.o \ +++ yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o \ +++ p2put.o pcforop.o stab.o pcproc.o pcfunc.o pccaseop.o pclval.o +++ +++a.out: ${OBJS} version +++ ./version > Version.c +++ ${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} Version.c +++ +++sources: ${SRCS} ${HDRS} ${OTHERS} +++ +++${SRCS} ${HDRS} ${OTHERS}: +++ ${GET} $@ +++ +++.c.o: +++ ${RM} ${TMPDIR}/$*.c +++ ${MKSTR} - ${ERRORSTRINGS} ${TMPDIR}/ $*.c +++ cd ${TMPDIR} ; ${CC} ${CFLAGS} -I.. -c $*.c ; mv $*.o ../$*.o +++ ${RM} ${TMPDIR}/$*.c +++ +++y.tab.h: pas.y gram +++ ${EYACC} pas.y > /dev/null +++ ex - y.tab.c opcode.h +++ ${RM} opc +++ +++pTree.h: +++ echo "/* this is not pTree.h */" > pTree.h +++ +++version: version.c +++ ${CC} version.c -o version +++ +++clean: +++ ${RM} *.o ${TMPDIR}/*.c +++ ${RM} y.tab.h y.tab.c y.tab.out +++ ${RM} ${ERRORSTRINGS} +++ ${RM} version Version.c +++ ${RM} a.out core *.list *.bak +++ ${RM} opc pic tags +++ +++print: sources +++ @pr makefile READ_ME +++ @ls -ls | pr +++ @cc -o pic pic.c +++ @pic | pr +++ @rm pic +++ @pr 0.h whoami.h main.c pas.y +++ @pr OPnames.h opcode.h tree.h +++ @pr pc.h +++ @pr [a-ln-x]*.c +++ @pr yy.h yy*.c +++ +++install: a.out +++ cp ${ERRORSTRINGS} ${LIBDIR}/${ERRORSTRINGS} +++ cp ${INSTALLNAME} ${INSTALLNAME}.bak +++ cp a.out ${INSTALLNAME} +++ +++depend: sources +++ /bin/grep '^#[ ]*include' *.h \ +++ | sed '/<.*>/d' \ +++ | sed 's/\(.*\):[^"]*"\([^"]*\)".*/\1: \2/' >makedep +++ /bin/grep '^#[ ]*include' *.c \ +++ | sed '/<.*>/d' \ +++ | sed 's/:[^"]*"\([^"]*\)".*/: \1/' \ +++ | sed 's/\.c/.o/' >>makedep +++ echo '/^# DO NOT DELETE THIS LINE/+2,$$d' >eddep +++ echo '$$r makedep' >>eddep +++ echo 'w' >>eddep +++ cp makefile makefile.bak +++ ed - makefile < eddep +++ rm eddep makedep +++ echo '# DEPENDENCIES MUST END AT END OF FILE' >> makefile +++ echo '# IF YOU PUT STUFF HERE IT WILL GO AWAY' >> makefile +++ echo '# see make depend above' >> makefile +++ +++# DO NOT DELETE THIS LINE -- make depend uses it +++ +++0.h: pTree.h +++yy.h: y.tab.h +++TRdata.o: whoami.h +++TRdata.o: 0.h +++ato.o: whoami.h +++ato.o: 0.h +++call.o: whoami.h +++call.o: 0.h +++call.o: tree.h +++call.o: opcode.h +++call.o: objfmt.h +++call.o: pc.h +++call.o: pcops.h +++case.o: whoami.h +++case.o: 0.h +++case.o: tree.h +++case.o: opcode.h +++clas.o: whoami.h +++clas.o: 0.h +++clas.o: tree.h +++const.o: whoami.h +++const.o: 0.h +++const.o: tree.h +++conv.o: whoami.h +++conv.o: 0.h +++conv.o: opcode.h +++conv.o: pcops.h +++cset.o: whoami.h +++cset.o: 0.h +++cset.o: tree.h +++cset.o: opcode.h +++cset.o: objfmt.h +++cset.o: pc.h +++cset.o: pcops.h +++error.o: whoami.h +++error.o: 0.h +++error.o: yy.h +++fdec.o: whoami.h +++fdec.o: 0.h +++fdec.o: tree.h +++fdec.o: opcode.h +++fdec.o: objfmt.h +++fdec.o: align.h +++fdec.o: pc.h +++fdec.o: pcops.h +++flvalue.o: whoami.h +++flvalue.o: 0.h +++flvalue.o: tree.h +++flvalue.o: opcode.h +++flvalue.o: objfmt.h +++flvalue.o: pc.h +++flvalue.o: pcops.h +++func.o: whoami.h +++func.o: 0.h +++func.o: tree.h +++func.o: opcode.h +++gen.o: whoami.h +++gen.o: 0.h +++gen.o: tree.h +++gen.o: opcode.h +++gen.o: objfmt.h +++hash.o: whoami.h +++hash.o: 0.h +++hash.o: yy.h +++lab.o: whoami.h +++lab.o: 0.h +++lab.o: tree.h +++lab.o: opcode.h +++lab.o: objfmt.h +++lab.o: pc.h +++lab.o: pcops.h +++lookup.o: whoami.h +++lookup.o: 0.h +++lval.o: whoami.h +++lval.o: 0.h +++lval.o: tree.h +++lval.o: opcode.h +++lval.o: objfmt.h +++lval.o: pc.h +++lval.o: pcops.h +++main.o: whoami.h +++main.o: 0.h +++main.o: yy.h +++main.o: objfmt.h +++nl.o: whoami.h +++nl.o: 0.h +++nl.o: opcode.h +++nl.o: objfmt.h +++opc.o: OPnames.h +++p2put.o: whoami.h +++p2put.o: 0.h +++p2put.o: pcops.h +++p2put.o: pc.h +++pccaseop.o: whoami.h +++pccaseop.o: 0.h +++pccaseop.o: tree.h +++pccaseop.o: objfmt.h +++pccaseop.o: pcops.h +++pccaseop.o: pc.h +++pcforop.o: whoami.h +++pcforop.o: 0.h +++pcforop.o: opcode.h +++pcforop.o: tree.h +++pcforop.o: pc.h +++pcforop.o: pcops.h +++pcfunc.o: whoami.h +++pcfunc.o: 0.h +++pcfunc.o: tree.h +++pcfunc.o: opcode.h +++pcfunc.o: pc.h +++pcfunc.o: pcops.h +++pclval.o: whoami.h +++pclval.o: 0.h +++pclval.o: tree.h +++pclval.o: opcode.h +++pclval.o: objfmt.h +++pclval.o: pc.h +++pclval.o: pcops.h +++pcproc.o: whoami.h +++pcproc.o: 0.h +++pcproc.o: tree.h +++pcproc.o: opcode.h +++pcproc.o: pc.h +++pcproc.o: pcops.h +++pic.o: OPnames.h +++proc.o: whoami.h +++proc.o: 0.h +++proc.o: tree.h +++proc.o: opcode.h +++proc.o: objfmt.h +++put.o: whoami.h +++put.o: opcode.h +++put.o: 0.h +++put.o: objfmt.h +++put.o: pc.h +++put.o: OPnames.h +++rec.o: whoami.h +++rec.o: 0.h +++rec.o: tree.h +++rec.o: opcode.h +++rval.o: whoami.h +++rval.o: 0.h +++rval.o: tree.h +++rval.o: opcode.h +++rval.o: objfmt.h +++rval.o: pc.h +++rval.o: pcops.h +++stab.o: whoami.h +++stab.o: 0.h +++stab.o: pstab.h +++stab.o: pc.h +++stat.o: whoami.h +++stat.o: 0.h +++stat.o: tree.h +++stat.o: objfmt.h +++stat.o: pcops.h +++stat.o: pc.h +++stat.o: opcode.h +++stklval.o: whoami.h +++stklval.o: 0.h +++stklval.o: tree.h +++stklval.o: opcode.h +++stklval.o: objfmt.h +++stkrval.o: whoami.h +++stkrval.o: 0.h +++stkrval.o: tree.h +++stkrval.o: opcode.h +++stkrval.o: objfmt.h +++stkrval.o: pcops.h +++string.o: whoami.h +++string.o: 0.h +++string.o: send.h +++subr.o: whoami.h +++subr.o: 0.h +++tree.o: whoami.h +++tree.o: 0.h +++type.o: whoami.h +++type.o: 0.h +++type.o: tree.h +++type.o: objfmt.h +++var.o: whoami.h +++var.o: 0.h +++var.o: align.h +++var.o: pc.h +++var.o: pcops.h +++var.o: iorec.h +++y.tab.o: whoami.h +++y.tab.o: 0.h +++y.tab.o: yy.h +++y.tab.o: tree.h +++yycopy.o: 0.h +++yycopy.o: yy.h +++yycosts.o: whoami.h +++yycosts.o: 0.h +++yycosts.o: yy.h +++yyerror.o: whoami.h +++yyerror.o: 0.h +++yyerror.o: yy.h +++yyget.o: whoami.h +++yyget.o: 0.h +++yyget.o: yy.h +++yyid.o: whoami.h +++yyid.o: 0.h +++yyid.o: yy.h +++yylex.o: whoami.h +++yylex.o: 0.h +++yylex.o: yy.h +++yymain.o: whoami.h +++yymain.o: 0.h +++yymain.o: yy.h +++yymain.o: objfmt.h +++yyoptions.o: whoami.h +++yyoptions.o: 0.h +++yyoptions.o: yy.h +++yypanic.o: whoami.h +++yypanic.o: 0.h +++yypanic.o: yy.h +++yyparse.o: whoami.h +++yyparse.o: 0.h +++yyparse.o: yy.h +++yyprint.o: whoami.h +++yyprint.o: 0.h +++yyprint.o: yy.h +++yyput.o: whoami.h +++yyput.o: 0.h +++yyput.o: tree.h +++yyput.o: yy.h +++yyrecover.o: whoami.h +++yyrecover.o: 0.h +++yyrecover.o: yy.h +++yyseman.o: whoami.h +++yyseman.o: 0.h +++yyseman.o: yy.h +++yytree.o: whoami.h +++yytree.o: 0.h +++yytree.o: tree.h +++# DEPENDENCIES MUST END AT END OF FILE +++# IF YOU PUT STUFF HERE IT WILL GO AWAY +++# see make depend above diff --cc usr/src/cmd/pc0/nl.c index 0000000000,0000000000,0000000000..726c9da1c0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/nl.c @@@@ -1,0 -1,0 -1,0 +1,774 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)nl.c 1.2 10/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "opcode.h" +++#include "objfmt.h" +++ +++/* +++ * NAMELIST SEGMENT DEFINITIONS +++ */ +++struct nls { +++ struct nl *nls_low; +++ struct nl *nls_high; +++} ntab[MAXNL], *nlact; +++ +++struct nl nl[INL]; +++struct nl *nlp = nl; +++struct nls *nlact = ntab; +++ +++ /* +++ * all these strings must be places where people can find them +++ * since lookup only looks at the string pointer, not the chars. +++ * see, for example, pTreeInit. +++ */ +++ +++ /* +++ * built in constants +++ */ +++char *in_consts[] = { +++ "true" , +++ "false" , +++ "TRUE", +++ "FALSE", +++ "minint" , +++ "maxint" , +++ "minchar" , +++ "maxchar" , +++ "bell" , +++ "tab" , +++ 0 +++ }; +++ +++ /* +++ * built in simple types +++ */ +++char *in_types[] = +++ { +++ "boolean", +++ "char", +++ "integer", +++ "real", +++ "_nil", /* dummy name */ +++ 0 +++ }; +++ +++int in_rclasses[] = +++ { +++ TINT , +++ TINT , +++ TINT , +++ TCHAR , +++ TBOOL , +++ TDOUBLE , +++ 0 +++ }; +++ +++long in_ranges[] = +++ { +++ -128L , 128L , +++ -32768L , 32767L , +++ -2147483648L , 2147483647L , +++ 0L , 127L , +++ 0L , 1L , +++ 0L , 0L /* fake for reals */ +++ }; +++ +++ /* +++ * built in constructed types +++ */ +++char *in_ctypes[] = { +++ "Boolean" , +++ "intset" , +++ "alfa" , +++ "text" , +++ 0 +++ }; +++ +++ /* +++ * built in variables +++ */ +++char *in_vars[] = { +++ "input" , +++ "output" , +++ 0 +++ }; +++ +++ /* +++ * built in functions +++ */ +++char *in_funcs[] = +++ { +++ "abs" , +++ "arctan" , +++ "card" , +++ "chr" , +++ "clock" , +++ "cos" , +++ "eof" , +++ "eoln" , +++ "eos" , +++ "exp" , +++ "expo" , +++ "ln" , +++ "odd" , +++ "ord" , +++ "pred" , +++ "round" , +++ "sin" , +++ "sqr" , +++ "sqrt" , +++ "succ" , +++ "trunc" , +++ "undefined" , +++ /* +++ * Extensions +++ */ +++ "argc" , +++ "random" , +++ "seed" , +++ "wallclock" , +++ "sysclock" , +++ 0 +++ }; +++ +++ /* +++ * Built-in procedures +++ */ +++char *in_procs[] = +++ { +++ "date" , +++ "dispose" , +++ "flush" , +++ "get" , +++ "getseg" , +++ "halt" , +++ "linelimit" , +++ "message" , +++ "new" , +++ "pack" , +++ "page" , +++ "put" , +++ "putseg" , +++ "read" , +++ "readln" , +++ "remove" , +++ "reset" , +++ "rewrite" , +++ "time" , +++ "unpack" , +++ "write" , +++ "writeln" , +++ /* +++ * Extensions +++ */ +++ "argv" , +++ "null" , +++ "stlimit" , +++ 0 +++ }; +++ +++#ifndef PI0 +++ /* +++ * and their opcodes +++ */ +++int in_fops[] = +++ { +++ O_ABS2, +++ O_ATAN, +++ O_CARD|NSTAND, +++ O_CHR2, +++ O_CLCK|NSTAND, +++ O_COS, +++ O_EOF, +++ O_EOLN, +++ 0, +++ O_EXP, +++ O_EXPO|NSTAND, +++ O_LN, +++ O_ODD2, +++ O_ORD2, +++ O_PRED2, +++ O_ROUND, +++ O_SIN, +++ O_SQR2, +++ O_SQRT, +++ O_SUCC2, +++ O_TRUNC, +++ O_UNDEF|NSTAND, +++ /* +++ * Extensions +++ */ +++ O_ARGC|NSTAND, +++ O_RANDOM|NSTAND, +++ O_SEED|NSTAND, +++ O_WCLCK|NSTAND, +++ O_SCLCK|NSTAND +++ }; +++ +++ /* +++ * Built-in procedures +++ */ +++int in_pops[] = +++ { +++ O_DATE|NSTAND, +++ O_DISPOSE, +++ O_FLUSH|NSTAND, +++ O_GET, +++ 0, +++ O_HALT|NSTAND, +++ O_LLIMIT|NSTAND, +++ O_MESSAGE|NSTAND, +++ O_NEW, +++ O_PACK, +++ O_PAGE, +++ O_PUT, +++ 0, +++ O_READ4, +++ O_READLN, +++ O_REMOVE|NSTAND, +++ O_RESET, +++ O_REWRITE, +++ O_TIME|NSTAND, +++ O_UNPACK, +++ O_WRITEF, +++ O_WRITLN, +++ /* +++ * Extensions +++ */ +++ O_ARGV|NSTAND, +++ O_ABORT|NSTAND, +++ O_STLIM|NSTAND +++ }; +++#endif +++ +++/* +++ * Initnl initializes the first namelist segment and then +++ * initializes the name list for block 0. +++ */ +++initnl() +++ { +++ register char **cp; +++ register struct nl *np; +++ struct nl *fp; +++ int *ip; +++ long *lp; +++ +++#ifdef DEBUG +++ if ( hp21mx ) +++ { +++ MININT = -32768.; +++ MAXINT = 32767.; +++#ifndef PI0 +++ genmx(); +++#endif +++ } +++#endif +++ ntab[0].nls_low = nl; +++ ntab[0].nls_high = &nl[INL]; +++ defnl ( 0 , 0 , 0 , 0 ); +++ +++ /* +++ * Types +++ */ +++ for ( cp = in_types ; *cp != 0 ; cp ++ ) +++ hdefnl ( *cp , TYPE , nlp , 0 ); +++ +++ /* +++ * Ranges +++ */ +++ lp = in_ranges; +++ for ( ip = in_rclasses ; *ip != 0 ; ip ++ ) +++ { +++ np = defnl ( 0 , RANGE , nl+(*ip) , 0 ); +++ nl[*ip].type = np; +++ np -> range[0] = *lp ++ ; +++ np -> range[1] = *lp ++ ; +++ +++ }; +++ +++ /* +++ * built in constructed types +++ */ +++ +++ cp = in_ctypes; +++ /* +++ * Boolean = boolean; +++ */ +++ hdefnl ( *cp++ , TYPE , nl+T1BOOL , 0 ); +++ +++ /* +++ * intset = set of 0 .. 127; +++ */ +++ intset = *cp++; +++ hdefnl( intset , TYPE , nlp+1 , 0 ); +++ defnl ( 0 , SET , nlp+1 , 0 ); +++ np = defnl ( 0 , RANGE , nl+TINT , 0 ); +++ np -> range[0] = 0L; +++ np -> range[1] = 127L; +++ +++ /* +++ * alfa = array [ 1 .. 10 ] of char; +++ */ +++ np = defnl ( 0 , RANGE , nl+TINT , 0 ); +++ np -> range[0] = 1L; +++ np -> range[1] = 10L; +++ defnl ( 0 , ARRAY , nl+T1CHAR , 1 ) -> chain = np; +++ hdefnl ( *cp++ , TYPE , nlp-1 , 0 ); +++ +++ /* +++ * text = file of char; +++ */ +++ hdefnl ( *cp++ , TYPE , nlp+1 , 0 ); +++ np = defnl ( 0 , FILET , nl+T1CHAR , 0 ); +++ np -> nl_flags |= NFILES; +++ +++ /* +++ * input,output : text; +++ */ +++ cp = in_vars; +++# ifndef PI0 +++ input = hdefnl ( *cp++ , VAR , np , INPUT_OFF ); +++ output = hdefnl ( *cp++ , VAR , np , OUTPUT_OFF ); +++# else +++ input = hdefnl ( *cp++ , VAR , np , 0 ); +++ output = hdefnl ( *cp++ , VAR , np , 0 ); +++# endif +++ +++ /* +++ * built in constants +++ */ +++ cp = in_consts; +++ np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 ); +++ fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 ); +++ (nl + TBOOL)->chain = fp; +++ fp->chain = np; +++ np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 ); +++ fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 ); +++ fp->chain = np; +++ if (opt('s')) +++ (nl + TBOOL)->chain = fp; +++ hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MININT; +++ hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MAXINT; +++ hdefnl ( *cp++ , CONST , nl + T1CHAR , 0 ); +++ hdefnl ( *cp++ , CONST , nl + T1CHAR , 127 ); +++ hdefnl ( *cp++ , CONST , nl + T1CHAR , '\007' ); +++ hdefnl ( *cp++ , CONST , nl + T1CHAR , '\t' ); +++ +++ /* +++ * Built-in functions and procedures +++ */ +++#ifndef PI0 +++ ip = in_fops; +++ for ( cp = in_funcs ; *cp != 0 ; cp ++ ) +++ hdefnl ( *cp , FUNC , 0 , * ip ++ ); +++ ip = in_pops; +++ for ( cp = in_procs ; *cp != 0 ; cp ++ ) +++ hdefnl ( *cp , PROC , 0 , * ip ++ ); +++#else +++ for ( cp = in_funcs ; *cp != 0 ; cp ++ ) +++ hdefnl ( *cp , FUNC , 0 , 0 ); +++ for ( cp = in_procs ; *cp != 0 , cp ++ ) +++ hdefnl ( *cp , PROC , 0 , 0 ); +++#endif +++# ifdef PTREE +++ pTreeInit(); +++# endif +++ } +++ +++struct nl * +++hdefnl(sym, cls, typ, val) +++{ +++ register struct nl *p; +++ +++#ifndef PI1 +++ if (sym) +++ hash(sym, 0); +++#endif +++ p = defnl(sym, cls, typ, val); +++ if (sym) +++ enter(p); +++ return (p); +++} +++ +++/* +++ * Free up the name list segments +++ * at the end of a statement/proc/func +++ * All segments are freed down to the one in which +++ * p points. +++ */ +++nlfree(p) +++ struct nl *p; +++{ +++ +++ nlp = p; +++ while (nlact->nls_low > nlp || nlact->nls_high < nlp) { +++ free(nlact->nls_low); +++ nlact->nls_low = NIL; +++ nlact->nls_high = NIL; +++ --nlact; +++ if (nlact < &ntab[0]) +++ panic("nlfree"); +++ } +++} +++ +++ +++char *VARIABLE = "variable"; +++ +++char *classes[ ] = { +++ "undefined", +++ "constant", +++ "type", +++ "variable", /* VARIABLE */ +++ "array", +++ "pointer or file", +++ "record", +++ "field", +++ "procedure", +++ "function", +++ "variable", /* VARIABLE */ +++ "variable", /* VARIABLE */ +++ "pointer", +++ "file", +++ "set", +++ "subrange", +++ "label", +++ "withptr", +++ "scalar", +++ "string", +++ "program", +++ "improper", +++ "variant", +++ "formal procedure", +++ "formal function" +++}; +++ +++char *snark = "SNARK"; +++ +++#ifdef PI +++#ifdef DEBUG +++char *ctext[] = +++{ +++ "BADUSE", +++ "CONST", +++ "TYPE", +++ "VAR", +++ "ARRAY", +++ "PTRFILE", +++ "RECORD", +++ "FIELD", +++ "PROC", +++ "FUNC", +++ "FVAR", +++ "REF", +++ "PTR", +++ "FILET", +++ "SET", +++ "RANGE", +++ "LABEL", +++ "WITHPTR", +++ "SCAL", +++ "STR", +++ "PROG", +++ "IMPROPER", +++ "VARNT", +++ "FPROC", +++ "FFUNC" +++}; +++ +++char *stars = "\t***"; +++ +++/* +++ * Dump the namelist from the +++ * current nlp down to 'to'. +++ * All the namelist is dumped if +++ * to is NIL. +++ */ +++dumpnl(to, rout) +++ struct nl *to; +++{ +++ register struct nl *p; +++ register int j; +++ struct nls *nlsp; +++ int i, v, head; +++ +++ if (opt('y') == 0) +++ return; +++ if (to != NIL) +++ printf("\n\"%s\" Block=%d\n", rout, cbn); +++ nlsp = nlact; +++ head = NIL; +++ for (p = nlp; p != to;) { +++ if (p == nlsp->nls_low) { +++ if (nlsp == &ntab[0]) +++ break; +++ nlsp--; +++ p = nlsp->nls_high; +++ } +++ p--; +++ if (head == NIL) { +++ printf("\tName\tClass Bn+Flags\tType\tVal\tChn\n"); +++ head++; +++ } +++ printf("%3d:", nloff(p)); +++ if (p->symbol) +++ printf("\t%.7s", p->symbol); +++ else +++ printf(stars); +++ if (p->class) +++ printf("\t%s", ctext[p->class]); +++ else +++ printf(stars); +++ if (p->nl_flags) { +++ pchr('\t'); +++ if (p->nl_flags & 037) +++ printf("%d ", p->nl_flags & 037); +++#ifndef PI0 +++ if (p->nl_flags & NMOD) +++ pchr('M'); +++ if (p->nl_flags & NUSED) +++ pchr('U'); +++#endif +++ if (p->nl_flags & NFILES) +++ pchr('F'); +++ } else +++ printf(stars); +++ if (p->type) +++ printf("\t[%d]", nloff(p->type)); +++ else +++ printf(stars); +++ v = p->value[0]; +++ switch (p->class) { +++ case TYPE: +++ break; +++ case VARNT: +++ goto con; +++ case CONST: +++ switch (nloff(p->type)) { +++ default: +++ printf("\t%d", v); +++ break; +++ case TDOUBLE: +++ printf("\t%f", p->real); +++ break; +++ case TINT: +++ case T4INT: +++con: +++ printf("\t%ld", p->range[0]); +++ break; +++ case TSTR: +++ printf("\t'%s'", p->ptr[0]); +++ break; +++ } +++ break; +++ case VAR: +++ case REF: +++ case WITHPTR: +++ case FFUNC: +++ case FPROC: +++ printf("\t%d,%d", cbn, v); +++ break; +++ case SCAL: +++ case RANGE: +++ printf("\t%ld..%ld", p->range[0], p->range[1]); +++ break; +++ case RECORD: +++ printf("\t%d(%d)", v, p->value[NL_FLDSZ]); +++ break; +++ case FIELD: +++ printf("\t%d", v); +++ break; +++ case STR: +++ printf("\t|%d|", p->value[0]); +++ break; +++ case FVAR: +++ case FUNC: +++ case PROC: +++ case PROG: +++ if (cbn == 0) { +++ printf("\t<%o>", p->value[0] & 0377); +++#ifndef PI0 +++ if (p->value[0] & NSTAND) +++ printf("\tNSTAND"); +++#endif +++ break; +++ } +++ v = p->value[1]; +++ default: +++casedef: +++ if (v) +++ printf("\t<%d>", v); +++ else +++ printf(stars); +++ } +++ if (p->chain) +++ printf("\t[%d]", nloff(p->chain)); +++ switch (p->class) { +++ case RECORD: +++ if (p->ptr[NL_VARNT]) +++ printf("\tVARNT=[%d]", nloff(p->ptr[NL_VARNT])); +++ if (p->ptr[NL_TAG]) +++ printf(" TAG=[%d]", nloff(p->ptr[NL_TAG])); +++ break; +++ case VARNT: +++ printf("\tVTOREC=[%d]", nloff(p->ptr[NL_VTOREC])); +++ break; +++ } +++# ifdef PTREE +++ pchr( '\t' ); +++ pPrintPointer( stdout , "%s" , p -> inTree ); +++# endif +++ pchr('\n'); +++ } +++ if (head == 0) +++ printf("\tNo entries\n"); +++} +++#endif +++ +++ +++/* +++ * Define a new name list entry +++ * with initial symbol, class, type +++ * and value[0] as given. A new name +++ * list segment is allocated to hold +++ * the next name list slot if necessary. +++ */ +++struct nl * +++defnl(sym, cls, typ, val) +++ char *sym; +++ int cls; +++ struct nl *typ; +++ int val; +++{ +++ register struct nl *p; +++ register int *q, i; +++ char *cp; +++ +++ p = nlp; +++ +++ /* +++ * Zero out this entry +++ */ +++ q = p; +++ i = (sizeof *p)/(sizeof (int)); +++ do +++ *q++ = 0; +++ while (--i); +++ +++ /* +++ * Insert the values +++ */ +++ p->symbol = sym; +++ p->class = cls; +++ p->type = typ; +++ p->nl_block = cbn; +++ p->value[0] = val; +++ +++ /* +++ * Insure that the next namelist +++ * entry actually exists. This is +++ * really not needed here, it would +++ * suffice to do it at entry if we +++ * need the slot. It is done this +++ * way because, historically, nlp +++ * always pointed at the next namelist +++ * slot. +++ */ +++ nlp++; +++ if (nlp >= nlact->nls_high) { +++ i = NLINC; +++ cp = malloc(NLINC * sizeof *nlp); +++ if (cp == -1) { +++ i = NLINC / 2; +++ cp = malloc((NLINC / 2) * sizeof *nlp); +++ } +++ if (cp == -1) { +++ error("Ran out of memory (defnl)"); +++ pexit(DIED); +++ } +++ nlact++; +++ if (nlact >= &ntab[MAXNL]) { +++ error("Ran out of name list tables"); +++ pexit(DIED); +++ } +++ nlp = cp; +++ nlact->nls_low = nlp; +++ nlact->nls_high = nlact->nls_low + i; +++ } +++ return (p); +++} +++ +++/* +++ * Make a duplicate of the argument +++ * namelist entry for, e.g., type +++ * declarations of the form 'type a = b' +++ * and array indicies. +++ */ +++struct nl * +++nlcopy(p) +++ struct nl *p; +++{ +++ register int *p1, *p2, i; +++ +++ p1 = p; +++ p = p2 = defnl(0, 0, 0, 0); +++ i = (sizeof *p)/(sizeof (int)); +++ do +++ *p2++ = *p1++; +++ while (--i); +++ p->chain = NIL; +++ return (p); +++} +++ +++/* +++ * Compute a namelist offset +++ */ +++nloff(p) +++ struct nl *p; +++{ +++ +++ return (p - nl); +++} +++ +++/* +++ * Enter a symbol into the block +++ * symbol table. Symbols are hashed +++ * 64 ways based on low 6 bits of the +++ * character pointer into the string +++ * table. +++ */ +++struct nl * +++enter(np) +++ struct nl *np; +++{ +++ register struct nl *rp, *hp; +++ register struct nl *p; +++ int i; +++ +++ rp = np; +++ if (rp == NIL) +++ return (NIL); +++#ifndef PI1 +++ if (cbn > 0) +++ if (rp->symbol == input->symbol || rp->symbol == output->symbol) +++ error("Pre-defined files input and output must not be redefined"); +++#endif +++ i = rp->symbol; +++ i &= 077; +++ hp = disptab[i]; +++ if (rp->class != BADUSE && rp->class != FIELD) +++ for (p = hp; p != NIL && (p->nl_block & 037) == cbn; p = p->nl_next) +++ if (p->symbol == rp->symbol && p->class != BADUSE && p->class != FIELD) { +++#ifndef PI1 +++ error("%s is already defined in this block", rp->symbol); +++#endif +++ break; +++ +++ } +++ rp->nl_next = hp; +++ disptab[i] = rp; +++ return (rp); +++} +++#endif diff --cc usr/src/cmd/pc0/objfmt.h index 0000000000,0000000000,0000000000..ba55ea3067 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/objfmt.h @@@@ -1,0 -1,0 -1,0 +1,88 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)objfmt.h 1.2 10/4/80"; */ +++ +++#ifdef OBJ +++ /* +++ * the creation time, the size and the magic number of the obj file +++ */ +++ struct pxhdr { +++ int maketime; +++ int objsize; +++ short magicnum; +++ }; +++ +++# define HEADER_BYTES 1024 /* the size of px_header */ +++# define PX_HEADER "/usr/lib/px_header" /* px_header's name */ +++# define PX_INTRP "/usr/ucb/px" /* the interpreter's name */ +++#endif OBJ +++ +++ /* +++ * the file of error messages created by mkstr +++ */ +++#ifdef OBJ +++# define ERR_STRNGS "/usr/lib/pi2.0strings" +++# define ERR_PATHLEN 9 +++#endif OBJ +++#ifdef PC +++# define ERR_STRNGS "/usr/lib/pc2.0strings" +++# define ERR_PATHLEN 9 +++#endif PC +++ +++ /* +++ * these are because of varying sizes of pointers +++ */ +++#ifdef VAX +++# define INDX 2 /* log2 of sizeof( * ) */ +++# define PTR_AS O_AS4 +++# define PTR_RV O_RV4 +++# define PTR_IND O_IND4 +++# define PTR_DCL unsigned long /* for pointer variables */ +++# define SHORTADDR 32768 /* maximum short address */ +++# define TOOMUCH 65536 /* maximum variable size */ +++# define MAXSET 65536 /* maximum set size */ +++ /* +++ * Offsets due to the structure of the runtime stack. +++ * DPOFF1 is the amount of fixed storage in each block allocated +++ * as local variables for the runtime system. +++ * since locals are allocated negative offsets, +++ * -DPOFF1 is the last used implicit local offset. +++ * DPOFF2 is the size of the block mark. +++ * since arguments are allocated positive offsets, +++ * DPOFF2 is the end of the implicit arguments. +++ * for obj, the first argument has the highest offset +++ * from the stackpointer. and the block mark is an +++ * implicit last parameter. +++ * for pc, the first argument has the lowest offset +++ * from the argumentpointer. and the block mark is an +++ * implicit first parameter. +++ */ +++# ifdef OBJ +++# define DPOFF1 0 +++# define DPOFF2 32 +++# define INPUT_OFF -8 /* offset of `input' */ +++# define OUTPUT_OFF -4 /* offset of `output' */ +++# endif OBJ +++# ifdef PC +++# define DPOFF1 ( sizeof rtlocs - sizeof rtlocs.unwind ) +++# define DPOFF2 ( sizeof (long) ) +++# define INPUT_OFF 0 +++# define OUTPUT_OFF 0 +++# endif PC +++# define MAGICNUM 0403 /* obj magic number */ +++#endif VAX +++ +++#ifdef PDP11 +++# define INDX 1 +++# define PTR_AS O_AS2 +++# define PTR_RV O_RV2 +++# define PTR_IND O_IND2 +++# define PTR_DCL char * +++# define TOOMUCH 50000 +++# define SHORTADDR 65536 +++# define MAXSET 65536 /* maximum set size */ +++# define DPOFF2 16 +++# define INPUT_OFF -2 +++# define OUTPUT_OFF -4 +++# define MAGICNUM 0404 +++#endif PDP11 diff --cc usr/src/cmd/pc0/opc.c index 0000000000,0000000000,0000000000..7a0c47cd65 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/opc.c @@@@ -1,0 -1,0 -1,0 +1,14 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)opc.c 1.1 8/27/80"; +++ +++#include "OPnames.h" +++ +++main() { +++ register int i; +++ +++ for (i = 0; i < 256; i++) +++ if (otext[i]) +++ printf("#define O_%s %04o\n", otext[i]+1, i); +++ exit(0); +++} diff --cc usr/src/cmd/pc0/p2put.c index 0000000000,0000000000,0000000000..4a59d09c41 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/p2put.c @@@@ -1,0 -1,0 -1,0 +1,742 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)p2put.c 1.3 10/16/80"; +++ +++ /* +++ * functions to help pi put out +++ * polish postfix binary portable c compiler intermediate code +++ * thereby becoming the portable pascal compiler +++ */ +++ +++#include "whoami.h" +++#ifdef PC +++#include "0.h" +++#include "pcops.h" +++#include "pc.h" +++ +++ /* +++ * mash into f77's format +++ * lovely, isn't it? +++ */ +++#define TOF77( fop,val,rest ) ( ( ( (rest) & 0177777 ) << 16 ) \ +++ | ( ( (val) & 0377 ) << 8 ) \ +++ | ( (fop) & 0377 ) ) +++ +++ /* +++ * emits an ftext operator and a string to the pcstream +++ */ +++puttext( string ) +++ char *string; +++ { +++ int length = str4len( string ); +++ +++ if ( cgenflg ) +++ return; +++ p2word( TOF77( P2FTEXT , length , 0 ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FTEXT | %3d | 0 " , length ); +++ } +++# endif +++ p2string( string ); +++ } +++ +++int +++str4len( string ) +++ char *string; +++ { +++ +++ return ( ( strlen( string ) + 3 ) / 4 ); +++ } +++ +++ /* +++ * put formatted text into a buffer for printing to the pcstream. +++ * a call to putpflush actually puts out the text. +++ * none of arg1 .. arg5 need be present. +++ * and you can add more if you need them. +++ */ +++ /* VARARGS */ +++putprintf( format , incomplete , arg1 , arg2 , arg3 , arg4 , arg5 ) +++ char *format; +++ int incomplete; +++ { +++ static char ppbuffer[ BUFSIZ ]; +++ static char *ppbufp = ppbuffer; +++ +++ if ( cgenflg ) +++ return; +++ sprintf( ppbufp , format , arg1 , arg2 , arg3 , arg4 , arg5 ); +++ ppbufp = &( ppbuffer[ strlen( ppbuffer ) ] ); +++ if ( ppbufp >= &( ppbuffer[ BUFSIZ ] ) ) +++ panic( "putprintf" ); +++ if ( ! incomplete ) { +++ puttext( ppbuffer ); +++ ppbufp = ppbuffer; +++ } +++ } +++ +++ /* +++ * emit a left bracket operator to pcstream +++ * with function number, the maximum temp register, and total local bytes +++ * until i figure out how to use them, regs 0 .. 11 are free. +++ * one idea for one reg is to save the display pointer on block entry +++ */ +++putlbracket( ftnno , localbytes ) +++ int ftnno; +++ int localbytes; +++ { +++# define MAXTP2REG 11 +++ +++ p2word( TOF77( P2FLBRAC , MAXTP2REG , ftnno ) ); +++ p2word( BITSPERBYTE * localbytes ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout +++ , "P2FLBRAC | %3d | %d " , MAXTP2REG , ftnno ); +++ fprintf( stdout , "%d\n" +++ , BITSPERBYTE * localbytes ); +++ } +++# endif +++ } +++ +++ /* +++ * emit a right bracket operator +++ * which for the binary (fortran) interface +++ * forces the stack allocate and register mask +++ */ +++putrbracket( ftnno ) +++ int ftnno; +++ { +++ +++ p2word( TOF77( P2FRBRAC , 0 , ftnno ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FRBRAC | 0 | %d\n" , ftnno ); +++ } +++# endif +++ } +++ +++ /* +++ * emit an eof operator +++ */ +++puteof() +++ { +++ +++ p2word( P2FEOF ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FEOF\n" ); +++ } +++# endif +++ } +++ +++ /* +++ * emit a dot operator, +++ * with a source file line number and name +++ * if line is negative, there was an error on that line, but who cares? +++ */ +++putdot( filename , line ) +++ char *filename; +++ int line; +++ { +++ int length = str4len( filename ); +++ +++ if ( line < 0 ) { +++ line = -line; +++ } +++ p2word( TOF77( P2FEXPR , length , line ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FEXPR | %3d | %d " , length , line ); +++ } +++# endif +++ p2string( filename ); +++ } +++ +++ /* +++ * put out a leaf node +++ */ +++putleaf( op , lval , rval , type , name ) +++ int op; +++ int lval; +++ int rval; +++ int type; +++ char *name; +++ { +++ if ( cgenflg ) +++ return; +++ switch ( op ) { +++ default: +++ panic( "[putleaf]" ); +++ case P2ICON: +++ p2word( TOF77( P2ICON , name != NIL , type ) ); +++ p2word( lval ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2ICON | %3d | %d " +++ , name != NIL , type ); +++ fprintf( stdout , "%d\n" , lval ); +++ } +++# endif +++ if ( name ) +++ p2name( name ); +++ break; +++ case P2NAME: +++ p2word( TOF77( P2NAME , lval != 0 , type ) ); +++ if ( lval ) +++ p2word( lval ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2NAME | %3d | %d " +++ , lval != 0 , type ); +++ if ( lval ) +++ fprintf( stdout , "%d " , lval ); +++ } +++# endif +++ p2name( name ); +++ break; +++ case P2REG: +++ p2word( TOF77( P2REG , rval , type ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2REG | %3d | %d\n" , rval , type ); +++ } +++# endif +++ break; +++ } +++ } +++ +++ /* +++ * rvalues are just lvalues with indirection, except +++ * special case for named globals, whose names are their rvalues +++ */ +++putRV( name , level , offset , type ) +++ char *name; +++ int level; +++ int offset; +++ int type; +++ { +++ char extname[ BUFSIZ ]; +++ char *printname; +++ +++ if ( cgenflg ) +++ return; +++ if ( ( level <= 1 ) && ( name != 0 ) ) { +++ if ( name[0] != '_' ) { +++ sprintf( extname , EXTFORMAT , name ); +++ printname = extname; +++ } else { +++ printname = name; +++ } +++ putleaf( P2NAME , offset , 0 , type , printname ); +++ return; +++ } +++ putLV( name , level , offset , type ); +++ putop( P2UNARY P2MUL , type ); +++ } +++ +++ /* +++ * put out an lvalue +++ * given a level and offset +++ * special case for +++ * named globals, whose lvalues are just their names as constants. +++ * negative offsets, that are offsets from the frame pointer. +++ * positive offsets, that are offsets from argument pointer. +++ */ +++putLV( name , level , offset , type ) +++ char *name; +++ int level; +++ int offset; +++ int type; +++ { +++ char extname[ BUFSIZ ]; +++ char *printname; +++ +++ if ( cgenflg ) +++ return; +++ if ( ( level <= 1 ) && ( name != 0 ) ) { +++ if ( name[0] != '_' ) { +++ sprintf( extname , EXTFORMAT , name ); +++ printname = extname; +++ } else { +++ printname = name; +++ } +++ putleaf( P2ICON , offset , 0 , ADDTYPE( type , P2PTR ) +++ , printname ); +++ return; +++ } +++ if ( level == cbn ) { +++ if ( offset < 0 ) { +++ putleaf( P2REG , 0 , P2FP , ADDTYPE( type , P2PTR ) , 0 ); +++ } else { +++ putleaf( P2REG , 0 , P2AP , ADDTYPE( type , P2PTR ) , 0 ); +++ } +++ } else { +++ if ( offset < 0 ) { +++ putleaf( P2NAME +++ , ( level * sizeof(struct dispsave) ) + FP_OFFSET +++ , 0 , P2PTR | P2CHAR , DISPLAYNAME ); +++ } else { +++ putleaf( P2NAME +++ , ( level * sizeof(struct dispsave) ) + AP_OFFSET +++ , 0 , P2PTR | P2CHAR , DISPLAYNAME ); +++ } +++ } +++ if ( offset < 0 ) { +++ putleaf( P2ICON , -offset , 0 , P2INT , 0 ); +++ putop( P2MINUS , P2PTR | P2CHAR ); +++ } else { +++ putleaf( P2ICON , offset , 0 , P2INT , 0 ); +++ putop( P2PLUS , P2PTR | P2CHAR ); +++ } +++ return; +++ } +++ +++ /* +++ * put out a floating point constant leaf node +++ * the constant is declared in aligned data space +++ * and a P2NAME leaf put out for it +++ */ +++putCON8( value ) +++ double value; +++ { +++ int label; +++ char name[ BUFSIZ ]; +++ +++ if ( cgenflg ) +++ return; +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 2" , 0 ); +++ label = getlab(); +++ putlab( label ); +++ putprintf( " .double 0d%.20e" , 0 , value ); +++ putprintf( " .text" , 0 ); +++ sprintf( name , PREFIXFORMAT , LABELPREFIX , label ); +++ putleaf( P2NAME , 0 , 0 , P2DOUBLE , name ); +++ } +++ +++ /* +++ * put out either an lvalue or an rvalue for a constant string. +++ * an lvalue (for assignment rhs's) is the name as a constant, +++ * an rvalue (for parameters) is just the name. +++ */ +++putCONG( string , length , required ) +++ char *string; +++ int length; +++ int required; +++ { +++ char name[ BUFSIZ ]; +++ int label; +++ char *cp; +++ int pad; +++ int others; +++ +++ if ( cgenflg ) +++ return; +++ putprintf( " .data" , 0 ); +++ label = getlab(); +++ putlab( label ); +++ cp = string; +++ while ( *cp ) { +++ putprintf( " .byte 0%o" , 1 , *cp ++ ); +++ for ( others = 2 ; ( others <= 8 ) && *cp ; others ++ ) { +++ putprintf( ",0%o" , 1 , *cp++ ); +++ } +++ putprintf( "" , 0 ); +++ } +++ pad = length - strlen( string ); +++ while ( pad-- > 0 ) { +++ putprintf( " .byte 0%o" , 1 , ' ' ); +++ for ( others = 2 ; ( others <= 8 ) && ( pad-- > 0 ) ; others++ ) { +++ putprintf( ",0%o" , 1 , ' ' ); +++ } +++ putprintf( "" , 0 ); +++ } +++ putprintf( " .byte 0" , 0 ); +++ putprintf( " .text" , 0 ); +++ sprintf( name , PREFIXFORMAT , LABELPREFIX , label ); +++ if ( required == RREQ ) { +++ putleaf( P2NAME , 0 , 0 , P2ARY | P2CHAR , name ); +++ } else { +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR , name ); +++ } +++ } +++ +++ /* +++ * map a pascal type to a c type +++ * this would be tail recursive, but i unfolded it into a for (;;). +++ * this is sort of like isa and lwidth +++ * a note on the types used by the portable c compiler: +++ * they are divided into a basic type (char, short, int, long, etc.) +++ * and qualifications on those basic types (pointer, function, array). +++ * the basic type is kept in the low 4 bits of the type descriptor, +++ * and the qualifications are arranged in two bit chunks, with the +++ * most significant on the right, +++ * and the least significant on the left +++ * e.g. int *foo(); +++ * (a function returning a pointer to an integer) +++ * is stored as +++ * +++ * so, we build types recursively +++ * also, we know that /lib/f1 can only deal with 6 qualifications +++ * so we stop the recursion there. this stops infinite type recursion +++ * through mutually recursive pointer types. +++ */ +++#define MAXQUALS 6 +++int +++p2type( np ) +++{ +++ +++ return typerecur( np , 0 ); +++} +++typerecur( np , quals ) +++ struct nl *np; +++ int quals; +++ { +++ +++ if ( np == NIL || quals > MAXQUALS ) { +++ return P2UNDEF; +++ } +++ switch ( np -> class ) { +++ case SCAL : +++ case RANGE : +++ if ( np -> type == ( nl + TDOUBLE ) ) { +++ return P2DOUBLE; +++ } +++ switch ( bytes( np -> range[0] , np -> range[1] ) ) { +++ case 1: +++ return P2CHAR; +++ case 2: +++ return P2SHORT; +++ case 4: +++ return P2INT; +++ default: +++ panic( "p2type int" ); +++ } +++ case STR : +++ return ( P2ARY | P2CHAR ); +++ case RECORD : +++ case SET : +++ return P2STRTY; +++ case FILET : +++ return ( P2PTR | P2STRTY ); +++ case CONST : +++ case VAR : +++ case FIELD : +++ return p2type( np -> type ); +++ case TYPE : +++ switch ( nloff( np ) ) { +++ case TNIL : +++ return ( P2PTR | P2UNDEF ); +++ case TSTR : +++ return ( P2ARY | P2CHAR ); +++ case TSET : +++ return P2STRTY; +++ default : +++ return ( p2type( np -> type ) ); +++ } +++ case REF: +++ case WITHPTR: +++ case PTR : +++ return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2PTR ); +++ case ARRAY : +++ return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2ARY ); +++ case FUNC : +++ /* +++ * functions are really pointers to functions +++ * which return their underlying type. +++ */ +++ return ADDTYPE( ADDTYPE( typerecur( np -> type , quals + 2 ) , +++ P2FTN ) , P2PTR ); +++ case PROC : +++ /* +++ * procedures are pointers to functions +++ * which return integers (whether you look at them or not) +++ */ +++ return ADDTYPE( ADDTYPE( P2INT , P2FTN ) , P2PTR ); +++ case FFUNC : +++ case FPROC : +++ /* +++ * formal procedures and functions are pointers +++ * to structures which describe their environment. +++ */ +++ return ADDTYPE( P2PTR , P2STRTY ); +++ default : +++ panic( "p2type" ); +++ } +++ } +++ +++ /* +++ * add a most significant type modifier to a type +++ */ +++long +++addtype( underlying , mtype ) +++ long underlying; +++ long mtype; +++ { +++ return ( ( ( underlying & ~P2BASETYPE ) << P2TYPESHIFT ) +++ | mtype +++ | ( underlying & P2BASETYPE ) ); +++ } +++ +++ /* +++ * put a typed operator to the pcstream +++ */ +++putop( op , type ) +++ int op; +++ int type; +++ { +++ extern char *p2opnames[]; +++ +++ if ( cgenflg ) +++ return; +++ p2word( TOF77( op , 0 , type ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "%s (%d) | 0 | %d\n" +++ , p2opnames[ op ] , op , type ); +++ } +++# endif +++ } +++ +++ /* +++ * put out a structure operator (STASG, STARG, STCALL, UNARY STCALL ) +++ * which looks just like a regular operator, only the size and +++ * alignment go in the next consecutive words +++ */ +++putstrop( op , type , size , alignment ) +++ int op; +++ int type; +++ int size; +++ int alignment; +++ { +++ extern char *p2opnames[]; +++ +++ if ( cgenflg ) +++ return; +++ p2word( TOF77( op , 0 , type ) ); +++ p2word( size ); +++ p2word( alignment ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "%s (%d) | 0 | %d %d %d\n" +++ , p2opnames[ op ] , op , type , size , alignment ); +++ } +++# endif +++ } +++ +++ /* +++ * the string names of p2ops +++ */ +++char *p2opnames[] = { +++ "", +++ "P2UNDEFINED", /* 1 */ +++ "P2NAME", /* 2 */ +++ "P2STRING", /* 3 */ +++ "P2ICON", /* 4 */ +++ "P2FCON", /* 5 */ +++ "P2PLUS", /* 6 */ +++ "", +++ "P2MINUS", /* 8 also unary == P2NEG */ +++ "", +++ "P2NEG", +++ "P2MUL", /* 11 also unary == P2INDIRECT */ +++ "", +++ "P2INDIRECT", +++ "P2AND", /* 14 also unary == P2ADDROF */ +++ "", +++ "P2ADDROF", +++ "P2OR", /* 17 */ +++ "", +++ "P2ER", /* 19 */ +++ "", +++ "P2QUEST", /* 21 */ +++ "P2COLON", /* 22 */ +++ "P2ANDAND", /* 23 */ +++ "P2OROR", /* 24 */ +++ "", /* 25 */ +++ "", /* 26 */ +++ "", /* 27 */ +++ "", /* 28 */ +++ "", /* 29 */ +++ "", /* 30 */ +++ "", /* 31 */ +++ "", /* 32 */ +++ "", /* 33 */ +++ "", /* 34 */ +++ "", /* 35 */ +++ "", /* 36 */ +++ "", /* 37 */ +++ "", /* 38 */ +++ "", /* 39 */ +++ "", /* 40 */ +++ "", /* 41 */ +++ "", /* 42 */ +++ "", /* 43 */ +++ "", /* 44 */ +++ "", /* 45 */ +++ "", /* 46 */ +++ "", /* 47 */ +++ "", /* 48 */ +++ "", /* 49 */ +++ "", /* 50 */ +++ "", /* 51 */ +++ "", /* 52 */ +++ "", /* 53 */ +++ "", /* 54 */ +++ "", /* 55 */ +++ "P2LISTOP", /* 56 */ +++ "", +++ "P2ASSIGN", /* 58 */ +++ "P2COMOP", /* 59 */ +++ "P2DIV", /* 60 */ +++ "", +++ "P2MOD", /* 62 */ +++ "", +++ "P2LS", /* 64 */ +++ "", +++ "P2RS", /* 66 */ +++ "", +++ "P2DOT", /* 68 */ +++ "P2STREF", /* 69 */ +++ "P2CALL", /* 70 also unary */ +++ "", +++ "P2UNARYCALL", +++ "P2FORTCALL", /* 73 also unary */ +++ "", +++ "P2UNARYFORTCALL", +++ "P2NOT", /* 76 */ +++ "P2COMPL", /* 77 */ +++ "P2INCR", /* 78 */ +++ "P2DECR", /* 79 */ +++ "P2EQ", /* 80 */ +++ "P2NE", /* 81 */ +++ "P2LE", /* 82 */ +++ "P2LT", /* 83 */ +++ "P2GE", /* 84 */ +++ "P2GT", /* 85 */ +++ "P2ULE", /* 86 */ +++ "P2ULT", /* 87 */ +++ "P2UGE", /* 88 */ +++ "P2UGT", /* 89 */ +++ "P2SETBIT", /* 90 */ +++ "P2TESTBIT", /* 91 */ +++ "P2RESETBIT", /* 92 */ +++ "P2ARS", /* 93 */ +++ "P2REG", /* 94 */ +++ "P2OREG", /* 95 */ +++ "P2CCODES", /* 96 */ +++ "P2FREE", /* 97 */ +++ "P2STASG", /* 98 */ +++ "P2STARG", /* 99 */ +++ "P2STCALL", /* 100 also unary */ +++ "", +++ "P2UNARYSTCALL", +++ "P2FLD", /* 103 */ +++ "P2SCONV", /* 104 */ +++ "P2PCONV", /* 105 */ +++ "P2PMCONV", /* 106 */ +++ "P2PVCONV", /* 107 */ +++ "P2FORCE", /* 108 */ +++ "P2CBRANCH", /* 109 */ +++ "P2INIT", /* 110 */ +++ "P2CAST", /* 111 */ +++ }; +++ +++ /* +++ * low level routines +++ */ +++ +++ /* +++ * puts a long word on the pcstream +++ */ +++p2word( word ) +++ long word; +++ { +++ +++ putw( word , pcstream ); +++ } +++ +++ /* +++ * put a length 0 mod 4 null padded string onto the pcstream +++ */ +++p2string( string ) +++ char *string; +++ { +++ int slen = strlen( string ); +++ int wlen = ( slen + 3 ) / 4; +++ int plen = ( wlen * 4 ) - slen; +++ char *cp; +++ int p; +++ +++ for ( cp = string ; *cp ; cp++ ) +++ putc( *cp , pcstream ); +++ for ( p = 1 ; p <= plen ; p++ ) +++ putc( '\0' , pcstream ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "\"%s" , string ); +++ for ( p = 1 ; p <= plen ; p++ ) +++ fprintf( stdout , "\\0" ); +++ fprintf( stdout , "\"\n" ); +++ } +++# endif +++ } +++ +++ /* +++ * puts a name on the pcstream +++ */ +++p2name( name ) +++ char *name; +++ { +++ int pad; +++ +++ fprintf( pcstream , NAMEFORMAT , name ); +++ pad = strlen( name ) % sizeof (long); +++ for ( ; pad < sizeof (long) ; pad++ ) { +++ putc( '\0' , pcstream ); +++ } +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , NAMEFORMAT , name ); +++ pad = strlen( name ) % sizeof (long); +++ for ( ; pad < sizeof (long) ; pad++ ) { +++ fprintf( stdout , "\\0" ); +++ } +++ fprintf( stdout , "\n" ); +++ } +++# endif +++ } +++ +++ /* +++ * put out a jump to a label +++ */ +++putjbr( label ) +++ long label; +++ { +++ +++ printjbr( LABELPREFIX , label ); +++ } +++ +++ /* +++ * put out a jump to any kind of label +++ */ +++printjbr( prefix , label ) +++ char *prefix; +++ long label; +++ { +++ +++ putprintf( " jbr " , 1 ); +++ putprintf( PREFIXFORMAT , 0 , prefix , label ); +++ } +++ +++ /* +++ * another version of put to catch calls to put +++ */ +++put( arg1 , arg2 ) +++ { +++ +++ putprintf( "# PUT CALLED!: arg1 = %d arg2 = 0%o" , 0 , arg1 , arg2 ); +++ } +++ +++#endif PC diff --cc usr/src/cmd/pc0/pas.y index 0000000000,0000000000,0000000000..6598e80178 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pas.y @@@@ -1,0 -1,0 -1,0 +1,902 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* +++ * Yacc grammar for UNIX Pascal +++ * +++ * This grammar is processed by the commands in the shell script +++ * "gram" to yield parse tables and semantic routines in the file +++ * "y.tab.c" and a header defining the lexical tokens in "yy.h". +++ * +++ * In order for the syntactic error recovery possible with this +++ * grammar to work, the grammar must be processed by a yacc which +++ * has been modified to fully enumerate possibilities in states +++ * which involve the symbol "error". +++ * The parser used for Pascal also uses a different encoding of +++ * the test entries in the action table which speeds the parse. +++ * A version of yacc which will work for Pascal is included on +++ * the distribution table as "eyacc". +++ * +++ * The "gram" script also makes the following changes to the "y.tab.c" +++ * file: +++ * +++ * 1) Causes yyval to be declared int *. +++ * +++ * 2) Loads the variable yypv into a register as yyYpv so that +++ * the arguments $1, ... are available as yyYpv[1] etc. +++ * This produces much smaller code in the semantic actions. +++ * +++ * 3) Deletes the unused array yysterm. +++ * +++ * 4) Moves the declarations up to the flag line containing +++ * '##' to the file yy.h so that the routines which use +++ * these "magic numbers" don't have to all be compiled at +++ * the same time. +++ * +++ * 5) Creates the semantic restriction checking routine yyEactr +++ * by processing action lines containing `@@'. +++ * +++ * This compiler uses a different version of the yacc parser, a +++ * different yyerror which is called yerror, and requires more +++ * lookahead sets than normally provided by yacc. +++ * +++ * Source for the yacc used with this grammar is included on +++ * distribution tapes. +++ */ +++ +++/* +++ * TERMINAL DECLARATIONS +++ * +++ * Some of the terminal declarations are out of the most natural +++ * alphabetic order because the error recovery +++ * will guess the first of equal cost non-terminals. +++ * This makes, e.g. YTO preferable to YDOWNTO. +++ */ +++ +++%term +++ YAND YARRAY YBEGIN YCASE +++ YCONST YDIV YDO YDOTDOT +++ YTO YELSE YEND YFILE +++ YFOR YFORWARD YFUNCTION YGOTO +++ YID YIF YIN YINT +++ YLABEL YMOD YNOT YNUMB +++ YOF YOR YPACKED YNIL +++ YPROCEDURE YPROG YRECORD YREPEAT +++ YSET YSTRING YTHEN YDOWNTO +++ YTYPE YUNTIL YVAR YWHILE +++ YWITH YBINT YOCT YHEX +++ YASSERT YCASELAB YILLCH YEXTERN +++ YLAST +++ +++/* +++ * PRECEDENCE DECLARATIONS +++ * +++ * Highest precedence is the unary logical NOT. +++ * Next are the multiplying operators, signified by '*'. +++ * Lower still are the binary adding operators, signified by '+'. +++ * Finally, at lowest precedence and non-associative are the relationals. +++ */ +++ +++%binary '<' '=' '>' YIN +++%left '+' '-' YOR '|' +++%left UNARYSIGN +++%left '*' '/' YDIV YMOD YAND '&' +++%left YNOT +++ +++%{ +++/* +++ * GLOBALS FOR ACTIONS +++ */ +++ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)pas.y 1.3 9/2/80"; */ +++ +++/* +++ * The following line marks the end of the yacc +++ * Constant definitions which are removed from +++ * y.tab.c and placed in the file y.tab.h. +++ */ +++## +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pas.y 1.3 9/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++#include "tree.h" +++ +++#ifdef PI +++#define lineof(l) l +++#define line2of(l) l +++#endif +++ +++%} +++ +++%% +++ +++/* +++ * PRODUCTIONS +++ */ +++ +++goal: +++ prog_hedr decls block '.' +++ = funcend($1, $3, lineof($4)); +++ | +++ decls +++ = segend(); +++ ; +++ +++ +++prog_hedr: +++ YPROG YID '(' id_list ')' ';' +++ = $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), $2, fixlist($4), NIL))); +++ | +++ YPROG error +++ = { +++ yyPerror("Malformed program statement", PPROG); +++ /* +++ * Should make a program statement +++ * with "input" and "output" here. +++ */ +++ $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), NIL, NIL, NIL))); +++ } +++ ; +++block: +++ YBEGIN stat_list YEND +++ = { +++ $$ = tree3(T_BSTL, lineof($1), fixlist($2)); +++ if ($3 < 0) +++ brerror($1, "begin"); +++ } +++ ; +++ +++ +++/* +++ * DECLARATION PART +++ */ +++decls: +++ decls decl +++ = trfree(); +++ | +++ decls error +++ = { +++Derror: +++ constend(), typeend(), varend(), trfree(); +++ yyPerror("Malformed declaration", PDECL); +++ } +++ | +++ /* lambda */ +++ = trfree(); +++ ; +++ +++decl: +++ labels +++ | +++ const_decl +++ = constend(); +++ | +++ type_decl +++ = typeend(); +++ | +++ var_decl +++ = varend(); +++ | +++ proc_decl +++ ; +++ +++/* +++ * LABEL PART +++ */ +++ +++labels: +++ YLABEL label_decl ';' +++ = label(fixlist($2), lineof($1)); +++ ; +++label_decl: +++ YINT +++ = $$ = newlist($1 == NIL ? NIL : *hash($1, 1)); +++ | +++ label_decl ',' YINT +++ = $$ = addlist($1, $3 == NIL ? NIL : *hash($3, 1)); +++ ; +++ +++/* +++ * CONST PART +++ */ +++ +++const_decl: +++ YCONST YID '=' const ';' +++ = constbeg($1, line2of($2)), const(lineof($3), $2, $4); +++ | +++ const_decl YID '=' const ';' +++ = const(lineof($3), $2, $4); +++ | +++ YCONST error +++ = { +++ constbeg($1, line2of($1)); +++Cerror: +++ yyPerror("Malformed const declaration", PDECL); +++ } +++ | +++ const_decl error +++ = goto Cerror; +++ ; +++ +++/* +++ * TYPE PART +++ */ +++ +++type_decl: +++ YTYPE YID '=' type ';' +++ = typebeg($1, line2of($2)), type(lineof($3), $2, $4); +++ | +++ type_decl YID '=' type ';' +++ = type(lineof($3), $2, $4); +++ | +++ YTYPE error +++ = { +++ typebeg($1, line2of($1)); +++Terror: +++ yyPerror("Malformed type declaration", PDECL); +++ } +++ | +++ type_decl error +++ = goto Terror; +++ ; +++ +++/* +++ * VAR PART +++ */ +++ +++var_decl: +++ YVAR id_list ':' type ';' +++ = varbeg($1, line2of($3)), var(lineof($3), fixlist($2), $4); +++ | +++ var_decl id_list ':' type ';' +++ = var(lineof($3), fixlist($2), $4); +++ | +++ YVAR error +++ = { +++ varbeg($1, line2of($1)); +++Verror: +++ yyPerror("Malformed var declaration", PDECL); +++ } +++ | +++ var_decl error +++ = goto Verror; +++ ; +++ +++/* +++ * PROCEDURE AND FUNCTION DECLARATION PART +++ */ +++ +++proc_decl: +++ phead YFORWARD ';' +++ = funcfwd($1); +++ | +++ phead YEXTERN ';' +++ = funcext($1); +++ | +++ pheadres decls block ';' +++ = funcend($1, $3, lineof($4)); +++ ; +++pheadres: +++ phead +++ = funcbody($1); +++ ; +++phead: +++ porf YID params ftype ';' +++ = $$ = funchdr(tree5($1, lineof($5), $2, $3, $4)); +++ ; +++porf: +++ YPROCEDURE +++ = $$ = T_PDEC; +++ | +++ YFUNCTION +++ = $$ = T_FDEC; +++ ; +++params: +++ '(' param_list ')' +++ = $$ = fixlist($2); +++ | +++ /* lambda */ +++ = $$ = NIL; +++ ; +++ +++/* +++ * PARAMETERS +++ */ +++ +++param: +++ id_list ':' type +++ = $$ = tree3(T_PVAL, fixlist($1), $3); +++ | +++ YVAR id_list ':' type +++ = $$ = tree3(T_PVAR, fixlist($2), $4); +++ | +++ YFUNCTION id_list ':' type +++ = $$ = tree3(T_PFUNC, fixlist($2), $4); +++ | +++ YPROCEDURE id_list +++ = $$ = tree2(T_PPROC, fixlist($2)); +++ ; +++ftype: +++ ':' type +++ = $$ = $2; +++ | +++ /* lambda */ +++ = $$ = NIL; +++ ; +++param_list: +++ param +++ = $$ = newlist($1); +++ | +++ param_list ';' param +++ = $$ = addlist($1, $3); +++ ; +++ +++/* +++ * CONSTANTS +++ */ +++ +++const: +++ YSTRING +++ = $$ = tree2(T_CSTRNG, $1); +++ | +++ number +++ | +++ '+' number +++ = $$ = tree2(T_PLUSC, $2); +++ | +++ '-' number +++ = $$ = tree2(T_MINUSC, $2); +++ ; +++number: +++ const_id +++ = $$ = tree2(T_ID, $1); +++ | +++ YINT +++ = $$ = tree2(T_CINT, $1); +++ | +++ YBINT +++ = $$ = tree2(T_CBINT, $1); +++ | +++ YNUMB +++ = $$ = tree2(T_CFINT, $1); +++ ; +++const_list: +++ const +++ = $$ = newlist($1); +++ | +++ const_list ',' const +++ = $$ = addlist($1, $3); +++ ; +++ +++/* +++ * TYPES +++ */ +++ +++type: +++ simple_type +++ | +++ '^' YID +++ = $$ = tree3(T_TYPTR, lineof($1), tree2(T_ID, $2)); +++ | +++ struct_type +++ | +++ YPACKED struct_type +++ = $$ = tree3(T_TYPACK, lineof($1), $2); +++ ; +++simple_type: +++ type_id +++ | +++ '(' id_list ')' +++ = $$ = tree3(T_TYSCAL, lineof($1), fixlist($2)); +++ | +++ const YDOTDOT const +++ = $$ = tree4(T_TYRANG, lineof($2), $1, $3); +++ ; +++struct_type: +++ YARRAY '[' simple_type_list ']' YOF type +++ = $$ = tree4(T_TYARY, lineof($1), fixlist($3), $6); +++ | +++ YFILE YOF type +++ = $$ = tree3(T_TYFILE, lineof($1), $3); +++ | +++ YSET YOF simple_type +++ = $$ = tree3(T_TYSET, lineof($1), $3); +++ | +++ YRECORD field_list YEND +++ = { +++ $$ = setuptyrec( lineof( $1 ) , $2 ); +++ if ($3 < 0) +++ brerror($1, "record"); +++ } +++ ; +++simple_type_list: +++ simple_type +++ = $$ = newlist($1); +++ | +++ simple_type_list ',' simple_type +++ = $$ = addlist($1, $3); +++ ; +++ +++/* +++ * RECORD TYPE +++ */ +++field_list: +++ fixed_part variant_part +++ = $$ = tree4(T_FLDLST, lineof(NIL), fixlist($1), $2); +++ ; +++fixed_part: +++ field +++ = $$ = newlist($1); +++ | +++ fixed_part ';' field +++ = $$ = addlist($1, $3); +++ | +++ fixed_part error +++ = yyPerror("Malformed record declaration", PDECL); +++ ; +++field: +++ /* lambda */ +++ = $$ = NIL; +++ | +++ id_list ':' type +++ = $$ = tree4(T_RFIELD, lineof($2), fixlist($1), $3); +++ ; +++ +++variant_part: +++ /* lambda */ +++ = $$ = NIL; +++ | +++ YCASE type_id YOF variant_list +++ = $$ = tree5(T_TYVARPT, lineof($1), NIL, $2, fixlist($4)); +++ | +++ YCASE YID ':' type_id YOF variant_list +++ = $$ = tree5(T_TYVARPT, lineof($1), $2, $4, fixlist($6)); +++ ; +++variant_list: +++ variant +++ = $$ = newlist($1); +++ | +++ variant_list ';' variant +++ = $$ = addlist($1, $3); +++ | +++ variant_list error +++ = yyPerror("Malformed record declaration", PDECL); +++ ; +++variant: +++ /* lambda */ +++ = $$ = NIL; +++ | +++ const_list ':' '(' field_list ')' +++ = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), $4); +++ | +++ const_list ':' '(' ')' +++ = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), NIL); +++ ; +++ +++/* +++ * STATEMENT LIST +++ */ +++ +++stat_list: +++ stat +++ = $$ = newlist($1); +++ | +++ stat_lsth stat +++ = { +++ if ((p = $1) != NIL && (q = p[1])[0] == T_IFX) { +++ q[0] = T_IFEL; +++ q[4] = $2; +++ } else +++ $$ = addlist($1, $2); +++ } +++ ; +++ +++stat_lsth: +++ stat_list ';' +++ = if ((q = $1) != NIL && (p = q[1]) != NIL && p[0] == T_IF) { +++ if (yychar < 0) +++ yychar = yylex(); +++ if (yyshifts >= 2 && yychar == YELSE) { +++ recovered(); +++ copy(&Y, &OY, sizeof Y); +++ yerror("Deleted ';' before keyword else"); +++ yychar = yylex(); +++ p[0] = T_IFX; +++ } +++ } +++ ; +++ +++/* +++ * CASE STATEMENT LIST +++ */ +++ +++cstat_list: +++ cstat +++ = $$ = newlist($1); +++ | +++ cstat_list ';' cstat +++ = $$ = addlist($1, $3); +++ | +++ error +++ = { +++ $$ = NIL; +++Kerror: +++ yyPerror("Malformed statement in case", PSTAT); +++ } +++ | +++ cstat_list error +++ = goto Kerror; +++ ; +++ +++cstat: +++ const_list ':' stat +++ = $$ = tree4(T_CSTAT, lineof($2), fixlist($1), $3); +++ | +++ YCASELAB stat +++ = $$ = tree4(T_CSTAT, lineof($1), NIL, $2); +++ | +++ /* lambda */ +++ = $$ = NIL; +++ ; +++ +++/* +++ * STATEMENT +++ */ +++ +++stat: +++ /* lambda */ +++ = $$ = NIL; +++ | +++ YINT ':' stat +++ = $$ = tree4(T_LABEL, lineof($2), $1 == NIL ? NIL : *hash($1, 1), $3); +++ | +++ proc_id +++ = $$ = tree4(T_PCALL, lineof(yyline), $1, NIL); +++ | +++ proc_id '(' wexpr_list ')' +++ = $$ = tree4(T_PCALL, lineof($2), $1, fixlist($3)); +++ | +++ YID error +++ = goto NSerror; +++ | +++ assign +++ | +++ YBEGIN stat_list YEND +++ = { +++ $$ = tree3(T_BLOCK, lineof($1), fixlist($2)); +++ if ($3 < 0) +++ brerror($1, "begin"); +++ } +++ | +++ YCASE expr YOF cstat_list YEND +++ = { +++ $$ = tree4(T_CASE, lineof($1), $2, fixlist($4)); +++ if ($5 < 0) +++ brerror($1, "case"); +++ } +++ | +++ YWITH var_list YDO stat +++ = $$ = tree4(T_WITH, lineof($1), fixlist($2), $4); +++ | +++ YWHILE expr YDO stat +++ = $$ = tree4(T_WHILE, lineof($1), $2, $4); +++ | +++ YREPEAT stat_list YUNTIL expr +++ = $$ = tree4(T_REPEAT, lineof($3), fixlist($2), $4); +++ | +++ YFOR assign YTO expr YDO stat +++ = $$ = tree5(T_FORU, lineof($1), $2, $4, $6); +++ | +++ YFOR assign YDOWNTO expr YDO stat +++ = $$ = tree5(T_FORD, lineof($1), $2, $4, $6); +++ | +++ YGOTO YINT +++ = $$ = tree3(T_GOTO, lineof($1), *hash($2, 1)); +++ | +++ YIF expr YTHEN stat +++ = $$ = tree5(T_IF, lineof($1), $2, $4, NIL); +++ | +++ YIF expr YTHEN stat YELSE stat +++ = $$ = tree5(T_IFEL, lineof($1), $2, $4, $6); +++ | +++ YIF expr YTHEN stat YELSE +++ = $$ = tree5(T_IFEL, lineof($1), $2, $4, NIL); +++ | +++ YASSERT '(' expr ')' +++ = $$ = tree3(T_ASRT, lineof($1), $3); +++ | +++ error +++ = { +++NSerror: +++ $$ = NIL; +++Serror: +++ yyPerror("Malformed statement", PSTAT); +++ } +++ ; +++assign: +++ variable ':' '=' expr +++ = $$ = tree4(T_ASGN, lineof($2), $1, $4); +++ ; +++ +++/* +++ * EXPRESSION +++ */ +++ +++expr: +++ error +++ = { +++NEerror: +++ $$ = NIL; +++Eerror: +++ yyPerror("Missing/malformed expression", PEXPR); +++ } +++ | +++ expr relop expr %prec '<' +++ = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); +++ | +++ '+' expr %prec UNARYSIGN +++ = $$ = tree3(T_PLUS, $2[1], $2); +++ | +++ '-' expr %prec UNARYSIGN +++ = $$ = tree3(T_MINUS, $2[1], $2); +++ | +++ expr addop expr %prec '+' +++ = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); +++ | +++ expr divop expr %prec '*' +++ = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); +++ | +++ YNIL +++ = $$ = tree2(T_NIL, NOCON); +++ | +++ YSTRING +++ = $$ = tree3(T_STRNG, SAWCON, $1); +++ | +++ YINT +++ = $$ = tree3(T_INT, NOCON, $1); +++ | +++ YBINT +++ = $$ = tree3(T_BINT, NOCON, $1); +++ | +++ YNUMB +++ = $$ = tree3(T_FINT, NOCON, $1); +++ | +++ variable +++ | +++ YID error +++ = goto NEerror; +++ | +++ func_id '(' wexpr_list ')' +++ = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3)); +++ | +++ '(' expr ')' +++ = $$ = $2; +++ | +++ negop expr %prec YNOT +++ = $$ = tree3(T_NOT, NOCON, $2); +++ | +++ '[' element_list ']' +++ = $$ = tree3(T_CSET, SAWCON, fixlist($2)); +++ | +++ '[' ']' +++ = $$ = tree3(T_CSET, SAWCON, NIL); +++ ; +++ +++element_list: +++ element +++ = $$ = newlist($1); +++ | +++ element_list ',' element +++ = $$ = addlist($1, $3); +++ ; +++element: +++ expr +++ | +++ expr YDOTDOT expr +++ = $$ = tree3(T_RANG, $1, $3); +++ ; +++ +++/* +++ * QUALIFIED VARIABLES +++ */ +++ +++variable: +++ YID +++ = { +++ @@ return (identis(var, VAR)); +++ $$ = setupvar($1, NIL); +++ } +++ | +++ qual_var +++ = $1[3] = fixlist($1[3]); +++ ; +++qual_var: +++ array_id '[' expr_list ']' +++ = $$ = setupvar($1, tree2(T_ARY, fixlist($3))); +++ | +++ qual_var '[' expr_list ']' +++ = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3))); +++ | +++ record_id '.' field_id +++ = $$ = setupvar($1, setupfield($3, NIL)); +++ | +++ qual_var '.' field_id +++ = $1[3] = addlist($1[3], setupfield($3, NIL)); +++ | +++ ptr_id '^' +++ = $$ = setupvar($1, tree1(T_PTR)); +++ | +++ qual_var '^' +++ = $1[3] = addlist($1[3], tree1(T_PTR)); +++ ; +++ +++/* +++ * Expression with write widths +++ */ +++wexpr: +++ expr +++ | +++ expr ':' expr +++ = $$ = tree4(T_WEXP, $1, $3, NIL); +++ | +++ expr ':' expr ':' expr +++ = $$ = tree4(T_WEXP, $1, $3, $5); +++ | +++ expr octhex +++ = $$ = tree4(T_WEXP, $1, NIL, $2); +++ | +++ expr ':' expr octhex +++ = $$ = tree4(T_WEXP, $1, $3, $4); +++ ; +++octhex: +++ YOCT +++ = $$ = OCT; +++ | +++ YHEX +++ = $$ = HEX; +++ ; +++ +++expr_list: +++ expr +++ = $$ = newlist($1); +++ | +++ expr_list ',' expr +++ = $$ = addlist($1, $3); +++ ; +++ +++wexpr_list: +++ wexpr +++ = $$ = newlist($1); +++ | +++ wexpr_list ',' wexpr +++ = $$ = addlist($1, $3); +++ ; +++ +++/* +++ * OPERATORS +++ */ +++ +++relop: +++ '=' = $$ = T_EQ; +++ | +++ '<' = $$ = T_LT; +++ | +++ '>' = $$ = T_GT; +++ | +++ '<' '>' = $$ = T_NE; +++ | +++ '<' '=' = $$ = T_LE; +++ | +++ '>' '=' = $$ = T_GE; +++ | +++ YIN = $$ = T_IN; +++ ; +++addop: +++ '+' = $$ = T_ADD; +++ | +++ '-' = $$ = T_SUB; +++ | +++ YOR = $$ = T_OR; +++ | +++ '|' = $$ = T_OR; +++ ; +++divop: +++ '*' = $$ = T_MULT; +++ | +++ '/' = $$ = T_DIVD; +++ | +++ YDIV = $$ = T_DIV; +++ | +++ YMOD = $$ = T_MOD; +++ | +++ YAND = $$ = T_AND; +++ | +++ '&' = $$ = T_AND; +++ ; +++ +++negop: +++ YNOT +++ | +++ '~' +++ ; +++ +++/* +++ * LISTS +++ */ +++ +++var_list: +++ variable +++ = $$ = newlist($1); +++ | +++ var_list ',' variable +++ = $$ = addlist($1, $3); +++ ; +++ +++id_list: +++ YID +++ = $$ = newlist($1); +++ | +++ id_list ',' YID +++ = $$ = addlist($1, $3); +++ ; +++ +++/* +++ * Identifier productions with semantic restrictions +++ * +++ * For these productions, the characters @@ signify +++ * that the associated C statement is to provide +++ * the semantic restriction for this reduction. +++ * These lines are made into a procedure yyEactr, similar to +++ * yyactr, which determines whether the corresponding reduction +++ * is permitted, or whether an error is to be signaled. +++ * A zero return from yyEactr is considered an error. +++ * YyEactr is called with an argument "var" giving the string +++ * name of the variable in question, essentially $1, although +++ * $1 will not work because yyEactr is called from loccor in +++ * the recovery routines. +++ */ +++ +++const_id: +++ YID +++ = @@ return (identis(var, CONST)); +++ ; +++type_id: +++ YID +++ = { +++ @@ return (identis(var, TYPE)); +++ $$ = tree3(T_TYID, lineof(yyline), $1); +++ } +++ ; +++var_id: +++ YID +++ = @@ return (identis(var, VAR)); +++ ; +++array_id: +++ YID +++ = @@ return (identis(var, ARRAY)); +++ ; +++ptr_id: +++ YID +++ = @@ return (identis(var, PTRFILE)); +++ ; +++record_id: +++ YID +++ = @@ return (identis(var, RECORD)); +++ ; +++field_id: +++ YID +++ = @@ return (identis(var, FIELD)); +++ ; +++proc_id: +++ YID +++ = @@ return (identis(var, PROC)); +++ ; +++func_id: +++ YID +++ = @@ return (identis(var, FUNC)); +++ ; diff --cc usr/src/cmd/pc0/pc.h index 0000000000,0000000000,0000000000..cd8a4e89fd new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pc.h @@@@ -1,0 -1,0 -1,0 +1,100 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)pc.h 1.2 10/14/80"; */ +++ +++ /* +++ * random constants for pc +++ */ +++ +++ /* +++ * the name of the display. +++ * the display is made up of saved AP's and FP's. +++ * FP's are used to find locals, and AP's are used to find parameters. +++ * FP and AP are untyped pointers, but are used throughout as (char *). +++ * the display is used by adding AP_OFFSET or FP_OFFSET to the +++ * address of the approriate display entry. +++ */ +++#define DISPLAYNAME "__disply" +++struct dispsave { +++ char *savedAP; +++ char *savedFP; +++}; +++#define AP_OFFSET ( 0 ) +++#define FP_OFFSET ( sizeof(char *) ) +++ +++ /* +++ * the structure below describes the locals used by the run time system. +++ * at function entry, at least this much space is allocated, +++ * and the following information is filled in: +++ * the address of a routine to close the current frame for unwinding, +++ * a pointer to the display entry for the current static level and +++ * the previous contents of the display for this static level. +++ * the curfile location is used to point to the currently active file, +++ * and is filled in as io is initiated. +++ * one of these structures is allocated on the (negatively growing) stack. +++ * at function entry, fp is set to point to the last field of the struct, +++ * thus the offsets of the fields are as indicated below. +++ */ +++struct rtlocals { +++ struct iorec *curfile; +++ struct dispsave dsave; +++ struct dispsave *dptr; +++ int (*unwind)(); +++} rtlocs; +++#define CURFILEOFFSET ( ( -sizeof rtlocs ) + sizeof rtlocs.unwind ) +++#define DSAVEOFFSET ( CURFILEOFFSET + sizeof rtlocs.curfile ) +++#define DPTROFFSET ( DSAVEOFFSET + sizeof rtlocs.dsave ) +++#define UNWINDOFFSET ( DPTROFFSET + sizeof rtlocs.dptr ) +++#define UNWINDNAME "_UNWIND" +++ +++ /* +++ * the register save mask for saving no registers +++ */ +++#define RSAVEMASK ( 0 ) +++ +++ /* +++ * runtime check mask for divide check and integer overflow +++ */ +++#define RUNCHECK ( ( 1 << 15 ) | ( 1 << 14 ) ) +++ +++ /* +++ * formats for various names +++ * NAMEFORMAT arbitrary length strings. +++ * EXTFORMAT for externals, a preceding underscore. +++ * PREFIXFORMAT used to print made up names with prefixes. +++ * LABELPREFIX with getlab() makes up label names. +++ * LLABELPREFIX with getlab() makes up sdb labels. +++ * a typical use might be to print out a name with a preceeding underscore +++ * with putprintf( EXTFORMAT , 0 , name ); +++ */ +++#define NAMEFORMAT "%s" +++#define EXTFORMAT "_%s" +++#define PREFIXFORMAT "%s%d" +++#define LABELPREFIX "L" +++#define LLABELPREFIX "LL" +++ +++ /* +++ * the name of the statement counter +++ */ +++#define STMTCOUNT "__stcnt" +++ +++ /* +++ * the name of the pcp counters +++ */ +++#define PCPCOUNT "__pcpcount" +++ +++ /* +++ * a vector of pointer to enclosing functions for fully qualified names. +++ */ +++char *enclosing[ DSPLYSZ ]; +++ +++ /* +++ * and of course ... +++ */ +++#define BITSPERBYTE 8 +++ +++ /* +++ * error number for case label not found (ECASE) +++ * stolen from ~mckusick/px/lib/h01errs.h +++ */ +++#define ECASE 5 diff --cc usr/src/cmd/pc0/pccaseop.c index 0000000000,0000000000,0000000000..79321a1c6b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pccaseop.c @@@@ -1,0 -1,0 -1,0 +1,332 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pccaseop.c 1.4 10/8/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and the rest of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "objfmt.h" +++#include "pcops.h" +++#include "pc.h" +++ +++ /* +++ * structure for a case: +++ * its constant label, line number (for errors), and location label. +++ */ +++struct ct { +++ long cconst; +++ int cline; +++ int clabel; +++}; +++ +++ /* +++ * the P2FORCE operator puts its operand into a register. +++ * these to keep from thinking of it as r0 all over. +++ */ +++#define FORCENAME "r0" +++#define FORCENUMBER 0 +++ +++ /* +++ * given a tree for a case statement, generate code for it. +++ * this computes the expression into a register, +++ * puts down the code for each of the cases, +++ * and then decides how to do the case switching. +++ * tcase [0] T_CASE +++ * [1] lineof "case" +++ * [2] expression +++ * [3] list of cased statements: +++ * cstat [0] T_CSTAT +++ * [1] lineof ":" +++ * [2] list of constant labels +++ * [3] statement +++ */ +++pccaseop( tcase ) +++ int *tcase; +++{ +++ struct nl *exprtype; +++ struct nl *rangetype; +++ long low; +++ long high; +++ long exprctype; +++ long swlabel; +++ long endlabel; +++ long label; +++ long count; +++ long *cstatlp; +++ long *cstatp; +++ long *casep; +++ struct ct *ctab; +++ struct ct *ctp; +++ long i; +++ long nr; +++ long goc; +++ int casecmp(); +++ bool dupcases; +++ +++ goc = gocnt; +++ /* +++ * find out the type of the case expression +++ * even if the expression has errors (exprtype == NIL), continue. +++ */ +++ line = tcase[1]; +++ exprtype = rvalue( (int *) tcase[2] , NIL , RREQ ); +++ if ( exprtype != NIL ) { +++ if ( isnta( exprtype , "bcsi" ) ) { +++ error("Case selectors cannot be %ss" , nameof( exprtype ) ); +++ exprtype = NIL; +++ } else { +++ if ( exprtype -> class != RANGE ) { +++ rangetype = exprtype -> type; +++ } else { +++ rangetype = exprtype; +++ } +++ if ( rangetype == NIL ) { +++ exprtype = NIL; +++ } else { +++ low = rangetype -> range[0]; +++ high = rangetype -> range[1]; +++ } +++ } +++ } +++ if ( exprtype != NIL ) { +++ /* +++ * put expression into a register +++ * save its c-type and jump to the code to do the switch. +++ */ +++ putop( P2FORCE , P2INT ); +++ putdot( filename , line ); +++ exprctype = p2type( exprtype ); +++ swlabel = getlab(); +++ putjbr( swlabel ); +++ } +++ /* +++ * count the number of cases +++ * and allocate table for cases, lines, and labels +++ * default case goes in ctab[0]. +++ */ +++ count = 1; +++ for ( cstatlp = tcase[3] ; cstatlp != NIL ; cstatlp = cstatlp[2] ) { +++ cstatp = cstatlp[1]; +++ if ( cstatp == NIL ) { +++ continue; +++ } +++ for ( casep = cstatp[2] ; casep != NIL ; casep = casep[2] ) { +++ count++; +++ } +++ } +++ /* +++ */ +++ ctab = (struct ct *) malloc( count * sizeof( struct ct ) ); +++ if ( ctab == (struct ct *) 0 ) { +++ error("Ran out of memory (case)"); +++ pexit( DIED ); +++ } +++ /* +++ * pick up default label and label for after case statement. +++ */ +++ ctab[0].clabel = getlab(); +++ endlabel = getlab(); +++ /* +++ * generate code for each case +++ * filling in ctab for each. +++ * nr is for error if no case falls out bottom. +++ */ +++ nr = 1; +++ count = 0; +++ for ( cstatlp = tcase[3] ; cstatlp != NIL ; cstatlp = cstatlp[2] ) { +++ cstatp = cstatlp[1]; +++ if ( cstatp == NIL ) { +++ continue; +++ } +++ line = cstatp[1]; +++ label = getlab(); +++ for ( casep = cstatp[2] ; casep != NIL ; casep = casep[2] ) { +++ gconst( casep[1] ); +++ if( exprtype == NIL || con.ctype == NIL ) { +++ continue; +++ } +++ if ( incompat( con.ctype , exprtype , NIL ) ) { +++ cerror("Case label type clashed with case selector expression type"); +++ continue; +++ } +++ if ( con.crval < low || con.crval > high ) { +++ error("Case label out of range"); +++ continue; +++ } +++ count++; +++ ctab[ count ].cconst = con.crval; +++ ctab[ count ].cline = line; +++ ctab[ count ].clabel = label; +++ } +++ /* +++ * put out the statement +++ */ +++ putlab( label ); +++ putcnt(); +++ level++; +++ statement( cstatp[3] ); +++ nr &= noreach; +++ noreach = 0; +++ level--; +++ if (gotos[cbn]) { +++ ungoto(); +++ } +++ putjbr( endlabel ); +++ } +++ noreach = nr; +++ /* +++ * default action is to call error +++ */ +++ putlab( ctab[0].clabel ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_ERROR" ); +++ putleaf( P2ICON , ECASE , 0 , P2INT , 0 ); +++ putleaf( P2REG , FORCENUMBER , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ /* +++ * sort the cases +++ */ +++ qsort( &ctab[1] , count , sizeof (struct ct) , casecmp ); +++ /* +++ * check for duplicates +++ */ +++ dupcases = FALSE; +++ for ( ctp = &ctab[1] ; ctp < &ctab[ count ] ; ctp++ ) { +++ if ( ctp[0].cconst == ctp[1].cconst ) { +++ error("Multiply defined label in case, lines %d and %d" , +++ ctp[0].cline , ctp[1].cline ); +++ dupcases = TRUE; +++ } +++ } +++ if ( dupcases ) { +++ return; +++ } +++ /* +++ * choose a switch algorithm and implement it: +++ * direct switch >= 1/3 full and >= 4 cases. +++ * binary switch not direct switch and > 8 cases. +++ * ifthenelse not direct or binary switch. +++ */ +++ putlab( swlabel ); +++ if ( ctab[ count ].cconst - ctab[1].cconst < 3 * count && count >= 4 ) { +++ directsw( ctab , count ); +++ } else if ( count > 8 ) { +++ binarysw( ctab , count ); +++ } else { +++ itesw( ctab , count ); +++ } +++ putlab( endlabel ); +++ if ( goc != gocnt ) { +++ putcnt(); +++ } +++} +++ +++ /* +++ * direct switch +++ */ +++directsw( ctab , count ) +++ struct ct *ctab; +++ int count; +++{ +++ int fromlabel = getlab(); +++ long i; +++ long j; +++ +++ putprintf( " casel %s,$%d,$%d" , 0 , FORCENAME , +++ ctab[1].cconst , ctab[ count ].cconst - ctab[1].cconst ); +++ putlab( fromlabel ); +++ i = 1; +++ j = ctab[1].cconst; +++ while ( i <= count ) { +++ if ( j == ctab[ i ].cconst ) { +++ putprintf( " .word " , 1 ); +++ putprintf( PREFIXFORMAT , 1 , LABELPREFIX , ctab[ i ].clabel ); +++ putprintf( "-" , 1 ); +++ putprintf( PREFIXFORMAT , 0 , LABELPREFIX , fromlabel ); +++ i++; +++ } else { +++ putprintf( " .word " , 1 ); +++ putprintf( PREFIXFORMAT , 1 , LABELPREFIX , ctab[ 0 ].clabel ); +++ putprintf( "-" , 1 ); +++ putprintf( PREFIXFORMAT , 0 , LABELPREFIX , fromlabel ); +++ } +++ j++; +++ } +++ putjbr( ctab[0].clabel ); +++} +++ +++ /* +++ * binary switch +++ * special case out default label and start recursion. +++ */ +++binarysw( ctab , count ) +++ struct ct *ctab; +++ int count; +++{ +++ +++ bsrecur( ctab[0].clabel , &ctab[0] , count ); +++} +++ +++ /* +++ * recursive log( count ) search. +++ */ +++bsrecur( deflabel , ctab , count ) +++ int deflabel; +++ struct ct *ctab; +++ int count; +++{ +++ +++ if ( count <= 0 ) { +++ putprintf( " jbr L%d" , 0 , deflabel ); +++ return; +++ } else if ( count == 1 ) { +++ putprintf( " cmpl %s,$%d" , 0 , FORCENAME , ctab[1].cconst ); +++ putprintf( " jeql L%d" , 0 , ctab[1].clabel ); +++ putprintf( " jbr L%d" , 0 , deflabel ); +++ return; +++ } else { +++ int half = ( count + 1 ) / 2; +++ int gtrlabel = getlab(); +++ +++ putprintf( " cmpl %s,$%d" , 0 , FORCENAME , ctab[ half ].cconst ); +++ putprintf( " jgtr L%d" , 0 , gtrlabel ); +++ putprintf( " jeql L%d" , 0 , ctab[ half ].clabel ); +++ bsrecur( deflabel , &ctab[0] , half - 1 ); +++ putprintf( "L%d:" , 0 , gtrlabel ); +++ bsrecur( deflabel , &ctab[ half ] , count - half ); +++ return; +++ } +++} +++ +++itesw( ctab , count ) +++ struct ct *ctab; +++ int count; +++{ +++ int i; +++ +++ for ( i = 1 ; i <= count ; i++ ) { +++ putprintf( " cmpl %s,$%d" , 0 , FORCENAME , ctab[ i ].cconst ); +++ putprintf( " jeql L%d" , 0 , ctab[ i ].clabel ); +++ } +++ putprintf( " jbr L%d" , 0 , ctab[0].clabel ); +++ return; +++} +++int +++casecmp( this , that ) +++ struct ct *this; +++ struct ct *that; +++{ +++ if ( this -> cconst < that -> cconst ) { +++ return -1; +++ } else if ( this -> cconst > that -> cconst ) { +++ return 1; +++ } else { +++ return 0; +++ } +++} +++#endif PC diff --cc usr/src/cmd/pc0/pcforop.c index 0000000000,0000000000,0000000000..ae13546a93 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pcforop.c @@@@ -1,0 -1,0 -1,0 +1,241 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pcforop.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and the rest of the file +++ */ +++#include "0.h" +++#include "opcode.h" +++#include "tree.h" +++#include "pc.h" +++#include "pcops.h" +++ /* +++ * forop for pc: +++ * this evaluates the initial and termination expressions, +++ * checks them to see if the loop executes at all, and then +++ * does the assignment and the loop. +++ * arg here looks like: +++ * arg[0] T_FORU or T_FORD +++ * [1] lineof "for" +++ * [2] [0] T_ASGN +++ * [1] lineof ":=" +++ * [2] [0] T_VAR +++ * [1] lineof id +++ * [2] char * to id +++ * [3] qualifications +++ * [3] initial expression +++ * [3] termination expression +++ * [4] statement +++ */ +++pcforop( arg ) +++ int *arg; +++ { +++ int *lhs; +++ struct nl *forvar; +++ struct nl *fortype; +++ int forctype; +++ int *init; +++ struct nl *inittype; +++ int initoff; +++ int *term; +++ struct nl *termtype; +++ int termoff; +++ int *stat; +++ int goc; /* saved gocnt */ +++ int again; /* label at the top of the loop */ +++ int after; /* label after the end of the loop */ +++ +++ goc = gocnt; +++ forvar = NIL; +++ if ( arg == NIL ) { +++ goto byebye; +++ } +++ if ( arg[2] == NIL ) { +++ goto byebye; +++ } +++ line = arg[1]; +++ putline(); +++ lhs = ( (int *) arg[2] )[2]; +++ init = ( (int *) arg[2] )[3]; +++ term = arg[3]; +++ stat = arg[4]; +++ if ( lhs[3] != NIL ) { +++ error("For variable must be unqualified"); +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ /* +++ * and this marks the variable as used!!! +++ */ +++ forvar = lookup( lhs[2] ); +++ if ( forvar == NIL ) { +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ /* +++ * find out the type of the loop variable +++ */ +++ codeoff(); +++ fortype = lvalue( lhs , MOD , RREQ ); +++ codeon(); +++ /* +++ * mark the forvar so we can't change it during the loop +++ */ +++ forvar -> value[ NL_FORV ] = 1; +++ if ( fortype == NIL ) { +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ if ( isnta( fortype , "bcis" ) ) { +++ error("For variables cannot be %ss" , nameof( fortype ) ); +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ forctype = p2type( fortype ); +++ /* +++ * allocate space for the initial and termination expressions +++ */ +++ sizes[cbn].om_off -= sizeof( long ); +++ initoff = sizes[cbn].om_off; +++ sizes[cbn].om_off -= sizeof( long ); +++ termoff = sizes[cbn].om_off; +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ if ( sizes[cbn].om_off < sizes[cbn].om_max ) { +++ sizes[cbn].om_max = sizes[cbn].om_off; +++ } +++ /* +++ * compute and save the initial expression +++ */ +++ putRV( 0 , cbn , initoff , forctype ); +++ inittype = rvalue( init , fortype , RREQ ); +++ if ( incompat( inittype , fortype , init ) ) { +++ cerror("Type of initial expression clashed with index type in 'for' statement"); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * compute and save the termination expression +++ */ +++ putRV( 0 , cbn , termoff , forctype ); +++ termtype = rvalue( term , fortype , RREQ ); +++ if ( incompat( termtype , fortype , term ) ) { +++ cerror("Type of limit expression clashed with index type in 'for' statement"); +++ statement( stat ); +++ goto byebye; +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * we can skip the loop altogether if !( init <= term ) +++ */ +++ after = getlab(); +++ putRV( 0 , cbn , initoff , forctype ); +++ putRV( 0 , cbn , termoff , forctype ); +++ putop( ( arg[0] == T_FORU ? P2LE : P2GE ) , forctype ); +++ putleaf( P2ICON , after , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++ /* +++ * okay, then we have to execute the body, +++ * but first, assign the initial expression to the for variable. +++ * see the note in asgnop1 about why this is an rvalue. +++ */ +++ rvalue( lhs , NIL , RREQ ); +++ if ( opt( 't' ) ) { +++ precheck( fortype , "_RANG4" , "_RSNG4" ); +++ } +++ putRV( 0 , cbn , initoff , forctype ); +++ if ( opt( 't' ) ) { +++ postcheck( fortype ); +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * put down the label at the top of the loop +++ */ +++ again = getlab(); +++ putlab( again ); +++ putcnt(); +++ /* +++ * and don't forget ... +++ */ +++ statement( arg[ 4 ] ); +++ /* +++ * wasn't that fun? do we get to do it again? +++ * we don't do it again if ( !( forvar < limit ) ) +++ * pretend we were doing this at the top of the loop +++ */ +++ line = arg[ 1 ]; +++ if ( opt( 'p' ) ) { +++ if ( opt('t') ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_LINO" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else { +++ putRV( STMTCOUNT , 0 , 0 , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2ASG P2PLUS , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++ rvalue( lhs , NIL , RREQ ); +++ putRV( 0 , cbn , termoff , forctype ); +++ putop( ( arg[ 0 ] == T_FORU ? P2LT : P2GT ) , forctype ); +++ putleaf( P2ICON , after , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++ /* +++ * okay, so we have to do it again, +++ * but first, increment the for variable. +++ * there it is again, an rvalue on the lhs of an assignment. +++ */ +++ rvalue( lhs , NIL , RREQ ); +++ if ( opt( 't' ) ) { +++ precheck( fortype , "_RANG4" , "_RSNG4" ); +++ } +++ rvalue( lhs , NIL , RREQ ); +++ putleaf( P2ICON , 1 , 0 , forctype , 0 ); +++ putop( ( arg[0] == T_FORU ? P2PLUS : P2MINUS ) , forctype ); +++ if ( opt( 't' ) ) { +++ postcheck( fortype ); +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * and do it all again +++ */ +++ putjbr( again ); +++ /* +++ * deallocate the initial and limit variables +++ */ +++ sizes[cbn].om_off += 2 * ( sizeof( long ) ); +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ /* +++ * and here we are +++ */ +++ putlab( after ); +++byebye: +++ noreach = 0; +++ if ( forvar != NIL ) { +++ forvar -> value[ NL_FORV ] = 0; +++ } +++ if ( goc != gocnt ) { +++ putcnt(); +++ } +++ } +++#endif PC diff --cc usr/src/cmd/pc0/pcfunc.c index 0000000000,0000000000,0000000000..288c8656d3 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pcfunc.c @@@@ -1,0 -1,0 -1,0 +1,367 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pcfunc.c 1.3 10/19/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and to the end of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "pc.h" +++#include "pcops.h" +++ +++/* +++ * Funccod generates code for +++ * built in function calls and calls +++ * call to generate calls to user +++ * defined functions and procedures. +++ */ +++pcfunccod( r ) +++ int *r; +++{ +++ struct nl *p; +++ register struct nl *p1; +++ register int *al; +++ register op; +++ int argc, *argv; +++ int tr[2], tr2[4]; +++ char *funcname; +++ long tempoff; +++ long temptype; +++ struct nl *rettype; +++ +++ /* +++ * Verify that the given name +++ * is defined and the name of +++ * a function. +++ */ +++ p = lookup(r[2]); +++ if (p == NIL) { +++ rvlist(r[3]); +++ return (NIL); +++ } +++ if (p->class != FUNC && p->class != FFUNC) { +++ error("%s is not a function", p->symbol); +++ rvlist(r[3]); +++ return (NIL); +++ } +++ argv = r[3]; +++ /* +++ * Call handles user defined +++ * procedures and functions +++ */ +++ if (bn != 0) +++ return (call(p, argv, FUNC, bn)); +++ /* +++ * Count the arguments +++ */ +++ argc = 0; +++ for (al = argv; al != NIL; al = al[2]) +++ argc++; +++ /* +++ * Built-in functions have +++ * their interpreter opcode +++ * associated with them. +++ */ +++ op = p->value[0] &~ NSTAND; +++ if (opt('s') && (p->value[0] & NSTAND)) { +++ standard(); +++ error("%s is a nonstandard function", p->symbol); +++ } +++ if ( op == O_ARGC ) { +++ putleaf( P2NAME , 0 , 0 , P2INT , "__argc" ); +++ return nl + T4INT; +++ } +++ switch (op) { +++ /* +++ * Parameterless functions +++ */ +++ case O_CLCK: +++ funcname = "_CLCK"; +++ goto noargs; +++ case O_SCLCK: +++ funcname = "_SCLCK"; +++ goto noargs; +++noargs: +++ if (argc != 0) { +++ error("%s takes no arguments", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , funcname ); +++ putop( P2UNARY P2CALL , P2INT ); +++ return (nl+T4INT); +++ case O_WCLCK: +++ if (argc != 0) { +++ error("%s takes no arguments", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_time" ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2CALL , P2INT ); +++ return (nl+T4INT); +++ case O_EOF: +++ case O_EOLN: +++ if (argc == 0) { +++ argv = tr; +++ tr[1] = tr2; +++ tr2[0] = T_VAR; +++ tr2[2] = input->symbol; +++ tr2[1] = tr2[3] = NIL; +++ argc = 1; +++ } else if (argc != 1) { +++ error("%s takes either zero or one argument", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ } +++ /* +++ * All other functions take +++ * exactly one argument. +++ */ +++ if (argc != 1) { +++ error("%s takes exactly one argument", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ /* +++ * find out the type of the argument +++ */ +++ codeoff(); +++ p1 = stkrval((int *) argv[1], NLNIL , RREQ ); +++ codeon(); +++ if (p1 == NIL) +++ return (NIL); +++ /* +++ * figure out the return type and the funtion name +++ */ +++ switch (op) { +++ case O_EXP: +++ funcname = "_exp"; +++ goto mathfunc; +++ case O_SIN: +++ funcname = "_sin"; +++ goto mathfunc; +++ case O_COS: +++ funcname = "_cos"; +++ goto mathfunc; +++ case O_ATAN: +++ funcname = "_atan"; +++ goto mathfunc; +++ case O_LN: +++ funcname = opt('t') ? "_LN" : "_log"; +++ goto mathfunc; +++ case O_SQRT: +++ funcname = opt('t') ? "_SQRT" : "_sqrt"; +++ goto mathfunc; +++ case O_RANDOM: +++ funcname = "_RANDOM"; +++ goto mathfunc; +++mathfunc: +++ if (isnta(p1, "id")) { +++ error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2DOUBLE , P2PTR ) , funcname ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ if ( isa( p1 , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ putop( P2CALL , P2DOUBLE ); +++ return nl + TDOUBLE; +++ case O_EXPO: +++ if (isnta( p1 , "id" ) ) { +++ error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_EXPO" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ if ( isa( p1 , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ putop( P2CALL , P2INT ); +++ return ( nl + T4INT ); +++ case O_UNDEF: +++ if ( isnta( p1 , "id" ) ) { +++ error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2COMOP , P2INT ); +++ return ( nl + TBOOL ); +++ case O_SEED: +++ if (isnta(p1, "i")) { +++ error("seed's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_SEED" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2INT ); +++ return nl + T4INT; +++ case O_ROUND: +++ case O_TRUNC: +++ if ( isnta( p1 , "d" ) ) { +++ error("%s's argument must be a real, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_ROUND ? "_ROUND" : "_TRUNC" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2INT ); +++ return nl + T4INT; +++ case O_ABS2: +++ if ( isa( p1 , "d" ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2DOUBLE , P2PTR ) +++ , "_fabs" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2DOUBLE ); +++ return nl + TDOUBLE; +++ } +++ if ( isa( p1 , "i" ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_abs" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2INT ); +++ return nl + T4INT; +++ } +++ error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ case O_SQR2: +++ if ( isa( p1 , "d" ) ) { +++ temptype = P2DOUBLE; +++ rettype = nl + TDOUBLE; +++ sizes[ cbn ].om_off -= sizeof( double ); +++ } else if ( isa( p1 , "i" ) ) { +++ temptype = P2INT; +++ rettype = nl + T4INT; +++ sizes[ cbn ].om_off -= sizeof( long ); +++ } else { +++ error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ tempoff = sizes[ cbn ].om_off; +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putlbracket( ftnno , -tempoff ); +++ putRV( 0 , cbn , tempoff , temptype , 0 ); +++ p1 = rvalue( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2ASSIGN , temptype ); +++ putRV( 0 , cbn , tempoff , temptype , 0 ); +++ putRV( 0 , cbn , tempoff , temptype , 0 ); +++ putop( P2MUL , temptype ); +++ putop( P2COMOP , temptype ); +++ return rettype; +++ case O_ORD2: +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ if (isa(p1, "bcis") || classify(p1) == TPTR) { +++ return (nl+T4INT); +++ } +++ error("ord's argument must be of scalar type or a pointer, not %s", nameof(p1)); +++ return (NIL); +++ case O_SUCC2: +++ case O_PRED2: +++ if (isa(p1, "d")) { +++ error("%s is forbidden for reals", p->symbol); +++ return (NIL); +++ } +++ if ( isnta( p1 , "bcsi" ) ) { +++ error("%s's argument must be of scalar type, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_SUCC2 ? "_SUCC" : "_PRED" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putleaf( P2ICON , p1 -> range[0] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , p1 -> range[1] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } else { +++ p1 = rvalue( argv[1] , NIL , RREQ ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( op == O_SUCC2 ? P2PLUS : P2MINUS , P2INT ); +++ } +++ if ( isa( p1 , "bcs" ) ) { +++ return p1; +++ } else { +++ return nl + T4INT; +++ } +++ case O_ODD2: +++ if (isnta(p1, "i")) { +++ error("odd's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ p1 = rvalue( (int *) argv[1] , NLNIL , RREQ ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2AND , P2INT ); +++ return nl + TBOOL; +++ case O_CHR2: +++ if (isnta(p1, "i")) { +++ error("chr's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2CHAR , P2PTR ) , "_CHR" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2CHAR ); +++ } else { +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ } +++ return nl + TCHAR; +++ case O_CARD: +++ if (isnta(p1, "t")) { +++ error("Argument to card must be a set, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_CARD" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , LREQ ); +++ putleaf( P2ICON , lwidth( p1 ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ return nl + T2INT; +++ case O_EOLN: +++ if (!text(p1)) { +++ error("Argument to eoln must be a text file, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_TEOLN" ); +++ p1 = stklval( (int *) argv[1] , NOFLAGS ); +++ putop( P2CALL , P2INT ); +++ return nl + TBOOL; +++ case O_EOF: +++ if (p1->class != FILET) { +++ error("Argument to eof must be file, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_TEOF" ); +++ p1 = stklval( (int *) argv[1] , NOFLAGS ); +++ putop( P2CALL , P2INT ); +++ return nl + TBOOL; +++ case 0: +++ error("%s is an unimplemented 6000-3.4 extension", p->symbol); +++ default: +++ panic("func1"); +++ } +++} +++#endif PC diff --cc usr/src/cmd/pc0/pclval.c index 0000000000,0000000000,0000000000..5beca73d53 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pclval.c @@@@ -1,0 -1,0 -1,0 +1,340 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pclval.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++ /* +++ * and the rest of the file +++ */ +++# include "pc.h" +++# include "pcops.h" +++ +++extern int flagwas; +++/* +++ * pclvalue computes the address +++ * of a qualified name and +++ * leaves it on the stack. +++ * for pc, it can be asked for either an lvalue or an rvalue. +++ * the semantics are the same, only the code is different. +++ * for putting out calls to check for nil and fnil, +++ * we have to traverse the list of qualifications twice: +++ * once to put out the calls and once to put out the address to be checked. +++ */ +++struct nl * +++pclvalue( r , modflag , required ) +++ int *r; +++ int modflag; +++ int required; +++{ +++ register struct nl *p; +++ register *c, *co; +++ int f, o; +++ int tr[2], trp[3]; +++ struct nl *firstp; +++ struct nl *lastp; +++ char *firstsymbol; +++ int firstbn; +++ +++ if ( r == NIL ) { +++ return NIL; +++ } +++ if ( nowexp( r ) ) { +++ return NIL; +++ } +++ if ( r[0] != T_VAR ) { +++ error("Variable required"); /* Pass mesgs down from pt of call ? */ +++ return NIL; +++ } +++ firstp = p = lookup( r[2] ); +++ if ( p == NIL ) { +++ return NIL; +++ } +++ firstsymbol = p -> symbol; +++ firstbn = bn; +++ c = r[3]; +++ if ( ( modflag & NOUSE ) && ! lptr( c ) ) { +++ p -> nl_flags = flagwas; +++ } +++ if ( modflag & MOD ) { +++ p -> nl_flags |= NMOD; +++ } +++ /* +++ * Only possibilities for p -> class here +++ * are the named classes, i.e. CONST, TYPE +++ * VAR, PROC, FUNC, REF, or a WITHPTR. +++ */ +++ if ( p -> class == WITHPTR ) { +++ /* +++ * Construct the tree implied by +++ * the with statement +++ */ +++ trp[0] = T_LISTPP; +++ trp[1] = tr; +++ trp[2] = r[3]; +++ tr[0] = T_FIELD; +++ tr[1] = r[2]; +++ c = trp; +++ } +++ /* +++ * this not only puts out the names of functions to call +++ * but also does all the semantic checking of the qualifications. +++ */ +++ if ( ! nilfnil( p , c , modflag , firstp , r[2] ) ) { +++ return NIL; +++ } +++ switch (p -> class) { +++ case WITHPTR: +++ case REF: +++ /* +++ * Obtain the indirect word +++ * of the WITHPTR or REF +++ * as the base of our lvalue +++ */ +++ putRV( firstsymbol , firstbn , p -> value[ 0 ] +++ , p2type( p ) ); +++ firstsymbol = 0; +++ f = 0; /* have an lv on stack */ +++ o = 0; +++ break; +++ case VAR: +++ f = 1; /* no lv on stack yet */ +++ o = p -> value[0]; +++ break; +++ default: +++ error("%s %s found where variable required", classes[p -> class], p -> symbol); +++ return (NIL); +++ } +++ /* +++ * Loop and handle each +++ * qualification on the name +++ */ +++ if ( c == NIL && ( modflag & ASGN ) && p -> value[ NL_FORV ] ) { +++ error("Can't modify the for variable %s in the range of the loop", p -> symbol); +++ return (NIL); +++ } +++ for ( ; c != NIL ; c = c[2] ) { +++ co = c[1]; +++ if ( co == NIL ) { +++ return NIL; +++ } +++ lastp = p; +++ p = p -> type; +++ if ( p == NIL ) { +++ return NIL; +++ } +++ switch ( co[0] ) { +++ case T_PTR: +++ /* +++ * Pointer qualification. +++ */ +++ if ( f ) { +++ putLV( firstsymbol , firstbn , o +++ , p2type( p ) ); +++ firstsymbol = 0; +++ } else { +++ if (o) { +++ putleaf( P2ICON , o , 0 , P2INT +++ , 0 ); +++ putop( P2PLUS , P2PTR | P2CHAR ); +++ } +++ } +++ /* +++ * Pointer cannot be +++ * nil and file cannot +++ * be at end-of-file. +++ * the appropriate function name is +++ * already out there from nilfnil. +++ */ +++ if ( p -> class == PTR ) { +++ /* +++ * this is the indirection from +++ * the address of the pointer +++ * to the pointer itself. +++ * kirk sez: +++ * fnil doesn't want this. +++ * and does it itself for files +++ * since only it knows where the +++ * actual window is. +++ * but i have to do this for +++ * regular pointers. +++ */ +++ putop( P2UNARY P2MUL , p2type( p ) ); +++ if ( opt( 't' ) ) { +++ putop( P2CALL , P2INT ); +++ } +++ } else { +++ putop( P2CALL , P2INT ); +++ } +++ f = o = 0; +++ continue; +++ case T_ARGL: +++ case T_ARY: +++ if ( f ) { +++ putLV( firstsymbol , firstbn , o +++ , p2type( p ) ); +++ firstsymbol = 0; +++ } else { +++ if (o) { +++ putleaf( P2ICON , o , 0 , P2INT +++ , 0 ); +++ putop( P2PLUS , P2INT ); +++ } +++ } +++ arycod( p , co[1] ); +++ f = o = 0; +++ continue; +++ case T_FIELD: +++ /* +++ * Field names are just +++ * an offset with some +++ * semantic checking. +++ */ +++ p = reclook(p, co[1]); +++ o += p -> value[0]; +++ continue; +++ default: +++ panic("lval2"); +++ } +++ } +++ if (f) { +++ putLV( firstsymbol , firstbn , o , p2type( p -> type ) ); +++ } else { +++ if (o) { +++ putleaf( P2ICON , o , 0 , P2INT , 0 ); +++ putop( P2PLUS , P2INT ); +++ } +++ } +++ if ( required == RREQ ) { +++ putop( P2UNARY P2MUL , p2type( p -> type ) ); +++ } +++ return ( p -> type ); +++} +++ +++ /* +++ * this recursively follows done a list of qualifications +++ * and puts out the beginnings of calls to fnil for files +++ * or nil for pointers (if checking is on) on the way back. +++ * this returns true or false. +++ */ +++nilfnil( p , c , modflag , firstp , r2 ) +++ struct nl *p; +++ int *c; +++ int modflag; +++ struct nl *firstp; +++ char *r2; /* no, not r2-d2 */ +++ { +++ int *co; +++ struct nl *lastp; +++ int t; +++ +++ if ( c == NIL ) { +++ return TRUE; +++ } +++ co = (int *) ( c[1] ); +++ if ( co == NIL ) { +++ return FALSE; +++ } +++ lastp = p; +++ p = p -> type; +++ if ( p == NIL ) { +++ return FALSE; +++ } +++ switch ( co[0] ) { +++ case T_PTR: +++ /* +++ * Pointer qualification. +++ */ +++ lastp -> nl_flags |= NUSED; +++ if ( p -> class != PTR && p -> class != FILET) { +++ error("^ allowed only on files and pointers, not on %ss", nameof(p)); +++ goto bad; +++ } +++ break; +++ case T_ARGL: +++ if ( p -> class != ARRAY ) { +++ if ( lastp == firstp ) { +++ error("%s is a %s, not a function", r2, classes[firstp -> class]); +++ } else { +++ error("Illegal function qualificiation"); +++ } +++ return FALSE; +++ } +++ recovered(); +++ error("Pascal uses [] for subscripting, not ()"); +++ /* and fall through */ +++ case T_ARY: +++ if ( p -> class != ARRAY ) { +++ error("Subscripting allowed only on arrays, not on %ss", nameof(p)); +++ goto bad; +++ } +++ codeoff(); +++ t = arycod( p , co[1] ); +++ codeon(); +++ switch ( t ) { +++ case 0: +++ return FALSE; +++ case -1: +++ goto bad; +++ } +++ break; +++ case T_FIELD: +++ /* +++ * Field names are just +++ * an offset with some +++ * semantic checking. +++ */ +++ if ( p -> class != RECORD ) { +++ error(". allowed only on records, not on %ss", nameof(p)); +++ goto bad; +++ } +++ if ( co[1] == NIL ) { +++ return FALSE; +++ } +++ p = reclook( p , co[1] ); +++ if ( p == NIL ) { +++ error("%s is not a field in this record", co[1]); +++ goto bad; +++ } +++ if ( modflag & MOD ) { +++ p -> nl_flags |= NMOD; +++ } +++ if ( ( modflag & NOUSE ) == 0 || lptr( c[2] ) ) { +++ p -> nl_flags |= NUSED; +++ } +++ break; +++ default: +++ panic("nilfnil"); +++ } +++ /* +++ * recursive call, check the rest of the qualifications. +++ */ +++ if ( ! nilfnil( p , c[2] , modflag , firstp , r2 ) ) { +++ return FALSE; +++ } +++ /* +++ * the point of all this. +++ */ +++ if ( co[0] == T_PTR ) { +++ if ( p -> class == PTR ) { +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_NIL" ); +++ } +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_FNIL" ); +++ } +++ } +++ return TRUE; +++bad: +++ cerror("Error occurred on qualification of %s", r2); +++ return FALSE; +++ } +++#endif PC diff --cc usr/src/cmd/pc0/pcops.h index 0000000000,0000000000,0000000000..c5f15e758a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pcops.h @@@@ -1,0 -1,0 -1,0 +1,144 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)pcops.h 1.1 8/27/80"; */ +++ +++ /* +++ * tree node operators +++ */ +++#define P2UNDEFINED 1 +++#define P2NAME 2 +++#define P2STRING 3 +++#define P2ICON 4 +++#define P2FCON 5 +++#define P2PLUS 6 +++#define P2MINUS 8 /* also unary == P2NEG */ +++#define P2MUL 11 /* also unary == P2INDIRECT */ +++#define P2AND 14 /* also unary */ +++#define P2OR 17 +++#define P2ER 19 +++#define P2QUEST 21 +++#define P2COLON 22 +++#define P2ANDAND 23 +++#define P2OROR 24 +++ /* +++ * yacc operator classes, reserved words, little symbols, etc. +++ * operators 25 .. 57 not used, except 56 +++ */ +++#define P2LISTOP 56 +++#define P2ASSIGN 58 +++#define P2COMOP 59 +++#define P2DIV 60 +++#define P2MOD 62 +++#define P2LS 64 +++#define P2RS 66 +++#define P2DOT 68 +++#define P2STREF 69 +++#define P2CALL 70 /* also unary */ +++#define P2FORTCALL 73 /* also unary */ +++#define P2NOT 76 +++#define P2COMPL 77 +++#define P2INCR 78 +++#define P2DECR 79 +++#define P2EQ 80 +++#define P2NE 81 +++#define P2LE 82 +++#define P2LT 83 +++#define P2GE 84 +++#define P2GT 85 +++#define P2ULE 86 +++#define P2ULT 87 +++#define P2UGE 88 +++#define P2UGT 89 +++#define P2SETBIT 90 +++#define P2TESTBIT 91 +++#define P2RESETBIT 92 +++#define P2ARS 93 +++#define P2REG 94 +++#define P2OREG 95 +++#define P2CCODES 96 +++#define P2FREE 97 +++#define P2STASG 98 +++#define P2STARG 99 +++#define P2STCALL 100 /* also unary */ +++ +++ /* +++ * some conversion operators +++ */ +++#define P2FLD 103 +++#define P2SCONV 104 +++#define P2PCONV 105 +++#define P2PMCONV 106 +++#define P2PVCONV 107 +++ +++ /* +++ * special node operators, used for special contexts +++ */ +++#define P2FORCE 108 +++#define P2CBRANCH 109 +++#define P2INIT 110 +++#define P2CAST 111 +++ +++ /* +++ * prefix unary operator modifier +++ */ +++#define P2ASG 1+ +++#define P2UNARY 2+ +++ +++ /* +++ * these borrowed from /usr/src/cmd/mip/fort.c +++ * to use the binary interface. +++ * only FTEXT, FEXPR, FLBRAC, FRBRAC, and FEOF are used +++ */ +++#define P2FTEXT 200 +++#define P2FEXPR 201 +++#define P2FLBRAC 203 +++#define P2FRBRAC 204 +++#define P2FEOF 205 +++ +++ /* +++ * type names +++ */ +++#define P2UNDEF 0 +++#define P2FARG 1 +++#define P2CHAR 2 +++#define P2SHORT 3 +++#define P2INT 4 /* this is also used for booleans */ +++#define P2LONG 5 /* don't use these, the second pass chokes */ +++#define P2FLOAT 6 +++#define P2DOUBLE 7 +++#define P2STRTY 8 +++#define P2UNIONTY 9 +++#define P2ENUMTY 10 +++#define P2MOETY 11 +++#define P2UCHAR 12 +++#define P2USHORT 13 +++#define P2UNSIGNED 14 +++#define P2ULONG 15 +++ +++ /* +++ * type modifiers +++ */ +++#define P2PTR 020 +++#define P2FTN 040 +++#define P2ARY 060 +++ +++ /* +++ * see the comment for p2type for an explanation of c type words +++ */ +++#define P2BASETYPE 017 +++#define P2TYPESHIFT 2 +++ +++ /* +++ * add a most significant type modifier, m, to a type, t +++ */ +++#define ADDTYPE( t,m ) ( ( ( ( t ) & ~P2BASETYPE ) << P2TYPESHIFT ) \ +++ | ( m ) \ +++ | ( ( t ) & P2BASETYPE ) ) +++ +++ /* +++ * the runtime framepointer and argumentpointer registers +++ */ +++#define P2FP 13 +++#define P2FPNAME "fp" +++#define P2AP 12 +++#define P2APNAME "ap" diff --cc usr/src/cmd/pc0/pcproc.c index 0000000000,0000000000,0000000000..f26b504d62 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pcproc.c @@@@ -1,0 -1,0 -1,0 +1,1449 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pcproc.c 1.3 10/28/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and to the end of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "pc.h" +++#include "pcops.h" +++ +++/* +++ * The following array is used to determine which classes may be read +++ * from textfiles. It is indexed by the return value from classify. +++ */ +++#define rdops(x) rdxxxx[(x)-(TFIRST)] +++ +++int rdxxxx[] = { +++ 0, /* -7 file types */ +++ 0, /* -6 record types */ +++ 0, /* -5 array types */ +++ O_READE, /* -4 scalar types */ +++ 0, /* -3 pointer types */ +++ 0, /* -2 set types */ +++ 0, /* -1 string types */ +++ 0, /* 0 nil, no type */ +++ O_READE, /* 1 boolean */ +++ O_READC, /* 2 character */ +++ O_READ4, /* 3 integer */ +++ O_READ8 /* 4 real */ +++}; +++ +++/* +++ * Proc handles procedure calls. +++ * Non-builtin procedures are "buck-passed" to func (with a flag +++ * indicating that they are actually procedures. +++ * builtin procedures are handled here. +++ */ +++pcproc(r) +++ int *r; +++{ +++ register struct nl *p; +++ register int *alv, *al, op; +++ struct nl *filetype, *ap; +++ int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file; +++ char fmt, format[20], *strptr; +++ int prec, field, strnglen, fmtlen, fmtstart, pu; +++ int *pua, *pui, *puz; +++ int i, j, k; +++ int itemwidth; +++ char *readname; +++ long tempoff; +++ long readtype; +++ +++#define CONPREC 4 +++#define VARPREC 8 +++#define CONWIDTH 1 +++#define VARWIDTH 2 +++#define SKIP 16 +++ +++ /* +++ * Verify that the name is +++ * defined and is that of a +++ * procedure. +++ */ +++ p = lookup(r[2]); +++ if (p == NIL) { +++ rvlist(r[3]); +++ return; +++ } +++ if (p->class != PROC && p->class != FPROC) { +++ error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]); +++ rvlist(r[3]); +++ return; +++ } +++ argv = r[3]; +++ +++ /* +++ * Call handles user defined +++ * procedures and functions. +++ */ +++ if (bn != 0) { +++ call(p, argv, PROC, bn); +++ return; +++ } +++ +++ /* +++ * Call to built-in procedure. +++ * Count the arguments. +++ */ +++ argc = 0; +++ for (al = argv; al != NIL; al = al[2]) +++ argc++; +++ +++ /* +++ * Switch on the operator +++ * associated with the built-in +++ * procedure in the namelist +++ */ +++ op = p->value[0] &~ NSTAND; +++ if (opt('s') && (p->value[0] & NSTAND)) { +++ standard(); +++ error("%s is a nonstandard procedure", p->symbol); +++ } +++ switch (op) { +++ +++ case O_ABORT: +++ if (argc != 0) +++ error("null takes no arguments"); +++ return; +++ +++ case O_FLUSH: +++ if (argc == 0) { +++ putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ } +++ if (argc != 1) { +++ error("flush takes at most one argument"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_FLUSH" ); +++ ap = stklval(argv[1], NOFLAGS); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("flush's argument must be a file, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_MESSAGE: +++ case O_WRITEF: +++ case O_WRITLN: +++ /* +++ * Set up default file "output"'s type +++ */ +++ file = NIL; +++ filetype = nl+T1CHAR; +++ /* +++ * Determine the file implied +++ * for the write and generate +++ * code to make it the active file. +++ */ +++ if (op == O_MESSAGE) { +++ /* +++ * For message, all that matters +++ * is that the filetype is +++ * a character file. +++ * Thus "output" will suit us fine. +++ */ +++ putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "__err" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ } else if (argv != NIL && (al = argv[1])[0] != T_WEXP) { +++ /* +++ * If there is a first argument which has +++ * no write widths, then it is potentially +++ * a file name. +++ */ +++ codeoff(); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ argv = argv[2]; +++ if (ap != NIL && ap->class == FILET) { +++ /* +++ * Got "write(f, ...", make +++ * f the active file, and save +++ * it and its type for use in +++ * processing the rest of the +++ * arguments to write. +++ */ +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ file = argv[1]; +++ filetype = ap->type; +++ stklval(argv[1], NOFLAGS); +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ /* +++ * Skip over the first argument +++ */ +++ argv = argv[2]; +++ argc--; +++ } else { +++ /* +++ * Set up for writing on +++ * standard output. +++ */ +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_output" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ } +++ } else { +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_output" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ } +++ /* +++ * Loop and process each +++ * of the arguments. +++ */ +++ for (; argv != NIL; argv = argv[2]) { +++ /* +++ * fmtspec indicates the type (CONstant or VARiable) +++ * and number (none, WIDTH, and/or PRECision) +++ * of the fields in the printf format for this +++ * output variable. +++ * stkcnt is the number of longs pushed on the stack +++ * fmt is the format output indicator (D, E, F, O, X, S) +++ * fmtstart = 0 for leading blank; = 1 for no blank +++ */ +++ fmtspec = NIL; +++ stkcnt = 0; +++ fmt = 'D'; +++ fmtstart = 1; +++ al = argv[1]; +++ if (al == NIL) +++ continue; +++ if (al[0] == T_WEXP) +++ alv = al[1]; +++ else +++ alv = al; +++ if (alv == NIL) +++ continue; +++ codeoff(); +++ ap = stkrval(alv, NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ continue; +++ typ = classify(ap); +++ if (al[0] == T_WEXP) { +++ /* +++ * Handle width expressions. +++ * The basic game here is that width +++ * expressions get evaluated. If they +++ * are constant, the value is placed +++ * directly in the format string. +++ * Otherwise the value is pushed onto +++ * the stack and an indirection is +++ * put into the format string. +++ */ +++ if (al[3] == OCT) +++ fmt = 'O'; +++ else if (al[3] == HEX) +++ fmt = 'X'; +++ else if (al[3] != NIL) { +++ /* +++ * Evaluate second format spec +++ */ +++ if ( constval(al[3]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONPREC; +++ prec = con.crval; +++ } else { +++ fmtspec += VARPREC; +++ } +++ fmt = 'f'; +++ switch ( typ ) { +++ case TINT: +++ if ( opt( 's' ) ) { +++ standard(); +++ error("Writing %ss with two write widths is non-standard", clnames[typ]); +++ } +++ /* and fall through */ +++ case TDOUBLE: +++ break; +++ default: +++ error("Cannot write %ss with two write widths", clnames[typ]); +++ continue; +++ } +++ } +++ /* +++ * Evaluate first format spec +++ */ +++ if (al[2] != NIL) { +++ if ( constval(al[2]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONWIDTH; +++ field = con.crval; +++ } else { +++ fmtspec += VARWIDTH; +++ } +++ } +++ if ((fmtspec & CONPREC) && prec < 0 || +++ (fmtspec & CONWIDTH) && field < 0) { +++ error("Negative widths are not allowed"); +++ continue; +++ } +++ } +++ if (filetype != nl+T1CHAR) { +++ if (fmt == 'O' || fmt == 'X') { +++ error("Oct/hex allowed only on text files"); +++ continue; +++ } +++ if (fmtspec) { +++ error("Write widths allowed only on text files"); +++ continue; +++ } +++ /* +++ * Generalized write, i.e. +++ * to a non-textfile. +++ */ +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( +++ ADDTYPE( +++ ADDTYPE( p2type( filetype ) +++ , P2PTR ) +++ , P2FTN ) +++ , P2PTR ) +++ , "_FNIL" ); +++ stklval(file, NOFLAGS); +++ putop( P2CALL +++ , ADDTYPE( p2type( filetype ) , P2PTR ) ); +++ putop( P2UNARY P2MUL , p2type( filetype ) ); +++ /* +++ * file^ := ... +++ */ +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ precheck( filetype , "_RANG4" , "_RSGN4" ); +++ /* and fall through */ +++ case TDOUBLE: +++ case TPTR: +++ ap = rvalue( argv[1] , filetype , RREQ ); +++ break; +++ default: +++ ap = rvalue( argv[1] , filetype , LREQ ); +++ break; +++ } +++ if (ap == NIL) +++ continue; +++ if (incompat(ap, filetype, argv[1])) { +++ cerror("Type mismatch in write to non-text file"); +++ continue; +++ } +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ postcheck( filetype ); +++ /* and fall through */ +++ case TDOUBLE: +++ case TPTR: +++ putop( P2ASSIGN , p2type( filetype ) ); +++ putdot( filename , line ); +++ break; +++ default: +++ putstrop( P2STASG +++ , p2type( filetype ) +++ , lwidth( filetype ) +++ , align( filetype ) ); +++ putdot( filename , line ); +++ break; +++ } +++ /* +++ * put(file) +++ */ +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PUT" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ continue; +++ } +++ /* +++ * Write to a textfile +++ * +++ * Evaluate the expression +++ * to be written. +++ */ +++ if (fmt == 'O' || fmt == 'X') { +++ if (opt('s')) { +++ standard(); +++ error("Oct and hex are non-standard"); +++ } +++ if (typ == TSTR || typ == TDOUBLE) { +++ error("Can't write %ss with oct/hex", clnames[typ]); +++ continue; +++ } +++ if (typ == TCHAR || typ == TBOOL) +++ typ = TINT; +++ } +++ /* +++ * If there is no format specified by the programmer, +++ * implement the default. +++ */ +++ switch (typ) { +++ case TINT: +++ if (fmt == 'f') { +++ typ = TDOUBLE; +++ goto tdouble; +++ } +++ if (fmtspec == NIL) { +++ if (fmt == 'D') +++ field = 10; +++ else if (fmt == 'X') +++ field = 8; +++ else if (fmt == 'O') +++ field = 11; +++ else +++ panic("fmt1"); +++ fmtspec = CONWIDTH; +++ } +++ break; +++ case TCHAR: +++ tchar: +++ fmt = 'c'; +++ break; +++ case TSCAL: +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Writing scalars to text files is non-standard"); +++ case TBOOL: +++ fmt = 's'; +++ break; +++ case TDOUBLE: +++ tdouble: +++ switch (fmtspec) { +++ case NIL: +++ field = 21; +++ prec = 14; +++ fmt = 'E'; +++ fmtspec = CONWIDTH + CONPREC; +++ break; +++ case CONWIDTH: +++ if (--field < 1) +++ field = 1; +++ prec = field - 7; +++ if (prec < 1) +++ prec = 1; +++ fmtspec += CONPREC; +++ fmt = 'E'; +++ break; +++ case VARWIDTH: +++ fmtspec += VARPREC; +++ fmt = 'E'; +++ break; +++ case CONWIDTH + CONPREC: +++ case CONWIDTH + VARPREC: +++ if (--field < 1) +++ field = 1; +++ } +++ format[0] = ' '; +++ fmtstart = 0; +++ break; +++ case TSTR: +++ constval( alv ); +++ switch ( classify( con.ctype ) ) { +++ case TCHAR: +++ typ = TCHAR; +++ goto tchar; +++ case TSTR: +++ strptr = con.cpval; +++ for (strnglen = 0; *strptr++; strnglen++) /* void */; +++ strptr = con.cpval; +++ break; +++ default: +++ strnglen = width(ap); +++ break; +++ } +++ fmt = 's'; +++ strfmt = fmtspec; +++ if (fmtspec == NIL) { +++ fmtspec = SKIP; +++ break; +++ } +++ if (fmtspec & CONWIDTH) { +++ if (field <= strnglen) +++ fmtspec = SKIP; +++ else +++ field -= strnglen; +++ } +++ break; +++ default: +++ error("Can't write %ss to a text file", clnames[typ]); +++ continue; +++ } +++ /* +++ * Generate the format string +++ */ +++ switch (fmtspec) { +++ default: +++ panic("fmt2"); +++ case NIL: +++ if (fmt == 'c') { +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN|P2INT , P2PTR ) +++ , "_WRITEC" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ stkrval( alv , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN|P2INT , P2PTR ) +++ , "_fputc" ); +++ stkrval( alv , NIL , RREQ ); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0, cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else { +++ sprintf(&format[1], "%%%c", fmt); +++ goto fmtgen; +++ } +++ case SKIP: +++ break; +++ case CONWIDTH: +++ sprintf(&format[1], "%%%1D%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH: +++ sprintf(&format[1], "%%*%c", fmt); +++ goto fmtgen; +++ case CONWIDTH + CONPREC: +++ sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt); +++ goto fmtgen; +++ case CONWIDTH + VARPREC: +++ sprintf(&format[1], "%%%1D.*%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH + CONPREC: +++ sprintf(&format[1], "%%*.%1D%c", prec, fmt); +++ goto fmtgen; +++ case VARWIDTH + VARPREC: +++ sprintf(&format[1], "%%*.*%c", fmt); +++ fmtgen: +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_WRITEF" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fprintf" ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ } +++ putCONG( &format[ fmtstart ] +++ , strlen( &format[ fmtstart ] ) +++ , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ if ( fmtspec & VARWIDTH ) { +++ /* +++ * either +++ * ,(temp=width,MAX(temp,...)), +++ * or +++ * , MAX( width , ... ) , +++ */ +++ if ( ( typ == TDOUBLE && al[3] == NIL ) +++ || typ == TSTR ) { +++ sizes[ cbn ].om_off -= sizeof( int ); +++ tempoff = sizes[ cbn ].om_off; +++ putlbracket( ftnno , -tempoff ); +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putRV( 0 , cbn , tempoff , P2INT ); +++ ap = stkrval( al[2] , NIL , RREQ ); +++ putop( P2ASSIGN , P2INT ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_MAX" ); +++ putRV( 0 , cbn , tempoff , P2INT ); +++ } else { +++ if (opt('t') +++ || typ == TSTR || typ == TDOUBLE) { +++ putleaf( P2ICON , 0 , 0 +++ ,ADDTYPE( P2FTN | P2INT, P2PTR ) +++ ,"_MAX" ); +++ } +++ ap = stkrval( al[2] , NIL , RREQ ); +++ } +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("First write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ switch ( typ ) { +++ case TDOUBLE: +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ if ( al[3] == NIL ) { +++ /* +++ * finish up the comma op +++ */ +++ putop( P2COMOP , P2INT ); +++ fmtspec &= ~VARPREC; +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_MAX" ); +++ putRV( 0 , cbn , tempoff , P2INT ); +++ sizes[ cbn ].om_off += sizeof( int ); +++ putleaf( P2ICON , 8 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TSTR: +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putop( P2COMOP , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ default: +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putop( P2LISTOP , P2INT ); +++ break; +++ } +++ } +++ /* +++ * If there is a variable precision, +++ * evaluate it +++ */ +++ if (fmtspec & VARPREC) { +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_MAX" ); +++ } +++ ap = stkrval( al[3] , NIL , RREQ ); +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("Second write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putop( P2LISTOP , P2INT ); +++ } +++ /* +++ * evaluate the thing we want printed. +++ */ +++ switch ( typ ) { +++ case TCHAR: +++ case TINT: +++ stkrval( alv , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TDOUBLE: +++ ap = stkrval( alv , NIL , RREQ ); +++ if ( isnta( ap , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TSCAL: +++ case TBOOL: +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_NAM" ); +++ ap = stkrval( alv , NIL , RREQ ); +++ sprintf( format , PREFIXFORMAT , LABELPREFIX +++ , listnames( ap ) ); +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR +++ , format ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TSTR: +++ putCONG( "" , 0 , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ /* +++ * Write the string after its blank padding +++ */ +++ if (typ == TSTR ) { +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_WRITES" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ ap = stkrval(alv, NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fwrite" ); +++ ap = stkrval(alv, NIL , RREQ ); +++ } +++ if (strfmt & VARWIDTH) { +++ /* +++ * min, inline expanded as +++ * temp < len ? temp : len +++ */ +++ putRV( 0 , cbn , tempoff , P2INT ); +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2LT , P2INT ); +++ putRV( 0 , cbn , tempoff , P2INT ); +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2COLON , P2INT ); +++ putop( P2QUEST , P2INT ); +++ } else { +++ if ( ( fmtspec & SKIP ) +++ && ( strfmt & CONWIDTH ) ) { +++ strnglen = field; +++ } +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++ /* +++ * Done with arguments. +++ * Handle writeln and +++ * insufficent number of args. +++ */ +++ switch (p->value[0] &~ NSTAND) { +++ case O_WRITEF: +++ if (argc == 0) +++ error("Write requires an argument"); +++ break; +++ case O_MESSAGE: +++ if (argc == 0) +++ error("Message requires an argument"); +++ case O_WRITLN: +++ if (filetype != nl+T1CHAR) +++ error("Can't 'writeln' a non text file"); +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_WRITLN" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fputc" ); +++ putleaf( P2ICON , '\n' , 0 , P2CHAR , 0 ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ break; +++ } +++ return; +++ +++ case O_READ4: +++ case O_READLN: +++ /* +++ * Set up default +++ * file "input". +++ */ +++ file = NIL; +++ filetype = nl+T1CHAR; +++ /* +++ * Determine the file implied +++ * for the read and generate +++ * code to make it the active file. +++ */ +++ if (argv != NIL) { +++ codeoff(); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ argv = argv[2]; +++ if (ap != NIL && ap->class == FILET) { +++ /* +++ * Got "read(f, ...", make +++ * f the active file, and save +++ * it and its type for use in +++ * processing the rest of the +++ * arguments to read. +++ */ +++ file = argv[1]; +++ filetype = ap->type; +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ stklval(argv[1], NOFLAGS); +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ argv = argv[2]; +++ argc--; +++ } else { +++ /* +++ * Default is read from +++ * standard input. +++ */ +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_input" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ input->nl_flags |= NUSED; +++ } +++ } else { +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_input" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ input->nl_flags |= NUSED; +++ } +++ /* +++ * Loop and process each +++ * of the arguments. +++ */ +++ for (; argv != NIL; argv = argv[2]) { +++ /* +++ * Get the address of the target +++ * on the stack. +++ */ +++ al = argv[1]; +++ if (al == NIL) +++ continue; +++ if (al[0] != T_VAR) { +++ error("Arguments to %s must be variables, not expressions", p->symbol); +++ continue; +++ } +++ codeoff(); +++ ap = stklval(al, MOD|ASGN|NOUSE); +++ codeon(); +++ if (ap == NIL) +++ continue; +++ if (filetype != nl+T1CHAR) { +++ /* +++ * Generalized read, i.e. +++ * from a non-textfile. +++ */ +++ if (incompat(filetype, ap, argv[1] )) { +++ error("Type mismatch in read from non-text file"); +++ continue; +++ } +++ /* +++ * var := file ^; +++ */ +++ ap = lvalue( al , MOD | ASGN | NOUSE , RREQ ); +++ if ( isa( ap , "bsci" ) ) { +++ precheck( ap , "_RANG4" , "_RSNG4" ); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( +++ ADDTYPE( +++ ADDTYPE( +++ p2type( filetype ) , P2PTR ) +++ , P2FTN ) +++ , P2PTR ) +++ , "_FNIL" ); +++ if (file != NIL) +++ stklval(file, NOFLAGS); +++ else /* Magic */ +++ putRV( "_input" , 0 , 0 +++ , P2PTR | P2STRTY ); +++ putop( P2CALL , P2INT ); +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ case TDOUBLE: +++ case TPTR: +++ putop( P2UNARY P2MUL +++ , p2type( filetype ) ); +++ } +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ postcheck( ap ); +++ /* and fall through */ +++ case TDOUBLE: +++ case TPTR: +++ putop( P2ASSIGN , p2type( ap ) ); +++ putdot( filename , line ); +++ break; +++ default: +++ putstrop( P2STASG +++ , p2type( ap ) +++ , lwidth( ap ) +++ , align( ap ) ); +++ putdot( filename , line ); +++ break; +++ } +++ /* +++ * get(file); +++ */ +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_GET" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ continue; +++ } +++ /* +++ * if you get to here, you are reading from +++ * a text file. only possiblities are: +++ * character, integer, real, or scalar. +++ * read( f , foo , ... ) is done as +++ * foo := read( f ) with rangechecking +++ * if appropriate. +++ */ +++ typ = classify(ap); +++ op = rdops(typ); +++ if (op == NIL) { +++ error("Can't read %ss from a text file", clnames[typ]); +++ continue; +++ } +++ /* +++ * left hand side of foo := read( f ) +++ */ +++ ap = lvalue( al , MOD|ASGN|NOUSE , RREQ ); +++ if ( isa( ap , "bsci" ) ) { +++ precheck( ap , "_RANG4" , "_RSNG4" ); +++ } +++ switch ( op ) { +++ case O_READC: +++ readname = "_READC"; +++ readtype = P2INT; +++ break; +++ case O_READ4: +++ readname = "_READ4"; +++ readtype = P2INT; +++ break; +++ case O_READ8: +++ readname = "_READ8"; +++ readtype = P2DOUBLE; +++ break; +++ case O_READE: +++ readname = "_READE"; +++ readtype = P2INT; +++ break; +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | readtype , P2PTR ) +++ , readname ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ if ( op == O_READE ) { +++ sprintf( format , PREFIXFORMAT , LABELPREFIX +++ , listnames( ap ) ); +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR +++ , format ); +++ putop( P2LISTOP , P2INT ); +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Reading scalars from text files is non-standard"); +++ } +++ putop( P2CALL , readtype ); +++ if ( isa( ap , "bcsi" ) ) { +++ postcheck( ap ); +++ } +++ putop( P2ASSIGN , p2type( ap ) ); +++ putdot( filename , line ); +++ } +++ /* +++ * Done with arguments. +++ * Handle readln and +++ * insufficient number of args. +++ */ +++ if (p->value[0] == O_READLN) { +++ if (filetype != nl+T1CHAR) +++ error("Can't 'readln' a non text file"); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_READLN" ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else if (argc == 0) +++ error("read requires an argument"); +++ return; +++ +++ case O_GET: +++ case O_PUT: +++ if (argc != 1) { +++ error("%s expects one argument", p->symbol); +++ return; +++ } +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ ap = stklval(argv[1], NOFLAGS); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("Argument to %s must be a file, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_GET ? "_GET" : "_PUT" ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_RESET: +++ case O_REWRITE: +++ if (argc == 0 || argc > 2) { +++ error("%s expects one or two arguments", p->symbol); +++ return; +++ } +++ if (opt('s') && argc == 2) { +++ standard(); +++ error("Two argument forms of reset and rewrite are non-standard"); +++ } +++ putleaf( P2ICON , 0 , 0 , P2INT +++ , op == O_RESET ? "_RESET" : "_REWRITE" ); +++ ap = stklval(argv[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("First argument to %s must be a file, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ if (argc == 2) { +++ /* +++ * Optional second argument +++ * is a string name of a +++ * UNIX (R) file to be associated. +++ */ +++ al = argv[2]; +++ al = stkrval(al[1], NOFLAGS , RREQ ); +++ if (al == NIL) +++ return; +++ if (classify(al) != TSTR) { +++ error("Second argument to %s must be a string, not %s", p->symbol, nameof(al)); +++ return; +++ } +++ strnglen = width(al); +++ } else { +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ strnglen = 0; +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , text(ap) ? 0: width(ap->type) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_NEW: +++ case O_DISPOSE: +++ if (argc == 0) { +++ error("%s expects at least one argument", p->symbol); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_DISPOSE ? "_DISPOSE" : +++ opt('t') ? "_NEWZ" : "_NEW" ); +++ ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD ); +++ if (ap == NIL) +++ return; +++ if (ap->class != PTR) { +++ error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ ap = ap->type; +++ if (ap == NIL) +++ return; +++ argv = argv[2]; +++ if (argv != NIL) { +++ if (ap->class != RECORD) { +++ error("Record required when specifying variant tags"); +++ return; +++ } +++ for (; argv != NIL; argv = argv[2]) { +++ if (ap->ptr[NL_VARNT] == NIL) { +++ error("Too many tag fields"); +++ return; +++ } +++ if (!isconst(argv[1])) { +++ error("Second and successive arguments to %s must be constants", p->symbol); +++ return; +++ } +++ gconst(argv[1]); +++ if (con.ctype == NIL) +++ return; +++ if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) { +++ cerror("Specified tag constant type clashed with variant case selector type"); +++ return; +++ } +++ for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain) +++ if (ap->range[0] == con.crval) +++ break; +++ if (ap == NIL) { +++ error("No variant case label value equals specified constant value"); +++ return; +++ } +++ ap = ap->ptr[NL_VTOREC]; +++ } +++ } +++ putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_DATE: +++ case O_TIME: +++ if (argc != 1) { +++ error("%s expects one argument", p->symbol); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_DATE ? "_DATE" : "_TIME" ); +++ ap = stklval(argv[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR || width(ap) != 10) { +++ error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_HALT: +++ if (argc != 0) { +++ error("halt takes no arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_HALT" ); +++ +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ noreach = 1; +++ return; +++ +++ case O_ARGV: +++ if (argc != 2) { +++ error("argv takes two arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ARGV" ); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("argv's first argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ al = argv[2]; +++ ap = stklval(al[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR) { +++ error("argv's second argument must be a string, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_STLIM: +++ if (argc != 1) { +++ error("stlimit requires one argument"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_STLIM" ); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("stlimit's argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_REMOVE: +++ if (argc != 1) { +++ error("remove expects one argument"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_REMOVE" ); +++ ap = stkrval(argv[1], NOFLAGS , RREQ ); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR) { +++ error("remove's argument must be a string, not %s", nameof(ap)); +++ return; +++ } +++ putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_LLIMIT: +++ if (argc != 2) { +++ error("linelimit expects two arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_LLIMIT" ); +++ ap = stklval(argv[1], NOFLAGS|NOUSE); +++ if (ap == NIL) +++ return; +++ if (!text(ap)) { +++ error("linelimit's first argument must be a text file, not %s", nameof(ap)); +++ return; +++ } +++ al = argv[2]; +++ ap = stkrval(al[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("linelimit's second argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ case O_PAGE: +++ if (argc != 1) { +++ error("page expects one argument"); +++ return; +++ } +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ ap = stklval(argv[1], NOFLAGS); +++ if (ap == NIL) +++ return; +++ if (!text(ap)) { +++ error("Argument to page must be a text file, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PAGE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fputc" ); +++ putleaf( P2ICON , '\f' , 0 , P2CHAR , 0 ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_PACK: +++ if (argc != 3) { +++ error("pack expects three arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PACK" ); +++ pu = "pack(a,i,z)"; +++ pua = (al = argv)[1]; +++ pui = (al = al[2])[1]; +++ puz = (al = al[2])[1]; +++ goto packunp; +++ case O_UNPACK: +++ if (argc != 3) { +++ error("unpack expects three arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNPACK" ); +++ pu = "unpack(z,a,i)"; +++ puz = (al = argv)[1]; +++ pua = (al = al[2])[1]; +++ pui = (al = al[2])[1]; +++packunp: +++ ap = stkrval((int *) pui, NLNIL , RREQ ); +++ if (ap == NIL) +++ return; +++ ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (ap->class != ARRAY) { +++ error("%s requires a to be an unpacked array, not %s", pu, nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE); +++ if (al->class != ARRAY) { +++ error("%s requires z to be a packed array, not %s", pu, nameof(ap)); +++ return; +++ } +++ if (al->type == NIL || ap->type == NIL) +++ return; +++ if (al->type != ap->type) { +++ error("%s requires a and z to be arrays of the same type", pu, nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ k = width(al); +++ itemwidth = width(ap->type); +++ ap = ap->chain; +++ al = al->chain; +++ if (ap->chain != NIL || al->chain != NIL) { +++ error("%s requires a and z to be single dimension arrays", pu); +++ return; +++ } +++ if (ap == NIL || al == NIL) +++ return; +++ /* +++ * al is the range for z i.e. u..v +++ * ap is the range for a i.e. m..n +++ * i will be n-m+1 +++ * j will be v-u+1 +++ */ +++ i = ap->range[1] - ap->range[0] + 1; +++ j = al->range[1] - al->range[0] + 1; +++ if (i < j) { +++ error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i); +++ return; +++ } +++ /* +++ * get n-m-(v-u) and m for the interpreter +++ */ +++ i -= j; +++ j = ap->range[0]; +++ putleaf( P2ICON , itemwidth , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , j , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , i , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , k , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ case 0: +++ error("%s is an unimplemented 6400 extension", p->symbol); +++ return; +++ +++ default: +++ panic("proc case"); +++ } +++} +++#endif PC diff --cc usr/src/cmd/pc0/proc.c index 0000000000,0000000000,0000000000..ab9820a48d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/proc.c @@@@ -1,0 -1,0 -1,0 +1,1029 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)proc.c 1.3 10/28/80"; +++ +++#include "whoami.h" +++#ifdef OBJ +++ /* +++ * and the rest of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++ +++/* +++ * The following array is used to determine which classes may be read +++ * from textfiles. It is indexed by the return value from classify. +++ */ +++#define rdops(x) rdxxxx[(x)-(TFIRST)] +++ +++int rdxxxx[] = { +++ 0, /* -7 file types */ +++ 0, /* -6 record types */ +++ 0, /* -5 array types */ +++ O_READE, /* -4 scalar types */ +++ 0, /* -3 pointer types */ +++ 0, /* -2 set types */ +++ 0, /* -1 string types */ +++ 0, /* 0 nil, no type */ +++ O_READE, /* 1 boolean */ +++ O_READC, /* 2 character */ +++ O_READ4, /* 3 integer */ +++ O_READ8 /* 4 real */ +++}; +++ +++/* +++ * Proc handles procedure calls. +++ * Non-builtin procedures are "buck-passed" to func (with a flag +++ * indicating that they are actually procedures. +++ * builtin procedures are handled here. +++ */ +++proc(r) +++ int *r; +++{ +++ register struct nl *p; +++ register int *alv, *al, op; +++ struct nl *filetype, *ap; +++ int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file; +++ char fmt, format[20], *strptr; +++ int prec, field, strnglen, fmtlen, fmtstart, pu; +++ int *pua, *pui, *puz; +++ int i, j, k; +++ int itemwidth; +++ +++#define CONPREC 4 +++#define VARPREC 8 +++#define CONWIDTH 1 +++#define VARWIDTH 2 +++#define SKIP 16 +++ +++ /* +++ * Verify that the name is +++ * defined and is that of a +++ * procedure. +++ */ +++ p = lookup(r[2]); +++ if (p == NIL) { +++ rvlist(r[3]); +++ return; +++ } +++ if (p->class != PROC && p->class != FPROC) { +++ error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]); +++ rvlist(r[3]); +++ return; +++ } +++ argv = r[3]; +++ +++ /* +++ * Call handles user defined +++ * procedures and functions. +++ */ +++ if (bn != 0) { +++ call(p, argv, PROC, bn); +++ return; +++ } +++ +++ /* +++ * Call to built-in procedure. +++ * Count the arguments. +++ */ +++ argc = 0; +++ for (al = argv; al != NIL; al = al[2]) +++ argc++; +++ +++ /* +++ * Switch on the operator +++ * associated with the built-in +++ * procedure in the namelist +++ */ +++ op = p->value[0] &~ NSTAND; +++ if (opt('s') && (p->value[0] & NSTAND)) { +++ standard(); +++ error("%s is a nonstandard procedure", p->symbol); +++ } +++ switch (op) { +++ +++ case O_ABORT: +++ if (argc != 0) +++ error("null takes no arguments"); +++ return; +++ +++ case O_FLUSH: +++ if (argc == 0) { +++ put(1, O_MESSAGE); +++ return; +++ } +++ if (argc != 1) { +++ error("flush takes at most one argument"); +++ return; +++ } +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("flush's argument must be a file, not %s", nameof(ap)); +++ return; +++ } +++ put(1, op); +++ return; +++ +++ case O_MESSAGE: +++ case O_WRITEF: +++ case O_WRITLN: +++ /* +++ * Set up default file "output"'s type +++ */ +++ file = NIL; +++ filetype = nl+T1CHAR; +++ /* +++ * Determine the file implied +++ * for the write and generate +++ * code to make it the active file. +++ */ +++ if (op == O_MESSAGE) { +++ /* +++ * For message, all that matters +++ * is that the filetype is +++ * a character file. +++ * Thus "output" will suit us fine. +++ */ +++ put(1, O_MESSAGE); +++ } else if (argv != NIL && (al = argv[1])[0] != T_WEXP) { +++ /* +++ * If there is a first argument which has +++ * no write widths, then it is potentially +++ * a file name. +++ */ +++ codeoff(); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ argv = argv[2]; +++ if (ap != NIL && ap->class == FILET) { +++ /* +++ * Got "write(f, ...", make +++ * f the active file, and save +++ * it and its type for use in +++ * processing the rest of the +++ * arguments to write. +++ */ +++ file = argv[1]; +++ filetype = ap->type; +++ stkrval(argv[1], NIL , RREQ ); +++ put(1, O_UNIT); +++ /* +++ * Skip over the first argument +++ */ +++ argv = argv[2]; +++ argc--; +++ } else +++ /* +++ * Set up for writing on +++ * standard output. +++ */ +++ put(1, O_UNITOUT); +++ } else +++ put(1, O_UNITOUT); +++ /* +++ * Loop and process each +++ * of the arguments. +++ */ +++ for (; argv != NIL; argv = argv[2]) { +++ /* +++ * fmtspec indicates the type (CONstant or VARiable) +++ * and number (none, WIDTH, and/or PRECision) +++ * of the fields in the printf format for this +++ * output variable. +++ * stkcnt is the number of longs pushed on the stack +++ * fmt is the format output indicator (D, E, F, O, X, S) +++ * fmtstart = 0 for leading blank; = 1 for no blank +++ */ +++ fmtspec = NIL; +++ stkcnt = 0; +++ fmt = 'D'; +++ fmtstart = 1; +++ al = argv[1]; +++ if (al == NIL) +++ continue; +++ if (al[0] == T_WEXP) +++ alv = al[1]; +++ else +++ alv = al; +++ if (alv == NIL) +++ continue; +++ codeoff(); +++ ap = stkrval(alv, NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ continue; +++ typ = classify(ap); +++ if (al[0] == T_WEXP) { +++ /* +++ * Handle width expressions. +++ * The basic game here is that width +++ * expressions get evaluated. If they +++ * are constant, the value is placed +++ * directly in the format string. +++ * Otherwise the value is pushed onto +++ * the stack and an indirection is +++ * put into the format string. +++ */ +++ if (al[3] == OCT) +++ fmt = 'O'; +++ else if (al[3] == HEX) +++ fmt = 'X'; +++ else if (al[3] != NIL) { +++ /* +++ * Evaluate second format spec +++ */ +++ if ( constval(al[3]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONPREC; +++ prec = con.crval; +++ } else { +++ fmtspec += VARPREC; +++ } +++ fmt = 'f'; +++ switch ( typ ) { +++ case TINT: +++ if ( opt( 's' ) ) { +++ standard(); +++ error("Writing %ss with two write widths is non-standard", clnames[typ]); +++ } +++ /* and fall through */ +++ case TDOUBLE: +++ break; +++ default: +++ error("Cannot write %ss with two write widths", clnames[typ]); +++ continue; +++ } +++ } +++ /* +++ * Evaluate first format spec +++ */ +++ if (al[2] != NIL) { +++ if ( constval(al[2]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONWIDTH; +++ field = con.crval; +++ } else { +++ fmtspec += VARWIDTH; +++ } +++ } +++ if ((fmtspec & CONPREC) && prec < 0 || +++ (fmtspec & CONWIDTH) && field < 0) { +++ error("Negative widths are not allowed"); +++ continue; +++ } +++ } +++ if (filetype != nl+T1CHAR) { +++ if (fmt == 'O' || fmt == 'X') { +++ error("Oct/hex allowed only on text files"); +++ continue; +++ } +++ if (fmtspec) { +++ error("Write widths allowed only on text files"); +++ continue; +++ } +++ /* +++ * Generalized write, i.e. +++ * to a non-textfile. +++ */ +++ stkrval(file, NIL , RREQ ); +++ put(1, O_FNIL); +++ /* +++ * file^ := ... +++ */ +++ ap = rvalue(argv[1], NIL); +++ if (ap == NIL) +++ continue; +++ if (incompat(ap, filetype, argv[1])) { +++ cerror("Type mismatch in write to non-text file"); +++ continue; +++ } +++ convert(ap, filetype); +++ put(2, O_AS, width(filetype)); +++ /* +++ * put(file) +++ */ +++ put(1, O_PUT); +++ continue; +++ } +++ /* +++ * Write to a textfile +++ * +++ * Evaluate the expression +++ * to be written. +++ */ +++ if (fmt == 'O' || fmt == 'X') { +++ if (opt('s')) { +++ standard(); +++ error("Oct and hex are non-standard"); +++ } +++ if (typ == TSTR || typ == TDOUBLE) { +++ error("Can't write %ss with oct/hex", clnames[typ]); +++ continue; +++ } +++ if (typ == TCHAR || typ == TBOOL) +++ typ = TINT; +++ } +++ /* +++ * Place the arguement on the stack. If there is +++ * no format specified by the programmer, implement +++ * the default. +++ */ +++ switch (typ) { +++ case TINT: +++ if (fmt != 'f') { +++ ap = stkrval(alv, NIL , RREQ ); +++ stkcnt++; +++ } else { +++ ap = stkrval(alv, NIL , RREQ ); +++ put(1, O_ITOD); +++ stkcnt += 2; +++ typ = TDOUBLE; +++ goto tdouble; +++ } +++ if (fmtspec == NIL) { +++ if (fmt == 'D') +++ field = 10; +++ else if (fmt == 'X') +++ field = 8; +++ else if (fmt == 'O') +++ field = 11; +++ else +++ panic("fmt1"); +++ fmtspec = CONWIDTH; +++ } +++ break; +++ case TCHAR: +++ tchar: +++ ap = stkrval(alv, NIL , RREQ ); +++ stkcnt++; +++ fmt = 'c'; +++ break; +++ case TSCAL: +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Writing scalars to text files is non-standard"); +++ case TBOOL: +++ stkrval(alv, NIL , RREQ ); +++ put(2, O_NAM, listnames(ap)); +++ stkcnt++; +++ fmt = 's'; +++ break; +++ case TDOUBLE: +++ ap = stkrval(alv, TDOUBLE , RREQ ); +++ stkcnt += 2; +++ tdouble: +++ switch (fmtspec) { +++ case NIL: +++ field = 21; +++ prec = 14; +++ fmt = 'E'; +++ fmtspec = CONWIDTH + CONPREC; +++ break; +++ case CONWIDTH: +++ if (--field < 1) +++ field = 1; +++ prec = field - 7; +++ if (prec < 1) +++ prec = 1; +++ fmtspec += CONPREC; +++ fmt = 'E'; +++ break; +++ case CONWIDTH + CONPREC: +++ case CONWIDTH + VARPREC: +++ if (--field < 1) +++ field = 1; +++ } +++ format[0] = ' '; +++ fmtstart = 0; +++ break; +++ case TSTR: +++ constval( alv ); +++ switch ( classify( con.ctype ) ) { +++ case TCHAR: +++ typ = TCHAR; +++ goto tchar; +++ case TSTR: +++ strptr = con.cpval; +++ for (strnglen = 0; *strptr++; strnglen++) /* void */; +++ strptr = con.cpval; +++ break; +++ default: +++ strnglen = width(ap); +++ break; +++ } +++ fmt = 's'; +++ strfmt = fmtspec; +++ if (fmtspec == NIL) { +++ fmtspec = SKIP; +++ break; +++ } +++ if (fmtspec & CONWIDTH) { +++ if (field <= strnglen) { +++ fmtspec = SKIP; +++ break; +++ } else +++ field -= strnglen; +++ } +++ /* +++ * push string to implement leading blank padding +++ */ +++ put(2, O_LVCON, 2); +++ putstr("", 0); +++ stkcnt++; +++ break; +++ default: +++ error("Can't write %ss to a text file", clnames[typ]); +++ continue; +++ } +++ /* +++ * If there is a variable precision, evaluate it onto +++ * the stack +++ */ +++ if (fmtspec & VARPREC) { +++ ap = stkrval(al[3], NIL , RREQ ); +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("Second write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ if ( opt( 't' ) ) { +++ put(3, O_MAX, 0, 0); +++ } +++ stkcnt++; +++ } +++ /* +++ * If there is a variable width, evaluate it onto +++ * the stack +++ */ +++ if (fmtspec & VARWIDTH) { +++ if ( ( typ == TDOUBLE && fmtspec == VARWIDTH ) +++ || typ == TSTR ) { +++ i = sizes[cbn].om_off -= sizeof(int); +++ if (i < sizes[cbn].om_max) +++ sizes[cbn].om_max = i; +++ put(2, O_LV | cbn << 8 + INDX, i); +++ } +++ ap = stkrval(al[2], NIL , RREQ ); +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("First write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ stkcnt++; +++ /* +++ * Perform special processing on widths based +++ * on data type +++ */ +++ switch (typ) { +++ case TDOUBLE: +++ if (fmtspec == VARWIDTH) { +++ fmt = 'E'; +++ put(1, O_AS4); +++ put(2, O_RV4 | cbn << 8 + INDX, i); +++ put(3, O_MAX, 8, 1); +++ put(2, O_RV4 | cbn << 8 + INDX, i); +++ stkcnt++; +++ fmtspec += VARPREC; +++ } +++ put(3, O_MAX, 1, 1); +++ break; +++ case TSTR: +++ put(1, O_AS4); +++ put(2, O_RV4 | cbn << 8 + INDX, i); +++ put(3, O_MAX, strnglen, 0); +++ break; +++ default: +++ if ( opt( 't' ) ) { +++ put(3, O_MAX, 0, 0); +++ } +++ break; +++ } +++ } +++ /* +++ * Generate the format string +++ */ +++ switch (fmtspec) { +++ default: +++ panic("fmt2"); +++ case NIL: +++ if (fmt == 'c') +++ put(1, O_WRITEC); +++ else { +++ sprintf(&format[1], "%%%c", fmt); +++ goto fmtgen; +++ } +++ case SKIP: +++ break; +++ case CONWIDTH: +++ sprintf(&format[1], "%%%1D%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH: +++ sprintf(&format[1], "%%*%c", fmt); +++ goto fmtgen; +++ case CONWIDTH + CONPREC: +++ sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt); +++ goto fmtgen; +++ case CONWIDTH + VARPREC: +++ sprintf(&format[1], "%%%1D.*%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH + CONPREC: +++ sprintf(&format[1], "%%*.%1D%c", prec, fmt); +++ goto fmtgen; +++ case VARWIDTH + VARPREC: +++ sprintf(&format[1], "%%*.*%c", fmt); +++ fmtgen: +++ fmtlen = lenstr(&format[fmtstart], 0); +++ put(2, O_LVCON, fmtlen); +++ putstr(&format[fmtstart], 0); +++ put(1, O_FILE); +++ stkcnt += 2; +++ put(2, O_WRITEF, stkcnt); +++ } +++ /* +++ * Write the string after its blank padding +++ */ +++ if (typ == TSTR) { +++ put(1, O_FILE); +++ put(2, O_CON24, 1); +++ if (strfmt & VARWIDTH) { +++ put(2, O_RV4 | cbn << 8 + INDX , i ); +++ put(2, O_MIN, strnglen); +++ } else { +++ if ((fmtspec & SKIP) && +++ (strfmt & CONWIDTH)) { +++ strnglen = field; +++ } +++ put(2, O_CON24, strnglen); +++ } +++ ap = stkrval(alv, NIL , RREQ ); +++ put(1, O_WRITES); +++ } +++ } +++ /* +++ * Done with arguments. +++ * Handle writeln and +++ * insufficent number of args. +++ */ +++ switch (p->value[0] &~ NSTAND) { +++ case O_WRITEF: +++ if (argc == 0) +++ error("Write requires an argument"); +++ break; +++ case O_MESSAGE: +++ if (argc == 0) +++ error("Message requires an argument"); +++ case O_WRITLN: +++ if (filetype != nl+T1CHAR) +++ error("Can't 'writeln' a non text file"); +++ put(1, O_WRITLN); +++ break; +++ } +++ return; +++ +++ case O_READ4: +++ case O_READLN: +++ /* +++ * Set up default +++ * file "input". +++ */ +++ file = NIL; +++ filetype = nl+T1CHAR; +++ /* +++ * Determine the file implied +++ * for the read and generate +++ * code to make it the active file. +++ */ +++ if (argv != NIL) { +++ codeoff(); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ argv = argv[2]; +++ if (ap != NIL && ap->class == FILET) { +++ /* +++ * Got "read(f, ...", make +++ * f the active file, and save +++ * it and its type for use in +++ * processing the rest of the +++ * arguments to read. +++ */ +++ file = argv[1]; +++ filetype = ap->type; +++ stkrval(argv[1], NIL , RREQ ); +++ put(1, O_UNIT); +++ argv = argv[2]; +++ argc--; +++ } else { +++ /* +++ * Default is read from +++ * standard input. +++ */ +++ put(1, O_UNITINP); +++ input->nl_flags |= NUSED; +++ } +++ } else { +++ put(1, O_UNITINP); +++ input->nl_flags |= NUSED; +++ } +++ /* +++ * Loop and process each +++ * of the arguments. +++ */ +++ for (; argv != NIL; argv = argv[2]) { +++ /* +++ * Get the address of the target +++ * on the stack. +++ */ +++ al = argv[1]; +++ if (al == NIL) +++ continue; +++ if (al[0] != T_VAR) { +++ error("Arguments to %s must be variables, not expressions", p->symbol); +++ continue; +++ } +++ ap = stklval(al, MOD|ASGN|NOUSE); +++ if (ap == NIL) +++ continue; +++ if (filetype != nl+T1CHAR) { +++ /* +++ * Generalized read, i.e. +++ * from a non-textfile. +++ */ +++ if (incompat(filetype, ap, argv[1] )) { +++ error("Type mismatch in read from non-text file"); +++ continue; +++ } +++ /* +++ * var := file ^; +++ */ +++ if (file != NIL) +++ stkrval(file, NIL , RREQ ); +++ else /* Magic */ +++ put(2, O_RV2, input->value[0]); +++ put(1, O_FNIL); +++ put(2, O_IND, width(filetype)); +++ convert(filetype, ap); +++ if (isa(ap, "bsci")) +++ rangechk(ap, ap); +++ put(2, O_AS, width(ap)); +++ /* +++ * get(file); +++ */ +++ put(1, O_GET); +++ continue; +++ } +++ typ = classify(ap); +++ op = rdops(typ); +++ if (op == NIL) { +++ error("Can't read %ss from a text file", clnames[typ]); +++ continue; +++ } +++ if (op != O_READE) +++ put(1, op); +++ else { +++ put(2, op, listnames(ap)); +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Reading scalars from text files is non-standard"); +++ } +++ /* +++ * Data read is on the stack. +++ * Assign it. +++ */ +++ if (op != O_READ8 && op != O_READE) +++ rangechk(ap, op == O_READC ? ap : nl+T4INT); +++ gen(O_AS2, O_AS2, width(ap), +++ op == O_READ8 ? 8 : op == O_READ4 ? 4 : 2); +++ } +++ /* +++ * Done with arguments. +++ * Handle readln and +++ * insufficient number of args. +++ */ +++ if (p->value[0] == O_READLN) { +++ if (filetype != nl+T1CHAR) +++ error("Can't 'readln' a non text file"); +++ put(1, O_READLN); +++ } +++ else if (argc == 0) +++ error("read requires an argument"); +++ return; +++ +++ case O_GET: +++ case O_PUT: +++ if (argc != 1) { +++ error("%s expects one argument", p->symbol); +++ return; +++ } +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("Argument to %s must be a file, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ put(1, O_UNIT); +++ put(1, op); +++ return; +++ +++ case O_RESET: +++ case O_REWRITE: +++ if (argc == 0 || argc > 2) { +++ error("%s expects one or two arguments", p->symbol); +++ return; +++ } +++ if (opt('s') && argc == 2) { +++ standard(); +++ error("Two argument forms of reset and rewrite are non-standard"); +++ } +++ ap = stklval(argv[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("First argument to %s must be a file, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ if (argc == 2) { +++ /* +++ * Optional second argument +++ * is a string name of a +++ * UNIX (R) file to be associated. +++ */ +++ al = argv[2]; +++ al = stkrval(al[1], NOFLAGS , RREQ ); +++ if (al == NIL) +++ return; +++ if (classify(al) != TSTR) { +++ error("Second argument to %s must be a string, not %s", p->symbol, nameof(al)); +++ return; +++ } +++ strnglen = width(al); +++ } else { +++ put(2, O_CON24, NIL); +++ strnglen = 0; +++ } +++ put(2, O_CON24, strnglen); +++ put(2, O_CON24, text(ap) ? 0: width(ap->type)); +++ put(1, op); +++ return; +++ +++ case O_NEW: +++ case O_DISPOSE: +++ if (argc == 0) { +++ error("%s expects at least one argument", p->symbol); +++ return; +++ } +++ ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD ); +++ if (ap == NIL) +++ return; +++ if (ap->class != PTR) { +++ error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ ap = ap->type; +++ if (ap == NIL) +++ return; +++ argv = argv[2]; +++ if (argv != NIL) { +++ if (ap->class != RECORD) { +++ error("Record required when specifying variant tags"); +++ return; +++ } +++ for (; argv != NIL; argv = argv[2]) { +++ if (ap->ptr[NL_VARNT] == NIL) { +++ error("Too many tag fields"); +++ return; +++ } +++ if (!isconst(argv[1])) { +++ error("Second and successive arguments to %s must be constants", p->symbol); +++ return; +++ } +++ gconst(argv[1]); +++ if (con.ctype == NIL) +++ return; +++ if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) { +++ cerror("Specified tag constant type clashed with variant case selector type"); +++ return; +++ } +++ for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain) +++ if (ap->range[0] == con.crval) +++ break; +++ if (ap == NIL) { +++ error("No variant case label value equals specified constant value"); +++ return; +++ } +++ ap = ap->ptr[NL_VTOREC]; +++ } +++ } +++ put(2, op, width(ap)); +++ return; +++ +++ case O_DATE: +++ case O_TIME: +++ if (argc != 1) { +++ error("%s expects one argument", p->symbol); +++ return; +++ } +++ ap = stklval(argv[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR || width(ap) != 10) { +++ error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ put(1, op); +++ return; +++ +++ case O_HALT: +++ if (argc != 0) { +++ error("halt takes no arguments"); +++ return; +++ } +++ put(1, op); +++ noreach = 1; +++ return; +++ +++ case O_ARGV: +++ if (argc != 2) { +++ error("argv takes two arguments"); +++ return; +++ } +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("argv's first argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ al = argv[2]; +++ ap = stklval(al[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR) { +++ error("argv's second argument must be a string, not %s", nameof(ap)); +++ return; +++ } +++ put(2, op, width(ap)); +++ return; +++ +++ case O_STLIM: +++ if (argc != 1) { +++ error("stlimit requires one argument"); +++ return; +++ } +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("stlimit's argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ if (width(ap) != 4) +++ put(1, O_STOI); +++ put(1, op); +++ return; +++ +++ case O_REMOVE: +++ if (argc != 1) { +++ error("remove expects one argument"); +++ return; +++ } +++ ap = stkrval(argv[1], NOFLAGS , RREQ ); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR) { +++ error("remove's argument must be a string, not %s", nameof(ap)); +++ return; +++ } +++ put(2, O_CON24, width(ap)); +++ put(1, op); +++ return; +++ +++ case O_LLIMIT: +++ if (argc != 2) { +++ error("linelimit expects two arguments"); +++ return; +++ } +++ ap = stklval(argv[1], NOFLAGS|NOUSE); +++ if (ap == NIL) +++ return; +++ if (!text(ap)) { +++ error("linelimit's first argument must be a text file, not %s", nameof(ap)); +++ return; +++ } +++ al = argv[2]; +++ ap = stkrval(al[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("linelimit's second argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ put(1, op); +++ return; +++ case O_PAGE: +++ if (argc != 1) { +++ error("page expects one argument"); +++ return; +++ } +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (!text(ap)) { +++ error("Argument to page must be a text file, not %s", nameof(ap)); +++ return; +++ } +++ put(1, O_UNIT); +++ put(1, op); +++ return; +++ +++ case O_PACK: +++ if (argc != 3) { +++ error("pack expects three arguments"); +++ return; +++ } +++ pu = "pack(a,i,z)"; +++ pua = (al = argv)[1]; +++ pui = (al = al[2])[1]; +++ puz = (al = al[2])[1]; +++ goto packunp; +++ case O_UNPACK: +++ if (argc != 3) { +++ error("unpack expects three arguments"); +++ return; +++ } +++ pu = "unpack(z,a,i)"; +++ puz = (al = argv)[1]; +++ pua = (al = al[2])[1]; +++ pui = (al = al[2])[1]; +++packunp: +++ ap = stkrval((int *) pui, NLNIL , RREQ ); +++ if (ap == NIL) +++ return; +++ ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (ap->class != ARRAY) { +++ error("%s requires a to be an unpacked array, not %s", pu, nameof(ap)); +++ return; +++ } +++ al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE); +++ if (al->class != ARRAY) { +++ error("%s requires z to be a packed array, not %s", pu, nameof(ap)); +++ return; +++ } +++ if (al->type == NIL || ap->type == NIL) +++ return; +++ if (al->type != ap->type) { +++ error("%s requires a and z to be arrays of the same type", pu, nameof(ap)); +++ return; +++ } +++ k = width(al); +++ itemwidth = width(ap->type); +++ ap = ap->chain; +++ al = al->chain; +++ if (ap->chain != NIL || al->chain != NIL) { +++ error("%s requires a and z to be single dimension arrays", pu); +++ return; +++ } +++ if (ap == NIL || al == NIL) +++ return; +++ /* +++ * al is the range for z i.e. u..v +++ * ap is the range for a i.e. m..n +++ * i will be n-m+1 +++ * j will be v-u+1 +++ */ +++ i = ap->range[1] - ap->range[0] + 1; +++ j = al->range[1] - al->range[0] + 1; +++ if (i < j) { +++ error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i); +++ return; +++ } +++ /* +++ * get n-m-(v-u) and m for the interpreter +++ */ +++ i -= j; +++ j = ap->range[0]; +++ put(5, op, itemwidth , j, i, k); +++ return; +++ case 0: +++ error("%s is an unimplemented 6400 extension", p->symbol); +++ return; +++ +++ default: +++ panic("proc case"); +++ } +++} +++#endif OBJ diff --cc usr/src/cmd/pc0/pstab.h index 0000000000,0000000000,0000000000..b86d9aec27 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/pstab.h @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++ /* static char sccsid[] = "@(#)pstab.h 1.2 9/9/80"; */ +++ +++ /* +++ * subtypes within the above type +++ * subtypes N_PSO and N_PSOL are .stabs name,,0,subtype,0 +++ * others subtypes are .stabs name,,0,subtype,line +++ */ +++#define N_PSO 0x1 /* source file name */ +++#define N_PSOL 0x2 /* include file name */ +++#define N_PGLABEL 0x3 /* global label */ +++#define N_PGCONST 0x4 /* global constant */ +++#define N_PGTYPE 0x5 /* global type */ +++#define N_PGVAR 0x6 /* global variable */ +++#define N_PGFUNC 0x7 /* global function */ +++#define N_PGPROC 0x8 /* global procedure */ +++#define N_PEFUNC 0x9 /* external function */ +++#define N_PEPROC 0xa /* external procedure */ diff --cc usr/src/cmd/pc0/put.c index 0000000000,0000000000,0000000000..7e4180f5df new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/put.c @@@@ -1,0 -1,0 -1,0 +1,661 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)put.c 1.3 10/2/80"; +++ +++#include "whoami.h" +++#include "opcode.h" +++#include "0.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++#endif PC +++ +++short *obufp = obuf; +++ +++/* +++ * If DEBUG is defined, include the table +++ * of the printing opcode names. +++ */ +++#ifdef DEBUG +++#include "OPnames.h" +++#endif +++ +++#ifdef OBJ +++/* +++ * Put is responsible for the interpreter equivalent of code +++ * generation. Since the interpreter is specifically designed +++ * for Pascal, little work is required here. +++ */ +++put(a) +++{ +++ register int *p, i; +++ register char *cp; +++ int n, subop, suboppr, op, oldlc, w; +++ char *string; +++ static int casewrd; +++ +++ /* +++ * It would be nice to do some more +++ * optimizations here. The work +++ * done to collapse offsets in lval +++ * should be done here, the IFEQ etc +++ * relational operators could be used +++ * etc. +++ */ +++ oldlc = lc; +++ if (cgenflg < 0) +++ /* +++ * code disabled - do nothing +++ */ +++ return (oldlc); +++ p = &a; +++ n = *p++; +++ suboppr = subop = (*p>>8) & 0377; +++ op = *p & 0377; +++ string = 0; +++#ifdef DEBUG +++ if ((cp = otext[op]) == NIL) { +++ printf("op= %o\n", op); +++ panic("put"); +++ } +++#endif +++ switch (op) { +++ case O_ABORT: +++ cp = "*"; +++ break; +++ case O_LINO: +++/***** +++ if (line == codeline) +++ return (oldlc); +++ codeline = line; +++*****/ +++ case O_NEW: +++ case O_DISPOSE: +++ case O_AS: +++ case O_IND: +++ case O_LVCON: +++ case O_CON: +++ case O_OFF: +++ case O_INX2: +++ case O_INX4: +++ case O_CARD: +++ case O_ADDT: +++ case O_SUBT: +++ case O_MULT: +++ case O_IN: +++ case O_CASE1OP: +++ case O_CASE2OP: +++ case O_CASE4OP: +++ case O_FRTN: +++ case O_WRITES: +++ case O_WRITEF: +++ case O_MAX: +++ case O_MIN: +++ case O_PACK: +++ case O_UNPACK: +++ case O_ARGV: +++ case O_CTTOT: +++ case O_INCT: +++ case O_RANG2: +++ case O_RSNG2: +++ case O_RANG42: +++ case O_RSNG42: +++ if (p[1] == 0) +++ break; +++ case O_CON2: +++ case O_CON24: +++ if (p[1] < 128 && p[1] >= -128) { +++ suboppr = subop = p[1]; +++ p++; +++ n--; +++ if (op == O_CON2) { +++ op = O_CON1; +++ cp = otext[O_CON1]; +++ } +++ if (op == O_CON24) { +++ op = O_CON14; +++ cp = otext[O_CON14]; +++ } +++ } +++ break; +++ case O_CON8: +++ { +++ short *sp = &p[1]; +++ +++#ifdef DEBUG +++ if ( opt( 'k' ) ) +++ printf ( ")#%5d\tCON8\t%10.3f\n" , +++ lc - HEADER_BYTES , +++ * ( ( double * ) &p[1] ) ); +++#endif +++ word ( op ); +++ for ( i = 1 ; i <= 4 ; i ++ ) +++ word ( *sp ++ ); +++ return ( oldlc ); +++ } +++ default: +++ if (op >= O_REL2 && op <= O_REL84) { +++ if ((i = (subop >> 1) * 5 ) >= 30) +++ i -= 30; +++ else +++ i += 2; +++#ifdef DEBUG +++ string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i]; +++#endif +++ suboppr = 0; +++ } +++ break; +++ case O_IF: +++ case O_TRA: +++/***** +++ codeline = 0; +++*****/ +++ case O_FOR1U: +++ case O_FOR2U: +++ case O_FOR4U: +++ case O_FOR1D: +++ case O_FOR2D: +++ case O_FOR4D: +++ /* relative addressing */ +++ p[1] -= ( unsigned ) lc + 2; +++ break; +++ case O_CONG: +++ i = p[1]; +++ cp = * ( ( char ** ) &p[2] ) ; +++#ifdef DEBUG +++ if (opt('k')) +++ printf(")#%5d\tCONG:%d\t%s\n", +++ lc - HEADER_BYTES, i, cp); +++#endif +++ if (i <= 127) +++ word(O_CON | i << 8); +++ else { +++ word(O_CON); +++ word(i); +++ } +++ while (i > 0) { +++ w = *cp ? *cp++ : ' '; +++ w |= (*cp ? *cp++ : ' ') << 8; +++ word(w); +++ i -= 2; +++ } +++ return (oldlc); +++ case O_CONC: +++#ifdef DEBUG +++ (string = "'x'")[1] = p[1]; +++#endif +++ suboppr = 0; +++ op = O_CON1; +++ cp = otext[O_CON1]; +++ subop = p[1]; +++ goto around; +++ case O_CONC4: +++#ifdef DEBUG +++ (string = "'x'")[1] = p[1]; +++#endif +++ suboppr = 0; +++ op = O_CON14; +++ subop = p[1]; +++ goto around; +++ case O_CON1: +++ case O_CON14: +++ suboppr = subop = p[1]; +++around: +++ n--; +++ break; +++ case O_CASEBEG: +++ casewrd = 0; +++ return (oldlc); +++ case O_CASEEND: +++ if ((unsigned) lc & 1) { +++ lc--; +++ word(casewrd); +++ } +++ return (oldlc); +++ case O_CASE1: +++#ifdef DEBUG +++ if (opt('k')) +++ printf(")#%5d\tCASE1\t%d\n" +++ , lc - HEADER_BYTES +++ , ( int ) *( ( long * ) &p[1] ) ); +++#endif +++ /* +++ * this to build a byte size case table +++ * saving bytes across calls in casewrd +++ * so they can be put out by word() +++ */ +++ lc++; +++ if ((unsigned) lc & 1) +++ casewrd = *( ( long * ) &p[1] ) & 0377; +++ else { +++ lc -= 2; +++ word ( casewrd +++ | ( ( int ) *( ( long * ) &p[1] ) << 8 ) ); +++ } +++ return (oldlc); +++ case O_CASE2: +++#ifdef DEBUG +++ if (opt('k')) +++ printf(")#%5d\tCASE2\t%d\n" +++ , lc - HEADER_BYTES +++ , ( int ) *( ( long * ) &p[1] ) ); +++#endif +++ word( ( short ) *( ( long * ) &p[1] ) ); +++ return (oldlc); +++ case O_FCALL: +++ if (p[1] == 0) +++ goto longgen; +++ /* and fall through */ +++ case O_PUSH: +++ if (p[1] == 0) +++ return (oldlc); +++ if (p[1] < 128 && p[1] >= -128) { +++ suboppr = subop = p[1]; +++ p++; +++ n--; +++ break; +++ } +++ goto longgen; +++ case O_TRA4: +++ case O_CALL: +++ case O_FSAV: +++ case O_GOTO: +++ case O_NAM: +++ case O_READE: +++ /* absolute long addressing */ +++ p[1] -= HEADER_BYTES; +++ goto longgen; +++ case O_RV1: +++ case O_RV14: +++ case O_RV2: +++ case O_RV24: +++ case O_RV4: +++ case O_RV8: +++ case O_RV: +++ case O_LV: +++ if (p[1] < SHORTADDR && p[1] >= -SHORTADDR) +++ break; +++ else { +++ op += O_LRV - O_RV; +++ cp = otext[op]; +++ } +++ case O_BEG: +++ case O_NODUMP: +++ case O_CON4: +++ case O_CASE4: +++ case O_RANG4: +++ case O_RANG24: +++ case O_RSNG4: +++ case O_RSNG24: +++ longgen: +++ { +++ short *sp = &p[1]; +++ long *lp = &p[1]; +++ +++ n = (n << 1) - 1; +++ if ( op == O_LRV ) +++ n--; +++#ifdef DEBUG +++ if (opt('k')) +++ { +++ printf( ")#%5d\t%s" , lc - HEADER_BYTES , cp+1 ); +++ if (suboppr) +++ printf(":%1d", suboppr); +++ for ( i = 1 ; i < n +++ ; i += sizeof ( long )/sizeof ( short ) ) +++ printf( "\t%D " , *lp ++ ); +++ pchr ( '\n' ); +++ } +++#endif +++ if ( op != O_CASE4 ) +++ word ( op | subop<<8 ); +++ for ( i = 1 ; i < n ; i ++ ) +++ word ( *sp ++ ); +++ return ( oldlc ); +++ } +++ } +++#ifdef DEBUG +++ if (opt('k')) { +++ printf(")#%5d\t%s", lc - HEADER_BYTES, cp+1); +++ if (suboppr) +++ printf(":%d", suboppr); +++ if (string) +++ printf("\t%s",string); +++ if (n > 1) +++ pchr('\t'); +++ for (i=1; iclass != TYPE) +++ ap = ap->type; +++ if (ap->value[ NL_ELABEL ] != 0) { +++ /* the list already exists */ +++ return( ap -> value[ NL_ELABEL ] ); +++ } +++# ifdef OBJ +++ oldlc = lc; +++ put(2, O_TRA, lc); +++ ap->value[ NL_ELABEL ] = lc; +++# endif OBJ +++# ifdef PC +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ ap -> value[ NL_ELABEL ] = getlab(); +++ putlab( ap -> value[ NL_ELABEL ] ); +++# endif PC +++ /* number of scalars */ +++ next = ap->type; +++ len = next->range[1]-next->range[0]+1; +++# ifdef OBJ +++ put(2, O_CASE2, len); +++# endif OBJ +++# ifdef PC +++ putprintf( " .word %d" , 0 , len ); +++# endif PC +++ /* offsets of each scalar name */ +++ len = (len+1)*sizeof(short); +++# ifdef OBJ +++ put(2, O_CASE2, len); +++# endif OBJ +++# ifdef PC +++ putprintf( " .word %d" , 0 , len ); +++# endif PC +++ next = ap->chain; +++ do { +++ for(strptr = next->symbol; *strptr++; len++) +++ continue; +++ len++; +++# ifdef OBJ +++ put(2, O_CASE2, len); +++# endif OBJ +++# ifdef PC +++ putprintf( " .word %d" , 0 , len ); +++# endif PC +++ } while (next = next->chain); +++ /* list of scalar names */ +++ strptr = getnext(ap, &next); +++# ifdef OBJ +++ do { +++ w = (unsigned) *strptr; +++ if (!*strptr++) +++ strptr = getnext(next, &next); +++ w |= *strptr << 8; +++ if (!*strptr++) +++ strptr = getnext(next, &next); +++ word(w); +++ } while (next); +++ /* jump over the mess */ +++ patch(oldlc); +++# endif OBJ +++# ifdef PC +++ while ( next ) { +++ while ( *strptr ) { +++ putprintf( " .byte 0%o" , 1 , *strptr++ ); +++ for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) { +++ putprintf( ",0%o" , 1 , *strptr++ ); +++ } +++ putprintf( "" , 0 ); +++ } +++ putprintf( " .byte 0" , 0 ); +++ strptr = getnext( next , &next ); +++ } +++ putprintf( " .text" , 0 ); +++# endif PC +++ return( ap -> value[ NL_ELABEL ] ); +++} +++ +++getnext(next, new) +++ +++ struct nl *next, **new; +++{ +++ if (next != NIL) { +++ next = next->chain; +++ *new = next; +++ } +++ if (next == NIL) +++ return(""); +++#ifdef OBJ +++ if (opt('k') && cgenflg >= 0) +++ printf(")#%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol); +++#endif +++ return(next->symbol); +++} +++ +++#ifdef OBJ +++/* +++ * Putspace puts out a table +++ * of nothing to leave space +++ * for the case branch table e.g. +++ */ +++putspace(n) +++ int n; +++{ +++ register i; +++ +++ if (cgenflg < 0) +++ /* +++ * code disabled - do nothing +++ */ +++ return(lc); +++#ifdef DEBUG +++ if (opt('k')) +++ printf(")#%5d\t.=.+%d\n", lc - HEADER_BYTES, n); +++#endif +++ for (i = even(n); i > 0; i -= 2) +++ word(0); +++} +++ +++putstr(sptr, padding) +++ +++ char *sptr; +++ int padding; +++{ +++ register unsigned short w; +++ register char *strptr = sptr; +++ register int pad = padding; +++ +++ if (cgenflg < 0) +++ /* +++ * code disabled - do nothing +++ */ +++ return(lc); +++#ifdef DEBUG +++ if (opt('k')) +++ printf(")#%5D\t\t\"%s\"\n", lc-HEADER_BYTES, strptr); +++#endif +++ if (pad == 0) { +++ do { +++ w = (unsigned short) * strptr; +++ if (w) +++ w |= *++strptr << 8; +++ word(w); +++ } while (*strptr++); +++ } else { +++ do { +++ w = (unsigned short) * strptr; +++ if (w) { +++ if (*++strptr) +++ w |= *strptr << 8; +++ else { +++ w |= ' ' << 8; +++ pad--; +++ } +++ word(w); +++ } +++ } while (*strptr++); +++ while (pad > 1) { +++ word(' '); +++ pad -= 2; +++ } +++ if (pad == 1) +++ word(' '); +++ else +++ word(0); +++ } +++} +++#endif OBJ +++ +++lenstr(sptr, padding) +++ +++ char *sptr; +++ int padding; +++ +++{ +++ register int cnt; +++ register char *strptr = sptr; +++ +++ cnt = padding; +++ do { +++ cnt++; +++ } while (*strptr++); +++ return((++cnt) & ~1); +++} +++ +++/* +++ * Patch repairs the branch +++ * at location loc to come +++ * to the current location. +++ * for PC, this puts down the label +++ * and the branch just references that label. +++ * lets here it for two pass assemblers. +++ */ +++patch(loc) +++{ +++ +++# ifdef OBJ +++ patchfil(loc, lc-loc-2, 1); +++# endif OBJ +++# ifdef PC +++ putlab( loc ); +++# endif PC +++} +++ +++#ifdef OBJ +++patch4(loc) +++{ +++ +++ patchfil(loc, lc - HEADER_BYTES, 2); +++} +++ +++/* +++ * Patchfil makes loc+2 have value +++ * as its contents. +++ */ +++patchfil(loc, value, words) +++ PTR_DCL loc; +++ int value, words; +++{ +++ register i; +++ +++ if (cgenflg < 0) +++ return; +++ if (loc > (unsigned) lc) +++ panic("patchfil"); +++#ifdef DEBUG +++ if (opt('k')) +++ printf(")#\tpatch %u %d\n", loc - HEADER_BYTES, value); +++#endif +++ do { +++ i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2; +++ if (i >= 0 && i < 1024) +++ obuf[i] = value; +++ else { +++ lseek(ofil, (long) loc+2, 0); +++ write(ofil, &value, 2); +++ lseek(ofil, (long) 0, 2); +++ } +++ loc += 2; +++ value = value >> 16; +++ } while (--words); +++} +++ +++/* +++ * Put the word o into the code +++ */ +++word(o) +++ int o; +++{ +++ +++ *obufp = o; +++ obufp++; +++ lc += 2; +++ if (obufp >= obuf+512) +++ pflush(); +++} +++ +++extern char *obj; +++/* +++ * Flush the code buffer +++ */ +++pflush() +++{ +++ register i; +++ +++ i = (obufp - ( ( short * ) obuf ) ) * 2; +++ if (i != 0 && write(ofil, obuf, i) != i) +++ perror(obj), pexit(DIED); +++ obufp = obuf; +++} +++#endif OBJ +++ +++/* +++ * Getlab - returns the location counter. +++ * included here for the eventual code generator. +++ * for PC, thank you! +++ */ +++getlab() +++{ +++# ifdef OBJ +++ +++ return (lc); +++# endif OBJ +++# ifdef PC +++ static long lastlabel; +++ +++ return ( ++lastlabel ); +++# endif PC +++} +++ +++/* +++ * Putlab - lay down a label. +++ * for PC, just print the label name with a colon after it. +++ */ +++putlab(l) +++ int l; +++{ +++ +++# ifdef PC +++ putprintf( PREFIXFORMAT , 1 , LABELPREFIX , l ); +++ putprintf( ":" , 0 ); +++# endif PC +++ return (l); +++} +++ diff --cc usr/src/cmd/pc0/putn.c index 0000000000,0000000000,0000000000..703d6396ce new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/putn.c @@@@ -1,0 -1,0 -1,0 +1,42 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)putn.c 1.1 8/27/80"; +++ +++ /* +++ * put[1234] +++ * these sort of replace the assembler code +++ * which used to mung the stack inserting 1, 2, 3, or 4 and then +++ * jmp ( not jsr ) to put. these are more portable, +++ * but since they can only receive integer arguments, calls +++ * to one of these with long or real arguments must be changed +++ * to call put directly. +++ */ +++ +++ /* +++ * is there some reason why these aren't #defined? +++ */ +++ +++put1 ( arg1 ) +++ int arg1; +++ { +++ return ( put ( 1 , arg1 ) ); +++ } +++ +++put2 ( arg1 , arg2 ) +++ int arg1 , arg2; +++ { +++ return ( put ( 2 , arg1 , arg2 ) ); +++ } +++ +++put3 ( arg1 , arg2 , arg3 ) +++ int arg1 , arg2 , arg3; +++ { +++ return ( put ( 3 , arg1 , arg2 , arg3 ) ); +++ } +++ +++put4 ( arg1 , arg2 , arg3 , arg4 ) +++ int arg1 , arg2 , arg3 , arg4; +++ { +++ return ( put ( 4 , arg1 , arg2 , arg3 , arg4 ) ); +++ } +++ diff --cc usr/src/cmd/pc0/rec.c index 0000000000,0000000000,0000000000..bdb8fad05c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/rec.c @@@@ -1,0 -1,0 -1,0 +1,267 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)rec.c 1.2 9/22/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++ +++/* +++ * Build a record namelist entry. +++ * Some of the processing here is somewhat involved. +++ * The basic structure we are building is as follows. +++ * +++ * Each record has a main RECORD entry, with an attached +++ * chain of fields as ->chain; these include all the fields in all +++ * the variants of this record. +++ * +++ * Attached to NL_VARNT is a chain of VARNT structures +++ * describing each of the variants. These are further linked +++ * through ->chain. Each VARNT has, in ->range[0] the value of +++ * the associated constant, and each points at a RECORD describing +++ * the subrecord through NL_VTOREC. These pointers are not unique, +++ * more than one VARNT may reference the same RECORD. +++ * +++ * The involved processing here is in computing the NL_OFFS entry +++ * by maxing over the variants. This works as follows. +++ * +++ * Each RECORD has two size counters. NL_OFFS is the maximum size +++ * so far of any variant of this record; NL_FLDSZ gives the size +++ * of just the FIELDs to this point as a base for further variants. +++ * +++ * As we process each variant record, we start its size with the +++ * NL_FLDSZ we have so far. After processing it, if its NL_OFFS +++ * is the largest so far, we update the NL_OFFS of this subrecord. +++ * This will eventually propagate back and update the NL_OFFS of the +++ * entire record. +++ */ +++ +++/* +++ * P0 points to the outermost RECORD for name searches. +++ */ +++struct nl *P0; +++ +++tyrec(r, off) +++ int *r, off; +++{ +++ +++ return tyrec1(r, off, 1); +++} +++ +++/* +++ * Define a record namelist entry. +++ * R is the tree for the record to be built. +++ * Off is the offset for the first item in this (sub)record. +++ */ +++struct nl * +++tyrec1(r, off, first) +++ register int *r; +++ int off; +++ char first; +++{ +++ register struct nl *p, *P0was; +++ +++ p = defnl(0, RECORD, 0, 0); +++ P0was = P0; +++ if (first) +++ P0 = p; +++#ifndef PI0 +++ p->value[NL_FLDSZ] = p->value[NL_OFFS] = off; +++#endif +++ if (r != NIL) { +++ fields(p, r[2]); +++ variants(p, r[3]); +++ } +++ /* +++ * round the lengths of records up to their alignments +++ */ +++ p -> value[ NL_OFFS ] = roundup( p -> value[ NL_OFFS ] , align( p ) ); +++ P0 = P0was; +++ return (p); +++} +++ +++/* +++ * Define the fixed part fields for p. +++ */ +++struct nl * +++fields(p, r) +++ struct nl *p; +++ int *r; +++{ +++ register int *fp, *tp, *ip; +++ struct nl *jp; +++ +++ for (fp = r; fp != NIL; fp = fp[2]) { +++ tp = fp[1]; +++ if (tp == NIL) +++ continue; +++ jp = gtype(tp[3]); +++ line = tp[1]; +++ for (ip = tp[2]; ip != NIL; ip = ip[2]) +++ deffld(p, ip[1], jp); +++ } +++} +++ +++/* +++ * Define the variants for RECORD p. +++ */ +++struct nl * +++variants(p, r) +++ struct nl *p; +++ register int *r; +++{ +++ register int *vc, *v; +++ int *vr; +++ struct nl *ct; +++ +++ if (r == NIL) +++ return; +++ ct = gtype(r[3]); +++ if ( isnta( ct , "bcsi" ) ) { +++ error("Tag fields cannot be %ss" , nameof( ct ) ); +++ } +++ line = r[1]; +++ /* +++ * Want it even if r[2] is NIL so +++ * we check its type in "new" and "dispose" +++ * calls -- link it to NL_TAG. +++ */ +++ p->ptr[NL_TAG] = deffld(p, r[2], ct); +++ for (vc = r[4]; vc != NIL; vc = vc[2]) { +++ v = vc[1]; +++ if (v == NIL) +++ continue; +++ vr = tyrec1(v[3], p->value[NL_FLDSZ], 0); +++#ifndef PI0 +++ if (vr->value[NL_OFFS] > p->value[NL_OFFS]) +++ p->value[NL_OFFS] = vr->value[NL_OFFS]; +++#endif +++ line = v[1]; +++ for (v = v[2]; v != NIL; v = v[2]) +++ defvnt(p, v[1], vr, ct); +++ } +++} +++ +++/* +++ * Define a field in subrecord p of record P0 +++ * with name s and type t. +++ */ +++struct nl * +++deffld(p, s, t) +++ struct nl *p; +++ register char *s; +++ register struct nl *t; +++{ +++ register struct nl *fp; +++ +++ if (reclook(P0, s) != NIL) { +++#ifndef PI1 +++ error("%s is a duplicate field name in this record", s); +++#endif +++ s = NIL; +++ } +++#ifndef PI0 +++ /* +++ * it used to be easy to keep track of offsets of fields +++ * and total sizes of records. +++ * but now, the offset of the field is aligned +++ * so only it knows it's offset, and calculating +++ * the total size of the record is based on it, +++ * rather than just the width of the field. +++ */ +++ fp = enter( defnl( s , FIELD , t , roundup( p -> value[ NL_OFFS ] +++ , align( t ) ) ) ); +++#else +++ fp = enter(defnl(s, FIELD, t, 0)); +++#endif +++ if (s != NIL) { +++ fp->chain = P0->chain; +++ P0->chain = fp; +++#ifndef PI0 +++ /* +++ * and the size of the record is incremented. +++ */ +++ p -> value[ NL_OFFS ] = fp -> value[ NL_OFFS ] + width( t ); +++ p -> value[ NL_FLDSZ ] = p -> value[ NL_OFFS ]; +++#endif +++ if (t != NIL) { +++ P0->nl_flags |= t->nl_flags & NFILES; +++ p->nl_flags |= t->nl_flags & NFILES; +++ } +++# ifdef PC +++ stabfield( s , p2type( t ) , fp -> value[ NL_OFFS ] +++ , lwidth( t ) ); +++# endif PC +++ } +++ return (fp); +++} +++ +++/* +++ * Define a variant from the constant tree of t +++ * in subrecord p of record P0 where the casetype +++ * is ct and the variant record to be associated is vr. +++ */ +++struct nl * +++defvnt(p, t, vr, ct) +++ struct nl *p, *vr; +++ int *t; +++ register struct nl *ct; +++{ +++ register struct nl *av; +++ +++ gconst(t); +++ if (ct != NIL && incompat(con.ctype, ct , t )) { +++#ifndef PI1 +++ cerror("Variant label type incompatible with selector type"); +++#endif +++ ct = NIL; +++ } +++ av = defnl(0, VARNT, ct, 0); +++#ifndef PI1 +++ if (ct != NIL) +++ uniqv(p); +++#endif +++ av->chain = p->ptr[NL_VARNT]; +++ p->ptr[NL_VARNT] = av; +++ av->ptr[NL_VTOREC] = vr; +++ av->range[0] = con.crval; +++ return (av); +++} +++ +++#ifndef PI1 +++/* +++ * Check that the constant label value +++ * is unique among the labels in this variant. +++ */ +++uniqv(p) +++ struct nl *p; +++{ +++ register struct nl *vt; +++ +++ for (vt = p->ptr[NL_VARNT]; vt != NIL; vt = vt->chain) +++ if (vt->range[0] == con.crval) { +++ error("Duplicate variant case label in record"); +++ return; +++ } +++} +++#endif +++ +++/* +++ * See if the field name s is defined +++ * in the record p, returning a pointer +++ * to it namelist entry if it is. +++ */ +++struct nl * +++reclook(p, s) +++ register struct nl *p; +++ char *s; +++{ +++ +++ if (p == NIL || s == NIL) +++ return (NIL); +++ for (p = p->chain; p != NIL; p = p->chain) +++ if (p->symbol == s) +++ return (p); +++ return (NIL); +++} diff --cc usr/src/cmd/pc0/rval.c index 0000000000,0000000000,0000000000..22849a80a6 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/rval.c @@@@ -1,0 -1,0 -1,0 +1,1150 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)rval.c 1.5 10/28/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++ +++extern char *opnames[]; +++ +++ /* line number of the last record comparison warning */ +++short reccompline = 0; +++ +++#ifdef PC +++ char *relts[] = { +++ "_RELEQ" , "_RELNE" , +++ "_RELTLT" , "_RELTGT" , +++ "_RELTLE" , "_RELTGE" +++ }; +++ char *relss[] = { +++ "_RELEQ" , "_RELNE" , +++ "_RELSLT" , "_RELSGT" , +++ "_RELSLE" , "_RELSGE" +++ }; +++ long relops[] = { +++ P2EQ , P2NE , +++ P2LT , P2GT , +++ P2LE , P2GE +++ }; +++ long mathop[] = { P2MUL , P2PLUS , P2MINUS }; +++ char *setop[] = { "_MULT" , "_ADDT" , "_SUBT" }; +++#endif PC +++/* +++ * Rvalue - an expression. +++ * +++ * Contype is the type that the caller would prefer, nand is important +++ * if constant sets or constant strings are involved, the latter +++ * because of string padding. +++ * required is a flag whether an lvalue or an rvalue is required. +++ * only VARs and structured things can have gt their lvalue this way. +++ */ +++struct nl * +++rvalue(r, contype , required ) +++ int *r; +++ struct nl *contype; +++ int required; +++{ +++ register struct nl *p, *p1; +++ register struct nl *q; +++ int c, c1, *rt, w, g; +++ char *cp, *cp1, *opname; +++ long l; +++ double f; +++ extern int flagwas; +++ struct csetstr csetd; +++# ifdef PC +++ struct nl *rettype; +++ long ctype; +++ long tempoff; +++# endif PC +++ +++ if (r == NIL) +++ return (NIL); +++ if (nowexp(r)) +++ return (NIL); +++ /* +++ * Pick up the name of the operation +++ * for future error messages. +++ */ +++ if (r[0] <= T_IN) +++ opname = opnames[r[0]]; +++ +++ /* +++ * The root of the tree tells us what sort of expression we have. +++ */ +++ switch (r[0]) { +++ +++ /* +++ * The constant nil +++ */ +++ case T_NIL: +++# ifdef OBJ +++ put(2, O_CON2, 0); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 , P2PTR|P2UNDEF , 0 ); +++# endif PC +++ return (nl+TNIL); +++ +++ /* +++ * Function call with arguments. +++ */ +++ case T_FCALL: +++# ifdef OBJ +++ return (funccod(r)); +++# endif OBJ +++# ifdef PC +++ return (pcfunccod( r )); +++# endif PC +++ +++ case T_VAR: +++ p = lookup(r[2]); +++ if (p == NIL || p->class == BADUSE) +++ return (NIL); +++ switch (p->class) { +++ case VAR: +++ /* +++ * If a variable is +++ * qualified then get +++ * the rvalue by a +++ * lvalue and an ind. +++ */ +++ if (r[3] != NIL) +++ goto ind; +++ q = p->type; +++ if (q == NIL) +++ return (NIL); +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(2, O_RV8 | bn << 8+INDX, p->value[0]); +++ break; +++ case 4: +++ put(2, O_RV4 | bn << 8+INDX, p->value[0]); +++ break; +++ case 2: +++ put(2, O_RV2 | bn << 8+INDX, p->value[0]); +++ break; +++ case 1: +++ put(2, O_RV1 | bn << 8+INDX, p->value[0]); +++ break; +++ default: +++ put(3, O_RV | bn << 8+INDX, p->value[0], w); +++ } +++# endif OBJ +++# ifdef PC +++ if ( required == RREQ ) { +++ putRV( p -> symbol , bn , p -> value[0] +++ , p2type( q ) ); +++ } else { +++ putLV( p -> symbol , bn , p -> value[0] +++ , p2type( q ) ); +++ } +++# endif PC +++ return (q); +++ +++ case WITHPTR: +++ case REF: +++ /* +++ * A lvalue for these +++ * is actually what one +++ * might consider a rvalue. +++ */ +++ind: +++ q = lvalue(r, NOFLAGS , LREQ ); +++ if (q == NIL) +++ return (NIL); +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(1, O_IND8); +++ break; +++ case 4: +++ put(1, O_IND4); +++ break; +++ case 2: +++ put(1, O_IND2); +++ break; +++ case 1: +++ put(1, O_IND1); +++ break; +++ default: +++ put(2, O_IND, w); +++ } +++# endif OBJ +++# ifdef PC +++ if ( required == RREQ ) { +++ putop( P2UNARY P2MUL , p2type( q ) ); +++ } +++# endif PC +++ return (q); +++ +++ case CONST: +++ if (r[3] != NIL) { +++ error("%s is a constant and cannot be qualified", r[2]); +++ return (NIL); +++ } +++ q = p->type; +++ if (q == NIL) +++ return (NIL); +++ if (q == nl+TSTR) { +++ /* +++ * Find the size of the string +++ * constant if needed. +++ */ +++ cp = p->ptr[0]; +++cstrng: +++ cp1 = cp; +++ for (c = 0; *cp++; c++) +++ continue; +++ if (contype != NIL && !opt('s')) { +++ if (width(contype) < c && classify(contype) == TSTR) { +++ error("Constant string too long"); +++ return (NIL); +++ } +++ c = width(contype); +++ } +++# ifdef OBJ +++ put( 2 + (sizeof(char *)/sizeof(short)) +++ , O_CONG, c, cp1); +++# endif OBJ +++# ifdef PC +++ putCONG( cp1 , c , required ); +++# endif PC +++ /* +++ * Define the string temporarily +++ * so later people can know its +++ * width. +++ * cleaned out by stat. +++ */ +++ q = defnl(0, STR, 0, c); +++ q->type = q; +++ return (q); +++ } +++ if (q == nl+T1CHAR) { +++# ifdef OBJ +++ put(2, O_CONC, p->value[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , p -> value[0] , 0 +++ , P2CHAR , 0 ); +++# endif PC +++ return (q); +++ } +++ /* +++ * Every other kind of constant here +++ */ +++ switch (width(q)) { +++ case 8: +++#ifndef DEBUG +++# ifdef OBJ +++ put(2, O_CON8, p->real); +++# endif OBJ +++# ifdef PC +++ putCON8( p -> real ); +++# endif PC +++#else +++ if (hp21mx) { +++ f = p->real; +++ conv(&f); +++ l = f.plong; +++ put(2, O_CON4, l); +++ } else +++# ifdef OBJ +++ put(2, O_CON8, p->real); +++# endif OBJ +++# ifdef PC +++ putCON8( p -> real ); +++# endif PC +++#endif +++ break; +++ case 4: +++# ifdef OBJ +++ put(2, O_CON4, p->range[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , p -> range[0] , 0 +++ , P2INT , 0 ); +++# endif PC +++ break; +++ case 2: +++# ifdef OBJ +++ put(2, O_CON2, ( short ) p->range[0]); +++# endif OBJ +++# ifdef PC +++ /* +++ * make short constants ints +++ */ +++ putleaf( P2ICON , (short) p -> range[0] +++ , 0 , P2INT , 0 ); +++# endif PC +++ break; +++ case 1: +++# ifdef OBJ +++ put(2, O_CON1, p->value[0]); +++# endif OBJ +++# ifdef PC +++ /* +++ * make char constants ints +++ */ +++ putleaf( P2ICON , p -> value[0] , 0 +++ , P2INT , 0 ); +++# endif PC +++ break; +++ default: +++ panic("rval"); +++ } +++ return (q); +++ +++ case FUNC: +++ case FFUNC: +++ /* +++ * Function call with no arguments. +++ */ +++ if (r[3]) { +++ error("Can't qualify a function result value"); +++ return (NIL); +++ } +++# ifdef OBJ +++ return (funccod((int *) r)); +++# endif OBJ +++# ifdef PC +++ return (pcfunccod( r )); +++# endif PC +++ +++ case TYPE: +++ error("Type names (e.g. %s) allowed only in declarations", p->symbol); +++ return (NIL); +++ +++ case PROC: +++ case FPROC: +++ error("Procedure %s found where expression required", p->symbol); +++ return (NIL); +++ default: +++ panic("rvid"); +++ } +++ /* +++ * Constant sets +++ */ +++ case T_CSET: +++# ifdef OBJ +++ if ( precset( r , contype , &csetd ) ) { +++ if ( csetd.csettype == NIL ) { +++ return NIL; +++ } +++ postcset( r , &csetd ); +++ } else { +++ put( 2, O_PUSH, -width(csetd.csettype)); +++ postcset( r , &csetd ); +++ setran( ( csetd.csettype ) -> type ); +++ put( 2, O_CON24, set.uprbp); +++ put( 2, O_CON24, set.lwrb); +++ put( 2, O_CTTOT, 5 + csetd.singcnt + 2 * csetd.paircnt); +++ } +++ return csetd.csettype; +++# endif OBJ +++# ifdef PC +++ if ( precset( r , contype , &csetd ) ) { +++ if ( csetd.csettype == NIL ) { +++ return NIL; +++ } +++ postcset( r , &csetd ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_CTTOT" ); +++ /* +++ * allocate a temporary and use it +++ */ +++ sizes[ cbn ].om_off -= lwidth( csetd.csettype ); +++ tempoff = sizes[ cbn ].om_off; +++ putlbracket( ftnno , -tempoff ); +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putLV( 0 , cbn , tempoff , P2PTR|P2STRTY ); +++ setran( ( csetd.csettype ) -> type ); +++ putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ postcset( r , &csetd ); +++ putop( P2CALL , P2INT ); +++ } +++ return csetd.csettype; +++# endif PC +++ +++ /* +++ * Unary plus and minus +++ */ +++ case T_PLUS: +++ case T_MINUS: +++ q = rvalue(r[2], NIL , RREQ ); +++ if (q == NIL) +++ return (NIL); +++ if (isnta(q, "id")) { +++ error("Operand of %s must be integer or real, not %s", opname, nameof(q)); +++ return (NIL); +++ } +++ if (r[0] == T_MINUS) { +++# ifdef OBJ +++ put(1, O_NEG2 + (width(q) >> 2)); +++# endif OBJ +++# ifdef PC +++ putop( P2UNARY P2MINUS , p2type( q ) ); +++# endif PC +++ return (isa(q, "d") ? q : nl+T4INT); +++ } +++ return (q); +++ +++ case T_NOT: +++ q = rvalue(r[2], NIL , RREQ ); +++ if (q == NIL) +++ return (NIL); +++ if (isnta(q, "b")) { +++ error("not must operate on a Boolean, not %s", nameof(q)); +++ return (NIL); +++ } +++# ifdef OBJ +++ put(1, O_NOT); +++# endif OBJ +++# ifdef PC +++ putop( P2NOT , P2INT ); +++# endif PC +++ return (nl+T1BOOL); +++ +++ case T_AND: +++ case T_OR: +++ p = rvalue(r[2], NIL , RREQ ); +++ p1 = rvalue(r[3], NIL , RREQ ); +++ if (p == NIL || p1 == NIL) +++ return (NIL); +++ if (isnta(p, "b")) { +++ error("Left operand of %s must be Boolean, not %s", opname, nameof(p)); +++ return (NIL); +++ } +++ if (isnta(p1, "b")) { +++ error("Right operand of %s must be Boolean, not %s", opname, nameof(p1)); +++ return (NIL); +++ } +++# ifdef OBJ +++ put(1, r[0] == T_AND ? O_AND : O_OR); +++# endif OBJ +++# ifdef PC +++ /* +++ * note the use of & and | rather than && and || +++ * to force evaluation of all the expressions. +++ */ +++ putop( r[ 0 ] == T_AND ? P2AND : P2OR , P2INT ); +++# endif PC +++ return (nl+T1BOOL); +++ +++ case T_DIVD: +++# ifdef OBJ +++ p = rvalue(r[2], NIL , RREQ ); +++ p1 = rvalue(r[3], NIL , RREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * force these to be doubles for the divide +++ */ +++ p = rvalue( r[ 2 ] , NIL , RREQ ); +++ if ( isnta( p , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ p1 = rvalue( r[ 3 ] , NIL , RREQ ); +++ if ( isnta( p1 , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++# endif PC +++ if (p == NIL || p1 == NIL) +++ return (NIL); +++ if (isnta(p, "id")) { +++ error("Left operand of / must be integer or real, not %s", nameof(p)); +++ return (NIL); +++ } +++ if (isnta(p1, "id")) { +++ error("Right operand of / must be integer or real, not %s", nameof(p1)); +++ return (NIL); +++ } +++# ifdef OBJ +++ return gen(NIL, r[0], width(p), width(p1)); +++# endif OBJ +++# ifdef PC +++ putop( P2DIV , P2DOUBLE ); +++ return nl + TDOUBLE; +++# endif PC +++ +++ case T_MULT: +++ case T_ADD: +++ case T_SUB: +++# ifdef OBJ +++ /* +++ * If the context hasn't told us the type +++ * and a constant set is present +++ * we need to infer the type +++ * before generating code. +++ */ +++ if ( contype == NIL ) { +++ codeoff(); +++ contype = rvalue( r[3] , NIL , RREQ ); +++ codeon(); +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ contype = rvalue( r[2] , NIL , RREQ ); +++ codeon(); +++ } +++ } +++ if ( contype == NIL ) { +++ return NIL; +++ } +++ p = rvalue( r[2] , contype , RREQ ); +++ p1 = rvalue( r[3] , p , RREQ ); +++ if ( p == NIL || p1 == NIL ) +++ return NIL; +++ if (isa(p, "id") && isa(p1, "id")) +++ return (gen(NIL, r[0], width(p), width(p1))); +++ if (isa(p, "t") && isa(p1, "t")) { +++ if (p != p1) { +++ error("Set types of operands of %s must be identical", opname); +++ return (NIL); +++ } +++ gen(TSET, r[0], width(p), 0); +++ return (p); +++ } +++# endif OBJ +++# ifdef PC +++ /* +++ * the second pass can't do +++ * long op double or double op long +++ * so we have to know the type of both operands +++ * also, it gets tricky for sets, which are done +++ * by function calls. +++ */ +++ codeoff(); +++ p1 = rvalue( r[ 3 ] , contype , RREQ ); +++ codeon(); +++ if ( isa( p1 , "id" ) ) { +++ p = rvalue( r[ 2 ] , contype , RREQ ); +++ if ( ( p == NIL ) || ( p1 == NIL ) ) { +++ return NIL; +++ } +++ if ( isa( p , "i" ) && isa( p1 , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ p1 = rvalue( r[ 3 ] , contype , RREQ ); +++ if ( isa( p , "d" ) && isa( p1 , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ if ( isa( p , "id" ) ) { +++ if ( isa( p , "d" ) || isa( p1 , "d" ) ) { +++ ctype = P2DOUBLE; +++ rettype = nl + TDOUBLE; +++ } else { +++ ctype = P2INT; +++ rettype = nl + T4INT; +++ } +++ putop( mathop[ r[0] - T_MULT ] , ctype ); +++ return rettype; +++ } +++ } +++ if ( isa( p1 , "t" ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( ADDTYPE( P2PTR | P2STRTY , P2FTN ) +++ , P2PTR ) +++ , setop[ r[0] - T_MULT ] ); +++ if ( contype == NIL ) { +++ contype = p1; +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ contype = rvalue( r[2] , NIL , LREQ ); +++ codeon(); +++ } +++ } +++ if ( contype == NIL ) { +++ return NIL; +++ } +++ /* +++ * allocate a temporary and use it +++ */ +++ sizes[ cbn ].om_off -= lwidth( contype ); +++ tempoff = sizes[ cbn ].om_off; +++ putlbracket( ftnno , -tempoff ); +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putLV( 0 , cbn , tempoff , P2PTR|P2STRTY ); +++ p = rvalue( r[2] , contype , LREQ ); +++ if ( isa( p , "t" ) ) { +++ putop( P2LISTOP , P2INT ); +++ if ( p == NIL || p1 == NIL ) { +++ return NIL; +++ } +++ p1 = rvalue( r[3] , p , LREQ ); +++ if ( p != p1 ) { +++ error("Set types of operands of %s must be identical", opname); +++ return NIL; +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , lwidth( p1 ) / sizeof( long ) , 0 +++ , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2PTR | P2STRTY ); +++ return p; +++ } +++ } +++ if ( isnta( p1 , "idt" ) ) { +++ /* +++ * find type of left operand for error message. +++ */ +++ p = rvalue( r[2] , contype , RREQ ); +++ } +++ /* +++ * don't give spurious error messages. +++ */ +++ if ( p == NIL || p1 == NIL ) { +++ return NIL; +++ } +++# endif PC +++ if (isnta(p, "idt")) { +++ error("Left operand of %s must be integer, real or set, not %s", opname, nameof(p)); +++ return (NIL); +++ } +++ if (isnta(p1, "idt")) { +++ error("Right operand of %s must be integer, real or set, not %s", opname, nameof(p1)); +++ return (NIL); +++ } +++ error("Cannot mix sets with integers and reals as operands of %s", opname); +++ return (NIL); +++ +++ case T_MOD: +++ case T_DIV: +++ p = rvalue(r[2], NIL , RREQ ); +++ p1 = rvalue(r[3], NIL , RREQ ); +++ if (p == NIL || p1 == NIL) +++ return (NIL); +++ if (isnta(p, "i")) { +++ error("Left operand of %s must be integer, not %s", opname, nameof(p)); +++ return (NIL); +++ } +++ if (isnta(p1, "i")) { +++ error("Right operand of %s must be integer, not %s", opname, nameof(p1)); +++ return (NIL); +++ } +++# ifdef OBJ +++ return (gen(NIL, r[0], width(p), width(p1))); +++# endif OBJ +++# ifdef PC +++ putop( r[ 0 ] == T_DIV ? P2DIV : P2MOD , P2INT ); +++ return ( nl + T4INT ); +++# endif PC +++ +++ case T_EQ: +++ case T_NE: +++ case T_LT: +++ case T_GT: +++ case T_LE: +++ case T_GE: +++ /* +++ * Since there can be no, a priori, knowledge +++ * of the context type should a constant string +++ * or set arise, we must poke around to find such +++ * a type if possible. Since constant strings can +++ * always masquerade as identifiers, this is always +++ * necessary. +++ */ +++ codeoff(); +++ p1 = rvalue(r[3], NIL , RREQ ); +++ codeon(); +++ if (p1 == NIL) +++ return (NIL); +++ contype = p1; +++# ifdef OBJ +++ if (p1->class == STR) { +++ /* +++ * For constant strings we want +++ * the longest type so as to be +++ * able to do padding (more importantly +++ * avoiding truncation). For clarity, +++ * we get this length here. +++ */ +++ codeoff(); +++ p = rvalue(r[2], NIL , RREQ ); +++ codeon(); +++ if (p == NIL) +++ return (NIL); +++ if (width(p) > width(p1)) +++ contype = p; +++ } else if ( isa( p1 , "t" ) ) { +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ contype = rvalue( r[2] , NIL , RREQ ); +++ codeon(); +++ if ( contype == NIL ) { +++ return NIL; +++ } +++ } +++ } +++ /* +++ * Now we generate code for +++ * the operands of the relational +++ * operation. +++ */ +++ p = rvalue(r[2], contype , RREQ ); +++ if (p == NIL) +++ return (NIL); +++ p1 = rvalue(r[3], p , RREQ ); +++ if (p1 == NIL) +++ return (NIL); +++# endif OBJ +++# ifdef PC +++ c1 = classify( p1 ); +++ if ( c1 == TSET || c1 == TSTR || c1 == TREC ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , c1 == TSET ? relts[ r[0] - T_EQ ] +++ : relss[ r[0] - T_EQ ] ); +++ /* +++ * for [] and strings, comparisons are done on +++ * the maximum width of the two sides. +++ * for other sets, we have to ask the left side +++ * what type it is based on the type of the right. +++ * (this matters for intsets). +++ */ +++ if ( c1 == TSTR ) { +++ codeoff(); +++ p = rvalue( r[ 2 ] , NIL , LREQ ); +++ codeon(); +++ if ( p == NIL ) { +++ return NIL; +++ } +++ if ( lwidth( p ) > lwidth( p1 ) ) { +++ contype = p; +++ } +++ } else if ( c1 == TSET ) { +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ p = rvalue( r[ 2 ] , NIL , LREQ ); +++ codeon(); +++ if ( p == NIL ) { +++ return NIL; +++ } +++ contype = p; +++ } +++ } +++ /* +++ * put out the width of the comparison. +++ */ +++ putleaf( P2ICON , lwidth( contype ) , 0 , P2INT , 0 ); +++ /* +++ * and the left hand side, +++ * for sets, strings, records +++ */ +++ p = rvalue( r[ 2 ] , contype , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ p1 = rvalue( r[ 3 ] , p , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } else { +++ /* +++ * the easy (scalar or error) case +++ */ +++ p = rvalue( r[ 2 ] , contype , RREQ ); +++ if ( p == NIL ) { +++ return NIL; +++ /* +++ * since the second pass can't do +++ * long op double or double op long +++ * we may have to do some coercing. +++ */ +++ if ( isa( p , "i" ) && isa( p1 , "d" ) ) +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ p1 = rvalue( r[ 3 ] , p , RREQ ); +++ if ( isa( p , "d" ) && isa( p1 , "i" ) ) +++ putop( P2SCONV , P2DOUBLE ); +++ putop( relops[ r[0] - T_EQ ] , P2INT ); +++ } +++# endif PC +++ c = classify(p); +++ c1 = classify(p1); +++ if (nocomp(c) || nocomp(c1)) +++ return (NIL); +++ g = NIL; +++ switch (c) { +++ case TBOOL: +++ case TCHAR: +++ if (c != c1) +++ goto clash; +++ break; +++ case TINT: +++ case TDOUBLE: +++ if (c1 != TINT && c1 != TDOUBLE) +++ goto clash; +++ break; +++ case TSCAL: +++ if (c1 != TSCAL) +++ goto clash; +++ if (scalar(p) != scalar(p1)) +++ goto nonident; +++ break; +++ case TSET: +++ if (c1 != TSET) +++ goto clash; +++ if (p != p1) +++ goto nonident; +++ g = TSET; +++ break; +++ case TREC: +++ if ( c1 != TREC ) { +++ goto clash; +++ } +++ if ( p != p1 ) { +++ goto nonident; +++ } +++ if (r[0] != T_EQ && r[0] != T_NE) { +++ error("%s not allowed on records - only allow = and <>" , opname ); +++ return (NIL); +++ } +++ g = TREC; +++ break; +++ case TPTR: +++ case TNIL: +++ if (c1 != TPTR && c1 != TNIL) +++ goto clash; +++ if (r[0] != T_EQ && r[0] != T_NE) { +++ error("%s not allowed on pointers - only allow = and <>" , opname ); +++ return (NIL); +++ } +++ break; +++ case TSTR: +++ if (c1 != TSTR) +++ goto clash; +++ if (width(p) != width(p1)) { +++ error("Strings not same length in %s comparison", opname); +++ return (NIL); +++ } +++ g = TSTR; +++ break; +++ default: +++ panic("rval2"); +++ } +++# ifdef OBJ +++ return (gen(g, r[0], width(p), width(p1))); +++# endif OBJ +++# ifdef PC +++ return nl + TBOOL; +++# endif PC +++clash: +++ error("%ss and %ss cannot be compared - operator was %s", clnames[c], clnames[c1], opname); +++ return (NIL); +++nonident: +++ error("%s types must be identical in comparisons - operator was %s", clnames[c1], opname); +++ return (NIL); +++ +++ case T_IN: +++ rt = r[3]; +++# ifdef OBJ +++ if (rt != NIL && rt[0] == T_CSET) { +++ precset( rt , NIL , &csetd ); +++ p1 = csetd.csettype; +++ if (p1 == NIL) +++ return NIL; +++ postcset( rt, &csetd); +++ } else { +++ p1 = stkrval(r[3], NIL , RREQ ); +++ rt = NIL; +++ } +++# endif OBJ +++# ifdef PC +++ if (rt != NIL && rt[0] == T_CSET) { +++ if ( precset( rt , NIL , &csetd ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_IN" ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_INCT" ); +++ } +++ p1 = csetd.csettype; +++ if (p1 == NIL) +++ return NIL; +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_IN" ); +++ codeoff(); +++ p1 = rvalue(r[3], NIL , LREQ ); +++ codeon(); +++ } +++# endif PC +++ p = stkrval(r[2], NIL , RREQ ); +++ if (p == NIL || p1 == NIL) +++ return (NIL); +++ if (p1->class != SET) { +++ error("Right operand of 'in' must be a set, not %s", nameof(p1)); +++ return (NIL); +++ } +++ if (incompat(p, p1->type, r[2])) { +++ cerror("Index type clashed with set component type for 'in'"); +++ return (NIL); +++ } +++ setran(p1->type); +++# ifdef OBJ +++ if (rt == NIL || csetd.comptime) +++ put(4, O_IN, width(p1), set.lwrb, set.uprbp); +++ else +++ put(2, O_INCT, 3 + csetd.singcnt + 2*csetd.paircnt); +++# endif OBJ +++# ifdef PC +++ if ( rt == NIL || rt[0] != T_CSET ) { +++ putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ p1 = rvalue( r[3] , NIL , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else if ( csetd.comptime ) { +++ putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ postcset( r[3] , &csetd ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ postcset( r[3] , &csetd ); +++ } +++ putop( P2CALL , P2INT ); +++# endif PC +++ return (nl+T1BOOL); +++ default: +++ if (r[2] == NIL) +++ return (NIL); +++ switch (r[0]) { +++ default: +++ panic("rval3"); +++ +++ +++ /* +++ * An octal number +++ */ +++ case T_BINT: +++ f = a8tol(r[2]); +++ goto conint; +++ +++ /* +++ * A decimal number +++ */ +++ case T_INT: +++ f = atof(r[2]); +++conint: +++ if (f > MAXINT || f < MININT) { +++ error("Constant too large for this implementation"); +++ return (NIL); +++ } +++ l = f; +++ if (bytes(l, l) <= 2) { +++# ifdef OBJ +++ put(2, O_CON2, ( short ) l); +++# endif OBJ +++# ifdef PC +++ /* +++ * short constants are ints +++ */ +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++# endif PC +++ return (nl+T2INT); +++ } +++# ifdef OBJ +++ put(2, O_CON4, l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++# endif PC +++ return (nl+T4INT); +++ +++ /* +++ * A floating point number +++ */ +++ case T_FINT: +++# ifdef OBJ +++ put(2, O_CON8, atof(r[2])); +++# endif OBJ +++# ifdef PC +++ putCON8( atof( r[2] ) ); +++# endif PC +++ return (nl+TDOUBLE); +++ +++ /* +++ * Constant strings. Note that constant characters +++ * are constant strings of length one; there is +++ * no constant string of length one. +++ */ +++ case T_STRNG: +++ cp = r[2]; +++ if (cp[1] == 0) { +++# ifdef OBJ +++ put(2, O_CONC, cp[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 ); +++# endif PC +++ return (nl+T1CHAR); +++ } +++ goto cstrng; +++ } +++ +++ } +++} +++ +++/* +++ * Can a class appear +++ * in a comparison ? +++ */ +++nocomp(c) +++ int c; +++{ +++ +++ switch (c) { +++ case TREC: +++ if ( line != reccompline ) { +++ reccompline = line; +++ warning(); +++ if ( opt( 's' ) ) { +++ standard(); +++ } +++ error("record comparison is non-standard"); +++ } +++ break; +++ case TFILE: +++ case TARY: +++ error("%ss may not participate in comparisons", clnames[c]); +++ return (1); +++ } +++ return (NIL); +++} +++ +++ /* +++ * this is sort of like gconst, except it works on expression trees +++ * rather than declaration trees, and doesn't give error messages for +++ * non-constant things. +++ * as a side effect this fills in the con structure that gconst uses. +++ * this returns TRUE or FALSE. +++ */ +++constval(r) +++ register int *r; +++{ +++ register struct nl *np; +++ register *cn; +++ char *cp; +++ int negd, sgnd; +++ long ci; +++ +++ con.ctype = NIL; +++ cn = r; +++ negd = sgnd = 0; +++loop: +++ /* +++ * cn[2] is nil if error recovery generated a T_STRNG +++ */ +++ if (cn == NIL || cn[2] == NIL) +++ return FALSE; +++ switch (cn[0]) { +++ default: +++ return FALSE; +++ case T_MINUS: +++ negd = 1 - negd; +++ /* and fall through */ +++ case T_PLUS: +++ sgnd++; +++ cn = cn[2]; +++ goto loop; +++ case T_NIL: +++ con.cpval = NIL; +++ con.cival = 0; +++ con.crval = con.cival; +++ con.ctype = nl + TNIL; +++ break; +++ case T_VAR: +++ np = lookup(cn[2]); +++ if (np == NIL || np->class != CONST) { +++ return FALSE; +++ } +++ if ( cn[3] != NIL ) { +++ return FALSE; +++ } +++ con.ctype = np->type; +++ switch (classify(np->type)) { +++ case TINT: +++ con.crval = np->range[0]; +++ break; +++ case TDOUBLE: +++ con.crval = np->real; +++ break; +++ case TBOOL: +++ case TCHAR: +++ case TSCAL: +++ con.cival = np->value[0]; +++ con.crval = con.cival; +++ break; +++ case TSTR: +++ con.cpval = np->ptr[0]; +++ break; +++ default: +++ con.ctype = NIL; +++ return FALSE; +++ } +++ break; +++ case T_BINT: +++ con.crval = a8tol(cn[2]); +++ goto restcon; +++ case T_INT: +++ con.crval = atof(cn[2]); +++ if (con.crval > MAXINT || con.crval < MININT) { +++ derror("Constant too large for this implementation"); +++ con.crval = 0; +++ } +++restcon: +++ ci = con.crval; +++#ifndef PI0 +++ if (bytes(ci, ci) <= 2) +++ con.ctype = nl+T2INT; +++ else +++#endif +++ con.ctype = nl+T4INT; +++ break; +++ case T_FINT: +++ con.ctype = nl+TDOUBLE; +++ con.crval = atof(cn[2]); +++ break; +++ case T_STRNG: +++ cp = cn[2]; +++ if (cp[1] == 0) { +++ con.ctype = nl+T1CHAR; +++ con.cival = cp[0]; +++ con.crval = con.cival; +++ break; +++ } +++ con.ctype = nl+TSTR; +++ con.cpval = cp; +++ break; +++ } +++ if (sgnd) { +++ if (isnta(con.ctype, "id")) { +++ derror("%s constants cannot be signed", nameof(con.ctype)); +++ return FALSE; +++ } else if (negd) +++ con.crval = -con.crval; +++ } +++ return TRUE; +++} diff --cc usr/src/cmd/pc0/send.h index 0000000000,0000000000,0000000000..ef74c70969 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/send.h @@@@ -1,0 -1,0 -1,0 +1,32 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)send.h 1.1 8/27/80"; */ +++ +++#define RINIT 1 +++#define RENQ 2 +++#define RTREE 3 +++#define RTRFREE 4 +++#define RTRCHK 5 +++#define REVENIT 6 +++#define RSTRING 7 +++#define REVLAB 8 +++#define REVCNST 9 +++#define REVTBEG 10 +++#define REVTYPE 11 +++#define REVTEND 12 +++#define REVVBEG 13 +++#define REVVAR 14 +++#define REVVEND 15 +++#define REVFHDR 16 +++#define REVFFWD 17 +++#define REVFBDY 18 +++#define REVFEND 19 +++#define ROPUSH 20 +++#define ROPOP 21 +++#define ROSET 22 +++#define RKILL 23 +++#define RFINISH 24 +++ +++#define RLAST 24 +++ +++extern char *trdesc[]; diff --cc usr/src/cmd/pc0/stab.c index 0000000000,0000000000,0000000000..3f99d53a92 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/stab.c @@@@ -1,0 -1,0 -1,0 +1,313 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stab.c 1.3 9/4/80"; +++ +++ /* +++ * procedures to put out sdb symbol table information. +++ * and stabs for separate compilation type checking. +++ * these use the new .stabs, .stabn, and .stabd directives +++ */ +++ +++#include "whoami.h" +++#ifdef PC +++ /* and the rest of the file */ +++# include "0.h" +++# include +++ +++ /* +++ * additional symbol definition for +++ * that is used by the separate compilation facility -- +++ * eventually, should be updated to include this +++ */ +++ +++# include "pstab.h" +++# include "pc.h" +++ +++ /* +++ * absolute value: line numbers are negative if error recovery. +++ */ +++#define ABS( x ) ( x < 0 ? -x : x ) +++ +++ /* +++ * variables +++ */ +++stabvar( name , type , level , offset , length , line ) +++ char *name; +++ int type; +++ int level; +++ int offset; +++ int length; +++ int line; +++ { +++ +++ /* +++ * for separate compilation +++ */ +++ if ( level == 1 ) { +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , N_PGVAR , ABS( line ) ); +++ } +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ if ( level == 1 ) { +++ putprintf( "\",0x%x,0,0x%x,0" , 0 , N_GSYM , type ); +++ } else { +++ putprintf( "\",0x%x,0,0x%x,0x%x" , 0 , N_LSYM , type , offset ); +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0,0x%x" , 0 , N_LENG , length ); +++ +++} +++ +++ +++ /* +++ * parameters +++ */ +++stabparam( name , type , offset , length ) +++ char *name; +++ int type; +++ int offset; +++ int length; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0x%x,0x%x" , 0 , N_PSYM , type , offset ); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0,0x%x" , 0 , N_LENG , length ); +++ } +++ +++ /* +++ * fields +++ */ +++stabfield( name , type , offset , length ) +++ char *name; +++ int type; +++ int offset; +++ int length; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0x%x,0x%x" , 0 , N_SSYM , type , offset ); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0,0x%x" , 0 , N_LENG , length ); +++ } +++ +++ /* +++ * left brackets +++ */ +++stablbrac( level ) +++ int level; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabd 0x%x,0,0x%x" , 0 , N_LBRAC , level ); +++ } +++ +++ /* +++ * right brackets +++ */ +++stabrbrac( level ) +++ int level; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabd 0x%x,0,0x%x" , 0 , N_RBRAC , level ); +++ } +++ +++ /* +++ * functions +++ */ +++stabfunc( name , class , line , level ) +++ char *name; +++ int class; +++ int line; +++ long level; +++ { +++ int type; +++ long i; +++ +++ /* +++ * for separate compilation +++ */ +++ if ( level == 1 ) { +++ if ( class == FUNC ) { +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , N_PGFUNC , ABS( line ) ); +++ } else if ( class == PROC ) { +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , N_PGPROC , ABS( line ) ); +++ } +++ } +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0x%x," , 1 , N_FUN , line ); +++ for ( i = 1 ; i < level ; i++ ) { +++ putprintf( EXTFORMAT , 1 , enclosing[ i ] ); +++ } +++ putprintf( EXTFORMAT , 0 , name ); +++ } +++ +++ /* +++ * source line numbers +++ */ +++stabline( line ) +++ int line; +++ { +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabd 0x%x,0,0x%x" , 0 , N_SLINE , ABS( line ) ); +++ } +++ +++ /* +++ * source files +++ */ +++stabsource( filename ) +++ char *filename; +++ { +++ int label; +++ +++ /* +++ * for separate compilation +++ */ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0" , 0 +++ , filename , N_PC , N_PSO ); +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ label = getlab(); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , filename ); +++ putprintf( "\",0x%x,0,0," , 1 , N_SO ); +++ putprintf( PREFIXFORMAT , 0 , LLABELPREFIX , label ); +++ putprintf( PREFIXFORMAT , 1 , LLABELPREFIX , label ); +++ putprintf( ":" , 0 ); +++ } +++ +++ /* +++ * included files get one or more of these: +++ * one as they are entered by a #include, +++ * and one every time they are returned to by nested #includes +++ */ +++stabinclude( filename ) +++ char *filename; +++ { +++ int label; +++ +++ /* +++ * for separate compilation +++ */ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0" , 0 +++ , filename , N_PC , N_PSOL ); +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ label = getlab(); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , filename ); +++ putprintf( "\",0x%x,0,0," , 1 , N_SOL ); +++ putprintf( PREFIXFORMAT , 0 , LLABELPREFIX , label ); +++ putprintf( PREFIXFORMAT , 1 , LLABELPREFIX , label ); +++ putprintf( ":" , 0 ); +++ } +++ +++ +++/* +++ * global Pascal symbols : +++ * labels, types, constants, and external procedure and function names: +++ * These are used by the separate compilation facility +++ * to be able to check for disjoint header files. +++ */ +++ +++ /* +++ * global labels +++ */ +++stabglabel( label , line ) +++ char *label; +++ int line; +++ { +++ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , label , N_PC , N_PGLABEL , ABS( line ) ); +++ } +++ +++ /* +++ * global constants +++ */ +++stabgconst( const , line ) +++ char *const; +++ int line; +++ { +++ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , const , N_PC , N_PGCONST , ABS( line ) ); +++ } +++ +++ /* +++ * global types +++ */ +++stabgtype( type , line ) +++ char *type; +++ int line; +++ { +++ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , type , N_PC , N_PGTYPE , ABS( line ) ); +++ } +++ +++ +++ /* +++ * external functions and procedures +++ */ +++stabefunc( name , class , line ) +++ char *name; +++ int class; +++ int line; +++ { +++ int type; +++ +++ if ( class == FUNC ) { +++ type = N_PEFUNC; +++ } else if ( class == PROC ) { +++ type = N_PEPROC; +++ } else { +++ return; +++ } +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , type , ABS( line ) ); +++ } +++ +++#endif PC diff --cc usr/src/cmd/pc0/stat.c index 0000000000,0000000000,0000000000..c4b44b2bf7 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/stat.c @@@@ -1,0 -1,0 -1,0 +1,752 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stat.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pcops.h" +++# include "pc.h" +++#endif PC +++ +++int cntstat; +++short cnts = 3; +++#include "opcode.h" +++ +++/* +++ * Statement list +++ */ +++statlist(r) +++ int *r; +++{ +++ register *sl; +++ +++ for (sl=r; sl != NIL; sl=sl[2]) +++ statement(sl[1]); +++} +++ +++/* +++ * Statement +++ */ +++statement(r) +++ int *r; +++{ +++ register *s; +++ register struct nl *snlp; +++ long soffset; +++ +++ s = r; +++ snlp = nlp; +++ soffset = sizes[ cbn ].om_off; +++top: +++ if (cntstat) { +++ cntstat = 0; +++ putcnt(); +++ } +++ if (s == NIL) +++ return; +++ line = s[1]; +++ if (s[0] == T_LABEL) { +++ labeled(s[2]); +++ s = s[3]; +++ noreach = 0; +++ cntstat = 1; +++ goto top; +++ } +++ if (noreach) { +++ noreach = 0; +++ warning(); +++ error("Unreachable statement"); +++ } +++ switch (s[0]) { +++ case T_PCALL: +++ putline(); +++# ifdef OBJ +++ proc(s); +++# endif OBJ +++# ifdef PC +++ pcproc( s ); +++# endif PC +++ break; +++ case T_ASGN: +++ putline(); +++ asgnop(s); +++ break; +++ case T_GOTO: +++ putline(); +++ gotoop(s[2]); +++ noreach = 1; +++ cntstat = 1; +++ break; +++ default: +++ level++; +++ switch (s[0]) { +++ default: +++ panic("stat"); +++ case T_IF: +++ case T_IFEL: +++ ifop(s); +++ break; +++ case T_WHILE: +++ whilop(s); +++ noreach = 0; +++ break; +++ case T_REPEAT: +++ repop(s); +++ break; +++ case T_FORU: +++ case T_FORD: +++# ifdef OBJ +++ forop(s); +++# endif OBJ +++# ifdef PC +++ pcforop( s ); +++# endif PC +++ noreach = 0; +++ break; +++ case T_BLOCK: +++ statlist(s[2]); +++ break; +++ case T_CASE: +++ putline(); +++# ifdef OBJ +++ caseop(s); +++# endif OBJ +++# ifdef PC +++ pccaseop( s ); +++# endif PC +++ break; +++ case T_WITH: +++ withop(s); +++ break; +++ case T_ASRT: +++ putline(); +++ asrtop(s); +++ break; +++ } +++ --level; +++ if (gotos[cbn]) +++ ungoto(); +++ break; +++ } +++ /* +++ * Free the temporary name list entries defined in +++ * expressions, e.g. STRs, and WITHPTRs from withs. +++ */ +++ nlfree(snlp); +++ /* +++ * free any temporaries allocated for this statement +++ * these come from strings and sets. +++ */ +++ if ( soffset != sizes[ cbn ].om_off ) { +++ sizes[ cbn ].om_off = soffset; +++# ifdef PC +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++# endif PC +++ } +++} +++ +++ungoto() +++{ +++ register struct nl *p; +++ +++ for (p = gotos[cbn]; p != NIL; p = p->chain) +++ if ((p->nl_flags & NFORWD) != 0) { +++ if (p->value[NL_GOLEV] != NOTYET) +++ if (p->value[NL_GOLEV] > level) +++ p->value[NL_GOLEV] = level; +++ } else +++ if (p->value[NL_GOLEV] != DEAD) +++ if (p->value[NL_GOLEV] > level) +++ p->value[NL_GOLEV] = DEAD; +++} +++ +++putcnt() +++{ +++ +++ if (monflg == 0) { +++ return; +++ } +++ inccnt( getcnt() ); +++} +++ +++int +++getcnt() +++ { +++ +++ return ++cnts; +++ } +++ +++inccnt( counter ) +++ int counter; +++ { +++ +++# ifdef OBJ +++ put2(O_COUNT, counter ); +++# endif OBJ +++# ifdef PC +++ putRV( PCPCOUNT , 0 , counter * sizeof (long) , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2ASG P2PLUS , P2INT ); +++ putdot( filename , line ); +++# endif PC +++ } +++ +++putline() +++{ +++ +++# ifdef OBJ +++ if (opt('p') != 0) +++ put2(O_LINO, line); +++# endif OBJ +++# ifdef PC +++ static lastline; +++ +++ if ( line != lastline ) { +++ stabline( line ); +++ lastline = line; +++ } +++ if ( opt( 'p' ) ) { +++ if ( opt('t') ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_LINO" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else { +++ putRV( STMTCOUNT , 0 , 0 , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2ASG P2PLUS , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++# endif PC +++} +++ +++/* +++ * With varlist do stat +++ * +++ * With statement requires an extra word +++ * in automatic storage for each level of withing. +++ * These indirect pointers are initialized here, and +++ * the scoping effect of the with statement occurs +++ * because lookup examines the field names of the records +++ * associated with the WITHPTRs on the withlist. +++ */ +++withop(s) +++ int *s; +++{ +++ register *p; +++ register struct nl *r; +++ int i; +++ int *swl; +++ long soffset; +++ +++ putline(); +++ swl = withlist; +++ soffset = sizes[cbn].om_off; +++ for (p = s[2]; p != NIL; p = p[2]) { +++ i = sizes[cbn].om_off -= sizeof ( int * ); +++ if (sizes[cbn].om_off < sizes[cbn].om_max) +++ sizes[cbn].om_max = sizes[cbn].om_off; +++# ifdef OBJ +++ put2(O_LV | cbn <<8+INDX, i ); +++# endif OBJ +++# ifdef PC +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ putRV( 0 , cbn , i , P2PTR|P2STRTY ); +++# endif PC +++ r = lvalue(p[1], MOD , LREQ ); +++ if (r == NIL) +++ continue; +++ if (r->class != RECORD) { +++ error("Variable in with statement refers to %s, not to a record", nameof(r)); +++ continue; +++ } +++ r = defnl(0, WITHPTR, r, i); +++ r->nl_next = withlist; +++ withlist = r; +++# ifdef OBJ +++ put(1, PTR_AS); +++# endif OBJ +++# ifdef PC +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++# endif PC +++ } +++ statement(s[3]); +++ sizes[cbn].om_off = soffset; +++# ifdef PC +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++# endif PC +++ withlist = swl; +++} +++ +++extern flagwas; +++/* +++ * var := expr +++ */ +++asgnop(r) +++ int *r; +++{ +++ register struct nl *p; +++ register *av; +++ +++ if (r == NIL) +++ return (NIL); +++ /* +++ * Asgnop's only function is +++ * to handle function variable +++ * assignments. All other assignment +++ * stuff is handled by asgnop1. +++ * the if below checks for unqualified lefthandside: +++ * necessary for fvars. +++ */ +++ av = r[2]; +++ if (av != NIL && av[0] == T_VAR && av[3] == NIL) { +++ p = lookup1(av[2]); +++ if (p != NIL) +++ p->nl_flags = flagwas; +++ if (p != NIL && p->class == FVAR) { +++ /* +++ * Give asgnop1 the func +++ * which is the chain of +++ * the FVAR. +++ */ +++ p->nl_flags |= NUSED|NMOD; +++ p = p->chain; +++ if (p == NIL) { +++ rvalue(r[3], NIL , RREQ ); +++ return; +++ } +++# ifdef OBJ +++ put2(O_LV | bn << 8+INDX, p->value[NL_OFFS]); +++ if (isa(p->type, "i") && width(p->type) == 1) +++ asgnop1(r, nl+T2INT); +++ else +++ asgnop1(r, p->type); +++# endif OBJ +++# ifdef PC +++ /* +++ * this should be the lvalue of the fvar, +++ * but since the second pass knows to use +++ * the address of the left operand of an +++ * assignment, what i want here is an rvalue. +++ * see note in funchdr about fvar allocation. +++ */ +++ p = p -> ptr[ NL_FVAR ]; +++ putRV( p -> symbol , bn , p -> value[ NL_OFFS ] +++ , p2type( p -> type ) ); +++ asgnop1( r , p -> type ); +++# endif PC +++ return; +++ } +++ } +++ asgnop1(r, NIL); +++} +++ +++/* +++ * Asgnop1 handles all assignments. +++ * If p is not nil then we are assigning +++ * to a function variable, otherwise +++ * we look the variable up ourselves. +++ */ +++struct nl * +++asgnop1(r, p) +++ int *r; +++ register struct nl *p; +++{ +++ register struct nl *p1; +++ +++ if (r == NIL) +++ return (NIL); +++ if (p == NIL) { +++# ifdef OBJ +++ p = lvalue(r[2], MOD|ASGN|NOUSE , LREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * since the second pass knows that it should reference +++ * the lefthandside of asignments, what i need here is +++ * an rvalue. +++ */ +++ p = lvalue( r[2] , MOD|ASGN|NOUSE , RREQ ); +++# endif PC +++ if ( p == NIL ) { +++ rvalue( r[3] , NIL , RREQ ); +++ return NIL; +++ } +++ } +++# ifdef OBJ +++ p1 = rvalue(r[3], p , RREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * if this is a scalar assignment, +++ * then i want to rvalue the righthandside. +++ * if this is a structure assignment, +++ * then i want an lvalue to the righthandside. +++ * that's what the intermediate form sez. +++ */ +++ switch ( classify( p ) ) { +++ case TINT: +++ case TCHAR: +++ case TBOOL: +++ case TSCAL: +++ precheck( p , "_RANG4" , "_RSNG4" ); +++ case TDOUBLE: +++ case TPTR: +++ p1 = rvalue( r[3] , p , RREQ ); +++ break; +++ default: +++ p1 = rvalue( r[3] , p , LREQ ); +++ break; +++ } +++# endif PC +++ if (p1 == NIL) +++ return (NIL); +++ if (incompat(p1, p, r[3])) { +++ cerror("Type of expression clashed with type of variable in assignment"); +++ return (NIL); +++ } +++ switch (classify(p)) { +++ case TINT: +++ case TBOOL: +++ case TCHAR: +++ case TSCAL: +++# ifdef OBJ +++ rangechk(p, p1); +++# endif OBJ +++# ifdef PC +++ postcheck( p ); +++# endif PC +++ case TDOUBLE: +++ case TPTR: +++# ifdef OBJ +++ gen(O_AS2, O_AS2, width(p), width(p1)); +++# endif OBJ +++# ifdef PC +++ putop( P2ASSIGN , p2type( p ) ); +++ putdot( filename , line ); +++# endif PC +++ break; +++ default: +++# ifdef OBJ +++ put2(O_AS, width(p)); +++# endif OBJ +++# ifdef PC +++ putstrop( P2STASG , p2type( p ) +++ , lwidth( p ) , align( p ) ); +++ putdot( filename , line ); +++# endif PC +++ } +++ return (p); /* Used by for statement */ +++} +++ +++#ifdef OBJ +++/* +++ * for var := expr [down]to expr do stat +++ */ +++forop(r) +++ int *r; +++{ +++ register struct nl *t1, *t2; +++ int l1, l2, l3; +++ long soffset; +++ register op; +++ struct nl *p; +++ int *rr, goc, i; +++ +++ p = NIL; +++ goc = gocnt; +++ if (r == NIL) +++ goto aloha; +++ putline(); +++ /* +++ * Start with assignment +++ * of initial value to for variable +++ */ +++ t1 = asgnop1(r[2], NIL); +++ if (t1 == NIL) { +++ rvalue(r[3], NIL , RREQ ); +++ statement(r[4]); +++ goto aloha; +++ } +++ rr = r[2]; /* Assignment */ +++ rr = rr[2]; /* Lhs variable */ +++ if (rr[3] != NIL) { +++ error("For variable must be unqualified"); +++ rvalue(r[3], NIL , RREQ ); +++ statement(r[4]); +++ goto aloha; +++ } +++ p = lookup(rr[2]); +++ p->value[NL_FORV] = 1; +++ if (isnta(t1, "bcis")) { +++ error("For variables cannot be %ss", nameof(t1)); +++ statement(r[4]); +++ goto aloha; +++ } +++ /* +++ * Allocate automatic +++ * space for limit variable +++ */ +++ sizes[cbn].om_off -= 4; +++ if (sizes[cbn].om_off < sizes[cbn].om_max) +++ sizes[cbn].om_max = sizes[cbn].om_off; +++ i = sizes[cbn].om_off; +++ /* +++ * Initialize the limit variable +++ */ +++ put2(O_LV | cbn<<8+INDX, i); +++ t2 = rvalue(r[3], NIL , RREQ ); +++ if (incompat(t2, t1, r[3])) { +++ cerror("Limit type clashed with index type in 'for' statement"); +++ statement(r[4]); +++ goto aloha; +++ } +++ put1(width(t2) <= 2 ? O_AS24 : O_AS4); +++ /* +++ * See if we can skip the loop altogether +++ */ +++ rr = r[2]; +++ if (rr != NIL) +++ rvalue(rr[2], NIL , RREQ ); +++ put2(O_RV4 | cbn<<8+INDX, i); +++ gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4); +++ /* +++ * L1 will be patched to skip the body of the loop. +++ * L2 marks the top of the loop when we go around. +++ */ +++ put2(O_IF, (l1 = getlab())); +++ putlab(l2 = getlab()); +++ putcnt(); +++ statement(r[4]); +++ /* +++ * now we see if we get to go again +++ */ +++ if (opt('t') == 0) { +++ /* +++ * Easy if we dont have to test +++ */ +++ put2(O_RV4 | cbn<<8+INDX, i); +++ if (rr != NIL) +++ lvalue(rr[2], MOD , RREQ ); +++ put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2); +++ } else { +++ line = r[1]; +++ putline(); +++ if (rr != NIL) +++ rvalue(rr[2], NIL , RREQ ); +++ put2(O_RV4 | cbn << 8+INDX, i); +++ gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4); +++ l3 = put2(O_IF, getlab()); +++ lvalue((int *) rr[2], MOD , RREQ ); +++ rvalue(rr[2], NIL , RREQ ); +++ put2(O_CON2, 1); +++ t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2); +++ rangechk(t1, t2); /* The point of all this */ +++ gen(O_AS2, O_AS2, width(t1), width(t2)); +++ put2(O_TRA, l2); +++ patch(l3); +++ } +++ sizes[cbn].om_off += 4; +++ patch(l1); +++aloha: +++ noreach = 0; +++ if (p != NIL) +++ p->value[NL_FORV] = 0; +++ if (goc != gocnt) +++ putcnt(); +++} +++#endif OBJ +++ +++/* +++ * if expr then stat [ else stat ] +++ */ +++ifop(r) +++ int *r; +++{ +++ register struct nl *p; +++ register l1, l2; /* l1 is start of else, l2 is end of else */ +++ int nr, goc; +++ +++ goc = gocnt; +++ if (r == NIL) +++ return; +++ putline(); +++ p = rvalue(r[2], NIL , RREQ ); +++ if (p == NIL) { +++ statement(r[3]); +++ noreach = 0; +++ statement(r[4]); +++ noreach = 0; +++ return; +++ } +++ if (isnta(p, "b")) { +++ error("Type of expression in if statement must be Boolean, not %s", nameof(p)); +++ statement(r[3]); +++ noreach = 0; +++ statement(r[4]); +++ noreach = 0; +++ return; +++ } +++# ifdef OBJ +++ l1 = put2(O_IF, getlab()); +++# endif OBJ +++# ifdef PC +++ l1 = getlab(); +++ putleaf( P2ICON , l1 , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++# endif PC +++ putcnt(); +++ statement(r[3]); +++ nr = noreach; +++ if (r[4] != NIL) { +++ /* +++ * else stat +++ */ +++ --level; +++ ungoto(); +++ ++level; +++# ifdef OBJ +++ l2 = put2(O_TRA, getlab()); +++# endif OBJ +++# ifdef PC +++ l2 = getlab(); +++ putjbr( l2 ); +++# endif PC +++ patch(l1); +++ noreach = 0; +++ statement(r[4]); +++ noreach &= nr; +++ l1 = l2; +++ } else +++ noreach = 0; +++ patch(l1); +++ if (goc != gocnt) +++ putcnt(); +++} +++ +++/* +++ * while expr do stat +++ */ +++whilop(r) +++ int *r; +++{ +++ register struct nl *p; +++ register l1, l2; +++ int goc; +++ +++ goc = gocnt; +++ if (r == NIL) +++ return; +++ putlab(l1 = getlab()); +++ putline(); +++ p = rvalue(r[2], NIL , RREQ ); +++ if (p == NIL) { +++ statement(r[3]); +++ noreach = 0; +++ return; +++ } +++ if (isnta(p, "b")) { +++ error("Type of expression in while statement must be Boolean, not %s", nameof(p)); +++ statement(r[3]); +++ noreach = 0; +++ return; +++ } +++ l2 = getlab(); +++# ifdef OBJ +++ put2(O_IF, l2); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l2 , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++# endif PC +++ putcnt(); +++ statement(r[3]); +++# ifdef OBJ +++ put2(O_TRA, l1); +++# endif OBJ +++# ifdef PC +++ putjbr( l1 ); +++# endif PC +++ patch(l2); +++ if (goc != gocnt) +++ putcnt(); +++} +++ +++/* +++ * repeat stat* until expr +++ */ +++repop(r) +++ int *r; +++{ +++ register struct nl *p; +++ register l; +++ int goc; +++ +++ goc = gocnt; +++ if (r == NIL) +++ return; +++ l = putlab(getlab()); +++ putcnt(); +++ statlist(r[2]); +++ line = r[1]; +++ p = rvalue(r[3], NIL , RREQ ); +++ if (p == NIL) +++ return; +++ if (isnta(p,"b")) { +++ error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p)); +++ return; +++ } +++# ifdef OBJ +++ put2(O_IF, l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++# endif PC +++ if (goc != gocnt) +++ putcnt(); +++} +++ +++/* +++ * assert expr +++ */ +++asrtop(r) +++ register int *r; +++{ +++ register struct nl *q; +++ +++ if (opt('s')) { +++ standard(); +++ error("Assert statement is non-standard"); +++ } +++ if (!opt('t')) +++ return; +++ r = r[2]; +++# ifdef OBJ +++ q = rvalue((int *) r, NLNIL , RREQ ); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_ASRT" ); +++ q = stkrval( r , NLNIL , RREQ ); +++# endif PC +++ if (q == NIL) +++ return; +++ if (isnta(q, "b")) +++ error("Assert expression must be Boolean, not %ss", nameof(q)); +++# ifdef OBJ +++ put1(O_ASRT); +++# endif OBJ +++# ifdef PC +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++# endif PC +++} diff --cc usr/src/cmd/pc0/stklval.c index 0000000000,0000000000,0000000000..c62b436acc new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/stklval.c @@@@ -1,0 -1,0 -1,0 +1,26 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stklval.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++ +++/* +++ * Lvalue computes the address +++ * of a qualified name and +++ * leaves it on the stack. +++ */ +++struct nl * +++stklval(r, modflag) +++ int *r, modflag; +++{ +++ /* +++ * For the purposes of the interpreter stklval +++ * is the same as an lvalue. +++ */ +++ +++ return(lvalue(r, modflag , LREQ )); +++} diff --cc usr/src/cmd/pc0/stkrval.c index 0000000000,0000000000,0000000000..aa46cbbb2d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/stkrval.c @@@@ -1,0 -1,0 -1,0 +1,382 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stkrval.c 1.3 10/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pcops.h" +++#endif PC +++ +++/* +++ * stkrval Rvalue - an expression, and coerce it to be a stack quantity. +++ * +++ * Contype is the type that the caller would prefer, nand is important +++ * if constant sets or constant strings are involved, the latter +++ * because of string padding. +++ */ +++/* +++ * for the obj version, this is a copy of rvalue hacked to use fancy new +++ * push-onto-stack-and-convert opcodes. +++ * for the pc version, i just call rvalue and convert if i have to, +++ * based on the return type of rvalue. +++ */ +++struct nl * +++stkrval(r, contype , required ) +++ register int *r; +++ struct nl *contype; +++ long required; +++{ +++ register struct nl *p; +++ register struct nl *q; +++ register char *cp, *cp1; +++ register int c, w; +++ int **pt; +++ long l; +++ double f; +++ +++ if (r == NIL) +++ return (NIL); +++ if (nowexp(r)) +++ return (NIL); +++ /* +++ * The root of the tree tells us what sort of expression we have. +++ */ +++ switch (r[0]) { +++ +++ /* +++ * The constant nil +++ */ +++ case T_NIL: +++# ifdef OBJ +++ put(2, O_CON14, 0); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++# endif PC +++ return (nl+TNIL); +++ +++ case T_FCALL: +++ case T_VAR: +++ p = lookup(r[2]); +++ if (p == NIL || p->class == BADUSE) +++ return (NIL); +++ switch (p->class) { +++ case VAR: +++ /* +++ if a variable is +++ * qualified then get +++ * the rvalue by a +++ * stklval and an ind. +++ */ +++ if (r[3] != NIL) +++ goto ind; +++ q = p->type; +++ if (q == NIL) +++ return (NIL); +++ if (classify(q) == TSTR) +++ return(stklval(r, NOFLAGS)); +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(2, O_RV8 | bn << 8+INDX, p->value[0]); +++ return(q); +++ case 4: +++ put(2, O_RV4 | bn << 8+INDX, p->value[0]); +++ return(q); +++ case 2: +++ put(2, O_RV24 | bn << 8+INDX, p->value[0]); +++ return(q); +++ case 1: +++ put(2, O_RV14 | bn << 8+INDX, p->value[0]); +++ return(q); +++ default: +++ put(3, O_RV | bn << 8+INDX, p->value[0], w); +++ return(q); +++ } +++# endif OBJ +++# ifdef PC +++ return rvalue( r , contype , required ); +++# endif PC +++ +++ case WITHPTR: +++ case REF: +++ /* +++ * A stklval for these +++ * is actually what one +++ * might consider a rvalue. +++ */ +++ind: +++ q = stklval(r, NOFLAGS); +++ if (q == NIL) +++ return (NIL); +++ if (classify(q) == TSTR) +++ return(q); +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(1, O_IND8); +++ return(q); +++ case 4: +++ put(1, O_IND4); +++ return(q); +++ case 2: +++ put(1, O_IND24); +++ return(q); +++ case 1: +++ put(1, O_IND14); +++ return(q); +++ default: +++ put(2, O_IND, w); +++ return(q); +++ } +++# endif OBJ +++# ifdef PC +++ if ( required == RREQ ) { +++ putop( P2UNARY P2MUL , p2type( q ) ); +++ } +++ return q; +++# endif PC +++ +++ case CONST: +++ if (r[3] != NIL) { +++ error("%s is a constant and cannot be qualified", r[2]); +++ return (NIL); +++ } +++ q = p->type; +++ if (q == NIL) +++ return (NIL); +++ if (q == nl+TSTR) { +++ /* +++ * Find the size of the string +++ * constant if needed. +++ */ +++ cp = p->ptr[0]; +++cstrng: +++ cp1 = cp; +++ for (c = 0; *cp++; c++) +++ continue; +++ w = 0; +++ if (contype != NIL && !opt('s')) { +++ if (width(contype) < c && classify(contype) == TSTR) { +++ error("Constant string too long"); +++ return (NIL); +++ } +++ w = width(contype) - c; +++ } +++# ifdef OBJ +++ put(2, O_LVCON, lenstr(cp1, w)); +++ putstr(cp1, w); +++# endif OBJ +++# ifdef PC +++ putCONG( cp1 , c + w , LREQ ); +++# endif PC +++ /* +++ * Define the string temporarily +++ * so later people can know its +++ * width. +++ * cleaned out by stat. +++ */ +++ q = defnl(0, STR, 0, c); +++ q->type = q; +++ return (q); +++ } +++ if (q == nl+T1CHAR) { +++# ifdef OBJ +++ put(2, O_CONC4, p->value[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , p -> value[0] , 0 , P2CHAR , 0 ); +++# endif PC +++ return(q); +++ } +++ /* +++ * Every other kind of constant here +++ */ +++# ifdef OBJ +++ switch (width(q)) { +++ case 8: +++#ifndef DEBUG +++ put(2, O_CON8, p->real); +++ return(q); +++#else +++ if (hp21mx) { +++ f = p->real; +++ conv(&f); +++ l = f.plong; +++ put(2, O_CON4, l); +++ } else +++ put(2, O_CON8, p->real); +++ return(q); +++#endif +++ case 4: +++ put(2, O_CON4, p->range[0]); +++ return(q); +++ case 2: +++ put(2, O_CON24, (short)p->range[0]); +++ return(q); +++ case 1: +++ put(2, O_CON14, (short)p->range[0]); +++ return(q); +++ default: +++ panic("stkrval"); +++ } +++# endif OBJ +++# ifdef PC +++ return rvalue( r , contype , required ); +++# endif PC +++ +++ case FUNC: +++ case FFUNC: +++ /* +++ * Function call +++ */ +++ pt = (int **)r[3]; +++ if (pt != NIL) { +++ switch (pt[1][0]) { +++ case T_PTR: +++ case T_ARGL: +++ case T_ARY: +++ case T_FIELD: +++ error("Can't qualify a function result value"); +++ return (NIL); +++ } +++ } +++# ifdef OBJ +++ q = p->type; +++ if (classify(q) == TSTR) { +++ c = width(q); +++ put(2, O_LVCON, even(c+1)); +++ putstr("", c); +++ put(1, O_SDUP4); +++ p = funccod(r); +++ put(2, O_AS, c); +++ return(p); +++ } +++ p = funccod(r); +++ if (width(p) <= 2) +++ put(1, O_STOI); +++# endif OBJ +++# ifdef PC +++ p = pcfunccod( r ); +++# endif PC +++ return (p); +++ +++ case TYPE: +++ error("Type names (e.g. %s) allowed only in declarations", p->symbol); +++ return (NIL); +++ +++ case PROC: +++ case FPROC: +++ error("Procedure %s found where expression required", p->symbol); +++ return (NIL); +++ default: +++ panic("stkrvid"); +++ } +++ case T_PLUS: +++ case T_MINUS: +++ case T_NOT: +++ case T_AND: +++ case T_OR: +++ case T_DIVD: +++ case T_MULT: +++ case T_SUB: +++ case T_ADD: +++ case T_MOD: +++ case T_DIV: +++ case T_EQ: +++ case T_NE: +++ case T_GE: +++ case T_LE: +++ case T_GT: +++ case T_LT: +++ case T_IN: +++ p = rvalue(r, contype , required ); +++# ifdef OBJ +++ if (width(p) <= 2) +++ put(1, O_STOI); +++# endif OBJ +++ return (p); +++ case T_CSET: +++ p = rvalue(r, contype , required ); +++ return (p); +++ default: +++ if (r[2] == NIL) +++ return (NIL); +++ switch (r[0]) { +++ default: +++ panic("stkrval3"); +++ +++ /* +++ * An octal number +++ */ +++ case T_BINT: +++ f = a8tol(r[2]); +++ goto conint; +++ +++ /* +++ * A decimal number +++ */ +++ case T_INT: +++ f = atof(r[2]); +++conint: +++ if (f > MAXINT || f < MININT) { +++ error("Constant too large for this implementation"); +++ return (NIL); +++ } +++ l = f; +++ if (bytes(l, l) <= 2) { +++# ifdef OBJ +++ put(2, O_CON24, (short)l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); +++# endif PC +++ return(nl+T4INT); +++ } +++# ifdef OBJ +++ put(2, O_CON4, l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++# endif PC +++ return (nl+T4INT); +++ +++ /* +++ * A floating point number +++ */ +++ case T_FINT: +++# ifdef OBJ +++ put(2, O_CON8, atof(r[2])); +++# endif OBJ +++# ifdef PC +++ putCON8( atof( r[2] ) ); +++# endif PC +++ return (nl+TDOUBLE); +++ +++ /* +++ * Constant strings. Note that constant characters +++ * are constant strings of length one; there is +++ * no constant string of length one. +++ */ +++ case T_STRNG: +++ cp = r[2]; +++ if (cp[1] == 0) { +++# ifdef OBJ +++ put(2, O_CONC4, cp[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 ); +++# endif PC +++ return(nl+T1CHAR); +++ } +++ goto cstrng; +++ } +++ +++ } +++} diff --cc usr/src/cmd/pc0/string.c index 0000000000,0000000000,0000000000..2cd1b7003d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/string.c @@@@ -1,0 -1,0 -1,0 +1,150 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)string.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#ifndef PI01 +++#ifndef PXP +++#include "send.h" +++#endif +++#endif +++ +++/* +++ * STRING SPACE DECLARATIONS +++ * +++ * Strng is the base of the current +++ * string space and strngp the +++ * base of the free area therein. +++ * Strp is the array of descriptors. +++ */ +++#ifndef PI0 +++STATIC char strings[STRINC]; +++STATIC char *strng = strings; +++STATIC char *strngp = strings; +++#else +++char *strng, *strngp; +++#endif +++#ifndef PI01 +++#ifndef PXP +++STATIC char *strp[20]; +++STATIC char **stract strp; +++int strmax; +++#endif +++#endif +++ +++#ifndef PI01 +++#ifndef PXP +++#ifndef PI0 +++initstring() +++#else +++initstring(strings) +++ char *strings; +++#endif +++{ +++ +++ *stract++ = strings; +++#ifdef PI0 +++ strng = strngp = strings; +++#endif +++ strmax = STRINC * 2; +++} +++#endif +++#endif +++ +++/* +++ * Copy a string into the string area. +++ */ +++char * +++savestr(cp) +++ register char *cp; +++{ +++ register int i; +++ +++ i = strlen(cp) + 1; +++ if (strngp + i >= strng + STRINC) { +++ strngp = malloc(STRINC); +++ if (strngp == -1) { +++ yerror("Ran out of memory (string)"); +++ pexit(DIED); +++ } +++#ifndef PI01 +++#ifndef PXP +++ *stract++ = strngp; +++ strmax =+ STRINC; +++#endif +++#endif +++ strng = strngp; +++ } +++ strcpy(strngp, cp); +++ cp = strngp; +++ strngp = cp + i; +++#ifdef PI0 +++ send(RSTRING, cp); +++#endif +++ return (cp); +++} +++ +++#ifndef PI1 +++#ifndef PXP +++esavestr(cp) +++ char *cp; +++{ +++ +++#ifdef PI0 +++ send(REVENIT); +++#endif +++ strngp = ( (char *) ( ( (int) (strngp + 1) ) &~ 1 ) ); +++ return (savestr(cp)); +++} +++#endif +++#endif +++ +++#ifndef PI01 +++#ifndef PXP +++soffset(cp) +++ register char *cp; +++{ +++ register char **sp; +++ register int i; +++ +++ if (cp == NIL || cp == OCT || cp == HEX) +++ return (-cp); +++ for (i = STRINC, sp = strp; sp < stract; sp++) { +++ if (cp >= *sp && cp < (*sp + STRINC)) +++ return (i + (cp - *sp)); +++ i =+ STRINC; +++ } +++ i = nlfund(cp); +++ if (i != 0) +++ return (i); +++ panic("soffset"); +++} +++#ifdef PI1 +++sreloc(i) +++ register int i; +++{ +++ +++ if (i == 0 || i == -OCT || i == -HEX) +++ return (-i); +++ if (i < STRINC) { +++ if (i >= INL) +++ panic("sreloc INL"); +++ i = nl[i].symbol; +++ if (i == 0) +++ panic("sreloc nl[i]"); +++ return (i); +++ } +++ if (i > strmax || i < 0) +++ panic("sreloc"); +++ return (strp[(i / STRINC) - 1] + (i % STRINC)); +++} +++ +++evenit() +++{ +++ +++ strngp = (strngp + 1) &~ 1; +++} +++#endif +++#endif +++#endif diff --cc usr/src/cmd/pc0/subr.c index 0000000000,0000000000,0000000000..a02db2cc89 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/subr.c @@@@ -1,0 -1,0 -1,0 +1,217 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)subr.c 1.2 11/13/80"; +++ +++#include "whoami.h" +++#include "0.h" +++ +++#ifndef PI1 +++/* +++ * Does the string fp end in '.' and the character c ? +++ */ +++dotted(fp, c) +++ register char *fp; +++ char c; +++{ +++ register int i; +++ +++ i = strlen(fp); +++ return (i > 1 && fp[i - 2] == '.' && fp[i - 1] == c); +++} +++ +++/* +++ * Toggle the option c. +++ */ +++togopt(c) +++ char c; +++{ +++ register char *tp; +++ +++ tp = &opt( c ); +++ *tp = 1 - *tp; +++} +++ +++/* +++ * Set the time vector "tvec" to the +++ * modification time stamp of a file. +++ */ +++gettime( filename ) +++ char *filename; +++{ +++#include +++ struct stat stb; +++ +++ stat(filename, &stb); +++ tvec = stb.st_mtime; +++} +++ +++/* +++ * Convert a "ctime" into a Pascal styple time line +++ */ +++char * +++myctime(tv) +++ int *tv; +++{ +++ register char *cp, *dp; +++ char *cpp; +++ register i; +++ static char mycbuf[26]; +++ +++ cpp = ctime(tv); +++ dp = mycbuf; +++ cp = cpp; +++ cpp[16] = 0; +++ while (*dp++ = *cp++); +++ dp--; +++ cp = cpp+19; +++ cpp[24] = 0; +++ while (*dp++ = *cp++); +++ return (mycbuf); +++} +++ +++/* +++ * Is "fp" in the command line list of names ? +++ */ +++inpflist(fp) +++ char *fp; +++{ +++ register i, *pfp; +++ +++ pfp = pflist; +++ for (i = pflstc; i > 0; i--) +++ if (strcmp(fp, *pfp++) == 0) +++ return (1); +++ return (0); +++} +++#endif +++ +++extern int errno; +++extern char *sys_errlist[]; +++ +++/* +++ * Boom! +++ */ +++Perror(file, error) +++ char *file, *error; +++{ +++ +++ write(2, file, strlen(file)); +++ write(2, ": ", 2); +++ write(2, error, strlen(error)); +++ write(2, "\n", 1); +++/* +++ errno = 0; +++ sys_errlist[0] = error; +++ perror(file); +++*/ +++} +++ +++int * +++calloc(num, size) +++ int num, size; +++{ +++ register int p1, *p2, nbyte; +++ +++ nbyte = (num*size+( ( sizeof ( int ) ) - 1 ) ) & ~( ( sizeof ( int ) ) - 1 ); +++ if ((p1 = malloc(nbyte)) == -1 || p1==0) +++ return (-1); +++ p2 = p1; +++ nbyte /= sizeof ( int ); +++ do { +++ *p2++ = 0; +++ } while (--nbyte); +++ return (p1); +++} +++ +++/* +++ * Compare strings: s1>s2: >0 s1==s2: 0 s1>= 1; +++#ifdef PI0 +++ send(ROPOP, c); +++#endif +++} diff --cc usr/src/cmd/pc0/tree.c index 0000000000,0000000000,0000000000..4b7dfeaec5 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/tree.c @@@@ -1,0 -1,0 -1,0 +1,179 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)tree.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++ +++/* +++ * TREE SPACE DECLARATIONS +++ */ +++struct tr { +++ int *tr_low; +++ int *tr_high; +++} ttab[MAXTREE], *tract; +++ +++/* +++ * The variable space is the +++ * absolute base of the tree segments. +++ * (exactly the same as ttab[0].tr_low) +++ * Spacep is maintained to point at the +++ * beginning of the next tree slot to +++ * be allocated for use by the grammar. +++ * Spacep is used "extern" by the semantic +++ * actions in pas.y. +++ * The variable tract is maintained to point +++ * at the tree segment out of which we are +++ * allocating (the active segment). +++ */ +++int *space, *spacep; +++ +++/* +++ * TREENMAX is the maximum width +++ * in words that any tree node +++ * due to the way in which the parser uses +++ * the pointer spacep. +++ */ +++#define TREENMAX 6 +++ +++int trspace[ITREE]; +++int *space = trspace; +++int *spacep = trspace; +++struct tr *tract = ttab; +++ +++/* +++ * Inittree allocates the first tree slot +++ * and sets up the first segment descriptor. +++ * A lot of this work is actually done statically +++ * above. +++ */ +++inittree() +++{ +++ +++ ttab[0].tr_low = space; +++ ttab[0].tr_high = &space[ITREE]; +++} +++ +++/* +++ * Tree builds the nodes in the +++ * parse tree. It is rarely called +++ * directly, rather calls are made +++ * to tree[12345] which supplies the +++ * first argument to save space in +++ * the code. Tree also guarantees +++ * that spacep points to the beginning +++ * of the next slot it will return, +++ * a property required by the parser +++ * which was always true before we +++ * segmented the tree space. +++ */ +++int *tree(cnt, a) +++ int cnt; +++{ +++ register int *p, *q; +++ register int i; +++ +++ i = cnt; +++ p = spacep; +++ q = &a; +++ do +++ *p++ = *q++; +++ while (--i); +++ q = spacep; +++ spacep = p; +++ if (p+TREENMAX >= tract->tr_high) +++ /* +++ * this peek-ahead should +++ * save a great number of calls +++ * to tralloc. +++ */ +++ tralloc(TREENMAX); +++ return (q); +++} +++ +++/* +++ * Tralloc preallocates enough +++ * space in the tree to allow +++ * the grammar to use the variable +++ * spacep, as it did before the +++ * tree was segmented. +++ */ +++tralloc(howmuch) +++{ +++ register char *cp; +++ register i; +++ +++ if (spacep + howmuch >= tract->tr_high) { +++ i = TRINC; +++ cp = malloc(i * sizeof ( int )); +++ if (cp == -1) { +++ yerror("Ran out of memory (tralloc)"); +++ pexit(DIED); +++ } +++ spacep = cp; +++ tract++; +++ if (tract >= &ttab[MAXTREE]) { +++ yerror("Ran out of tree tables"); +++ pexit(DIED); +++ } +++ tract->tr_low = cp; +++ tract->tr_high = tract->tr_low+i; +++ } +++} +++ +++extern int yylacnt; +++extern bottled; +++#ifdef PXP +++#endif +++/* +++ * Free up the tree segments +++ * at the end of a block. +++ * If there is scanner lookahead, +++ * i.e. if yylacnt != 0 or there is bottled output, then we +++ * cannot free the tree space. +++ * This happens only when errors +++ * occur and the forward move extends +++ * across "units". +++ */ +++trfree() +++{ +++ +++ if (yylacnt != 0 || bottled != NIL) +++ return; +++#ifdef PXP +++ if (needtree()) +++ return; +++#endif +++ spacep = space; +++ while (tract->tr_low > spacep || tract->tr_high <= spacep) { +++ free(tract->tr_low); +++ tract->tr_low = NIL; +++ tract->tr_high = NIL; +++ tract--; +++ if (tract < ttab) +++ panic("ttab"); +++ } +++#ifdef PXP +++ packtree(); +++#endif +++} +++ +++/* +++ * Copystr copies a token from +++ * the "token" buffer into the +++ * tree space. +++ */ +++copystr(token) +++ register char *token; +++{ +++ register char *cp; +++ register int i; +++ +++ i = (strlen(token) + sizeof ( int )) & ~( ( sizeof ( int ) ) - 1 ); +++ tralloc(i / sizeof ( int )); +++ strcpy(spacep, token); +++ cp = spacep; +++ spacep = cp + i; +++ tralloc(TREENMAX); +++ return (cp); +++} diff --cc usr/src/cmd/pc0/tree.h index 0000000000,0000000000,0000000000..ca8b8c1579 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/tree.h @@@@ -1,0 -1,0 -1,0 +1,85 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)tree.h 1.1 8/27/80"; */ +++ +++#define T_MINUS 1 +++#define T_MOD 2 +++#define T_DIV 3 +++#define T_DIVD 4 +++#define T_MULT 5 +++#define T_ADD 6 +++#define T_SUB 7 +++#define T_EQ 8 +++#define T_NE 9 +++#define T_LT 10 +++#define T_GT 11 +++#define T_LE 12 +++#define T_GE 13 +++#define T_NOT 14 +++#define T_AND 15 +++#define T_OR 16 +++#define T_ASGN 17 +++#define T_PLUS 18 +++#define T_IN 19 +++#define T_LISTPP 20 +++#define T_PDEC 21 +++#define T_FDEC 22 +++#define T_PVAL 23 +++#define T_PVAR 24 +++#define T_PFUNC 25 +++#define T_PPROC 26 +++#define T_NIL 27 +++#define T_STRNG 28 +++#define T_CSTRNG 29 +++#define T_PLUSC 30 +++#define T_MINUSC 31 +++#define T_ID 32 +++#define T_INT 33 +++#define T_FINT 34 +++#define T_CINT 35 +++#define T_CFINT 36 +++#define T_TYPTR 37 +++#define T_TYPACK 38 +++#define T_TYSCAL 39 +++#define T_TYRANG 40 +++#define T_TYARY 41 +++#define T_TYFILE 42 +++#define T_TYSET 43 +++#define T_TYREC 44 +++#define T_TYFIELD 45 +++#define T_TYVARPT 46 +++#define T_TYVARNT 47 +++#define T_CSTAT 48 +++#define T_BLOCK 49 +++#define T_BSTL 50 +++#define T_LABEL 51 +++#define T_PCALL 52 +++#define T_FCALL 53 +++#define T_CASE 54 +++#define T_WITH 55 +++#define T_WHILE 56 +++#define T_REPEAT 57 +++#define T_FORU 58 +++#define T_FORD 59 +++#define T_GOTO 60 +++#define T_IF 61 +++#define T_ASRT 62 +++#define T_CSET 63 +++#define T_RANG 64 +++#define T_VAR 65 +++#define T_ARGL 66 +++#define T_ARY 67 +++#define T_FIELD 68 +++#define T_PTR 69 +++#define T_WEXP 70 +++#define T_PROG 71 +++#define T_BINT 72 +++#define T_CBINT 73 +++#define T_IFEL 74 +++#define T_IFX 75 +++#define T_TYID 76 +++#define T_COPSTR 77 +++#define T_BOTTLE 78 +++#define T_RFIELD 79 +++#define T_FLDLST 80 +++#define T_LAST 81 diff --cc usr/src/cmd/pc0/treen.c index 0000000000,0000000000,0000000000..b6e6ae22a0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/treen.c @@@@ -1,0 -1,0 -1,0 +1,38 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)treen.c 1.1 8/27/80"; +++ +++ /* +++ * is there some reason why these aren't #defined? +++ */ +++ +++tree1 ( arg1 ) +++ int arg1; +++ { +++ tree ( 1 , arg1 ); +++ } +++ +++tree2 ( arg1 , arg2 ) +++ int arg1 , arg2; +++ { +++ tree ( 2 , arg1 , arg2 ); +++ } +++ +++tree3 ( arg1 , arg2 , arg3 ) +++ int arg1 , arg2 , arg3; +++ { +++ tree ( 3 , arg1 , arg2 , arg3 ); +++ } +++ +++tree4 ( arg1 , arg2 , arg3 , arg4 ) +++ int arg1 , arg2 , arg3 , arg4; +++ { +++ tree ( 4 , arg1 , arg2 , arg3 , arg4 ); +++ } +++ +++tree5 ( arg1 , arg2 , arg3 , arg4 , arg5 ) +++ int arg1 , arg2 , arg3 , arg4 , arg5; +++ { +++ tree ( 5 , arg1 , arg2 , arg3 , arg4 , arg5 ); +++ } +++ diff --cc usr/src/cmd/pc0/type.c index 0000000000,0000000000,0000000000..fee06b5091 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/type.c @@@@ -1,0 -1,0 -1,0 +1,388 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)type.c 1.4 9/4/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "objfmt.h" +++ +++/* +++ * Type declaration part +++ */ +++typebeg() +++{ +++ +++/* +++ * this allows for multiple +++ * declaration parts unless +++ * standard option has been +++ * specified. +++ * If routine segment is being +++ * compiled, do level one processing. +++ */ +++ +++#ifndef PI1 +++ if (!progseen) +++ level1(); +++ if ( parts[ cbn ] & ( VPRT | RPRT ) ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Type declarations should precede var and routine declarations"); +++ } +++ if (parts[ cbn ] & TPRT) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All types should be declared in one type part"); +++ } +++ parts[ cbn ] |= TPRT; +++#endif +++ /* +++ * Forechain is the head of a list of types that +++ * might be self referential. We chain them up and +++ * process them later. +++ */ +++ forechain = NIL; +++#ifdef PI0 +++ send(REVTBEG); +++#endif +++} +++ +++type(tline, tid, tdecl) +++ int tline; +++ char *tid; +++ register int *tdecl; +++{ +++ register struct nl *np; +++ +++ np = gtype(tdecl); +++ line = tline; +++#ifndef PI0 +++ enter(defnl(tid, TYPE, np, 0))->nl_flags |= NMOD; +++#else +++ enter(defnl(tid, TYPE, np, 0)); +++ send(REVTYPE, tline, tid, tdecl); +++#endif +++ +++#ifdef PC +++ if (cbn == 1) { +++ stabgtype( tid , line ); +++ } +++#endif PC +++ +++# ifdef PTREE +++ { +++ pPointer Type = TypeDecl( tid , tdecl ); +++ pPointer *Types; +++ +++ pSeize( PorFHeader[ nesting ] ); +++ Types = &( pDEF( PorFHeader[ nesting ] ).PorFTypes ); +++ *Types = ListAppend( *Types , Type ); +++ pRelease( PorFHeader[ nesting ] ); +++ } +++# endif +++} +++ +++typeend() +++{ +++ +++#ifdef PI0 +++ send(REVTEND); +++#endif +++ foredecl(); +++} +++ +++/* +++ * Return a type pointer (into the namelist) +++ * from a parse tree for a type, building +++ * namelist entries as needed. +++ */ +++struct nl * +++gtype(r) +++ register int *r; +++{ +++ register struct nl *np; +++ register char *cp; +++ register int oline, w; +++ +++ if (r == NIL) +++ return (NIL); +++ oline = line; +++ if (r[0] != T_ID) +++ oline = line = r[1]; +++ switch (r[0]) { +++ default: +++ panic("type"); +++ case T_TYID: +++ r++; +++ case T_ID: +++ np = lookup(r[1]); +++ if (np == NIL) +++ break; +++ if (np->class != TYPE) { +++#ifndef PI1 +++ error("%s is a %s, not a type as required", r[1], classes[np->class]); +++#endif +++ np = NIL; +++ break; +++ } +++ np = np->type; +++ break; +++ case T_TYSCAL: +++ np = tyscal(r); +++ break; +++ case T_TYRANG: +++ np = tyrang(r); +++ break; +++ case T_TYPTR: +++ np = defnl(0, PTR, 0, 0 ); +++ np -> ptr[0] = r[2]; +++ np->nl_next = forechain; +++ forechain = np; +++ break; +++ case T_TYPACK: +++ np = gtype(r[2]); +++ break; +++ case T_TYARY: +++ np = tyary(r); +++ break; +++ case T_TYREC: +++ np = tyrec(r[2], 0); +++# ifdef PTREE +++ /* +++ * mung T_TYREC[3] to point to the record +++ * for RecTCopy +++ */ +++ r[3] = np; +++# endif +++ break; +++ case T_TYFILE: +++ np = gtype(r[2]); +++ if (np == NIL) +++ break; +++#ifndef PI1 +++ if (np->nl_flags & NFILES) +++ error("Files cannot be members of files"); +++#endif +++ np = defnl(0, FILET, np, 0); +++ np->nl_flags |= NFILES; +++ break; +++ case T_TYSET: +++ np = gtype(r[2]); +++ if (np == NIL) +++ break; +++ if (np->type == nl+TDOUBLE) { +++#ifndef PI1 +++ error("Set of real is not allowed"); +++#endif +++ np = NIL; +++ break; +++ } +++ if (np->class != RANGE && np->class != SCAL) { +++#ifndef PI1 +++ error("Set type must be range or scalar, not %s", nameof(np)); +++#endif +++ np = NIL; +++ break; +++ } +++#ifndef PI1 +++ if (width(np) > 2) +++ error("Implementation restriction: sets must be indexed by 16 bit quantities"); +++#endif +++ np = defnl(0, SET, np, 0); +++ break; +++ } +++ line = oline; +++ w = lwidth(np); +++ if (w >= TOOMUCH) { +++ error("Storage requirement of %s exceeds the implementation limit of %d by %d bytes", +++ nameof(np), TOOMUCH-1, w-TOOMUCH+1); +++ np = NIL; +++ } +++ return (np); +++} +++ +++/* +++ * Scalar (enumerated) types +++ */ +++tyscal(r) +++ int *r; +++{ +++ register struct nl *np, *op, *zp; +++ register *v; +++ int i; +++ +++ np = defnl(0, SCAL, 0, 0); +++ np->type = np; +++ v = r[2]; +++ if (v == NIL) +++ return (NIL); +++ i = -1; +++ zp = np; +++ for (; v != NIL; v = v[2]) { +++ op = enter(defnl(v[1], CONST, np, ++i)); +++#ifndef PI0 +++ op->nl_flags |= NMOD; +++#endif +++ op->value[1] = i; +++ zp->chain = op; +++ zp = op; +++ } +++ np->range[1] = i; +++ return (np); +++} +++ +++/* +++ * Declare a subrange. +++ */ +++tyrang(r) +++ register int *r; +++{ +++ register struct nl *lp, *hp; +++ double high; +++ int c, c1; +++ +++ gconst(r[3]); +++ hp = con.ctype; +++ high = con.crval; +++ gconst(r[2]); +++ lp = con.ctype; +++ if (lp == NIL || hp == NIL) +++ return (NIL); +++ if (norange(lp) || norange(hp)) +++ return (NIL); +++ c = classify(lp); +++ c1 = classify(hp); +++ if (c != c1) { +++#ifndef PI1 +++ error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp)); +++#endif +++ return (NIL); +++ } +++ if (c == TSCAL && scalar(lp) != scalar(hp)) { +++#ifndef PI1 +++ error("Scalar types must be identical in subranges"); +++#endif +++ return (NIL); +++ } +++ if (con.crval > high) { +++#ifndef PI1 +++ error("Range lower bound exceeds upper bound"); +++#endif +++ return (NIL); +++ } +++ lp = defnl(0, RANGE, hp->type, 0); +++ lp->range[0] = con.crval; +++ lp->range[1] = high; +++ return (lp); +++} +++ +++norange(p) +++ register struct nl *p; +++{ +++ if (isa(p, "d")) { +++#ifndef PI1 +++ error("Subrange of real is not allowed"); +++#endif +++ return (1); +++ } +++ if (isnta(p, "bcsi")) { +++#ifndef PI1 +++ error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p)); +++#endif +++ return (1); +++ } +++ return (0); +++} +++ +++/* +++ * Declare arrays and chain together the dimension specification +++ */ +++struct nl * +++tyary(r) +++ int *r; +++{ +++ struct nl *np; +++ register *tl; +++ register struct nl *tp, *ltp; +++ int i; +++ +++ tp = gtype(r[3]); +++ if (tp == NIL) +++ return (NIL); +++ np = defnl(0, ARRAY, tp, 0); +++ np->nl_flags |= (tp->nl_flags) & NFILES; +++ ltp = np; +++ i = 0; +++ for (tl = r[2]; tl != NIL; tl = tl[2]) { +++ tp = gtype(tl[1]); +++ if (tp == NIL) { +++ np = NIL; +++ continue; +++ } +++ if (tp->class == RANGE && tp->type == nl+TDOUBLE) { +++#ifndef PI1 +++ error("Index type for arrays cannot be real"); +++#endif +++ np = NIL; +++ continue; +++ } +++ if (tp->class != RANGE && tp->class != SCAL) { +++#ifndef PI1 +++ error("Array index type is a %s, not a range or scalar as required", classes[tp->class]); +++#endif +++ np = NIL; +++ continue; +++ } +++ if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) { +++#ifndef PI1 +++ error("Value of dimension specifier too large or small for this implementation"); +++#endif +++ continue; +++ } +++ tp = nlcopy(tp); +++ i++; +++ ltp->chain = tp; +++ ltp = tp; +++ } +++ if (np != NIL) +++ np->value[0] = i; +++ return (np); +++} +++ +++/* +++ * Delayed processing for pointers to +++ * allow self-referential and mutually +++ * recursive pointer constructs. +++ */ +++foredecl() +++{ +++ register struct nl *p, *q; +++ +++ for (p = forechain; p != NIL; p = p->nl_next) { +++ if (p->class == PTR && p -> ptr[0] != 0) +++ { +++ p->type = gtype(p -> ptr[0]); +++#ifndef PI1 +++ if (p->type != NIL && ( ( p->type )->nl_flags & NFILES)) +++ error("Files cannot be members of dynamic structures"); +++#endif +++# ifdef PTREE +++ { +++ if ( pUSE( p -> inTree ).PtrTType == pNIL ) { +++ pPointer PtrTo = tCopy( p -> ptr[0] ); +++ +++ pDEF( p -> inTree ).PtrTType = PtrTo; +++ } +++ } +++# endif +++ p -> ptr[0] = 0; +++ } +++ } +++} diff --cc usr/src/cmd/pc0/var.c index 0000000000,0000000000,0000000000..0287e9f415 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/var.c @@@@ -1,0 -1,0 -1,0 +1,421 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)var.c 1.3 9/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "align.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++# include "iorec.h" +++#endif PC +++ +++/* +++ * Declare variables of a var part. DPOFF1 is +++ * the local variable storage for all prog/proc/func +++ * modules aside from the block mark. The total size +++ * of all the local variables is entered into the +++ * size array. +++ */ +++varbeg() +++{ +++ +++/* this allows for multiple declaration +++ * parts except when the "standard" +++ * option has been specified. +++ * If routine segment is being compiled, +++ * do level one processing. +++ */ +++ +++#ifndef PI1 +++ if (!progseen) +++ level1(); +++ if ( parts[ cbn ] & RPRT ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Variable declarations should precede routine declarations"); +++ } +++ if ( parts[ cbn ] & VPRT ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All variables should be declared in one var part"); +++ } +++ parts[ cbn ] |= VPRT; +++#endif +++ /* +++ * #ifndef PI0 +++ * sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; +++ * #endif +++ */ +++ forechain = NIL; +++#ifdef PI0 +++ send(REVVBEG); +++#endif +++} +++ +++var(vline, vidl, vtype) +++#ifdef PI0 +++ int vline, *vidl, *vtype; +++{ +++ register struct nl *np; +++ register int *vl; +++ +++ np = gtype(vtype); +++ line = vline; +++ for (vl = vidl; vl != NIL; vl = vl[2]) { +++ } +++ } +++ send(REVVAR, vline, vidl, vtype); +++} +++#else +++ int vline; +++ register int *vidl; +++ int *vtype; +++{ +++ register struct nl *np; +++ register struct om *op; +++ long w; +++ int o2; +++ int *ovidl = vidl; +++ +++ np = gtype(vtype); +++ line = vline; +++ /* +++ * widths are evened out +++ */ +++ w = (lwidth(np) + 1) &~ 1; +++ op = &sizes[cbn]; +++ for (; vidl != NIL; vidl = vidl[2]) { +++# ifdef OBJ +++ op -> om_off = roundup( op -> om_off - w , align( np ) ); +++ o2 = op -> om_off; +++# endif OBJ +++# ifdef PC +++ if ( cbn == 1 ) { +++ /* +++ * global variables are not accessed off the fp +++ * but rather by their names. +++ */ +++ o2 = 0; +++ } else { +++ /* +++ * locals are aligned, too. +++ */ +++ op -> om_off = roundup( op -> om_off - w +++ , align( np ) ); +++ o2 = op -> om_off; +++ } +++# endif PC +++ enter(defnl(vidl[1], VAR, np, o2)); +++ if ( np -> nl_flags & NFILES ) { +++ dfiles[ cbn ] = TRUE; +++ } +++# ifdef PC +++ if ( cbn == 1 ) { +++ putprintf( " .data" , 0 ); +++ putprintf( " .comm " , 1 ); +++ putprintf( EXTFORMAT , 1 , vidl[1] ); +++ putprintf( ",%d" , 0 , w ); +++ putprintf( " .text" , 0 ); +++ } +++ stabvar( vidl[1] , p2type( np ) , cbn , o2 , w , line ); +++# endif PC +++ } +++# ifdef PTREE +++ { +++ pPointer *Vars; +++ pPointer Var = VarDecl( ovidl , vtype ); +++ +++ pSeize( PorFHeader[ nesting ] ); +++ Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars ); +++ *Vars = ListAppend( *Vars , Var ); +++ pRelease( PorFHeader[ nesting ] ); +++ } +++# endif +++} +++#endif +++ +++varend() +++{ +++ +++ foredecl(); +++#ifndef PI0 +++ sizes[cbn].om_max = sizes[cbn].om_off; +++#else +++ send(REVVEND); +++#endif +++} +++ +++/* +++ * Evening +++ */ +++even(w) +++ register int w; +++{ +++ if (w < 0) +++ return (w & ~1); +++ return ((w+1) & ~1); +++} +++ +++/* +++ * Find the width of a type in bytes. +++ */ +++width(np) +++ struct nl *np; +++{ +++ +++ return (lwidth(np)); +++} +++ +++long +++lwidth(np) +++ struct nl *np; +++{ +++ register struct nl *p; +++ long w; +++ +++ p = np; +++ if (p == NIL) +++ return (0); +++loop: +++ switch (p->class) { +++ case TYPE: +++ switch (nloff(p)) { +++ case TNIL: +++ return (2); +++ case TSTR: +++ case TSET: +++ panic("width"); +++ default: +++ p = p->type; +++ goto loop; +++ } +++ case ARRAY: +++ return (aryconst(p, 0)); +++ case PTR: +++ return ( sizeof ( int * ) ); +++ case FILET: +++# ifdef OBJ +++ return ( sizeof ( int * ) ); +++# endif OBJ +++# ifdef PC +++ return ( sizeof(struct iorec) +++ + lwidth( p -> type ) ); +++# endif PC +++ case RANGE: +++ if (p->type == nl+TDOUBLE) +++#ifdef DEBUG +++ return (hp21mx ? 4 : 8); +++#else +++ return (8); +++#endif +++ case SCAL: +++ return (bytes(p->range[0], p->range[1])); +++ case SET: +++ setran(p->type); +++ return roundup( ( set.uprbp >> 3 ) + 1 , A_SET ); +++ case STR: +++ case RECORD: +++ return ( p->value[NL_OFFS] ); +++ default: +++ panic("wclass"); +++ } +++} +++ +++ /* +++ * round up x to a multiple of y +++ * for computing offsets of aligned things. +++ * y had better be positive. +++ * rounding is in the direction of x. +++ */ +++long +++roundup( x , y ) +++ long x; +++ register long y; +++ { +++ +++ if ( y == 0 ) { +++ return 0; +++ } +++ if ( x >= 0 ) { +++ return ( ( ( x + ( y - 1 ) ) / y ) * y ); +++ } else { +++ return ( ( ( x - ( y - 1 ) ) / y ) * y ); +++ } +++ } +++ +++ /* +++ * alignment of an object using the c alignment scheme +++ */ +++int +++align( np ) +++ struct nl *np; +++ { +++ register struct nl *p; +++ +++ p = np; +++ if ( p == NIL ) { +++ return 0; +++ } +++alignit: +++ switch ( p -> class ) { +++ case TYPE: +++ switch ( nloff( p ) ) { +++ case TNIL: +++ return A_POINT; +++ case TSTR: +++ return A_CHAR; +++ case TSET: +++ return A_SET; +++ default: +++ p = p -> type; +++ goto alignit; +++ } +++ case ARRAY: +++ /* +++ * arrays are aligned as their component types +++ */ +++ p = p -> type; +++ goto alignit; +++ case PTR: +++ return A_POINT; +++ case FILET: +++ return A_FILET; +++ case RANGE: +++ if ( p -> type == nl+TDOUBLE ) { +++ return A_DOUBLE; +++ } +++ /* else, fall through */ +++ case SCAL: +++ switch ( bytes( p -> range[0] , p -> range[1] ) ) { +++ case 4: +++ return A_LONG; +++ case 2: +++ return A_SHORT; +++ case 1: +++ return A_CHAR; +++ default: +++ panic( "align: scal" ); +++ } +++ case SET: +++ return A_SET; +++ case STR: +++ return A_CHAR; +++ case RECORD: +++ /* +++ * follow chain through all fields in record, +++ * taking max of alignments of types of fields. +++ * short circuit out if i reach the maximum alignment. +++ * this is pretty likely, as A_MAX is only 4. +++ */ +++ { +++ register long recalign; +++ register long fieldalign; +++ +++ recalign = A_MIN; +++ p = p -> chain; +++ while ( ( p != NIL ) && ( recalign < A_MAX ) ) { +++ fieldalign = align( p -> type ); +++ if ( fieldalign > recalign ) { +++ recalign = fieldalign; +++ } +++ p = p -> chain; +++ } +++ return recalign; +++ } +++ default: +++ panic( "align" ); +++ } +++ } +++ +++/* +++ * Return the width of an element +++ * of a n time subscripted np. +++ */ +++long aryconst(np, n) +++ struct nl *np; +++ int n; +++{ +++ register struct nl *p; +++ long s, d; +++ +++ if ((p = np) == NIL) +++ return (NIL); +++ if (p->class != ARRAY) +++ panic("ary"); +++ s = lwidth(p->type); +++ /* +++ * Arrays of anything but characters are word aligned. +++ */ +++ if (s & 1) +++ if (s != 1) +++ s++; +++ /* +++ * Skip the first n subscripts +++ */ +++ while (n >= 0) { +++ p = p->chain; +++ n--; +++ } +++ /* +++ * Sum across remaining subscripts. +++ */ +++ while (p != NIL) { +++ if (p->class != RANGE && p->class != SCAL) +++ panic("aryran"); +++ d = p->range[1] - p->range[0] + 1; +++ s *= d; +++ p = p->chain; +++ } +++ return (s); +++} +++ +++/* +++ * Find the lower bound of a set, and also its size in bits. +++ */ +++setran(q) +++ struct nl *q; +++{ +++ register lb, ub; +++ register struct nl *p; +++ +++ p = q; +++ if (p == NIL) +++ return (NIL); +++ lb = p->range[0]; +++ ub = p->range[1]; +++ if (p->class != RANGE && p->class != SCAL) +++ panic("setran"); +++ set.lwrb = lb; +++ /* set.(upperbound prime) = number of bits - 1; */ +++ set.uprbp = ub-lb; +++} +++ +++/* +++ * Return the number of bytes required to hold an arithmetic quantity +++ */ +++bytes(lb, ub) +++ long lb, ub; +++{ +++ +++#ifndef DEBUG +++ if (lb < -32768 || ub > 32767) +++ return (4); +++ else if (lb < -128 || ub > 127) +++ return (2); +++#else +++ if (!hp21mx && (lb < -32768 || ub > 32767)) +++ return (4); +++ if (lb < -128 || ub > 127) +++ return (2); +++#endif +++ else +++ return (1); +++} diff --cc usr/src/cmd/pc0/version.c index 0000000000,0000000000,0000000000..462664eaea new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/version.c @@@@ -1,0 -1,0 -1,0 +1,25 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)version.c 1.1 8/27/80"; +++ +++ /* +++ * this writes the declaration of the character string version +++ * onto standard output. +++ * useful for makeing Version.c give the correct date for pi. +++ */ +++ +++#include +++ +++char *ctime(); +++ +++long clock; +++char *cstring; +++ +++main() +++ { +++ time( &clock ); +++ cstring = ctime( &clock ); +++ cstring[ 24 ] = '\0'; +++ printf( "char version[] = \"%s\";\n" , cstring ); +++ } +++ diff --cc usr/src/cmd/pc0/whoami.h index 0000000000,0000000000,0000000000..562c720ef8 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/whoami.h @@@@ -1,0 -1,0 -1,0 +1,32 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)whoami.h 1.1 8/27/80"; */ +++ +++/* +++ * am i generating an obj file (OBJ), +++ * postfix binary input to the 2nd pass of the portable c compiler (PC), +++ * or pTrees (PTREE)? +++ */ +++#undef OBJ +++#define PC +++#undef PTREE +++ +++/* +++ * am i the vax or the pdp11 version +++ */ +++#define VAX +++#undef PDP11 +++ +++/* +++ * am i pi or pxp? +++ */ +++#define PI +++#undef PXP +++ +++/* +++ * am i both passes, or am i only one of the two passes pi0 or pi1? +++ */ +++#define PI01 +++#undef PI0 +++#undef PI1 +++ diff --cc usr/src/cmd/pc0/yy.h index 0000000000,0000000000,0000000000..a28814fbf7 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yy.h @@@@ -1,0 -1,0 -1,0 +1,286 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)yy.h 1.1 8/27/80"; */ +++ +++#include "y.tab.h" +++/* +++ * INPUT/OUTPUT +++ */ +++ +++/* +++ * The buffer for the input file is normally "ibuf". +++ * When files are included, however, this may be +++ * pushed down in the stack of currently active +++ * files. For this reason, the pointer ibp always +++ * references the i/o buffer of the current input file. +++ */ +++FILE *ibuf, *ibp; +++ +++/* +++ * Line and token buffers. Charbuf is the character buffer for +++ * input lines, token the buffer for tokens returned +++ * by the scanner. CBSIZE defines the maximum line +++ * length allowed on input and is doubtless too small. +++ * The token buffer should be a local array in yylex. +++ */ +++#define CBSIZE 161 +++ +++char charbuf[CBSIZE], *bufp, token[CBSIZE]; +++ +++#define digit(c) (c >= '0' && c <= '9') +++#define alph(c) ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) +++ +++/* +++ * Flag to prevent reprinting current line after +++ * an error. +++ */ +++char yyprtd; +++ +++/* +++ * The following variables are maintained by +++ * the scanner in the file lex and used in scanning +++ * and in parsing. +++ * +++ * The variable yychar is the current scanner character. +++ * Currently, the scanner must be called as +++ * yychar = yylex() +++ * even though it should set yychar itself. +++ * Yychar has value YEOF at end of file, and negative value if +++ * there is no yychar, e.g. after a shift in the parser. +++ * +++ * The variable yycol is the current column in the line whose number +++ * is given by yyline. Yyecol and yyeline give the position for an +++ * error message to flag, usually the start of an input token. +++ * Yylval is the semantic return from the scanner. +++ * +++ * In fact all of these variables are "per token". +++ * In the usual case, only the copies in the scanner token structure +++ * 'Y' are used, and the #defines below serve to make them look +++ * like variables. +++ * +++ * For the purposes of the error recovery, however, they are copied +++ * and restored quite freely. For the error recovery also, the +++ * file name which the input line this token is on and the seek +++ * pointer of this line in its source file are saved as yyefile +++ * and yyseekp. The global variable yylinpt is the seek pointer +++ * of the current input line. +++ */ +++int yycol; +++int yyline; +++int yyseqid; +++int yysavc; +++int yylinpt; +++ +++/* *** NOTE *** +++ * It would be much better to not have the Yyeline and Yyefile +++ * in the scanner structure and to have a mechanism for mapping +++ * seqid's to these globally. +++ */ +++struct yytok { +++ int Yychar; +++ int Yylval; +++ int Yyecol; +++ int Yyeline; +++ int Yyseekp; +++ char *Yyefile; +++ int Yyeseqid; +++} Y, OY; +++ +++#define yychar Y.Yychar +++#define yylval Y.Yylval +++#define yyecol Y.Yyecol +++#define yyeline Y.Yyeline +++#define yyseekp Y.Yyseekp +++#define yyefile Y.Yyefile +++#define yyeseqid Y.Yyeseqid +++ +++/* +++ * Yyval is the semantic value returned by a reduction. +++ * It is what "$$" is expanded to by yacc. +++ */ +++int *Ps, *yyval; +++ +++/* +++ * N is the length of a reduction. +++ * Used externally by "lineof" to get the left and +++ * right margins for a reduction. +++ */ +++int N; +++/* +++ * Definitions for looking up keywords. +++ * The keyword array is called yykey, and +++ * lastkey points at the end of it. +++ */ +++char *lastkey; +++ +++struct kwtab { +++ char *kw_str; +++ int kw_val; +++} yykey[]; +++ +++/* +++ * ERROR RECOVERY EXTERNALS +++ */ +++ +++#define CLIMIT 40 /* see yyrecover.c */ +++char *tokname(); +++char *charname(); +++ +++char *classes[]; +++ +++/* +++ * Tokens which yacc doesn't define +++ */ +++#define YEOF 0 +++#define ERROR 256 +++ +++/* +++ * Limit on the number of syntax errors +++ */ +++#define MAXSYNERR 100 +++ +++/* +++ * Big costs +++ */ +++#define HUGE 50 +++#define INFINITY 100 +++ +++/* +++ * Kinds of panics +++ */ +++#define PDECL 0 +++#define PSTAT 1 +++#define PEXPR 2 +++#define PPROG 3 +++ +++#define yyresume() yyResume = 1; +++ +++char yyResume; +++ +++char dquote; +++ +++char errout; +++ +++/* +++ * Yyidwant and yyidhave are the namelist classes +++ * of identifiers associated with a identifier reduce +++ * error, set before the recovery is called. +++ * Since they may be set again during the forward move +++ * they must be saved by yyrecover, which uses them in printing +++ * error messages. +++ */ +++int yyidhave, yyidwant; +++ +++/* +++ * The variables yy*shifts are used to prevent looping and the printing +++ * of spurious messages in the parser. Yyshifts gives the number of +++ * true input shifts since the last corrective action. YyOshifts +++ * is the value of yyshifts before it was last cleared, and is used +++ * by yyPerror in yypanic.c to suppress messages. +++ * +++ * Yytshifts counts true input shifts. It is used to prevent looping +++ * inserting unique symbols. If yytshifts == yyTshifts (local to +++ * yyrecover.c) then there has been no shift over true input since +++ * the last unique symbol insertion. We refuse, in this case, +++ * to insert more unique symbols so as to prevent looping. +++ * +++ * The recovery cannot loop because it guarantees the progress of the +++ * parse, i.e.: +++ * +++ * 1) Any insertion guarantees to shift over 2 symbols, a replacement +++ * over one symbol. +++ * +++ * 2) Unique symbol insertions are limited to one for each true +++ * symbol of input, or "safe" insertion of the keywords "end" +++ * and "until" at zero cost (safe since these are know to match +++ * stack that cannot have been generated - e.g. "begin" or "repeat") +++ * +++ * 3) We never panic more than once from a given state without +++ * shifting over input, i.e. we force the parse stack to shrink +++ * after each unsuccessful panic. +++ */ +++int yyshifts, yyOshifts; +++unsigned yytshifts; +++ +++#ifdef PXP +++ +++/* +++ * Identifier class definitions +++ */ +++#define UNDEF 0 +++#define CONST 1 +++#define TYPE 2 +++#define VAR 3 +++#define ARRAY 4 +++#define PTRFILE 5 +++#define RECORD 6 +++#define FIELD 7 +++#define PROC 8 +++#define FUNC 9 +++#define FVAR 10 +++#define REF 11 +++#define PTR 12 +++#define FILET 13 +++#define SET 14 +++#define RANGE 15 +++#define LABEL 16 +++#define WITHPTR 17 +++#define SCAL 18 +++#define STR 19 +++#define PROG 20 +++#define IMPROPER 21 +++ +++/* +++ * COMMENT FORMATTING DEFINITIONS +++ */ +++ +++/* +++ * Count of tokens on this input line +++ * Note that this can be off if input is not syntactically correct. +++ */ +++int yytokcnt; +++int yywhcnt; +++ +++/* +++ * Types of comments +++ */ +++#define CLMARG 0 +++#define CALIGN 1 +++#define CTRAIL 2 +++#define CRMARG 3 +++#define CSRMARG 4 +++#define CNL 5 +++#define CNLBL 6 +++#define CFORM 7 +++#define CINCLUD 8 +++ +++/* +++ * Comment structure +++ * Cmhp is the head of the current list of comments +++ */ +++struct comment { +++ struct comment *cmnext; +++ int cmdelim; +++ struct commline *cml; +++ int cmjust; +++ int cmseqid; +++} *cmhp; +++ +++/* +++ * Structure for holding a comment line +++ */ +++struct commline { +++ char *cmtext; +++ int cmcol; /* Only used for first line of comment currently */ +++ struct commline *cml; +++}; +++ +++struct W { +++ int Wseqid; +++ int Wcol; +++} yyw[MAXDEPTH + 1], *yypw; +++ +++#define commform() quickcomm(CFORM) +++#define commnl() quickcomm(CNL) +++#define commnlbl() quickcomm(CNLBL) +++#endif diff --cc usr/src/cmd/pc0/yycopy.c index 0000000000,0000000000,0000000000..1c3b8c9161 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yycopy.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yycopy.c 1.1 8/27/80"; +++ +++#include "0.h" +++#include "yy.h" +++ +++OYcopy () +++ { +++ register int *r0 = & OY; +++ register int *r1 = & Y; +++ register int r2 = ( sizeof ( struct yytok ) ) / ( sizeof ( int ) ); +++ +++ do +++ { +++ * r0 ++ = * r1 ++ ; +++ } +++ while ( -- r2 > 0 ); +++ } diff --cc usr/src/cmd/pc0/yycosts.c index 0000000000,0000000000,0000000000..f0ec79c740 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yycosts.c @@@@ -1,0 -1,0 -1,0 +1,232 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yycosts.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * Symbol costs for Pascal. +++ * +++ * Cost strategy of August 14, 1977. +++ * +++ * The costs determined by the routines in this file are used by +++ * the recovery in choosing appropriate corrections. +++ * The cost vectors and the error productions in the grammar +++ * work together to define the corrective capacity of the grammar. +++ * +++ * The costs here largely derive from those given in Steve Rhode's +++ * thesis for the Pascal-I error correcting parser which he implemented. +++ * Some minor changes have been made to adjust for the fact that +++ * the current error recovery is not as "smart", both because of the +++ * limited forward move and because of the lack of any type information +++ * about identifiers. +++ * +++ * These adjustments largely take the form of increased costs for certain +++ * tokens, noticeably keywords which are major brackets such as "begin" +++ * "label", "procedure", etc. +++ * +++ * The overall weighting strategy is still similar to Rhodes' strategy. +++ * The costs can be considered: +++ * +++ * LOW <= 3 +++ * MEDIUM 4 or 5 +++ * HIGH >= 6 +++ */ +++ +++/* +++ * Insertion costs +++ * +++ * In addition to the normal symbol insertion costs, +++ * there are zero cost insertions here. +++ * The current error recovery system treats symbols +++ * which have zero insertion cost in a special way, +++ * inserting them but suppressing diagnostics. +++ * This allows the system to hold of on bracketing +++ * error diagnostics about missing end's until the +++ * reduction occurs which knows the line number of the +++ * corresponding "begin", "repeat", etc. +++ * A more intelligent and useful diagnostic can then +++ * be printed. +++ * +++ * Although this routine never allows the insertion +++ * of the keyword begin, it can be inserted after a +++ * procedure or function body starts, if it was omitted +++ * by a special case in the panic routine, which notices +++ * the keywords in the statement body of the procedure +++ * and inserts the begin to recover. +++ * +++ * Similarly, we do not insert end-of-file, but +++ * the fact that end-of-file is the unique input +++ * is noticed by the recovery routines as a special +++ * case and handled there. +++ */ +++inscost(sy, before) +++ register int sy, before; +++{ +++ +++ switch (before) { +++ case YEND: +++ if (sy == YEND) +++ break; +++ case YPROCEDURE: +++ case YFUNCTION: +++ if (sy == YUNTIL || sy == YEND) +++ return (0); +++ } +++ switch (sy) { +++ case ';': +++ return (1); +++ case ',': +++ case ':': +++ case YOF: +++ case YDO: +++ return (2); +++ case YARRAY: +++ case '+': +++ case '*': +++ return (3); +++ default: +++ return (4); +++ case '^': +++ case YNOT: +++ case YLABEL: +++ case YCONST: +++ case YTYPE: +++ case YVAR: +++ case YUNTIL: +++ case '(': +++ case '[': +++ case YWHILE: +++ case YWITH: +++ case YASSERT: +++ return (5); +++ case YPROCEDURE: +++ case YFUNCTION: +++ case YCASE: +++ return (6); +++ case YEND: +++ return (8); +++ case YBEGIN: +++ case YEOF: +++ case YREPEAT: +++ case YRECORD: +++ return (INFINITY); +++ } +++} +++ +++/* +++ * Replacement costs +++ * +++ * Most replacement costs are the same as an insertion +++ * plus a deletion cost. One special case is the replacement +++ * of a large number of keywords by an identifier. +++ * These are given lower costs, especially the keyword "to". +++ */ +++repcost(what, with) +++ register int what, with; +++{ +++ register int c; +++ +++ if (with == what) +++ return (INFINITY); +++ if (with == YID && what > ERROR) +++ switch (what) { +++ case YID: +++ case YDOTDOT: +++ case YINT: +++ case YBINT: +++ case YSTRING: +++ case YNUMB: +++ break; +++ case YTO: +++ return (3); +++ default: +++ return (5); +++ case YRECORD: +++ case YTHEN: +++ return (6); +++ case YBEGIN: +++ break; +++ } +++ if (what == ';' && (with == ',' || with == '.')) +++ return (CLIMIT - 1); +++ c = delcost(what) + inscost(with); +++ /* +++ * It costs extra to replace something which has +++ * semantics by something which doesn't. +++ */ +++ if (nullsem(what) == NIL && nullsem(with) != NIL) +++ c =+ 4; +++ return (c); +++} +++ +++/* +++ * Deletion costs +++ */ +++delcost(what) +++ int what; +++{ +++ +++ switch (what) { +++ case '.': +++ case ':': +++ case ',': +++ case '=': +++ case '(': +++ return (3); +++ case YELSE: +++ case YTHEN: +++ return (4); +++ default: +++ return (5); +++ case YLABEL: +++ case YCONST: +++ case YTYPE: +++ case YVAR: +++ return (10); +++ case YPROCEDURE: +++ case YFUNCTION: +++ case YBEGIN: +++ case YEND: +++ return ((CLIMIT * 3) / 4); +++ case ';': +++ case YEOF: +++ return (INFINITY); +++ } +++} +++#ifdef DEBUG +++ +++/* +++ * Routine to print out costs with "-K" option. +++ */ +++char yysyms[] ";,:=*+/-|&()[]<>~^"; +++ +++ +++yycosts() +++{ +++ register int c; +++ register char *cp; +++ +++ printf("Insert\tDelete\tRep(ID)\tSymbol\n"); +++ for (cp = yysyms; *cp; cp++) +++ yydocost(*cp); +++ for (c = ERROR + 1; c < YLAST; c++) +++ yydocost(c); +++#ifdef PXP +++ flush(); +++#endif +++} +++ +++yydocost(c) +++ int c; +++{ +++ +++ printf("%4d\t", inscost(c, -1)); +++ printf("%4d\t", delcost(c)); +++ if (repcost(c, YID) != inscost(YID) + delcost(c)) +++ printf("%4d", repcost(c, YID)); +++ printf("\t%s%s\n", charname(c)); +++} +++#endif diff --cc usr/src/cmd/pc0/yyerror.c index 0000000000,0000000000,0000000000..e8fe41a13c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyerror.c @@@@ -1,0 -1,0 -1,0 +1,99 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyerror.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * Yerror prints an error +++ * message and then returns +++ * NIL for the tree if needed. +++ * The error is flagged on the +++ * current line which is printed +++ * if the listing is turned off. +++#ifdef PXP +++ * +++ * As is obvious from the fooling around +++ * with fout below, the Pascal system should +++ * be changed to use the new library "lS". +++#endif +++ */ +++yerror(s, a1, a2, a3, a4, a5) +++ char *s; +++{ +++#ifdef PI +++ char buf[256]; +++#endif +++ register int i, j; +++ static yySerrs; +++#ifdef PXP +++ int ofout; +++#endif +++ +++ if (errpfx == 'w' && opt('w') != 0) { +++ errpfx = 'E'; +++ return; +++ } +++#ifdef PXP +++ flush(); +++ ofout = fout[0]; +++ fout[0] = errout; +++#endif +++ yyResume = 0; +++#ifdef PI +++ geterr(s, buf); +++ s = buf; +++#endif +++ yysync(); +++ pchr(errpfx); +++ pchr(' '); +++ for (i = 3; i < yyecol; i++) +++ pchr('-'); +++ printf("^--- "); +++/* +++ if (yyecol > 60) +++ printf("\n\t"); +++*/ +++ printf(s, a1, a2, a3, a4, a5); +++ pchr('\n'); +++ if (errpfx == 'E') +++#ifdef PI +++ eflg++, codeoff(); +++#endif +++#ifdef PXP +++ eflg++; +++#endif +++ errpfx = 'E'; +++ yySerrs++; +++ if (yySerrs >= MAXSYNERR) { +++ yySerrs = 0; +++ yerror("Too many syntax errors - QUIT"); +++ pexit(ERRS); +++ } +++#ifdef PXP +++ flush(); +++ fout[0] = ofout; +++ return (0); +++#endif +++} +++ +++/* +++ * A bracketing error message +++ */ +++brerror(where, what) +++ int where; +++ char *what; +++{ +++ +++ if (where == 0) { +++ line = yyeline; +++ setpfx(' '); +++ error("End matched %s on line %d", what, where); +++ return; +++ } +++ if (where < 0) +++ where = -where; +++ yerror("Inserted keyword end matching %s on line %d", what, where); +++} diff --cc usr/src/cmd/pc0/yyget.c index 0000000000,0000000000,0000000000..f8d5c5c159 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyget.c @@@@ -1,0 -1,0 -1,0 +1,341 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyget.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++#ifdef PXP +++int yytokcnt; +++#endif +++ +++/* +++ * Readch returns the next +++ * character from the current +++ * input line or -1 on end-of-file. +++ * It also maintains yycol for use in +++ * printing error messages. +++ */ +++readch() +++{ +++ register i, c; +++ +++ if (*bufp == '\n' && bufp >= charbuf) { +++#ifdef PXP +++ yytokcnt = 0; +++#endif +++ if (getline() < 0) +++ return (-1); +++ } +++ c = *++bufp; +++ if (c == '\t') +++ yycol = ((yycol + 8) & ~7); +++ else +++ yycol++; +++ return (c); +++} +++ +++/* +++ * Definitions of the structures used for the +++ * include facility. The variable "ibp" points +++ * to the getc buffer of the current input file. +++ * There are "inclev + 1" current include files, +++ * and information in saved in the incs stack +++ * whenever a new level of include nesting occurs. +++ * +++ * Ibp in the incs structure saves the pointer +++ * to the previous levels input buffer; +++ * filename saves the previous file name; +++ * Printed saves whether the previous file name +++ * had been printed before this nesting occurred; +++ * and yyline is the line we were on on the previous file. +++ */ +++ +++#define MAXINC 10 +++ +++struct inc { +++ FILE *ibp; +++ char *filename; +++ int Printed; +++ int yyline; +++ int yyLinpt; +++} incs[MAXINC]; +++ +++extern char *printed; +++ +++int inclev = -1; +++ +++#ifdef PXP +++/* +++ * These initializations survive only if +++ * pxp is asked to pretty print one file. +++ * Otherwise they are destroyed by the initial +++ * call to getline. +++ */ +++char charbuf[CBSIZE] = " program x(output);\n"; +++int yycol = 8; +++char *bufp = charbuf; +++ +++#endif +++/* +++ * YyLinpt is the seek pointer to the beginning of the +++ * next line in the file. +++ */ +++int yyLinpt; +++ +++/* +++ * Getline places the next line +++ * from the input stream in the +++ * line buffer, returning -1 at YEOF. +++ */ +++getline() +++{ +++ register char *cp; +++ register CHAR c; +++#ifdef PXP +++ static char ateof; +++#endif +++ register FILE *ib; +++ int i; +++ +++ if (opt('l') && yyprtd == 0) +++ yyoutline(); +++ yyprtd = 0; +++top: +++ yylinpt = yyLinpt; +++ yyline++; +++ yyseqid++; +++ cp = charbuf; +++ ib = ibp; +++ i = sizeof charbuf - 1; +++ for (;;) { +++ c = getc(ib); +++ if (c == EOF) { +++ if (uninclud()) +++ goto top; +++#ifdef PXP +++ if (ateof == 0 && bracket) { +++ strcpy(charbuf, "begin end.\n"); +++ ateof = 1; +++ goto out; +++ } +++#endif +++ bufp = "\n"; +++ yyline--; +++ yyseqid--; +++ yyprtd = 1; +++ return (-1); +++ } +++ *cp++ = c; +++ if (c == '\n') +++ break; +++ if (--i == 0) { +++ line = yyline; +++ error("Input line too long - QUIT"); +++ pexit(DIED); +++ } +++ } +++ *cp = 0; +++ yyLinpt = yylinpt + cp - charbuf; +++ if (includ()) +++ goto top; +++#ifdef PXP +++ if (cp == &charbuf[1]) +++ commnl(); +++ else if (cp == &charbuf[2]) +++ switch (charbuf[0]) { +++ case ' ': +++ commnlbl(); +++ break; +++ case '\f': +++ commform(); +++ } +++#endif +++ if (opt('u')) +++ setuflg(); +++out: +++ bufp = charbuf - 1; +++ yycol = 8; +++ return (1); +++} +++ +++/* +++ * Check an input line to see if it is a "#include" pseudo-statement. +++ * We allow arbitrary blanks in the line and the file name +++ * may be delimited by either 's or "s. A single semicolon +++ * may be placed after the name, but nothing else is allowed +++ */ +++includ() +++{ +++ register char *cp, *dp; +++ char ch; +++ register struct inc *ip; +++ +++ cp = charbuf; +++ if (*cp++ != '#') +++ return (0); +++ cp = skipbl(cp); +++ for (dp = "include"; *dp; dp++) +++ if (*dp != *cp++) +++ return (0); +++ line = yyline; +++ cp = skipbl(cp); +++ ch = *cp++; +++ if (ch != '\'' && ch != '"') { +++ /* +++ * This should be a yerror flagging the place +++ * but its not worth figuring out the column. +++ */ +++ line = yyline; +++ error("Include syntax error - expected ' or \" not found - QUIT"); +++ pexit(DIED); +++ } +++ for (dp = cp; *dp != ch; dp++) +++ if (*dp == 0) { +++ line = yyline; +++ error("Missing closing %c for include file name - QUIT", ch); +++ pexit(DIED); +++ } +++ *dp++ = 0; +++/* +++ * if (*dp == ';') +++ * dp++; +++ * dp = skipbl(dp); +++ * if (*dp != '\n') { +++ * line = yyline; +++ * error("Garbage after filename in include"); +++ * pexit(DIED); +++ * } +++ */ +++ if ((!dotted(cp, 'i')) && (!dotted(cp, 'h'))) { +++ line = yyline; +++ error("Include filename must end in .i or .h"); +++ } +++#ifdef PXP +++ commincl(cp, ch); +++ if (noinclude) +++ return (1); +++#endif +++ inclev++; +++ if (inclev > MAXINC) { +++ line = yyline; +++ error("Absurdly deep include nesting - QUIT"); +++ pexit(DIED); +++ } +++ ip = &incs[inclev]; +++ ip->filename = filename; +++ filename = savestr(cp); +++/* +++ * left over from before stdio +++ * +++ * cp = malloc(518); +++ * if (cp == -1) { +++ * error("Ran out of memory (include)"); +++ * pexit(DIED); +++ * } +++ * +++ */ +++ ip->ibp = ibp; +++ if ( ( ibp = fopen(filename, "r" ) ) == NULL ) { +++ perror(filename); +++ pexit(DIED); +++ } +++ if (inpflist(filename)) { +++#ifdef PI +++ opush('l'); +++#endif +++#ifdef PXP +++ opush('z'); +++#endif +++ } +++ ip->Printed = printed; +++ printed = 0; +++ ip->yyline = yyline; +++ yyline = 0; +++ ip->yyLinpt = yyLinpt; +++ yyLinpt = 0; +++/* +++ * left over from before stdio +++ * +++ * ip->ibp = ibp; +++ * ibp = cp; +++ * +++ */ +++# ifdef PC +++ stabinclude( filename ); +++# endif PC +++ return (1); +++} +++ +++skipbl(ocp) +++ char *ocp; +++{ +++ register char *cp; +++ +++ cp = ocp; +++ while (*cp == ' ' || *cp == '\t') +++ cp++; +++ return (cp); +++} +++ +++ +++/* +++ * At the end of an include, +++ * close the file, free the input buffer, +++ * and restore the environment before +++ * the "push", including the value of +++ * the z option for pxp and the l option for pi. +++ */ +++uninclud() +++{ +++ register struct inc *ip; +++ +++ if (inclev < 0) +++ return (0); +++/* +++ * left over from before stdio: becomes fclose ( ibp ) +++ * +++ * close(ibp[0]); +++ * free(ibp); +++ * +++ */ +++ fclose ( ibp ); +++ ip = &incs[inclev]; +++ ibp = ip->ibp; +++ yyline = ip->yyline; +++ if (inpflist(filename)) { +++#ifdef PI +++ opop('l'); +++#endif +++#ifdef PXP +++ opop('z'); +++#endif +++ } +++ filename = ip->filename; +++ yyLinpt = ip->yyLinpt; +++ /* +++ * If we printed out the nested name, +++ * then we should print all covered names again. +++ * If we didn't print out the nested name +++ * we print the uncovered name only if it +++ * has not been printed before (unstack). +++ */ +++ if (printed) { +++ printed = 0; +++ while (ip >= incs) { +++ ip->Printed = 0; +++ ip--; +++ } +++ } else +++ printed = ip->Printed; +++# ifdef PC +++ if ( inclev == 0 ) { +++ stabsource( filename ); +++ } else { +++ stabinclude( filename ); +++ } +++# endif PC +++ inclev--; +++ return (1); +++} diff --cc usr/src/cmd/pc0/yyid.c index 0000000000,0000000000,0000000000..9dc1b188bc new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyid.c @@@@ -1,0 -1,0 -1,0 +1,255 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyid.c 1.2 10/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++#ifdef PI +++extern int *yypv; +++/* +++ * Determine whether the identifier whose name +++ * is "cp" can possibly be a kind, which is a +++ * namelist class. We look through the symbol +++ * table for the first instance of cp as a non-field, +++ * and at all instances of cp as a field. +++ * If any of these are ok, we return true, else false. +++ * It would be much better to handle with's correctly, +++ * even to just know whether we are in a with at all. +++ * +++ * Note that we don't disallow constants on the lhs of assignment. +++ */ +++identis(cp, kind) +++ register char *cp; +++ int kind; +++{ +++ register struct nl *p; +++ int i; +++ +++ /* +++ * Cp is NIL when error recovery inserts it. +++ */ +++ if (cp == NIL) +++ return (1); +++ +++ /* +++ * Record kind we want for possible later use by yyrecover +++ */ +++ yyidwant = kind; +++ yyidhave = NIL; +++ i = ( (int) cp ) & 077; +++ for (p = disptab[i]; p != NIL; p = p->nl_next) +++ if (p->symbol == cp) { +++ if (yyidok(p, kind)) +++ goto gotit; +++ if (p->class != FIELD && p->class != BADUSE) +++ break; +++ } +++ if (p != NIL) +++ for (p = p->nl_next; p != NIL; p = p->nl_next) +++ if (p->symbol == cp && p->class == FIELD && yyidok(p, kind)) +++ goto gotit; +++ return (0); +++gotit: +++ if (p->class == BADUSE && !Recovery) { +++ yybadref(p, OY.Yyeline); +++ yypv[0] = NIL; +++ } +++ return (1); +++} +++ +++/* +++ * A bad reference to the identifier cp on line +++ * line and use implying the addition of kindmask +++ * to the mask of kind information. +++ */ +++yybaduse(cp, line, kindmask) +++ register char *cp; +++ int line, kindmask; +++{ +++ register struct nl *p, *oldp; +++ int i; +++ +++ i = ( (int) cp ) & 077; +++ for (p = disptab[i]; p != NIL; p = p->nl_next) +++ if (p->symbol == cp) +++ break; +++ oldp = p; +++ if (p == NIL || p->class != BADUSE) +++ p = enter(defnl(cp, BADUSE, 0, 0)); +++ p->value[NL_KINDS] =| kindmask; +++ yybadref(p, line); +++ return (oldp); +++} +++ +++ /* +++ * ud is initialized so that esavestr will allocate +++ * sizeof ( struct udinfo ) bytes for the 'real' struct udinfo +++ */ +++struct udinfo ud = { ~0 , ~0 , 0}; +++/* +++ * Record a reference to an undefined identifier, +++ * or one which is improperly used. +++ */ +++yybadref(p, line) +++ register struct nl *p; +++ int line; +++{ +++ register struct udinfo *udp; +++ +++ if (p->chain != NIL && p->chain->ud_line == line) +++ return; +++ udp = esavestr(&ud); +++ udp->ud_line = line; +++ udp->ud_next = p->chain; +++ p->chain = udp; +++} +++ +++#define varkinds ((1<class == BADUSE) { +++ if (kind == VAR) +++ return (p->value[0] & varkinds); +++ return (p->value[0] & (1 << kind)); +++ } +++ if (yyidok1(p, kind)) +++ return (1); +++ if (yyidhave != NIL) +++ yyidhave = IMPROPER; +++ else +++ yyidhave = p->class; +++ return (0); +++} +++ +++yyidok1(p, kind) +++ register struct nl *p; +++ int kind; +++{ +++ int i; +++ +++ switch (kind) { +++ case FUNC: +++ return ( p -> class == FUNC +++ || p -> class == FVAR +++ || p -> class == FFUNC ); +++ case PROC: +++ return ( p -> class == PROC || p -> class == FPROC ); +++ case CONST: +++ case TYPE: +++ case FIELD: +++ return (p->class == kind); +++ case VAR: +++ return (p->class == CONST || yyisvar(p, NIL)); +++ case ARRAY: +++ case RECORD: +++ return (yyisvar(p, kind)); +++ case PTRFILE: +++ return (yyisvar(p, PTR) || yyisvar(p, FILET)); +++ } +++} +++ +++yyisvar(p, class) +++ register struct nl *p; +++ int class; +++{ +++ +++ switch (p->class) { +++ case FIELD: +++ case VAR: +++ case REF: +++ case FVAR: +++ /* +++ * We would prefer to return +++ * parameterless functions only. +++ */ +++ case FUNC: +++ case FFUNC: +++ return (class == NIL || (p->type != NIL && p->type->class == class)); +++ case PROC: +++ case FPROC: +++ return ( class == NIL ); +++ } +++ return (0); +++} +++#endif +++#ifdef PXP +++#ifndef DEBUG +++identis() +++{ +++ +++ return (1); +++} +++#endif +++#ifdef DEBUG +++extern char *classes[]; +++ +++char kindchars[] "UCTVAQRDPF"; +++/* +++ * Fake routine "identis" for pxp when testing error recovery. +++ * Looks at letters in variable names to answer questions +++ * about attributes. Mapping is +++ * C const_id +++ * T type_id +++ * V var_id also if any of AQRDF +++ * A array_id +++ * Q ptr_id +++ * R record_id +++ * D field_id D for "dot" +++ * P proc_id +++ * F func_id +++ */ +++identis(cp, kind) +++ register char *cp; +++ int kind; +++{ +++ register char *dp; +++ char kindch; +++ +++ /* +++ * Don't do anything unless -T +++ */ +++ if (!typetest) +++ return (1); +++ +++ /* +++ * Inserted symbols are always correct +++ */ +++ if (cp == NIL) +++ return (1); +++ /* +++ * Set up the names for error messages +++ */ +++ yyidwant = classes[kind]; +++ for (dp = kindchars; *dp; dp++) +++ if (any(cp, *dp)) { +++ yyidhave = classes[dp - kindchars]; +++ break; +++ } +++ +++ /* +++ * U in the name means undefined +++ */ +++ if (any(cp, 'U')) +++ return (0); +++ +++ kindch = kindchars[kind]; +++ if (kindch == 'V') +++ for (dp = "AQRDF"; *dp; dp++) +++ if (any(cp, *dp)) +++ return (1); +++ return (any(cp, kindch)); +++} +++#endif +++#endif diff --cc usr/src/cmd/pc0/yylex.c index 0000000000,0000000000,0000000000..5773821b9f new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yylex.c @@@@ -1,0 -1,0 -1,0 +1,338 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yylex.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * Scanner +++ */ +++int yylacnt; +++ +++#define YYLASIZ 10 +++ +++struct yytok Yla[YYLASIZ]; +++ +++unyylex(y) +++ struct yylex *y; +++{ +++ +++ if (yylacnt == YYLASIZ) +++ panic("unyylex"); +++ copy(&Yla[yylacnt], y, sizeof Yla[0]); +++ yylacnt++; +++ +++} +++ +++yylex() +++{ +++ register c; +++ register **ip; +++ register char *cp; +++ int f; +++ char delim; +++ +++ if (yylacnt != 0) { +++ yylacnt--; +++ copy(&Y, &Yla[yylacnt], sizeof Y); +++ return (yychar); +++ } +++ if (c = yysavc) +++ yysavc = 0; +++ else +++ c = readch(); +++#ifdef PXP +++ yytokcnt++; +++#endif +++ +++next: +++ /* +++ * skip white space +++ */ +++#ifdef PXP +++ yywhcnt = 0; +++#endif +++ while (c == ' ' || c == '\t') { +++#ifdef PXP +++ if (c == '\t') +++ yywhcnt++; +++ yywhcnt++; +++#endif +++ c = readch(); +++ } +++ yyecol = yycol; +++ yyeline = yyline; +++ yyefile = filename; +++ yyeseqid = yyseqid; +++ yyseekp = yylinpt; +++ cp = token; +++ yylval = yyline; +++ switch (c) { +++ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g': +++ case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n': +++ case 'o': case 'p': case 'q': case 'r': case 's': case 't': case 'u': +++ case 'v': case 'w': case 'x': case 'y': case 'z': +++ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G': +++ case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N': +++ case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U': +++ case 'V': case 'W': case 'X': case 'Y': case 'Z': +++ do { +++ *cp++ = c; +++ c = readch(); +++ } while (alph(c) || digit(c)); +++ *cp = 0; +++ if (opt('s')) +++ for (cp = token; *cp; cp++) +++ if (*cp >= 'A' && *cp <= 'Z') { +++ *cp =| ' '; +++ } +++ yysavc = c; +++ ip = hash(0, 1); +++ if (*ip < yykey || *ip >= lastkey) { +++ yylval = *ip; +++ return (YID); +++ } +++ yylval = yyline; +++ /* +++ * For keywords +++ * the lexical token +++ * is magically retrieved +++ * from the keyword table. +++ */ +++ return ((*ip)[1]); +++ case '0': case '1': case '2': case '3': case '4': +++ case '5': case '6': case '7': case '8': case '9': +++ f = 0; +++ do { +++ *cp++ = c; +++ c = readch(); +++ } while (digit(c)); +++ if (c == 'b' || c == 'B') { +++ /* +++ * nonstandard - octal constants +++ */ +++ if (opt('s')) { +++ standard(); +++ yerror("Octal constants are non-standard"); +++ } +++ *cp = 0; +++ yylval = copystr(token); +++ return (YBINT); +++ } +++ if (c == '.') { +++ c = readch(); +++ if (c == '.') { +++ *cp = 0; +++ yysavc = YDOTDOT; +++ yylval = copystr(token); +++ return (YINT); +++ } +++infpnumb: +++ f++; +++ *cp++ = '.'; +++ if (!digit(c)) { +++ yyset(); +++ recovered(); +++ yerror("Digits required after decimal point"); +++ *cp++ = '0'; +++ } else +++ while (digit(c)) { +++ *cp++ = c; +++ c = readch(); +++ } +++ } +++ if (c == 'e' || c == 'E') { +++ f++; +++ *cp++ = c; +++ if ((c = yysavc) == 0) +++ c = readch(); +++ if (c == '+' || c == '-') { +++ *cp++ = c; +++ c = readch(); +++ } +++ if (!digit(c)) { +++ yyset(); +++ yerror("Digits required in exponent"); +++ *cp++ = '0'; +++ } else +++ while (digit(c)) { +++ *cp++ = c; +++ c = readch(); +++ } +++ } +++ *cp = 0; +++ yysavc = c; +++ yylval = copystr(token); +++ if (f) +++ return (YNUMB); +++ return (YINT); +++ case '"': +++ case '`': +++ if (!any(bufp + 1, c)) +++ goto illch; +++ if (!dquote) { +++ recovered(); +++ dquote++; +++ yerror("Character/string delimiter is '"); +++ } +++ case '\'': +++ case '#': +++ delim = c; +++ do { +++ do { +++ c = readch(); +++ if (c == '\n') { +++ yerror("Unmatched %c for string", delim); +++ if (cp == token) +++ *cp++ = ' ', cp++; +++ break; +++ } +++ *cp++ = c; +++ } while (c != delim); +++ c = readch(); +++ } while (c == delim); +++ *--cp = 0; +++ if (cp == token) { +++ yerror("Null string not allowed"); +++ *cp++ = ' '; +++ *cp++ = 0; +++ } +++ yysavc = c; +++ yylval = copystr(token); +++ return (YSTRING); +++ case '.': +++ c = readch(); +++ if (c == '.') +++ return (YDOTDOT); +++ if (digit(c)) { +++ recovered(); +++ yerror("Digits required before decimal point"); +++ *cp++ = '0'; +++ goto infpnumb; +++ } +++ yysavc = c; +++ return ('.'); +++ case '{': +++ /* +++ * { ... } comment +++ */ +++#ifdef PXP +++ getcm(c); +++#endif +++#ifdef PI +++ c = options(); +++ while (c != '}') { +++ if (c <= 0) +++ goto nonterm; +++ if (c == '{') { +++ warning(); +++ yyset(); +++ yerror("{ in a { ... } comment"); +++ } +++ c = readch(); +++ } +++#endif +++ c = readch(); +++ goto next; +++ case '(': +++ if ((c = readch()) == '*') { +++ /* +++ * (* ... *) comment +++ */ +++#ifdef PXP +++ getcm(c); +++ c = readch(); +++ goto next; +++#endif +++#ifdef PI +++ c = options(); +++ for (;;) { +++ if (c < 0) { +++nonterm: +++ yerror("Comment does not terminate - QUIT"); +++ pexit(ERRS); +++ } +++ if (c == '(' && (c = readch()) == '*') { +++ warning(); +++ yyset(); +++ yerror("(* in a (* ... *) comment"); +++ } +++ if (c == '*') { +++ if ((c = readch()) != ')') +++ continue; +++ c = readch(); +++ goto next; +++ } +++ c = readch(); +++ } +++#endif +++ } +++ yysavc = c; +++ c = '('; +++ case ';': +++ case ',': +++ case ':': +++ case '=': +++ case '*': +++ case '+': +++ case '/': +++ case '-': +++ case '|': +++ case '&': +++ case ')': +++ case '[': +++ case ']': +++ case '<': +++ case '>': +++ case '~': +++ case '^': +++ return (c); +++ default: +++ switch (c) { +++ case YDOTDOT: +++ return (c); +++ case '\n': +++ c = readch(); +++#ifdef PXP +++ yytokcnt++; +++#endif +++ goto next; +++ case '\f': +++ c = readch(); +++ goto next; +++ } +++ if (c <= 0) +++ return (YEOF); +++illch: +++ do +++ yysavc = readch(); +++ while (yysavc == c); +++ yylval = c; +++ return (YILLCH); +++ } +++} +++ +++yyset() +++{ +++ +++ yyecol = yycol; +++ yyeline = yyline; +++ yyefile = filename; +++ yyseekp = yylinpt; +++} +++ +++/* +++ * Setuflg trims the current +++ * input line to at most 72 chars +++ * for the u option. +++ */ +++setuflg() +++{ +++ +++ if (charbuf[71] != '\n') { +++ charbuf[72] = '\n'; +++ charbuf[73] = 0; +++ } +++} diff --cc usr/src/cmd/pc0/yymain.c index 0000000000,0000000000,0000000000..dc193cdeca new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yymain.c @@@@ -1,0 -1,0 -1,0 +1,162 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yymain.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++#include +++#include "objfmt.h" +++#include +++ +++short line = 1; +++ +++/* +++ * Yymain initializes each of the utility +++ * clusters and then starts the processing +++ * by calling yyparse. +++ */ +++yymain() +++{ +++ +++ /* +++ * Initialize the scanner +++ */ +++#ifdef PXP +++ if (bracket == 0) { +++#endif +++ if (getline() == -1) { +++ Perror(filename, "No lines in file"); +++ pexit(NOSTART); +++ } +++#ifdef PXP +++ } else +++ yyline = 0; +++#endif +++ +++#ifdef PI +++# ifdef OBJ +++ magic(); +++# endif OBJ +++#endif +++ /* +++ * Initialize the clusters +++ * +++ initstring(); +++ */ +++ inithash(); +++ inittree(); +++#ifdef PI +++ initnl(); +++#endif +++ +++ /* +++ * Process the input +++ */ +++ yyparse(); +++#ifdef PI +++# ifdef OBJ +++ magic2(); +++# endif OBJ +++# ifdef DEBUG +++ dumpnl(0); +++# endif +++#endif +++#ifdef PXP +++ prttab(); +++ if (onefile) { +++ extern int outcol; +++ +++ if (outcol) +++ pchr('\n'); +++ flush(); +++ if (eflg) { +++ writef(2, "File not rewritten because of errors\n"); +++ pexit(ERRS); +++ } +++ signal(SIGHUP, SIG_IGN); +++ signal(SIGINT, SIG_IGN); +++ copyfile(); +++ } +++#endif +++ pexit(eflg ? ERRS : AOK); +++} +++ +++#ifdef PXP +++copyfile() +++{ +++ extern int fout[]; +++ register int c; +++ +++ close(1); +++ if (creat(firstname, 0644) != 1) { +++ perror(firstname); +++ pexit(ERRS); +++ } +++ lseek(fout[0], 0l, 0); +++ while ((c = read(fout[0], &fout[3], 512)) > 0) { +++ if (write(1, &fout[3], c) != c) { +++ perror(firstname); +++ pexit(ERRS); +++ } +++ } +++} +++#endif +++ +++static +++struct exec magichdr; +++ +++#ifdef PI +++#ifdef OBJ +++magic() +++{ +++ +++ short buf[HEADER_BYTES / sizeof ( short )]; +++ unsigned *ubuf = buf; +++ register int hf, i; +++ +++ hf = open(PX_HEADER,0); +++ if (hf >= 0 && read(hf, buf, HEADER_BYTES) > sizeof(struct exec)) { +++ magichdr.a_magic = ubuf[0]; +++ magichdr.a_text = ubuf[1]; +++ magichdr.a_data = ubuf[2]; +++ magichdr.a_bss = ubuf[3]; +++ magichdr.a_syms = ubuf[4]; +++ magichdr.a_entry = ubuf[5]; +++ magichdr.a_trsize = ubuf[6]; +++ magichdr.a_drsize = ubuf[7]; +++ for (i = 0; i < HEADER_BYTES / sizeof ( short ); i++) +++ word(buf[i]); +++ } +++ close(hf); +++} +++#endif OBJ +++ +++#ifdef OBJ +++magic2() +++{ +++ struct pxhdr pxhd; +++ +++ if (magichdr.a_magic != 0407) +++ panic ( "magic2" ); +++ pflush(); +++ lseek(ofil, 0l, 0); +++ magichdr.a_data = ( unsigned ) lc - magichdr.a_text; +++ magichdr.a_data -= sizeof (struct exec); +++ write(ofil, &magichdr, sizeof(struct exec)); +++ pxhd.objsize = ( ( unsigned ) lc) - HEADER_BYTES; +++ pxhd.maketime = time(0); +++ pxhd.magicnum = MAGICNUM; +++ lseek(ofil, ( long ) ( HEADER_BYTES - sizeof ( pxhd ) ) , 0); +++ write(ofil, &pxhd, sizeof (pxhd)); +++} +++#endif OBJ +++#endif +++ +++#ifdef PXP +++writef(i, cp) +++{ +++ +++ write(i, cp, strlen(cp)); +++} +++#endif diff --cc usr/src/cmd/pc0/yyoptions.c index 0000000000,0000000000,0000000000..1145ed00e7 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyoptions.c @@@@ -1,0 -1,0 -1,0 +1,74 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyoptions.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * Options processes the option +++ * strings which can appear in +++ * comments and returns the next character. +++ */ +++options() +++{ +++ register c, ch; +++ register char *optp; +++ int ok; +++ +++ c = readch(); +++ if (c != '$') +++ return (c); +++ do { +++ ch = c = readch(); +++ switch (c) { +++ case 'b': +++ optp = &opt( 'b' ); +++ c = readch(); +++ if (!digit(c)) +++ return (c); +++ *optp = c - '0'; +++ c = readch(); +++ break; +++# ifdef PC +++ case 'C': +++ /* +++ * C is a replacement for t, fake it. +++ */ +++ c = 't'; +++ /* and fall through */ +++ case 'g': +++# endif PC +++ case 'k': +++ case 'l': +++ case 'n': +++ case 'p': +++ case 's': +++ case 't': +++ case 'u': +++ case 'w': +++ case 'z': +++ optp = &opt( c ); +++ c = readch(); +++ if (c == '+') { +++ *optp = 1; +++ c = readch(); +++ } else if (c == '-') { +++ *optp = 0; +++ c = readch(); +++ } else { +++ return (c); +++ } +++ break; +++ default: +++ return (c); +++ } +++#ifdef PI0 +++ send(ROSET, ch, *optp); +++#endif +++ } while (c == ','); +++ if ( opt( 'u' ) ) +++ setuflg(); +++ return (c); +++} diff --cc usr/src/cmd/pc0/yypanic.c index 0000000000,0000000000,0000000000..1f27f12a8e new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yypanic.c @@@@ -1,0 -1,0 -1,0 +1,149 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yypanic.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++struct yytok oldpos; +++/* +++ * The routine yyPerror coordinates the panic when +++ * the correction routines fail. Three types of panics +++ * are possible - those in a declaration part, those +++ * in a statement part, and those in an expression. +++ * +++ * Declaration part panics consider insertion of "begin", +++ * expression part panics will stop on more symbols. +++ * The panics are otherwise the same. +++ * +++ * ERROR MESSAGE SUPPRESSION STRATEGY: August 11, 1977 +++ * +++ * If the parser has not made at least 2 moves since the last point of +++ * error then we want to suppress the supplied error message. +++ * Otherwise we print it. +++ * We then skip input up to the next solid symbol. +++ */ +++yyPerror(cp, kind) +++ char *cp; +++ register int kind; +++{ +++ register int ishifts, brlev; +++ +++ copy(&oldpos, &Y, sizeof oldpos); +++ brlev = 0; +++ if (yychar < 0) +++ yychar = yylex(); +++ for (ishifts = yyshifts; ; yychar = yylex(), yyshifts++) +++ switch (yychar) { +++ case YILLCH: +++ yerror("Illegal character"); +++ if (ishifts == yyshifts) +++ yyOshifts = 0; +++ continue; +++ case YEOF: +++ goto quiet; +++ case ';': +++ if (kind == PPROG) +++ continue; +++ if (kind == PDECL) +++ yychar = yylex(); +++ goto resume; +++ case YEND: +++ if (kind == PPROG) +++ continue; +++ case YPROCEDURE: +++ case YFUNCTION: +++ goto resume; +++ case YLABEL: +++ case YTYPE: +++ case YCONST: +++ case YVAR: +++ if (kind == PSTAT) { +++ yerror("Declaration found when statement expected"); +++ goto quiet; +++ } +++ case YBEGIN: +++ goto resume; +++ case YFOR: +++ case YREPEAT: +++ case YWHILE: +++ case YGOTO: +++ case YIF: +++ if (kind != PDECL) +++ goto resume; +++ yerror("Expected keyword begin after declarations, before statements"); +++ unyylex(&Y); +++ yychar = YBEGIN; +++ yylval = nullsem(YBEGIN); +++ goto quiet; +++ case YTHEN: +++ case YELSE: +++ case YDO: +++ if (kind == PSTAT) { +++ yychar = yylex(); +++ goto resume; +++ } +++ if (kind == PEXPR) +++ goto resume; +++ continue; +++ case ')': +++ case ']': +++ if (kind != PEXPR) +++ continue; +++ if (brlev == 0) +++ goto resume; +++ if (brlev > 0) +++ brlev--; +++ continue; +++ case '(': +++ case '[': +++ brlev++; +++ continue; +++ case ',': +++ if (brlev != 0) +++ continue; +++ case YOF: +++ case YTO: +++ case YDOWNTO: +++ if (kind == PEXPR) +++ goto resume; +++ continue; +++#ifdef PI +++ /* +++ * A rough approximation for now +++ * Should be much more lenient on suppressing +++ * warnings. +++ */ +++ case YID: +++ syneflg++; +++ continue; +++#endif +++ } +++resume: +++ if (yyOshifts >= 2) { +++ if (yychar != -1) +++ unyylex(&Y); +++ copy(&Y, &oldpos, sizeof Y); +++ yerror(cp); +++ yychar = yylex(); +++ } +++quiet: +++ if (yyshifts - ishifts > 2 && opt('r')) { +++ setpfx('r'); +++ yerror("Parsing resumes"); +++ } +++ /* +++ * If we paniced in the statement part, +++ * and didn't stop at a ';', then we insert +++ * a ';' to prevent the recovery from immediately +++ * inserting one and complaining about it. +++ */ +++ if (kind == PSTAT && yychar != ';') { +++ unyylex(&Y); +++ yyshifts--; +++ yytshifts--; +++ yychar = ';'; +++ yylval = nullsem(';'); +++ } +++} diff --cc usr/src/cmd/pc0/yyparse.c index 0000000000,0000000000,0000000000..d8c8afdb90 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyparse.c @@@@ -1,0 -1,0 -1,0 +1,202 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyparse.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * Parser for 'yacc' output. +++ * Specifially Modified for Berkeley Pascal +++ */ +++ +++int yystate; /* Current parser state */ +++int *yypv; +++unsigned yytshifts 1; /* Number of "true" shifts */ +++ +++/* +++ * Parse Tables +++ */ +++int yygo[]; +++int yypgo[]; +++int yyr1[]; +++int yyr2[]; +++int yyact[]; +++int yypact[]; +++ +++/* +++ * Parse and parallel semantic stack +++ */ +++int yyv[MAXDEPTH]; +++int yys[MAXDEPTH]; +++ +++/* +++ * This routine parses the input stream, and +++ * returns if it accepts, or if an unrecoverable syntax +++ * error is encountered. +++ */ +++yyparse() +++{ +++ register int *ps, n, *p; +++ int paniced, *panicps, idfail; +++ +++ yystate = 0; +++ yychar = yylex(); +++ OY.Yychar = -1; +++ yyshifts = 3; +++ paniced = 0; +++ ps = &yys[0]-1; +++ yypv = &yyv[0]-1; +++#ifdef PXP +++ yypw = &yyw[0]-1; +++#endif +++ +++stack: +++ /* +++ * Push new state and value. +++ */ +++ if (yypv >= &yyv[MAXDEPTH-1]) { +++ yerror("Parse stack overflow"); +++ pexit(DIED); +++ } +++ *++ps = yystate; +++ *++yypv = yyval; +++#ifdef PXP +++ yypw++; +++#endif +++newstate: +++ /* +++ * Locate parsing actions for the +++ * new parser state. +++ */ +++ p = &yyact[ yypact[yystate+1] ]; +++actn: +++ /* +++ * Search the parse actions table +++ * for something useful to do. +++ * While n is non-positive, it is the negation +++ * of the token we are testing for. +++ */ +++#ifdef PI +++ if ((n = *p++) <= 0) { +++ if (yychar < 0) +++ yychar = yylex(); +++ do +++ if ((n =+ yychar) != 0) +++ p++; +++ while ((n = *p++) <= 0); +++ } +++#else +++ while ((n = *p++) <= 0) +++ if ((n =+ yychar) != 0) +++ p++; +++#endif +++ switch (n >> 12) { +++ +++ /* +++ * Shift. +++ */ +++ case 2: +++#ifdef PXP +++ yypw[1].Wseqid = yyseqid; +++ yypw[1].Wcol = yycol; +++#endif +++ OYcopy(); +++ yystate = n & 07777; +++ yyval = yylval; +++#ifdef PI +++ yychar = -1; +++#else +++ yychar = yylex(); +++#endif +++ yyshifts++; +++ yytshifts++; +++ goto stack; +++ +++ /* +++ * Reduce. +++ */ +++ case 3: +++ n =& 07777; +++ N = yyr2[n]; +++ if (N == 1 && OY.Yychar == YID && !yyEactr(n, yypv[0])) { +++ idfail = 1; +++ goto errin; +++ } +++ OY.Yychar = -1; +++ ps =- N; +++ yypv =- N; +++#ifdef PXP +++ yypw =- N; +++#endif +++ yyval = yypv[1]; +++ yyactr(n); +++ /* +++ * Use goto table to find next state. +++ */ +++ p = &yygo[yypgo[yyr1[n]]]; +++ while (*p != *ps && *p >= 0) +++ p =+ 2; +++ yystate = p[1]; +++ goto stack; +++ +++ /* +++ * Accept. +++ */ +++ case 4: +++ return; +++ +++ /* +++ * Error. +++ */ +++ case 1: +++ idfail = 0; +++errin: +++ if ((paniced || yyshifts != 0) && yyrecover(ps, idfail)) { +++ paniced = 0; +++ ps = Ps; +++ yystate = *ps; +++ goto newstate; +++ } +++ /* +++ * Find a state where 'error' is a +++ * legal shift action. +++ */ +++ if (paniced && yyshifts <= 0 && ps >= panicps) { +++ yypv =- (ps - panicps) + 1; +++#ifdef PXP +++ yypw =- (ps - panicps) + 1; +++#endif +++ ps = panicps - 1; +++ } +++ while (ps >= yys) { +++ for (p = &yyact[ yypact[*ps+1] ] ; *p <= 0; p=+ 2) +++ if (*p == -256) { +++ panicps = ps; +++ yystate= p[1] & 07777; +++ yyOshifts = yyshifts; +++ yyshifts = 0; +++ paniced = 1; +++ goto stack; +++ } +++ --ps; +++ --yypv; +++#ifdef PXP +++ --yypw; +++#endif +++#ifdef PI +++ if (OY.Yychar != YID) +++ syneflg++; +++#endif +++ OY.Yychar = -1; +++ } +++ if (yychar == YEOF) +++ yyunexeof(); +++ if (yystate == 1) +++ yyexeof(); +++ yerror("Unrecoverable syntax error - QUIT"); +++ return; +++ } +++ panic("yyparse"); +++} diff --cc usr/src/cmd/pc0/yyprint.c index 0000000000,0000000000,0000000000..efcfc0e89b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyprint.c @@@@ -1,0 -1,0 -1,0 +1,97 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyprint.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++char *tokname(); +++ +++STATIC bool bounce; +++ +++/* +++ * Printing representation of a +++ * "character" - a lexical token +++ * not in a yytok structure. +++ * 'which' indicates which char * you want +++ * should always be called as "charname(...,0),charname(...,1)" +++ */ +++char * +++charname(ch , which ) +++ int ch; +++ int which; +++{ +++ struct yytok Ych; +++ +++ Ych.Yychar = ch; +++ Ych.Yylval = nullsem(ch); +++ return (tokname(&Ych , which )); +++} +++ +++/* +++ * Printing representation of a token +++ * 'which' as above. +++ */ +++char * +++tokname(tp , which ) +++ register struct yytok *tp; +++ int which; +++{ +++ register char *cp; +++ register struct kwtab *kp; +++ char *cp2; +++ +++ cp2 = ""; +++ switch (tp->Yychar) { +++ case YCASELAB: +++ cp = "case-label"; +++ break; +++ case YEOF: +++ cp = "end-of-file"; +++ break; +++ case YILLCH: +++ cp = "illegal character"; +++ break; +++ case 256: +++ /* error token */ +++ cp = "error"; +++ break; +++ case YID: +++ cp = "identifier"; +++ break; +++ case YNUMB: +++ cp = "real number"; +++ break; +++ case YINT: +++ case YBINT: +++ cp = "number"; +++ break; +++ case YSTRING: +++ cp = tp->Yylval; +++ cp = cp == NIL || cp[1] == 0 ? "character" : "string"; +++ break; +++ case YDOTDOT: +++ cp = "'..'"; +++ break; +++ default: +++ if (tp->Yychar < 256) { +++ cp = "'x'\0'x'\0'x'\0'x'"; +++ /* +++ * for four times reentrant code! +++ * used to be: +++ * if (bounce = ((bounce + 1) & 1)) +++ * cp += 4; +++ */ +++ bounce = ( bounce + 1 ) % 4; +++ cp += (4 * bounce); /* 'x'\0 is 4 chars */ +++ cp[1] = tp->Yychar; +++ break; +++ } +++ for (kp = yykey; kp->kw_str != NIL && kp->kw_val != tp->Yychar; kp++) +++ continue; +++ cp = "keyword "; +++ cp2 = kp->kw_str; +++ } +++ return ( which ? cp2 : cp ); +++} diff --cc usr/src/cmd/pc0/yyput.c index 0000000000,0000000000,0000000000..53a7e47f61 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyput.c @@@@ -1,0 -1,0 -1,0 +1,276 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyput.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "yy.h" +++ +++/* +++ * Structure describing queued listing lines during the forward move +++ * of error recovery. These lines will be stroed by yyoutline during +++ * the forward move and flushed by yyoutfl or yyflush when an +++ * error occurs or a program termination. +++ */ +++struct B { +++ int Bmagic; +++ int Bline; +++ int Bseekp; +++ char *Bfile; +++ int Bseqid; +++ struct B *Bnext; +++} *bottled; +++ +++/* +++ * Filename gives the current input file, lastname is +++ * the last filename we printed, and lastid is the seqid of the last line +++ * we printed, to help us avoid printing +++ * multiple copies of lines. +++ */ +++extern char *filename; +++char *lastname; +++int lastid; +++ +++char hadsome; +++char holdbl; +++ +++/* +++ * Print the current line in the input line +++ * buffer or, in a forward move of the recovery, queue it for printing. +++ */ +++yyoutline() +++{ +++ register struct B *bp; +++ +++ if (Recovery) { +++ bp = tree(6, T_BOTTLE, yyline, yylinpt, filename, yyseqid); +++ if (bottled != NIL) +++ bp->Bnext = bottled->Bnext, bottled->Bnext = bp; +++ else +++ bp->Bnext = bp; +++ bottled = bp; +++ return; +++ } +++ yyoutfl(yyseqid); +++ if (yyseqid != lastid) +++ yyprline(charbuf, yyline, filename, yyseqid); +++} +++ +++/* +++ * Flush all the bottled output. +++ */ +++yyflush() +++{ +++ +++ yyoutfl(32767); +++} +++ +++/* +++ * Flush the listing to the sequence id toseqid +++ */ +++yyoutfl(toseqid) +++ int toseqid; +++{ +++ register struct B *bp; +++ +++ bp = bottled; +++ if (bp == NIL) +++ return; +++ bp = bp->Bnext; +++ while (bp->Bseqid <= toseqid) { +++ yygetline(bp->Bfile, bp->Bseekp, bp->Bline, bp->Bseqid); +++ if (bp->Bnext == bp) { +++ bottled = NIL; +++ break; +++ } +++ bp = bp->Bnext; +++ bottled->Bnext = bp; +++ } +++} +++ +++FILE *yygetunit = NULL; +++char *yygetfile; +++ +++/* +++ * Yysync guarantees that the line associated +++ * with the current token was the last line +++ * printed for a syntactic error message. +++ */ +++yysync() +++{ +++ +++ yyoutfl(yyeseqid); +++ if (lastid != yyeseqid) +++ yygetline(yyefile, yyseekp, yyeline, yyeseqid); +++} +++ +++yySsync() +++{ +++ +++ yyoutfl(OY.Yyeseqid); +++} +++ +++/* +++ * Yygetline gets a line from a file after we have +++ * lost it. The pointer efile gives the name of the file, +++ * seekp its offset in the file, and eline its line number. +++ * If this routine has been called before the last file +++ * it worked on will be open in yygetunit, with the files +++ * name being given in yygetfile. Note that this unit must +++ * be opened independently of the unit in use for normal i/o +++ * to this file; if it were a dup seeks would seek both files. +++ */ +++yygetline(efile, seekp, eline, eseqid) +++ char *efile; +++ int seekp, eline, eseqid; +++{ +++ register int cnt; +++ register char *bp; +++ char buf[CBSIZE + 1]; +++ +++ if (lastid == eseqid) +++ return; +++ if (eseqid == yyseqid) { +++ bp = charbuf; +++ yyprtd++; +++ } else { +++ bp = buf; +++ if (efile != yygetfile) { +++ if ( yygetunit != NULL ) +++ fclose( yygetunit ); +++ yygetfile = efile; +++ yygetunit = fopen( yygetfile , "r" ); +++ if (yygetunit < 0) +++oops: +++ perror(yygetfile), pexit(DIED); +++ } +++ if ( fseek( yygetunit , (long) seekp , 0 ) < 0) +++ goto oops; +++ cnt = fread( bp , sizeof( * bp ) , CBSIZE , yygetunit ); +++ if (cnt < 0) +++ goto oops; +++ bp[cnt] = 0; +++ } +++ yyprline(bp, eline, efile, eseqid); +++} +++ +++yyretrieve() +++{ +++ +++ yygetline(OY.Yyefile, OY.Yyseekp, OY.Yyeline, OY.Yyeseqid); +++} +++ +++/* +++ * Print the line in the character buffer which has +++ * line number line. The buffer may be terminated by a new +++ * line character or a null character. We process +++ * form feed directives, lines with only a form feed character, and +++ * suppress numbering lines which are empty here. +++ */ +++yyprline(buf, line, file, id) +++ register char *buf; +++ int line; +++ char *file; +++ int id; +++{ +++ +++ lastid = id; +++ if (buf[0] == '\f' && buf[1] == '\n') { +++ printf("\f\n"); +++ hadsome = 0; +++ holdbl = 0; +++ return; +++ } +++ if (holdbl) { +++ pchr('\n'); +++ holdbl = 0; +++ } +++ if (buf[0] == '\n') +++ holdbl = 1; +++ else { +++ yysetfile(file); +++ yyprintf(buf, line); +++ } +++ hadsome = 1; +++} +++ +++yyprintf(cp, line) +++ register char *cp; +++ int line; +++{ +++ +++ printf("%6d ", line); +++ while (*cp != 0 && *cp != '\n') +++ pchr(graphic(*cp++)); +++ pchr('\n'); +++} +++ +++graphic(ch) +++ register CHAR ch; +++{ +++ +++ switch (ch) { +++ default: +++ if (ch >= ' ') +++ return (ch); +++ case 0177: +++ return ('?'); +++ case '\n': +++ case '\t': +++ return (ch); +++ } +++} +++ +++extern int nopflg; +++ +++char printed 1; +++/* +++ * Set the current file name to be file, +++ * printing the name, or a header on a new +++ * page if required. +++ * there is another yysetfile in error.c +++ * this one is for PI and PXP that one is for PI1 +++ */ +++yysetfile(file) +++ register char *file; +++{ +++ +++#ifdef PXP +++ if (nopflg == 1) +++ return; +++#endif +++ +++ if (lastname == file) +++ return; +++ if (file == filename && opt('n') && (printed & 02) == 0) { +++ printed =| 02; +++ header(); +++ } else +++ yyputfn(file); +++ lastname = file; +++} +++ +++/* +++ * Put out an include file name +++ * if an error occurs but the name has +++ * not been printed (or if another name +++ * has been printed since it has). +++ */ +++yyputfn(cp) +++ register char *cp; +++{ +++ extern int outcol; +++ +++ if (cp == lastname && printed) +++ return; +++ lastname = cp; +++ printed = 1; +++#ifdef PXP +++ if (outcol) +++ pchr('\n'); +++#endif +++ gettime( cp ); +++ printf("%s %s:\n" , myctime( &tvec ) , cp ); +++ hadsome = 1; +++} diff --cc usr/src/cmd/pc0/yyrecover.c index 0000000000,0000000000,0000000000..7d8ffd3e54 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyrecover.c @@@@ -1,0 -1,0 -1,0 +1,860 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyrecover.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * Very simplified version of Graham-Rhodes error recovery +++ * method for LALR parsers. Backward move is embodied in +++ * default reductions of the yacc parser until an error condition +++ * is reached. Forward move is over a small number of input tokens +++ * and cannot "condense". The basic corrections are: +++ * +++ * 1) Delete the input token. +++ * +++ * 2) Replace the current input with a legal input. +++ * +++ * 3) Insert a legal token. +++ * +++ * All corrections are weighted, considered only if they allow +++ * at least two shifts, and the cost of a correction increases if +++ * it allows shifting over only a part of the lookahead. +++ * +++ * Another error situation is that which occurs when an identifier "fails" +++ * a reduction because it is not the required "class". +++ * In this case, we also consider replacing this identifier, which has +++ * already been shifted over, with an identifier of the correct class. +++ * +++ * Another correction performed here is unique symbol insertion. +++ * If the current state admits only one input, and no other alternative +++ * correction presents itself, then that symbol will be inserted. +++ * There is a danger in this of looping, and it is handled +++ * by counting true shifts over input (see below). +++ * +++ * +++ * A final class of corrections, considered only when the error +++ * occurred immediately after a shift over a terminal, involves +++ * the three basic corrections above, but with the point of error +++ * considered to be before this terminal was shifted over, effectively +++ * "unreading" this terminal. This is a feeble attempt at elimination +++ * of the left-right bias and because "if" has a low weight and some +++ * statements are quite simple i.e. +++ * +++ * cse ch of ... +++ * +++ * we can get a small number of errors. The major deficiency of +++ * this is that we back up only one token, and that the forward +++ * move is over a small number of tokens, often not enough to really +++ * tell what the input should be, e.g. in +++ * +++ * a[i] > a[i - 1] ... +++ * +++ * In such cases a bad identifier (misspelled keyword) or omitted +++ * keyword will be change or inserted as "if" as it has the lowest cost. +++ * This is not terribly bad, as "if"s are most common. +++ * This also allows the correction of other errors. +++ * +++ * This recovery depends on the default reductions which delay +++ * noticing the error until the parse reaches a state where the +++ * relevant "alternatives" are visible. Note that it does not +++ * consider tokens which will cause reductions before being +++ * shifted over. This requires the grammar to be written in a +++ * certain way for the recovery to work correctly. +++ * In some sense, also, the recovery suffers because we have +++ * LALR(1) tables rather than LR(1) tables, e.g. in +++ * +++ * if rec.field < rec2,field2 then +++ */ +++ +++/* +++ * Definitions of possible corrective actions +++ */ +++#define CPANIC 0 +++#define CDELETE 1 +++#define CREPLACE 2 +++#define CINSERT 3 +++#define CUNIQUE 4 +++#define CCHIDENT 5 +++ +++/* +++ * Multiplicative cost factors for corrective actions. +++ * +++ * When an error occurs we take YCSIZ - 1 look-ahead tokens. +++ * If a correction being considered will shift over only part of +++ * that look-ahead, it is not completely discarded, but rather +++ * "weighted", its cost being multiplied by a weighting factor. +++ * For a correction to be considered its weighted cost must be less +++ * than CLIMIT. +++ * +++ * Non-weighted costs are considered: +++ * +++ * LOW <= 3 +++ * MEDIUM 4,5 +++ * HIGH >= 6 +++ * +++ * CURRENT WEIGHTING STRATEGY: Aug 20, 1977 +++ * +++ * For all kinds of corrections we demand shifts over two symbols. +++ * Corrections have high weight even after two symbol +++ * shifts because the costs for deleting and inserting symbols are actually +++ * quite low; we do not want to change weighty symbols +++ * on inconclusive evidence. +++ * +++ * The weights are the same after the third look ahead. +++ * This prevents later, unrelated errors from causing "funny" +++ * biases of the weights toward one type of correction. +++ * +++ * Current look ahead is 5 symbols. +++ */ +++ +++/*** CLIMIT is defined in yy.h for yycosts ***/ +++#define CPRLIMIT 50 +++#define CCHIDCOST 3 +++ +++char insmult[8] = {INFINITY, INFINITY, INFINITY, 15, 8, 6, 3, 1}; +++char repmult[7] = {INFINITY, INFINITY, INFINITY, 8, 6, 3, 1}; +++char delmult[6] = {INFINITY, INFINITY, INFINITY, 6, 3, 1}; +++ +++#define NOCHAR -1 +++ +++#define Eprintf if (errtrace) printf +++#define Tprintf if (testtrace) printf +++ +++/* +++ * Action arrays of the parser needed here +++ */ +++int yyact[], yypact[], *yypv; +++ +++/* +++ * Yytips is the tip of the stack when using +++ * the function loccor to check for local +++ * syntactic correctness. As we don't want +++ * to copy the whole parser stack, but want +++ * to simulate parser moves, we "split" +++ * the parser stack and keep the tip here. +++ */ +++#define YYTIPSIZ 16 +++int yytips[YYTIPSIZ], yytipct; +++int yytipv[YYTIPSIZ]; +++ +++/* +++ * The array YC saves the lookahead tokens for the +++ * forward moves. +++ * Yccnt is the number of tokens in the YC array. +++ */ +++#define YCSIZ 6 +++ +++int yCcnt; +++struct yytok YC0[YCSIZ + 1]; +++struct yytok *YC; +++ +++/* +++ * YCps gives the top of stack at +++ * the point of error. +++ */ +++ +++bool yyunique 1; +++ +++STATIC unsigned yyTshifts; +++ +++/* +++ * Cact is the corrective action we have decided on +++ * so far, ccost its cost, and cchar the associated token. +++ * Cflag tells if the correction is over the previous input token. +++ */ +++int cact, ccost, cchar, cflag; +++ +++/* +++ * ACtok holds the token under +++ * consideration when examining +++ * the lookaheads in a state. +++ */ +++struct yytok ACtok; +++ +++#define acchar ACtok.Yychar +++#define aclval ACtok.Yylval +++ +++/* +++ * Make a correction to the current stack which has +++ * top of stack pointer Ps. +++ */ +++yyrecover(Ps0, idfail) +++ int *Ps0, idfail; +++{ +++ register int c, i; +++ int yyrwant, yyrhave; +++ +++#ifdef PI +++ Recovery = 1; +++#endif +++ +++ YC = &YC0[1]; +++#ifdef DEBUG +++ if (errtrace) { +++ setpfx('p'); +++ yerror("Point of error"); +++ printf("States %d %d ...", Ps0[0], Ps0[-1]); +++ if (idfail) +++ printf(" [Idfail]"); +++ pchr('\n'); +++ printf("Input %s%s", tokname(&Y , 0) +++ , tokname(&Y , 1)); +++ } +++ +++#endif +++ /* +++ * We first save the current input token +++ * and its associated semantic information. +++ */ +++ if (yychar < 0) +++ yychar = yylex(); +++ copy(&YC[0], &Y, sizeof Y); +++ +++ /* +++ * Set the default action and cost +++ */ +++ cact = CPANIC, ccost = CLIMIT, cflag = 0; +++ +++ /* +++ * Peek ahead +++ */ +++ for (yCcnt = 1; yCcnt < YCSIZ; yCcnt++) { +++ yychar = yylex(); +++ copy(&YC[yCcnt], &Y, sizeof YC[0]); +++#ifdef DEBUG +++ Eprintf(" | %s%s", tokname(&YC[yCcnt] , 0 ) +++ , tokname(&YC[yCcnt] , 1 )); +++#endif +++ } +++#ifdef DEBUG +++ Eprintf("\n"); +++#endif +++ +++ /* +++ * If we are here because a reduction failed, try +++ * correcting that. +++ */ +++ if (idfail) { +++ /* +++ * Save the particulars about +++ * the kind of identifier we want/have. +++ */ +++ yyrwant = yyidwant; +++ yyrhave = yyidhave; +++#ifdef DEBUG +++ Tprintf(" Try Replace %s identifier with %s identifier cost=%d\n", +++ classes[yyidhave], classes[yyidwant], CCHIDCOST); +++#endif +++ +++ /* +++ * Save the semantics of the ID on the +++ * stack, and null them out to free +++ * up the reduction in question. +++ */ +++ i = yypv[0]; +++ yypv[0] = nullsem(YID); +++ c = correct(NOCHAR, 0, CCHIDCOST, &repmult[2], Ps0, yypv); +++ yypv[0] = i; +++#ifdef DEBUG +++ if (c < CPRLIMIT || fulltrace) +++ Eprintf("Cost %2d Replace %s identifier with %s identifier\n", c, classes[yyrhave], classes[yyrwant]); +++#endif +++ if (c < ccost) +++ cact = CCHIDENT, ccost = c, cchar = YID; +++ } +++ +++ /* +++ * First try correcting the state we are in +++ */ +++ trystate(Ps0, yypv, 0, &insmult[1], &delmult[1], &repmult[1]); +++ +++ /* +++ * Now, if we just shifted over a terminal, try +++ * correcting it. +++ */ +++ if (OY.Yychar != -1 && OY.Yylval != nullsem(OY.Yychar)) { +++ YC--; +++ copy(&YC[0], &OY, sizeof YC[0]); +++ trystate(Ps0 - 1, yypv - 1, 1, insmult, delmult, repmult); +++ if (cflag == 0) +++ YC++; +++ else { +++ yypv--; +++#ifdef PXP +++ yypw--; +++#endif +++ Ps0--; +++ yCcnt++; +++ } +++ } +++ +++ /* +++ * Restoring the first look ahead into +++ * the scanner token allows the error message +++ * routine to print the error message with the text +++ * of the correct line. +++ */ +++ copy(&Y, &YC[0], sizeof Y); +++ +++ /* +++ * Unique symbol insertion. +++ * +++ * If there was no reasonable correction found, +++ * but only one input to the parser is acceptable +++ * we report that, and try it. +++ * +++ * Special precautions here to prevent looping. +++ * The number of true inputs shifted over at the point +++ * of the last unique insertion is recorded in the +++ * variable yyTshifts. If this is not less than +++ * the current number in yytshifts, we do not insert. +++ * Thus, after one unique insertion, no more unique +++ * insertions will be made until an input is shifted +++ * over. This guarantees termination. +++ */ +++ if (cact == CPANIC && !idfail) { +++ register int *ap; +++ +++ ap = &yyact[yypact[*Ps0 + 1]]; +++ if (*ap == -ERROR) +++ ap =+ 2; +++ if (ap[0] <= 0 && ap[2] > 0) { +++ cchar = -ap[0]; +++ if (cchar == YEOF) +++ yyexeof(); +++ if (cchar != ERROR && yyTshifts < yytshifts) { +++ cact = CUNIQUE; +++#ifdef DEBUG +++ Eprintf("Unique symbol %s%s\n" +++ , charname(cchar , 0 ) +++ , charname(cchar , 1 )); +++#endif +++ /* +++ * Note that the inserted symbol +++ * will not be counted as a true input +++ * (i.e. the "yytshifts--" below) +++ * so that a true shift will be needed +++ * to make yytshifts > yyTshifts. +++ */ +++ yyTshifts = yytshifts; +++ } +++ } +++ } +++ +++ /* +++ * Set up to perform the correction. +++ * Build a token appropriate for replacement +++ * or insertion in the yytok structure ACchar +++ * having the attributes of the input at the +++ * point of error. +++ */ +++ copy(&ACtok, &YC[0], sizeof ACtok); +++ acchar = cchar; +++ aclval = nullsem(acchar); +++ if (aclval != NIL) +++ recovered(); +++ switch (cact) { +++ /* +++ * Panic, just restore the +++ * lookahead and return. +++ */ +++ case CPANIC: +++ setpfx('E'); +++ if (idfail) { +++ copy(&Y, &OY, sizeof Y); +++ if (yyrhave == NIL) { +++#ifdef PI +++ if (yybaduse(yypv[0], yyeline, ISUNDEF) == NIL) +++#endif +++ yerror("Undefined identifier"); +++ } else { +++ yerror("Improper %s identifier", classes[yyrhave]); +++#ifdef PI +++ yybaduse(yypv[0], yyeline, NIL); +++#endif +++ } +++ /* +++ * Suppress message from panic routine +++ */ +++ yyshifts = 1; +++ } +++ i = 0; +++ /* Note that on one path we dont touch yyshifts ! */ +++ break; +++ /* +++ * Delete the input. +++ * Mark this as a shift over true input. +++ * Restore the lookahead starting at +++ * the second token. +++ */ +++ case CDELETE: +++ if (ccost != 0) +++ yerror("Deleted %s%s", tokname(&YC[0] , 0 ) +++ , tokname(&YC[0] , 1 )); +++ yytshifts++; +++ i = 1; +++ yyshifts = 0; +++ break; +++ /* +++ * Replace the input with a new token. +++ */ +++ case CREPLACE: +++ if (acchar == YEOF) +++ yyexeof(); +++ if (acchar == YEND) +++ aclval = NIL; +++ yerror("Replaced %s%s with a %s%s", +++ tokname(&YC[0] , 0 ), +++ tokname(&YC[0] , 1 ), +++ tokname(&ACtok , 0 ), +++ tokname(&ACtok , 1 )); +++ copy(&YC[0], &ACtok, sizeof YC[0]); +++ i = 0; +++ yyshifts = 0; +++ break; +++ /* +++ * Insert a token. +++ * Don't count this token as a true input shift. +++ * For inserted "end"s pas.y is responsible +++ * for the error message later so suppress it. +++ * Restore all the lookahead. +++ */ +++ case CINSERT: +++ if (acchar == YEOF) +++ yyexeof(); +++ if (acchar != YEND) +++ yerror("Inserted %s%s", +++ tokname(&ACtok , 0 ), +++ tokname(&ACtok , 1 )); +++ yytshifts--; +++ i = 0; +++ yyshifts = 0; +++ break; +++ /* +++ * Make a unique symbol correction. +++ * Like an insertion but a different message. +++ */ +++ case CUNIQUE: +++ setpfx('E'); +++ yerror("Expected %s%s", +++ tokname(&ACtok , 0 ), +++ tokname(&ACtok , 1 )); +++ yytshifts--; +++ i = 0; +++ if (ccost == 0 || yyunique) +++ yyshifts = 0; +++ else +++ yyshifts = -1; +++ break; +++ /* +++ * Change an identifier's type +++ * to make it work. +++ */ +++ case CCHIDENT: +++ copy(&Y, &OY, sizeof Y); +++#ifdef PI +++ i = 1 << yyrwant; +++#endif +++ if (yyrhave == NIL) { +++ yerror("Undefined %s", classes[yyrwant]); +++#ifdef PI +++ i =| ISUNDEF; +++#endif +++ } else +++ yerror("Replaced %s id with a %s id", classes[yyrhave], classes[yyrwant]); +++#ifdef PI +++ yybaduse(yypv[0], yyeline, i); +++#endif +++ yypv[0] = nullsem(YID); +++ i = 0; +++ yyshifts = 0; +++ break; +++ } +++ +++ /* +++ * Restore the desired portion of the lookahead, +++ * and possibly the inserted or unique inserted token. +++ */ +++ for (yCcnt--; yCcnt >= i; yCcnt--) +++ unyylex(&YC[yCcnt]); +++ if (cact == CINSERT || cact == CUNIQUE) +++ unyylex(&ACtok); +++ +++ /* +++ * Put the scanner back in sync. +++ */ +++ yychar = yylex(); +++ +++ /* +++ * We succeeded if we didn't "panic". +++ */ +++ Recovery = 0; +++ Ps = Ps0; +++ return (cact != CPANIC); +++} +++ +++yyexeof() +++{ +++ +++ yerror("End-of-file expected - QUIT"); +++ pexit(ERRS); +++} +++ +++yyunexeof() +++{ +++ +++ yerror("Unexpected end-of-file - QUIT"); +++ pexit(ERRS); +++} +++ +++/* +++ * Try corrections with the state at Ps0. +++ * Flag is 0 if this is the top of stack state, +++ * 1 if it is the state below. +++ */ +++trystate(Ps0, Pv0, flag, insmult, delmult, repmult) +++ int *Ps0, *Pv0, flag; +++ char *insmult, *delmult, *repmult; +++{ +++ /* +++ * C is a working cost, ap a pointer into the action +++ * table for looking at feasible alternatives. +++ */ +++ register int c, *ap; +++ int i, *actions; +++ +++#ifdef DEBUG +++ Eprintf("Trying state %d\n", *Ps0); +++#endif +++ /* +++ * Try deletion. +++ * Correct returns a cost. +++ */ +++#ifdef DEBUG +++ Tprintf(" Try Delete %s%s cost=%d\n", +++ tokname(&YC[0] , 0 ), +++ tokname(&YC[0] , 1 ), +++ delcost(YC[0].Yychar)); +++#endif +++ c = delcost(YC[0].Yychar); +++#ifndef DEBUG +++ if (c < ccost) { +++#endif +++ c = correct(NOCHAR, 1, c, delmult, Ps0, Pv0); +++#ifdef DEBUG +++ if (c < CPRLIMIT || fulltrace) +++ Eprintf("Cost %2d Delete %s%s\n", c, +++ tokname(&YC[0] , 0 ), +++ tokname(&YC[0] , 1 )); +++#endif +++ if (c < ccost) +++ cact = CDELETE, ccost = c, cflag = flag; +++#ifndef DEBUG +++ } +++#endif +++ +++ /* +++ * Look at the inputs to this state +++ * which will cause parse action shift. +++ */ +++ aclval = NIL; +++ ap = &yyact[yypact[*Ps0 + 1]]; +++ +++ /* +++ * Skip action on error to +++ * detect true unique inputs. +++ * Error action is always first. +++ */ +++ if (*ap == -ERROR) +++ ap=+ 2; +++ +++ /* +++ * Loop through the test actions +++ * for this state. +++ */ +++ for (actions = ap; *ap <= 0; ap =+ 2) { +++ /* +++ * Extract the token of this action +++ */ +++ acchar = -*ap; +++ +++ /* +++ * Try insertion +++ */ +++#ifdef DEBUG +++ Tprintf(" Try Insert %s%s cost=%d\n" +++ , charname(acchar , 0 ) +++ , charname(acchar , 1 ) +++ , inscost(acchar)); +++#endif +++ c = inscost(acchar, YC[0].Yychar); +++#ifndef DEBUG +++ if (c < ccost) { +++#endif +++ if (c == 0) { +++ c = correct(acchar, 0, 1, insmult + 1, Ps0, Pv0); +++#ifdef DEBUG +++ Eprintf("Cost %2d Freebie %s%s\n", c +++ , charname(acchar , 0 ) +++ , charname(acchar , 1 )); +++#endif +++ if (c < ccost) +++ cact = CUNIQUE, ccost = 0, cchar = acchar, cflag = flag; +++ } else { +++ c = correct(acchar, 0, c, insmult, Ps0, Pv0); +++#ifdef DEBUG +++ if (c < CPRLIMIT || fulltrace) +++ Eprintf("Cost %2d Insert %s%s\n", c +++ , charname(acchar , 0 ) +++ , charname(acchar , 1 )); +++#endif +++ if (c < ccost) +++ cact = CINSERT, ccost = c, cchar = acchar, cflag = flag; +++ } +++#ifndef DEBUG +++ } +++#endif +++ +++ /* +++ * Try replacement +++ */ +++#ifdef DEBUG +++ Tprintf(" Try Replace %s%s with %s%s cost=%d\n", +++ tokname(&YC[0] , 0 ), +++ tokname(&YC[0] , 1 ), +++ charname(acchar , 0 ), +++ charname(acchar , 1 ), +++ repcost(YC[0].Yychar, acchar)); +++#endif +++ c = repcost(YC[0].Yychar, acchar); +++#ifndef DEBUG +++ if (c < ccost) { +++#endif +++ c = correct(acchar, 1, repcost(YC[0].Yychar, acchar), repmult, Ps0, Pv0); +++#ifdef DEBUG +++ if (c < CPRLIMIT || fulltrace) +++ Eprintf("Cost %2d Replace %s%s with %s%s\n", +++ c, +++ tokname(&YC[0] , 0 ), +++ tokname(&YC[0] , 1 ), +++ tokname(&ACtok , 0 ), +++ tokname(&ACtok , 1 )); +++#endif +++ if (c < ccost) +++ cact = CREPLACE, ccost = c, cchar = acchar, cflag = flag; +++#ifndef DEBUG +++ } +++#endif +++ } +++} +++ +++int *yCpv; +++char yyredfail; +++ +++/* +++ * The ntok structure is used to build a +++ * scanner structure for tokens inserted +++ * from the argument "fchar" to "correct" below. +++ */ +++static struct yytok ntok; +++ +++/* +++ * Compute the cost of a correction +++ * C is the base cost for it. +++ * Fchar is the first input character from +++ * the current state, NOCHAR if none. +++ * The rest of the inputs come from the array +++ * YC, starting at origin and continuing to the +++ * last character there, YC[yCcnt - 1].Yychar. +++ * +++ * The cost returned is INFINITE if this correction +++ * allows no shifts, otherwise is weighted based +++ * on the number of shifts this allows against the +++ * maximum number possible with the available lookahead. +++ */ +++correct(fchar, origin, c, multvec, Ps0, Pv0) +++ register int fchar, c; +++ int origin; +++ char *multvec; +++ int *Ps0, *Pv0; +++{ +++ register char *mv; +++ +++ /* +++ * Ps is the top of the parse stack after the most +++ * recent local correctness check. Loccor returns +++ * NIL when we cannot shift. +++ */ +++ register int *ps; +++ +++ yyredfail = 0; +++ /* +++ * Initialize the tip parse and semantic stacks. +++ */ +++ ps = Ps0; +++ yytips[0] = *ps; +++ ps--; +++ yytipv[0] = Pv0[0]; +++ yCpv = Pv0 - 1; +++ yytipct = 1; +++ +++ /* +++ * Shift while possible. +++ * Adjust cost as necessary. +++ */ +++ mv = multvec; +++ do { +++ if (fchar != NOCHAR) { +++ copy(&ntok, &YC[0], sizeof ntok); +++ ntok.Yychar = fchar, ntok.Yylval = nullsem(fchar); +++ fchar = NOCHAR; +++ ps = loccor(ps, &ntok); +++ } else +++ ps = loccor(ps, &YC[origin++]); +++ if (ps == NIL) { +++ if (yyredfail && mv > multvec) +++ mv--; +++ c =* *mv; +++ break; +++ } +++ mv++; +++ } while (*mv != 1); +++ return (c); +++} +++ +++extern int yygo[], yypgo[], yyr1[], yyr2[]; +++/* +++ * Local syntactic correctness check. +++ * The arguments to this routine are a +++ * top of stack pointer, ps, and an input +++ * token tok. Also, implicitly, the contents +++ * of the yytips array which contains the tip +++ * of the stack, and into which the new top +++ * state on the stack will be placed if we shift. +++ * +++ * If we succeed, we return a new top of stack +++ * pointer, else we return NIL. +++ */ +++loccor(ps, ntok) +++ int *ps; +++ struct yytok *ntok; +++{ +++ register int *p, n; +++ register int nchar; +++ int i; +++ +++ if (ps == NIL) +++ return (NIL); +++ nchar = ntok->Yychar; +++ yyeline = ntok->Yyeline; +++#ifdef DEBUG +++ Tprintf(" Stack "); +++ for (i = yytipct - 1; i >= 0; i--) +++ Tprintf("%d ", yytips[i]); +++ Tprintf("| %d, Input %s%s\n", *ps +++ , charname(nchar , 0 ) +++ , charname(nchar , 1 )); +++#endif +++ /* +++ * As in the yacc parser yyparse, +++ * p traces through the action list +++ * and "n" is the information associated +++ * with the action. +++ */ +++newstate: +++ p = &yyact[ yypact[yytips[yytipct - 1]+1] ]; +++ +++actn: +++ /* +++ * Search the parse actions table +++ * for something useful to do. +++ * While n is non-positive, it is the +++ * arithmetic inverse of the token to be tested. +++ * This allows a fast check. +++ */ +++ while ((n = *p++) <= 0) +++ if ((n =+ nchar) != 0) +++ p++; +++ switch (n >> 12) { +++ /* +++ * SHIFT +++ */ +++ case 2: +++ n =& 07777; +++ yyredfail = 0; +++ if (nchar == YID) +++ yyredfail++; +++ if (yytipct == YYTIPSIZ) { +++tipover: +++#ifdef DEBUG +++ Tprintf("\tTIP OVFLO\n"); +++#endif +++ return (NIL); +++ } +++ yytips[yytipct] = n; +++ yytipv[yytipct] = ntok->Yylval; +++ yytipct++; +++#ifdef DEBUG +++ Tprintf("\tShift to state %d\n", n); +++#endif +++ return (ps); +++ /* +++ * REDUCE +++ */ +++ case 3: +++ n =& 07777; +++ if (yyEactr(n, yytipv[yytipct - 1]) == 0) { +++#ifdef DEBUG +++ Tprintf("\tYyEactr objects: have %s id, want %s id\n", classes[yyidhave], classes[yyidwant]); +++#endif +++ return (NIL); +++ } +++ yyredfail = 0; +++ i = yyr2[n]; +++#ifdef DEBUG +++ Tprintf("\tReduce, length %d,", i); +++#endif +++ if (i > yytipct) { +++ i =- yytipct; +++ yytipct = 0; +++ ps =- i; +++ yCpv =- i; +++ } else +++ yytipct =- i; +++ if (yytipct >= YYTIPSIZ) +++ goto tipover; +++ /* +++ * Use goto table to find next state +++ */ +++ p = &yygo[yypgo[yyr1[n]]]; +++ i = yytipct ? yytips[yytipct - 1] : *ps; +++ while (*p != i && *p >= 0) +++ p =+ 2; +++#ifdef DEBUG +++ Tprintf(" new state %d\n", p[1]); +++#endif +++ yytips[yytipct] = p[1]; +++ yytipct++; +++ goto newstate; +++ /* +++ * ACCEPT +++ */ +++ case 4: +++#ifdef DEBUG +++ Tprintf("\tAccept\n"); +++#endif +++ return (ps); +++ /* +++ * ERROR +++ */ +++ case 1: +++#ifdef DEBUG +++ Tprintf("\tError\n"); +++#endif +++ return (0); +++ } +++ panic("loccor"); +++} diff --cc usr/src/cmd/pc0/yyseman.c index 0000000000,0000000000,0000000000..135e2d5447 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yyseman.c @@@@ -1,0 -1,0 -1,0 +1,36 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yyseman.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "yy.h" +++ +++/* +++ * Assign semantics to a generated token +++ * +++ * Most terminals have a semantic value the current +++ * input line. If they are generated they are flagged +++ * by having this number negated. +++ * +++ * The terminals which have true semantics such +++ * as identifiers and strings are instead given +++ * semantic value NIL here - we do not attempt +++ * to do repair, e.g. by giving generated integers +++ * the value 1, etc. +++ */ +++nullsem(ch) +++ int ch; +++{ +++ +++ switch (ch) { +++ case YID: +++ case YINT: +++ case YNUMB: +++ case YBINT: +++ case YSTRING: +++ return (NIL); +++ default: +++ return (-yyeline); +++ } +++} diff --cc usr/src/cmd/pc0/yytree.c index 0000000000,0000000000,0000000000..4a1afe5f3b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pc0/yytree.c @@@@ -1,0 -1,0 -1,0 +1,156 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yytree.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++ +++extern int *spacep; +++ +++/* +++ * LIST MANIPULATION ROUTINES +++ * +++ * The grammar for Pascal is written left recursively. +++ * Because of this, the portions of parse trees which are to resemble +++ * lists are in the somewhat inconvenient position of having +++ * the nodes built from left to right, while we want to eventually +++ * have as semantic value the leftmost node. +++ * We could carry the leftmost node as semantic value, but this +++ * would be inefficient as to add a new node to the list we would +++ * have to chase down to the end. Other solutions involving a head +++ * and tail pointer waste space. +++ * +++ * The simple solution to this apparent dilemma is to carry along +++ * a pointer to the leftmost node in a list in the rightmost node +++ * which is the current semantic value of the list. +++ * When we have completed building the list, we can retrieve this +++ * left end pointer very easily; neither adding new elements to the list +++ * nor finding the left end is thus expensive. As the bottommost node +++ * has an unused next pointer in it, no space is wasted either. +++ * +++ * The nodes referred to here are of the T_LISTPP type and have +++ * the form: +++ * +++ * T_LISTPP some_pointer next_element +++ * +++ * Here some_pointer points to the things of interest in the list, +++ * and next_element to the next thing in the list except for the +++ * rightmost node, in which case it points to the leftmost node. +++ * The next_element of the rightmost node is of course zapped to the +++ * NIL pointer when the list is completed. +++ * +++ * Thinking of the lists as tree we heceforth refer to the leftmost +++ * node as the "top", and the rightmost node as the "bottom" or as +++ * the "virtual root". +++ */ +++ +++/* +++ * Make a new list +++ */ +++newlist(new) +++ register int *new; +++{ +++ +++ if (new == NIL) +++ return (NIL); +++ return (tree3(T_LISTPP, new, spacep)); +++} +++ +++/* +++ * Add a new element to an existing list +++ */ +++addlist(vroot, new) +++ register int *vroot; +++ int *new; +++{ +++ register int *top; +++ +++ if (new == NIL) +++ return (vroot); +++ if (vroot == NIL) +++ return (newlist(new)); +++ top = vroot[2]; +++ vroot[2] = spacep; +++ return (tree3(T_LISTPP, new, top)); +++} +++ +++/* +++ * Fix up the list which has virtual root vroot. +++ * We grab the top pointer and return it, zapping the spot +++ * where it was so that the tree is not circular. +++ */ +++fixlist(vroot) +++ register int *vroot; +++{ +++ register int *top; +++ +++ if (vroot == NIL) +++ return (NIL); +++ top = vroot[2]; +++ vroot[2] = NIL; +++ return (top); +++} +++ +++ +++/* +++ * Set up a T_VAR node for a qualified variable. +++ * Init is the initial entry in the qualification, +++ * or NIL if there is none. +++ * +++ * if we are building pTrees, there has to be an extra slot for +++ * a pointer to the namelist entry of a field, if this T_VAR refers +++ * to a field name within a WITH statement. +++ * this extra field is set in lvalue, and used in VarCopy. +++ */ +++setupvar(var, init) +++ char *var; +++ register int *init; +++{ +++ +++ if (init != NIL) +++ init = newlist(init); +++# ifndef PTREE +++ return (tree4(T_VAR, NOCON, var, init)); +++# else +++ return tree5( T_VAR , NOCON , var , init , NIL ); +++# endif +++} +++ +++ /* +++ * set up a T_TYREC node for a record +++ * +++ * if we are building pTrees, there has to be an extra slot for +++ * a pointer to the namelist entry of the record. +++ * this extra field is filled in in gtype, and used in RecTCopy. +++ */ +++setuptyrec( line , fldlst ) +++ int line; +++ int *fldlst; +++ { +++ +++# ifndef PTREE +++ return tree3( T_TYREC , line , fldlst ); +++# else +++ return tree4( T_TYREC , line , fldlst , NIL ); +++# endif +++ } +++ +++ /* +++ * set up a T_FIELD node for a field. +++ * +++ * if we are building pTrees, there has to be an extra slot for +++ * a pointer to the namelist entry of the field. +++ * this extra field is set in lvalue, and used in SelCopy. +++ */ +++setupfield( field , other ) +++ int *field; +++ int *other; +++ { +++ +++# ifndef PTREE +++ return tree3( T_FIELD , field , other ); +++# else +++ return tree4( T_FIELD , field , other , NIL ); +++# endif +++ } diff --cc usr/src/cmd/pi/0.h index 0000000000,d123ff158b,0000000000..566fc47a0d mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/0.h +++ b/usr/src/cmd/pi/0.h @@@@ -1,0 -1,739 -1,0 +1,754 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)0.h 1.3 10/2/80"; */ +++ + +#define DEBUG + +#define CHAR + +#define STATIC + +#define hp21mx 0 + + - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy - * University of California, Berkeley (UCB) - * Version 1.2 November 1978 - */ - + +#include + +#include + + + +#define bool short + +#define TRUE 1 + +#define FALSE 0 + + + +/* + + * Option flags + + * + + * The following options are recognized in the text of the program + + * and also on the command line: + + * + + * b block buffer the file output + + * + + * i make a listing of the procedures and functions in + + * the following include files + + * + + * l make a listing of the program + + * + + * n place each include file on a new page with a header + + * + + * p disable post mortem and statement limit counting + + * + + * t disable run-time tests + + * + + * u card image mode; only first 72 chars of input count + + * + + * w suppress special diagnostic warnings + + * + + * z generate counters for an execution profile + + */ + +#ifdef DEBUG + +bool fulltrace, errtrace, testtrace, yyunique; - #endif +++#endif DEBUG + + + +/* + + * Each option has a stack of 17 option values, with opts giving + + * the current, top value, and optstk the value beneath it. + + * One refers to option `l' as, e.g., opt('l') in the text for clarity. + + */ - char opts[26]; - short optstk[26]; +++char opts[ 'z' - 'A' + 1]; +++short optstk[ 'z' - 'A' + 1]; + + - #define opt(c) opts[c-'a'] +++#define opt(c) opts[c-'A'] + + + +/* + + * Monflg is set when we are generating - * a profile +++ * a pxp profile. this is set by the -z command line option. + + */ + +bool monflg; +++ +++ /* +++ * profflag is set when we are generating a prof profile. +++ * this is set by the -p command line option. +++ */ +++bool profflag; +++ + + + +/* + + * NOTES ON THE DYNAMIC NATURE OF THE DATA STRUCTURES + + * + + * Pi uses expandable tables for + + * its namelist (symbol table), string table + + * hash table, and parse tree space. The following + + * definitions specify the size of the increments + + * for these items in fundamental units so that + + * each uses approximately 1024 bytes. + + */ + + + +#define STRINC 1024 /* string space increment */ + +#define TRINC 512 /* tree space increment */ + +#define HASHINC 509 /* hash table size in words, each increment */ + +#define NLINC 56 /* namelist increment size in nl structs */ + + + +/* + + * The initial sizes of the structures. + + * These should be large enough to compile + + * an "average" sized program so as to minimize + + * storage requests. + + * On a small system or and 11/34 or 11/40 + + * these numbers can be trimmed to make the + + * compiler smaller. + + */ + +#define ITREE 2000 + +#define INL 200 + +#define IHASH 509 + + + +/* + + * The following limits on hash and tree tables currently + + * allow approximately 1200 symbols and 20k words of tree + + * space. The fundamental limit of 64k total data space + + * should be exceeded well before these are full. + + */ + +/* - * TABLE_MULITPLIER is for uniformly increasing the sizes of the tables +++ * TABLE_MULTIPLIER is for uniformly increasing the sizes of the tables + + */ - #define TABLE_MULTIPLIER 2 +++#define TABLE_MULTIPLIER 8 + +#define MAXHASH (4 * TABLE_MULTIPLIER) + +#define MAXNL (12 * TABLE_MULTIPLIER) + +#define MAXTREE (30 * TABLE_MULTIPLIER) - #define MAXDEPTH (150 * TABLE_MULTIPLIER) +++/* +++ * MAXDEPTH is the depth of the parse stack. +++ * STACK_MULTIPLIER is for increasing its size. +++ */ +++#define STACK_MULTIPLIER 8 +++#define MAXDEPTH ( 150 * STACK_MULTIPLIER ) + + + +/* + + * ERROR RELATED DEFINITIONS + + */ + + + +/* + + * Exit statuses to pexit + + * + + * AOK + + * ERRS Compilation errors inhibit obj productin + + * NOSTART Errors before we ever got started + + * DIED We ran out of memory or some such + + */ + +#define AOK 0 + +#define ERRS 1 + +#define NOSTART 2 + +#define DIED 3 + + + +bool Recovery; + + + +#define eholdnl() Eholdnl = 1 + +#define nocascade() Enocascade = 1 + + + +bool Eholdnl, Enocascade; + + + + + +/* + + * The flag eflg is set whenever we have a hard error. + + * The character in errpfx will precede the next error message. + + * When cgenflg is set code generation is suppressed. + + * This happens whenver we have an error (i.e. if eflg is set) + + * and when we are walking the tree to determine types only. + + */ + +bool eflg; + +char errpfx; + + + +#define setpfx(x) errpfx = x + + + +#define standard() setpfx('s') + +#define warning() setpfx('w') + +#define recovered() setpfx('e') + + + +bool cgenflg; + + + + + +/* + + * The flag syneflg is used to suppress the diagnostics of the form + + * E 10 a, defined in someprocedure, is neither used nor set + + * when there were syntax errors in "someprocedure". + + * In this case, it is likely that these warinings would be spurious. + + */ + +bool syneflg; + + + +/* + + * The compiler keeps its error messages in a file. + + * The variable efil is the unit number on which + + * this file is open for reading of error message text. + + * Similarly, the file ofil is the unit of the file + + * "obj" where we write the interpreter code. + + */ + +short efil; + +short ofil; + +short obuf[518]; + + + +#define elineoff() Enoline++ + +#define elineon() Enoline = 0 + + + +bool Enoline; + + + +/* + + * SYMBOL TABLE STRUCTURE DEFINITIONS + + * + + * The symbol table is henceforth referred to as the "namelist". + + * It consists of a number of structures of the form "nl" below. + + * These are contained in a number of segments of the symbol + + * table which are dynamically allocated as needed. + + * The major namelist manipulation routines are contained in the + + * file "nl.c". + + * + + * The major components of a namelist entry are the "symbol", giving + + * a pointer into the string table for the string associated with this + + * entry and the "class" which tells which of the (currently 19) + + * possible types of structure this is. + + * + + * Many of the classes use the "type" field for a pointer to the type + + * which the entry has. + + * + + * Other pieces of information in more than one class include the block + + * in which the symbol is defined, flags indicating whether the symbol + + * has been used and whether it has been assigned to, etc. + + * + + * A more complete discussion of the features of the namelist is impossible + + * here as it would be too voluminous. Refer to the "PI 1.0 Implementation + + * Notes" for more details. + + */ + + + +/* + + * The basic namelist structure. + + * There are also two other variants, defining the real + + * field as longs or integers given below. + + * + + * The array disptab defines the hash header for the symbol table. + + * Symbols are hashed based on the low 6 bits of their pointer into + + * the string table; see the routines in the file "lookup.c" and also "fdec.c" + + * especially "funcend". + + */ + +#ifdef PTREE + +# include "pTree.h" - #endif +++#endif PTREE + +struct nl { + + char *symbol; + + char class, nl_flags; +++#ifdef PC +++ char ext_flags; /* an extra flag is used for externals */ +++#endif PC + + struct nl *type; + + struct nl *chain, *nl_next; + + int *ptr[4]; - # ifdef PTREE - pPointer inTree; - # endif + +#ifdef PI + + int entloc; - #endif +++#endif PI +++# ifdef PTREE +++ pPointer inTree; +++# endif PTREE + +} *nlp, *disptab[077+1]; + + + +extern struct nl nl[INL]; + + + +struct { + + char *symbol; + + char class, nl_flags; +++#ifdef PC +++ char ext_flags; +++#endif + + struct nl *type; + + struct nl *chain, *nl_next; + + double real; + +}; + + + +struct { + + char *symbol; + + char class, nl_block; +++#ifdef PC +++ char ext_flags; +++#endif + + struct nl *type; + + struct nl *chain, *nl_next; + + long range[2]; + +}; + + + +struct { + + char *symbol; + + char class, nl_flags; +++#ifdef PC +++ char ext_flags; +++#endif + + struct nl *type; + + struct nl *chain, *nl_next; - short value[4]; +++ long value[4]; + +}; + + + +/* + + * NL FLAGS BITS + + * + + * Definitions of the usage of the bits in + + * the nl_flags byte. Note that the low 5 bits of the + + * byte are the "nl_block" and that some classes make use + + * of this byte as a "width". + + * + + * The only non-obvious bit definition here is "NFILES" + + * which records whether a structure contains any files. + + * Such structures are not allowed to be dynamically allocated. + + */ - #define NPACKED 0200 + +#define NUSED 0100 + +#define NMOD 0040 + +#define NFORWD 0200 + +#define NFILES 0200 +++ +++#ifdef PC +++#define NEXTERN 0001 /* flag used to mark external funcs and procs */ +++#endif + + + +/* + + * Definition of the commonly used "value" fields. - * The most important ones are NL_LOC which gives the location - * in the code of a label or procedure, and NL_OFFS which gives +++ * The most important one is NL_OFFS which gives + + * the offset of a variable in its stack mark. + + */ + +#define NL_OFFS 0 - #define NL_LOC 1 + + +++#define NL_CNTR 1 + +#define NL_FVAR 3 + + + +#define NL_GOLEV 2 + +#define NL_GOLINE 3 + +#define NL_FORV 1 + + + +#define NL_FLDSZ 1 + +#define NL_VARNT 2 + +#define NL_VTOREC 2 + +#define NL_TAG 3 + + +++#define NL_ELABEL 3 +++ + +/* + + * For BADUSE nl structures, NL_KINDS is a bit vector + + * indicating the kinds of illegal usages complained about + + * so far. For kind of bad use "kind", "1 << kind" is set. + + * The low bit is reserved as ISUNDEF to indicate whether + + * this identifier is totally undefined. + + */ + +#define NL_KINDS 0 + + + +#define ISUNDEF 1 + + + +/* + + * NAMELIST CLASSES + + * + + * The following are the namelist classes. + + * Different classes make use of the value fields + + * of the namelist in different ways. + + * + + * The namelist should be redesigned by providing + + * a number of structure definitions with one corresponding + + * to each namelist class, ala a variant record in Pascal. + + */ + +#define BADUSE 0 + +#define CONST 1 + +#define TYPE 2 + +#define VAR 3 + +#define ARRAY 4 + +#define PTRFILE 5 + +#define RECORD 6 + +#define FIELD 7 + +#define PROC 8 + +#define FUNC 9 + +#define FVAR 10 + +#define REF 11 + +#define PTR 12 + +#define FILET 13 + +#define SET 14 + +#define RANGE 15 + +#define LABEL 16 + +#define WITHPTR 17 + +#define SCAL 18 + +#define STR 19 + +#define PROG 20 + +#define IMPROPER 21 + +#define VARNT 22 +++#define FPROC 23 +++#define FFUNC 24 + + + +/* + + * Clnames points to an array of names for the + + * namelist classes. + + */ + +char **clnames; + + + +/* + + * PRE-DEFINED NAMELIST OFFSETS + + * + + * The following are the namelist offsets for the + + * primitive types. The ones which are negative + + * don't actually exist, but are generated and tested + + * internally. These definitions are sensitive to the + + * initializations in nl.c. + + */ + +#define TFIRST -7 + +#define TFILE -7 + +#define TREC -6 + +#define TARY -5 + +#define TSCAL -4 + +#define TPTR -3 + +#define TSET -2 + +#define TSTR -1 + +#define NIL 0 + +#define TBOOL 1 + +#define TCHAR 2 + +#define TINT 3 + +#define TDOUBLE 4 + +#define TNIL 5 + +#define T1INT 6 + +#define T2INT 7 + +#define T4INT 8 + +#define T1CHAR 9 + +#define T1BOOL 10 + +#define T8REAL 11 + +#define TLAST 11 + + + +/* + + * SEMANTIC DEFINITIONS + + */ + + + +/* + + * NOCON and SAWCON are flags in the tree telling whether + + * a constant set is part of an expression. + + */ + +#define NOCON 0 + +#define SAWCON 1 + + + +/* + + * The variable cbn gives the current block number, + + * the variable bn is set as a side effect of a call to + + * lookup, and is the block number of the variable which + + * was found. + + */ + +short bn, cbn; + + + +/* + + * The variable line is the current semantic + + * line and is set in stat.c from the numbers + + * embedded in statement type tree nodes. + + */ + +short line; + + + +/* + + * The size of the display + + * which defines the maximum nesting + + * of procedures and functions allowed. + + * Because of the flags in the current namelist + + * this must be no greater than 32. + + */ + +#define DSPLYSZ 20 + + + +/* + + * The following structure is used + + * to keep track of the amount of variable + + * storage required by each block. + + * "Max" is the high water mark, "off" + + * the current need. Temporaries for "for" + + * loops and "with" statements are allocated + + * in the local variable area and these + + * numbers are thereby changed if necessary. + + */ + +struct om { + + long om_off; + + long om_max; + +} sizes[DSPLYSZ]; +++ +++ /* +++ * the following structure records whether a level declares +++ * any variables which are (or contain) files. +++ * this so that the runtime routines for file cleanup can be invoked. +++ */ +++bool dfiles[ DSPLYSZ ]; + + + +/* + + * Structure recording information about a constant + + * declaration. It is actually the return value from + + * the routine "gconst", but since C doesn't support + + * record valued functions, this is more convenient. + + */ + +struct { + + struct nl *ctype; + + short cival; + + double crval; + + int *cpval; + +} con; + + + +/* + + * The set structure records the lower bound + + * and upper bound with the lower bound normalized + + * to zero when working with a set. It is set by + + * the routine setran in var.c. + + */ + +struct { + + short lwrb, uprbp; + +} set; + + +++ /* +++ * structures of this kind are filled in by precset and used by postcset +++ * to indicate things about constant sets. +++ */ +++struct csetstr { +++ struct nl *csettype; +++ long paircnt; +++ long singcnt; +++ bool comptime; +++}; + +/* + + * The following flags are passed on calls to lvalue + + * to indicate how the reference is to affect the usage + + * information for the variable being referenced. + + * MOD is used to set the NMOD flag in the namelist + + * entry for the variable, ASGN permits diagnostics + + * to be formed when a for variable is assigned to in + + * the range of the loop. + + */ - #define NOMOD 0 +++#define NOFLAGS 0 + +#define MOD 01 + +#define ASGN 02 + +#define NOUSE 04 + + +++ /* +++ * the following flags are passed to lvalue and rvalue +++ * to tell them whether an lvalue or rvalue is required. +++ * the semantics checking is done according to the function called, +++ * but for pc, lvalue may put out an rvalue by indirecting afterwards, +++ * and rvalue may stop short of putting out the indirection. +++ */ +++#define LREQ 01 +++#define RREQ 02 +++ + +double MAXINT; + +double MININT; + + + +/* + + * Variables for generation of profile information. + + * Monflg is set when we want to generate a profile. + + * Gocnt record the total number of goto's and + + * cnts records the current counter for generating + + * COUNT operators. + + */ + +short gocnt; + +short cnts; + + + +/* + + * Most routines call "incompat" rather than asking "!compat" + + * for historical reasons. + + */ + +#define incompat !compat + + + +/* + + * Parts records which declaration parts have been seen. - * The grammar allows the "const" "type" and "var" +++ * The grammar allows the "label" "const" "type" "var" and routine + + * parts to be repeated and to be in any order, so that + + * they can be detected semantically to give better + + * error diagnostics. + + */ - short parts; +++int parts[ DSPLYSZ ]; + + - #define LPRT 01 - #define CPRT 02 - #define TPRT 04 - #define VPRT 08 +++#define LPRT 1 +++#define CPRT 2 +++#define TPRT 4 +++#define VPRT 8 +++#define RPRT 16 + + + +/* + + * Flags for the "you used / instead of div" diagnostic + + */ + +bool divchk; + +bool divflg; + + + +short errcnt[DSPLYSZ]; + + + +/* + + * Forechain links those types which are + + * ^ sometype + + * so that they can be evaluated later, permitting + + * circular, recursive list structures to be defined. + + */ + +struct nl *forechain; + + + +/* + + * Withlist links all the records which are currently + + * opened scopes because of with statements. + + */ + +struct nl *withlist; + + + +struct nl *intset; + +struct nl *input, *output; + +struct nl *program; +++ +++/* progseen flag used by PC to determine if +++ * a routine segment is being compiled (and +++ * therefore no program statement seen) +++ */ +++bool progseen; +++ + + + +/* + + * STRUCTURED STATEMENT GOTO CHECKING + + * + + * The variable level keeps track of the current + + * "structured statement level" when processing the statement + + * body of blocks. This is used in the detection of goto's into + + * structured statements in a block. + + * + + * Each label's namelist entry contains two pieces of information + + * related to this check. The first `NL_GOLEV' either contains + + * the level at which the label was declared, `NOTYET' if the label + + * has not yet been declared, or `DEAD' if the label is dead, i.e. + + * if we have exited the level in which the label was defined. + + * + + * When we discover a "goto" statement, if the label has not + + * been defined yet, then we record the current level and the current line + + * for a later error check. If the label has been already become "DEAD" + + * then a reference to it is an error. Now the compiler maintains, + + * for each block, a linked list of the labels headed by "gotos[bn]". + + * When we exit a structured level, we perform the routine + + * ungoto in stat.c. It notices labels whose definition levels have been + + * exited and makes them be dead. For labels which have not yet been + + * defined, ungoto will maintain NL_GOLEV as the minimum structured level + + * since the first usage of the label. It is not hard to see that the label + + * must eventually be declared at this level or an outer level to this + + * one or a goto into a structured statement will exist. + + */ + +short level; + +struct nl *gotos[DSPLYSZ]; + + + +#define NOTYET 10000 + +#define DEAD 10000 + + + +/* + + * Noreach is true when the next statement will + + * be unreachable unless something happens along + + * (like exiting a looping construct) to save + + * the day. + + */ + +bool noreach; + + + +/* + + * UNDEFINED VARIABLE REFERENCE STRUCTURES + + */ + +struct udinfo { + + int ud_line; + + struct udinfo *ud_next; + + char nullch; + +}; + + + +/* + + * CODE GENERATION DEFINITIONS + + */ + + + +/* + + * NSTAND is or'ed onto the abstract machine opcode + + * for non-standard built-in procedures and functions. + + */ + +#define NSTAND 0400 + + + +#define codeon() cgenflg++ + +#define codeoff() --cgenflg + + - /* - * Offsets due to the structure of the runtime stack. - * DPOFF1 is the amount of fixed storage in each block allocated - * as local variables for the runtime system. - * DPOFF2 is the size of the block mark. - */ - #if OBJ || PTREE - # define DPOFF1 0 - # ifdef PDP11 - # define DPOFF2 16 - # endif - # ifdef VAX - # define DPOFF2 32 - # endif - #endif - #ifdef PPC - /* - * the display for this level is saved in 0(fp) - * and there is no block mark - */ - # define DPOFF1 ( sizeof (int *) ) - # define DPOFF2 0 - #endif - + +/* + + * Codeline is the last lino output in the code generator. + + * It used to be used to suppress LINO operators but no + + * more since we now count statements. + + * Lc is the intepreter code location counter. + + * + +short codeline; + + */ + +char *lc; + + + + + +/* + + * Routines which need types + + * other than "integer" to be + + * assumed by the compiler. + + */ + +double atof(); + +long lwidth(); + +long aryconst(); + +long a8tol(); + +struct nl *lookup(); + +double atof(); + +int *tree(); + +int *hash(); + +char *alloc(); + +int *calloc(); + +char *savestr(); + +struct nl *lookup1(); + +struct nl *hdefnl(); + +struct nl *defnl(); + +struct nl *enter(); + +struct nl *nlcopy(); + +struct nl *tyrecl(); + +struct nl *tyary(); + +struct nl *fields(); + +struct nl *variants(); + +struct nl *deffld(); + +struct nl *defvnt(); + +struct nl *tyrec1(); + +struct nl *reclook(); + +struct nl *asgnop1(); + +struct nl *gtype(); + +struct nl *call(); + +struct nl *lvalue(); + +struct nl *rvalue(); + +struct nl *cset(); + + + +/* + + * type cast NIL to keep lint happy (which is not so bad) + + */ + +#define NLNIL ( (struct nl *) NIL ) + + + +/* + + * Funny structures to use + + * pointers in wild and wooly ways + + */ + +struct { + + char pchar; + +}; + +struct { + + short pint; + + short pint2; + +}; + +struct { + + long plong; + +}; + +struct { + + double pdouble; + +}; + + + +#define OCT 1 + +#define HEX 2 + + + +/* + + * MAIN PROGRAM VARIABLES, MISCELLANY + + */ + + + +/* + + * Variables forming a data base referencing + + * the command line arguments with the "i" option, e.g. + + * in "pi -i scanner.i compiler.p". + + */ + +char **pflist; + +short pflstc; + +short pfcnt; + + + +char *filename; /* current source file name */ + +long tvec; + +extern char *snark; /* SNARK */ + +extern char *classes[ ]; /* maps namelist classes to string names */ + + + +#define derror error + + - /* - * size of the px_header put on in yymain.c: magic - */ - #define PX_HEAD_BYTES ( 1024 ) - - /* - * size of the header, including the magic word (a short) - */ - #define HEAD_BYTES ( PX_HEAD_BYTES + sizeof ( short ) ) +++#ifdef PC + + - #ifdef PPC + + /* + + * the current function number, for [ lines + + */ + + int ftnno; + + + + /* - * the ppc output stream +++ * the pc output stream + + */ - FILE *ppcstream; +++ FILE *pcstream; + + - # ifdef DEBUG - /* - * a flag for printing ppc diagnostic stuff - */ - bool ppcdebug; - - /* - * and the stream onto which to print it - */ - FILE *ppcdstream; - # endif - - #endif +++#endif PC diff --cc usr/src/cmd/pi/OPnames.h index 0000000000,be1aaa0160,0000000000..5df08ce21f mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/OPnames.h +++ b/usr/src/cmd/pi/OPnames.h @@@@ -1,0 -1,256 -1,0 +1,260 @@@@ - "", - "HALT", - "TRA4", - "NODUMP", - "BEG", - "END", - "CALL", - "TRACNT", - "PUSH", - "POP", - "INX4", - "SDUP", - "IF", - "TRA", - "LINO", - "GOTO", - "REL2", - "REL4", - "REL24", - "REL42", - "REL8", - "RELG", - "RELT", - 0, - "REL28", - "REL48", - "REL82", - "REL84", - "AND", - "OR", - "NOT", - 0, - "AS2", - "AS4", - "AS24", - "AS42", - "AS8", - "INX2P2", - "INX4P2", - "AS", - "AS21", - "AS41", - "AS28", - "AS48", - "OFF", - "INX2", - "NIL", - "LV", - "ADD2", - "ADD4", - "ADD24", - "ADD42", - "ADD28", - "ADD48", - "ADD82", - "ADD84", - "SUB2", - "SUB4", - "SUB24", - "SUB42", - "SUB28", - "SUB48", - "SUB82", - "SUB84", - "MUL2", - "MUL4", - "MUL24", - "MUL42", - "MUL28", - "MUL48", - "MUL82", - "MUL84", - "ABS2", - "ABS4", - "ABS8", - 0, - "ADD8", - "SUB8", - "MUL8", - "DVD8", - "DIV2", - "DIV4", - "DIV24", - "DIV42", - 0, - 0, - 0, - 0, - "MOD2", - "MOD4", - "MOD24", - "MOD42", - 0, - 0, - 0, - 0, - "NEG2", - "NEG4", - "NEG8", - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - "DVD2", - "DVD4", - "DVD24", - "DVD42", - "DVD28", - "DVD48", - "DVD82", - "DVD84", - "RV1", - "RV2", - "RV4", - "RV8", - "IND1", - "IND2", - "IND4", - "IND8", - "CON1", - "CON2", - "CON4", - "CON8", - "RV", - "IND", - "CON", - 0, - "RANG2", - "RANG42", - "RSNG2", - "RSNG42", - "RANG4", - "RANG24", - "RSNG4", - "RSNG24", - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - "CONC", - "CASEBEG", - "CASE1", - "CASE2", - "CASE4", - "CASEEND", - "CONG", - "ORD2", - "CASE1OP", - "CASE2OP", - "CASE4OP", - "PXPBUF", - "COUNT", - 0, - 0, - 0, - "ADDT", - "SUBT", - "MULT", - "INCT", - "CTTOT", - "CARD", - "IN", - "ASRT", - "FOR1U", - "FOR2U", - "FOR4U", - "FOR1D", - "FOR2D", - "FOR4D", - "STLIM", - "SCLCK", - "STOI", - "STOD", - "ITOD", - "ITOS", - "BUFF", - "WCLCK", - "WRHEX2", - "WRHEX4", - "GET", - "PUT", - "MESSAGE", - "FNIL", - "EOF", - "EOLN", - "RESET", - "REWRITE", - "REMOVE", - "READ4", - "UNIT", - "READC", - "READ8", - "UNITINP", - "UNITOUT", - "READLN", - "WRIT2", - "WRIT4", - "WRITB", - "WRITC", - "WRIT8", - "WRITG", - "WRIT82", - "WRITLN", - "WROCT2", - "WROCT4", - "FLUSH", - "PACK", - "UNPACK", - "LLIMIT", - "ARGC", - "ARGV", - "CLCK", - "SEED", - "RANDOM", - "DISPOSE", - "NEW", - "EXPO", - "DATE", - "TIME", - "ATAN", - "COS", - "EXP", - "LN", - "SIN", - "SQRT", - "CHR2", - "CHR4", - "ODD2", - "ODD4", - "PRED2", - "PRED4", - "PRED24", - "SUCC2", - "SUCC4", - "SUCC24", - "DEFNAME", - "PAGE", - "UNDEF", - "SQR2", - "SQR4", - "SQR8", - "ROUND", - "TRUNC" +++/* static char sccsid[] = "@(#)OPnames.h 1.2 10/2/80"; */ +++ +++char *otext[] = { +++ 0, +++ " NODUMP", +++ " BEG", +++ " END", +++ " CALL", +++ " FCALL", +++ " FRTN", +++ " FSAV", +++ " SDUP2", +++ " SDUP4", +++ " TRA", +++ " TRA4", +++ " GOTO", +++ " LINO", +++ " PUSH", +++ 0, +++ " IF", +++ " REL2", +++ " REL4", +++ " REL24", +++ " REL42", +++ " REL8", +++ " RELG", +++ " RELT", +++ " REL28", +++ " REL48", +++ " REL82", +++ " REL84", +++ " AND", +++ " OR", +++ " NOT", +++ 0, +++ " AS2", +++ " AS4", +++ " AS24", +++ " AS42", +++ " AS21", +++ " AS41", +++ " AS28", +++ " AS48", +++ " AS8", +++ " AS", +++ " INX2P2", +++ " INX4P2", +++ " INX2", +++ " INX4", +++ " OFF", +++ " NIL", +++ " ADD2", +++ " ADD4", +++ " ADD24", +++ " ADD42", +++ " ADD28", +++ " ADD48", +++ " ADD82", +++ " ADD84", +++ " SUB2", +++ " SUB4", +++ " SUB24", +++ " SUB42", +++ " SUB28", +++ " SUB48", +++ " SUB82", +++ " SUB84", +++ " MUL2", +++ " MUL4", +++ " MUL24", +++ " MUL42", +++ " MUL28", +++ " MUL48", +++ " MUL82", +++ " MUL84", +++ " ABS2", +++ " ABS4", +++ " ABS8", +++ 0, +++ " NEG2", +++ " NEG4", +++ " NEG8", +++ 0, +++ " DIV2", +++ " DIV4", +++ " DIV24", +++ " DIV42", +++ " MOD2", +++ " MOD4", +++ " MOD24", +++ " MOD42", +++ " ADD8", +++ " SUB8", +++ " MUL8", +++ " DVD8", +++ " STOI", +++ " STOD", +++ " ITOD", +++ " ITOS", +++ " DVD2", +++ " DVD4", +++ " DVD24", +++ " DVD42", +++ " DVD28", +++ " DVD48", +++ " DVD82", +++ " DVD84", +++ " RV1", +++ " RV14", +++ " RV2", +++ " RV24", +++ " RV4", +++ " RV8", +++ " RV", +++ " LV", +++ " LRV1", +++ " LRV14", +++ " LRV2", +++ " LRV24", +++ " LRV4", +++ " LRV8", +++ " LRV", +++ " LLV", +++ " IND1", +++ " IND14", +++ " IND2", +++ " IND24", +++ " IND4", +++ " IND8", +++ " IND", +++ 0, +++ " CON1", +++ " CON14", +++ " CON2", +++ " CON24", +++ " CON4", +++ " CON8", +++ " CON", +++ " LVCON", +++ " RANG2", +++ " RANG42", +++ " RSNG2", +++ " RSNG42", +++ " RANG4", +++ " RANG24", +++ " RSNG4", +++ " RSNG24", +++ " STLIM", +++ " LLIMIT", +++ " BUFF", +++ " HALT", +++ 0, +++ 0, +++ 0, +++ 0, +++ "*ORD2", +++ "*CONG", +++ "*CONC", +++ "*CONC4", +++ "*ABORT", +++ " PXPBUF", +++ " COUNT", +++ 0, +++ " CASE1OP", +++ " CASE2OP", +++ " CASE4OP", +++ "*CASEBEG", +++ "*CASE1", +++ "*CASE2", +++ "*CASE4", +++ "*CASEEND", +++ " ADDT", +++ " SUBT", +++ " MULT", +++ " INCT", +++ " CTTOT", +++ " CARD", +++ " IN", +++ " ASRT", +++ " FOR1U", +++ " FOR2U", +++ " FOR4U", +++ " FOR1D", +++ " FOR2D", +++ " FOR4D", +++ 0, +++ 0, +++ " READE", +++ " READ4", +++ " READC", +++ " READ8", +++ " READLN", +++ " EOF", +++ " EOLN", +++ 0, +++ " WRITEC", +++ " WRITES", +++ " WRITEF", +++ " WRITLN", +++ " PAGE", +++ " NAM", +++ " MAX", +++ " MIN", +++ " UNIT", +++ " UNITINP", +++ " UNITOUT", +++ " MESSAGE", +++ " GET", +++ " PUT", +++ " FNIL", +++ 0, +++ " DEFNAME", +++ " RESET", +++ " REWRITE", +++ " FILE", +++ " REMOVE", +++ " FLUSH", +++ 0, +++ 0, +++ " PACK", +++ " UNPACK", +++ " ARGC", +++ " ARGV", +++ 0, +++ 0, +++ 0, +++ 0, +++ " CLCK", +++ " WCLCK", +++ " SCLCK", +++ " DISPOSE", +++ " NEW", +++ " DATE", +++ " TIME", +++ " UNDEF", +++ " ATAN", +++ " COS", +++ " EXP", +++ " LN", +++ " SIN", +++ " SQRT", +++ " CHR2", +++ " CHR4", +++ " ODD2", +++ " ODD4", +++ " PRED2", +++ " PRED4", +++ " PRED24", +++ " SUCC2", +++ " SUCC4", +++ " SUCC24", +++ " SEED", +++ " RANDOM", +++ " EXPO", +++ " SQR2", +++ " SQR4", +++ " SQR8", +++ " ROUND", +++ " TRUNC" +++}; diff --cc usr/src/cmd/pi/TRdata.c index 0000000000,783d0f0c65,0000000000..229c7ca169 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/TRdata.c +++ b/usr/src/cmd/pi/TRdata.c @@@@ -1,0 -1,201 -1,0 +1,204 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - #include "whoami" +++ +++static char sccsid[] = "@(#)TRdata.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#ifdef PI1 + +#ifdef DEBUG + +char *trnames[] + +{ + + 0, + + "MINUS", + + "MOD", + + "DIV", + + "DIVD", + + "MULT", + + "ADD", + + "SUB", + + "EQ", + + "NE", + + "LT", + + "GT", + + "LE", + + "GE", + + "NOT", + + "AND", + + "OR", + + "ASGN", + + "PLUS", + + "IN", + + "LISTPP", + + "PDEC", + + "FDEC", + + "PVAL", + + "PVAR", + + "PFUNC", + + "PPROC", + + "NIL", + + "STRNG", + + "CSTRNG", + + "PLUSC", + + "MINUSC", + + "ID", + + "INT", + + "FINT", + + "CINT", + + "CFINT", + + "TYPTR", + + "TYPACK", + + "TYSCAL", + + "TYRANG", + + "TYARY", + + "TYFILE", + + "TYSET", + + "TYREC", + + "TYFIELD", + + "TYVARPT", + + "TYVARNT", + + "CSTAT", + + "BLOCK", + + "BSTL", + + "LABEL", + + "PCALL", + + "FCALL", + + "CASE", + + "WITH", + + "WHILE", + + "REPEAT", + + "FORU", + + "FORD", + + "GOTO", + + "IF", + + "ASRT", + + "CSET", + + "RANG", + + "VAR", + + "ARGL", + + "ARY", + + "FIELD", + + "PTR", + + "WEXP", + + "PROG", + + "BINT", + + "CBINT", + + "IFEL", + + "IFX", + + "TYID", + + "COPSTR", + + "BOTTLE", + + "RFIELD", + + "FLDLST", + + "LAST" + +}; + +#endif + +#endif + + + +char *trdesc[] + +{ + + 0, + + "dp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dpp", + + "dp", + + "dpp", + + "dpp", + + "npp", + + "dp", + + "dpp", + + "pp", + + "n\"pp", + + "n\"pp", + + "pp", + + "pp", + + "pp", + + "p", + + "d", + + "dp", + + "p", + + "p", + + "p", + + "p", + + "dp", + + "dp", + + "p", + + "p", + + "np", + + "np", + + "np", + + "npp", + + "npp", + + "np", + + "np", + + "np", + + "pp", + + "nppp", + + "npp", + + "npp", + + "np", + + "np", + + "n\"p", + + "n\"p", + + "n\"p", + + "npp", + + "npp", + + "npp", + + "npp", + + "nppp", + + "nppp", + + "n\"", + + "nppp", + + "np", + + "dp", + + "pp", + + "n\"p", + + "p", + + "p", + + "pp", + + "", + + "ppp", + + "n\"pp", + + "dp", + + "p", + + "nppp", + + "nppp", + + "np", + + "s", + + "nnnnn", + + "npp", + + "npp", + + "x" + +}; + +char *opnames[] + +{ + + 0, + + "unary -", + + "mod", + + "div", + + "/", + + "*", + + "+", + + "-", + + "=", + + "<>", + + "<", + + ">", + + "<=", + + ">=", + + "not", + + "and", + + "or", + + ":=", + + "unary +", + + "in" + +}; diff --cc usr/src/cmd/pi/align.h index 0000000000,0000000000,0000000000..1191a47528 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/align.h @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)align.h 1.1 8/27/80"; */ +++ +++ /* +++ * alignment of various types in bytes. +++ * sizes are found using sizeof( type ). +++ */ +++#define A_CHAR 1 +++#define A_INT 4 +++#define A_FLOAT 4 +++#define A_DOUBLE 4 +++#define A_LONG 4 +++#define A_SHORT 2 +++#define A_POINT 4 +++#define A_STRUCT 1 +++#define A_STACK 4 +++#define A_FILET 4 +++#define A_SET 4 +++#define A_MIN 1 +++#define A_MAX 4 diff --cc usr/src/cmd/pi/ato.c index 0000000000,1e92dd4e17,0000000000..c4888893ef mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/ato.c +++ b/usr/src/cmd/pi/ato.c @@@@ -1,0 -1,45 -1,0 +1,40 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)ato.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + + + +long + +a8tol(cp) + + char *cp; + +{ + + int err; + + long l; + + register CHAR c; + + + + l = 0; + + err = 0; + + while ((c = *cp++) != '\0') { + + if (c == '8' || c == '9') + + if (err == 0) { + + error("8 or 9 in octal number"); + + err++; + + } + + c -= '0'; + + if ((l & 0160000000000L) != 0) + + if (err == 0) { + + error("Number too large for this implementation"); + + err++; + + } + + l = (l << 3) | c; + + } + + return (l); + +} + + + +/* + + * Note that the version of atof + + * used in this compiler does not + + * (sadly) complain when floating + + * point numbers are too large. + + */ diff --cc usr/src/cmd/pi/call.c index 0000000000,7aba9c5116,0000000000..8480cc13a7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/call.c +++ b/usr/src/cmd/pi/call.c @@@@ -1,0 -1,102 -1,0 +1,399 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)call.c 1.3 10/2/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++ +++bool slenflag = 0; +++bool floatflag = 0; + + + +/* + + * Call generates code for calls to + + * user defined procedures and functions + + * and is called by proc and funccod. + + * P is the result of the lookup + + * of the procedure/function symbol, + + * and porf is PROC or FUNC. + + * Psbn is the block number of p. + + */ + +struct nl * + +call(p, argv, porf, psbn) + + struct nl *p; + + int *argv, porf, psbn; + +{ + + register struct nl *p1, *q; + + int *r; + + - if (porf == FUNC) - /* - * Push some space - * for the function return type - */ - put2(O_PUSH, even(-width(p->type))); +++# ifdef OBJ +++ int cnt; +++# endif OBJ +++# ifdef PC +++ long temp; +++ int firsttime; +++ int rettype; +++# endif PC +++ +++# ifdef OBJ +++ if (p->class == FFUNC || p->class == FPROC) +++ put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]); +++ if (porf == FUNC) +++ /* +++ * Push some space +++ * for the function return type +++ */ +++ put2(O_PUSH, even(-width(p->type))); +++# endif OBJ +++# ifdef PC +++ if ( porf == FUNC ) { +++ switch( classify( p -> type ) ) { +++ case TSTR: +++ case TSET: +++ case TREC: +++ case TFILE: +++ case TARY: +++ temp = sizes[ cbn ].om_off -= width( p -> type ); +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ if (sizes[cbn].om_off < sizes[cbn].om_max) { +++ sizes[cbn].om_max = sizes[cbn].om_off; +++ } +++ putRV( 0 , cbn , temp , P2STRTY ); +++ } +++ } +++ switch ( p -> class ) { +++ case FUNC: +++ case PROC: +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int funcbn; +++ int i; +++ +++ starthere = &extname[0]; +++ funcbn = p -> nl_block & 037; +++ for ( i = 1 ; i < funcbn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "call namelength" ); +++ } +++ putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); +++ } +++ break; +++ case FFUNC: +++ case FPROC: +++ /* +++ * start one of these: +++ * FRTN( frtn , ( *FCALL( frtn ) )(...args...) ) +++ */ +++ putleaf( P2ICON , 0 , 0 , p2type( p ) , "_FRTN" ); +++ putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2PTR , ADDTYPE( P2FTN , p2type( p ) ) ) +++ , "_FCALL" ); +++ putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY ); +++ putop( P2CALL , p2type( p ) ); +++ break; +++ default: +++ panic("call class"); +++ } +++ firsttime = TRUE; +++# endif PC + + /* + + * Loop and process each of + + * arguments to the proc/func. + + */ - for (p1 = p->chain; p1 != NIL; p1 = p1->chain) { +++ if ( p -> class == FUNC || p -> class == PROC ) { +++ for (p1 = p->chain; p1 != NIL; p1 = p1->chain) { + + if (argv == NIL) { + + error("Not enough arguments to %s", p->symbol); + + return (NIL); + + } + + switch (p1->class) { - case REF: - /* - * Var parameter - */ - r = argv[1]; - if (r != NIL && r[0] != T_VAR) { - error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol); - break; - } - q = lvalue( (int *) argv[1], MOD); - if (q == NIL) - break; - if (q != p1->type) { - error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol); +++ case REF: +++ /* +++ * Var parameter +++ */ +++ r = argv[1]; +++ if (r != NIL && r[0] != T_VAR) { +++ error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++ q = lvalue( (int *) argv[1], MOD , LREQ ); +++ if (q == NIL) +++ break; +++ if (q != p1->type) { +++ error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++ break; +++ case VAR: +++ /* +++ * Value parameter +++ */ +++# ifdef OBJ +++ q = rvalue(argv[1], p1->type , RREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * structure arguments require lvalues, +++ * scalars use rvalue. +++ */ +++ switch( classify( p1 -> type ) ) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ q = rvalue( argv[1] , p1 -> type , LREQ ); + + break; - } - break; - case VAR: - /* - * Value parameter - */ - q = rvalue(argv[1], p1->type); - if (q == NIL) +++ case TINT: +++ case TSCAL: +++ case TBOOL: +++ case TCHAR: +++ precheck( p1 -> type , "_RANG4" , "_RSNG4" ); +++ q = rvalue( argv[1] , p1 -> type , RREQ ); +++ postcheck( p1 -> type ); + + break; - if (incompat(q, p1->type, argv[1])) { - cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol); +++ default: +++ q = rvalue( argv[1] , p1 -> type , RREQ ); +++ if ( isa( p1 -> type , "d" ) +++ && isa( q , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } + + break; + + } +++# endif PC +++ if (q == NIL) +++ break; +++ if (incompat(q, p1->type, argv[1])) { +++ cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++# ifdef OBJ + + if (isa(p1->type, "bcsi")) + + rangechk(p1->type, q); + + if (q->class != STR) + + convert(q, p1->type); - break; - default: - panic("call"); +++# endif OBJ +++# ifdef PC +++ switch( classify( p1 -> type ) ) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ putstrop( P2STARG +++ , p2type( p1 -> type ) +++ , lwidth( p1 -> type ) +++ , align( p1 -> type ) ); +++ } +++# endif PC +++ break; +++ case FFUNC: +++ /* +++ * function parameter +++ */ +++ q = flvalue( (int *) argv[1] , FFUNC ); +++ if (q == NIL) +++ break; +++ if (q != p1->type) { +++ error("Function type not identical to type of function parameter %s of %s", p1->symbol, p->symbol); +++ break; +++ } +++ break; +++ case FPROC: +++ /* +++ * procedure parameter +++ */ +++ q = flvalue( (int *) argv[1] , FPROC ); +++ if (q != NIL) { +++ error("Procedure parameter %s of %s cannot have a type", p1->symbol, p->symbol); +++ } +++ break; +++ default: +++ panic("call"); + + } +++# ifdef PC +++ /* +++ * if this is the nth (>1) argument, +++ * hang it on the left linear list of arguments +++ */ +++ if ( firsttime ) { +++ firsttime = FALSE; +++ } else { +++ putop( P2LISTOP , P2INT ); +++ } +++# endif PC + + argv = argv[2]; +++ } +++ if (argv != NIL) { +++ error("Too many arguments to %s", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ } else if ( p -> class == FFUNC || p -> class == FPROC ) { +++ /* +++ * formal routines can only have by-value parameters. +++ * this will lose for integer actuals passed to real +++ * formals, and strings which people want blank padded. +++ */ +++# ifdef OBJ +++ cnt = 0; +++# endif OBJ +++ for ( ; argv != NIL ; argv = argv[2] ) { +++# ifdef OBJ +++ q = rvalue(argv[1], NIL, RREQ ); +++ cnt += even(lwidth(q)); +++# endif OBJ +++# ifdef PC +++ /* +++ * structure arguments require lvalues, +++ * scalars use rvalue. +++ */ +++ codeoff(); +++ p1 = rvalue( argv[1] , NIL , RREQ ); +++ codeon(); +++ switch( classify( p1 ) ) { +++ case TSTR: +++ if ( p1 -> class == STR && slenflag == 0 ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Implementation can't construct equal length strings"); +++ slenflag++; +++ } +++ /* and fall through */ +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ q = rvalue( argv[1] , p1 , LREQ ); +++ break; +++ case TINT: +++ if ( floatflag == 0 ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Implementation can't coerice integer to real"); +++ floatflag++; +++ } +++ /* and fall through */ +++ case TSCAL: +++ case TBOOL: +++ case TCHAR: +++ default: +++ q = rvalue( argv[1] , p1 , RREQ ); +++ break; +++ } +++ switch( classify( p1 ) ) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ putstrop( P2STARG , p2type( p1 ) , +++ lwidth( p1 ) , align( p1 ) ); +++ } +++ /* +++ * if this is the nth (>1) argument, +++ * hang it on the left linear list of arguments +++ */ +++ if ( firsttime ) { +++ firsttime = FALSE; +++ } else { +++ putop( P2LISTOP , P2INT ); +++ } +++# endif PC +++ } +++ } else { +++ panic("call class"); + + } - if (argv != NIL) { - error("Too many arguments to %s", p->symbol); - rvlist(argv); - return (NIL); - } - put2(O_CALL | psbn << 9, p->entloc); - put2(O_POP, p->value[NL_OFFS]-DPOFF2); +++# ifdef OBJ +++ if ( p -> class == FFUNC || p -> class == FPROC ) { +++ put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]); +++ put(2, O_FCALL, cnt); +++ put(2, O_FRTN, even(lwidth(p->type))); +++ } else { +++ put2(O_CALL | psbn << 8+INDX, p->entloc); +++ } +++# endif OBJ +++# ifdef PC +++ if ( porf == FUNC ) { +++ rettype = p2type( p -> type ); +++ switch ( classify( p -> type ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ case TDOUBLE: +++ case TPTR: +++ if ( firsttime ) { +++ putop( P2UNARY P2CALL , rettype ); +++ } else { +++ putop( P2CALL , rettype ); +++ } +++ if (p -> class == FFUNC || p -> class == FPROC ) { +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , rettype ); +++ } +++ break; +++ default: +++ if ( firsttime ) { +++ putstrop( P2UNARY P2STCALL +++ , ADDTYPE( rettype , P2PTR ) +++ , lwidth( p -> type ) +++ , align( p -> type ) ); +++ } else { +++ putstrop( P2STCALL +++ , ADDTYPE( rettype , P2PTR ) +++ , lwidth( p -> type ) +++ , align( p -> type ) ); +++ } +++ if (p -> class == FFUNC || p -> class == FPROC ) { +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , ADDTYPE( rettype , P2PTR ) ); +++ } +++ putstrop( P2STASG , rettype , lwidth( p -> type ) +++ , align( p -> type ) ); +++ putLV( 0 , cbn , temp , rettype ); +++ putop( P2COMOP , P2INT ); +++ break; +++ } +++ } else { +++ if ( firsttime ) { +++ putop( P2UNARY P2CALL , P2INT ); +++ } else { +++ putop( P2CALL , P2INT ); +++ } +++ if (p -> class == FFUNC || p -> class == FPROC ) { +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putdot( filename , line ); +++ } +++# endif PC + + return (p->type); + +} + + + +rvlist(al) + + register int *al; + +{ + + + + for (; al != NIL; al = al[2]) - rvalue( (int *) al[1], NLNIL); +++ rvalue( (int *) al[1], NLNIL , RREQ ); + +} diff --cc usr/src/cmd/pi/case.c index 0000000000,e1f45b377a,0000000000..76b947a95d mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/case.c +++ b/usr/src/cmd/pi/case.c @@@@ -1,0 -1,190 -1,0 +1,187 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)case.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" + + + +/* + + * The structure used to + + * hold information about + + * each case label. + + */ + +struct ct { + + long clong; + + int cline; + +}; + + +++#ifdef OBJ + +/* + + * Caseop generates the + + * pascal case statement code + + */ + +caseop(r) + + int *r; + +{ + + register struct nl *p; + + register struct ct *ctab; + + register *cs; + + int *cl; + + double low, high; + + short *brtab; + + char *brtab0; + + char *csend; + + int w, i, j, m, n; + + int nr, goc; + + + + goc = gocnt; + + /* + + * Obtain selector attributes: + + * p type + + * w width + + * low lwb(p) + + * high upb(p) + + */ - p = rvalue((int *) r[2], NLNIL); +++ p = rvalue((int *) r[2], NLNIL , RREQ ); + + if (p != NIL) { + + if (isnta(p, "bcsi")) { + + error("Case selectors cannot be %ss", nameof(p)); + + p = NIL; + + } else { + + cl = p; + + if (p->class != RANGE) + + cl = p->type; + + if (cl == NIL) + + p = NIL; + + else { + + w = width(p); + +#ifdef DEBUG + + if (hp21mx) + + w = 2; + +#endif + + low = cl->range[0]; + + high = cl->range[1]; + + } + + } + + } + + /* + + * Count # of cases + + */ + + n = 0; + + for (cl = r[3]; cl != NIL; cl = cl[2]) { + + cs = cl[1]; + + if (cs == NIL) + + continue; + + for (cs = cs[2]; cs != NIL; cs = cs[2]) + + n++; + + } + + /* + + * Allocate case table space + + */ + + ctab = i = malloc(n * sizeof *ctab); + + if (i == -1) { + + error("Ran out of memory (case)"); + + pexit(DIED); + + } + + /* + + * Check the legality of the + + * labels and count the number + + * of good labels + + */ + + m = 0; + + for (cl = r[3]; cl != NIL; cl = cl[2]) { + + cs = cl[1]; + + if (cs == NIL) + + continue; + + line = cs[1]; + + for (cs = cs[2]; cs != NIL; cs = cs[2]) { + + gconst(cs[1]); + + if (p == NIL || con.ctype == NIL) + + continue; - if (incompat(con.ctype, p, NIL)) { +++ if (incompat(con.ctype, p, NIL )) { + + cerror("Case label type clashed with case selector expression type"); + + continue; + + } + + if (con.crval < low || con.crval > high) { + + error("Case label out of range"); + + continue; + + } + + ctab[m].clong = con.crval; + + ctab[m].cline = line; + + m++; + + } + + } + + + + /* + + * Check for duplicate labels + + */ + + for (i = 0; i < m; i++) + + for (j = 0; j < m; j++) + + if (ctab[i].clong == ctab[j].clong) { + + if (i == j) + + continue; + + if (j < i) + + break; + + error("Multiply defined label in case, lines %d and %d", ctab[i].cline, ctab[j].cline); + + } + + /* + + * Put out case operator and + + * leave space for the + + * branch table + + */ + + if (p != NIL) { - put2(O_CASE1OP + (w >> 1), n); +++ put(2, O_CASE1OP + (w >> 1), n); + + brtab = brtab0 = lc; + + putspace(n * 2); - put1(O_CASEBEG); +++ put(1, O_CASEBEG); + + for (i=0; i> 1), ctab[i].clong); - put1(O_CASEEND); +++ put( 2 , O_CASE1 + (w >> 1), ctab[i].clong); +++ put(1, O_CASEEND); + + } + + csend = getlab(); - put2(O_TRA, csend); +++ put(2, O_TRA, csend); + + /* + + * Free the case + + * table space. + + */ + + free(ctab); + + /* + + * Generate code for each + + * statement. Patch branch + + * table to beginning of each + + * statement and follow each + + * statement with a branch back + + * to the TRA above. + + */ + + nr = 1; + + for (cl = r[3]; cl != NIL; cl = cl[2]) { + + cs = cl[1]; + + if (cs == NIL) + + continue; + + if (p != NIL) + + for (cs = cs[2]; cs != NIL; cs = cs[2]) { + + patchfil(brtab - 1, lc - brtab0, 1); + + brtab++; + + } + + cs = cl[1]; + + putcnt(); + + level++; + + statement(cs[3]); + + nr &= noreach; + + noreach = 0; - put2(O_TRA, csend); +++ put(2, O_TRA, csend); + + level--; + + if (gotos[cbn]) + + ungoto(); + + } + + /* + + * Patch the termination branch + + */ + + patch(csend); + + noreach = nr; + + if (goc != gocnt) + + putcnt(); + +} +++#endif OBJ diff --cc usr/src/cmd/pi/clas.c index 0000000000,13929ccba1,0000000000..c6b354482a mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/clas.c +++ b/usr/src/cmd/pi/clas.c @@@@ -1,0 -1,210 -1,0 +1,208 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)clas.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + + + +/* + + * This is the array of class + + * names for the classes returned + + * by classify. The order of the + + * classes is the same as the base + + * of the namelist, with special + + * negative index entries for structures, + + * scalars, pointers, sets and strings + + * to be collapsed into. + + */ + +char *clnxxxx[] = + +{ + + "file", /* -7 TFILE */ + + "record", /* -6 TREC */ + + "array", /* -5 TARY */ + + "scalar", /* -4 TSCAL */ + + "pointer", /* -3 TPTR */ + + "set", /* -2 TSET */ + + "string", /* -1 TSTR */ + + "SNARK", /* 0 NIL */ + + "Boolean", /* 1 TBOOL */ + + "char", /* 2 TCHAR */ + + "integer", /* 3 TINT */ + + "real", /* 4 TREAL */ + + "\"nil\"", /* 5 TNIL */ + +}; + + + +char **clnames = &clnxxxx[-(TFIRST)]; + + + +/* + + * Classify takes a pointer + + * to a type and returns one + + * of several interesting group + + * classifications for easy use. + + */ + +classify(p1) + + struct nl *p1; + +{ + + register struct nl *p; + + + + p = p1; + +swit: + + if (p == NIL) { + + nocascade(); + + return (NIL); + + } + + if (p == &nl[TSTR]) + + return (TSTR); +++ if ( p == &nl[ TSET ] ) { +++ return TSET; +++ } + + switch (p->class) { + + case PTR: + + return (TPTR); + + case ARRAY: + + if (p->type == nl+T1CHAR) + + return (TSTR); + + return (TARY); + + case STR: + + return (TSTR); + + case SET: + + return (TSET); + + case RANGE: + + p = p->type; + + goto swit; + + case TYPE: + + if (p <= nl+TLAST) + + return (p - nl); + + panic("clas2"); + + case FILET: + + return (TFILE); + + case RECORD: + + return (TREC); + + case SCAL: + + return (TSCAL); + + default: + + panic("clas"); + + } + +} + + + +#ifndef PI0 + +/* + + * Is p a text file? + + */ + +text(p) + + struct nl *p; + +{ + + + + return (p != NIL && p->class == FILET && p->type == nl+T1CHAR); + +} + +#endif + + + +/* + + * Scalar returns a pointer to + + * the the base scalar type of + + * its argument if its argument + + * is a SCALar else NIL. + + */ + +scalar(p1) + + struct nl *p1; + +{ + + register struct nl *p; + + + + p = p1; + + if (p == NIL) + + return (NIL); + + if (p->class == RANGE) + + p = p->type; + + if (p == NIL) + + return (NIL); + + return (p->class == SCAL ? p : NIL); + +} + + + +/* + + * Isa tells whether p + + * is one of a group of + + * namelist classes. The + + * classes wanted are specified + + * by the characters in s. + + * (Note that s would more efficiently, + + * if less clearly, be given by a mask.) + + */ + +isa(p, s) + + register struct nl *p; + + char *s; + +{ + + register i; + + register char *cp; + + + + if (p == NIL) + + return (NIL); + + /* + + * map ranges down to + + * the base type + + */ + + if (p->class == RANGE) + + p = p->type; + + /* + + * the following character/class + + * associations are made: + + * + + * s scalar + + * b Boolean + + * c character + + * i integer + + * d double (real) + + * t set + + */ + + switch (p->class) { + + case SET: + + i = TDOUBLE+1; + + break; + + case SCAL: + + i = 0; + + break; + + default: + + i = p - nl; + + } + + if (i >= 0 && i <= TDOUBLE+1) { + + i = "sbcidt"[i]; + + cp = s; + + while (*cp) + + if (*cp++ == i) + + return (1); + + } + + return (NIL); + +} + + + +/* + + * Isnta is !isa + + */ + +isnta(p, s) + +{ + + + + return (!isa(p, s)); + +} + + + +/* + + * "shorthand" + + */ + +nameof(p) + +{ + + + + return (clnames[classify(p)]); + +} + + + +#ifndef PI0 + +nowexp(r) + + int *r; + +{ + + if (r[0] == T_WEXP) { + + if (r[2] == NIL) + + error("Oct/hex allowed only on writeln/write calls"); + + else + + error("Width expressions allowed only in writeln/write calls"); + + return (1); + + } + + return (NIL); + +} + +#endif diff --cc usr/src/cmd/pi/const.c index 0000000000,34414b2d4a,0000000000..e18b0b2c3f mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/const.c +++ b/usr/src/cmd/pi/const.c @@@@ -1,0 -1,232 -1,0 +1,252 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)const.c 1.4 9/4/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + + + +/* + + * Const enters the definitions + + * of the constant declaration + + * part into the namelist. + + */ + +#ifndef PI1 + +constbeg() + +{ + + - if (parts & (TPRT|VPRT)) - error("Constant declarations must precede type and variable declarations"); - if (parts & CPRT) - error("All constants must be declared in one const part"); - parts |= CPRT; +++/* +++ * this allows for multiple declaration +++ * parts, unless the "standard" option +++ * has been specified. +++ * If a routine segment is being compiled, +++ * do level one processing. +++ */ +++ +++ if (!progseen) +++ level1(); +++ if (parts[ cbn ] & (TPRT|VPRT|RPRT)) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Constant declarations should precede type, var and routine declarations"); +++ } +++ if (parts[ cbn ] & CPRT) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All constants should be declared in one const part"); +++ } +++ parts[ cbn ] |= CPRT; + +} - #endif +++#endif PI1 + + + +const(cline, cid, cdecl) + + int cline; + + register char *cid; + + register int *cdecl; + +{ + + register struct nl *np; + + + +#ifdef PI0 + + send(REVCNST, cline, cid, cdecl); + +#endif + + line = cline; + + gconst(cdecl); + + np = enter(defnl(cid, CONST, con.ctype, con.cival)); + +#ifndef PI0 + + np->nl_flags |= NMOD; + +#endif +++ +++#ifdef PC +++ if (cbn == 1) { +++ stabgconst( cid , line ); +++ } +++#endif PC +++ + +# ifdef PTREE + + { + + pPointer Const = ConstDecl( cid , cdecl ); + + pPointer *Consts; + + + + pSeize( PorFHeader[ nesting ] ); + + Consts = &( pDEF( PorFHeader[ nesting ] ).PorFConsts ); + + *Consts = ListAppend( *Consts , Const ); + + pRelease( PorFHeader[ nesting ] ); + + } + +# endif + + if (con.ctype == NIL) + + return; + + if ( con.ctype == nl + TSTR ) + + np->ptr[0] = con.cpval; + + if (isa(con.ctype, "i")) + + np->range[0] = con.crval; + + else if (isa(con.ctype, "d")) + + np->real = con.crval; + +} + + + +#ifndef PI0 + +#ifndef PI1 + +constend() + +{ + + + +} + +#endif + +#endif + + + +/* + + * Gconst extracts + + * a constant declaration + + * from the tree for it. + + * only types of constants + + * are integer, reals, strings + + * and scalars, the first two + + * being possibly signed. + + */ + +gconst(r) + + int *r; + +{ + + register struct nl *np; + + register *cn; + + char *cp; + + int negd, sgnd; + + long ci; + + + + con.ctype = NIL; + + cn = r; + + negd = sgnd = 0; + +loop: + + if (cn == NIL || cn[1] == NIL) + + return (NIL); + + switch (cn[0]) { + + default: + + panic("gconst"); + + case T_MINUSC: + + negd = 1 - negd; + + case T_PLUSC: + + sgnd++; + + cn = cn[1]; + + goto loop; + + case T_ID: + + np = lookup(cn[1]); + + if (np == NIL) + + return; + + if (np->class != CONST) { + + derror("%s is a %s, not a constant as required", cn[1], classes[np->class]); + + return; + + } + + con.ctype = np->type; + + switch (classify(np->type)) { + + case TINT: + + con.crval = np->range[0]; + + break; + + case TDOUBLE: + + con.crval = np->real; + + break; + + case TBOOL: + + case TCHAR: + + case TSCAL: + + con.cival = np->value[0]; + + con.crval = con.cival; + + break; + + case TSTR: + + con.cpval = np->ptr[0]; + + break; + + case NIL: + + con.ctype = NIL; + + return; + + default: + + panic("gconst2"); + + } + + break; + + case T_CBINT: + + con.crval = a8tol(cn[1]); + + goto restcon; + + case T_CINT: + + con.crval = atof(cn[1]); + + if (con.crval > MAXINT || con.crval < MININT) { + + derror("Constant too large for this implementation"); + + con.crval = 0; + + } + +restcon: + + ci = con.crval; + +#ifndef PI0 + + if (bytes(ci, ci) <= 2) + + con.ctype = nl+T2INT; + + else + +#endif + + con.ctype = nl+T4INT; + + break; + + case T_CFINT: + + con.ctype = nl+TDOUBLE; + + con.crval = atof(cn[1]); + + break; + + case T_CSTRNG: + + cp = cn[1]; + + if (cp[1] == 0) { + + con.ctype = nl+T1CHAR; + + con.cival = cp[0]; + + con.crval = con.cival; + + break; + + } + + con.ctype = nl+TSTR; + + con.cpval = savestr(cp); + + break; + + } + + if (sgnd) { + + if (isnta(con.ctype, "id")) + + derror("%s constants cannot be signed", nameof(con.ctype)); + + else { + + if (negd) + + con.crval = -con.crval; + + ci = con.crval; - #ifndef PI0 - if (bytes(ci, ci) <= 2) - con.ctype = nl+T2INT; - #endif + + } + + } + +} + + + +#ifndef PI0 + +isconst(r) + + register int *r; + +{ + + + + if (r == NIL) + + return (1); + + switch (r[0]) { + + case T_MINUS: + + r[0] = T_MINUSC; + + r[1] = r[2]; + + return (isconst(r[1])); + + case T_PLUS: + + r[0] = T_PLUSC; + + r[1] = r[2]; + + return (isconst(r[1])); + + case T_VAR: + + if (r[3] != NIL) + + return (0); + + r[0] = T_ID; + + r[1] = r[2]; + + return (1); + + case T_BINT: + + r[0] = T_CBINT; + + r[1] = r[2]; + + return (1); + + case T_INT: + + r[0] = T_CINT; + + r[1] = r[2]; + + return (1); + + case T_FINT: + + r[0] = T_CFINT; + + r[1] = r[2]; + + return (1); + + case T_STRNG: + + r[0] = T_CSTRNG; + + r[1] = r[2]; + + return (1); + + } + + return (0); + +} + +#endif diff --cc usr/src/cmd/pi/conv.c index 0000000000,4bfca60693,0000000000..165ee80088 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/conv.c +++ b/usr/src/cmd/pi/conv.c @@@@ -1,0 -1,247 -1,0 +1,340 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)conv.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#ifdef PI + +#include "0.h" + +#include "opcode.h" +++#ifdef PC +++# include "pcops.h" +++#endif PC + + + +#ifndef PI0 + +/* + + * Convert a p1 into a p2. + + * Mostly used for different + + * length integers and "to real" conversions. + + */ + +convert(p1, p2) + + struct nl *p1, *p2; + +{ + + if (p1 == NIL || p2 == NIL) + + return; + + switch (width(p1) - width(p2)) { + + case -7: + + case -6: + + put1(O_STOD); + + return; + + case -4: + + put1(O_ITOD); + + return; + + case -3: + + case -2: + + put1(O_STOI); + + return; + + case -1: + + case 0: + + case 1: + + return; + + case 2: + + case 3: + + put1(O_ITOS); + + return; + + default: + + panic("convert"); + + } + +} + +#endif + + + +/* + + * Compat tells whether + + * p1 and p2 are compatible + + * types for an assignment like + + * context, i.e. value parameters, + + * indicies for 'in', etc. + + */ + +compat(p1, p2, t) + + struct nl *p1, *p2; + +{ + + register c1, c2; + + + + c1 = classify(p1); + + if (c1 == NIL) + + return (NIL); + + c2 = classify(p2); + + if (c2 == NIL) + + return (NIL); + + switch (c1) { + + case TBOOL: + + case TCHAR: + + if (c1 == c2) + + return (1); + + break; + + case TINT: + + if (c2 == TINT) + + return (1); + + case TDOUBLE: + + if (c2 == TDOUBLE) + + return (1); + +#ifndef PI0 - if (c2 == TINT && divflg == 0) { +++ if (c2 == TINT && divflg == 0 && t != NIL ) { + + divchk= 1; - c1 = classify(rvalue(t, NLNIL)); +++ c1 = classify(rvalue(t, NLNIL , RREQ )); + + divchk = NIL; + + if (c1 == TINT) { + + error("Type clash: real is incompatible with integer"); + + cerror("This resulted because you used '/' which always returns real rather"); + + cerror("than 'div' which divides integers and returns integers"); + + divflg = 1; + + return (NIL); + + } + + } + +#endif + + break; + + case TSCAL: + + if (c2 != TSCAL) + + break; + + if (scalar(p1) != scalar(p2)) { + + derror("Type clash: non-identical scalar types"); + + return (NIL); + + } + + return (1); + + case TSTR: + + if (c2 != TSTR) + + break; + + if (width(p1) != width(p2)) { + + derror("Type clash: unequal length strings"); + + return (NIL); + + } + + return (1); + + case TNIL: + + if (c2 != TPTR) + + break; + + return (1); + + case TFILE: + + if (c1 != c2) + + break; + + derror("Type clash: files not allowed in this context"); + + return (NIL); + + default: + + if (c1 != c2) + + break; + + if (p1 != p2) { + + derror("Type clash: non-identical %s types", clnames[c1]); + + return (NIL); + + } + + if (p1->nl_flags & NFILES) { + + derror("Type clash: %ss with file components not allowed in this context", clnames[c1]); + + return (NIL); + + } + + return (1); + + } + + derror("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]); + + return (NIL); + +} + + + +#ifndef PI0 + +/* + + * Rangechk generates code to + + * check if the type p on top + + * of the stack is in range for + + * assignment to a variable + + * of type q. + + */ + +rangechk(p, q) + + struct nl *p, *q; + +{ + + register struct nl *rp; + + register op; + + int wq, wrp; + + + + if (opt('t') == 0) + + return; + + rp = p; + + if (rp == NIL) + + return; + + if (q == NIL) + + return; - /* - * When op is 1 we are checking length - * 4 numbers against length 2 bounds, - * and adding it to the opcode forces - * generation of appropriate tests. - */ - op = 0; - wq = width(q); - wrp = width(rp); - op = wq != wrp && (wq == 4 || wrp == 4); - if (rp->class == TYPE) - rp = rp->type; - switch (rp->class) { - case RANGE: - if (rp->range[0] != 0) { - # ifndef DEBUG - if (wrp <= 2) - put3(O_RANG2+op, ( short ) rp->range[0], - ( short ) rp->range[1]); - else if (rp != nl+T4INT) - put(5, O_RANG4+op, rp->range[0], rp->range[1] ); - # else - if (!hp21mx) { - if (wrp <= 2) - put3(O_RANG2+op,( short ) rp->range[0], - ( short ) rp->range[1]); - else if (rp != nl+T4INT) - put(5,O_RANG4+op,rp->range[0], - rp->range[1]); - } else - if (rp != nl+T2INT && rp != nl+T4INT) - put3(O_RANG2+op,( short ) rp->range[0], - ( short ) rp->range[1]); - # endif +++# ifdef OBJ +++ /* +++ * When op is 1 we are checking length +++ * 4 numbers against length 2 bounds, +++ * and adding it to the opcode forces +++ * generation of appropriate tests. +++ */ +++ op = 0; +++ wq = width(q); +++ wrp = width(rp); +++ op = wq != wrp && (wq == 4 || wrp == 4); +++ if (rp->class == TYPE) +++ rp = rp->type; +++ switch (rp->class) { +++ case RANGE: +++ if (rp->range[0] != 0) { +++# ifndef DEBUG +++ if (wrp <= 2) +++ put(3, O_RANG2+op, ( short ) rp->range[0], +++ ( short ) rp->range[1]); +++ else if (rp != nl+T4INT) +++ put(3, O_RANG4+op, rp->range[0], rp->range[1] ); +++# else +++ if (!hp21mx) { +++ if (wrp <= 2) +++ put(3, O_RANG2+op,( short ) rp->range[0], +++ ( short ) rp->range[1]); +++ else if (rp != nl+T4INT) +++ put(3, O_RANG4+op,rp->range[0], +++ rp->range[1]); +++ } else +++ if (rp != nl+T2INT && rp != nl+T4INT) +++ put(3, O_RANG2+op,( short ) rp->range[0], +++ ( short ) rp->range[1]); +++# endif +++ break; +++ } +++ /* +++ * Range whose lower bounds are +++ * zero can be treated as scalars. +++ */ +++ case SCAL: +++ if (wrp <= 2) +++ put(2, O_RSNG2+op, ( short ) rp->range[1]); +++ else +++ put( 2 , O_RSNG4+op, rp->range[1]); + + break; - } +++ default: +++ panic("rangechk"); +++ } +++# endif OBJ +++# ifdef PC + + /* - * Range whose lower bounds are - * zero can be treated as scalars. +++ * what i want to do is make this and some other stuff +++ * arguments to a function call, which will do the rangecheck, +++ * and return the value of the current expression, or abort +++ * if the rangecheck fails. +++ * probably i need one rangecheck routine to return each c-type +++ * of value. +++ * also, i haven't figured out what the `other stuff' is. + + */ - case SCAL: - if (wrp <= 2) - put2(O_RSNG2+op, ( short ) rp->range[1]); - else - put( 3 , O_RSNG4+op, rp->range[1]); - break; - default: - panic("rangechk"); - } +++ putprintf( "# call rangecheck" , 0 ); +++# endif PC + +} + +#endif + +#endif + + +++#ifdef PC +++ /* +++ * if type p requires a range check, +++ * then put out the name of the checking function +++ * for the beginning of a function call which is completed by postcheck. +++ * (name1 is for a full check; name2 assumes a lower bound of zero) +++ */ +++precheck( p , name1 , name2 ) +++ struct nl *p; +++ char *name1 , *name2; +++ { +++ +++ if ( opt( 't' ) == 0 ) { +++ return; +++ } +++ if ( p == NIL ) { +++ return; +++ } +++ if ( p -> class == TYPE ) { +++ p = p -> type; +++ } +++ switch ( p -> class ) { +++ case RANGE: +++ if ( p != nl + T4INT ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , p -> range[0] != 0 ? name1 : name2 ); +++ } +++ break; +++ case SCAL: +++ /* +++ * how could a scalar ever be out of range? +++ */ +++ break; +++ default: +++ panic( "precheck" ); +++ break; +++ } +++ } +++ +++ /* +++ * if type p requires a range check, +++ * then put out the rest of the arguments of to the checking function +++ * a call to which was started by precheck. +++ * the first argument is what is being rangechecked (put out by rvalue), +++ * the second argument is the lower bound of the range, +++ * the third argument is the upper bound of the range. +++ */ +++postcheck( p ) +++ struct nl *p; +++ { +++ +++ if ( opt( 't' ) == 0 ) { +++ return; +++ } +++ if ( p == NIL ) { +++ return; +++ } +++ if ( p -> class == TYPE ) { +++ p = p -> type; +++ } +++ switch ( p -> class ) { +++ case RANGE: +++ if ( p != nl + T4INT ) { +++ if (p -> range[0] != 0 ) { +++ putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ } +++ putleaf( P2ICON , p -> range[1] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ break; +++ case SCAL: +++ break; +++ default: +++ panic( "postcheck" ); +++ break; +++ } +++ } +++#endif PC +++ + +#ifdef DEBUG + +conv(dub) + + int *dub; + +{ + + int newfp[2]; + + double *dp = dub; + + long *lp = dub; + + register int exp; + + long mant; + + + + newfp[0] = dub[0] & 0100000; + + newfp[1] = 0; + + if (*dp == 0.0) + + goto ret; + + exp = ((dub[0] >> 7) & 0377) - 0200; + + if (exp < 0) { + + newfp[1] = 1; + + exp = -exp; + + } + + if (exp > 63) + + exp = 63; + + dub[0] &= ~0177600; + + dub[0] |= 0200; + + mant = *lp; + + mant <<= 8; + + if (newfp[0]) + + mant = -mant; + + newfp[0] |= (mant >> 17) & 077777; + + newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1); + +ret: + + dub[0] = newfp[0]; + + dub[1] = newfp[1]; + +} + +#endif diff --cc usr/src/cmd/pi/cset.c index 0000000000,0e3af24164,0000000000..e150a2df58 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/cset.c +++ b/usr/src/cmd/pi/cset.c @@@@ -1,0 -1,142 -1,0 +1,413 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)cset.c 1.2 10/19/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" +++#include "pc.h" +++#include "pcops.h" + + + +/* - * Constant set constructor. - * settype is the type of the - * set if we think that we know it - * if not we try our damndest to figure - * out what the type should be. +++ * rummage through a `constant' set (i.e. anything within [ ]'s) tree +++ * and decide if this is a compile time constant set or a runtime set. +++ * this information is returned in a structure passed from the caller. +++ * while rummaging, this also reorders the tree so that all ranges +++ * preceed all singletons. + + */ - struct nl * - cset(r, settype, x) - int *r; - struct nl *settype; - int x; +++bool +++precset( r , settype , csetp ) +++ int *r; +++ struct nl *settype; +++ struct csetstr *csetp; + +{ - register *e; - register struct nl *t, *exptype; - int n, *el; +++ register int *e; +++ register struct nl *t; +++ register struct nl *exptype; +++ register int *el; +++ register int *pairp; +++ register int *singp; +++ int *ip; +++ long lower; +++ long upper; +++ long rangeupper; +++ bool setofint; + + - if (settype == NIL) { +++ csetp -> csettype = NIL; +++ csetp -> paircnt = 0; +++ csetp -> singcnt = 0; +++ csetp -> comptime = TRUE; +++ setofint = FALSE; +++ if ( settype != NIL ) { +++ if ( settype -> class == SET ) { +++ /* +++ * the easy case, we are told the type of the set. +++ */ +++ exptype = settype -> type; +++ } else { +++ /* +++ * we are told the type, but it's not a set +++ * supposedly possible if someone tries +++ * e.g string context [1,2] = 'abc' +++ */ +++ error("Constant set involved in non set context"); +++ return csetp -> comptime; +++ } +++ } else { + + /* + + * So far we have no indication + + * of what the set type should be. + + * We "look ahead" and try to infer + + * The type of the constant set + + * by evaluating one of its members. + + */ - e = r[2]; - if (e == NIL) - return (nl+TSET); /* tenative for [] */ - e = e[1]; - if (e == NIL) - return (NIL); - if (e[0] == T_RANG) - e = e[1]; - codeoff(); - t = rvalue(e, NIL); - codeon(); - if (t == NIL) - return (NIL); +++ e = r[2]; +++ if (e == NIL) { +++ /* +++ * tentative for [], return type of `intset' +++ */ +++ settype = lookup( intset ); +++ if ( settype == NIL ) { +++ panic( "empty set" ); +++ } +++ settype = settype -> type; +++ if ( settype == NIL ) { +++ return csetp -> comptime; +++ } +++ if ( isnta( settype , "t" ) ) { +++ error("Set default type \"intset\" is not a set"); +++ return csetp -> comptime; +++ } +++ csetp -> csettype = settype; +++ return csetp -> comptime; +++ } +++ e = e[1]; +++ if (e == NIL) { +++ return csetp -> comptime; +++ } +++ if (e[0] == T_RANG) { +++ e = e[1]; +++ } +++ codeoff(); +++ t = rvalue(e, NIL , RREQ ); +++ codeon(); +++ if (t == NIL) { +++ return csetp -> comptime; +++ } + + /* + + * The type of the set, settype, is + + * deemed to be a set of the base type + + * of t, which we call exptype. If, + + * however, this would involve a + + * "set of integer", we cop out + + * and use "intset"'s current scoped + + * type instead. + + */ - if (isa(t, "r")) { - error("Sets may not have 'real' elements"); - return (NIL); - } - if (isnta(t, "bcsi")) { - error("Set elements must be scalars, not %ss", nameof(t)); - return (NIL); - } - if (isa(t, "i")) { - settype = lookup(intset); - if (settype == NIL) - panic("intset"); - settype = settype->type; - if (settype == NIL) - return (NIL); - if (isnta(settype, "t")) { - error("Set default type \"intset\" is not a set"); - return (NIL); - } - exptype = settype->type; - } else { +++ if (isa(t, "r")) { +++ error("Sets may not have 'real' elements"); +++ return csetp -> comptime; +++ } +++ if (isnta(t, "bcsi")) { +++ error("Set elements must be scalars, not %ss", nameof(t)); +++ return csetp -> comptime; +++ } +++ if (isa(t, "i")) { +++ settype = lookup(intset); +++ if (settype == NIL) +++ panic("intset"); +++ settype = settype->type; +++ if (settype == NIL) +++ return csetp -> comptime; +++ if (isnta(settype, "t")) { +++ error("Set default type \"intset\" is not a set"); +++ return csetp -> comptime; +++ } +++ exptype = settype->type; +++ /* +++ * say we are doing an intset +++ * but, if we get out of range errors for intset +++ * we punt constructing the set at compile time. +++ */ +++ setofint = TRUE; +++ } else { + + exptype = t->type; + + if (exptype == NIL) - return (NIL); +++ return csetp -> comptime; + + if (exptype->class != RANGE) + + exptype = exptype->type; + + settype = defnl(0, SET, exptype, 0); - } - } else { - if (settype->class != SET) { - /* - * e.g string context [1,2] = 'abc' - */ - error("Constant set involved in non set context"); - return (NIL); - } - exptype = settype->type; +++ } + + } - if (x == NIL) - put2(O_PUSH, -width(settype)); - n = 0; - for (el=r[2]; el; el=el[2]) { - n++; +++ csetp -> csettype = settype; +++ setran( exptype ); +++ lower = set.lwrb; +++ upper = set.lwrb + set.uprbp; +++ pairp = NIL; +++ singp = NIL; +++ codeoff(); +++ while ( el = r[2] ) { + + e = el[1]; - if (e == NIL) - return (NIL); +++ if (e == NIL) { +++ /* +++ * don't hang this one anywhere. +++ */ +++ csetp -> csettype = NIL; +++ r[2] = el[2]; +++ continue; +++ } + + if (e[0] == T_RANG) { - t = rvalue(e[2], NIL); - if (t == NIL) { - rvalue(e[1], NIL); - continue; +++ if ( csetp -> comptime && constval( e[2] ) ) { +++ t = con.ctype; +++ if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) { +++ if ( setofint ) { +++ csetp -> comptime = FALSE; +++ } else { +++ error("Range upper bound of %d out of set bounds" , ((long)con.crval) ); +++ csetp -> csettype = NIL; +++ } +++ } +++ rangeupper = ((long)con.crval); +++ } else { +++ csetp -> comptime = FALSE; +++ t = rvalue(e[2], NIL , RREQ ); +++ if (t == NIL) { +++ rvalue(e[1], NIL , RREQ ); +++ goto pairhang; +++ } + + } - if (incompat(t, exptype, e[2])) +++ if (incompat(t, exptype, e[2])) { + + cerror("Upper bound of element type clashed with set type in constant set"); - else - convert(t, nl+T2INT); - t = rvalue(e[1], NIL); - if (t == NIL) - continue; - if (incompat(t, exptype, e[1])) +++ } +++ if ( csetp -> comptime && constval( e[1] ) ) { +++ t = con.ctype; +++ if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) { +++ if ( setofint ) { +++ csetp -> comptime = FALSE; +++ } else { +++ error("Range lower bound of %d out of set bounds" , ((long)con.crval) ); +++ csetp -> csettype = NIL; +++ } +++ } +++ } else { +++ csetp -> comptime = FALSE; +++ t = rvalue(e[1], NIL , RREQ ); +++ if (t == NIL) { +++ goto pairhang; +++ } +++ } +++ if (incompat(t, exptype, e[1])) { + + cerror("Lower bound of element type clashed with set type in constant set"); - else - convert(t, nl+T2INT); +++ } +++pairhang: +++ /* +++ * remove this range from the tree list and +++ * hang it on the pairs list. +++ */ +++ ip = el[2]; +++ el[2] = pairp; +++ pairp = r[2]; +++ r[2] = ip; +++ csetp -> paircnt++; + + } else { - t = rvalue((int *) e, NLNIL); - if (t == NIL) - continue; - if (incompat(t, exptype, e)) +++ if ( csetp -> comptime && constval( e ) ) { +++ t = con.ctype; +++ if ( ((long)con.crval) < lower || ((long)con.crval) > upper ) { +++ if ( setofint ) { +++ csetp -> comptime = FALSE; +++ } else { +++ error("Value of %d out of set bounds" , ((long)con.crval) ); +++ csetp -> csettype = NIL; +++ } +++ } +++ } else { +++ csetp -> comptime = FALSE; +++ t = rvalue((int *) e, NLNIL , RREQ ); +++ if (t == NIL) { +++ goto singhang; +++ } +++ } +++ if (incompat(t, exptype, e)) { + + cerror("Element type clashed with set type in constant set"); - else - convert(t, nl+T2INT); - put1(O_SDUP); +++ } +++singhang: +++ /* +++ * take this expression off the tree list and +++ * hang it on the list of singletons. +++ */ +++ ip = el[2]; +++ el[2] = singp; +++ singp = r[2]; +++ r[2] = ip; +++ csetp -> singcnt++; +++ } +++ } +++ codeon(); +++# ifdef PC +++ if ( pairp != NIL ) { +++ for ( el = pairp ; el[2] != NIL ; el = el[2] ) /* void */; +++ el[2] = singp; +++ r[2] = pairp; +++ } else { +++ r[2] = singp; +++ } +++# endif PC +++# ifdef OBJ +++ if ( singp != NIL ) { +++ for ( el = singp ; el[2] != NIL ; el = el[2] ) /* void */; +++ el[2] = pairp; +++ r[2] = singp; +++ } else { +++ r[2] = pairp; +++ } +++# endif OBJ +++ if ( csetp -> csettype == NIL ) { +++ csetp -> comptime = TRUE; +++ } +++ return csetp -> comptime; +++} +++ +++#define BITSPERLONG ( sizeof( long ) * BITSPERBYTE ) +++ /* +++ * mask[i] has the low i bits turned off. +++ */ +++long mask[] = { +++ 0xffffffff , 0xfffffffe , 0xfffffffc , 0xfffffff8 , +++ 0xfffffff0 , 0xffffffe0 , 0xffffffc0 , 0xffffff80 , +++ 0xffffff00 , 0xfffffe00 , 0xfffffc00 , 0xfffff800 , +++ 0xfffff000 , 0xffffe000 , 0xffffc000 , 0xffff8000 , +++ 0xffff0000 , 0xfffe0000 , 0xfffc0000 , 0xfff80000 , +++ 0xfff00000 , 0xffe00000 , 0xffc00000 , 0xff800000 , +++ 0xff000000 , 0xfe000000 , 0xfc000000 , 0xf8000000 , +++ 0xf0000000 , 0xe0000000 , 0xc0000000 , 0x80000000 , +++ 0x00000000 +++ }; +++ /* +++ * given a csetstr, either +++ * put out a compile time constant set and an lvalue to it. +++ * or +++ * put out rvalues for the singletons and the pairs +++ * and counts of each. +++ */ +++postcset( r , csetp ) +++ int *r; +++ struct csetstr *csetp; +++ { +++ register int *el; +++ register int *e; +++ int lower; +++ int upper; +++ int lowerdiv; +++ int lowermod; +++ int upperdiv; +++ int uppermod; +++ int label; +++ long *lp; +++ long *limit; +++ long tempset[ ( MAXSET / BITSPERLONG ) + 1 ]; +++ long temp; +++ char labelname[ BUFSIZ ]; +++ +++ if ( csetp -> comptime ) { +++ setran( ( csetp -> csettype ) -> type ); +++ limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ]; +++ for ( lp = &tempset[0] ; lp < limit ; lp++ ) { +++ *lp = 0; +++ } +++ for ( el = r[2] ; el != NIL ; el = el[2] ) { +++ e = el[1]; +++ if ( e[0] == T_RANG ) { +++ constval( e[1] ); +++ lower = (long) con.crval; +++ constval( e[2] ); +++ upper = (long) con.crval; +++ if ( upper < lower ) { +++ continue; +++ } +++ lowerdiv = ( lower - set.lwrb ) / BITSPERLONG; +++ lowermod = ( lower - set.lwrb ) % BITSPERLONG; +++ upperdiv = ( upper - set.lwrb ) / BITSPERLONG; +++ uppermod = ( upper - set.lwrb ) % BITSPERLONG; +++ temp = mask[ lowermod ]; +++ if ( lowerdiv == upperdiv ) { +++ temp &= ~mask[ uppermod + 1 ]; +++ } +++ tempset[ lowerdiv ] |= temp; +++ limit = &tempset[ upperdiv-1 ]; +++ for ( lp = &tempset[ lowerdiv+1 ] ; lp <= limit ; lp++ ) { +++ *lp |= ~0; +++ } +++ if ( lowerdiv != upperdiv ) { +++ tempset[ upperdiv ] |= ~mask[ uppermod + 1 ]; +++ } +++ } else { +++ constval( e ); +++ lowerdiv = ( ((long)con.crval) - set.lwrb ) / BITSPERLONG; +++ lowermod = ( ((long)con.crval) - set.lwrb ) % BITSPERLONG; +++ tempset[ lowerdiv ] |= ( 1 << lowermod ); +++ } +++ } +++ if ( cgenflg ) +++ return; +++# ifdef PC +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 2" , 0 ); +++ label = getlab(); +++ putlab( label ); +++ lp = &( tempset[0] ); +++ limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ]; +++ while ( lp < limit ) { +++ putprintf( " .long 0x%x" , 1 , *lp ++ ); +++ for ( temp = 2 ; ( temp <= 8 ) && lp < limit ; temp ++ ) { +++ putprintf( ",0x%x" , 1 , *lp++ ); +++ } +++ putprintf( "" , 0 ); +++ } +++ putprintf( " .text" , 0 ); +++ sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label ); +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2STRTY , labelname ); +++# endif PC +++# ifdef OBJ +++ put( 2, O_CON, (set.uprbp / BITSPERLONG + 1) * +++ (BITSPERLONG / BITSPERBYTE)); +++ lp = &( tempset[0] ); +++ limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ]; +++ while ( lp < limit ) { +++ put( 2, O_CASE4, *lp ++); +++ } +++# endif OBJ +++ } else { +++# ifdef PC +++ putleaf( P2ICON , csetp -> paircnt , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , csetp -> singcnt , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ for ( el = r[2] ; el != NIL ; el = el[2] ) { +++ e = el[1]; +++ if ( e[0] == T_RANG ) { +++ rvalue( e[2] , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ rvalue( e[1] , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ rvalue( e , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } +++ } +++# endif PC +++# ifdef OBJ +++ for ( el = r[2] ; el != NIL ; el = el[2] ) { +++ e = el[1]; +++ if ( e[0] == T_RANG ) { +++ stkrval( e[2] , NIL , RREQ ); +++ stkrval( e[1] , NIL , RREQ ); +++ } else { +++ stkrval( e , NIL , RREQ ); +++ } + + } +++ put( 2 , O_CON24 , csetp -> singcnt ); +++ put( 2 , O_CON24 , csetp -> paircnt ); +++# endif OBJ + + } - if (x == NIL) { - setran(exptype); - put(4, O_CTTOT, n, set.lwrb, set.uprbp); - } else - put2(O_CON2, n); - return (settype); + +} diff --cc usr/src/cmd/pi/error.c index 0000000000,477bc97d27,0000000000..256ed2b71b mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/error.c +++ b/usr/src/cmd/pi/error.c @@@@ -1,0 -1,134 -1,0 +1,135 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)error.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#ifndef PI1 + +#include "yy.h" + +#endif + + + +char errpfx = 'E'; + +extern int yyline; + +/* + + * Panic is called when impossible + + * (supposedly, anyways) situations + + * are encountered. + + * Panic messages should be short + + * as they do not go to the message + + * file. + + */ + +panic(s) + + char *s; + +{ + + + +#ifdef DEBUG + +#ifdef PI1 + + printf("Snark (%s) line=%d\n", s, line); + + abort(); + +#else + + printf("Snark (%s) line=%d, yyline=%d\n", s, line, yyline); + + abort () ; /* die horribly */ + +#endif + +#endif + +#ifdef PI1 + + Perror( "Snark in pi1", s); + +#else + + Perror( "Snark in pi", s); + +#endif + + pexit(DIED); + +} + + + +extern char *errfile; + +/* + + * Error is called for + + * semantic errors and + + * prints the error and + + * a line number. + + */ + + + +/*VARARGS*/ + + + +error(a1, a2, a3, a4) + + register char *a1; + +{ + + char errbuf[256]; /* was extern. why? ...pbk */ + + register int i; + + - if (errpfx == 'w' && opt('w') != 0) +++ if (errpfx == 'w' && opt('w') != 0) { +++ errpfx = 'E'; + + return; +++ } + + Enocascade = 0; + + geterr(a1, errbuf); + + a1 = errbuf; + + if (line < 0) + + line = -line; + +#ifndef PI1 + + if (opt('l')) + + yyoutline(); + +#endif + + yysetfile(filename); + + if (errpfx == ' ') { + + printf(" "); + + for (i = line; i >= 10; i /= 10) + + pchr( ' ' ); + + printf("... "); + + } else if (Enoline) + + printf(" %c - ", errpfx); + + else + + printf("%c %d - ", errpfx, line); + + printf(a1, a2, a3, a4); + + if (errpfx == 'E') + +#ifndef PI0 - eflg++, cgenflg++; +++ eflg++, codeoff(); + +#else + + eflg++; + +#endif + + errpfx = 'E'; + + if (Eholdnl) + + Eholdnl = 0; + + else + + pchr( '\n' ); + +} + + + +/*VARAGRS*/ + + + +cerror(a1, a2, a3, a4) + +{ + + + + if (Enocascade) + + return; + + setpfx(' '); + + error(a1, a2, a3, a4); + +} + + + +#ifdef PI1 + + + +/*VARARGS*/ + + + +derror(a1, a2, a3, a4) + +{ + + + + if (!holdderr) + + error(a1, a2, a3, a4); + + errpfx = 'E'; + +} + + + +char *lastname, printed, hadsome; + + +++ /* +++ * this yysetfile for PI1 only. +++ * the real yysetfile is in yyput.c +++ */ + +yysetfile(name) + + char *name; + +{ + + + + if (lastname == name) + + return; + + printed =| 1; + + gettime( name ); + + printf("%s %s:\n" , myctime( &tvec ) , name ); + + lastname = name; + +} + +#endif diff --cc usr/src/cmd/pi/fdec.c index 0000000000,e9566f42da,0000000000..c15f3b1cbe mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/fdec.c +++ b/usr/src/cmd/pi/fdec.c @@@@ -1,0 -1,638 -1,0 +1,1110 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)fdec.c 1.7 10/28/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" +++#include "align.h" +++ +++/* +++ * this array keeps the pxp counters associated with +++ * functions and procedures, so that they can be output +++ * when their bodies are encountered +++ */ +++int bodycnts[ DSPLYSZ ]; +++ +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC + + +++#ifdef OBJ + +int cntpatch; + +int nfppatch; +++#endif OBJ + + + +/* + + * Funchdr inserts + + * declaration of a the + + * prog/proc/func into the + + * namelist. It also handles + + * the arguments and puts out + + * a transfer which defines + + * the entry point of a procedure. + + */ + + + +struct nl * + +funchdr(r) + + int *r; + +{ + + register struct nl *p; + + register *il, **rl; + + int *rll; + + struct nl *cp, *dp, *sp; - int o, *pp; +++ int s, o, *pp; + + + + if (inpflist(r[2])) { + + opush('l'); + + yyretrieve(); /* kludge */ + + } + + pfcnt++; +++ parts[ cbn ] |= RPRT; + + line = r[1]; + + if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { + + /* + + * Symbol already defined + + * in this block. it is either + + * a redeclared symbol (error) - * or a forward declaration. +++ * a forward declaration, +++ * or an external declaration. + + */ + + if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { + + /* + + * Grammar doesnt forbid + + * types on a resolution + + * of a forward function + + * declaration. + + */ + + if (p->class == FUNC && r[4]) + + error("Function type should be given only in forward declaration"); - if (monflg) - putcnt(); +++ /* +++ * get another counter for the actual +++ */ +++ if ( monflg ) { +++ bodycnts[ cbn ] = getcnt(); +++ } +++# ifdef PC +++ enclosing[ cbn ] = p -> symbol; +++# endif PC + +# ifdef PTREE + + /* + + * mark this proc/func as forward + + * in the pTree. + + */ + + pDEF( p -> inTree ).PorFForward = TRUE; - # endif +++# endif PTREE + + return (p); + + } + + } +++ +++ /* if a routine segment is being compiled, +++ * do level one processing. +++ */ +++ +++ if ((r[0] != T_PROG) && (!progseen)) +++ level1(); +++ +++ + + /* + + * Declare the prog/proc/func + + */ + + switch (r[0]) { - case T_PROG: - if (opt('z')) - monflg++; - program = p = defnl(r[2], PROG, 0, 0); - p->value[3] = r[1]; - break; - case T_PDEC: - if (r[4] != NIL) - error("Procedures do not have types, only functions do"); - p = enter(defnl(r[2], PROC, 0, 0)); - p->nl_flags |= NMOD; - break; - case T_FDEC: - il = r[4]; - if (il == NIL) - error("Function type must be specified"); - else if (il[0] != T_TYID) { - il = NIL; - error("Function type can be specified only by using a type identifier"); - } else - il = gtype(il); - p = enter(defnl(r[2], FUNC, il, NIL)); - p->nl_flags |= NMOD; - /* - * An arbitrary restriction - */ - switch (o = classify(p->type)) { - case TFILE: - case TARY: - case TREC: - case TSET: - case TSTR: - warning(); - if (opt('s')) - standard(); - error("Functions should not return %ss", clnames[o]); - } - break; - default: - panic("funchdr"); - } +++ case T_PROG: +++ progseen++; +++ if (opt('z')) +++ monflg++; +++ program = p = defnl(r[2], PROG, 0, 0); +++ p->value[3] = r[1]; +++ break; +++ case T_PDEC: +++ if (r[4] != NIL) +++ error("Procedures do not have types, only functions do"); +++ p = enter(defnl(r[2], PROC, 0, 0)); +++ p->nl_flags |= NMOD; +++# ifdef PC +++ enclosing[ cbn ] = r[2]; +++# endif PC +++ break; +++ case T_FDEC: +++ il = r[4]; +++ if (il == NIL) +++ error("Function type must be specified"); +++ else if (il[0] != T_TYID) { +++ il = NIL; +++ error("Function type can be specified only by using a type identifier"); +++ } else +++ il = gtype(il); +++ p = enter(defnl(r[2], FUNC, il, NIL)); +++ p->nl_flags |= NMOD; +++ /* +++ * An arbitrary restriction +++ */ +++ switch (o = classify(p->type)) { +++ case TFILE: +++ case TARY: +++ case TREC: +++ case TSET: +++ case TSTR: +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Functions should not return %ss", clnames[o]); +++ } +++# ifdef PC +++ enclosing[ cbn ] = r[2]; +++# endif PC +++ break; +++ default: +++ panic("funchdr"); +++ } + + if (r[0] != T_PROG) { + + /* + + * Mark this proc/func as + + * being forward declared + + */ + + p->nl_flags |= NFORWD; + + /* + + * Enter the parameters + + * in the next block for + + * the time being + + */ + + if (++cbn >= DSPLYSZ) { + + error("Procedure/function nesting too deep"); + + pexit(ERRS); + + } + + /* + + * For functions, the function variable + + */ + + if (p->class == FUNC) { - cp = defnl(r[2], FVAR, p->type, 0); +++# ifdef OBJ +++ cp = defnl(r[2], FVAR, p->type, 0); +++# endif OBJ +++# ifdef PC +++ /* +++ * fvars used to be allocated and deallocated +++ * by the caller right before the arguments. +++ * the offset of the fvar was kept in +++ * value[NL_OFFS] of function (very wierd, +++ * but see asgnop). +++ * now, they are locals to the function +++ * with the offset kept in the fvar. +++ */ +++ +++ cp = defnl( r[2] , FVAR , p -> type +++ , -( roundup( DPOFF1+width( p -> type ) +++ , align( p -> type ) ) ) ); +++# endif PC + + cp->chain = p; + + p->ptr[NL_FVAR] = cp; + + } + + /* + + * Enter the parameters + + * and compute total size + + */ + + cp = sp = p; - o = 0; +++ +++# ifdef OBJ +++ o = 0; +++# endif OBJ +++# ifdef PC +++ /* +++ * parameters used to be allocated backwards, +++ * then fixed. for pc, they are allocated correctly. +++ * also, they are aligned. +++ */ +++ o = DPOFF2; +++# endif PC + + for (rl = r[3]; rl != NIL; rl = rl[2]) { + + p = NIL; + + if (rl[1] == NIL) + + continue; + + /* + + * Parametric procedures + + * don't have types !?! + + */ + + if (rl[1][0] != T_PPROC) { + + rll = rl[1][2]; + + if (rll[0] != T_TYID) { + + error("Types for arguments can be specified only by using type identifiers"); + + p = NIL; + + } else + + p = gtype(rll); + + } + + for (il = rl[1][1]; il != NIL; il = il[2]) { + + switch (rl[1][0]) { - default: - panic("funchdr2"); - case T_PVAL: - if (p != NIL) { - if (p->class == FILET) - error("Files cannot be passed by value"); - else if (p->nl_flags & NFILES) - error("Files cannot be a component of %ss passed by value", - nameof(p)); - } +++ default: +++ panic("funchdr2"); +++ case T_PVAL: +++ if (p != NIL) { +++ if (p->class == FILET) +++ error("Files cannot be passed by value"); +++ else if (p->nl_flags & NFILES) +++ error("Files cannot be a component of %ss passed by value", +++ nameof(p)); +++ } +++# ifdef OBJ + + dp = defnl(il[1], VAR, p, o -= even(width(p))); - dp->nl_flags |= NMOD; - break; - case T_PVAR: +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , VAR , p +++ , o = roundup( o , A_STACK ) ); +++ o += width( p ); +++# endif PC +++ dp->nl_flags |= NMOD; +++ break; +++ case T_PVAR: +++# ifdef OBJ + + dp = defnl(il[1], REF, p, o -= sizeof ( int * ) ); - break; - case T_PFUNC: - case T_PPROC: - error("Procedure/function parameters not implemented"); - continue; - } +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , REF , p +++ , o = roundup( o , A_STACK ) ); +++ o += sizeof(char *); +++# endif PC +++ break; +++ case T_PFUNC: +++# ifdef OBJ +++ dp = defnl(il[1], FFUNC, p, o -= sizeof ( int * ) ); +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , FFUNC , p +++ , o = roundup( o , A_STACK ) ); +++ o += sizeof(char *); +++# endif PC +++ dp -> nl_flags |= NMOD; +++ break; +++ case T_PPROC: +++# ifdef OBJ +++ dp = defnl(il[1], FPROC, p, o -= sizeof ( int * ) ); +++# endif OBJ +++# ifdef PC +++ dp = defnl( il[1] , FPROC , p +++ , o = roundup( o , A_STACK ) ); +++ o += sizeof(char *); +++# endif PC +++ dp -> nl_flags |= NMOD; +++ break; +++ } + + if (dp != NIL) { + + cp->chain = dp; + + cp = dp; + + } + + } + + } + + cbn--; + + p = sp; - p->value[NL_OFFS] = -o+DPOFF2; - /* - * Correct the naievity - * of our above code to - * calculate offsets - */ - for (il = p->chain; il != NIL; il = il->chain) - il->value[NL_OFFS] += p->value[NL_OFFS]; +++# ifdef OBJ +++ p->value[NL_OFFS] = -o+DPOFF2; +++ /* +++ * Correct the naivete (naievity) +++ * of our above code to +++ * calculate offsets +++ */ +++ for (il = p->chain; il != NIL; il = il->chain) +++ il->value[NL_OFFS] += p->value[NL_OFFS]; +++# endif OBJ +++# ifdef PC +++ p -> value[ NL_OFFS ] = roundup( o , A_STACK ); +++# endif PC + + } else { + + /* + + * The wonderful + + * program statement! + + */ - if (monflg) { - cntpatch = put2(O_PXPBUF, 0); - nfppatch = put3(NIL, 0, 0); - } +++# ifdef OBJ +++ if (monflg) { +++ put(1, O_PXPBUF); +++ cntpatch = put(2, O_CASE4, 0); +++ nfppatch = put(2, O_CASE4, 0); +++ } +++# endif OBJ + + cp = p; + + for (rl = r[3]; rl; rl = rl[2]) { + + if (rl[1] == NIL) + + continue; + + dp = defnl(rl[1], VAR, 0, 0); + + cp->chain = dp; + + cp = dp; + + } + + } + + /* + + * Define a branch at + + * the "entry point" of + + * the prog/proc/func. + + */ + + p->entloc = getlab(); + + if (monflg) { - put2(O_TRACNT, p->entloc); - putcnt(); - } else - put2(O_TRA4, p->entloc); +++ bodycnts[ cbn ] = getcnt(); +++ p->value[ NL_CNTR ] = 0; +++ } +++# ifdef OBJ +++ put(2, O_TRA4, p->entloc); +++# endif OBJ + +# ifdef PTREE + + { + + pPointer PF = tCopy( r ); + + + + pSeize( PorFHeader[ nesting ] ); + + if ( r[0] != T_PROG ) { + + pPointer *PFs; + + + + PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); + + *PFs = ListAppend( *PFs , PF ); + + } else { + + pDEF( PorFHeader[ nesting ] ).GlobProg = PF; + + } + + pRelease( PorFHeader[ nesting ] ); + + } - # endif +++# endif PTREE + + return (p); + +} + + + +funcfwd(fp) + + struct nl *fp; + +{ + + +++ /* +++ * save the counter for this function +++ */ +++ if ( monflg ) { +++ fp -> value[ NL_CNTR ] = bodycnts[ cbn ]; +++ } + + return (fp); + +} + + +++/* +++ * Funcext marks the procedure or +++ * function external in the symbol +++ * table. Funcext should only be +++ * called if PC, and is an error +++ * otherwise. +++ */ +++ +++funcext(fp) +++ struct nl *fp; +++{ +++ +++#ifdef PC +++ if (opt('s')) { +++ standard(); +++ error("External procedures and functions are not standard"); +++ } else { +++ if (cbn == 1) { +++ fp->ext_flags |= NEXTERN; +++ stabefunc( fp -> symbol , fp -> class , line ); +++ } +++ else +++ error("External procedures and functions can only be declared at the outermost level."); +++ } +++#endif PC +++#ifdef OBJ +++ error("Procedures or functions cannot be declared external."); +++#endif OBJ +++ +++ return(fp); +++} +++ + +/* + + * Funcbody is called + + * when the actual (resolved) + + * declaration of a procedure is + + * encountered. It puts the names + + * of the (function) and parameters + + * into the symbol table. + + */ + +funcbody(fp) + + struct nl *fp; + +{ + + register struct nl *q, *p; + + + + cbn++; + + if (cbn >= DSPLYSZ) { + + error("Too many levels of function/procedure nesting"); + + pexit(ERRS); + + } + + sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; + + gotos[cbn] = NIL; + + errcnt[cbn] = syneflg; - parts = NIL; +++ parts[ cbn ] = NIL; +++ dfiles[ cbn ] = FALSE; + + if (fp == NIL) + + return (NIL); + + /* + + * Save the virtual name + + * list stack pointer so + + * the space can be freed + + * later (funcend). + + */ + + fp->ptr[2] = nlp; - if (fp->class != PROG) - for (q = fp->chain; q != NIL; q = q->chain) +++# ifdef PC +++ if ( fp -> class != PROG ) { +++ stabfunc( fp -> symbol , fp -> class , line , cbn - 1 ); +++ } else { +++ stabfunc( "program" , fp -> class , line , 0 ); +++ } +++# endif PC +++ if (fp->class != PROG) { +++ for (q = fp->chain; q != NIL; q = q->chain) { + + enter(q); +++# ifdef PC +++ stabparam( q -> symbol , p2type( q -> type ) +++ , q -> value[ NL_OFFS ] +++ , lwidth( q -> type ) ); +++# endif PC +++ } +++ } + + if (fp->class == FUNC) { + + /* + + * For functions, enter the fvar + + */ + + enter(fp->ptr[NL_FVAR]); +++# ifdef PC +++ q = fp -> ptr[ NL_FVAR ]; +++ sizes[cbn].om_off -= lwidth( q -> type ); +++ sizes[cbn].om_max = sizes[cbn].om_off; +++ stabvar( q -> symbol , p2type( q -> type ) , cbn +++ , q -> value[ NL_OFFS ] , lwidth( q -> type ) +++ , line ); +++# endif PC + + } + +# ifdef PTREE + + /* + + * pick up the pointer to porf declaration + + */ + + PorFHeader[ ++nesting ] = fp -> inTree; - # endif +++# endif PTREE + + return (fp); + +} + + + +struct nl *Fp; + +int pnumcnt; + +/* + + * Funcend is called to + + * finish a block by generating + + * the code for the statements. + + * It then looks for unresolved declarations + + * of labels, procedures and functions, + + * and cleans up the name list. + + * For the program, it checks the + + * semantics of the program + + * statement (yuchh). + + */ + +funcend(fp, bundle, endline) + + struct nl *fp; + + int *bundle; + + int endline; + +{ + + register struct nl *p; + + register int i, b; + + int var, inp, out, chkref, *blk; + + struct nl *iop; + + char *cp; + + extern int cntstat; - # ifdef PPC - int toplabel = newlabel(); - int botlabel = newlabel(); - # endif +++# ifdef PC +++ int toplabel = getlab(); +++ int botlabel = getlab(); +++# endif PC + + + + cntstat = 0; + +/* + + * yyoutline(); + + */ + + if (program != NIL) + + line = program->value[3]; + + blk = bundle[2]; + + if (fp == NIL) { + + cbn--; + +# ifdef PTREE + + nesting--; - # endif +++# endif PTREE + + return; + + } + +#ifdef OBJ + + /* + + * Patch the branch to the + + * entry point of the function + + */ + + patch4(fp->entloc); + + /* + + * Put out the block entrance code and the block name. + + * the CONG is overlaid by a patch later! + + */ - var = put1(cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG); - put( 2 + (sizeof ( char * )/sizeof ( short )) , O_CONG, 8, fp->symbol); - put2(NIL, bundle[1]); - #endif - #ifdef PPC +++ var = put(2, (lenstr(fp->symbol,0) << 8) +++ | (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0); +++ /* +++ * output the number of bytes of arguments +++ * this is only checked on formal calls. +++ */ +++ put(2, O_CASE4, cbn == 1 ? 0 : fp->value[NL_OFFS]-DPOFF2); +++ put(2, O_CASE2, bundle[1]); +++ putstr(fp->symbol, 0); +++#endif OBJ +++#ifdef PC + + /* + + * put out the procedure entry code + + */ + + if ( fp -> class == PROG ) { - puttext( " .data" ); - puttext( " .align 1" ); - putprintf( " .comm _display,%d" - , DSPLYSZ * sizeof( int * ) ); - puttext( " .text" ); - puttext( " .align 1" ); - puttext( " .globl _main" ); - puttext( "_main:" ); +++ putprintf( " .text" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ putprintf( " .globl _main" , 0 ); +++ putprintf( "_main:" , 0 ); +++ putprintf( " .word 0" , 0 ); +++ putprintf( " calls $0,_PCSTART" , 0 ); +++ putprintf( " movl 4(ap),__argc" , 0 ); +++ putprintf( " movl 8(ap),__argv" , 0 ); +++ putprintf( " calls $0,_program" , 0 ); +++ putprintf( " calls $0,_PCEXIT" , 0 ); +++ ftnno = fp -> entloc; +++ putprintf( " .text" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ putprintf( " .globl _program" , 0 ); +++ putprintf( "_program:" , 0 ); +++ } else { +++ ftnno = fp -> entloc; +++ putprintf( " .text" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ putprintf( " .globl " , 1 ); +++ for ( i = 1 ; i < cbn ; i++ ) { +++ putprintf( EXTFORMAT , 1 , enclosing[ i ] ); +++ } +++ putprintf( "" , 0 ); +++ for ( i = 1 ; i < cbn ; i++ ) { +++ putprintf( EXTFORMAT , 1 , enclosing[ i ] ); +++ } +++ putprintf( ":" , 0 ); +++ } +++ stablbrac( cbn ); +++ /* +++ * register save mask +++ */ +++ if ( opt( 't' ) ) { +++ putprintf( " .word 0x%x" , 0 , RUNCHECK | RSAVEMASK ); +++ } else { +++ putprintf( " .word 0x%x" , 0 , RSAVEMASK ); +++ } +++ putjbr( botlabel ); +++ putlab( toplabel ); +++ if ( profflag ) { +++ /* +++ * call mcount for profiling +++ */ +++ putprintf( " moval 1f,r0" , 0 ); +++ putprintf( " jsb mcount" , 0 ); +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 2" , 0 ); +++ putprintf( "1:" , 0 ); +++ putprintf( " .long 0" , 0 ); +++ putprintf( " .text" , 0 ); +++ } +++ /* +++ * set up unwind exception vector. +++ */ +++ putprintf( " moval %s,%d(%s)" , 0 +++ , UNWINDNAME , UNWINDOFFSET , P2FPNAME ); +++ /* +++ * save address of display entry, for unwind. +++ */ +++ putprintf( " moval %s+%d,%d(%s)" , 0 +++ , DISPLAYNAME , cbn * sizeof(struct dispsave) +++ , DPTROFFSET , P2FPNAME ); +++ /* +++ * save old display +++ */ +++ putprintf( " movq %s+%d,%d(%s)" , 0 +++ , DISPLAYNAME , cbn * sizeof(struct dispsave) +++ , DSAVEOFFSET , P2FPNAME ); +++ /* +++ * set up new display by saving AP and FP in appropriate +++ * slot in display structure. +++ */ +++ putprintf( " movq %s,%s+%d" , 0 +++ , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) ); +++ /* +++ * ask second pass to allocate known locals +++ */ +++ putlbracket( ftnno , -sizes[ cbn ].om_max ); +++ /* +++ * and zero them if checking is on +++ * by calling zframe( bytes of locals , highest local address ); +++ */ +++ if ( opt( 't' ) ) { +++ if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ZFRAME" ); +++ putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1 +++ , 0 , P2INT , 0 ); +++ putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ /* +++ * check number of longs of arguments +++ * this can only be wrong for formal calls. +++ */ +++ if ( fp -> class != PROG ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) , +++ "_NARGCHK" ); +++ putleaf( P2ICON , +++ (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) , +++ 0 , P2INT , 0 ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++#endif PC +++ if ( monflg ) { +++ if ( fp -> value[ NL_CNTR ] != 0 ) { +++ inccnt( fp -> value [ NL_CNTR ] ); +++ } +++ inccnt( bodycnts[ fp -> nl_block & 037 ] ); + + } - ftnno = newlabel(); - puttext( " .text" ); - puttext( " .align 1" ); - putprintf( " .globl _%.7s" , fp -> symbol ); - putprintf( "_%.7s:" , fp -> symbol ); - /* register save mask for function */ - putprintf( " .word 0" ); - putprintf( " jbr B%d" , botlabel ); - putprintf( "T%d:" , toplabel ); - /* save old display */ - putprintf( " movl _display+%o,(fp)" , cbn * sizeof( int * ) ); - /* set up new display */ - putprintf( " movl fp,_display+%o" , cbn * sizeof( int * ) ); - /* 'allocate' local storage */ - putlbracket(); - #endif + + if (fp->class == PROG) { + + /* + + * The glorious buffers option. + + * 0 = don't buffer output + + * 1 = line buffer output + + * 2 = 512 byte buffer output + + */ + +# ifdef OBJ + + if (opt('b') != 1) - put1(O_BUFF | opt('b') << 8); - # endif - inp = 0; +++ put(1, O_BUFF | opt('b') << 8); +++# endif OBJ +++# ifdef PC +++ if ( opt( 'b' ) != 1 ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" ); +++ putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++# endif PC + + out = 0; + + for (p = fp->chain; p != NIL; p = p->chain) { + + if (strcmp(p->symbol, "input") == 0) { + + inp++; + + continue; + + } + + if (strcmp(p->symbol, "output") == 0) { + + out++; + + continue; + + } + + iop = lookup1(p->symbol); + + if (iop == NIL || bn != cbn) { + + error("File %s listed in program statement but not declared", p->symbol); + + continue; + + } + + if (iop->class != VAR) { + + error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]); + + continue; + + } + + if (iop->type == NIL) + + continue; + + if (iop->type->class != FILET) { + + error("File %s listed in program statement but defined as %s", + + p->symbol, nameof(iop->type)); + + continue; + + } + +# ifdef OBJ - put2(O_LV | bn << 9, iop->value[NL_OFFS]); - b = p->symbol; - while (b->pchar != '\0') - b++; - i = b - ( (int) p->symbol ); - put( 2 + (sizeof ( char * )/sizeof ( short )) - , O_CONG, i, p->symbol); - put2(O_DEFNAME | i << 8 - , text(iop->type) ? 0: width(iop->type->type)); - # endif +++ put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]); +++ i = lenstr(p->symbol,0); +++ put(2, O_LVCON, i); +++ putstr(p->symbol, 0); +++ do { +++ i--; +++ } while (p->symbol+i == 0); +++ put(2, O_CON24, i+1); +++ put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type)); +++ put(1, O_DEFNAME); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_DEFNAME" ); +++ putLV( p -> symbol , bn , iop -> value[NL_OFFS] +++ , p2type( iop ) ); +++ putCONG( p -> symbol , strlen( p -> symbol ) +++ , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , strlen( p -> symbol ) +++ , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON +++ , text(iop->type) ? 0 : width(iop->type->type) +++ , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++# endif PC + + } + + if (out == 0 && fp->chain != NIL) { + + recovered(); + + error("The file output must appear in the program statement file list"); + + } + + } + + /* + + * Process the prog/proc/func body + + */ + + noreach = 0; + + line = bundle[1]; + + statlist(blk); + +# ifdef PTREE + + { + + pPointer Body = tCopy( blk ); + + + + pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body; + + } - # endif +++# endif PTREE + +# ifdef OBJ + + if (cbn== 1 && monflg != 0) { - patchfil(cntpatch, cnts, 1); - patchfil(nfppatch, pfcnt, 1); +++ patchfil(cntpatch - 2, cnts, 2); +++ patchfil(nfppatch - 2, pfcnt, 2); +++ } +++# endif OBJ +++# ifdef PC +++ if ( fp -> class == PROG && monflg ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PMFLUSH" ); +++ putleaf( P2ICON , cnts , 0 , P2INT , 0 ); +++ putleaf( P2ICON , pfcnt , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); + + } - # endif +++# endif PC + + if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) { + + recovered(); + + error("Input is used but not defined in the program statement"); + + } + + /* + + * Clean up the symbol table displays and check for unresolves + + */ + + line = endline; + + b = cbn; + + Fp = fp; + + chkref = syneflg == errcnt[cbn] && opt('w') == 0; + + for (i = 0; i <= 077; i++) { + + for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { + + /* + + * Check for variables defined + + * but not referenced + + */ + + if (chkref && p->symbol != NIL) + + switch (p->class) { + + case FIELD: + + /* + + * If the corresponding record is + + * unused, we shouldn't complain about + + * the fields. + + */ + + default: + + if ((p->nl_flags & (NUSED|NMOD)) == 0) { + + warning(); + + nerror("%s %s is neither used nor set", classes[p->class], p->symbol); + + break; + + } + + /* + + * If a var parameter is either + + * modified or used that is enough. + + */ + + if (p->class == REF) + + continue; - if ((p->nl_flags & NUSED) == 0) { +++# ifdef OBJ +++ if ((p->nl_flags & NUSED) == 0) { + + warning(); + + nerror("%s %s is never used", classes[p->class], p->symbol); + + break; - } +++ } +++# endif OBJ +++# ifdef PC +++ if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) { +++ warning(); +++ nerror("%s %s is never used", classes[p->class], p->symbol); +++ break; +++ } +++# endif PC + + if ((p->nl_flags & NMOD) == 0) { + + warning(); + + nerror("%s %s is used but never set", classes[p->class], p->symbol); + + break; + + } + + case LABEL: + + case FVAR: + + case BADUSE: + + break; + + } + + switch (p->class) { + + case BADUSE: + + cp = "s"; + + if (p->chain->ud_next == NIL) + + cp++; + + eholdnl(); + + if (p->value[NL_KINDS] & ISUNDEF) + + nerror("%s undefined on line%s", p->symbol, cp); + + else + + nerror("%s improperly used on line%s", p->symbol, cp); + + pnumcnt = 10; + + pnums(p->chain); + + pchr('\n'); + + break; + + + + case FUNC: + + case PROC: - if (p->nl_flags & NFORWD) +++# ifdef OBJ +++ if ((p->nl_flags & NFORWD)) +++ nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); +++# endif OBJ +++# ifdef PC +++ if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) + + nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); +++# endif PC + + break; + + + + case LABEL: + + if (p->nl_flags & NFORWD) + + nerror("label %s was declared but not defined", p->symbol); + + break; + + case FVAR: + + if ((p->nl_flags & NMOD) == 0) + + nerror("No assignment to the function variable"); + + break; + + } + + } + + /* + + * Pop this symbol + + * table slot + + */ + + disptab[i] = p; + + } + + + +# ifdef OBJ - put1(O_END); - # endif - # ifdef PPC - putprintf( " movl (fp),_display+%o" - , cbn * sizeof( int * ) ); - puttext( " ret" ); - putprintf( "B%d:" , botlabel ); - putprintf( " subl2 $.F%d,sp" , ftnno ); - putrbracket(); - putprintf( " jbr T%d" , toplabel ); - if ( fp -> class == PROG ) - puteof(); - # endif +++ put(1, O_END); +++# endif OBJ +++# ifdef PC +++ /* +++ * if there were file variables declared at this level +++ * call pclose( &__disply[ cbn ] ) to clean them up. +++ */ +++ if ( dfiles[ cbn ] ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PCLOSE" ); +++ putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave ) +++ , P2PTR | P2CHAR ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ /* +++ * if this is a function, +++ * the function variable is the return value. +++ * if it's a scalar valued function, return scalar, +++ * else, return a pointer to the structure value. +++ */ +++ if ( fp -> class == FUNC ) { +++ struct nl *fvar = fp -> ptr[ NL_FVAR ]; +++ long fvartype = p2type( fvar -> type ); +++ long label; +++ char labelname[ BUFSIZ ]; +++ +++ switch ( classify( fvar -> type ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ case TDOUBLE: +++ case TPTR: +++ putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 +++ , fvar -> value[ NL_OFFS ] , fvartype ); +++ break; +++ default: +++ label = getlab(); +++ sprintf( labelname , PREFIXFORMAT , +++ LABELPREFIX , label ); +++ putprintf( " .data" , 0 ); +++ putprintf( " .lcomm %s,%d" , 0 , +++ labelname , lwidth( fvar -> type ) ); +++ putprintf( " .text" , 0 ); +++ putleaf( P2NAME , 0 , 0 , fvartype , labelname ); +++ putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 +++ , fvar -> value[ NL_OFFS ] , fvartype ); +++ putstrop( P2STASG , fvartype , lwidth( fvar -> type ) , +++ align( fvar -> type ) ); +++ putdot( filename , line ); +++ putleaf( P2ICON , 0 , 0 , fvartype , labelname ); +++ break; +++ } +++ putop( P2FORCE , fvartype ); +++ putdot( filename , line ); +++ } +++ /* +++ * restore old display entry from save area +++ */ +++ +++ putprintf( " movq %d(%s),%s+%d" , 0 +++ , DSAVEOFFSET , P2FPNAME +++ , DISPLAYNAME , cbn * sizeof(struct dispsave) ); +++ stabrbrac( cbn ); +++ putprintf( " ret" , 0 ); +++ /* +++ * let the second pass allocate locals +++ */ +++ putlab( botlabel ); +++ putprintf( " subl2 $LF%d,sp" , 0 , ftnno ); +++ putrbracket( ftnno ); +++ putjbr( toplabel ); +++ /* +++ * declare pcp counters, if any +++ */ +++ if ( monflg && fp -> class == PROG ) { +++ putprintf( " .data" , 0 ); +++ putprintf( " .comm " , 1 ); +++ putprintf( PCPCOUNT , 1 ); +++ putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) ); +++ putprintf( " .text" , 0 ); +++ } +++# endif PC + +#ifdef DEBUG + + dumpnl(fp->ptr[2], fp->symbol); + +#endif + + /* + + * Restore the + + * (virtual) name list + + * position + + */ + + nlfree(fp->ptr[2]); + + /* + + * Proc/func has been + + * resolved + + */ + + fp->nl_flags &= ~NFORWD; + + /* + + * Patch the beg + + * of the proc/func to + + * the proper variable size + + */ - i = sizes[cbn].om_max; - # ifdef PDP11 - # define TOOMUCH -50000. - # endif - # ifdef VAX - # define TOOMUCH -32767. - # endif - if (sizes[cbn].om_max < TOOMUCH) - nerror("Storage requirement of %ld bytes exceeds hardware capacity", -sizes[cbn].om_max); + + if (Fp == NIL) + + elineon(); + +# ifdef OBJ - patchfil(var, i, 1); - # endif +++ patchfil(var, sizes[cbn].om_max, 2); +++# endif OBJ + + cbn--; + + if (inpflist(fp->symbol)) { + + opop('l'); + + } + +} + + +++ +++/* +++ * Segend is called to check for +++ * unresolved variables, funcs and +++ * procs, and deliver unresolved and +++ * baduse error diagnostics at the +++ * end of a routine segment (a separately +++ * compiled segment that is not the +++ * main program) for PC. This +++ * routine should only be called +++ * by PC (not standard). +++ */ +++ segend() +++ { +++ register struct nl *p; +++ register int i,b; +++ char *cp; +++ +++#ifdef PC +++ if (opt('s')) { +++ standard(); +++ error("Separately compiled routine segments are not standard."); +++ } else { +++ b = cbn; +++ for (i=0; i<077; i++) { +++ for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { +++ switch (p->class) { +++ case BADUSE: +++ cp = 's'; +++ if (p->chain->ud_next == NIL) +++ cp++; +++ eholdnl(); +++ if (p->value[NL_KINDS] & ISUNDEF) +++ nerror("%s undefined on line%s", p->symbol, cp); +++ else +++ nerror("%s improperly used on line%s", p->symbol, cp); +++ pnumcnt = 10; +++ pnums(p->chain); +++ pchr('\n'); +++ break; +++ +++ case FUNC: +++ case PROC: +++ if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) +++ nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); +++ break; +++ +++ case FVAR: +++ if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) +++ nerror("No assignment to the function variable"); +++ break; +++ } +++ } +++ disptab[i] = p; +++ } +++ } +++#endif PC +++#ifdef OBJ +++ error("Missing program statement and program body"); +++#endif OBJ +++ +++} +++ +++ +++/* +++ * Level1 does level one processing for +++ * separately compiled routine segments +++ */ +++level1() +++{ +++ +++# ifdef OBJ +++ error("Missing program statement"); +++# endif OBJ +++# ifdef PC +++ if (opt('s')) { +++ standard(); +++ error("Missing program statement"); +++ } +++# endif PC +++ +++ cbn++; +++ sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; +++ gotos[cbn] = NIL; +++ errcnt[cbn] = syneflg; +++ parts[ cbn ] = NIL; +++ dfiles[ cbn ] = FALSE; +++ progseen++; +++} +++ +++ +++ + +pnums(p) + + struct udinfo *p; + +{ + + + + if (p->ud_next != NIL) + + pnums(p->ud_next); + + if (pnumcnt == 0) { + + printf("\n\t"); + + pnumcnt = 20; + + } + + pnumcnt--; + + printf(" %d", p->ud_line); + +} + + + +nerror(a1, a2, a3) + +{ + + + + if (Fp != NIL) { + + yySsync(); + +#ifndef PI1 + + if (opt('l')) + + yyoutline(); + +#endif + + yysetfile(filename); + + printf("In %s %s:\n", classes[Fp->class], Fp->symbol); + + Fp = NIL; + + elineoff(); + + } + + error(a1, a2, a3); + +} diff --cc usr/src/cmd/pi/flvalue.c index 0000000000,0000000000,0000000000..0e5f4e23a0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/flvalue.c @@@@ -1,0 -1,0 -1,0 +1,133 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)flvalue.c 1.2 10/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC +++#ifdef OBJ +++/* +++ * define the display structure for purposes of allocating +++ * a temporary +++ */ +++struct dispsave { +++ char *ptr; +++}; +++#endif OBJ +++ +++ /* +++ * flvalue generates the code to either pass on a formal routine, +++ * or construct the structure which is the environment for passing. +++ * it tells the difference by looking at the tree it's given. +++ */ +++struct nl * +++flvalue( r , formalp ) +++ int *r; +++ struct nl *formalp; +++ { +++ struct nl *p; +++ long tempoff; +++ char *typename; +++ +++ if ( r == NIL ) { +++ return NIL; +++ } +++ typename = formalp -> class == FFUNC ? "function":"procedure"; +++ if ( r[0] != T_VAR ) { +++ error("Expression given, %s required for %s parameter %s" , +++ typename , typename , formalp -> symbol ); +++ return NIL; +++ } +++ p = lookup(r[2]); +++ if (p == NIL) { +++ return NIL; +++ } +++ switch ( p -> class ) { +++ case FFUNC: +++ case FPROC: +++ if ( r[3] != NIL ) { +++ error("Formal %s %s cannot be qualified" , +++ typename , p -> symbol ); +++ return NIL; +++ } +++# ifdef OBJ +++ put( 2 , PTR_RV | bn << 8+INDX , p -> value[NL_OFFS] ); +++# endif OBJ +++# ifdef PC +++ putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , +++ p2type( p ) ); +++# endif PC +++ return p -> type; +++ case FUNC: +++ case PROC: +++ if ( r[3] != NIL ) { +++ error("%s %s cannot be qualified" , typename , +++ p -> symbol ); +++ return NIL; +++ } +++ if (bn == 0) { +++ error("Built-in %s %s cannot be passed as a parameter" , +++ typename , p -> symbol ); +++ return NIL; +++ } +++ /* +++ * formal routine structure: +++ * +++ * struct formalrtn { +++ * long (*entryaddr)(); +++ * long cbn; +++ * struct dispsave disp[2*MAXLVL]; +++ * }; +++ */ +++ sizes[ cbn ].om_off -= sizeof (long (*)()) +++ + sizeof (long) +++ + 2*bn*sizeof (struct dispsave); +++ tempoff = sizes[ cbn ].om_off; +++ if ( sizes[ cbn ].om_off < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++# ifdef OBJ +++ put( 2 , O_LV | cbn << 8 + INDX , tempoff ); +++ put( 2 , O_FSAV | bn << 8 + INDX , p -> entloc ); +++# endif OBJ +++# ifdef PC +++ putlbracket( ftnno , -tempoff ); +++ putleaf( P2ICON , 0 , 0 , +++ ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , +++ "_FSAV" ); +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < bn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "flvalue namelength" ); +++ } +++ putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); +++ } +++ putleaf( P2ICON , bn , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putLV( 0 , cbn , tempoff , P2STRTY ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2PTR | P2STRTY ); +++# endif PC +++ return p -> type; +++ default: +++ error("Variable given, %s required for %s parameter %s" , +++ typename , typename , formalp -> symbol ); +++ return NIL; +++ } +++ } diff --cc usr/src/cmd/pi/func.c index 0000000000,3fffbdaa39,0000000000..c99b600ed3 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/func.c +++ b/usr/src/cmd/pi/func.c @@@@ -1,0 -1,237 -1,0 +1,230 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)func.c 1.3 10/19/80"; +++ +++#include "whoami.h" +++#ifdef OBJ +++ /* +++ * the rest of the file +++ */ + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" + + + +/* + + * Funccod generates code for + + * built in function calls and calls + + * call to generate calls to user + + * defined functions and procedures. + + */ + +funccod(r) + + int *r; + +{ + + struct nl *p; + + register struct nl *p1; + + register int *al; + + register op; + + int argc, *argv; + + int tr[2], tr2[4]; + + + + /* + + * Verify that the given name + + * is defined and the name of + + * a function. + + */ + + p = lookup(r[2]); + + if (p == NIL) { + + rvlist(r[3]); + + return (NIL); + + } - if (p->class != FUNC) { +++ if (p->class != FUNC && p->class != FFUNC) { + + error("%s is not a function", p->symbol); + + rvlist(r[3]); + + return (NIL); + + } + + argv = r[3]; + + /* + + * Call handles user defined + + * procedures and functions + + */ + + if (bn != 0) + + return (call(p, argv, FUNC, bn)); + + /* + + * Count the arguments + + */ + + argc = 0; + + for (al = argv; al != NIL; al = al[2]) + + argc++; + + /* + + * Built-in functions have + + * their interpreter opcode + + * associated with them. + + */ + + op = p->value[0] &~ NSTAND; + + if (opt('s') && (p->value[0] & NSTAND)) { + + standard(); + + error("%s is a nonstandard function", p->symbol); + + } + + switch (op) { + + /* + + * Parameterless functions + + */ + + case O_CLCK: + + case O_SCLCK: + + case O_WCLCK: + + case O_ARGC: + + if (argc != 0) { + + error("%s takes no arguments", p->symbol); + + rvlist(argv); + + return (NIL); + + } + + put1(op); + + return (nl+T4INT); + + case O_EOF: + + case O_EOLN: + + if (argc == 0) { + + argv = tr; + + tr[1] = tr2; + + tr2[0] = T_VAR; + + tr2[2] = input->symbol; + + tr2[1] = tr2[3] = NIL; + + argc = 1; + + } else if (argc != 1) { + + error("%s takes either zero or one argument", p->symbol); + + rvlist(argv); + + return (NIL); + + } + + } + + /* + + * All other functions take + + * exactly one argument. + + */ + + if (argc != 1) { + + error("%s takes exactly one argument", p->symbol); + + rvlist(argv); + + return (NIL); + + } + + /* + + * Evaluate the argmument + + */ - p1 = rvalue((int *) argv[1], NLNIL); +++ p1 = stkrval((int *) argv[1], NLNIL , RREQ ); + + if (p1 == NIL) + + return (NIL); + + switch (op) { + + case O_EXP: + + case O_SIN: + + case O_COS: + + case O_ATAN: + + case O_LN: + + case O_SQRT: + + case O_RANDOM: + + case O_EXPO: + + case O_UNDEF: + + if (isa(p1, "i")) + + convert(p1, nl+TDOUBLE); + + else if (isnta(p1, "d")) { + + error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); + + return (NIL); + + } + + put1(op); + + if (op == O_UNDEF) + + return (nl+TBOOL); + + else if (op == O_EXPO) + + return (nl+T4INT); + + else + + return (nl+TDOUBLE); + + case O_SEED: + + if (isnta(p1, "i")) { + + error("seed's argument must be an integer, not %s", nameof(p1)); + + return (NIL); + + } - convert(p1, nl+T4INT); + + put1(op); + + return (nl+T4INT); + + case O_ROUND: + + case O_TRUNC: + + if (isnta(p1, "d")) { + + error("%s's argument must be a real, not %s", p->symbol, nameof(p1)); + + return (NIL); + + } + + put1(op); + + return (nl+T4INT); + + case O_ABS2: + + case O_SQR2: + + if (isa(p1, "d")) { + + put1(op + O_ABS8-O_ABS2); + + return (nl+TDOUBLE); + + } + + if (isa(p1, "i")) { + + put1(op + (width(p1) >> 2)); + + return (nl+T4INT); + + } + + error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1)); + + return (NIL); + + case O_ORD2: - if (isa(p1, "bcis") || classify(p1) == TPTR) - switch (width(p1)) { - case 1: - return (nl+T1INT); - case 2: - return (nl+T2INT); - case 4: - return (nl+T4INT); - } +++ if (isa(p1, "bcis") || classify(p1) == TPTR) { +++ return (nl+T4INT); +++ } + + error("ord's argument must be of scalar type or a pointer, not %s", nameof(p1)); + + return (NIL); + + case O_SUCC2: + + case O_PRED2: + + if (isa(p1, "bcs")) { + + put1(op); + + return (p1); + + } + + if (isa(p1, "i")) { + + if (width(p1) <= 2) + + op += O_PRED24-O_PRED2; + + else + + op++; + + put1(op); + + return (nl+T4INT); + + } + + if (isa(p1, "id")) { + + error("%s is forbidden for reals", p->symbol); + + return (NIL); + + } + + error("%s's argument must be of scalar type, not %s", p->symbol, nameof(p1)); + + return (NIL); + + case O_ODD2: + + if (isnta(p1, "i")) { + + error("odd's argument must be an integer, not %s", nameof(p1)); + + return (NIL); + + } + + put1(op + (width(p1) >> 2)); + + return (nl+TBOOL); + + case O_CHR2: + + if (isnta(p1, "i")) { + + error("chr's argument must be an integer, not %s", nameof(p1)); + + return (NIL); + + } + + put1(op + (width(p1) >> 2)); + + return (nl+TCHAR); + + case O_CARD: + + if (isnta(p1, "t")) { - error("Argument to card must be a set, not %s", nameof(p1)); - return (NIL); +++ error("Argument to card must be a set, not %s", nameof(p1)); +++ return (NIL); + + } + + put2(O_CARD, width(p1)); + + return (nl+T2INT); + + case O_EOLN: + + if (!text(p1)) { + + error("Argument to eoln must be a text file, not %s", nameof(p1)); + + return (NIL); + + } + + put1(op); + + return (nl+TBOOL); + + case O_EOF: + + if (p1->class != FILET) { + + error("Argument to eof must be file, not %s", nameof(p1)); + + return (NIL); + + } + + put1(op); + + return (nl+TBOOL); + + case 0: + + error("%s is an unimplemented 6000-3.4 extension", p->symbol); + + default: + + panic("func1"); + + } + +} +++#endif OBJ diff --cc usr/src/cmd/pi/gen.c index 0000000000,957d5e97be,0000000000..21c07d7844 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/gen.c +++ b/usr/src/cmd/pi/gen.c @@@@ -1,0 -1,214 -1,0 +1,216 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)gen.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#ifdef OBJ +++ /* +++ * and the rest of the file +++ */ + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" + + + +/* + + * This array tells the type + + * returned by an arithmetic + + * operation. It is indexed + + * by the logarithm of the + + * lengths base 2. + + */ + +#ifndef DEBUG + +char arret[] = { + + T4INT, T4INT, T4INT, TDOUBLE, + + T4INT, T4INT, T4INT, TDOUBLE, + + T4INT, T4INT, T4INT, TDOUBLE, + + TDOUBLE, TDOUBLE, TDOUBLE, TDOUBLE + +}; + +#else + +char arret0[] = { + + T4INT, T4INT, T4INT, TDOUBLE, + + T4INT, T4INT, T4INT, TDOUBLE, + + T4INT, T4INT, T4INT, TDOUBLE, + + TDOUBLE, TDOUBLE, TDOUBLE, TDOUBLE + +}; + +char arret1[] = { + + T4INT, T4INT, T4INT, TDOUBLE, + + T4INT, T4INT, T4INT, TDOUBLE, + + T4INT, T4INT, T4INT, TDOUBLE, + + TDOUBLE, TDOUBLE, TDOUBLE, TDOUBLE + +}; + +char *arret = arret0; + +#endif + + + +/* + + * These array of arithmetic and set + + * operators are indexed by the + + * tree nodes and is highly dependent + + * on their order. They thus take + + * on the flavor of magic. + + */ + +int arop[] = { + + 0, O_NEG2, O_MOD2, O_DIV2, O_DVD2, O_MUL2, O_ADD2, O_SUB2, + + O_REL2, O_REL2, O_REL2, O_REL2, O_REL2, O_REL2 + +}; + +int setop[] = { + + O_MULT, O_ADDT, O_SUBT, + + O_RELT, O_RELT, O_RELT, O_RELT, O_RELT, O_RELT, + +}; + + + +/* + + * The following array is + + * used when operating on + + * two reals since they are + + * shoved off in a corner in + + * the interpreter table. + + */ + +int ar8op[] = { + + O_DVD8, O_MUL8, O_ADD8, O_SUB8, + + O_REL8, O_REL8, O_REL8, O_REL8, O_REL8, O_REL8, + +}; + + + +/* + + * The following arrays, which are linearizations + + * of two dimensional arrays, are the offsets for + + * arithmetic, relational and assignment operations + + * indexed by the logarithms of the argument widths. + + */ + +#ifndef DEBUG + +char artab[] = { + + O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, + + O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, + + O_ADD24-O_ADD2, O_ADD24-O_ADD2, O_ADD4-O_ADD2, O_ADD84-O_ADD2, + + O_ADD28-O_ADD2, O_ADD28-O_ADD2, O_ADD48-O_ADD2, -1 + +}; + +#else + +char artab0[] = { + + O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, + + O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD42-O_ADD2, O_ADD82-O_ADD2, + + O_ADD24-O_ADD2, O_ADD24-O_ADD2, O_ADD4-O_ADD2, O_ADD84-O_ADD2, + + O_ADD28-O_ADD2, O_ADD28-O_ADD2, O_ADD48-O_ADD2, -1 + +}; + +char artab1[] = { + + O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD82-O_ADD2, + + O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD82-O_ADD2, + + O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD2-O_ADD2, O_ADD84-O_ADD2, + + O_ADD28-O_ADD2, O_ADD28-O_ADD2, O_ADD28-O_ADD2, -1 + +}; + +char *artab = artab0; + +#endif + +#ifndef DEBUG + +char reltab[] = { + + O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, + + O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, + + O_REL24-O_REL2, O_REL24-O_REL2, O_REL4-O_REL2, O_REL84-O_REL2, + + O_REL28-O_REL2, O_REL28-O_REL2, O_REL48-O_REL2, O_REL8-O_REL2 + +}; + +#else + +char reltab0[] = { + + O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, + + O_REL2-O_REL2, O_REL2-O_REL2, O_REL42-O_REL2, O_REL82-O_REL2, + + O_REL24-O_REL2, O_REL24-O_REL2, O_REL4-O_REL2, O_REL84-O_REL2, + + O_REL28-O_REL2, O_REL28-O_REL2, O_REL48-O_REL2, O_REL8-O_REL2 + +}; + +char reltab1[] = { + + O_REL2-O_REL2, O_REL2-O_REL2, O_REL2-O_REL2, O_REL82-O_REL2, + + O_REL2-O_REL2, O_REL2-O_REL2, O_REL2-O_REL2, O_REL82-O_REL2, + + O_REL2-O_REL2, O_REL2-O_REL2, O_REL2-O_REL2, O_REL82-O_REL2, + + O_REL28-O_REL2, O_REL28-O_REL2, O_REL28-O_REL2, O_REL8-O_REL2 + +}; + +char *reltab = reltab0; + +#endif + + + +#ifndef DEBUG + +char asgntab[] = { + + O_AS21-O_AS2, O_AS21-O_AS2, O_AS41-O_AS2, -1, + + O_AS2-O_AS2, O_AS2-O_AS2, O_AS42-O_AS2, -1, + + O_AS24-O_AS2, O_AS24-O_AS2, O_AS4-O_AS2, -1, + + O_AS28-O_AS2, O_AS28-O_AS2, O_AS48-O_AS2, O_AS8-O_AS2, + +}; + +#else + +char asgntb0[] = { + + O_AS21-O_AS2, O_AS21-O_AS2, O_AS41-O_AS2, -1, + + O_AS2-O_AS2, O_AS2-O_AS2, O_AS42-O_AS2, -1, + + O_AS24-O_AS2, O_AS24-O_AS2, O_AS4-O_AS2, -1, + + O_AS28-O_AS2, O_AS28-O_AS2, O_AS48-O_AS2, O_AS8-O_AS2, + +}; + +char asgntb1[] = { + + O_AS21-O_AS2, O_AS21-O_AS2, O_AS21-O_AS2, -1, + + O_AS2-O_AS2, O_AS2-O_AS2, O_AS2-O_AS2, -1, + + O_AS2-O_AS2, O_AS2-O_AS2, O_AS2-O_AS2, -1, + + O_AS28-O_AS2, O_AS28-O_AS2, O_AS28-O_AS2, O_AS4-O_AS2, + +}; + +char *asgntab = asgntb0; + +#endif + + + +#ifdef DEBUG + +genmx() + +{ + + + + arret = arret1; + + artab = artab1; + + reltab = reltab1; + + asgntab = asgntb1; + +} + +#endif + + + +/* + + * Gen generates code for assignments, + + * and arithmetic and string operations + + * and comparisons. + + */ + +struct nl * + +gen(p, o, w1, w2) + + int p, o, w1, w2; + +{ + + register i, j; + + int op, off; + + + + switch (p) { + + case O_AS2: + + case NIL: + + i = j = -1; + + /* + + * Take the log2 of the widths + + * and linearize them for indexing. + + * width for indexing. + + */ + +#ifdef DEBUG + + if (hp21mx) { + + if (w1 == 4) + + w1 = 8; + + if (w2 == 4) + + w2 = 8; + + } + +#endif + + do i++; while (w1 >>= 1); + + do j++; while (w2 >>= 1); + + i <<= 2; + + i |= j; + + if (p == O_AS2) { + + put1(O_AS2 + asgntab[i]); + + return (NIL); + + } + + op = arop[o]; + + if (op == O_REL2) { - put1((op + reltab[i]) | (o - T_EQ) << 9); +++ put1((op + reltab[i]) | (o - T_EQ) << 8+INDX); + + return (nl+TBOOL); + + } + + put1(i == 15 ? ar8op[o-T_DIVD] : op | artab[i]); + + return (op == O_DVD2 && !divchk ? nl+TDOUBLE : nl+arret[i]); +++ case TREC: + + case TSTR: - put2(O_RELG | (o - T_EQ) << 9, w1); +++ put2(O_RELG | (o - T_EQ) << 8+INDX, w1); + + return (nl+TBOOL); + + case TSET: + + op = setop[o-T_MULT]; + + if (op == O_RELT) - op |= (o - T_EQ)<<9; +++ op |= (o - T_EQ)<<8+INDX; + + put2(op, w1); + + return (o >= T_EQ ? nl+TBOOL : nl+TSET); + + default: + + panic("gen"); + + } + +} +++#endif OBJ diff --cc usr/src/cmd/pi/gram index 0000000000,0000000000,0000000000..c5d5aa633d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/gram @@@@ -1,0 -1,0 -1,0 +1,45 @@@@ +++"@(#)gram 1.3 8/27/80" +++/yyval/s//*&/ +++/\*yysterm\[]/,$d +++1;/yyactr/ka +++'a,$s/yypv/yyYpv/g +++'aa +++ register int **yyYpv; +++ register int *p, *q; +++ yyYpv = yypv; +++. +++1;/^##/-w! y.tab.h +++/^int yylval 0/d +++/extern int yychar,/s//extern/ +++/yyclearin/d +++/yyerrok/d +++1;/^##/d +++$a +++ +++yyEactr(__np__, var) +++int __np__; +++char *var; +++{ +++switch(__np__) { +++default: +++return (1); +++. +++g/case.*@@/s/@@//\ +++.m$ +++g/@@/ka\ +++'a;?case?,?case?t$\ +++'am$\ +++a\ +++}\ +++break; +++$a +++} +++} +++. +++1,$s/@@// +++/int nterms/d +++/int nnonter/d +++/int nstate/d +++/int yyerrval/d +++w! +++q diff --cc usr/src/cmd/pi/hash.c index 0000000000,daea706399,0000000000..3420bec0f7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/hash.c +++ b/usr/src/cmd/pi/hash.c @@@@ -1,0 -1,190 -1,0 +1,180 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)hash.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * The definition for the segmented hash tables. + + */ + +struct ht { + + int *ht_low; + + int *ht_high; + + int ht_used; + +} htab[MAXHASH]; + + + +/* + + * This is the array of keywords and their + + * token values, which are hashed into the table + + * by inithash. + + */ + +struct kwtab yykey[] = { + + "and", YAND, + + "array", YARRAY, + + "assert", YASSERT, + + "begin", YBEGIN, + + "case", YCASE, + + "const", YCONST, + + "div", YDIV, + + "do", YDO, + + "downto", YDOWNTO, + + "else", YELSE, + + "end", YEND, + + "file", YFILE, + + "for", YFOR, + + "forward", YFORWARD, + + "function", YFUNCTION, + + "goto", YGOTO, + + "if", YIF, + + "in", YIN, + + "label", YLABEL, + + "mod", YMOD, + + "nil", YNIL, + + "not", YNOT, + + "of", YOF, + + "or", YOR, + + "packed", YPACKED, + + "procedure", YPROCEDURE, + + "program", YPROG, + + "record", YRECORD, + + "repeat", YREPEAT, + + "set", YSET, + + "then", YTHEN, + + "to", YTO, + + "type", YTYPE, + + "until", YUNTIL, + + "var", YVAR, + + "while", YWHILE, + + "with", YWITH, + + "oct", YOCT, /* non-standard Pascal */ + + "hex", YHEX, /* non-standard Pascal */ +++ "external", YEXTERN, /* non-standard Pascal */ + + 0 + +}; + + + +char *lastkey = &yykey[sizeof yykey/sizeof yykey[0]]; + + + +/* + + * Inithash initializes the hash table routines + + * by allocating the first hash table segment using + + * an already existing memory slot. + + */ + +#ifndef PI0 + +inithash() + +#else + +inithash(hshtab) + + int *hshtab; + +#endif + +{ + + register int *ip; + +#ifndef PI0 + + static int hshtab[HASHINC]; + +#endif + + + + htab[0].ht_low = hshtab; + + htab[0].ht_high = &hshtab[HASHINC]; + + for (ip = yykey; *ip; ip += 2) + + hash(ip[0], 0)[0] = ip; + +} + + + +/* + + * Hash looks up the s(ymbol) argument + + * in the string table, entering it if + + * it is not found. If save is 0, then + + * the argument string is already in + + * a safe place. Otherwise, if hash is + + * entering the symbol for the first time + + * it will save the symbol in the string + + * table using savestr. + + */ + +int *hash(s, save) + + char *s; + + int save; + +{ + + register int *h; + + register i; + + register char *cp; + + int *sym; + + struct ht *htp; + + int sh; + + + + /* + + * The hash function is a modular hash of + + * the sum of the characters with the sum + + * doubled before each successive character + + * is added. + + */ + + cp = s; + + if (cp == NIL) + + cp = token; /* default symbol to be hashed */ + + i = 0; + + while (*cp) + + i = i*2 + *cp++; + + sh = (i&077777) % HASHINC; + + cp = s; + + if (cp == NIL) + + cp = token; + + /* + + * There are as many as MAXHASH active + + * hash tables at any given point in time. + + * The search starts with the first table + + * and continues through the active tables + + * as necessary. + + */ + + for (htp = htab; htp < &htab[MAXHASH]; htp++) { + + if (htp->ht_low == NIL) { + + cp = (char *) calloc(sizeof ( int * ), HASHINC); + + if (cp == -1) { + + yerror("Ran out of memory (hash)"); + + pexit(DIED); + + } + + htp->ht_low = cp; + + htp->ht_high = htp->ht_low + HASHINC; + + cp = s; + + if (cp == NIL) + + cp = token; + + } + + h = htp->ht_low + sh; + + /* + + * quadratic rehash increment + + * starts at 1 and incremented + + * by two each rehash. + + */ + + i = 1; + + do { + + if (*h == 0) { + + if (htp->ht_used > (HASHINC * 3)/4) + + break; + + htp->ht_used++; + + if (save != 0) { + + *h = (int) savestr(cp); + + } else + + *h = s; + + return (h); + + } + + sym = *h; + + if (sym < lastkey && sym >= yykey) + + sym = *sym; + + if (sym->pchar == *cp && strcmp(sym, cp) == 0) + + return (h); + + h += i; + + i += 2; + + if (h >= htp->ht_high) + + h -= HASHINC; + + } while (i < HASHINC); + + } + + yerror("Ran out of hash tables"); + + pexit(DIED); + +} diff --cc usr/src/cmd/pi/iorec.h index 0000000000,0000000000,0000000000..975a158eb6 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/iorec.h @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)iorec.h 1.1 8/27/80"; */ +++ +++#include +++#define NAMSIZ 76 +++ +++struct iorec { +++ char *fileptr; /* ptr to file window */ +++ long lcount; /* number of lines printed */ +++ long llimit; /* maximum number of text lines */ +++ FILE *fbuf; /* FILE ptr */ +++ struct iorec *fchain; /* chain to next file */ +++ long *flev; /* ptr to associated file variable */ +++ char *pfname; /* ptr to name of file */ +++ long funit; /* file status flags */ +++ long size; /* size of elements in the file */ +++ char fname[NAMSIZ]; /* name of associated UNIX file */ +++ char buf[BUFSIZ]; /* I/O buffer */ +++ char window[1]; /* file window element */ +++}; diff --cc usr/src/cmd/pi/lab.c index 0000000000,6427abcfef,0000000000..3fe3baeaa8 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/lab.c +++ b/usr/src/cmd/pi/lab.c @@@@ -1,0 -1,133 -1,0 +1,233 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)lab.c 1.5 10/14/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC + + + +/* + + * Label enters the definitions + + * of the label declaration part + + * into the namelist. + + */ + +label(r, l) + + int *r, l; + +{ + +#ifndef PI0 + + register *ll; + + register struct nl *p, *lp; + + + + lp = NIL; + +#else + + send(REVLAB, r); + +#endif +++ if ( ! progseen ) { +++ level1(); +++ } + + line = l; + +#ifndef PI1 - if (parts & (CPRT|TPRT|VPRT)) - error("Label declarations must precede const, type and var declarations"); - if (parts & LPRT) - error("All labels must be declared in one label part"); - parts |= LPRT; +++ if (parts[ cbn ] & (CPRT|TPRT|VPRT|RPRT)){ +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Label declarations should precede const, type, var and routine declarations"); +++ } +++ if (parts[ cbn ] & LPRT) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All labels should be declared in one label part"); +++ } +++ parts[ cbn ] |= LPRT; + +#endif + +#ifndef PI0 + + for (ll = r; ll != NIL; ll = ll[2]) { + + l = getlab(); + + p = enter(defnl(ll[1], LABEL, 0, l)); + + /* + + * Get the label for the eventual target + + */ + + p->value[1] = getlab(); + + p->chain = lp; + + p->nl_flags |= (NFORWD|NMOD); + + p->value[NL_GOLEV] = NOTYET; + + p->entloc = l; + + lp = p; - /* - * This operator is between - * the bodies of two procedures - * and provides a target for - * gotos for this label via TRA. - */ - putlab(l); - put2(O_GOTO | cbn<<9, p->value[1]); +++# ifdef OBJ +++ /* +++ * This operator is between +++ * the bodies of two procedures +++ * and provides a target for +++ * gotos for this label via TRA. +++ */ +++ putlab(l); +++ put2(O_GOTO | cbn<<8+INDX, p->value[1]); +++# endif OBJ +++# ifdef PC +++ /* +++ * labels have to be .globl otherwise /lib/c2 may +++ * throw them away if they aren't used in the function +++ * which defines them. +++ */ +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < cbn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "lab decl namelength" ); +++ } +++ putprintf( " .globl " , 1 ); +++ putprintf( NAMEFORMAT , 0 , extname ); +++ if ( cbn == 1 ) { +++ stabglabel( extname , line ); +++ } +++ } +++# endif PC + + } + + gotos[cbn] = lp; + +# ifdef PTREE + + { + + pPointer Labels = LabelDCopy( r ); + + + + pDEF( PorFHeader[ nesting ] ).PorFLabels = Labels; + + } - # endif +++# endif PTREE + +#endif + +} + + + +#ifndef PI0 + +/* + + * Gotoop is called when + + * we get a statement "goto label" + + * and generates the needed tra. + + */ + +gotoop(s) + + char *s; + +{ + + register struct nl *p; + + + + gocnt++; + + p = lookup(s); + + if (p == NIL) + + return (NIL); - put2(O_TRA4, p->entloc); +++# ifdef OBJ +++ put2(O_TRA4, p->entloc); +++# endif OBJ +++# ifdef PC +++ if ( cbn != bn ) { +++ /* +++ * call goto to unwind the stack to the destination level +++ */ +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_GOTO" ); +++ putLV( DISPLAYNAME , 0 , bn * sizeof( struct dispsave ) +++ , P2PTR | P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < bn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "goto namelength" ); +++ } +++ putprintf( " jbr " , 1 ); +++ putprintf( NAMEFORMAT , 0 , extname ); +++ } +++# endif PC + + if (bn == cbn) + + if (p->nl_flags & NFORWD) { + + if (p->value[NL_GOLEV] == NOTYET) { + + p->value[NL_GOLEV] = level; + + p->value[NL_GOLINE] = line; + + } + + } else + + if (p->value[NL_GOLEV] == DEAD) { + + recovered(); + + error("Goto %s is into a structured statement", p->symbol); + + } + +} + + + +/* + + * Labeled is called when a label + + * definition is encountered, and + + * marks that it has been found and + + * patches the associated GOTO generated + + * by gotoop. + + */ + +labeled(s) + + char *s; + +{ + + register struct nl *p; + + + + p = lookup(s); + + if (p == NIL) + + return (NIL); + + if (bn != cbn) { + + error("Label %s not defined in correct block", s); + + return; + + } + + if ((p->nl_flags & NFORWD) == 0) { + + error("Label %s redefined", s); + + return; + + } + + p->nl_flags &= ~NFORWD; - patch4(p->entloc); +++# ifdef OBJ +++ patch4(p->entloc); +++# endif OBJ +++# ifdef PC +++ { +++ char extname[ BUFSIZ ]; +++ char *starthere; +++ int i; +++ +++ starthere = &extname[0]; +++ for ( i = 1 ; i < bn ; i++ ) { +++ sprintf( starthere , EXTFORMAT , enclosing[ i ] ); +++ starthere += strlen( enclosing[ i ] ) + 1; +++ } +++ sprintf( starthere , EXTFORMAT , p -> symbol ); +++ starthere += strlen( p -> symbol ) + 1; +++ if ( starthere >= &extname[ BUFSIZ ] ) { +++ panic( "labeled namelength" ); +++ } +++ putprintf( NAMEFORMAT , 1 , extname ); +++ putprintf( ":" , 0 ); +++ } +++# endif PC + + if (p->value[NL_GOLEV] != NOTYET) + + if (p->value[NL_GOLEV] < level) { + + recovered(); + + error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]); + + } + + p->value[NL_GOLEV] = level; + +} + +#endif diff --cc usr/src/cmd/pi/lookup.c index 0000000000,51421eaa8b,0000000000..5c4201fe37 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/lookup.c +++ b/usr/src/cmd/pi/lookup.c @@@@ -1,0 -1,118 -1,0 +1,113 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)lookup.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + + + +/* + + * Lookup is called to + + * find a symbol in the + + * block structure symbol + + * table and returns a pointer to + + * its namelist entry. + + */ + +struct nl * + +lookup(s) + + register char *s; + +{ + + register struct nl *p; + + register struct udinfo *udp; + + + + if (s == NIL) { + + nocascade(); + + return (NIL); + + } + + p = lookup1(s); + + if (p == NIL) { + + derror("%s is undefined", s); + + return (NIL); + + } + + if (p->class == FVAR) { + + p = p->chain; + + bn--; + + } + + return (p); + +} + + + +#ifndef PI0 + +int flagwas; + +#endif + +/* + + * Lookup1 is an internal lookup. + + * It is not an error to call lookup1 + + * if the symbol is not defined. Also + + * lookup1 will return FVARs while + + * lookup never will, thus asgnop + + * calls it when it thinks you are + + * assigning to the function variable. + + */ + + + +struct nl * + +lookup1(s) + + register char *s; + +{ + + register struct nl *p; + +#ifndef PI0 + + register struct nl *q; + +#endif + + register int i; + + + + if (s == NIL) + + return (NIL); + + bn = cbn; + +#ifndef PI0 + + /* + + * We first check the field names + + * of the currently active with + + * statements (expensive since they + + * are not hashed). + + */ + + for (p = withlist; p != NIL; p = p->nl_next) { + + q = p->type; + + if (q == NIL) + + continue; + + if (reclook(q, s) != NIL) + + /* + + * Return the WITHPTR, lvalue understands. + + */ + + return (p); + + } + +#endif + + /* + + * Symbol table is a 64 way hash + + * on the low bits of the character + + * pointer value. (Simple, but effective) + + */ + + i = (int) s & 077; + + for (p = disptab[i]; p != NIL; p = p->nl_next) + + if (p->symbol == s && p->class != FIELD && p->class != BADUSE) { + + bn = (p->nl_block & 037); + +#ifndef PI0 + + flagwas = p->nl_flags; + + p->nl_flags |= NUSED; + +#endif + + return (p); + + } + + return (NIL); + +} + + + +#ifndef PI01 + +nlfund(sp) + + char *sp; + +{ + + register struct nl *p; + + register int i; + + + + i = (int) sp & 077; + + for (p = disptab[i]; p != NIL; p = p->nl_next) + + if (p->symbol == sp && (p->nl_block & 037) == 0) + + return (nloff(p)); + + return (0); + +} + +#endif diff --cc usr/src/cmd/pi/lval.c index 0000000000,4f4f490a11,0000000000..827bf7d66c mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/lval.c +++ b/usr/src/cmd/pi/lval.c @@@@ -1,0 -1,307 -1,0 +1,352 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)lval.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC + + + +extern int flagwas; + +/* + + * Lvalue computes the address + + * of a qualified name and + + * leaves it on the stack. +++ * for pc, it can be asked for either an lvalue or an rvalue. +++ * the semantics are the same, only the code is different. + + */ + +struct nl * - lvalue(r, modflag) +++lvalue(r, modflag , required ) + + int *r, modflag; +++ int required; + +{ + + register struct nl *p; + + struct nl *firstp, *lastp; + + register *c, *co; + + int f, o; + + /* + + * Note that the local optimizations + + * done here for offsets would more + + * appropriately be done in put. + + */ + + int tr[2], trp[3]; + + - if (r == NIL) +++ if (r == NIL) { + + return (NIL); - if (nowexp(r)) +++ } +++ if (nowexp(r)) { + + return (NIL); +++ } + + if (r[0] != T_VAR) { + + error("Variable required"); /* Pass mesgs down from pt of call ? */ + + return (NIL); + + } +++# ifdef PC +++ /* +++ * pc requires a whole different control flow +++ */ +++ return pclvalue( r , modflag , required ); +++# endif PC + + firstp = p = lookup(r[2]); - if (p == NIL) +++ if (p == NIL) { + + return (NIL); +++ } + + c = r[3]; - if ((modflag & NOUSE) && !lptr(c)) +++ if ((modflag & NOUSE) && !lptr(c)) { + + p->nl_flags = flagwas; - if (modflag & MOD) +++ } +++ if (modflag & MOD) { + + p->nl_flags |= NMOD; +++ } + + /* + + * Only possibilities for p->class here + + * are the named classes, i.e. CONST, TYPE + + * VAR, PROC, FUNC, REF, or a WITHPTR. + + */ + + switch (p->class) { + + case WITHPTR: + + /* + + * Construct the tree implied by + + * the with statement + + */ + + trp[0] = T_LISTPP; + + trp[1] = tr; + + trp[2] = r[3]; + + tr[0] = T_FIELD; + + tr[1] = r[2]; + + c = trp; + +# ifdef PTREE + + /* + + * mung r[4] to say which field this T_VAR is + + * for VarCopy + + */ + + r[4] = reclook( p -> type , r[2] ); + +# endif + + /* and fall through */ + + case REF: + + /* + + * Obtain the indirect word + + * of the WITHPTR or REF + + * as the base of our lvalue + + */ - # ifdef VAX - put2 ( O_RV4 | bn << 9 , p->value[0] ); - # endif - # ifdef PDP11 - put2(O_RV2 | bn << 9, p->value[0]); - # endif +++ put(2, PTR_RV | bn << 8+INDX , p->value[0] ); + + f = 0; /* have an lv on stack */ + + o = 0; + + break; + + case VAR: + + f = 1; /* no lv on stack yet */ + + o = p->value[0]; + + break; + + default: + + error("%s %s found where variable required", classes[p->class], p->symbol); + + return (NIL); + + } + + /* + + * Loop and handle each + + * qualification on the name + + */ + + if (c == NIL && (modflag&ASGN) && p->value[NL_FORV]) { + + error("Can't modify the for variable %s in the range of the loop", p->symbol); + + return (NIL); + + } + + for (; c != NIL; c = c[2]) { + + co = c[1]; - if (co == NIL) +++ if (co == NIL) { + + return (NIL); +++ } + + lastp = p; + + p = p->type; - if (p == NIL) +++ if (p == NIL) { + + return (NIL); +++ } + + switch (co[0]) { + + case T_PTR: + + /* + + * Pointer qualification. + + */ + + lastp->nl_flags |= NUSED; + + if (p->class != PTR && p->class != FILET) { + + error("^ allowed only on files and pointers, not on %ss", nameof(p)); + + goto bad; + + } - if (f) - # ifdef VAX - put2 ( O_RV4 | bn << 9 , o ); - # endif - # ifdef PDP11 - put2(O_RV2 | bn<<9, o); - # endif - else { - if (o) - put2(O_OFF, o); - # ifdef VAX - put1 ( O_IND4 ); - # endif - # ifdef PDP11 - put1(O_IND2); - # endif +++ if (f) { +++ put(2, PTR_RV | bn <<8+INDX , o ); +++ } else { +++ if (o) { +++ put2(O_OFF, o); +++ } +++ put(1, PTR_IND); + + } + + /* + + * Pointer cannot be + + * nil and file cannot + + * be at end-of-file. + + */ + + put1(p->class == FILET ? O_FNIL : O_NIL); + + f = o = 0; + + continue; + + case T_ARGL: + + if (p->class != ARRAY) { - if (lastp == firstp) +++ if (lastp == firstp) { + + error("%s is a %s, not a function", r[2], classes[firstp->class]); - else +++ } else { + + error("Illegal function qualificiation"); +++ } + + return (NIL); + + } + + recovered(); + + error("Pascal uses [] for subscripting, not ()"); + + case T_ARY: + + if (p->class != ARRAY) { + + error("Subscripting allowed only on arrays, not on %ss", nameof(p)); + + goto bad; + + } - if (f) - put2(O_LV | bn<<9, o); - else if (o) - put2(O_OFF, o); +++ if (f) { +++ put2(O_LV | bn<<8+INDX, o); +++ } else { +++ if (o) { +++ put2(O_OFF, o); +++ } +++ } + + switch (arycod(p, co[1])) { + + case 0: + + return (NIL); + + case -1: + + goto bad; + + } + + f = o = 0; + + continue; + + case T_FIELD: + + /* + + * Field names are just + + * an offset with some + + * semantic checking. + + */ + + if (p->class != RECORD) { + + error(". allowed only on records, not on %ss", nameof(p)); + + goto bad; + + } - if (co[1] == NIL) +++ if (co[1] == NIL) { + + return (NIL); +++ } + + p = reclook(p, co[1]); + + if (p == NIL) { + + error("%s is not a field in this record", co[1]); + + goto bad; + + } + +# ifdef PTREE + + /* + + * mung co[3] to indicate which field + + * this is for SelCopy + + */ + + co[3] = p; + +# endif - if (modflag & MOD) +++ if (modflag & MOD) { + + p->nl_flags |= NMOD; - if ((modflag & NOUSE) == 0 || lptr(c[2])) +++ } +++ if ((modflag & NOUSE) == 0 || lptr(c[2])) { + + p->nl_flags |= NUSED; +++ } + + o += p->value[0]; + + continue; + + default: + + panic("lval2"); + + } + + } - if (f) - put2(O_LV | bn<<9, o); - else if (o) - put2(O_OFF, o); +++ if (f) { +++ put2(O_LV | bn<<8+INDX, o); +++ } else { +++ if (o) { +++ put2(O_OFF, o); +++ } +++ } + + return (p->type); + +bad: + + cerror("Error occurred on qualification of %s", r[2]); + + return (NIL); + +} + + + +lptr(c) + + register int *c; + +{ + + register int *co; + + + + for (; c != NIL; c = c[2]) { + + co = c[1]; - if (co == NIL) +++ if (co == NIL) { + + return (NIL); +++ } + + switch (co[0]) { + + + + case T_PTR: + + return (1); + + case T_ARGL: + + return (0); + + case T_ARY: + + case T_FIELD: + + continue; + + default: + + panic("lptr"); + + } + + } + + return (0); + +} + + + +/* + + * Arycod does the + + * code generation + + * for subscripting. + + */ + +arycod(np, el) + + struct nl *np; + + int *el; + +{ + + register struct nl *p, *ap; + + int i, d, v, v1; + + int w; + + + + p = np; - if (el == NIL) +++ if (el == NIL) { + + return (0); +++ } + + d = p->value[0]; + + /* + + * Check each subscript + + */ + + for (i = 1; i <= d; i++) { + + if (el == NIL) { + + error("Too few subscripts (%d given, %d required)", i-1, d); + + return (-1); + + } + + p = p->chain; - ap = rvalue(el[1], NLNIL); - if (ap == NIL) +++# ifdef PC +++ precheck( p , "_SUBSC" , "_SUBSCZ" ); +++# endif PC +++ ap = rvalue(el[1], NLNIL , RREQ ); +++ if (ap == NIL) { + + return (0); +++ } +++# ifdef PC +++ postcheck( p ); +++# endif PC + + if (incompat(ap, p->type, el[1])) { + + cerror("Array index type incompatible with declared index type"); - if (d != 1) +++ if (d != 1) { + + cerror("Error occurred on index number %d", i); +++ } + + return (-1); + + } + + w = aryconst(np, i); - if (opt('t') == 0) - switch (w) { - case 8: - w = 6; - case 4: - case 2: - case 1: - put2((width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]); - el = el[2]; - continue; - } - put(4, width(ap) != 4 ? O_INX2 : O_INX4,w,( short ) p->range[0], - ( short ) ( p->range[1] - p->range[0] ) ); +++# ifdef OBJ +++ if (opt('t') == 0) { +++ switch (w) { +++ case 8: +++ w = 6; +++ case 4: +++ case 2: +++ case 1: +++ put2((width(ap) != 4 ? O_INX2P2 : O_INX4P2) | (w & ~1) << 7, ( short ) p->range[0]); +++ el = el[2]; +++ continue; +++ } +++ } +++ put(4, width(ap) != 4 ? O_INX2 : O_INX4,w,( short ) p->range[0], +++ ( short ) ( p->range[1] - p->range[0] ) ); +++# endif OBJ +++# ifdef PC +++ /* +++ * subtract off the lower bound +++ */ +++ if ( p -> range[ 0 ] != 0 ) { +++ putleaf( P2ICON , p -> range[0] , 0 , P2INT , 0 ); +++ putop( P2MINUS , P2INT ); +++ } +++ /* +++ * multiply by the width of the elements +++ */ +++ if ( w != 1 ) { +++ putleaf( P2ICON , w , 0 , P2INT , 0 ); +++ putop( P2MUL , P2INT ); +++ } +++ /* +++ * and add it to the base address +++ */ +++ putop( P2PLUS , ADDTYPE( p2type( np -> type ) , P2PTR ) ); +++# endif PC + + el = el[2]; + + } + + if (el != NIL) { + + do { + + el = el[2]; + + i++; + + } while (el != NIL); + + error("Too many subscripts (%d given, %d required)", i-1, d); + + return (-1); + + } + + return (1); + +} diff --cc usr/src/cmd/pi/main.c index 0000000000,0f130e2549,0000000000..9687432807 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/main.c +++ b/usr/src/cmd/pi/main.c @@@@ -1,0 -1,296 -1,0 +1,409 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)main.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" +++#include +++#include "objfmt.h" + + + +/* + + * This version of pi has been in use at Berkeley since May 1977 + + * and is very stable, except for the syntactic error recovery which + + * has just been written. Please report any problems with the error + + * recovery to the second author at the address given in the file + + * READ_ME. The second author takes full responsibility for any bugs + + * in the syntactic error recovery. + + */ + + + +char piusage[] = "pi [ -blnpstuw ] [ -i file ... ] name.p"; + +char pixusage[] = "pix [ -blnpstuw ] [ -i file ... ] name.p [ arg ... ]"; +++char pcusage[] = "pc [ options ] [ -o file ] [ -i file ... ] name.p"; + + + +char *usageis = piusage; - char *obj = "obj"; + + - #ifdef PPC - char *ppcname = "ppc.p1"; - # ifdef DEBUG - char *ppcdname = "ppcd.p1"; - # endif - #endif +++char *errfile = ERR_STRNGS; +++ +++#ifdef OBJ +++ char *obj = "obj"; +++#endif OBJ +++#ifdef PC +++ char *pcname = "pc.pc1"; +++#endif PC + +#ifdef PTREE + + char *pTreeName = "pi.pTree"; - #endif +++#endif PTREE + + + +/* + + * Be careful changing errfile and howfile. + + * There are the "magic" constants 9 and 15 immediately below. +++ * errfile is now defined by ERR_STRNGS, in objfmt.h, +++ * and its leading path name length is ERR_PATHLEN long. +++ * this for executing out of the current directory if running as `a.something'. + + */ - char *errfile = "/usr/lib/pi1.2strings"; +++#ifdef OBJ + +char *howfile = "/usr/lib/how_pi\0"; +++#endif OBJ +++#ifdef PC +++char *howfile = "/usr/lib/how_pc"; +++#endif PC + + + +int onintr(); + + + +extern char *lastname; + + + +FILE *ibuf; +++FILE *pcstream = NULL; + + + +/* + + * these are made real variables + + * so they can be changed + + * if you are compiling on a smaller machine + + */ + +double MAXINT = 2147483647.; + +double MININT = -2147483648.; + + + +/* + + * Main program for pi. + + * Process options, then call yymain + + * to do all the real work. + + */ + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register char *cp; + + register c; + + int i; + + + + if (argv[0][0] == 'a') - errfile += 9, howfile += 9; - if (argv[0][0] == '-' && argv[0][1] == 'o') { - obj = &argv[0][2]; - usageis = pixusage; - howfile[15] = 'x'; - ofil = 3; - } else { - ofil = creat(obj, 0755); - if (ofil < 0) { - perror(obj); - pexit(NOSTART); - } - } +++ errfile += ERR_PATHLEN , howfile += 9; +++# ifdef OBJ +++ if (argv[0][0] == '-' && argv[0][1] == 'o') { +++ obj = &argv[0][2]; +++ usageis = pixusage; +++ howfile[15] = 'x'; +++ ofil = 3; +++ } else { +++ ofil = creat(obj, 0755); +++ if (ofil < 0) { +++ perror(obj); +++ pexit(NOSTART); +++ } +++ } +++# endif OBJ + + argv++, argc--; + + if (argc == 0) { + + i = fork(); + + if (i == -1) + + goto usage; + + if (i == 0) { + + execl("/bin/cat", "cat", howfile, 0); + + goto usage; + + } + + while (wait(&i) != -1) + + continue; + + pexit(NOSTART); + + } - opt('p') = opt('t') = opt('b') = 1; - while (argc > 0) { +++# ifdef OBJ +++ opt('p') = opt('t') = opt('b') = 1; +++ while (argc > 0) { +++ cp = argv[0]; +++ if (*cp++ != '-') +++ break; +++ while (c = *cp++) switch (c) { +++#ifdef DEBUG +++ case 'k': +++ case 'r': +++ case 'y': +++ togopt(c); +++ continue; +++ case 'K': +++ yycosts(); +++ pexit(NOSTART); +++ case 'A': +++ testtrace++; +++ case 'F': +++ fulltrace++; +++ case 'E': +++ errtrace++; +++ opt('r')++; +++ continue; +++ case 'U': +++ yyunique = 0; +++ continue; +++#endif +++ case 'b': +++ opt('b') = 2; +++ continue; +++ case 'i': +++ pflist = argv + 1; +++ pflstc = 0; +++ while (argc > 1) { +++ if (dotted(argv[1], 'p')) +++ break; +++ pflstc++, argc--, argv++; +++ } +++ if (pflstc == 0) +++ goto usage; +++ continue; +++ case 'l': +++ case 'n': +++ case 'p': +++ case 's': +++ case 't': +++ case 'u': +++ case 'w': +++ togopt(c); +++ continue; +++ case 'z': +++ monflg++; +++ continue; +++ default: +++ usage: +++ Perror( "Usage", usageis); +++ pexit(NOSTART); +++ } +++ argc--, argv++; +++ } +++# endif OBJ +++# ifdef PC +++ opt( 'b' ) = 1; +++ opt( 'g' ) = 0; +++ opt( 't' ) = 0; +++ opt( 'p' ) = 0; +++ usageis = pcusage; +++ while ( argc > 0 ) { + + cp = argv[0]; - if (*cp++ != '-') - break; - while (c = *cp++) switch (c) { +++ if ( *cp++ != '-' ) { +++ break; +++ } +++ c = *cp++; +++ switch( c ) { + +#ifdef DEBUG - case 'c': - case 'r': - case 'y': - togopt(c); - continue; - case 'C': - yycosts(); - pexit(NOSTART); - case 'A': - testtrace++; - case 'F': - fulltrace++; - case 'E': - errtrace++; - opt('r')++; - continue; - case 'U': - yyunique = 0; - continue; - # ifdef PPC - case 'P': - ppcdebug++; - continue; - # endif +++ case 'k': +++ case 'r': +++ case 'y': +++ togopt(c); +++ break; +++ case 'K': +++ yycosts(); +++ pexit(NOSTART); +++ case 'A': +++ testtrace++; +++ /* and fall through */ +++ case 'F': +++ fulltrace++; +++ /* and fall through */ +++ case 'E': +++ errtrace++; +++ opt('r')++; +++ break; +++ case 'U': +++ yyunique = 0; +++ break; + +#endif - case 'b': - opt('b') = 2; - continue; - case 'i': - pflist = argv + 1; - pflstc = 0; - while (argc > 1) { - if (dotted(argv[1], 'p')) - break; - pflstc++, argc--, argv++; - } - if (pflstc == 0) - goto usage; - continue; - case 'l': - case 'n': - case 'p': - case 's': - case 't': - case 'u': - case 'w': - togopt(c); - continue; - case 'z': - monflg++; - continue; - default: +++ case 'b': +++ opt('b') = 2; +++ break; +++ case 'i': +++ pflist = argv + 1; +++ pflstc = 0; +++ while (argc > 1) { +++ if (dotted(argv[1], 'p')) +++ break; +++ pflstc++, argc--, argv++; +++ } +++ if (pflstc == 0) +++ goto usage; +++ break; +++ /* +++ * output file for the first pass +++ */ +++ case 'o': +++ if ( argc < 2 ) { +++ goto usage; +++ } +++ argv++; +++ argc--; +++ pcname = argv[0]; +++ break; +++ case 'C': +++ /* +++ * since -t is an ld switch, use -C +++ * to turn on tests +++ */ +++ togopt( 't' ); +++ break; +++ case 'g': +++ /* +++ * sdb symbol table +++ */ +++ togopt( 'g' ); +++ break; +++ case 'l': +++ case 's': +++ case 'u': +++ case 'w': +++ togopt(c); +++ break; +++ case 'p': +++ /* +++ * -p on the command line means profile +++ */ +++ profflag++; +++ break; +++ case 'z': +++ monflg++; +++ break; +++ default: + +usage: - Perror( "Usage", usageis); - pexit(NOSTART); +++ Perror( "Usage", usageis); +++ pexit(NOSTART); + + } - argc--, argv++; - } +++ argc--; +++ argv++; +++ } +++# endif PC + + if (argc != 1) + + goto usage; + + efil = open ( errfile, 0 ); + + if ( efil < 0 ) + + perror(errfile), pexit(NOSTART); + + filename = argv[0]; + + if (!dotted(filename, 'p')) { + + Perror(filename, "Name must end in '.p'"); + + pexit(NOSTART); + + } + + close(0); - if ( ( ibuf = fopen ( filename , "r" ) ) == NULL ) +++ if ( ( ibuf = fopen( filename , "r" ) ) == NULL ) + + perror(filename), pexit(NOSTART); + + ibp = ibuf; - # ifdef PPC - if ( ( ppcstream = fopen( ppcname , "w" ) ) == NULL ) { - perror( ppcname ); +++# ifdef PC +++ if ( ( pcstream = fopen( pcname , "w" ) ) == NULL ) { +++ perror( pcname ); + + pexit( NOSTART ); + + } - # ifdef DEBUG - if ( ppcdebug ) { - if ( ( ppcdstream = fopen( ppcdname , "w" ) ) == NULL ) { - perror( ppcdname ); - pexit( NOSTART ); - } - } - # endif - putprintf( "# compilation of %s" , filename ); - # endif +++ stabsource( filename ); +++# endif PC + +# ifdef PTREE + +# define MAXpPAGES 16 + + if ( ! pCreate( pTreeName , MAXpPAGES ) ) { + + perror( pTreeName ); + + pexit( NOSTART ); + + } - # endif - if ((signal(2, 1) & 01) == 0) - signal(2, onintr); +++# endif PTREE +++ if ( signal( SIGINT , SIG_IGN ) != SIG_IGN ) +++ signal( SIGINT , onintr ); + + if (opt('l')) { + + opt('n')++; + + yysetfile(filename); + + opt('n')--; - } else - lastname = filename; +++ } + + yymain(); + + /* No return */ + +} + + + +pchr(c) + + char c; + +{ + + + + putc ( c , stdout ); + +} + + + +char ugh[] = "Fatal error in pi\n"; + +/* + + * Exit from the Pascal system. + + * We throw in an ungraceful termination + + * message if c > 1 indicating a severe + + * error such as running out of memory + + * or an internal inconsistency. + + */ + +pexit(c) + + int c; + +{ + + + + if (opt('l') && c != DIED && c != NOSTART) + + while (getline() != -1) + + continue; + + yyflush(); + + switch (c) { + + case DIED: + + write(2, ugh, sizeof ugh); + + case NOSTART: + + case ERRS: - if (ofil > 0) - unlink(obj); +++# ifdef OBJ +++ if (ofil > 0) +++ unlink(obj); +++# endif OBJ +++# ifdef PC +++ if ( pcstream != NULL ) { +++ unlink( pcname ); +++ } +++# endif PC + + break; + + case AOK: - pflush(); +++# ifdef OBJ +++ pflush(); +++# endif OBJ +++# ifdef PC +++ puteof(); +++# endif PC + + break; + + } + + /* + + * this to gather statistics on programs being compiled + + * taken 20 june 79 ... peter + + * + + * if (fork() == 0) { + + * char *cp = "-0"; + + * cp[1] += c; + + * execl("/usr/lib/gather", "gather", cp, filename, 0); + + * exit(1); + + * } + + */ + +# ifdef PTREE + + pFinish(); + +# endif + + exit(c); + +} + + + +onintr() + +{ + + - signal(2, 1); +++ signal( SIGINT , SIG_IGN ); + + pexit(NOSTART); + +} + + + +/* + + * Get an error message from the error message file + + */ + +geterr(seekpt, buf) + + int seekpt; + + char *buf; + +{ + + + + lseek(efil, (long) seekpt, 0); + + if (read(efil, buf, 256) <= 0) + + perror(errfile), pexit(DIED); + +} + + + +header() + +{ + + extern char version[]; + + static char anyheaders; + + + + gettime( filename ); + + if (anyheaders && opt('n')) + + putc( '\f' , stdout ); + + anyheaders++; - printf("Berkeley Pascal PI -- Version 1.2 (%s)\n\n%s %s\n\n", - version, myctime(&tvec), filename); +++# ifdef OBJ +++ printf("Berkeley Pascal PI -- Version 2.0 (%s)\n\n%s %s\n\n", +++ version, myctime(&tvec), filename); +++# endif OBJ +++# ifdef PC +++ printf("Berkeley Pascal PC -- Version 2.0 (%s)\n\n%s %s\n\n", +++ version, myctime(&tvec), filename); +++# endif PC + +} diff --cc usr/src/cmd/pi/makefile index 0000000000,77cd174021,0000000000..1881a1628b mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/makefile +++ b/usr/src/cmd/pi/makefile @@@@ -1,0 -1,129 -1,0 +1,367 @@@@ - DESTDIR= +++SCCSID = "@(#)pimakefile 1.14 10/28/80" +++WHOAMI = pi +++INSTALLNAME = ${DESTDIR}/usr/ucb/pi +++VERSION = 2.0 +++ +++MKSTR = /usr/ucb/mkstr +++EYACC = /usr/ucb/eyacc +++RM = -rm -f +++GET = touch +++ + +CFLAGS = -O -w + +LDFLAGS = -z + + +++LIBDIR = ${DESTDIR}/usr/lib +++TMPDIR = tmp +++ +++ERRORSTRINGS = ${WHOAMI}${VERSION}strings +++ +++SRCS = ato.c \ +++ call.c case.c clas.c const.c conv.c cset.c \ +++ error.c fdec.c flvalue.c func.c gen.c hash.c \ +++ lab.c lookup.c lval.c stklval.c \ +++ main.c nl.c proc.c put.c \ +++ rec.c rval.c stkrval.c\ +++ stat.c string.c subr.c \ +++ tree.c type.c var.c \ +++ TRdata.c \ +++ treen.c putn.c yycopy.c \ +++ yycosts.c yyerror.c yyget.c yyid.c yylex.c yymain.c yyoptions.c \ +++ yypanic.c yyparse.c yyprint.c yyput.c yyrecover.c yyseman.c yytree.c \ +++ p2put.c pcforop.c stab.c pcproc.c pcfunc.c pccaseop.c pclval.c +++ +++HDRS = 0.h OPnames.h align.h iorec.h objfmt.h pstab.h pc.h pcops.h \ +++ send.h tree.h whoami.h yy.h +++ +++OTHERS = pas.y opc.c version.c gram pic.c +++ + +OBJS = ato.o \ + + call.o case.o clas.o const.o conv.o cset.o \ - error.o fdec.o func.o gen.o hash.o \ - lab.o lookup.o lval.o \ +++ error.o fdec.o flvalue.o func.o gen.o hash.o \ +++ lab.o lookup.o lval.o stklval.o \ + + main.o nl.o proc.o put.o \ - rec.o rval.o \ +++ rec.o rval.o stkrval.o\ + + stat.o string.o subr.o \ + + tree.o type.o var.o \ + + TRdata.o \ + + treen.o putn.o yycopy.o \ + + y.tab.o \ + + yycosts.o yyerror.o yyget.o yyid.o yylex.o yymain.o yyoptions.o \ - yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o +++ yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o \ +++ p2put.o pcforop.o stab.o pcproc.o pcfunc.o pccaseop.o pclval.o + + + +a.out: ${OBJS} version + + ./version > Version.c + + ${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} Version.c + + - a.obj: ${OBJS} - ./version > Version.c - ${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} Version.c -o a.obj - - pTreeOBJS = pCopy.o tCopy.o dCopy.o - pTreeDIR = /usr/ucb/lib - - a.ptree: ${OBJS} ${pTreeOBJS} - ./version > Version.c - ${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} Version.c \ - ${pTreeOBJS} ${pTreeDIR}/pAddr.o -o a.ptree +++sources: ${SRCS} ${HDRS} ${OTHERS} +++ +++${SRCS} ${HDRS} ${OTHERS}: +++ ${GET} $@ + + - ppcOBJS = ppc.o +++.c.o: +++ ${RM} ${TMPDIR}/$*.c +++ ${MKSTR} - ${ERRORSTRINGS} ${TMPDIR}/ $*.c +++ cd ${TMPDIR} ; ${CC} ${CFLAGS} -I.. -c $*.c ; mv $*.o ../$*.o +++ ${RM} ${TMPDIR}/$*.c + + - a.ppc: ${OBJS} ${pccOBJS} - ./version > Version.c - ${CC} ${CFLAGS} ${LDFLAGS} ${OBJS} Version.c ${pccOBJS} -o a.ppc +++y.tab.h: pas.y gram +++ ${EYACC} pas.y > /dev/null +++ ex - y.tab.c opcode.h +++ ${RM} opc + + - .c.o: - rm -f ${TMPDIR}/$*.c - ${MKSTR} - ${ERRORSTRINGS} ${TMPDIR}/ $*.c - cd ${TMPDIR} ; \ - ${CC} ${CFLAGS} -I.. -I${pTreeDIR} -c $*.c ; \ - mv $*.o ../$*.o - rm -f ${TMPDIR}/$*.c +++pTree.h: +++ echo "/* this is not pTree.h */" > pTree.h + + + +version: version.c + + ${CC} version.c -o version + + - RM = -rm - + +clean: - @echo "don't rm y.tab.c until we have an eyacc" + + ${RM} *.o ${TMPDIR}/*.c +++ ${RM} y.tab.h y.tab.c y.tab.out + + ${RM} ${ERRORSTRINGS} + + ${RM} version Version.c - ${RM} a.out a.obj a.ptree a.ppc core *.list +++ ${RM} a.out core *.list *.bak +++ ${RM} opc pic tags + + - print: +++print: sources + + @pr makefile READ_ME + + @ls -ls | pr - @pr picture - @pr 0.h whoami main.c pas.y +++ @cc -o pic pic.c +++ @pic | pr +++ @rm pic +++ @pr 0.h whoami.h main.c pas.y + + @pr OPnames.h opcode.h tree.h - @pr pNodeBodies.h pTags.h pTree.h - @pr ppc.h +++ @pr pc.h + + @pr [a-ln-x]*.c + + @pr yy.h yy*.c + + + +install: a.out - cp ${ERRORSTRINGS} ${DESTDIR}/usr/lib/${ERRORSTRINGS} - cp a.out ${DESTDIR}/usr/ucb/pi - strip ${DESTDIR}/usr/ucb/pi - - 0.h: whoami - TRdata.o: 0.h - ato.o: 0.h - call.o: 0.h - case.o: 0.h - clas.o: 0.h - const.o: 0.h - conv.o: 0.h - cset.o: 0.h - dCopy.o: 0.h - error.o: 0.h - fdec.o: 0.h - func.o: 0.h - gen.o: 0.h - hash.o: 0.h - lab.o: 0.h - lookup.o: 0.h - lval.o: 0.h - main.o: 0.h - nl.o: 0.h - pCopy.o: 0.h - ppc.o: 0.h - proc.o: 0.h - put.o: 0.h - rec.o: 0.h - rval.o: 0.h - stat.o: 0.h - string.o: 0.h - subr.o: 0.h - tCopy.o: 0.h - tree.o: 0.h - type.o: 0.h - var.o: 0.h - y.tab.o: 0.h - yycopy.o: 0.h - yycosts.o: 0.h - yyerror.o: 0.h - yyget.o: 0.h - yyid.o: 0.h - yylex.o: 0.h - yymain.o: 0.h - yyoptions.o: 0.h - yypanic.o: 0.h - yyparse.o: 0.h - yyprint.o: 0.h - yyput.o: 0.h - yyrecover.o: 0.h - yyseman.o: 0.h - yytree.o: 0.h +++ cp ${ERRORSTRINGS} ${LIBDIR}/${ERRORSTRINGS} +++ cp ${INSTALLNAME} ${INSTALLNAME}.bak +++ cp a.out ${INSTALLNAME} +++ +++depend: sources +++ /bin/grep '^#[ ]*include' *.h \ +++ | sed '/<.*>/d' \ +++ | sed 's/\(.*\):[^"]*"\([^"]*\)".*/\1: \2/' >makedep +++ /bin/grep '^#[ ]*include' *.c \ +++ | sed '/<.*>/d' \ +++ | sed 's/:[^"]*"\([^"]*\)".*/: \1/' \ +++ | sed 's/\.c/.o/' >>makedep +++ echo '/^# DO NOT DELETE THIS LINE/+2,$$d' >eddep +++ echo '$$r makedep' >>eddep +++ echo 'w' >>eddep +++ cp makefile makefile.bak +++ ed - makefile < eddep +++ rm eddep makedep +++ echo '# DEPENDENCIES MUST END AT END OF FILE' >> makefile +++ echo '# IF YOU PUT STUFF HERE IT WILL GO AWAY' >> makefile +++ echo '# see make depend above' >> makefile +++ +++# DO NOT DELETE THIS LINE -- make depend uses it +++ +++0.h: pTree.h +++yy.h: y.tab.h +++TRdata.o: whoami.h +++TRdata.o: 0.h +++ato.o: whoami.h +++ato.o: 0.h +++call.o: whoami.h +++call.o: 0.h +++call.o: tree.h +++call.o: opcode.h +++call.o: objfmt.h +++call.o: pc.h +++call.o: pcops.h +++case.o: whoami.h +++case.o: 0.h +++case.o: tree.h +++case.o: opcode.h +++clas.o: whoami.h +++clas.o: 0.h +++clas.o: tree.h +++const.o: whoami.h +++const.o: 0.h +++const.o: tree.h +++conv.o: whoami.h +++conv.o: 0.h +++conv.o: opcode.h +++conv.o: pcops.h +++cset.o: whoami.h +++cset.o: 0.h +++cset.o: tree.h +++cset.o: opcode.h +++cset.o: objfmt.h +++cset.o: pc.h +++cset.o: pcops.h +++error.o: whoami.h +++error.o: 0.h +++error.o: yy.h +++fdec.o: whoami.h +++fdec.o: 0.h +++fdec.o: tree.h +++fdec.o: opcode.h +++fdec.o: objfmt.h +++fdec.o: align.h +++fdec.o: pc.h +++fdec.o: pcops.h +++flvalue.o: whoami.h +++flvalue.o: 0.h +++flvalue.o: tree.h +++flvalue.o: opcode.h +++flvalue.o: objfmt.h +++flvalue.o: pc.h +++flvalue.o: pcops.h +++func.o: whoami.h +++func.o: 0.h +++func.o: tree.h +++func.o: opcode.h +++gen.o: whoami.h +++gen.o: 0.h +++gen.o: tree.h +++gen.o: opcode.h +++gen.o: objfmt.h +++hash.o: whoami.h +++hash.o: 0.h +++hash.o: yy.h +++lab.o: whoami.h +++lab.o: 0.h +++lab.o: tree.h +++lab.o: opcode.h +++lab.o: objfmt.h +++lab.o: pc.h +++lab.o: pcops.h +++lookup.o: whoami.h +++lookup.o: 0.h +++lval.o: whoami.h +++lval.o: 0.h +++lval.o: tree.h +++lval.o: opcode.h +++lval.o: objfmt.h +++lval.o: pc.h +++lval.o: pcops.h +++main.o: whoami.h +++main.o: 0.h +++main.o: yy.h +++main.o: objfmt.h +++nl.o: whoami.h +++nl.o: 0.h +++nl.o: opcode.h +++nl.o: objfmt.h +++opc.o: OPnames.h +++p2put.o: whoami.h +++p2put.o: 0.h +++p2put.o: pcops.h +++p2put.o: pc.h +++pccaseop.o: whoami.h +++pccaseop.o: 0.h +++pccaseop.o: tree.h +++pccaseop.o: objfmt.h +++pccaseop.o: pcops.h +++pccaseop.o: pc.h +++pcforop.o: whoami.h +++pcforop.o: 0.h +++pcforop.o: opcode.h +++pcforop.o: tree.h +++pcforop.o: pc.h +++pcforop.o: pcops.h +++pcfunc.o: whoami.h +++pcfunc.o: 0.h +++pcfunc.o: tree.h +++pcfunc.o: opcode.h +++pcfunc.o: pc.h +++pcfunc.o: pcops.h +++pclval.o: whoami.h +++pclval.o: 0.h +++pclval.o: tree.h +++pclval.o: opcode.h +++pclval.o: objfmt.h +++pclval.o: pc.h +++pclval.o: pcops.h +++pcproc.o: whoami.h +++pcproc.o: 0.h +++pcproc.o: tree.h +++pcproc.o: opcode.h +++pcproc.o: pc.h +++pcproc.o: pcops.h +++pic.o: OPnames.h +++proc.o: whoami.h +++proc.o: 0.h +++proc.o: tree.h +++proc.o: opcode.h +++proc.o: objfmt.h +++put.o: whoami.h +++put.o: opcode.h +++put.o: 0.h +++put.o: objfmt.h +++put.o: pc.h +++put.o: OPnames.h +++rec.o: whoami.h +++rec.o: 0.h +++rec.o: tree.h +++rec.o: opcode.h +++rval.o: whoami.h +++rval.o: 0.h +++rval.o: tree.h +++rval.o: opcode.h +++rval.o: objfmt.h +++rval.o: pc.h +++rval.o: pcops.h +++stab.o: whoami.h +++stab.o: 0.h +++stab.o: pstab.h +++stab.o: pc.h +++stat.o: whoami.h +++stat.o: 0.h +++stat.o: tree.h +++stat.o: objfmt.h +++stat.o: pcops.h +++stat.o: pc.h +++stat.o: opcode.h +++stklval.o: whoami.h +++stklval.o: 0.h +++stklval.o: tree.h +++stklval.o: opcode.h +++stklval.o: objfmt.h +++stkrval.o: whoami.h +++stkrval.o: 0.h +++stkrval.o: tree.h +++stkrval.o: opcode.h +++stkrval.o: objfmt.h +++stkrval.o: pcops.h +++string.o: whoami.h +++string.o: 0.h +++string.o: send.h +++subr.o: whoami.h +++subr.o: 0.h +++tree.o: whoami.h +++tree.o: 0.h +++type.o: whoami.h +++type.o: 0.h +++type.o: tree.h +++type.o: objfmt.h +++var.o: whoami.h +++var.o: 0.h +++var.o: align.h +++var.o: pc.h +++var.o: pcops.h +++var.o: iorec.h +++y.tab.o: whoami.h +++y.tab.o: 0.h +++y.tab.o: yy.h +++y.tab.o: tree.h +++yycopy.o: 0.h +++yycopy.o: yy.h +++yycosts.o: whoami.h +++yycosts.o: 0.h +++yycosts.o: yy.h +++yyerror.o: whoami.h +++yyerror.o: 0.h +++yyerror.o: yy.h +++yyget.o: whoami.h +++yyget.o: 0.h +++yyget.o: yy.h +++yyid.o: whoami.h +++yyid.o: 0.h +++yyid.o: yy.h +++yylex.o: whoami.h +++yylex.o: 0.h +++yylex.o: yy.h +++yymain.o: whoami.h +++yymain.o: 0.h +++yymain.o: yy.h +++yymain.o: objfmt.h +++yyoptions.o: whoami.h +++yyoptions.o: 0.h +++yyoptions.o: yy.h +++yypanic.o: whoami.h +++yypanic.o: 0.h +++yypanic.o: yy.h +++yyparse.o: whoami.h +++yyparse.o: 0.h +++yyparse.o: yy.h +++yyprint.o: whoami.h +++yyprint.o: 0.h +++yyprint.o: yy.h +++yyput.o: whoami.h +++yyput.o: 0.h +++yyput.o: tree.h +++yyput.o: yy.h +++yyrecover.o: whoami.h +++yyrecover.o: 0.h +++yyrecover.o: yy.h +++yyseman.o: whoami.h +++yyseman.o: 0.h +++yyseman.o: yy.h +++yytree.o: whoami.h +++yytree.o: 0.h +++yytree.o: tree.h +++# DEPENDENCIES MUST END AT END OF FILE +++# IF YOU PUT STUFF HERE IT WILL GO AWAY +++# see make depend above diff --cc usr/src/cmd/pi/nl.c index 0000000000,cecef4317b,0000000000..726c9da1c0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/nl.c +++ b/usr/src/cmd/pi/nl.c @@@@ -1,0 -1,768 -1,0 +1,774 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)nl.c 1.2 10/2/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "opcode.h" +++#include "objfmt.h" + + + +/* + + * NAMELIST SEGMENT DEFINITIONS + + */ + +struct nls { + + struct nl *nls_low; + + struct nl *nls_high; + +} ntab[MAXNL], *nlact; + + + +struct nl nl[INL]; + +struct nl *nlp = nl; + +struct nls *nlact = ntab; + + + + /* + + * all these strings must be places where people can find them + + * since lookup only looks at the string pointer, not the chars. + + * see, for example, pTreeInit. + + */ + + + + /* + + * built in constants + + */ + +char *in_consts[] = { + + "true" , + + "false" , +++ "TRUE", +++ "FALSE", + + "minint" , + + "maxint" , + + "minchar" , + + "maxchar" , + + "bell" , + + "tab" , + + 0 + + }; + + + + /* + + * built in simple types + + */ + +char *in_types[] = + + { + + "boolean", + + "char", + + "integer", + + "real", + + "_nil", /* dummy name */ + + 0 + + }; + + + +int in_rclasses[] = + + { + + TINT , + + TINT , + + TINT , + + TCHAR , + + TBOOL , + + TDOUBLE , + + 0 + + }; + + + +long in_ranges[] = + + { + + -128L , 128L , + + -32768L , 32767L , + + -2147483648L , 2147483647L , + + 0L , 127L , + + 0L , 1L , + + 0L , 0L /* fake for reals */ + + }; + + + + /* + + * built in constructed types + + */ + +char *in_ctypes[] = { + + "Boolean" , + + "intset" , + + "alfa" , + + "text" , + + 0 + + }; + + + + /* + + * built in variables + + */ + +char *in_vars[] = { + + "input" , + + "output" , + + 0 + + }; + + + + /* + + * built in functions + + */ + +char *in_funcs[] = + + { + + "abs" , + + "arctan" , + + "card" , + + "chr" , + + "clock" , + + "cos" , + + "eof" , + + "eoln" , + + "eos" , + + "exp" , + + "expo" , + + "ln" , + + "odd" , + + "ord" , + + "pred" , + + "round" , + + "sin" , + + "sqr" , + + "sqrt" , + + "succ" , + + "trunc" , + + "undefined" , + + /* + + * Extensions + + */ + + "argc" , + + "random" , + + "seed" , + + "wallclock" , + + "sysclock" , + + 0 + + }; + + + + /* + + * Built-in procedures + + */ + +char *in_procs[] = + + { + + "date" , + + "dispose" , + + "flush" , + + "get" , + + "getseg" , + + "halt" , + + "linelimit" , + + "message" , + + "new" , + + "pack" , + + "page" , + + "put" , + + "putseg" , + + "read" , + + "readln" , + + "remove" , + + "reset" , + + "rewrite" , + + "time" , + + "unpack" , + + "write" , + + "writeln" , + + /* + + * Extensions + + */ + + "argv" , + + "null" , + + "stlimit" , + + 0 + + }; + + + +#ifndef PI0 + + /* + + * and their opcodes + + */ + +int in_fops[] = + + { + + O_ABS2, + + O_ATAN, + + O_CARD|NSTAND, + + O_CHR2, + + O_CLCK|NSTAND, + + O_COS, + + O_EOF, + + O_EOLN, + + 0, + + O_EXP, + + O_EXPO|NSTAND, + + O_LN, + + O_ODD2, + + O_ORD2, + + O_PRED2, + + O_ROUND, + + O_SIN, + + O_SQR2, + + O_SQRT, + + O_SUCC2, + + O_TRUNC, + + O_UNDEF|NSTAND, + + /* + + * Extensions + + */ + + O_ARGC|NSTAND, + + O_RANDOM|NSTAND, + + O_SEED|NSTAND, + + O_WCLCK|NSTAND, + + O_SCLCK|NSTAND + + }; + + + + /* + + * Built-in procedures + + */ + +int in_pops[] = + + { + + O_DATE|NSTAND, + + O_DISPOSE, + + O_FLUSH|NSTAND, + + O_GET, + + 0, + + O_HALT|NSTAND, + + O_LLIMIT|NSTAND, + + O_MESSAGE|NSTAND, + + O_NEW, + + O_PACK, + + O_PAGE, + + O_PUT, + + 0, + + O_READ4, + + O_READLN, + + O_REMOVE|NSTAND, + + O_RESET, + + O_REWRITE, + + O_TIME|NSTAND, + + O_UNPACK, - O_WRIT2, +++ O_WRITEF, + + O_WRITLN, + + /* + + * Extensions + + */ + + O_ARGV|NSTAND, - O_NULL|NSTAND, +++ O_ABORT|NSTAND, + + O_STLIM|NSTAND + + }; + +#endif + + + +/* + + * Initnl initializes the first namelist segment and then + + * initializes the name list for block 0. + + */ + +initnl() + + { + + register char **cp; + + register struct nl *np; +++ struct nl *fp; + + int *ip; + + long *lp; + + + +#ifdef DEBUG + + if ( hp21mx ) + + { + + MININT = -32768.; + + MAXINT = 32767.; + +#ifndef PI0 + + genmx(); + +#endif + + } + +#endif + + ntab[0].nls_low = nl; + + ntab[0].nls_high = &nl[INL]; + + defnl ( 0 , 0 , 0 , 0 ); + + + + /* + + * Types + + */ + + for ( cp = in_types ; *cp != 0 ; cp ++ ) + + hdefnl ( *cp , TYPE , nlp , 0 ); + + + + /* + + * Ranges + + */ + + lp = in_ranges; + + for ( ip = in_rclasses ; *ip != 0 ; ip ++ ) + + { + + np = defnl ( 0 , RANGE , nl+(*ip) , 0 ); + + nl[*ip].type = np; + + np -> range[0] = *lp ++ ; + + np -> range[1] = *lp ++ ; + + + + }; + + + + /* + + * built in constructed types + + */ + + + + cp = in_ctypes; + + /* + + * Boolean = boolean; + + */ + + hdefnl ( *cp++ , TYPE , nl+T1BOOL , 0 ); + + + + /* + + * intset = set of 0 .. 127; + + */ + + intset = *cp++; - enter ( defnl ( intset , TYPE , nlp+1 , 0 ) ); +++ hdefnl( intset , TYPE , nlp+1 , 0 ); + + defnl ( 0 , SET , nlp+1 , 0 ); + + np = defnl ( 0 , RANGE , nl+TINT , 0 ); + + np -> range[0] = 0L; + + np -> range[1] = 127L; + + + + /* + + * alfa = array [ 1 .. 10 ] of char; + + */ + + np = defnl ( 0 , RANGE , nl+TINT , 0 ); + + np -> range[0] = 1L; + + np -> range[1] = 10L; + + defnl ( 0 , ARRAY , nl+T1CHAR , 1 ) -> chain = np; + + hdefnl ( *cp++ , TYPE , nlp-1 , 0 ); + + + + /* + + * text = file of char; + + */ + + hdefnl ( *cp++ , TYPE , nlp+1 , 0 ); + + np = defnl ( 0 , FILET , nl+T1CHAR , 0 ); + + np -> nl_flags |= NFILES; + + + + /* + + * input,output : text; + + */ + + cp = in_vars; + +# ifndef PI0 - # ifdef VAX - input = hdefnl ( *cp++ , VAR , np , -8 ); - # endif - # ifdef PDP11 - input = hdefnl ( *cp++ , VAR , np , -2 ); - # endif - output = hdefnl ( *cp++ , VAR , np , -4 ); +++ input = hdefnl ( *cp++ , VAR , np , INPUT_OFF ); +++ output = hdefnl ( *cp++ , VAR , np , OUTPUT_OFF ); + +# else + + input = hdefnl ( *cp++ , VAR , np , 0 ); + + output = hdefnl ( *cp++ , VAR , np , 0 ); + +# endif + + + + /* + + * built in constants + + */ + + cp = in_consts; - hdefnl ( *cp++ , CONST , nl + TBOOL , 1 ); - hdefnl ( *cp++ , CONST , nl + TBOOL , 0 ); +++ np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 ); +++ fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 ); +++ (nl + TBOOL)->chain = fp; +++ fp->chain = np; +++ np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 ); +++ fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 ); +++ fp->chain = np; +++ if (opt('s')) +++ (nl + TBOOL)->chain = fp; + + hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MININT; + + hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MAXINT; + + hdefnl ( *cp++ , CONST , nl + T1CHAR , 0 ); + + hdefnl ( *cp++ , CONST , nl + T1CHAR , 127 ); + + hdefnl ( *cp++ , CONST , nl + T1CHAR , '\007' ); + + hdefnl ( *cp++ , CONST , nl + T1CHAR , '\t' ); + + + + /* + + * Built-in functions and procedures + + */ + +#ifndef PI0 + + ip = in_fops; + + for ( cp = in_funcs ; *cp != 0 ; cp ++ ) + + hdefnl ( *cp , FUNC , 0 , * ip ++ ); + + ip = in_pops; + + for ( cp = in_procs ; *cp != 0 ; cp ++ ) + + hdefnl ( *cp , PROC , 0 , * ip ++ ); + +#else + + for ( cp = in_funcs ; *cp != 0 ; cp ++ ) + + hdefnl ( *cp , FUNC , 0 , 0 ); + + for ( cp = in_procs ; *cp != 0 , cp ++ ) + + hdefnl ( *cp , PROC , 0 , 0 ); + +#endif + +# ifdef PTREE + + pTreeInit(); + +# endif + + } + + + +struct nl * + +hdefnl(sym, cls, typ, val) + +{ + + register struct nl *p; + + + +#ifndef PI1 + + if (sym) + + hash(sym, 0); + +#endif + + p = defnl(sym, cls, typ, val); + + if (sym) + + enter(p); + + return (p); + +} + + + +/* + + * Free up the name list segments + + * at the end of a statement/proc/func + + * All segments are freed down to the one in which + + * p points. + + */ + +nlfree(p) + + struct nl *p; + +{ + + + + nlp = p; + + while (nlact->nls_low > nlp || nlact->nls_high < nlp) { + + free(nlact->nls_low); + + nlact->nls_low = NIL; + + nlact->nls_high = NIL; + + --nlact; + + if (nlact < &ntab[0]) + + panic("nlfree"); + + } + +} + + + + + +char *VARIABLE = "variable"; + + + +char *classes[ ] = { + + "undefined", + + "constant", + + "type", + + "variable", /* VARIABLE */ + + "array", + + "pointer or file", + + "record", + + "field", + + "procedure", + + "function", + + "variable", /* VARIABLE */ + + "variable", /* VARIABLE */ + + "pointer", + + "file", + + "set", + + "subrange", + + "label", + + "withptr", + + "scalar", + + "string", + + "program", - "improper" - #ifdef DEBUG - ,"variant" - #endif +++ "improper", +++ "variant", +++ "formal procedure", +++ "formal function" + +}; + + + +char *snark = "SNARK"; + + + +#ifdef PI + +#ifdef DEBUG + +char *ctext[] = + +{ + + "BADUSE", + + "CONST", + + "TYPE", + + "VAR", + + "ARRAY", + + "PTRFILE", + + "RECORD", + + "FIELD", + + "PROC", + + "FUNC", + + "FVAR", + + "REF", + + "PTR", + + "FILET", + + "SET", + + "RANGE", + + "LABEL", + + "WITHPTR", + + "SCAL", + + "STR", + + "PROG", + + "IMPROPER", - "VARNT" +++ "VARNT", +++ "FPROC", +++ "FFUNC" + +}; + + + +char *stars = "\t***"; + + + +/* + + * Dump the namelist from the + + * current nlp down to 'to'. + + * All the namelist is dumped if + + * to is NIL. + + */ + +dumpnl(to, rout) + + struct nl *to; + +{ + + register struct nl *p; + + register int j; + + struct nls *nlsp; + + int i, v, head; + + + + if (opt('y') == 0) + + return; + + if (to != NIL) + + printf("\n\"%s\" Block=%d\n", rout, cbn); + + nlsp = nlact; + + head = NIL; + + for (p = nlp; p != to;) { + + if (p == nlsp->nls_low) { + + if (nlsp == &ntab[0]) + + break; + + nlsp--; + + p = nlsp->nls_high; + + } + + p--; + + if (head == NIL) { + + printf("\tName\tClass Bn+Flags\tType\tVal\tChn\n"); + + head++; + + } + + printf("%3d:", nloff(p)); + + if (p->symbol) + + printf("\t%.7s", p->symbol); + + else + + printf(stars); + + if (p->class) + + printf("\t%s", ctext[p->class]); + + else + + printf(stars); + + if (p->nl_flags) { + + pchr('\t'); + + if (p->nl_flags & 037) + + printf("%d ", p->nl_flags & 037); + +#ifndef PI0 + + if (p->nl_flags & NMOD) + + pchr('M'); + + if (p->nl_flags & NUSED) + + pchr('U'); + +#endif + + if (p->nl_flags & NFILES) + + pchr('F'); + + } else + + printf(stars); + + if (p->type) + + printf("\t[%d]", nloff(p->type)); + + else + + printf(stars); + + v = p->value[0]; + + switch (p->class) { + + case TYPE: + + break; + + case VARNT: + + goto con; + + case CONST: + + switch (nloff(p->type)) { + + default: + + printf("\t%d", v); + + break; + + case TDOUBLE: + + printf("\t%f", p->real); + + break; + + case TINT: + + case T4INT: + +con: + + printf("\t%ld", p->range[0]); + + break; + + case TSTR: + + printf("\t'%s'", p->ptr[0]); + + break; + + } + + break; + + case VAR: + + case REF: + + case WITHPTR: +++ case FFUNC: +++ case FPROC: + + printf("\t%d,%d", cbn, v); + + break; + + case SCAL: + + case RANGE: + + printf("\t%ld..%ld", p->range[0], p->range[1]); + + break; + + case RECORD: + + printf("\t%d(%d)", v, p->value[NL_FLDSZ]); + + break; + + case FIELD: + + printf("\t%d", v); + + break; + + case STR: + + printf("\t|%d|", p->value[0]); + + break; + + case FVAR: + + case FUNC: + + case PROC: + + case PROG: + + if (cbn == 0) { + + printf("\t<%o>", p->value[0] & 0377); + +#ifndef PI0 + + if (p->value[0] & NSTAND) + + printf("\tNSTAND"); + +#endif + + break; + + } + + v = p->value[1]; + + default: + +casedef: + + if (v) + + printf("\t<%d>", v); + + else + + printf(stars); + + } + + if (p->chain) + + printf("\t[%d]", nloff(p->chain)); + + switch (p->class) { + + case RECORD: + + if (p->ptr[NL_VARNT]) + + printf("\tVARNT=[%d]", nloff(p->ptr[NL_VARNT])); + + if (p->ptr[NL_TAG]) + + printf(" TAG=[%d]", nloff(p->ptr[NL_TAG])); + + break; + + case VARNT: + + printf("\tVTOREC=[%d]", nloff(p->ptr[NL_VTOREC])); + + break; + + } + +# ifdef PTREE + + pchr( '\t' ); + + pPrintPointer( stdout , "%s" , p -> inTree ); + +# endif + + pchr('\n'); + + } + + if (head == 0) + + printf("\tNo entries\n"); + +} + +#endif + + + + + +/* + + * Define a new name list entry + + * with initial symbol, class, type + + * and value[0] as given. A new name + + * list segment is allocated to hold + + * the next name list slot if necessary. + + */ + +struct nl * + +defnl(sym, cls, typ, val) + + char *sym; + + int cls; + + struct nl *typ; + + int val; + +{ + + register struct nl *p; + + register int *q, i; + + char *cp; + + + + p = nlp; + + + + /* + + * Zero out this entry + + */ + + q = p; + + i = (sizeof *p)/(sizeof (int)); + + do + + *q++ = 0; + + while (--i); + + + + /* + + * Insert the values + + */ + + p->symbol = sym; + + p->class = cls; + + p->type = typ; + + p->nl_block = cbn; + + p->value[0] = val; + + + + /* + + * Insure that the next namelist + + * entry actually exists. This is + + * really not needed here, it would + + * suffice to do it at entry if we + + * need the slot. It is done this + + * way because, historically, nlp + + * always pointed at the next namelist + + * slot. + + */ + + nlp++; + + if (nlp >= nlact->nls_high) { + + i = NLINC; + + cp = malloc(NLINC * sizeof *nlp); + + if (cp == -1) { + + i = NLINC / 2; + + cp = malloc((NLINC / 2) * sizeof *nlp); + + } + + if (cp == -1) { + + error("Ran out of memory (defnl)"); + + pexit(DIED); + + } + + nlact++; + + if (nlact >= &ntab[MAXNL]) { + + error("Ran out of name list tables"); + + pexit(DIED); + + } + + nlp = cp; + + nlact->nls_low = nlp; + + nlact->nls_high = nlact->nls_low + i; + + } + + return (p); + +} + + + +/* + + * Make a duplicate of the argument + + * namelist entry for, e.g., type + + * declarations of the form 'type a = b' + + * and array indicies. + + */ + +struct nl * + +nlcopy(p) + + struct nl *p; + +{ + + register int *p1, *p2, i; + + + + p1 = p; + + p = p2 = defnl(0, 0, 0, 0); + + i = (sizeof *p)/(sizeof (int)); + + do + + *p2++ = *p1++; + + while (--i); +++ p->chain = NIL; + + return (p); + +} + + + +/* + + * Compute a namelist offset + + */ + +nloff(p) + + struct nl *p; + +{ + + + + return (p - nl); + +} + + + +/* + + * Enter a symbol into the block + + * symbol table. Symbols are hashed + + * 64 ways based on low 6 bits of the + + * character pointer into the string + + * table. + + */ + +struct nl * + +enter(np) + + struct nl *np; + +{ + + register struct nl *rp, *hp; + + register struct nl *p; + + int i; + + + + rp = np; + + if (rp == NIL) + + return (NIL); + +#ifndef PI1 + + if (cbn > 0) + + if (rp->symbol == input->symbol || rp->symbol == output->symbol) + + error("Pre-defined files input and output must not be redefined"); + +#endif + + i = rp->symbol; + + i &= 077; + + hp = disptab[i]; + + if (rp->class != BADUSE && rp->class != FIELD) + + for (p = hp; p != NIL && (p->nl_block & 037) == cbn; p = p->nl_next) + + if (p->symbol == rp->symbol && p->class != BADUSE && p->class != FIELD) { + +#ifndef PI1 + + error("%s is already defined in this block", rp->symbol); + +#endif + + break; + + + + } + + rp->nl_next = hp; + + disptab[i] = rp; + + return (rp); + +} + +#endif diff --cc usr/src/cmd/pi/objfmt.h index 0000000000,0000000000,0000000000..ba55ea3067 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/objfmt.h @@@@ -1,0 -1,0 -1,0 +1,88 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)objfmt.h 1.2 10/4/80"; */ +++ +++#ifdef OBJ +++ /* +++ * the creation time, the size and the magic number of the obj file +++ */ +++ struct pxhdr { +++ int maketime; +++ int objsize; +++ short magicnum; +++ }; +++ +++# define HEADER_BYTES 1024 /* the size of px_header */ +++# define PX_HEADER "/usr/lib/px_header" /* px_header's name */ +++# define PX_INTRP "/usr/ucb/px" /* the interpreter's name */ +++#endif OBJ +++ +++ /* +++ * the file of error messages created by mkstr +++ */ +++#ifdef OBJ +++# define ERR_STRNGS "/usr/lib/pi2.0strings" +++# define ERR_PATHLEN 9 +++#endif OBJ +++#ifdef PC +++# define ERR_STRNGS "/usr/lib/pc2.0strings" +++# define ERR_PATHLEN 9 +++#endif PC +++ +++ /* +++ * these are because of varying sizes of pointers +++ */ +++#ifdef VAX +++# define INDX 2 /* log2 of sizeof( * ) */ +++# define PTR_AS O_AS4 +++# define PTR_RV O_RV4 +++# define PTR_IND O_IND4 +++# define PTR_DCL unsigned long /* for pointer variables */ +++# define SHORTADDR 32768 /* maximum short address */ +++# define TOOMUCH 65536 /* maximum variable size */ +++# define MAXSET 65536 /* maximum set size */ +++ /* +++ * Offsets due to the structure of the runtime stack. +++ * DPOFF1 is the amount of fixed storage in each block allocated +++ * as local variables for the runtime system. +++ * since locals are allocated negative offsets, +++ * -DPOFF1 is the last used implicit local offset. +++ * DPOFF2 is the size of the block mark. +++ * since arguments are allocated positive offsets, +++ * DPOFF2 is the end of the implicit arguments. +++ * for obj, the first argument has the highest offset +++ * from the stackpointer. and the block mark is an +++ * implicit last parameter. +++ * for pc, the first argument has the lowest offset +++ * from the argumentpointer. and the block mark is an +++ * implicit first parameter. +++ */ +++# ifdef OBJ +++# define DPOFF1 0 +++# define DPOFF2 32 +++# define INPUT_OFF -8 /* offset of `input' */ +++# define OUTPUT_OFF -4 /* offset of `output' */ +++# endif OBJ +++# ifdef PC +++# define DPOFF1 ( sizeof rtlocs - sizeof rtlocs.unwind ) +++# define DPOFF2 ( sizeof (long) ) +++# define INPUT_OFF 0 +++# define OUTPUT_OFF 0 +++# endif PC +++# define MAGICNUM 0403 /* obj magic number */ +++#endif VAX +++ +++#ifdef PDP11 +++# define INDX 1 +++# define PTR_AS O_AS2 +++# define PTR_RV O_RV2 +++# define PTR_IND O_IND2 +++# define PTR_DCL char * +++# define TOOMUCH 50000 +++# define SHORTADDR 65536 +++# define MAXSET 65536 /* maximum set size */ +++# define DPOFF2 16 +++# define INPUT_OFF -2 +++# define OUTPUT_OFF -4 +++# define MAGICNUM 0404 +++#endif PDP11 diff --cc usr/src/cmd/pi/opc.c index 0000000000,0000000000,0000000000..7a0c47cd65 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/opc.c @@@@ -1,0 -1,0 -1,0 +1,14 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)opc.c 1.1 8/27/80"; +++ +++#include "OPnames.h" +++ +++main() { +++ register int i; +++ +++ for (i = 0; i < 256; i++) +++ if (otext[i]) +++ printf("#define O_%s %04o\n", otext[i]+1, i); +++ exit(0); +++} diff --cc usr/src/cmd/pi/p2put.c index 0000000000,0000000000,0000000000..4a59d09c41 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/p2put.c @@@@ -1,0 -1,0 -1,0 +1,742 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)p2put.c 1.3 10/16/80"; +++ +++ /* +++ * functions to help pi put out +++ * polish postfix binary portable c compiler intermediate code +++ * thereby becoming the portable pascal compiler +++ */ +++ +++#include "whoami.h" +++#ifdef PC +++#include "0.h" +++#include "pcops.h" +++#include "pc.h" +++ +++ /* +++ * mash into f77's format +++ * lovely, isn't it? +++ */ +++#define TOF77( fop,val,rest ) ( ( ( (rest) & 0177777 ) << 16 ) \ +++ | ( ( (val) & 0377 ) << 8 ) \ +++ | ( (fop) & 0377 ) ) +++ +++ /* +++ * emits an ftext operator and a string to the pcstream +++ */ +++puttext( string ) +++ char *string; +++ { +++ int length = str4len( string ); +++ +++ if ( cgenflg ) +++ return; +++ p2word( TOF77( P2FTEXT , length , 0 ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FTEXT | %3d | 0 " , length ); +++ } +++# endif +++ p2string( string ); +++ } +++ +++int +++str4len( string ) +++ char *string; +++ { +++ +++ return ( ( strlen( string ) + 3 ) / 4 ); +++ } +++ +++ /* +++ * put formatted text into a buffer for printing to the pcstream. +++ * a call to putpflush actually puts out the text. +++ * none of arg1 .. arg5 need be present. +++ * and you can add more if you need them. +++ */ +++ /* VARARGS */ +++putprintf( format , incomplete , arg1 , arg2 , arg3 , arg4 , arg5 ) +++ char *format; +++ int incomplete; +++ { +++ static char ppbuffer[ BUFSIZ ]; +++ static char *ppbufp = ppbuffer; +++ +++ if ( cgenflg ) +++ return; +++ sprintf( ppbufp , format , arg1 , arg2 , arg3 , arg4 , arg5 ); +++ ppbufp = &( ppbuffer[ strlen( ppbuffer ) ] ); +++ if ( ppbufp >= &( ppbuffer[ BUFSIZ ] ) ) +++ panic( "putprintf" ); +++ if ( ! incomplete ) { +++ puttext( ppbuffer ); +++ ppbufp = ppbuffer; +++ } +++ } +++ +++ /* +++ * emit a left bracket operator to pcstream +++ * with function number, the maximum temp register, and total local bytes +++ * until i figure out how to use them, regs 0 .. 11 are free. +++ * one idea for one reg is to save the display pointer on block entry +++ */ +++putlbracket( ftnno , localbytes ) +++ int ftnno; +++ int localbytes; +++ { +++# define MAXTP2REG 11 +++ +++ p2word( TOF77( P2FLBRAC , MAXTP2REG , ftnno ) ); +++ p2word( BITSPERBYTE * localbytes ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout +++ , "P2FLBRAC | %3d | %d " , MAXTP2REG , ftnno ); +++ fprintf( stdout , "%d\n" +++ , BITSPERBYTE * localbytes ); +++ } +++# endif +++ } +++ +++ /* +++ * emit a right bracket operator +++ * which for the binary (fortran) interface +++ * forces the stack allocate and register mask +++ */ +++putrbracket( ftnno ) +++ int ftnno; +++ { +++ +++ p2word( TOF77( P2FRBRAC , 0 , ftnno ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FRBRAC | 0 | %d\n" , ftnno ); +++ } +++# endif +++ } +++ +++ /* +++ * emit an eof operator +++ */ +++puteof() +++ { +++ +++ p2word( P2FEOF ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FEOF\n" ); +++ } +++# endif +++ } +++ +++ /* +++ * emit a dot operator, +++ * with a source file line number and name +++ * if line is negative, there was an error on that line, but who cares? +++ */ +++putdot( filename , line ) +++ char *filename; +++ int line; +++ { +++ int length = str4len( filename ); +++ +++ if ( line < 0 ) { +++ line = -line; +++ } +++ p2word( TOF77( P2FEXPR , length , line ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2FEXPR | %3d | %d " , length , line ); +++ } +++# endif +++ p2string( filename ); +++ } +++ +++ /* +++ * put out a leaf node +++ */ +++putleaf( op , lval , rval , type , name ) +++ int op; +++ int lval; +++ int rval; +++ int type; +++ char *name; +++ { +++ if ( cgenflg ) +++ return; +++ switch ( op ) { +++ default: +++ panic( "[putleaf]" ); +++ case P2ICON: +++ p2word( TOF77( P2ICON , name != NIL , type ) ); +++ p2word( lval ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2ICON | %3d | %d " +++ , name != NIL , type ); +++ fprintf( stdout , "%d\n" , lval ); +++ } +++# endif +++ if ( name ) +++ p2name( name ); +++ break; +++ case P2NAME: +++ p2word( TOF77( P2NAME , lval != 0 , type ) ); +++ if ( lval ) +++ p2word( lval ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2NAME | %3d | %d " +++ , lval != 0 , type ); +++ if ( lval ) +++ fprintf( stdout , "%d " , lval ); +++ } +++# endif +++ p2name( name ); +++ break; +++ case P2REG: +++ p2word( TOF77( P2REG , rval , type ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "P2REG | %3d | %d\n" , rval , type ); +++ } +++# endif +++ break; +++ } +++ } +++ +++ /* +++ * rvalues are just lvalues with indirection, except +++ * special case for named globals, whose names are their rvalues +++ */ +++putRV( name , level , offset , type ) +++ char *name; +++ int level; +++ int offset; +++ int type; +++ { +++ char extname[ BUFSIZ ]; +++ char *printname; +++ +++ if ( cgenflg ) +++ return; +++ if ( ( level <= 1 ) && ( name != 0 ) ) { +++ if ( name[0] != '_' ) { +++ sprintf( extname , EXTFORMAT , name ); +++ printname = extname; +++ } else { +++ printname = name; +++ } +++ putleaf( P2NAME , offset , 0 , type , printname ); +++ return; +++ } +++ putLV( name , level , offset , type ); +++ putop( P2UNARY P2MUL , type ); +++ } +++ +++ /* +++ * put out an lvalue +++ * given a level and offset +++ * special case for +++ * named globals, whose lvalues are just their names as constants. +++ * negative offsets, that are offsets from the frame pointer. +++ * positive offsets, that are offsets from argument pointer. +++ */ +++putLV( name , level , offset , type ) +++ char *name; +++ int level; +++ int offset; +++ int type; +++ { +++ char extname[ BUFSIZ ]; +++ char *printname; +++ +++ if ( cgenflg ) +++ return; +++ if ( ( level <= 1 ) && ( name != 0 ) ) { +++ if ( name[0] != '_' ) { +++ sprintf( extname , EXTFORMAT , name ); +++ printname = extname; +++ } else { +++ printname = name; +++ } +++ putleaf( P2ICON , offset , 0 , ADDTYPE( type , P2PTR ) +++ , printname ); +++ return; +++ } +++ if ( level == cbn ) { +++ if ( offset < 0 ) { +++ putleaf( P2REG , 0 , P2FP , ADDTYPE( type , P2PTR ) , 0 ); +++ } else { +++ putleaf( P2REG , 0 , P2AP , ADDTYPE( type , P2PTR ) , 0 ); +++ } +++ } else { +++ if ( offset < 0 ) { +++ putleaf( P2NAME +++ , ( level * sizeof(struct dispsave) ) + FP_OFFSET +++ , 0 , P2PTR | P2CHAR , DISPLAYNAME ); +++ } else { +++ putleaf( P2NAME +++ , ( level * sizeof(struct dispsave) ) + AP_OFFSET +++ , 0 , P2PTR | P2CHAR , DISPLAYNAME ); +++ } +++ } +++ if ( offset < 0 ) { +++ putleaf( P2ICON , -offset , 0 , P2INT , 0 ); +++ putop( P2MINUS , P2PTR | P2CHAR ); +++ } else { +++ putleaf( P2ICON , offset , 0 , P2INT , 0 ); +++ putop( P2PLUS , P2PTR | P2CHAR ); +++ } +++ return; +++ } +++ +++ /* +++ * put out a floating point constant leaf node +++ * the constant is declared in aligned data space +++ * and a P2NAME leaf put out for it +++ */ +++putCON8( value ) +++ double value; +++ { +++ int label; +++ char name[ BUFSIZ ]; +++ +++ if ( cgenflg ) +++ return; +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 2" , 0 ); +++ label = getlab(); +++ putlab( label ); +++ putprintf( " .double 0d%.20e" , 0 , value ); +++ putprintf( " .text" , 0 ); +++ sprintf( name , PREFIXFORMAT , LABELPREFIX , label ); +++ putleaf( P2NAME , 0 , 0 , P2DOUBLE , name ); +++ } +++ +++ /* +++ * put out either an lvalue or an rvalue for a constant string. +++ * an lvalue (for assignment rhs's) is the name as a constant, +++ * an rvalue (for parameters) is just the name. +++ */ +++putCONG( string , length , required ) +++ char *string; +++ int length; +++ int required; +++ { +++ char name[ BUFSIZ ]; +++ int label; +++ char *cp; +++ int pad; +++ int others; +++ +++ if ( cgenflg ) +++ return; +++ putprintf( " .data" , 0 ); +++ label = getlab(); +++ putlab( label ); +++ cp = string; +++ while ( *cp ) { +++ putprintf( " .byte 0%o" , 1 , *cp ++ ); +++ for ( others = 2 ; ( others <= 8 ) && *cp ; others ++ ) { +++ putprintf( ",0%o" , 1 , *cp++ ); +++ } +++ putprintf( "" , 0 ); +++ } +++ pad = length - strlen( string ); +++ while ( pad-- > 0 ) { +++ putprintf( " .byte 0%o" , 1 , ' ' ); +++ for ( others = 2 ; ( others <= 8 ) && ( pad-- > 0 ) ; others++ ) { +++ putprintf( ",0%o" , 1 , ' ' ); +++ } +++ putprintf( "" , 0 ); +++ } +++ putprintf( " .byte 0" , 0 ); +++ putprintf( " .text" , 0 ); +++ sprintf( name , PREFIXFORMAT , LABELPREFIX , label ); +++ if ( required == RREQ ) { +++ putleaf( P2NAME , 0 , 0 , P2ARY | P2CHAR , name ); +++ } else { +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR , name ); +++ } +++ } +++ +++ /* +++ * map a pascal type to a c type +++ * this would be tail recursive, but i unfolded it into a for (;;). +++ * this is sort of like isa and lwidth +++ * a note on the types used by the portable c compiler: +++ * they are divided into a basic type (char, short, int, long, etc.) +++ * and qualifications on those basic types (pointer, function, array). +++ * the basic type is kept in the low 4 bits of the type descriptor, +++ * and the qualifications are arranged in two bit chunks, with the +++ * most significant on the right, +++ * and the least significant on the left +++ * e.g. int *foo(); +++ * (a function returning a pointer to an integer) +++ * is stored as +++ * +++ * so, we build types recursively +++ * also, we know that /lib/f1 can only deal with 6 qualifications +++ * so we stop the recursion there. this stops infinite type recursion +++ * through mutually recursive pointer types. +++ */ +++#define MAXQUALS 6 +++int +++p2type( np ) +++{ +++ +++ return typerecur( np , 0 ); +++} +++typerecur( np , quals ) +++ struct nl *np; +++ int quals; +++ { +++ +++ if ( np == NIL || quals > MAXQUALS ) { +++ return P2UNDEF; +++ } +++ switch ( np -> class ) { +++ case SCAL : +++ case RANGE : +++ if ( np -> type == ( nl + TDOUBLE ) ) { +++ return P2DOUBLE; +++ } +++ switch ( bytes( np -> range[0] , np -> range[1] ) ) { +++ case 1: +++ return P2CHAR; +++ case 2: +++ return P2SHORT; +++ case 4: +++ return P2INT; +++ default: +++ panic( "p2type int" ); +++ } +++ case STR : +++ return ( P2ARY | P2CHAR ); +++ case RECORD : +++ case SET : +++ return P2STRTY; +++ case FILET : +++ return ( P2PTR | P2STRTY ); +++ case CONST : +++ case VAR : +++ case FIELD : +++ return p2type( np -> type ); +++ case TYPE : +++ switch ( nloff( np ) ) { +++ case TNIL : +++ return ( P2PTR | P2UNDEF ); +++ case TSTR : +++ return ( P2ARY | P2CHAR ); +++ case TSET : +++ return P2STRTY; +++ default : +++ return ( p2type( np -> type ) ); +++ } +++ case REF: +++ case WITHPTR: +++ case PTR : +++ return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2PTR ); +++ case ARRAY : +++ return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2ARY ); +++ case FUNC : +++ /* +++ * functions are really pointers to functions +++ * which return their underlying type. +++ */ +++ return ADDTYPE( ADDTYPE( typerecur( np -> type , quals + 2 ) , +++ P2FTN ) , P2PTR ); +++ case PROC : +++ /* +++ * procedures are pointers to functions +++ * which return integers (whether you look at them or not) +++ */ +++ return ADDTYPE( ADDTYPE( P2INT , P2FTN ) , P2PTR ); +++ case FFUNC : +++ case FPROC : +++ /* +++ * formal procedures and functions are pointers +++ * to structures which describe their environment. +++ */ +++ return ADDTYPE( P2PTR , P2STRTY ); +++ default : +++ panic( "p2type" ); +++ } +++ } +++ +++ /* +++ * add a most significant type modifier to a type +++ */ +++long +++addtype( underlying , mtype ) +++ long underlying; +++ long mtype; +++ { +++ return ( ( ( underlying & ~P2BASETYPE ) << P2TYPESHIFT ) +++ | mtype +++ | ( underlying & P2BASETYPE ) ); +++ } +++ +++ /* +++ * put a typed operator to the pcstream +++ */ +++putop( op , type ) +++ int op; +++ int type; +++ { +++ extern char *p2opnames[]; +++ +++ if ( cgenflg ) +++ return; +++ p2word( TOF77( op , 0 , type ) ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "%s (%d) | 0 | %d\n" +++ , p2opnames[ op ] , op , type ); +++ } +++# endif +++ } +++ +++ /* +++ * put out a structure operator (STASG, STARG, STCALL, UNARY STCALL ) +++ * which looks just like a regular operator, only the size and +++ * alignment go in the next consecutive words +++ */ +++putstrop( op , type , size , alignment ) +++ int op; +++ int type; +++ int size; +++ int alignment; +++ { +++ extern char *p2opnames[]; +++ +++ if ( cgenflg ) +++ return; +++ p2word( TOF77( op , 0 , type ) ); +++ p2word( size ); +++ p2word( alignment ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "%s (%d) | 0 | %d %d %d\n" +++ , p2opnames[ op ] , op , type , size , alignment ); +++ } +++# endif +++ } +++ +++ /* +++ * the string names of p2ops +++ */ +++char *p2opnames[] = { +++ "", +++ "P2UNDEFINED", /* 1 */ +++ "P2NAME", /* 2 */ +++ "P2STRING", /* 3 */ +++ "P2ICON", /* 4 */ +++ "P2FCON", /* 5 */ +++ "P2PLUS", /* 6 */ +++ "", +++ "P2MINUS", /* 8 also unary == P2NEG */ +++ "", +++ "P2NEG", +++ "P2MUL", /* 11 also unary == P2INDIRECT */ +++ "", +++ "P2INDIRECT", +++ "P2AND", /* 14 also unary == P2ADDROF */ +++ "", +++ "P2ADDROF", +++ "P2OR", /* 17 */ +++ "", +++ "P2ER", /* 19 */ +++ "", +++ "P2QUEST", /* 21 */ +++ "P2COLON", /* 22 */ +++ "P2ANDAND", /* 23 */ +++ "P2OROR", /* 24 */ +++ "", /* 25 */ +++ "", /* 26 */ +++ "", /* 27 */ +++ "", /* 28 */ +++ "", /* 29 */ +++ "", /* 30 */ +++ "", /* 31 */ +++ "", /* 32 */ +++ "", /* 33 */ +++ "", /* 34 */ +++ "", /* 35 */ +++ "", /* 36 */ +++ "", /* 37 */ +++ "", /* 38 */ +++ "", /* 39 */ +++ "", /* 40 */ +++ "", /* 41 */ +++ "", /* 42 */ +++ "", /* 43 */ +++ "", /* 44 */ +++ "", /* 45 */ +++ "", /* 46 */ +++ "", /* 47 */ +++ "", /* 48 */ +++ "", /* 49 */ +++ "", /* 50 */ +++ "", /* 51 */ +++ "", /* 52 */ +++ "", /* 53 */ +++ "", /* 54 */ +++ "", /* 55 */ +++ "P2LISTOP", /* 56 */ +++ "", +++ "P2ASSIGN", /* 58 */ +++ "P2COMOP", /* 59 */ +++ "P2DIV", /* 60 */ +++ "", +++ "P2MOD", /* 62 */ +++ "", +++ "P2LS", /* 64 */ +++ "", +++ "P2RS", /* 66 */ +++ "", +++ "P2DOT", /* 68 */ +++ "P2STREF", /* 69 */ +++ "P2CALL", /* 70 also unary */ +++ "", +++ "P2UNARYCALL", +++ "P2FORTCALL", /* 73 also unary */ +++ "", +++ "P2UNARYFORTCALL", +++ "P2NOT", /* 76 */ +++ "P2COMPL", /* 77 */ +++ "P2INCR", /* 78 */ +++ "P2DECR", /* 79 */ +++ "P2EQ", /* 80 */ +++ "P2NE", /* 81 */ +++ "P2LE", /* 82 */ +++ "P2LT", /* 83 */ +++ "P2GE", /* 84 */ +++ "P2GT", /* 85 */ +++ "P2ULE", /* 86 */ +++ "P2ULT", /* 87 */ +++ "P2UGE", /* 88 */ +++ "P2UGT", /* 89 */ +++ "P2SETBIT", /* 90 */ +++ "P2TESTBIT", /* 91 */ +++ "P2RESETBIT", /* 92 */ +++ "P2ARS", /* 93 */ +++ "P2REG", /* 94 */ +++ "P2OREG", /* 95 */ +++ "P2CCODES", /* 96 */ +++ "P2FREE", /* 97 */ +++ "P2STASG", /* 98 */ +++ "P2STARG", /* 99 */ +++ "P2STCALL", /* 100 also unary */ +++ "", +++ "P2UNARYSTCALL", +++ "P2FLD", /* 103 */ +++ "P2SCONV", /* 104 */ +++ "P2PCONV", /* 105 */ +++ "P2PMCONV", /* 106 */ +++ "P2PVCONV", /* 107 */ +++ "P2FORCE", /* 108 */ +++ "P2CBRANCH", /* 109 */ +++ "P2INIT", /* 110 */ +++ "P2CAST", /* 111 */ +++ }; +++ +++ /* +++ * low level routines +++ */ +++ +++ /* +++ * puts a long word on the pcstream +++ */ +++p2word( word ) +++ long word; +++ { +++ +++ putw( word , pcstream ); +++ } +++ +++ /* +++ * put a length 0 mod 4 null padded string onto the pcstream +++ */ +++p2string( string ) +++ char *string; +++ { +++ int slen = strlen( string ); +++ int wlen = ( slen + 3 ) / 4; +++ int plen = ( wlen * 4 ) - slen; +++ char *cp; +++ int p; +++ +++ for ( cp = string ; *cp ; cp++ ) +++ putc( *cp , pcstream ); +++ for ( p = 1 ; p <= plen ; p++ ) +++ putc( '\0' , pcstream ); +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , "\"%s" , string ); +++ for ( p = 1 ; p <= plen ; p++ ) +++ fprintf( stdout , "\\0" ); +++ fprintf( stdout , "\"\n" ); +++ } +++# endif +++ } +++ +++ /* +++ * puts a name on the pcstream +++ */ +++p2name( name ) +++ char *name; +++ { +++ int pad; +++ +++ fprintf( pcstream , NAMEFORMAT , name ); +++ pad = strlen( name ) % sizeof (long); +++ for ( ; pad < sizeof (long) ; pad++ ) { +++ putc( '\0' , pcstream ); +++ } +++# ifdef DEBUG +++ if ( opt( 'k' ) ) { +++ fprintf( stdout , NAMEFORMAT , name ); +++ pad = strlen( name ) % sizeof (long); +++ for ( ; pad < sizeof (long) ; pad++ ) { +++ fprintf( stdout , "\\0" ); +++ } +++ fprintf( stdout , "\n" ); +++ } +++# endif +++ } +++ +++ /* +++ * put out a jump to a label +++ */ +++putjbr( label ) +++ long label; +++ { +++ +++ printjbr( LABELPREFIX , label ); +++ } +++ +++ /* +++ * put out a jump to any kind of label +++ */ +++printjbr( prefix , label ) +++ char *prefix; +++ long label; +++ { +++ +++ putprintf( " jbr " , 1 ); +++ putprintf( PREFIXFORMAT , 0 , prefix , label ); +++ } +++ +++ /* +++ * another version of put to catch calls to put +++ */ +++put( arg1 , arg2 ) +++ { +++ +++ putprintf( "# PUT CALLED!: arg1 = %d arg2 = 0%o" , 0 , arg1 , arg2 ); +++ } +++ +++#endif PC diff --cc usr/src/cmd/pi/pas.y index 0000000000,506a7b9ca8,0000000000..6598e80178 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/pas.y +++ b/usr/src/cmd/pi/pas.y @@@@ -1,0 -1,902 -1,0 +1,902 @@@@ - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.0 August 1977 - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.0 August 1977 - */ +++/* Copyright (c) 1979 Regents of the University of California */ + + + +/* + + * Yacc grammar for UNIX Pascal + + * + + * This grammar is processed by the commands in the shell script + + * "gram" to yield parse tables and semantic routines in the file + + * "y.tab.c" and a header defining the lexical tokens in "yy.h". + + * + + * In order for the syntactic error recovery possible with this + + * grammar to work, the grammar must be processed by a yacc which + + * has been modified to fully enumerate possibilities in states + + * which involve the symbol "error". + + * The parser used for Pascal also uses a different encoding of + + * the test entries in the action table which speeds the parse. + + * A version of yacc which will work for Pascal is included on + + * the distribution table as "eyacc". + + * + + * The "gram" script also makes the following changes to the "y.tab.c" + + * file: + + * + + * 1) Causes yyval to be declared int *. + + * + + * 2) Loads the variable yypv into a register as yyYpv so that + + * the arguments $1, ... are available as yyYpv[1] etc. + + * This produces much smaller code in the semantic actions. + + * + + * 3) Deletes the unused array yysterm. + + * + + * 4) Moves the declarations up to the flag line containing + + * '##' to the file yy.h so that the routines which use + + * these "magic numbers" don't have to all be compiled at + + * the same time. + + * + + * 5) Creates the semantic restriction checking routine yyEactr - * by processing action lines containing `@'. +++ * by processing action lines containing `@@'. + + * + + * This compiler uses a different version of the yacc parser, a + + * different yyerror which is called yerror, and requires more + + * lookahead sets than normally provided by yacc. + + * + + * Source for the yacc used with this grammar is included on + + * distribution tapes. + + */ + + + +/* + + * TERMINAL DECLARATIONS + + * + + * Some of the terminal declarations are out of the most natural + + * alphabetic order because the error recovery + + * will guess the first of equal cost non-terminals. + + * This makes, e.g. YTO preferable to YDOWNTO. + + */ + + + +%term + + YAND YARRAY YBEGIN YCASE + + YCONST YDIV YDO YDOTDOT + + YTO YELSE YEND YFILE + + YFOR YFORWARD YFUNCTION YGOTO + + YID YIF YIN YINT + + YLABEL YMOD YNOT YNUMB + + YOF YOR YPACKED YNIL + + YPROCEDURE YPROG YRECORD YREPEAT + + YSET YSTRING YTHEN YDOWNTO + + YTYPE YUNTIL YVAR YWHILE + + YWITH YBINT YOCT YHEX - YASSERT YCASELAB YILLCH YLAST +++ YASSERT YCASELAB YILLCH YEXTERN +++ YLAST + + + +/* + + * PRECEDENCE DECLARATIONS + + * + + * Highest precedence is the unary logical NOT. + + * Next are the multiplying operators, signified by '*'. + + * Lower still are the binary adding operators, signified by '+'. + + * Finally, at lowest precedence and non-associative are the relationals. + + */ + + + +%binary '<' '=' '>' YIN + +%left '+' '-' YOR '|' + +%left UNARYSIGN + +%left '*' '/' YDIV YMOD YAND '&' + +%left YNOT + + + +%{ - + +/* + + * GLOBALS FOR ACTIONS + + */ + + +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)pas.y 1.3 9/2/80"; */ +++ + +/* + + * The following line marks the end of the yacc + + * Constant definitions which are removed from + + * y.tab.c and placed in the file y.tab.h. + + */ + +## +++/* Copyright (c) 1979 Regents of the University of California */ + + - #include "whoami" +++static char sccsid[] = "@(#)pas.y 1.3 9/2/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + +#include "tree.h" + + + +#ifdef PI + +#define lineof(l) l + +#define line2of(l) l + +#endif + + + +%} + + + +%% + + + +/* + + * PRODUCTIONS + + */ + + + +goal: - prog_hedr decls procs block '.' - = funcend($1, $4, lineof($5)); +++ prog_hedr decls block '.' +++ = funcend($1, $3, lineof($4)); +++ | +++ decls +++ = segend(); + + ; +++ + + + +prog_hedr: + + YPROG YID '(' id_list ')' ';' + + = $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), $2, fixlist($4), NIL))); + + | + + YPROG error + + = { + + yyPerror("Malformed program statement", PPROG); + + /* + + * Should make a program statement + + * with "input" and "output" here. + + */ + + $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), NIL, NIL, NIL))); + + } + + ; + +block: + + YBEGIN stat_list YEND + + = { + + $$ = tree3(T_BSTL, lineof($1), fixlist($2)); + + if ($3 < 0) + + brerror($1, "begin"); + + } + + ; + + + + + +/* + + * DECLARATION PART + + */ + +decls: + + decls decl + + = trfree(); + + | + + decls error + + = { + +Derror: + + constend(), typeend(), varend(), trfree(); + + yyPerror("Malformed declaration", PDECL); + + } + + | + + /* lambda */ + + = trfree(); + + ; + + + +decl: + + labels + + | + + const_decl + + = constend(); + + | + + type_decl + + = typeend(); + + | + + var_decl + + = varend(); +++ | +++ proc_decl + + ; + + + +/* + + * LABEL PART + + */ + + + +labels: + + YLABEL label_decl ';' + + = label(fixlist($2), lineof($1)); + + ; + +label_decl: + + YINT + + = $$ = newlist($1 == NIL ? NIL : *hash($1, 1)); + + | + + label_decl ',' YINT + + = $$ = addlist($1, $3 == NIL ? NIL : *hash($3, 1)); + + ; + + + +/* + + * CONST PART + + */ + + + +const_decl: + + YCONST YID '=' const ';' + + = constbeg($1, line2of($2)), const(lineof($3), $2, $4); + + | + + const_decl YID '=' const ';' + + = const(lineof($3), $2, $4); + + | + + YCONST error + + = { + + constbeg($1, line2of($1)); + +Cerror: + + yyPerror("Malformed const declaration", PDECL); + + } + + | + + const_decl error + + = goto Cerror; + + ; + + + +/* + + * TYPE PART + + */ + + + +type_decl: + + YTYPE YID '=' type ';' + + = typebeg($1, line2of($2)), type(lineof($3), $2, $4); + + | + + type_decl YID '=' type ';' + + = type(lineof($3), $2, $4); + + | + + YTYPE error + + = { + + typebeg($1, line2of($1)); + +Terror: + + yyPerror("Malformed type declaration", PDECL); + + } + + | + + type_decl error + + = goto Terror; + + ; + + + +/* + + * VAR PART + + */ + + + +var_decl: + + YVAR id_list ':' type ';' + + = varbeg($1, line2of($3)), var(lineof($3), fixlist($2), $4); + + | + + var_decl id_list ':' type ';' + + = var(lineof($3), fixlist($2), $4); + + | + + YVAR error + + = { + + varbeg($1, line2of($1)); + +Verror: + + yyPerror("Malformed var declaration", PDECL); + + } + + | + + var_decl error + + = goto Verror; + + ; + + + +/* + + * PROCEDURE AND FUNCTION DECLARATION PART + + */ + + - procs: - /* lambda */ - | - procs proc - = trfree(); - ; - proc: +++proc_decl: + + phead YFORWARD ';' + + = funcfwd($1); + + | - pheadres decls procs block ';' - = funcend($1, $4, lineof($5)); +++ phead YEXTERN ';' +++ = funcext($1); +++ | +++ pheadres decls block ';' +++ = funcend($1, $3, lineof($4)); + + ; + +pheadres: + + phead + + = funcbody($1); + + ; + +phead: + + porf YID params ftype ';' + + = $$ = funchdr(tree5($1, lineof($5), $2, $3, $4)); + + ; + +porf: + + YPROCEDURE + + = $$ = T_PDEC; + + | + + YFUNCTION + + = $$ = T_FDEC; + + ; + +params: + + '(' param_list ')' + + = $$ = fixlist($2); + + | + + /* lambda */ + + = $$ = NIL; + + ; + + + +/* + + * PARAMETERS + + */ + + + +param: + + id_list ':' type + + = $$ = tree3(T_PVAL, fixlist($1), $3); + + | + + YVAR id_list ':' type + + = $$ = tree3(T_PVAR, fixlist($2), $4); + + | + + YFUNCTION id_list ':' type + + = $$ = tree3(T_PFUNC, fixlist($2), $4); + + | + + YPROCEDURE id_list + + = $$ = tree2(T_PPROC, fixlist($2)); + + ; + +ftype: + + ':' type + + = $$ = $2; + + | + + /* lambda */ + + = $$ = NIL; + + ; + +param_list: + + param + + = $$ = newlist($1); + + | + + param_list ';' param + + = $$ = addlist($1, $3); + + ; + + + +/* + + * CONSTANTS + + */ + + + +const: + + YSTRING + + = $$ = tree2(T_CSTRNG, $1); + + | + + number + + | + + '+' number + + = $$ = tree2(T_PLUSC, $2); + + | + + '-' number + + = $$ = tree2(T_MINUSC, $2); + + ; + +number: + + const_id + + = $$ = tree2(T_ID, $1); + + | + + YINT + + = $$ = tree2(T_CINT, $1); + + | + + YBINT + + = $$ = tree2(T_CBINT, $1); + + | + + YNUMB + + = $$ = tree2(T_CFINT, $1); + + ; + +const_list: + + const + + = $$ = newlist($1); + + | + + const_list ',' const + + = $$ = addlist($1, $3); + + ; + + + +/* + + * TYPES + + */ + + + +type: + + simple_type + + | + + '^' YID + + = $$ = tree3(T_TYPTR, lineof($1), tree2(T_ID, $2)); + + | + + struct_type + + | + + YPACKED struct_type + + = $$ = tree3(T_TYPACK, lineof($1), $2); + + ; + +simple_type: + + type_id + + | + + '(' id_list ')' + + = $$ = tree3(T_TYSCAL, lineof($1), fixlist($2)); + + | + + const YDOTDOT const + + = $$ = tree4(T_TYRANG, lineof($2), $1, $3); + + ; + +struct_type: + + YARRAY '[' simple_type_list ']' YOF type + + = $$ = tree4(T_TYARY, lineof($1), fixlist($3), $6); + + | + + YFILE YOF type + + = $$ = tree3(T_TYFILE, lineof($1), $3); + + | + + YSET YOF simple_type + + = $$ = tree3(T_TYSET, lineof($1), $3); + + | + + YRECORD field_list YEND + + = { + + $$ = setuptyrec( lineof( $1 ) , $2 ); + + if ($3 < 0) + + brerror($1, "record"); + + } + + ; + +simple_type_list: + + simple_type + + = $$ = newlist($1); + + | + + simple_type_list ',' simple_type + + = $$ = addlist($1, $3); + + ; + + + +/* + + * RECORD TYPE + + */ + +field_list: + + fixed_part variant_part + + = $$ = tree4(T_FLDLST, lineof(NIL), fixlist($1), $2); + + ; + +fixed_part: + + field + + = $$ = newlist($1); + + | + + fixed_part ';' field + + = $$ = addlist($1, $3); + + | + + fixed_part error + + = yyPerror("Malformed record declaration", PDECL); + + ; + +field: + + /* lambda */ + + = $$ = NIL; + + | + + id_list ':' type + + = $$ = tree4(T_RFIELD, lineof($2), fixlist($1), $3); + + ; + + + +variant_part: + + /* lambda */ + + = $$ = NIL; + + | + + YCASE type_id YOF variant_list + + = $$ = tree5(T_TYVARPT, lineof($1), NIL, $2, fixlist($4)); + + | + + YCASE YID ':' type_id YOF variant_list + + = $$ = tree5(T_TYVARPT, lineof($1), $2, $4, fixlist($6)); + + ; + +variant_list: + + variant + + = $$ = newlist($1); + + | + + variant_list ';' variant + + = $$ = addlist($1, $3); + + | + + variant_list error + + = yyPerror("Malformed record declaration", PDECL); + + ; + +variant: + + /* lambda */ + + = $$ = NIL; + + | + + const_list ':' '(' field_list ')' + + = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), $4); + + | + + const_list ':' '(' ')' + + = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), NIL); + + ; + + + +/* + + * STATEMENT LIST + + */ + + + +stat_list: + + stat + + = $$ = newlist($1); + + | + + stat_lsth stat + + = { + + if ((p = $1) != NIL && (q = p[1])[0] == T_IFX) { + + q[0] = T_IFEL; + + q[4] = $2; + + } else + + $$ = addlist($1, $2); + + } + + ; + + + +stat_lsth: + + stat_list ';' + + = if ((q = $1) != NIL && (p = q[1]) != NIL && p[0] == T_IF) { + + if (yychar < 0) + + yychar = yylex(); + + if (yyshifts >= 2 && yychar == YELSE) { + + recovered(); + + copy(&Y, &OY, sizeof Y); + + yerror("Deleted ';' before keyword else"); + + yychar = yylex(); + + p[0] = T_IFX; + + } + + } + + ; + + + +/* + + * CASE STATEMENT LIST + + */ + + + +cstat_list: + + cstat + + = $$ = newlist($1); + + | + + cstat_list ';' cstat + + = $$ = addlist($1, $3); + + | + + error + + = { + + $$ = NIL; + +Kerror: + + yyPerror("Malformed statement in case", PSTAT); + + } + + | + + cstat_list error + + = goto Kerror; + + ; + + + +cstat: + + const_list ':' stat + + = $$ = tree4(T_CSTAT, lineof($2), fixlist($1), $3); + + | + + YCASELAB stat + + = $$ = tree4(T_CSTAT, lineof($1), NIL, $2); + + | + + /* lambda */ + + = $$ = NIL; + + ; + + + +/* + + * STATEMENT + + */ + + + +stat: + + /* lambda */ + + = $$ = NIL; + + | + + YINT ':' stat + + = $$ = tree4(T_LABEL, lineof($2), $1 == NIL ? NIL : *hash($1, 1), $3); + + | + + proc_id + + = $$ = tree4(T_PCALL, lineof(yyline), $1, NIL); + + | + + proc_id '(' wexpr_list ')' + + = $$ = tree4(T_PCALL, lineof($2), $1, fixlist($3)); + + | + + YID error + + = goto NSerror; + + | + + assign + + | + + YBEGIN stat_list YEND + + = { + + $$ = tree3(T_BLOCK, lineof($1), fixlist($2)); + + if ($3 < 0) + + brerror($1, "begin"); + + } + + | + + YCASE expr YOF cstat_list YEND + + = { + + $$ = tree4(T_CASE, lineof($1), $2, fixlist($4)); + + if ($5 < 0) + + brerror($1, "case"); + + } + + | + + YWITH var_list YDO stat + + = $$ = tree4(T_WITH, lineof($1), fixlist($2), $4); + + | + + YWHILE expr YDO stat + + = $$ = tree4(T_WHILE, lineof($1), $2, $4); + + | + + YREPEAT stat_list YUNTIL expr + + = $$ = tree4(T_REPEAT, lineof($3), fixlist($2), $4); + + | + + YFOR assign YTO expr YDO stat + + = $$ = tree5(T_FORU, lineof($1), $2, $4, $6); + + | + + YFOR assign YDOWNTO expr YDO stat + + = $$ = tree5(T_FORD, lineof($1), $2, $4, $6); + + | + + YGOTO YINT + + = $$ = tree3(T_GOTO, lineof($1), *hash($2, 1)); + + | + + YIF expr YTHEN stat + + = $$ = tree5(T_IF, lineof($1), $2, $4, NIL); + + | + + YIF expr YTHEN stat YELSE stat + + = $$ = tree5(T_IFEL, lineof($1), $2, $4, $6); + + | + + YIF expr YTHEN stat YELSE + + = $$ = tree5(T_IFEL, lineof($1), $2, $4, NIL); + + | + + YASSERT '(' expr ')' + + = $$ = tree3(T_ASRT, lineof($1), $3); + + | + + error + + = { + +NSerror: + + $$ = NIL; + +Serror: + + yyPerror("Malformed statement", PSTAT); + + } + + ; + +assign: + + variable ':' '=' expr + + = $$ = tree4(T_ASGN, lineof($2), $1, $4); + + ; + + + +/* + + * EXPRESSION + + */ + + + +expr: + + error + + = { + +NEerror: + + $$ = NIL; + +Eerror: + + yyPerror("Missing/malformed expression", PEXPR); + + } + + | + + expr relop expr %prec '<' + + = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); + + | + + '+' expr %prec UNARYSIGN + + = $$ = tree3(T_PLUS, $2[1], $2); + + | + + '-' expr %prec UNARYSIGN + + = $$ = tree3(T_MINUS, $2[1], $2); + + | + + expr addop expr %prec '+' + + = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); + + | + + expr divop expr %prec '*' + + = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); + + | + + YNIL + + = $$ = tree2(T_NIL, NOCON); + + | + + YSTRING + + = $$ = tree3(T_STRNG, SAWCON, $1); + + | + + YINT + + = $$ = tree3(T_INT, NOCON, $1); + + | + + YBINT + + = $$ = tree3(T_BINT, NOCON, $1); + + | + + YNUMB + + = $$ = tree3(T_FINT, NOCON, $1); + + | + + variable + + | + + YID error + + = goto NEerror; + + | + + func_id '(' wexpr_list ')' + + = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3)); + + | + + '(' expr ')' + + = $$ = $2; + + | + + negop expr %prec YNOT + + = $$ = tree3(T_NOT, NOCON, $2); + + | + + '[' element_list ']' + + = $$ = tree3(T_CSET, SAWCON, fixlist($2)); + + | + + '[' ']' + + = $$ = tree3(T_CSET, SAWCON, NIL); + + ; + + + +element_list: + + element + + = $$ = newlist($1); + + | + + element_list ',' element + + = $$ = addlist($1, $3); + + ; + +element: + + expr + + | + + expr YDOTDOT expr + + = $$ = tree3(T_RANG, $1, $3); + + ; + + + +/* + + * QUALIFIED VARIABLES + + */ + + + +variable: + + YID + + = { - @ return (identis(var, VAR)); +++ @@ return (identis(var, VAR)); + + $$ = setupvar($1, NIL); + + } + + | + + qual_var + + = $1[3] = fixlist($1[3]); + + ; + +qual_var: + + array_id '[' expr_list ']' + + = $$ = setupvar($1, tree2(T_ARY, fixlist($3))); + + | + + qual_var '[' expr_list ']' + + = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3))); + + | + + record_id '.' field_id + + = $$ = setupvar($1, setupfield($3, NIL)); + + | + + qual_var '.' field_id + + = $1[3] = addlist($1[3], setupfield($3, NIL)); + + | + + ptr_id '^' + + = $$ = setupvar($1, tree1(T_PTR)); + + | + + qual_var '^' + + = $1[3] = addlist($1[3], tree1(T_PTR)); + + ; + + + +/* + + * Expression with write widths + + */ + +wexpr: + + expr + + | + + expr ':' expr + + = $$ = tree4(T_WEXP, $1, $3, NIL); + + | + + expr ':' expr ':' expr + + = $$ = tree4(T_WEXP, $1, $3, $5); + + | + + expr octhex + + = $$ = tree4(T_WEXP, $1, NIL, $2); + + | + + expr ':' expr octhex + + = $$ = tree4(T_WEXP, $1, $3, $4); + + ; + +octhex: + + YOCT + + = $$ = OCT; + + | + + YHEX + + = $$ = HEX; + + ; + + + +expr_list: + + expr + + = $$ = newlist($1); + + | + + expr_list ',' expr + + = $$ = addlist($1, $3); + + ; + + + +wexpr_list: + + wexpr + + = $$ = newlist($1); + + | + + wexpr_list ',' wexpr + + = $$ = addlist($1, $3); + + ; + + + +/* + + * OPERATORS + + */ + + + +relop: + + '=' = $$ = T_EQ; + + | + + '<' = $$ = T_LT; + + | + + '>' = $$ = T_GT; + + | + + '<' '>' = $$ = T_NE; + + | + + '<' '=' = $$ = T_LE; + + | + + '>' '=' = $$ = T_GE; + + | + + YIN = $$ = T_IN; + + ; + +addop: + + '+' = $$ = T_ADD; + + | + + '-' = $$ = T_SUB; + + | + + YOR = $$ = T_OR; + + | + + '|' = $$ = T_OR; + + ; + +divop: + + '*' = $$ = T_MULT; + + | + + '/' = $$ = T_DIVD; + + | + + YDIV = $$ = T_DIV; + + | + + YMOD = $$ = T_MOD; + + | + + YAND = $$ = T_AND; + + | + + '&' = $$ = T_AND; + + ; + + + +negop: + + YNOT + + | + + '~' + + ; + + + +/* + + * LISTS + + */ + + + +var_list: + + variable + + = $$ = newlist($1); + + | + + var_list ',' variable + + = $$ = addlist($1, $3); + + ; + + + +id_list: + + YID + + = $$ = newlist($1); + + | + + id_list ',' YID + + = $$ = addlist($1, $3); + + ; + + + +/* + + * Identifier productions with semantic restrictions + + * - * For these productions, the character @ signifies +++ * For these productions, the characters @@ signify + + * that the associated C statement is to provide + + * the semantic restriction for this reduction. + + * These lines are made into a procedure yyEactr, similar to + + * yyactr, which determines whether the corresponding reduction + + * is permitted, or whether an error is to be signaled. + + * A zero return from yyEactr is considered an error. + + * YyEactr is called with an argument "var" giving the string + + * name of the variable in question, essentially $1, although + + * $1 will not work because yyEactr is called from loccor in + + * the recovery routines. + + */ + + + +const_id: + + YID - = @ return (identis(var, CONST)); +++ = @@ return (identis(var, CONST)); + + ; + +type_id: + + YID + + = { - @ return (identis(var, TYPE)); +++ @@ return (identis(var, TYPE)); + + $$ = tree3(T_TYID, lineof(yyline), $1); + + } + + ; + +var_id: + + YID - = @ return (identis(var, VAR)); +++ = @@ return (identis(var, VAR)); + + ; + +array_id: + + YID - = @ return (identis(var, ARRAY)); +++ = @@ return (identis(var, ARRAY)); + + ; + +ptr_id: + + YID - = @ return (identis(var, PTRFILE)); +++ = @@ return (identis(var, PTRFILE)); + + ; + +record_id: + + YID - = @ return (identis(var, RECORD)); +++ = @@ return (identis(var, RECORD)); + + ; + +field_id: + + YID - = @ return (identis(var, FIELD)); +++ = @@ return (identis(var, FIELD)); + + ; + +proc_id: + + YID - = @ return (identis(var, PROC)); +++ = @@ return (identis(var, PROC)); + + ; + +func_id: + + YID - = @ return (identis(var, FUNC)); +++ = @@ return (identis(var, FUNC)); + + ; diff --cc usr/src/cmd/pi/pc.h index 0000000000,0000000000,0000000000..cd8a4e89fd new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pc.h @@@@ -1,0 -1,0 -1,0 +1,100 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)pc.h 1.2 10/14/80"; */ +++ +++ /* +++ * random constants for pc +++ */ +++ +++ /* +++ * the name of the display. +++ * the display is made up of saved AP's and FP's. +++ * FP's are used to find locals, and AP's are used to find parameters. +++ * FP and AP are untyped pointers, but are used throughout as (char *). +++ * the display is used by adding AP_OFFSET or FP_OFFSET to the +++ * address of the approriate display entry. +++ */ +++#define DISPLAYNAME "__disply" +++struct dispsave { +++ char *savedAP; +++ char *savedFP; +++}; +++#define AP_OFFSET ( 0 ) +++#define FP_OFFSET ( sizeof(char *) ) +++ +++ /* +++ * the structure below describes the locals used by the run time system. +++ * at function entry, at least this much space is allocated, +++ * and the following information is filled in: +++ * the address of a routine to close the current frame for unwinding, +++ * a pointer to the display entry for the current static level and +++ * the previous contents of the display for this static level. +++ * the curfile location is used to point to the currently active file, +++ * and is filled in as io is initiated. +++ * one of these structures is allocated on the (negatively growing) stack. +++ * at function entry, fp is set to point to the last field of the struct, +++ * thus the offsets of the fields are as indicated below. +++ */ +++struct rtlocals { +++ struct iorec *curfile; +++ struct dispsave dsave; +++ struct dispsave *dptr; +++ int (*unwind)(); +++} rtlocs; +++#define CURFILEOFFSET ( ( -sizeof rtlocs ) + sizeof rtlocs.unwind ) +++#define DSAVEOFFSET ( CURFILEOFFSET + sizeof rtlocs.curfile ) +++#define DPTROFFSET ( DSAVEOFFSET + sizeof rtlocs.dsave ) +++#define UNWINDOFFSET ( DPTROFFSET + sizeof rtlocs.dptr ) +++#define UNWINDNAME "_UNWIND" +++ +++ /* +++ * the register save mask for saving no registers +++ */ +++#define RSAVEMASK ( 0 ) +++ +++ /* +++ * runtime check mask for divide check and integer overflow +++ */ +++#define RUNCHECK ( ( 1 << 15 ) | ( 1 << 14 ) ) +++ +++ /* +++ * formats for various names +++ * NAMEFORMAT arbitrary length strings. +++ * EXTFORMAT for externals, a preceding underscore. +++ * PREFIXFORMAT used to print made up names with prefixes. +++ * LABELPREFIX with getlab() makes up label names. +++ * LLABELPREFIX with getlab() makes up sdb labels. +++ * a typical use might be to print out a name with a preceeding underscore +++ * with putprintf( EXTFORMAT , 0 , name ); +++ */ +++#define NAMEFORMAT "%s" +++#define EXTFORMAT "_%s" +++#define PREFIXFORMAT "%s%d" +++#define LABELPREFIX "L" +++#define LLABELPREFIX "LL" +++ +++ /* +++ * the name of the statement counter +++ */ +++#define STMTCOUNT "__stcnt" +++ +++ /* +++ * the name of the pcp counters +++ */ +++#define PCPCOUNT "__pcpcount" +++ +++ /* +++ * a vector of pointer to enclosing functions for fully qualified names. +++ */ +++char *enclosing[ DSPLYSZ ]; +++ +++ /* +++ * and of course ... +++ */ +++#define BITSPERBYTE 8 +++ +++ /* +++ * error number for case label not found (ECASE) +++ * stolen from ~mckusick/px/lib/h01errs.h +++ */ +++#define ECASE 5 diff --cc usr/src/cmd/pi/pccaseop.c index 0000000000,0000000000,0000000000..79321a1c6b new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pccaseop.c @@@@ -1,0 -1,0 -1,0 +1,332 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pccaseop.c 1.4 10/8/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and the rest of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "objfmt.h" +++#include "pcops.h" +++#include "pc.h" +++ +++ /* +++ * structure for a case: +++ * its constant label, line number (for errors), and location label. +++ */ +++struct ct { +++ long cconst; +++ int cline; +++ int clabel; +++}; +++ +++ /* +++ * the P2FORCE operator puts its operand into a register. +++ * these to keep from thinking of it as r0 all over. +++ */ +++#define FORCENAME "r0" +++#define FORCENUMBER 0 +++ +++ /* +++ * given a tree for a case statement, generate code for it. +++ * this computes the expression into a register, +++ * puts down the code for each of the cases, +++ * and then decides how to do the case switching. +++ * tcase [0] T_CASE +++ * [1] lineof "case" +++ * [2] expression +++ * [3] list of cased statements: +++ * cstat [0] T_CSTAT +++ * [1] lineof ":" +++ * [2] list of constant labels +++ * [3] statement +++ */ +++pccaseop( tcase ) +++ int *tcase; +++{ +++ struct nl *exprtype; +++ struct nl *rangetype; +++ long low; +++ long high; +++ long exprctype; +++ long swlabel; +++ long endlabel; +++ long label; +++ long count; +++ long *cstatlp; +++ long *cstatp; +++ long *casep; +++ struct ct *ctab; +++ struct ct *ctp; +++ long i; +++ long nr; +++ long goc; +++ int casecmp(); +++ bool dupcases; +++ +++ goc = gocnt; +++ /* +++ * find out the type of the case expression +++ * even if the expression has errors (exprtype == NIL), continue. +++ */ +++ line = tcase[1]; +++ exprtype = rvalue( (int *) tcase[2] , NIL , RREQ ); +++ if ( exprtype != NIL ) { +++ if ( isnta( exprtype , "bcsi" ) ) { +++ error("Case selectors cannot be %ss" , nameof( exprtype ) ); +++ exprtype = NIL; +++ } else { +++ if ( exprtype -> class != RANGE ) { +++ rangetype = exprtype -> type; +++ } else { +++ rangetype = exprtype; +++ } +++ if ( rangetype == NIL ) { +++ exprtype = NIL; +++ } else { +++ low = rangetype -> range[0]; +++ high = rangetype -> range[1]; +++ } +++ } +++ } +++ if ( exprtype != NIL ) { +++ /* +++ * put expression into a register +++ * save its c-type and jump to the code to do the switch. +++ */ +++ putop( P2FORCE , P2INT ); +++ putdot( filename , line ); +++ exprctype = p2type( exprtype ); +++ swlabel = getlab(); +++ putjbr( swlabel ); +++ } +++ /* +++ * count the number of cases +++ * and allocate table for cases, lines, and labels +++ * default case goes in ctab[0]. +++ */ +++ count = 1; +++ for ( cstatlp = tcase[3] ; cstatlp != NIL ; cstatlp = cstatlp[2] ) { +++ cstatp = cstatlp[1]; +++ if ( cstatp == NIL ) { +++ continue; +++ } +++ for ( casep = cstatp[2] ; casep != NIL ; casep = casep[2] ) { +++ count++; +++ } +++ } +++ /* +++ */ +++ ctab = (struct ct *) malloc( count * sizeof( struct ct ) ); +++ if ( ctab == (struct ct *) 0 ) { +++ error("Ran out of memory (case)"); +++ pexit( DIED ); +++ } +++ /* +++ * pick up default label and label for after case statement. +++ */ +++ ctab[0].clabel = getlab(); +++ endlabel = getlab(); +++ /* +++ * generate code for each case +++ * filling in ctab for each. +++ * nr is for error if no case falls out bottom. +++ */ +++ nr = 1; +++ count = 0; +++ for ( cstatlp = tcase[3] ; cstatlp != NIL ; cstatlp = cstatlp[2] ) { +++ cstatp = cstatlp[1]; +++ if ( cstatp == NIL ) { +++ continue; +++ } +++ line = cstatp[1]; +++ label = getlab(); +++ for ( casep = cstatp[2] ; casep != NIL ; casep = casep[2] ) { +++ gconst( casep[1] ); +++ if( exprtype == NIL || con.ctype == NIL ) { +++ continue; +++ } +++ if ( incompat( con.ctype , exprtype , NIL ) ) { +++ cerror("Case label type clashed with case selector expression type"); +++ continue; +++ } +++ if ( con.crval < low || con.crval > high ) { +++ error("Case label out of range"); +++ continue; +++ } +++ count++; +++ ctab[ count ].cconst = con.crval; +++ ctab[ count ].cline = line; +++ ctab[ count ].clabel = label; +++ } +++ /* +++ * put out the statement +++ */ +++ putlab( label ); +++ putcnt(); +++ level++; +++ statement( cstatp[3] ); +++ nr &= noreach; +++ noreach = 0; +++ level--; +++ if (gotos[cbn]) { +++ ungoto(); +++ } +++ putjbr( endlabel ); +++ } +++ noreach = nr; +++ /* +++ * default action is to call error +++ */ +++ putlab( ctab[0].clabel ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_ERROR" ); +++ putleaf( P2ICON , ECASE , 0 , P2INT , 0 ); +++ putleaf( P2REG , FORCENUMBER , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ /* +++ * sort the cases +++ */ +++ qsort( &ctab[1] , count , sizeof (struct ct) , casecmp ); +++ /* +++ * check for duplicates +++ */ +++ dupcases = FALSE; +++ for ( ctp = &ctab[1] ; ctp < &ctab[ count ] ; ctp++ ) { +++ if ( ctp[0].cconst == ctp[1].cconst ) { +++ error("Multiply defined label in case, lines %d and %d" , +++ ctp[0].cline , ctp[1].cline ); +++ dupcases = TRUE; +++ } +++ } +++ if ( dupcases ) { +++ return; +++ } +++ /* +++ * choose a switch algorithm and implement it: +++ * direct switch >= 1/3 full and >= 4 cases. +++ * binary switch not direct switch and > 8 cases. +++ * ifthenelse not direct or binary switch. +++ */ +++ putlab( swlabel ); +++ if ( ctab[ count ].cconst - ctab[1].cconst < 3 * count && count >= 4 ) { +++ directsw( ctab , count ); +++ } else if ( count > 8 ) { +++ binarysw( ctab , count ); +++ } else { +++ itesw( ctab , count ); +++ } +++ putlab( endlabel ); +++ if ( goc != gocnt ) { +++ putcnt(); +++ } +++} +++ +++ /* +++ * direct switch +++ */ +++directsw( ctab , count ) +++ struct ct *ctab; +++ int count; +++{ +++ int fromlabel = getlab(); +++ long i; +++ long j; +++ +++ putprintf( " casel %s,$%d,$%d" , 0 , FORCENAME , +++ ctab[1].cconst , ctab[ count ].cconst - ctab[1].cconst ); +++ putlab( fromlabel ); +++ i = 1; +++ j = ctab[1].cconst; +++ while ( i <= count ) { +++ if ( j == ctab[ i ].cconst ) { +++ putprintf( " .word " , 1 ); +++ putprintf( PREFIXFORMAT , 1 , LABELPREFIX , ctab[ i ].clabel ); +++ putprintf( "-" , 1 ); +++ putprintf( PREFIXFORMAT , 0 , LABELPREFIX , fromlabel ); +++ i++; +++ } else { +++ putprintf( " .word " , 1 ); +++ putprintf( PREFIXFORMAT , 1 , LABELPREFIX , ctab[ 0 ].clabel ); +++ putprintf( "-" , 1 ); +++ putprintf( PREFIXFORMAT , 0 , LABELPREFIX , fromlabel ); +++ } +++ j++; +++ } +++ putjbr( ctab[0].clabel ); +++} +++ +++ /* +++ * binary switch +++ * special case out default label and start recursion. +++ */ +++binarysw( ctab , count ) +++ struct ct *ctab; +++ int count; +++{ +++ +++ bsrecur( ctab[0].clabel , &ctab[0] , count ); +++} +++ +++ /* +++ * recursive log( count ) search. +++ */ +++bsrecur( deflabel , ctab , count ) +++ int deflabel; +++ struct ct *ctab; +++ int count; +++{ +++ +++ if ( count <= 0 ) { +++ putprintf( " jbr L%d" , 0 , deflabel ); +++ return; +++ } else if ( count == 1 ) { +++ putprintf( " cmpl %s,$%d" , 0 , FORCENAME , ctab[1].cconst ); +++ putprintf( " jeql L%d" , 0 , ctab[1].clabel ); +++ putprintf( " jbr L%d" , 0 , deflabel ); +++ return; +++ } else { +++ int half = ( count + 1 ) / 2; +++ int gtrlabel = getlab(); +++ +++ putprintf( " cmpl %s,$%d" , 0 , FORCENAME , ctab[ half ].cconst ); +++ putprintf( " jgtr L%d" , 0 , gtrlabel ); +++ putprintf( " jeql L%d" , 0 , ctab[ half ].clabel ); +++ bsrecur( deflabel , &ctab[0] , half - 1 ); +++ putprintf( "L%d:" , 0 , gtrlabel ); +++ bsrecur( deflabel , &ctab[ half ] , count - half ); +++ return; +++ } +++} +++ +++itesw( ctab , count ) +++ struct ct *ctab; +++ int count; +++{ +++ int i; +++ +++ for ( i = 1 ; i <= count ; i++ ) { +++ putprintf( " cmpl %s,$%d" , 0 , FORCENAME , ctab[ i ].cconst ); +++ putprintf( " jeql L%d" , 0 , ctab[ i ].clabel ); +++ } +++ putprintf( " jbr L%d" , 0 , ctab[0].clabel ); +++ return; +++} +++int +++casecmp( this , that ) +++ struct ct *this; +++ struct ct *that; +++{ +++ if ( this -> cconst < that -> cconst ) { +++ return -1; +++ } else if ( this -> cconst > that -> cconst ) { +++ return 1; +++ } else { +++ return 0; +++ } +++} +++#endif PC diff --cc usr/src/cmd/pi/pcforop.c index 0000000000,0000000000,0000000000..ae13546a93 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pcforop.c @@@@ -1,0 -1,0 -1,0 +1,241 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pcforop.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and the rest of the file +++ */ +++#include "0.h" +++#include "opcode.h" +++#include "tree.h" +++#include "pc.h" +++#include "pcops.h" +++ /* +++ * forop for pc: +++ * this evaluates the initial and termination expressions, +++ * checks them to see if the loop executes at all, and then +++ * does the assignment and the loop. +++ * arg here looks like: +++ * arg[0] T_FORU or T_FORD +++ * [1] lineof "for" +++ * [2] [0] T_ASGN +++ * [1] lineof ":=" +++ * [2] [0] T_VAR +++ * [1] lineof id +++ * [2] char * to id +++ * [3] qualifications +++ * [3] initial expression +++ * [3] termination expression +++ * [4] statement +++ */ +++pcforop( arg ) +++ int *arg; +++ { +++ int *lhs; +++ struct nl *forvar; +++ struct nl *fortype; +++ int forctype; +++ int *init; +++ struct nl *inittype; +++ int initoff; +++ int *term; +++ struct nl *termtype; +++ int termoff; +++ int *stat; +++ int goc; /* saved gocnt */ +++ int again; /* label at the top of the loop */ +++ int after; /* label after the end of the loop */ +++ +++ goc = gocnt; +++ forvar = NIL; +++ if ( arg == NIL ) { +++ goto byebye; +++ } +++ if ( arg[2] == NIL ) { +++ goto byebye; +++ } +++ line = arg[1]; +++ putline(); +++ lhs = ( (int *) arg[2] )[2]; +++ init = ( (int *) arg[2] )[3]; +++ term = arg[3]; +++ stat = arg[4]; +++ if ( lhs[3] != NIL ) { +++ error("For variable must be unqualified"); +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ /* +++ * and this marks the variable as used!!! +++ */ +++ forvar = lookup( lhs[2] ); +++ if ( forvar == NIL ) { +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ /* +++ * find out the type of the loop variable +++ */ +++ codeoff(); +++ fortype = lvalue( lhs , MOD , RREQ ); +++ codeon(); +++ /* +++ * mark the forvar so we can't change it during the loop +++ */ +++ forvar -> value[ NL_FORV ] = 1; +++ if ( fortype == NIL ) { +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ if ( isnta( fortype , "bcis" ) ) { +++ error("For variables cannot be %ss" , nameof( fortype ) ); +++ rvalue( init , NIL , RREQ ); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ forctype = p2type( fortype ); +++ /* +++ * allocate space for the initial and termination expressions +++ */ +++ sizes[cbn].om_off -= sizeof( long ); +++ initoff = sizes[cbn].om_off; +++ sizes[cbn].om_off -= sizeof( long ); +++ termoff = sizes[cbn].om_off; +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ if ( sizes[cbn].om_off < sizes[cbn].om_max ) { +++ sizes[cbn].om_max = sizes[cbn].om_off; +++ } +++ /* +++ * compute and save the initial expression +++ */ +++ putRV( 0 , cbn , initoff , forctype ); +++ inittype = rvalue( init , fortype , RREQ ); +++ if ( incompat( inittype , fortype , init ) ) { +++ cerror("Type of initial expression clashed with index type in 'for' statement"); +++ rvalue( term , NIL , RREQ ); +++ statement( stat ); +++ goto byebye; +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * compute and save the termination expression +++ */ +++ putRV( 0 , cbn , termoff , forctype ); +++ termtype = rvalue( term , fortype , RREQ ); +++ if ( incompat( termtype , fortype , term ) ) { +++ cerror("Type of limit expression clashed with index type in 'for' statement"); +++ statement( stat ); +++ goto byebye; +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * we can skip the loop altogether if !( init <= term ) +++ */ +++ after = getlab(); +++ putRV( 0 , cbn , initoff , forctype ); +++ putRV( 0 , cbn , termoff , forctype ); +++ putop( ( arg[0] == T_FORU ? P2LE : P2GE ) , forctype ); +++ putleaf( P2ICON , after , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++ /* +++ * okay, then we have to execute the body, +++ * but first, assign the initial expression to the for variable. +++ * see the note in asgnop1 about why this is an rvalue. +++ */ +++ rvalue( lhs , NIL , RREQ ); +++ if ( opt( 't' ) ) { +++ precheck( fortype , "_RANG4" , "_RSNG4" ); +++ } +++ putRV( 0 , cbn , initoff , forctype ); +++ if ( opt( 't' ) ) { +++ postcheck( fortype ); +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * put down the label at the top of the loop +++ */ +++ again = getlab(); +++ putlab( again ); +++ putcnt(); +++ /* +++ * and don't forget ... +++ */ +++ statement( arg[ 4 ] ); +++ /* +++ * wasn't that fun? do we get to do it again? +++ * we don't do it again if ( !( forvar < limit ) ) +++ * pretend we were doing this at the top of the loop +++ */ +++ line = arg[ 1 ]; +++ if ( opt( 'p' ) ) { +++ if ( opt('t') ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_LINO" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else { +++ putRV( STMTCOUNT , 0 , 0 , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2ASG P2PLUS , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++ rvalue( lhs , NIL , RREQ ); +++ putRV( 0 , cbn , termoff , forctype ); +++ putop( ( arg[ 0 ] == T_FORU ? P2LT : P2GT ) , forctype ); +++ putleaf( P2ICON , after , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++ /* +++ * okay, so we have to do it again, +++ * but first, increment the for variable. +++ * there it is again, an rvalue on the lhs of an assignment. +++ */ +++ rvalue( lhs , NIL , RREQ ); +++ if ( opt( 't' ) ) { +++ precheck( fortype , "_RANG4" , "_RSNG4" ); +++ } +++ rvalue( lhs , NIL , RREQ ); +++ putleaf( P2ICON , 1 , 0 , forctype , 0 ); +++ putop( ( arg[0] == T_FORU ? P2PLUS : P2MINUS ) , forctype ); +++ if ( opt( 't' ) ) { +++ postcheck( fortype ); +++ } +++ putop( P2ASSIGN , forctype ); +++ putdot( filename , line ); +++ /* +++ * and do it all again +++ */ +++ putjbr( again ); +++ /* +++ * deallocate the initial and limit variables +++ */ +++ sizes[cbn].om_off += 2 * ( sizeof( long ) ); +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ /* +++ * and here we are +++ */ +++ putlab( after ); +++byebye: +++ noreach = 0; +++ if ( forvar != NIL ) { +++ forvar -> value[ NL_FORV ] = 0; +++ } +++ if ( goc != gocnt ) { +++ putcnt(); +++ } +++ } +++#endif PC diff --cc usr/src/cmd/pi/pcfunc.c index 0000000000,0000000000,0000000000..288c8656d3 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pcfunc.c @@@@ -1,0 -1,0 -1,0 +1,367 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pcfunc.c 1.3 10/19/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and to the end of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "pc.h" +++#include "pcops.h" +++ +++/* +++ * Funccod generates code for +++ * built in function calls and calls +++ * call to generate calls to user +++ * defined functions and procedures. +++ */ +++pcfunccod( r ) +++ int *r; +++{ +++ struct nl *p; +++ register struct nl *p1; +++ register int *al; +++ register op; +++ int argc, *argv; +++ int tr[2], tr2[4]; +++ char *funcname; +++ long tempoff; +++ long temptype; +++ struct nl *rettype; +++ +++ /* +++ * Verify that the given name +++ * is defined and the name of +++ * a function. +++ */ +++ p = lookup(r[2]); +++ if (p == NIL) { +++ rvlist(r[3]); +++ return (NIL); +++ } +++ if (p->class != FUNC && p->class != FFUNC) { +++ error("%s is not a function", p->symbol); +++ rvlist(r[3]); +++ return (NIL); +++ } +++ argv = r[3]; +++ /* +++ * Call handles user defined +++ * procedures and functions +++ */ +++ if (bn != 0) +++ return (call(p, argv, FUNC, bn)); +++ /* +++ * Count the arguments +++ */ +++ argc = 0; +++ for (al = argv; al != NIL; al = al[2]) +++ argc++; +++ /* +++ * Built-in functions have +++ * their interpreter opcode +++ * associated with them. +++ */ +++ op = p->value[0] &~ NSTAND; +++ if (opt('s') && (p->value[0] & NSTAND)) { +++ standard(); +++ error("%s is a nonstandard function", p->symbol); +++ } +++ if ( op == O_ARGC ) { +++ putleaf( P2NAME , 0 , 0 , P2INT , "__argc" ); +++ return nl + T4INT; +++ } +++ switch (op) { +++ /* +++ * Parameterless functions +++ */ +++ case O_CLCK: +++ funcname = "_CLCK"; +++ goto noargs; +++ case O_SCLCK: +++ funcname = "_SCLCK"; +++ goto noargs; +++noargs: +++ if (argc != 0) { +++ error("%s takes no arguments", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , funcname ); +++ putop( P2UNARY P2CALL , P2INT ); +++ return (nl+T4INT); +++ case O_WCLCK: +++ if (argc != 0) { +++ error("%s takes no arguments", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_time" ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2CALL , P2INT ); +++ return (nl+T4INT); +++ case O_EOF: +++ case O_EOLN: +++ if (argc == 0) { +++ argv = tr; +++ tr[1] = tr2; +++ tr2[0] = T_VAR; +++ tr2[2] = input->symbol; +++ tr2[1] = tr2[3] = NIL; +++ argc = 1; +++ } else if (argc != 1) { +++ error("%s takes either zero or one argument", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ } +++ /* +++ * All other functions take +++ * exactly one argument. +++ */ +++ if (argc != 1) { +++ error("%s takes exactly one argument", p->symbol); +++ rvlist(argv); +++ return (NIL); +++ } +++ /* +++ * find out the type of the argument +++ */ +++ codeoff(); +++ p1 = stkrval((int *) argv[1], NLNIL , RREQ ); +++ codeon(); +++ if (p1 == NIL) +++ return (NIL); +++ /* +++ * figure out the return type and the funtion name +++ */ +++ switch (op) { +++ case O_EXP: +++ funcname = "_exp"; +++ goto mathfunc; +++ case O_SIN: +++ funcname = "_sin"; +++ goto mathfunc; +++ case O_COS: +++ funcname = "_cos"; +++ goto mathfunc; +++ case O_ATAN: +++ funcname = "_atan"; +++ goto mathfunc; +++ case O_LN: +++ funcname = opt('t') ? "_LN" : "_log"; +++ goto mathfunc; +++ case O_SQRT: +++ funcname = opt('t') ? "_SQRT" : "_sqrt"; +++ goto mathfunc; +++ case O_RANDOM: +++ funcname = "_RANDOM"; +++ goto mathfunc; +++mathfunc: +++ if (isnta(p1, "id")) { +++ error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2DOUBLE , P2PTR ) , funcname ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ if ( isa( p1 , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ putop( P2CALL , P2DOUBLE ); +++ return nl + TDOUBLE; +++ case O_EXPO: +++ if (isnta( p1 , "id" ) ) { +++ error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_EXPO" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ if ( isa( p1 , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ putop( P2CALL , P2INT ); +++ return ( nl + T4INT ); +++ case O_UNDEF: +++ if ( isnta( p1 , "id" ) ) { +++ error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2COMOP , P2INT ); +++ return ( nl + TBOOL ); +++ case O_SEED: +++ if (isnta(p1, "i")) { +++ error("seed's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_SEED" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2INT ); +++ return nl + T4INT; +++ case O_ROUND: +++ case O_TRUNC: +++ if ( isnta( p1 , "d" ) ) { +++ error("%s's argument must be a real, not %s", p->symbol, nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_ROUND ? "_ROUND" : "_TRUNC" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2INT ); +++ return nl + T4INT; +++ case O_ABS2: +++ if ( isa( p1 , "d" ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2DOUBLE , P2PTR ) +++ , "_fabs" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2DOUBLE ); +++ return nl + TDOUBLE; +++ } +++ if ( isa( p1 , "i" ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_abs" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2INT ); +++ return nl + T4INT; +++ } +++ error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ case O_SQR2: +++ if ( isa( p1 , "d" ) ) { +++ temptype = P2DOUBLE; +++ rettype = nl + TDOUBLE; +++ sizes[ cbn ].om_off -= sizeof( double ); +++ } else if ( isa( p1 , "i" ) ) { +++ temptype = P2INT; +++ rettype = nl + T4INT; +++ sizes[ cbn ].om_off -= sizeof( long ); +++ } else { +++ error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ tempoff = sizes[ cbn ].om_off; +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putlbracket( ftnno , -tempoff ); +++ putRV( 0 , cbn , tempoff , temptype , 0 ); +++ p1 = rvalue( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2ASSIGN , temptype ); +++ putRV( 0 , cbn , tempoff , temptype , 0 ); +++ putRV( 0 , cbn , tempoff , temptype , 0 ); +++ putop( P2MUL , temptype ); +++ putop( P2COMOP , temptype ); +++ return rettype; +++ case O_ORD2: +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ if (isa(p1, "bcis") || classify(p1) == TPTR) { +++ return (nl+T4INT); +++ } +++ error("ord's argument must be of scalar type or a pointer, not %s", nameof(p1)); +++ return (NIL); +++ case O_SUCC2: +++ case O_PRED2: +++ if (isa(p1, "d")) { +++ error("%s is forbidden for reals", p->symbol); +++ return (NIL); +++ } +++ if ( isnta( p1 , "bcsi" ) ) { +++ error("%s's argument must be of scalar type, not %s", p->symbol, nameof(p1)); +++ return NIL; +++ } +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_SUCC2 ? "_SUCC" : "_PRED" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putleaf( P2ICON , p1 -> range[0] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , p1 -> range[1] , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } else { +++ p1 = rvalue( argv[1] , NIL , RREQ ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( op == O_SUCC2 ? P2PLUS : P2MINUS , P2INT ); +++ } +++ if ( isa( p1 , "bcs" ) ) { +++ return p1; +++ } else { +++ return nl + T4INT; +++ } +++ case O_ODD2: +++ if (isnta(p1, "i")) { +++ error("odd's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ p1 = rvalue( (int *) argv[1] , NLNIL , RREQ ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2AND , P2INT ); +++ return nl + TBOOL; +++ case O_CHR2: +++ if (isnta(p1, "i")) { +++ error("chr's argument must be an integer, not %s", nameof(p1)); +++ return (NIL); +++ } +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2CHAR , P2PTR ) , "_CHR" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ putop( P2CALL , P2CHAR ); +++ } else { +++ p1 = stkrval( (int *) argv[1] , NLNIL , RREQ ); +++ } +++ return nl + TCHAR; +++ case O_CARD: +++ if (isnta(p1, "t")) { +++ error("Argument to card must be a set, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_CARD" ); +++ p1 = stkrval( (int *) argv[1] , NLNIL , LREQ ); +++ putleaf( P2ICON , lwidth( p1 ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ return nl + T2INT; +++ case O_EOLN: +++ if (!text(p1)) { +++ error("Argument to eoln must be a text file, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_TEOLN" ); +++ p1 = stklval( (int *) argv[1] , NOFLAGS ); +++ putop( P2CALL , P2INT ); +++ return nl + TBOOL; +++ case O_EOF: +++ if (p1->class != FILET) { +++ error("Argument to eof must be file, not %s", nameof(p1)); +++ return (NIL); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_TEOF" ); +++ p1 = stklval( (int *) argv[1] , NOFLAGS ); +++ putop( P2CALL , P2INT ); +++ return nl + TBOOL; +++ case 0: +++ error("%s is an unimplemented 6000-3.4 extension", p->symbol); +++ default: +++ panic("func1"); +++ } +++} +++#endif PC diff --cc usr/src/cmd/pi/pclval.c index 0000000000,0000000000,0000000000..5beca73d53 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pclval.c @@@@ -1,0 -1,0 -1,0 +1,340 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pclval.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++ /* +++ * and the rest of the file +++ */ +++# include "pc.h" +++# include "pcops.h" +++ +++extern int flagwas; +++/* +++ * pclvalue computes the address +++ * of a qualified name and +++ * leaves it on the stack. +++ * for pc, it can be asked for either an lvalue or an rvalue. +++ * the semantics are the same, only the code is different. +++ * for putting out calls to check for nil and fnil, +++ * we have to traverse the list of qualifications twice: +++ * once to put out the calls and once to put out the address to be checked. +++ */ +++struct nl * +++pclvalue( r , modflag , required ) +++ int *r; +++ int modflag; +++ int required; +++{ +++ register struct nl *p; +++ register *c, *co; +++ int f, o; +++ int tr[2], trp[3]; +++ struct nl *firstp; +++ struct nl *lastp; +++ char *firstsymbol; +++ int firstbn; +++ +++ if ( r == NIL ) { +++ return NIL; +++ } +++ if ( nowexp( r ) ) { +++ return NIL; +++ } +++ if ( r[0] != T_VAR ) { +++ error("Variable required"); /* Pass mesgs down from pt of call ? */ +++ return NIL; +++ } +++ firstp = p = lookup( r[2] ); +++ if ( p == NIL ) { +++ return NIL; +++ } +++ firstsymbol = p -> symbol; +++ firstbn = bn; +++ c = r[3]; +++ if ( ( modflag & NOUSE ) && ! lptr( c ) ) { +++ p -> nl_flags = flagwas; +++ } +++ if ( modflag & MOD ) { +++ p -> nl_flags |= NMOD; +++ } +++ /* +++ * Only possibilities for p -> class here +++ * are the named classes, i.e. CONST, TYPE +++ * VAR, PROC, FUNC, REF, or a WITHPTR. +++ */ +++ if ( p -> class == WITHPTR ) { +++ /* +++ * Construct the tree implied by +++ * the with statement +++ */ +++ trp[0] = T_LISTPP; +++ trp[1] = tr; +++ trp[2] = r[3]; +++ tr[0] = T_FIELD; +++ tr[1] = r[2]; +++ c = trp; +++ } +++ /* +++ * this not only puts out the names of functions to call +++ * but also does all the semantic checking of the qualifications. +++ */ +++ if ( ! nilfnil( p , c , modflag , firstp , r[2] ) ) { +++ return NIL; +++ } +++ switch (p -> class) { +++ case WITHPTR: +++ case REF: +++ /* +++ * Obtain the indirect word +++ * of the WITHPTR or REF +++ * as the base of our lvalue +++ */ +++ putRV( firstsymbol , firstbn , p -> value[ 0 ] +++ , p2type( p ) ); +++ firstsymbol = 0; +++ f = 0; /* have an lv on stack */ +++ o = 0; +++ break; +++ case VAR: +++ f = 1; /* no lv on stack yet */ +++ o = p -> value[0]; +++ break; +++ default: +++ error("%s %s found where variable required", classes[p -> class], p -> symbol); +++ return (NIL); +++ } +++ /* +++ * Loop and handle each +++ * qualification on the name +++ */ +++ if ( c == NIL && ( modflag & ASGN ) && p -> value[ NL_FORV ] ) { +++ error("Can't modify the for variable %s in the range of the loop", p -> symbol); +++ return (NIL); +++ } +++ for ( ; c != NIL ; c = c[2] ) { +++ co = c[1]; +++ if ( co == NIL ) { +++ return NIL; +++ } +++ lastp = p; +++ p = p -> type; +++ if ( p == NIL ) { +++ return NIL; +++ } +++ switch ( co[0] ) { +++ case T_PTR: +++ /* +++ * Pointer qualification. +++ */ +++ if ( f ) { +++ putLV( firstsymbol , firstbn , o +++ , p2type( p ) ); +++ firstsymbol = 0; +++ } else { +++ if (o) { +++ putleaf( P2ICON , o , 0 , P2INT +++ , 0 ); +++ putop( P2PLUS , P2PTR | P2CHAR ); +++ } +++ } +++ /* +++ * Pointer cannot be +++ * nil and file cannot +++ * be at end-of-file. +++ * the appropriate function name is +++ * already out there from nilfnil. +++ */ +++ if ( p -> class == PTR ) { +++ /* +++ * this is the indirection from +++ * the address of the pointer +++ * to the pointer itself. +++ * kirk sez: +++ * fnil doesn't want this. +++ * and does it itself for files +++ * since only it knows where the +++ * actual window is. +++ * but i have to do this for +++ * regular pointers. +++ */ +++ putop( P2UNARY P2MUL , p2type( p ) ); +++ if ( opt( 't' ) ) { +++ putop( P2CALL , P2INT ); +++ } +++ } else { +++ putop( P2CALL , P2INT ); +++ } +++ f = o = 0; +++ continue; +++ case T_ARGL: +++ case T_ARY: +++ if ( f ) { +++ putLV( firstsymbol , firstbn , o +++ , p2type( p ) ); +++ firstsymbol = 0; +++ } else { +++ if (o) { +++ putleaf( P2ICON , o , 0 , P2INT +++ , 0 ); +++ putop( P2PLUS , P2INT ); +++ } +++ } +++ arycod( p , co[1] ); +++ f = o = 0; +++ continue; +++ case T_FIELD: +++ /* +++ * Field names are just +++ * an offset with some +++ * semantic checking. +++ */ +++ p = reclook(p, co[1]); +++ o += p -> value[0]; +++ continue; +++ default: +++ panic("lval2"); +++ } +++ } +++ if (f) { +++ putLV( firstsymbol , firstbn , o , p2type( p -> type ) ); +++ } else { +++ if (o) { +++ putleaf( P2ICON , o , 0 , P2INT , 0 ); +++ putop( P2PLUS , P2INT ); +++ } +++ } +++ if ( required == RREQ ) { +++ putop( P2UNARY P2MUL , p2type( p -> type ) ); +++ } +++ return ( p -> type ); +++} +++ +++ /* +++ * this recursively follows done a list of qualifications +++ * and puts out the beginnings of calls to fnil for files +++ * or nil for pointers (if checking is on) on the way back. +++ * this returns true or false. +++ */ +++nilfnil( p , c , modflag , firstp , r2 ) +++ struct nl *p; +++ int *c; +++ int modflag; +++ struct nl *firstp; +++ char *r2; /* no, not r2-d2 */ +++ { +++ int *co; +++ struct nl *lastp; +++ int t; +++ +++ if ( c == NIL ) { +++ return TRUE; +++ } +++ co = (int *) ( c[1] ); +++ if ( co == NIL ) { +++ return FALSE; +++ } +++ lastp = p; +++ p = p -> type; +++ if ( p == NIL ) { +++ return FALSE; +++ } +++ switch ( co[0] ) { +++ case T_PTR: +++ /* +++ * Pointer qualification. +++ */ +++ lastp -> nl_flags |= NUSED; +++ if ( p -> class != PTR && p -> class != FILET) { +++ error("^ allowed only on files and pointers, not on %ss", nameof(p)); +++ goto bad; +++ } +++ break; +++ case T_ARGL: +++ if ( p -> class != ARRAY ) { +++ if ( lastp == firstp ) { +++ error("%s is a %s, not a function", r2, classes[firstp -> class]); +++ } else { +++ error("Illegal function qualificiation"); +++ } +++ return FALSE; +++ } +++ recovered(); +++ error("Pascal uses [] for subscripting, not ()"); +++ /* and fall through */ +++ case T_ARY: +++ if ( p -> class != ARRAY ) { +++ error("Subscripting allowed only on arrays, not on %ss", nameof(p)); +++ goto bad; +++ } +++ codeoff(); +++ t = arycod( p , co[1] ); +++ codeon(); +++ switch ( t ) { +++ case 0: +++ return FALSE; +++ case -1: +++ goto bad; +++ } +++ break; +++ case T_FIELD: +++ /* +++ * Field names are just +++ * an offset with some +++ * semantic checking. +++ */ +++ if ( p -> class != RECORD ) { +++ error(". allowed only on records, not on %ss", nameof(p)); +++ goto bad; +++ } +++ if ( co[1] == NIL ) { +++ return FALSE; +++ } +++ p = reclook( p , co[1] ); +++ if ( p == NIL ) { +++ error("%s is not a field in this record", co[1]); +++ goto bad; +++ } +++ if ( modflag & MOD ) { +++ p -> nl_flags |= NMOD; +++ } +++ if ( ( modflag & NOUSE ) == 0 || lptr( c[2] ) ) { +++ p -> nl_flags |= NUSED; +++ } +++ break; +++ default: +++ panic("nilfnil"); +++ } +++ /* +++ * recursive call, check the rest of the qualifications. +++ */ +++ if ( ! nilfnil( p , c[2] , modflag , firstp , r2 ) ) { +++ return FALSE; +++ } +++ /* +++ * the point of all this. +++ */ +++ if ( co[0] == T_PTR ) { +++ if ( p -> class == PTR ) { +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_NIL" ); +++ } +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_FNIL" ); +++ } +++ } +++ return TRUE; +++bad: +++ cerror("Error occurred on qualification of %s", r2); +++ return FALSE; +++ } +++#endif PC diff --cc usr/src/cmd/pi/pcops.h index 0000000000,0000000000,0000000000..c5f15e758a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pcops.h @@@@ -1,0 -1,0 -1,0 +1,144 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)pcops.h 1.1 8/27/80"; */ +++ +++ /* +++ * tree node operators +++ */ +++#define P2UNDEFINED 1 +++#define P2NAME 2 +++#define P2STRING 3 +++#define P2ICON 4 +++#define P2FCON 5 +++#define P2PLUS 6 +++#define P2MINUS 8 /* also unary == P2NEG */ +++#define P2MUL 11 /* also unary == P2INDIRECT */ +++#define P2AND 14 /* also unary */ +++#define P2OR 17 +++#define P2ER 19 +++#define P2QUEST 21 +++#define P2COLON 22 +++#define P2ANDAND 23 +++#define P2OROR 24 +++ /* +++ * yacc operator classes, reserved words, little symbols, etc. +++ * operators 25 .. 57 not used, except 56 +++ */ +++#define P2LISTOP 56 +++#define P2ASSIGN 58 +++#define P2COMOP 59 +++#define P2DIV 60 +++#define P2MOD 62 +++#define P2LS 64 +++#define P2RS 66 +++#define P2DOT 68 +++#define P2STREF 69 +++#define P2CALL 70 /* also unary */ +++#define P2FORTCALL 73 /* also unary */ +++#define P2NOT 76 +++#define P2COMPL 77 +++#define P2INCR 78 +++#define P2DECR 79 +++#define P2EQ 80 +++#define P2NE 81 +++#define P2LE 82 +++#define P2LT 83 +++#define P2GE 84 +++#define P2GT 85 +++#define P2ULE 86 +++#define P2ULT 87 +++#define P2UGE 88 +++#define P2UGT 89 +++#define P2SETBIT 90 +++#define P2TESTBIT 91 +++#define P2RESETBIT 92 +++#define P2ARS 93 +++#define P2REG 94 +++#define P2OREG 95 +++#define P2CCODES 96 +++#define P2FREE 97 +++#define P2STASG 98 +++#define P2STARG 99 +++#define P2STCALL 100 /* also unary */ +++ +++ /* +++ * some conversion operators +++ */ +++#define P2FLD 103 +++#define P2SCONV 104 +++#define P2PCONV 105 +++#define P2PMCONV 106 +++#define P2PVCONV 107 +++ +++ /* +++ * special node operators, used for special contexts +++ */ +++#define P2FORCE 108 +++#define P2CBRANCH 109 +++#define P2INIT 110 +++#define P2CAST 111 +++ +++ /* +++ * prefix unary operator modifier +++ */ +++#define P2ASG 1+ +++#define P2UNARY 2+ +++ +++ /* +++ * these borrowed from /usr/src/cmd/mip/fort.c +++ * to use the binary interface. +++ * only FTEXT, FEXPR, FLBRAC, FRBRAC, and FEOF are used +++ */ +++#define P2FTEXT 200 +++#define P2FEXPR 201 +++#define P2FLBRAC 203 +++#define P2FRBRAC 204 +++#define P2FEOF 205 +++ +++ /* +++ * type names +++ */ +++#define P2UNDEF 0 +++#define P2FARG 1 +++#define P2CHAR 2 +++#define P2SHORT 3 +++#define P2INT 4 /* this is also used for booleans */ +++#define P2LONG 5 /* don't use these, the second pass chokes */ +++#define P2FLOAT 6 +++#define P2DOUBLE 7 +++#define P2STRTY 8 +++#define P2UNIONTY 9 +++#define P2ENUMTY 10 +++#define P2MOETY 11 +++#define P2UCHAR 12 +++#define P2USHORT 13 +++#define P2UNSIGNED 14 +++#define P2ULONG 15 +++ +++ /* +++ * type modifiers +++ */ +++#define P2PTR 020 +++#define P2FTN 040 +++#define P2ARY 060 +++ +++ /* +++ * see the comment for p2type for an explanation of c type words +++ */ +++#define P2BASETYPE 017 +++#define P2TYPESHIFT 2 +++ +++ /* +++ * add a most significant type modifier, m, to a type, t +++ */ +++#define ADDTYPE( t,m ) ( ( ( ( t ) & ~P2BASETYPE ) << P2TYPESHIFT ) \ +++ | ( m ) \ +++ | ( ( t ) & P2BASETYPE ) ) +++ +++ /* +++ * the runtime framepointer and argumentpointer registers +++ */ +++#define P2FP 13 +++#define P2FPNAME "fp" +++#define P2AP 12 +++#define P2APNAME "ap" diff --cc usr/src/cmd/pi/pcproc.c index 0000000000,0000000000,0000000000..f26b504d62 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pcproc.c @@@@ -1,0 -1,0 -1,0 +1,1449 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pcproc.c 1.3 10/28/80"; +++ +++#include "whoami.h" +++#ifdef PC +++ /* +++ * and to the end of the file +++ */ +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "pc.h" +++#include "pcops.h" +++ +++/* +++ * The following array is used to determine which classes may be read +++ * from textfiles. It is indexed by the return value from classify. +++ */ +++#define rdops(x) rdxxxx[(x)-(TFIRST)] +++ +++int rdxxxx[] = { +++ 0, /* -7 file types */ +++ 0, /* -6 record types */ +++ 0, /* -5 array types */ +++ O_READE, /* -4 scalar types */ +++ 0, /* -3 pointer types */ +++ 0, /* -2 set types */ +++ 0, /* -1 string types */ +++ 0, /* 0 nil, no type */ +++ O_READE, /* 1 boolean */ +++ O_READC, /* 2 character */ +++ O_READ4, /* 3 integer */ +++ O_READ8 /* 4 real */ +++}; +++ +++/* +++ * Proc handles procedure calls. +++ * Non-builtin procedures are "buck-passed" to func (with a flag +++ * indicating that they are actually procedures. +++ * builtin procedures are handled here. +++ */ +++pcproc(r) +++ int *r; +++{ +++ register struct nl *p; +++ register int *alv, *al, op; +++ struct nl *filetype, *ap; +++ int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file; +++ char fmt, format[20], *strptr; +++ int prec, field, strnglen, fmtlen, fmtstart, pu; +++ int *pua, *pui, *puz; +++ int i, j, k; +++ int itemwidth; +++ char *readname; +++ long tempoff; +++ long readtype; +++ +++#define CONPREC 4 +++#define VARPREC 8 +++#define CONWIDTH 1 +++#define VARWIDTH 2 +++#define SKIP 16 +++ +++ /* +++ * Verify that the name is +++ * defined and is that of a +++ * procedure. +++ */ +++ p = lookup(r[2]); +++ if (p == NIL) { +++ rvlist(r[3]); +++ return; +++ } +++ if (p->class != PROC && p->class != FPROC) { +++ error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]); +++ rvlist(r[3]); +++ return; +++ } +++ argv = r[3]; +++ +++ /* +++ * Call handles user defined +++ * procedures and functions. +++ */ +++ if (bn != 0) { +++ call(p, argv, PROC, bn); +++ return; +++ } +++ +++ /* +++ * Call to built-in procedure. +++ * Count the arguments. +++ */ +++ argc = 0; +++ for (al = argv; al != NIL; al = al[2]) +++ argc++; +++ +++ /* +++ * Switch on the operator +++ * associated with the built-in +++ * procedure in the namelist +++ */ +++ op = p->value[0] &~ NSTAND; +++ if (opt('s') && (p->value[0] & NSTAND)) { +++ standard(); +++ error("%s is a nonstandard procedure", p->symbol); +++ } +++ switch (op) { +++ +++ case O_ABORT: +++ if (argc != 0) +++ error("null takes no arguments"); +++ return; +++ +++ case O_FLUSH: +++ if (argc == 0) { +++ putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ } +++ if (argc != 1) { +++ error("flush takes at most one argument"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_FLUSH" ); +++ ap = stklval(argv[1], NOFLAGS); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("flush's argument must be a file, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_MESSAGE: +++ case O_WRITEF: +++ case O_WRITLN: +++ /* +++ * Set up default file "output"'s type +++ */ +++ file = NIL; +++ filetype = nl+T1CHAR; +++ /* +++ * Determine the file implied +++ * for the write and generate +++ * code to make it the active file. +++ */ +++ if (op == O_MESSAGE) { +++ /* +++ * For message, all that matters +++ * is that the filetype is +++ * a character file. +++ * Thus "output" will suit us fine. +++ */ +++ putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "__err" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ } else if (argv != NIL && (al = argv[1])[0] != T_WEXP) { +++ /* +++ * If there is a first argument which has +++ * no write widths, then it is potentially +++ * a file name. +++ */ +++ codeoff(); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ argv = argv[2]; +++ if (ap != NIL && ap->class == FILET) { +++ /* +++ * Got "write(f, ...", make +++ * f the active file, and save +++ * it and its type for use in +++ * processing the rest of the +++ * arguments to write. +++ */ +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ file = argv[1]; +++ filetype = ap->type; +++ stklval(argv[1], NOFLAGS); +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ /* +++ * Skip over the first argument +++ */ +++ argv = argv[2]; +++ argc--; +++ } else { +++ /* +++ * Set up for writing on +++ * standard output. +++ */ +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_output" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ } +++ } else { +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_output" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ } +++ /* +++ * Loop and process each +++ * of the arguments. +++ */ +++ for (; argv != NIL; argv = argv[2]) { +++ /* +++ * fmtspec indicates the type (CONstant or VARiable) +++ * and number (none, WIDTH, and/or PRECision) +++ * of the fields in the printf format for this +++ * output variable. +++ * stkcnt is the number of longs pushed on the stack +++ * fmt is the format output indicator (D, E, F, O, X, S) +++ * fmtstart = 0 for leading blank; = 1 for no blank +++ */ +++ fmtspec = NIL; +++ stkcnt = 0; +++ fmt = 'D'; +++ fmtstart = 1; +++ al = argv[1]; +++ if (al == NIL) +++ continue; +++ if (al[0] == T_WEXP) +++ alv = al[1]; +++ else +++ alv = al; +++ if (alv == NIL) +++ continue; +++ codeoff(); +++ ap = stkrval(alv, NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ continue; +++ typ = classify(ap); +++ if (al[0] == T_WEXP) { +++ /* +++ * Handle width expressions. +++ * The basic game here is that width +++ * expressions get evaluated. If they +++ * are constant, the value is placed +++ * directly in the format string. +++ * Otherwise the value is pushed onto +++ * the stack and an indirection is +++ * put into the format string. +++ */ +++ if (al[3] == OCT) +++ fmt = 'O'; +++ else if (al[3] == HEX) +++ fmt = 'X'; +++ else if (al[3] != NIL) { +++ /* +++ * Evaluate second format spec +++ */ +++ if ( constval(al[3]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONPREC; +++ prec = con.crval; +++ } else { +++ fmtspec += VARPREC; +++ } +++ fmt = 'f'; +++ switch ( typ ) { +++ case TINT: +++ if ( opt( 's' ) ) { +++ standard(); +++ error("Writing %ss with two write widths is non-standard", clnames[typ]); +++ } +++ /* and fall through */ +++ case TDOUBLE: +++ break; +++ default: +++ error("Cannot write %ss with two write widths", clnames[typ]); +++ continue; +++ } +++ } +++ /* +++ * Evaluate first format spec +++ */ +++ if (al[2] != NIL) { +++ if ( constval(al[2]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONWIDTH; +++ field = con.crval; +++ } else { +++ fmtspec += VARWIDTH; +++ } +++ } +++ if ((fmtspec & CONPREC) && prec < 0 || +++ (fmtspec & CONWIDTH) && field < 0) { +++ error("Negative widths are not allowed"); +++ continue; +++ } +++ } +++ if (filetype != nl+T1CHAR) { +++ if (fmt == 'O' || fmt == 'X') { +++ error("Oct/hex allowed only on text files"); +++ continue; +++ } +++ if (fmtspec) { +++ error("Write widths allowed only on text files"); +++ continue; +++ } +++ /* +++ * Generalized write, i.e. +++ * to a non-textfile. +++ */ +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( +++ ADDTYPE( +++ ADDTYPE( p2type( filetype ) +++ , P2PTR ) +++ , P2FTN ) +++ , P2PTR ) +++ , "_FNIL" ); +++ stklval(file, NOFLAGS); +++ putop( P2CALL +++ , ADDTYPE( p2type( filetype ) , P2PTR ) ); +++ putop( P2UNARY P2MUL , p2type( filetype ) ); +++ /* +++ * file^ := ... +++ */ +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ precheck( filetype , "_RANG4" , "_RSGN4" ); +++ /* and fall through */ +++ case TDOUBLE: +++ case TPTR: +++ ap = rvalue( argv[1] , filetype , RREQ ); +++ break; +++ default: +++ ap = rvalue( argv[1] , filetype , LREQ ); +++ break; +++ } +++ if (ap == NIL) +++ continue; +++ if (incompat(ap, filetype, argv[1])) { +++ cerror("Type mismatch in write to non-text file"); +++ continue; +++ } +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ postcheck( filetype ); +++ /* and fall through */ +++ case TDOUBLE: +++ case TPTR: +++ putop( P2ASSIGN , p2type( filetype ) ); +++ putdot( filename , line ); +++ break; +++ default: +++ putstrop( P2STASG +++ , p2type( filetype ) +++ , lwidth( filetype ) +++ , align( filetype ) ); +++ putdot( filename , line ); +++ break; +++ } +++ /* +++ * put(file) +++ */ +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PUT" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ continue; +++ } +++ /* +++ * Write to a textfile +++ * +++ * Evaluate the expression +++ * to be written. +++ */ +++ if (fmt == 'O' || fmt == 'X') { +++ if (opt('s')) { +++ standard(); +++ error("Oct and hex are non-standard"); +++ } +++ if (typ == TSTR || typ == TDOUBLE) { +++ error("Can't write %ss with oct/hex", clnames[typ]); +++ continue; +++ } +++ if (typ == TCHAR || typ == TBOOL) +++ typ = TINT; +++ } +++ /* +++ * If there is no format specified by the programmer, +++ * implement the default. +++ */ +++ switch (typ) { +++ case TINT: +++ if (fmt == 'f') { +++ typ = TDOUBLE; +++ goto tdouble; +++ } +++ if (fmtspec == NIL) { +++ if (fmt == 'D') +++ field = 10; +++ else if (fmt == 'X') +++ field = 8; +++ else if (fmt == 'O') +++ field = 11; +++ else +++ panic("fmt1"); +++ fmtspec = CONWIDTH; +++ } +++ break; +++ case TCHAR: +++ tchar: +++ fmt = 'c'; +++ break; +++ case TSCAL: +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Writing scalars to text files is non-standard"); +++ case TBOOL: +++ fmt = 's'; +++ break; +++ case TDOUBLE: +++ tdouble: +++ switch (fmtspec) { +++ case NIL: +++ field = 21; +++ prec = 14; +++ fmt = 'E'; +++ fmtspec = CONWIDTH + CONPREC; +++ break; +++ case CONWIDTH: +++ if (--field < 1) +++ field = 1; +++ prec = field - 7; +++ if (prec < 1) +++ prec = 1; +++ fmtspec += CONPREC; +++ fmt = 'E'; +++ break; +++ case VARWIDTH: +++ fmtspec += VARPREC; +++ fmt = 'E'; +++ break; +++ case CONWIDTH + CONPREC: +++ case CONWIDTH + VARPREC: +++ if (--field < 1) +++ field = 1; +++ } +++ format[0] = ' '; +++ fmtstart = 0; +++ break; +++ case TSTR: +++ constval( alv ); +++ switch ( classify( con.ctype ) ) { +++ case TCHAR: +++ typ = TCHAR; +++ goto tchar; +++ case TSTR: +++ strptr = con.cpval; +++ for (strnglen = 0; *strptr++; strnglen++) /* void */; +++ strptr = con.cpval; +++ break; +++ default: +++ strnglen = width(ap); +++ break; +++ } +++ fmt = 's'; +++ strfmt = fmtspec; +++ if (fmtspec == NIL) { +++ fmtspec = SKIP; +++ break; +++ } +++ if (fmtspec & CONWIDTH) { +++ if (field <= strnglen) +++ fmtspec = SKIP; +++ else +++ field -= strnglen; +++ } +++ break; +++ default: +++ error("Can't write %ss to a text file", clnames[typ]); +++ continue; +++ } +++ /* +++ * Generate the format string +++ */ +++ switch (fmtspec) { +++ default: +++ panic("fmt2"); +++ case NIL: +++ if (fmt == 'c') { +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN|P2INT , P2PTR ) +++ , "_WRITEC" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ stkrval( alv , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN|P2INT , P2PTR ) +++ , "_fputc" ); +++ stkrval( alv , NIL , RREQ ); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0, cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else { +++ sprintf(&format[1], "%%%c", fmt); +++ goto fmtgen; +++ } +++ case SKIP: +++ break; +++ case CONWIDTH: +++ sprintf(&format[1], "%%%1D%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH: +++ sprintf(&format[1], "%%*%c", fmt); +++ goto fmtgen; +++ case CONWIDTH + CONPREC: +++ sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt); +++ goto fmtgen; +++ case CONWIDTH + VARPREC: +++ sprintf(&format[1], "%%%1D.*%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH + CONPREC: +++ sprintf(&format[1], "%%*.%1D%c", prec, fmt); +++ goto fmtgen; +++ case VARWIDTH + VARPREC: +++ sprintf(&format[1], "%%*.*%c", fmt); +++ fmtgen: +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_WRITEF" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fprintf" ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ } +++ putCONG( &format[ fmtstart ] +++ , strlen( &format[ fmtstart ] ) +++ , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ if ( fmtspec & VARWIDTH ) { +++ /* +++ * either +++ * ,(temp=width,MAX(temp,...)), +++ * or +++ * , MAX( width , ... ) , +++ */ +++ if ( ( typ == TDOUBLE && al[3] == NIL ) +++ || typ == TSTR ) { +++ sizes[ cbn ].om_off -= sizeof( int ); +++ tempoff = sizes[ cbn ].om_off; +++ putlbracket( ftnno , -tempoff ); +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putRV( 0 , cbn , tempoff , P2INT ); +++ ap = stkrval( al[2] , NIL , RREQ ); +++ putop( P2ASSIGN , P2INT ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_MAX" ); +++ putRV( 0 , cbn , tempoff , P2INT ); +++ } else { +++ if (opt('t') +++ || typ == TSTR || typ == TDOUBLE) { +++ putleaf( P2ICON , 0 , 0 +++ ,ADDTYPE( P2FTN | P2INT, P2PTR ) +++ ,"_MAX" ); +++ } +++ ap = stkrval( al[2] , NIL , RREQ ); +++ } +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("First write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ switch ( typ ) { +++ case TDOUBLE: +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ if ( al[3] == NIL ) { +++ /* +++ * finish up the comma op +++ */ +++ putop( P2COMOP , P2INT ); +++ fmtspec &= ~VARPREC; +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_MAX" ); +++ putRV( 0 , cbn , tempoff , P2INT ); +++ sizes[ cbn ].om_off += sizeof( int ); +++ putleaf( P2ICON , 8 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TSTR: +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putop( P2COMOP , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ default: +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putop( P2LISTOP , P2INT ); +++ break; +++ } +++ } +++ /* +++ * If there is a variable precision, +++ * evaluate it +++ */ +++ if (fmtspec & VARPREC) { +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_MAX" ); +++ } +++ ap = stkrval( al[3] , NIL , RREQ ); +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("Second write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ if (opt('t')) { +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } +++ putop( P2LISTOP , P2INT ); +++ } +++ /* +++ * evaluate the thing we want printed. +++ */ +++ switch ( typ ) { +++ case TCHAR: +++ case TINT: +++ stkrval( alv , NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TDOUBLE: +++ ap = stkrval( alv , NIL , RREQ ); +++ if ( isnta( ap , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TSCAL: +++ case TBOOL: +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_NAM" ); +++ ap = stkrval( alv , NIL , RREQ ); +++ sprintf( format , PREFIXFORMAT , LABELPREFIX +++ , listnames( ap ) ); +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR +++ , format ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ case TSTR: +++ putCONG( "" , 0 , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ break; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ /* +++ * Write the string after its blank padding +++ */ +++ if (typ == TSTR ) { +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_WRITES" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ ap = stkrval(alv, NIL , RREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fwrite" ); +++ ap = stkrval(alv, NIL , RREQ ); +++ } +++ if (strfmt & VARWIDTH) { +++ /* +++ * min, inline expanded as +++ * temp < len ? temp : len +++ */ +++ putRV( 0 , cbn , tempoff , P2INT ); +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2LT , P2INT ); +++ putRV( 0 , cbn , tempoff , P2INT ); +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2COLON , P2INT ); +++ putop( P2QUEST , P2INT ); +++ } else { +++ if ( ( fmtspec & SKIP ) +++ && ( strfmt & CONWIDTH ) ) { +++ strnglen = field; +++ } +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++ /* +++ * Done with arguments. +++ * Handle writeln and +++ * insufficent number of args. +++ */ +++ switch (p->value[0] &~ NSTAND) { +++ case O_WRITEF: +++ if (argc == 0) +++ error("Write requires an argument"); +++ break; +++ case O_MESSAGE: +++ if (argc == 0) +++ error("Message requires an argument"); +++ case O_WRITLN: +++ if (filetype != nl+T1CHAR) +++ error("Can't 'writeln' a non text file"); +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_WRITLN" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fputc" ); +++ putleaf( P2ICON , '\n' , 0 , P2CHAR , 0 ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ break; +++ } +++ return; +++ +++ case O_READ4: +++ case O_READLN: +++ /* +++ * Set up default +++ * file "input". +++ */ +++ file = NIL; +++ filetype = nl+T1CHAR; +++ /* +++ * Determine the file implied +++ * for the read and generate +++ * code to make it the active file. +++ */ +++ if (argv != NIL) { +++ codeoff(); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ argv = argv[2]; +++ if (ap != NIL && ap->class == FILET) { +++ /* +++ * Got "read(f, ...", make +++ * f the active file, and save +++ * it and its type for use in +++ * processing the rest of the +++ * arguments to read. +++ */ +++ file = argv[1]; +++ filetype = ap->type; +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ stklval(argv[1], NOFLAGS); +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ argv = argv[2]; +++ argc--; +++ } else { +++ /* +++ * Default is read from +++ * standard input. +++ */ +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_input" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ input->nl_flags |= NUSED; +++ } +++ } else { +++ putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putLV( "_input" , 0 , 0 , P2PTR|P2STRTY ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ input->nl_flags |= NUSED; +++ } +++ /* +++ * Loop and process each +++ * of the arguments. +++ */ +++ for (; argv != NIL; argv = argv[2]) { +++ /* +++ * Get the address of the target +++ * on the stack. +++ */ +++ al = argv[1]; +++ if (al == NIL) +++ continue; +++ if (al[0] != T_VAR) { +++ error("Arguments to %s must be variables, not expressions", p->symbol); +++ continue; +++ } +++ codeoff(); +++ ap = stklval(al, MOD|ASGN|NOUSE); +++ codeon(); +++ if (ap == NIL) +++ continue; +++ if (filetype != nl+T1CHAR) { +++ /* +++ * Generalized read, i.e. +++ * from a non-textfile. +++ */ +++ if (incompat(filetype, ap, argv[1] )) { +++ error("Type mismatch in read from non-text file"); +++ continue; +++ } +++ /* +++ * var := file ^; +++ */ +++ ap = lvalue( al , MOD | ASGN | NOUSE , RREQ ); +++ if ( isa( ap , "bsci" ) ) { +++ precheck( ap , "_RANG4" , "_RSNG4" ); +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( +++ ADDTYPE( +++ ADDTYPE( +++ p2type( filetype ) , P2PTR ) +++ , P2FTN ) +++ , P2PTR ) +++ , "_FNIL" ); +++ if (file != NIL) +++ stklval(file, NOFLAGS); +++ else /* Magic */ +++ putRV( "_input" , 0 , 0 +++ , P2PTR | P2STRTY ); +++ putop( P2CALL , P2INT ); +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ case TDOUBLE: +++ case TPTR: +++ putop( P2UNARY P2MUL +++ , p2type( filetype ) ); +++ } +++ switch ( classify( filetype ) ) { +++ case TBOOL: +++ case TCHAR: +++ case TINT: +++ case TSCAL: +++ postcheck( ap ); +++ /* and fall through */ +++ case TDOUBLE: +++ case TPTR: +++ putop( P2ASSIGN , p2type( ap ) ); +++ putdot( filename , line ); +++ break; +++ default: +++ putstrop( P2STASG +++ , p2type( ap ) +++ , lwidth( ap ) +++ , align( ap ) ); +++ putdot( filename , line ); +++ break; +++ } +++ /* +++ * get(file); +++ */ +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_GET" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ continue; +++ } +++ /* +++ * if you get to here, you are reading from +++ * a text file. only possiblities are: +++ * character, integer, real, or scalar. +++ * read( f , foo , ... ) is done as +++ * foo := read( f ) with rangechecking +++ * if appropriate. +++ */ +++ typ = classify(ap); +++ op = rdops(typ); +++ if (op == NIL) { +++ error("Can't read %ss from a text file", clnames[typ]); +++ continue; +++ } +++ /* +++ * left hand side of foo := read( f ) +++ */ +++ ap = lvalue( al , MOD|ASGN|NOUSE , RREQ ); +++ if ( isa( ap , "bsci" ) ) { +++ precheck( ap , "_RANG4" , "_RSNG4" ); +++ } +++ switch ( op ) { +++ case O_READC: +++ readname = "_READC"; +++ readtype = P2INT; +++ break; +++ case O_READ4: +++ readname = "_READ4"; +++ readtype = P2INT; +++ break; +++ case O_READ8: +++ readname = "_READ8"; +++ readtype = P2DOUBLE; +++ break; +++ case O_READE: +++ readname = "_READE"; +++ readtype = P2INT; +++ break; +++ } +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | readtype , P2PTR ) +++ , readname ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ if ( op == O_READE ) { +++ sprintf( format , PREFIXFORMAT , LABELPREFIX +++ , listnames( ap ) ); +++ putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR +++ , format ); +++ putop( P2LISTOP , P2INT ); +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Reading scalars from text files is non-standard"); +++ } +++ putop( P2CALL , readtype ); +++ if ( isa( ap , "bcsi" ) ) { +++ postcheck( ap ); +++ } +++ putop( P2ASSIGN , p2type( ap ) ); +++ putdot( filename , line ); +++ } +++ /* +++ * Done with arguments. +++ * Handle readln and +++ * insufficient number of args. +++ */ +++ if (p->value[0] == O_READLN) { +++ if (filetype != nl+T1CHAR) +++ error("Can't 'readln' a non text file"); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_READLN" ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else if (argc == 0) +++ error("read requires an argument"); +++ return; +++ +++ case O_GET: +++ case O_PUT: +++ if (argc != 1) { +++ error("%s expects one argument", p->symbol); +++ return; +++ } +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ ap = stklval(argv[1], NOFLAGS); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("Argument to %s must be a file, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_GET ? "_GET" : "_PUT" ); +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_RESET: +++ case O_REWRITE: +++ if (argc == 0 || argc > 2) { +++ error("%s expects one or two arguments", p->symbol); +++ return; +++ } +++ if (opt('s') && argc == 2) { +++ standard(); +++ error("Two argument forms of reset and rewrite are non-standard"); +++ } +++ putleaf( P2ICON , 0 , 0 , P2INT +++ , op == O_RESET ? "_RESET" : "_REWRITE" ); +++ ap = stklval(argv[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (ap->class != FILET) { +++ error("First argument to %s must be a file, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ if (argc == 2) { +++ /* +++ * Optional second argument +++ * is a string name of a +++ * UNIX (R) file to be associated. +++ */ +++ al = argv[2]; +++ al = stkrval(al[1], NOFLAGS , RREQ ); +++ if (al == NIL) +++ return; +++ if (classify(al) != TSTR) { +++ error("Second argument to %s must be a string, not %s", p->symbol, nameof(al)); +++ return; +++ } +++ strnglen = width(al); +++ } else { +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++ strnglen = 0; +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , strnglen , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , text(ap) ? 0: width(ap->type) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_NEW: +++ case O_DISPOSE: +++ if (argc == 0) { +++ error("%s expects at least one argument", p->symbol); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_DISPOSE ? "_DISPOSE" : +++ opt('t') ? "_NEWZ" : "_NEW" ); +++ ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD ); +++ if (ap == NIL) +++ return; +++ if (ap->class != PTR) { +++ error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ ap = ap->type; +++ if (ap == NIL) +++ return; +++ argv = argv[2]; +++ if (argv != NIL) { +++ if (ap->class != RECORD) { +++ error("Record required when specifying variant tags"); +++ return; +++ } +++ for (; argv != NIL; argv = argv[2]) { +++ if (ap->ptr[NL_VARNT] == NIL) { +++ error("Too many tag fields"); +++ return; +++ } +++ if (!isconst(argv[1])) { +++ error("Second and successive arguments to %s must be constants", p->symbol); +++ return; +++ } +++ gconst(argv[1]); +++ if (con.ctype == NIL) +++ return; +++ if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) { +++ cerror("Specified tag constant type clashed with variant case selector type"); +++ return; +++ } +++ for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain) +++ if (ap->range[0] == con.crval) +++ break; +++ if (ap == NIL) { +++ error("No variant case label value equals specified constant value"); +++ return; +++ } +++ ap = ap->ptr[NL_VTOREC]; +++ } +++ } +++ putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_DATE: +++ case O_TIME: +++ if (argc != 1) { +++ error("%s expects one argument", p->symbol); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , op == O_DATE ? "_DATE" : "_TIME" ); +++ ap = stklval(argv[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR || width(ap) != 10) { +++ error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_HALT: +++ if (argc != 0) { +++ error("halt takes no arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_HALT" ); +++ +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ noreach = 1; +++ return; +++ +++ case O_ARGV: +++ if (argc != 2) { +++ error("argv takes two arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ARGV" ); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("argv's first argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ al = argv[2]; +++ ap = stklval(al[1], MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR) { +++ error("argv's second argument must be a string, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_STLIM: +++ if (argc != 1) { +++ error("stlimit requires one argument"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_STLIM" ); +++ ap = stkrval(argv[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("stlimit's argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_REMOVE: +++ if (argc != 1) { +++ error("remove expects one argument"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_REMOVE" ); +++ ap = stkrval(argv[1], NOFLAGS , RREQ ); +++ if (ap == NIL) +++ return; +++ if (classify(ap) != TSTR) { +++ error("remove's argument must be a string, not %s", nameof(ap)); +++ return; +++ } +++ putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_LLIMIT: +++ if (argc != 2) { +++ error("linelimit expects two arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_LLIMIT" ); +++ ap = stklval(argv[1], NOFLAGS|NOUSE); +++ if (ap == NIL) +++ return; +++ if (!text(ap)) { +++ error("linelimit's first argument must be a text file, not %s", nameof(ap)); +++ return; +++ } +++ al = argv[2]; +++ ap = stkrval(al[1], NIL , RREQ ); +++ if (ap == NIL) +++ return; +++ if (isnta(ap, "i")) { +++ error("linelimit's second argument must be an integer, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ case O_PAGE: +++ if (argc != 1) { +++ error("page expects one argument"); +++ return; +++ } +++ putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY ); +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNIT" ); +++ ap = stklval(argv[1], NOFLAGS); +++ if (ap == NIL) +++ return; +++ if (!text(ap)) { +++ error("Argument to page must be a text file, not %s", nameof(ap)); +++ return; +++ } +++ putop( P2CALL , P2INT ); +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++ if ( opt( 't' ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PAGE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_fputc" ); +++ putleaf( P2ICON , '\f' , 0 , P2CHAR , 0 ); +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_ACTFILE" ); +++ putRV( 0 , cbn , CURFILEOFFSET +++ , P2PTR|P2STRTY ); +++ putop( P2CALL , P2INT ); +++ putop( P2LISTOP , P2INT ); +++ } +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ +++ case O_PACK: +++ if (argc != 3) { +++ error("pack expects three arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_PACK" ); +++ pu = "pack(a,i,z)"; +++ pua = (al = argv)[1]; +++ pui = (al = al[2])[1]; +++ puz = (al = al[2])[1]; +++ goto packunp; +++ case O_UNPACK: +++ if (argc != 3) { +++ error("unpack expects three arguments"); +++ return; +++ } +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_UNPACK" ); +++ pu = "unpack(z,a,i)"; +++ puz = (al = argv)[1]; +++ pua = (al = al[2])[1]; +++ pui = (al = al[2])[1]; +++packunp: +++ ap = stkrval((int *) pui, NLNIL , RREQ ); +++ if (ap == NIL) +++ return; +++ ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE); +++ if (ap == NIL) +++ return; +++ if (ap->class != ARRAY) { +++ error("%s requires a to be an unpacked array, not %s", pu, nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE); +++ if (al->class != ARRAY) { +++ error("%s requires z to be a packed array, not %s", pu, nameof(ap)); +++ return; +++ } +++ if (al->type == NIL || ap->type == NIL) +++ return; +++ if (al->type != ap->type) { +++ error("%s requires a and z to be arrays of the same type", pu, nameof(ap)); +++ return; +++ } +++ putop( P2LISTOP , P2INT ); +++ k = width(al); +++ itemwidth = width(ap->type); +++ ap = ap->chain; +++ al = al->chain; +++ if (ap->chain != NIL || al->chain != NIL) { +++ error("%s requires a and z to be single dimension arrays", pu); +++ return; +++ } +++ if (ap == NIL || al == NIL) +++ return; +++ /* +++ * al is the range for z i.e. u..v +++ * ap is the range for a i.e. m..n +++ * i will be n-m+1 +++ * j will be v-u+1 +++ */ +++ i = ap->range[1] - ap->range[0] + 1; +++ j = al->range[1] - al->range[0] + 1; +++ if (i < j) { +++ error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i); +++ return; +++ } +++ /* +++ * get n-m-(v-u) and m for the interpreter +++ */ +++ i -= j; +++ j = ap->range[0]; +++ putleaf( P2ICON , itemwidth , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , j , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , i , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , k , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++ return; +++ case 0: +++ error("%s is an unimplemented 6400 extension", p->symbol); +++ return; +++ +++ default: +++ panic("proc case"); +++ } +++} +++#endif PC diff --cc usr/src/cmd/pi/pic.c index 0000000000,0000000000,0000000000..c2645707f6 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pic.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pic.c 1.1 8/27/80"; +++ +++#include "OPnames.h" +++ +++main() { +++ register int j, k; +++ +++ for(j = 0; j < 32; j++) { +++ for (k = 0; k < 256; k += 32) +++ if (otext[j+k]) +++ printf("%03o%cO_%s\t", j+k, *otext[j+k], otext[j+k]+1); +++ else +++ printf("%03o\t\t", j+k); +++ putchar('\n'); +++ if ((j+1)%8 == 0) +++ putchar('\n'); +++ } +++ printf("Starred opcodes are used internally in Pi and are never generated.\n"); +++ exit(0); +++} diff --cc usr/src/cmd/pi/proc.c index 0000000000,cbddfdd518,0000000000..ab9820a48d mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/proc.c +++ b/usr/src/cmd/pi/proc.c @@@@ -1,0 -1,794 -1,0 +1,1029 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)proc.c 1.3 10/28/80"; +++ +++#include "whoami.h" +++#ifdef OBJ +++ /* +++ * and the rest of the file +++ */ + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" + + + +/* - * The following arrays are used to determine which classes may be - * read and written to/from text files. - * They are indexed by the return types from classify. +++ * The following array is used to determine which classes may be read +++ * from textfiles. It is indexed by the return value from classify. + + */ + +#define rdops(x) rdxxxx[(x)-(TFIRST)] - #define wrops(x) wrxxxx[(x)-(TFIRST)] + + + +int rdxxxx[] = { - 0, /* -7 file types */ - 0, /* -6 record types */ - 0, /* -5 array types */ - 0, /* -4 scalar types */ - 0, /* -3 pointer types */ - 0, /* -2 set types */ - 0, /* -1 string types */ - 0, /* 0 nil - i.e. no type */ - 0, /* 1 booleans */ - O_READC, /* 2 character */ - O_READ4, /* 3 integer */ - O_READ8 /* 4 real */ - }; - - int wrxxxx[] = { - 0, /* -7 file types */ - 0, /* -6 record types */ - 0, /* -5 array types */ - 0, /* -4 scalar types */ - 0, /* -3 pointer types */ - 0, /* -2 set types */ - O_WRITG, /* -1 string types */ - 0, /* 0 nil - i.e. no type */ - O_WRITB, /* 1 booleans */ - O_WRITC, /* 2 character */ - O_WRIT4, /* 3 integer */ - O_WRIT8, /* 4 real */ +++ 0, /* -7 file types */ +++ 0, /* -6 record types */ +++ 0, /* -5 array types */ +++ O_READE, /* -4 scalar types */ +++ 0, /* -3 pointer types */ +++ 0, /* -2 set types */ +++ 0, /* -1 string types */ +++ 0, /* 0 nil, no type */ +++ O_READE, /* 1 boolean */ +++ O_READC, /* 2 character */ +++ O_READ4, /* 3 integer */ +++ O_READ8 /* 4 real */ + +}; + + + +/* + + * Proc handles procedure calls. + + * Non-builtin procedures are "buck-passed" to func (with a flag + + * indicating that they are actually procedures. + + * builtin procedures are handled here. + + */ + +proc(r) + + int *r; + +{ + + register struct nl *p; - register int *al, op; +++ register int *alv, *al, op; + + struct nl *filetype, *ap; - int argc, *argv, c, two, oct, hex, *file; - int pu; +++ int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file; +++ char fmt, format[20], *strptr; +++ int prec, field, strnglen, fmtlen, fmtstart, pu; + + int *pua, *pui, *puz; + + int i, j, k; +++ int itemwidth; +++ +++#define CONPREC 4 +++#define VARPREC 8 +++#define CONWIDTH 1 +++#define VARWIDTH 2 +++#define SKIP 16 + + + + /* + + * Verify that the name is + + * defined and is that of a + + * procedure. + + */ + + p = lookup(r[2]); + + if (p == NIL) { + + rvlist(r[3]); + + return; + + } - if (p->class != PROC) { +++ if (p->class != PROC && p->class != FPROC) { + + error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]); + + rvlist(r[3]); + + return; + + } + + argv = r[3]; + + + + /* + + * Call handles user defined + + * procedures and functions. + + */ + + if (bn != 0) { + + call(p, argv, PROC, bn); + + return; + + } + + + + /* + + * Call to built-in procedure. + + * Count the arguments. + + */ + + argc = 0; + + for (al = argv; al != NIL; al = al[2]) + + argc++; + + + + /* + + * Switch on the operator + + * associated with the built-in + + * procedure in the namelist + + */ + + op = p->value[0] &~ NSTAND; + + if (opt('s') && (p->value[0] & NSTAND)) { + + standard(); + + error("%s is a nonstandard procedure", p->symbol); + + } + + switch (op) { + + - case O_NULL: +++ case O_ABORT: + + if (argc != 0) + + error("null takes no arguments"); + + return; + + + + case O_FLUSH: + + if (argc == 0) { - put1(O_MESSAGE); +++ put(1, O_MESSAGE); + + return; + + } + + if (argc != 1) { + + error("flush takes at most one argument"); + + return; + + } - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NIL , RREQ ); + + if (ap == NIL) + + return; + + if (ap->class != FILET) { + + error("flush's argument must be a file, not %s", nameof(ap)); + + return; + + } - put1(op); +++ put(1, op); + + return; + + + + case O_MESSAGE: - case O_WRIT2: +++ case O_WRITEF: + + case O_WRITLN: + + /* + + * Set up default file "output"'s type + + */ + + file = NIL; + + filetype = nl+T1CHAR; + + /* + + * Determine the file implied + + * for the write and generate + + * code to make it the active file. + + */ + + if (op == O_MESSAGE) { + + /* + + * For message, all that matters + + * is that the filetype is + + * a character file. + + * Thus "output" will suit us fine. + + */ - put1(O_MESSAGE); +++ put(1, O_MESSAGE); + + } else if (argv != NIL && (al = argv[1])[0] != T_WEXP) { + + /* + + * If there is a first argument which has + + * no write widths, then it is potentially + + * a file name. + + */ + + codeoff(); - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NIL , RREQ ); + + codeon(); + + if (ap == NIL) + + argv = argv[2]; + + if (ap != NIL && ap->class == FILET) { + + /* + + * Got "write(f, ...", make + + * f the active file, and save + + * it and its type for use in + + * processing the rest of the + + * arguments to write. + + */ + + file = argv[1]; + + filetype = ap->type; - rvalue(argv[1], NIL); - put1(O_UNIT); +++ stkrval(argv[1], NIL , RREQ ); +++ put(1, O_UNIT); + + /* + + * Skip over the first argument + + */ + + argv = argv[2]; + + argc--; + + } else + + /* + + * Set up for writing on + + * standard output. + + */ - put1(O_UNITOUT); +++ put(1, O_UNITOUT); + + } else - put1(O_UNITOUT); +++ put(1, O_UNITOUT); + + /* + + * Loop and process each + + * of the arguments. + + */ + + for (; argv != NIL; argv = argv[2]) { +++ /* +++ * fmtspec indicates the type (CONstant or VARiable) +++ * and number (none, WIDTH, and/or PRECision) +++ * of the fields in the printf format for this +++ * output variable. +++ * stkcnt is the number of longs pushed on the stack +++ * fmt is the format output indicator (D, E, F, O, X, S) +++ * fmtstart = 0 for leading blank; = 1 for no blank +++ */ +++ fmtspec = NIL; +++ stkcnt = 0; +++ fmt = 'D'; +++ fmtstart = 1; + + al = argv[1]; + + if (al == NIL) + + continue; - /* - * Op will be used to - * accumulate width information, - * and two records the fact - * that we saw two write widths - */ - op = 0; - two = 0; - oct = 0; - hex = 0; +++ if (al[0] == T_WEXP) +++ alv = al[1]; +++ else +++ alv = al; +++ if (alv == NIL) +++ continue; +++ codeoff(); +++ ap = stkrval(alv, NIL , RREQ ); +++ codeon(); +++ if (ap == NIL) +++ continue; +++ typ = classify(ap); + + if (al[0] == T_WEXP) { - if (filetype != nl+T1CHAR) { - error("Write widths allowed only with text files"); - continue; - } + + /* + + * Handle width expressions. + + * The basic game here is that width - * expressions get evaluated and left - * on the stack and their width's get - * packed into the high byte of the - * affected opcode (subop). +++ * expressions get evaluated. If they +++ * are constant, the value is placed +++ * directly in the format string. +++ * Otherwise the value is pushed onto +++ * the stack and an indirection is +++ * put into the format string. + + */ - if (al[3] == OCT) - oct++; +++ if (al[3] == OCT) +++ fmt = 'O'; + + else if (al[3] == HEX) - hex++; +++ fmt = 'X'; + + else if (al[3] != NIL) { - two++; + + /* - * Arrange for the write - * opcode that takes two widths +++ * Evaluate second format spec + + */ - op |= O_WRIT82-O_WRIT8; - ap = rvalue(al[3], NIL); - if (ap == NIL) - continue; - if (isnta(ap, "i")) { - error("Second write width must be integer, not %s", nameof(ap)); +++ if ( constval(al[3]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONPREC; +++ prec = con.crval; +++ } else { +++ fmtspec += VARPREC; +++ } +++ fmt = 'f'; +++ switch ( typ ) { +++ case TINT: +++ if ( opt( 's' ) ) { +++ standard(); +++ error("Writing %ss with two write widths is non-standard", clnames[typ]); +++ } +++ /* and fall through */ +++ case TDOUBLE: +++ break; +++ default: +++ error("Cannot write %ss with two write widths", clnames[typ]); + + continue; + + } - op |= even(width(ap)) << 11; + + } +++ /* +++ * Evaluate first format spec +++ */ + + if (al[2] != NIL) { - ap = rvalue(al[2], NIL); - if (ap == NIL) - continue; - if (isnta(ap, "i")) { - error("First write width must be integer, not %s", nameof(ap)); - continue; +++ if ( constval(al[2]) +++ && isa( con.ctype , "i" ) ) { +++ fmtspec += CONWIDTH; +++ field = con.crval; +++ } else { +++ fmtspec += VARWIDTH; + + } - op |= even(width(ap)) << 8; + + } - al = al[1]; - if (al == NIL) +++ if ((fmtspec & CONPREC) && prec < 0 || +++ (fmtspec & CONWIDTH) && field < 0) { +++ error("Negative widths are not allowed"); + + continue; +++ } + + } + + if (filetype != nl+T1CHAR) { - if (oct || hex) { +++ if (fmt == 'O' || fmt == 'X') { + + error("Oct/hex allowed only on text files"); + + continue; + + } - if (op) { +++ if (fmtspec) { + + error("Write widths allowed only on text files"); + + continue; + + } + + /* + + * Generalized write, i.e. + + * to a non-textfile. + + */ - rvalue(file, NIL); - put1(O_FNIL); +++ stkrval(file, NIL , RREQ ); +++ put(1, O_FNIL); + + /* + + * file^ := ... + + */ + + ap = rvalue(argv[1], NIL); + + if (ap == NIL) + + continue; + + if (incompat(ap, filetype, argv[1])) { + + cerror("Type mismatch in write to non-text file"); + + continue; + + } + + convert(ap, filetype); - put2(O_AS, width(filetype)); +++ put(2, O_AS, width(filetype)); + + /* + + * put(file) + + */ - put1(O_PUT); +++ put(1, O_PUT); + + continue; + + } + + /* + + * Write to a textfile + + * + + * Evaluate the expression + + * to be written. + + */ - ap = rvalue(al, NIL); - if (ap == NIL) - continue; - c = classify(ap); - if (two && c != TDOUBLE) { - if (isnta(ap, "i")) { - error("Only reals can have two write widths"); +++ if (fmt == 'O' || fmt == 'X') { +++ if (opt('s')) { +++ standard(); +++ error("Oct and hex are non-standard"); +++ } +++ if (typ == TSTR || typ == TDOUBLE) { +++ error("Can't write %ss with oct/hex", clnames[typ]); + + continue; + + } - convert(ap, nl+TDOUBLE); - c = TDOUBLE; +++ if (typ == TCHAR || typ == TBOOL) +++ typ = TINT; + + } - if (oct || hex) { +++ /* +++ * Place the arguement on the stack. If there is +++ * no format specified by the programmer, implement +++ * the default. +++ */ +++ switch (typ) { +++ case TINT: +++ if (fmt != 'f') { +++ ap = stkrval(alv, NIL , RREQ ); +++ stkcnt++; +++ } else { +++ ap = stkrval(alv, NIL , RREQ ); +++ put(1, O_ITOD); +++ stkcnt += 2; +++ typ = TDOUBLE; +++ goto tdouble; +++ } +++ if (fmtspec == NIL) { +++ if (fmt == 'D') +++ field = 10; +++ else if (fmt == 'X') +++ field = 8; +++ else if (fmt == 'O') +++ field = 11; +++ else +++ panic("fmt1"); +++ fmtspec = CONWIDTH; +++ } +++ break; +++ case TCHAR: +++ tchar: +++ ap = stkrval(alv, NIL , RREQ ); +++ stkcnt++; +++ fmt = 'c'; +++ break; +++ case TSCAL: +++ warning(); + + if (opt('s')) { + + standard(); - error("Oct and hex are non-standard"); + + } - switch (c) { - case TREC: - case TARY: - case TFILE: - case TSTR: - case TSET: - case TDOUBLE: - error("Can't write %ss with oct/hex", clnames[c]); - continue; +++ error("Writing scalars to text files is non-standard"); +++ case TBOOL: +++ stkrval(alv, NIL , RREQ ); +++ put(2, O_NAM, listnames(ap)); +++ stkcnt++; +++ fmt = 's'; +++ break; +++ case TDOUBLE: +++ ap = stkrval(alv, TDOUBLE , RREQ ); +++ stkcnt += 2; +++ tdouble: +++ switch (fmtspec) { +++ case NIL: +++ field = 21; +++ prec = 14; +++ fmt = 'E'; +++ fmtspec = CONWIDTH + CONPREC; +++ break; +++ case CONWIDTH: +++ if (--field < 1) +++ field = 1; +++ prec = field - 7; +++ if (prec < 1) +++ prec = 1; +++ fmtspec += CONPREC; +++ fmt = 'E'; +++ break; +++ case CONWIDTH + CONPREC: +++ case CONWIDTH + VARPREC: +++ if (--field < 1) +++ field = 1; +++ } +++ format[0] = ' '; +++ fmtstart = 0; +++ break; +++ case TSTR: +++ constval( alv ); +++ switch ( classify( con.ctype ) ) { +++ case TCHAR: +++ typ = TCHAR; +++ goto tchar; +++ case TSTR: +++ strptr = con.cpval; +++ for (strnglen = 0; *strptr++; strnglen++) /* void */; +++ strptr = con.cpval; +++ break; +++ default: +++ strnglen = width(ap); +++ break; +++ } +++ fmt = 's'; +++ strfmt = fmtspec; +++ if (fmtspec == NIL) { +++ fmtspec = SKIP; +++ break; + + } - put1(op | (oct ? O_WROCT2 : O_WRHEX2) | (width(ap) >> 2)); +++ if (fmtspec & CONWIDTH) { +++ if (field <= strnglen) { +++ fmtspec = SKIP; +++ break; +++ } else +++ field -= strnglen; +++ } +++ /* +++ * push string to implement leading blank padding +++ */ +++ put(2, O_LVCON, 2); +++ putstr("", 0); +++ stkcnt++; +++ break; +++ default: +++ error("Can't write %ss to a text file", clnames[typ]); + + continue; + + } - if (wrops(c) == NIL) { - error("Can't write %ss to a text file", clnames[c]); - continue; +++ /* +++ * If there is a variable precision, evaluate it onto +++ * the stack +++ */ +++ if (fmtspec & VARPREC) { +++ ap = stkrval(al[3], NIL , RREQ ); +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("Second write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ if ( opt( 't' ) ) { +++ put(3, O_MAX, 0, 0); +++ } +++ stkcnt++; +++ } +++ /* +++ * If there is a variable width, evaluate it onto +++ * the stack +++ */ +++ if (fmtspec & VARWIDTH) { +++ if ( ( typ == TDOUBLE && fmtspec == VARWIDTH ) +++ || typ == TSTR ) { +++ i = sizes[cbn].om_off -= sizeof(int); +++ if (i < sizes[cbn].om_max) +++ sizes[cbn].om_max = i; +++ put(2, O_LV | cbn << 8 + INDX, i); +++ } +++ ap = stkrval(al[2], NIL , RREQ ); +++ if (ap == NIL) +++ continue; +++ if (isnta(ap,"i")) { +++ error("First write width must be integer, not %s", nameof(ap)); +++ continue; +++ } +++ stkcnt++; +++ /* +++ * Perform special processing on widths based +++ * on data type +++ */ +++ switch (typ) { +++ case TDOUBLE: +++ if (fmtspec == VARWIDTH) { +++ fmt = 'E'; +++ put(1, O_AS4); +++ put(2, O_RV4 | cbn << 8 + INDX, i); +++ put(3, O_MAX, 8, 1); +++ put(2, O_RV4 | cbn << 8 + INDX, i); +++ stkcnt++; +++ fmtspec += VARPREC; +++ } +++ put(3, O_MAX, 1, 1); +++ break; +++ case TSTR: +++ put(1, O_AS4); +++ put(2, O_RV4 | cbn << 8 + INDX, i); +++ put(3, O_MAX, strnglen, 0); +++ break; +++ default: +++ if ( opt( 't' ) ) { +++ put(3, O_MAX, 0, 0); +++ } +++ break; +++ } +++ } +++ /* +++ * Generate the format string +++ */ +++ switch (fmtspec) { +++ default: +++ panic("fmt2"); +++ case NIL: +++ if (fmt == 'c') +++ put(1, O_WRITEC); +++ else { +++ sprintf(&format[1], "%%%c", fmt); +++ goto fmtgen; +++ } +++ case SKIP: +++ break; +++ case CONWIDTH: +++ sprintf(&format[1], "%%%1D%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH: +++ sprintf(&format[1], "%%*%c", fmt); +++ goto fmtgen; +++ case CONWIDTH + CONPREC: +++ sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt); +++ goto fmtgen; +++ case CONWIDTH + VARPREC: +++ sprintf(&format[1], "%%%1D.*%c", field, fmt); +++ goto fmtgen; +++ case VARWIDTH + CONPREC: +++ sprintf(&format[1], "%%*.%1D%c", prec, fmt); +++ goto fmtgen; +++ case VARWIDTH + VARPREC: +++ sprintf(&format[1], "%%*.*%c", fmt); +++ fmtgen: +++ fmtlen = lenstr(&format[fmtstart], 0); +++ put(2, O_LVCON, fmtlen); +++ putstr(&format[fmtstart], 0); +++ put(1, O_FILE); +++ stkcnt += 2; +++ put(2, O_WRITEF, stkcnt); +++ } +++ /* +++ * Write the string after its blank padding +++ */ +++ if (typ == TSTR) { +++ put(1, O_FILE); +++ put(2, O_CON24, 1); +++ if (strfmt & VARWIDTH) { +++ put(2, O_RV4 | cbn << 8 + INDX , i ); +++ put(2, O_MIN, strnglen); +++ } else { +++ if ((fmtspec & SKIP) && +++ (strfmt & CONWIDTH)) { +++ strnglen = field; +++ } +++ put(2, O_CON24, strnglen); +++ } +++ ap = stkrval(alv, NIL , RREQ ); +++ put(1, O_WRITES); + + } - if (c == TINT && width(ap) != 4) - op |= O_WRIT2; - else - op |= wrops(c); - if (c == TSTR) - put2(op, width(ap)); - else - put1(op); + + } + + /* + + * Done with arguments. + + * Handle writeln and + + * insufficent number of args. + + */ + + switch (p->value[0] &~ NSTAND) { - case O_WRIT2: +++ case O_WRITEF: + + if (argc == 0) + + error("Write requires an argument"); + + break; + + case O_MESSAGE: + + if (argc == 0) + + error("Message requires an argument"); + + case O_WRITLN: + + if (filetype != nl+T1CHAR) + + error("Can't 'writeln' a non text file"); - put1(O_WRITLN); +++ put(1, O_WRITLN); + + break; + + } + + return; + + + + case O_READ4: + + case O_READLN: + + /* + + * Set up default + + * file "input". + + */ + + file = NIL; + + filetype = nl+T1CHAR; + + /* + + * Determine the file implied + + * for the read and generate + + * code to make it the active file. + + */ + + if (argv != NIL) { + + codeoff(); - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NIL , RREQ ); + + codeon(); + + if (ap == NIL) + + argv = argv[2]; + + if (ap != NIL && ap->class == FILET) { + + /* + + * Got "read(f, ...", make + + * f the active file, and save + + * it and its type for use in + + * processing the rest of the + + * arguments to read. + + */ + + file = argv[1]; + + filetype = ap->type; - rvalue(argv[1], NIL); - put1(O_UNIT); +++ stkrval(argv[1], NIL , RREQ ); +++ put(1, O_UNIT); + + argv = argv[2]; + + argc--; + + } else { + + /* + + * Default is read from + + * standard input. + + */ - put1(O_UNITINP); +++ put(1, O_UNITINP); + + input->nl_flags |= NUSED; + + } + + } else { - put1(O_UNITINP); +++ put(1, O_UNITINP); + + input->nl_flags |= NUSED; + + } + + /* + + * Loop and process each + + * of the arguments. + + */ + + for (; argv != NIL; argv = argv[2]) { + + /* + + * Get the address of the target + + * on the stack. + + */ + + al = argv[1]; + + if (al == NIL) + + continue; + + if (al[0] != T_VAR) { + + error("Arguments to %s must be variables, not expressions", p->symbol); + + continue; + + } - ap = lvalue(al, MOD|ASGN|NOUSE); +++ ap = stklval(al, MOD|ASGN|NOUSE); + + if (ap == NIL) + + continue; + + if (filetype != nl+T1CHAR) { + + /* + + * Generalized read, i.e. + + * from a non-textfile. + + */ - if (incompat(filetype, ap, NIL)) { +++ if (incompat(filetype, ap, argv[1] )) { + + error("Type mismatch in read from non-text file"); + + continue; + + } + + /* + + * var := file ^; + + */ + + if (file != NIL) - rvalue(file, NIL); +++ stkrval(file, NIL , RREQ ); + + else /* Magic */ - put2(O_RV2, input->value[0]); - put1(O_FNIL); - put2(O_IND, width(filetype)); +++ put(2, O_RV2, input->value[0]); +++ put(1, O_FNIL); +++ put(2, O_IND, width(filetype)); + + convert(filetype, ap); + + if (isa(ap, "bsci")) + + rangechk(ap, ap); - put2(O_AS, width(ap)); +++ put(2, O_AS, width(ap)); + + /* + + * get(file); + + */ - put1(O_GET); +++ put(1, O_GET); + + continue; + + } - c = classify(ap); - op = rdops(c); +++ typ = classify(ap); +++ op = rdops(typ); + + if (op == NIL) { - error("Can't read %ss from a text file", clnames[c]); +++ error("Can't read %ss from a text file", clnames[typ]); + + continue; + + } - put1(op); +++ if (op != O_READE) +++ put(1, op); +++ else { +++ put(2, op, listnames(ap)); +++ warning(); +++ if (opt('s')) { +++ standard(); +++ } +++ error("Reading scalars from text files is non-standard"); +++ } + + /* + + * Data read is on the stack. + + * Assign it. + + */ - if (op != O_READ8) +++ if (op != O_READ8 && op != O_READE) + + rangechk(ap, op == O_READC ? ap : nl+T4INT); + + gen(O_AS2, O_AS2, width(ap), + + op == O_READ8 ? 8 : op == O_READ4 ? 4 : 2); + + } + + /* + + * Done with arguments. + + * Handle readln and + + * insufficient number of args. + + */ + + if (p->value[0] == O_READLN) { + + if (filetype != nl+T1CHAR) + + error("Can't 'readln' a non text file"); - put1(O_READLN); +++ put(1, O_READLN); + + } + + else if (argc == 0) + + error("read requires an argument"); + + return; + + + + case O_GET: + + case O_PUT: + + if (argc != 1) { + + error("%s expects one argument", p->symbol); + + return; + + } - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NIL , RREQ ); + + if (ap == NIL) + + return; + + if (ap->class != FILET) { + + error("Argument to %s must be a file, not %s", p->symbol, nameof(ap)); + + return; + + } - put1(O_UNIT); - put1(op); +++ put(1, O_UNIT); +++ put(1, op); + + return; + + + + case O_RESET: + + case O_REWRITE: + + if (argc == 0 || argc > 2) { + + error("%s expects one or two arguments", p->symbol); + + return; + + } + + if (opt('s') && argc == 2) { + + standard(); + + error("Two argument forms of reset and rewrite are non-standard"); + + } - ap = lvalue(argv[1], MOD|NOUSE); +++ ap = stklval(argv[1], MOD|NOUSE); + + if (ap == NIL) + + return; + + if (ap->class != FILET) { + + error("First argument to %s must be a file, not %s", p->symbol, nameof(ap)); + + return; + + } + + if (argc == 2) { + + /* + + * Optional second argument + + * is a string name of a + + * UNIX (R) file to be associated. + + */ + + al = argv[2]; - al = rvalue(al[1], NIL); +++ al = stkrval(al[1], NOFLAGS , RREQ ); + + if (al == NIL) + + return; + + if (classify(al) != TSTR) { + + error("Second argument to %s must be a string, not %s", p->symbol, nameof(al)); + + return; + + } - c = width(al); - } else - c = 0; - if (c > 127) { - error("File name too long"); - return; +++ strnglen = width(al); +++ } else { +++ put(2, O_CON24, NIL); +++ strnglen = 0; + + } - put2(op | c << 8, text(ap) ? 0: width(ap->type)); +++ put(2, O_CON24, strnglen); +++ put(2, O_CON24, text(ap) ? 0: width(ap->type)); +++ put(1, op); + + return; + + + + case O_NEW: + + case O_DISPOSE: + + if (argc == 0) { + + error("%s expects at least one argument", p->symbol); + + return; + + } - ap = lvalue(argv[1], MOD|NOUSE); +++ ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD ); + + if (ap == NIL) + + return; + + if (ap->class != PTR) { + + error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap)); + + return; + + } + + ap = ap->type; + + if (ap == NIL) + + return; + + argv = argv[2]; + + if (argv != NIL) { + + if (ap->class != RECORD) { + + error("Record required when specifying variant tags"); + + return; + + } + + for (; argv != NIL; argv = argv[2]) { + + if (ap->ptr[NL_VARNT] == NIL) { + + error("Too many tag fields"); + + return; + + } + + if (!isconst(argv[1])) { + + error("Second and successive arguments to %s must be constants", p->symbol); + + return; + + } + + gconst(argv[1]); + + if (con.ctype == NIL) + + return; - if (incompat(con.ctype, (ap->ptr[NL_TAG])->type)) { +++ if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) { + + cerror("Specified tag constant type clashed with variant case selector type"); + + return; + + } + + for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain) + + if (ap->range[0] == con.crval) + + break; + + if (ap == NIL) { + + error("No variant case label value equals specified constant value"); + + return; + + } + + ap = ap->ptr[NL_VTOREC]; + + } + + } - put2(op, width(ap)); +++ put(2, op, width(ap)); + + return; + + + + case O_DATE: + + case O_TIME: + + if (argc != 1) { + + error("%s expects one argument", p->symbol); + + return; + + } - ap = lvalue(argv[1], MOD|NOUSE); +++ ap = stklval(argv[1], MOD|NOUSE); + + if (ap == NIL) + + return; + + if (classify(ap) != TSTR || width(ap) != 10) { + + error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap)); + + return; + + } - put1(op); +++ put(1, op); + + return; + + + + case O_HALT: + + if (argc != 0) { + + error("halt takes no arguments"); + + return; + + } - put1(op); +++ put(1, op); + + noreach = 1; + + return; + + + + case O_ARGV: + + if (argc != 2) { + + error("argv takes two arguments"); + + return; + + } - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NIL , RREQ ); + + if (ap == NIL) + + return; + + if (isnta(ap, "i")) { + + error("argv's first argument must be an integer, not %s", nameof(ap)); + + return; + + } - convert(ap, nl+T2INT); + + al = argv[2]; - ap = lvalue(al[1], MOD|NOUSE); +++ ap = stklval(al[1], MOD|NOUSE); + + if (ap == NIL) + + return; + + if (classify(ap) != TSTR) { + + error("argv's second argument must be a string, not %s", nameof(ap)); + + return; + + } - put2(op, width(ap)); +++ put(2, op, width(ap)); + + return; + + + + case O_STLIM: + + if (argc != 1) { + + error("stlimit requires one argument"); + + return; + + } - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NIL , RREQ ); + + if (ap == NIL) + + return; + + if (isnta(ap, "i")) { + + error("stlimit's argument must be an integer, not %s", nameof(ap)); + + return; + + } + + if (width(ap) != 4) - put1(O_STOI); - put1(op); +++ put(1, O_STOI); +++ put(1, op); + + return; + + + + case O_REMOVE: + + if (argc != 1) { + + error("remove expects one argument"); + + return; + + } - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NOFLAGS , RREQ ); + + if (ap == NIL) + + return; + + if (classify(ap) != TSTR) { + + error("remove's argument must be a string, not %s", nameof(ap)); + + return; + + } - put2(op, width(ap)); +++ put(2, O_CON24, width(ap)); +++ put(1, op); + + return; + + + + case O_LLIMIT: + + if (argc != 2) { + + error("linelimit expects two arguments"); + + return; + + } - ap = lvalue(argv[1], NOMOD|NOUSE); +++ ap = stklval(argv[1], NOFLAGS|NOUSE); + + if (ap == NIL) + + return; + + if (!text(ap)) { + + error("linelimit's first argument must be a text file, not %s", nameof(ap)); + + return; + + } + + al = argv[2]; - ap = rvalue(al[1], NIL); +++ ap = stkrval(al[1], NIL , RREQ ); + + if (ap == NIL) + + return; + + if (isnta(ap, "i")) { + + error("linelimit's second argument must be an integer, not %s", nameof(ap)); + + return; + + } - convert(ap, nl+T4INT); - put1(op); +++ put(1, op); + + return; + + case O_PAGE: + + if (argc != 1) { + + error("page expects one argument"); + + return; + + } - ap = rvalue(argv[1], NIL); +++ ap = stkrval(argv[1], NIL , RREQ ); + + if (ap == NIL) + + return; + + if (!text(ap)) { + + error("Argument to page must be a text file, not %s", nameof(ap)); + + return; + + } - put1(O_UNIT); - put1(op); +++ put(1, O_UNIT); +++ put(1, op); + + return; + + + + case O_PACK: + + if (argc != 3) { + + error("pack expects three arguments"); + + return; + + } + + pu = "pack(a,i,z)"; + + pua = (al = argv)[1]; + + pui = (al = al[2])[1]; + + puz = (al = al[2])[1]; + + goto packunp; + + case O_UNPACK: + + if (argc != 3) { + + error("unpack expects three arguments"); + + return; + + } + + pu = "unpack(z,a,i)"; + + puz = (al = argv)[1]; + + pua = (al = al[2])[1]; + + pui = (al = al[2])[1]; + +packunp: - ap = rvalue((int *) pui, NLNIL); +++ ap = stkrval((int *) pui, NLNIL , RREQ ); + + if (ap == NIL) + + return; - if (width(ap) == 4) - put1(O_ITOS); - ap = lvalue(pua, op == O_PACK ? NOMOD : MOD|NOUSE); +++ ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE); + + if (ap == NIL) + + return; + + if (ap->class != ARRAY) { + + error("%s requires a to be an unpacked array, not %s", pu, nameof(ap)); + + return; + + } - al = (struct nl *) lvalue(puz, op == O_UNPACK ? NOMOD : MOD|NOUSE); +++ al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE); + + if (al->class != ARRAY) { + + error("%s requires z to be a packed array, not %s", pu, nameof(ap)); + + return; + + } + + if (al->type == NIL || ap->type == NIL) + + return; + + if (al->type != ap->type) { + + error("%s requires a and z to be arrays of the same type", pu, nameof(ap)); + + return; + + } + + k = width(al); +++ itemwidth = width(ap->type); + + ap = ap->chain; + + al = al->chain; + + if (ap->chain != NIL || al->chain != NIL) { + + error("%s requires a and z to be single dimension arrays", pu); + + return; + + } + + if (ap == NIL || al == NIL) + + return; + + /* + + * al is the range for z i.e. u..v + + * ap is the range for a i.e. m..n + + * i will be n-m+1 + + * j will be v-u+1 + + */ + + i = ap->range[1] - ap->range[0] + 1; + + j = al->range[1] - al->range[0] + 1; + + if (i < j) { + + error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i); + + return; + + } + + /* + + * get n-m-(v-u) and m for the interpreter + + */ + + i -= j; + + j = ap->range[0]; - put(5, op, width(ap), j, i, k); +++ put(5, op, itemwidth , j, i, k); + + return; + + case 0: + + error("%s is an unimplemented 6400 extension", p->symbol); + + return; + + + + default: + + panic("proc case"); + + } + +} +++#endif OBJ diff --cc usr/src/cmd/pi/pstab.h index 0000000000,0000000000,0000000000..b86d9aec27 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/pstab.h @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++ /* static char sccsid[] = "@(#)pstab.h 1.2 9/9/80"; */ +++ +++ /* +++ * subtypes within the above type +++ * subtypes N_PSO and N_PSOL are .stabs name,,0,subtype,0 +++ * others subtypes are .stabs name,,0,subtype,line +++ */ +++#define N_PSO 0x1 /* source file name */ +++#define N_PSOL 0x2 /* include file name */ +++#define N_PGLABEL 0x3 /* global label */ +++#define N_PGCONST 0x4 /* global constant */ +++#define N_PGTYPE 0x5 /* global type */ +++#define N_PGVAR 0x6 /* global variable */ +++#define N_PGFUNC 0x7 /* global function */ +++#define N_PGPROC 0x8 /* global procedure */ +++#define N_PEFUNC 0x9 /* external function */ +++#define N_PEPROC 0xa /* external procedure */ diff --cc usr/src/cmd/pi/put.c index 0000000000,1cd9c90440,0000000000..7e4180f5df mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/put.c +++ b/usr/src/cmd/pi/put.c @@@@ -1,0 -1,403 -1,0 +1,661 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)put.c 1.3 10/2/80"; +++ +++#include "whoami.h" + +#include "opcode.h" + +#include "0.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++#endif PC + + + +short *obufp = obuf; + + + +/* + + * If DEBUG is defined, include the table + + * of the printing opcode names. + + */ + +#ifdef DEBUG - char *otext[] = { + +#include "OPnames.h" - }; + +#endif + + + +#ifdef OBJ + +/* + + * Put is responsible for the interpreter equivalent of code + + * generation. Since the interpreter is specifically designed + + * for Pascal, little work is required here. + + */ + +put(a) + +{ + + register int *p, i; + + register char *cp; + + int n, subop, suboppr, op, oldlc, w; + + char *string; + + static int casewrd; + + + + /* + + * It would be nice to do some more + + * optimizations here. The work + + * done to collapse offsets in lval + + * should be done here, the IFEQ etc + + * relational operators could be used + + * etc. + + */ + + oldlc = lc; - if (cgenflg) +++ if (cgenflg < 0) + + /* + + * code disabled - do nothing + + */ + + return (oldlc); + + p = &a; + + n = *p++; + + suboppr = subop = (*p>>8) & 0377; + + op = *p & 0377; + + string = 0; + +#ifdef DEBUG + + if ((cp = otext[op]) == NIL) { + + printf("op= %o\n", op); + + panic("put"); + + } + +#endif + + switch (op) { - /***** +++ case O_ABORT: +++ cp = "*"; +++ break; + + case O_LINO: +++/***** + + if (line == codeline) + + return (oldlc); + + codeline = line; + +*****/ - case O_PUSH: - case O_POP: - if (p[1] == 0) - return (oldlc); + + case O_NEW: + + case O_DISPOSE: + + case O_AS: + + case O_IND: +++ case O_LVCON: +++ case O_CON: + + case O_OFF: + + case O_INX2: + + case O_INX4: + + case O_CARD: + + case O_ADDT: + + case O_SUBT: + + case O_MULT: + + case O_IN: + + case O_CASE1OP: + + case O_CASE2OP: + + case O_CASE4OP: +++ case O_FRTN: +++ case O_WRITES: +++ case O_WRITEF: +++ case O_MAX: +++ case O_MIN: + + case O_PACK: + + case O_UNPACK: +++ case O_ARGV: +++ case O_CTTOT: +++ case O_INCT: + + case O_RANG2: + + case O_RSNG2: + + case O_RANG42: + + case O_RSNG42: + + if (p[1] == 0) + + break; + + case O_CON2: +++ case O_CON24: + + if (p[1] < 128 && p[1] >= -128) { + + suboppr = subop = p[1]; + + p++; + + n--; - if (op == O_CON2) +++ if (op == O_CON2) { + + op = O_CON1; +++ cp = otext[O_CON1]; +++ } +++ if (op == O_CON24) { +++ op = O_CON14; +++ cp = otext[O_CON14]; +++ } + + } + + break; + + case O_CON8: + + { + + short *sp = &p[1]; + + + +#ifdef DEBUG - if ( opt( 'c' ) ) +++ if ( opt( 'k' ) ) + + printf ( ")#%5d\tCON8\t%10.3f\n" , - lc - HEAD_BYTES , +++ lc - HEADER_BYTES , + + * ( ( double * ) &p[1] ) ); + +#endif + + word ( op ); + + for ( i = 1 ; i <= 4 ; i ++ ) + + word ( *sp ++ ); + + return ( oldlc ); + + } + + default: + + if (op >= O_REL2 && op <= O_REL84) { + + if ((i = (subop >> 1) * 5 ) >= 30) + + i -= 30; + + else + + i += 2; + +#ifdef DEBUG + + string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i]; + +#endif + + suboppr = 0; + + } + + break; + + case O_IF: + + case O_TRA: + +/***** + + codeline = 0; + +*****/ + + case O_FOR1U: + + case O_FOR2U: + + case O_FOR4U: + + case O_FOR1D: + + case O_FOR2D: + + case O_FOR4D: + + /* relative addressing */ + + p[1] -= ( unsigned ) lc + 2; + + break; - case O_WRIT82: - #ifdef DEBUG - string = &"22\024\042\044"[subop*3]; - #endif - suboppr = 0; - break; + + case O_CONG: + + i = p[1]; + + cp = * ( ( char ** ) &p[2] ) ; + +#ifdef DEBUG - if (opt('c')) +++ if (opt('k')) + + printf(")#%5d\tCONG:%d\t%s\n", - lc - HEAD_BYTES, i, cp); +++ lc - HEADER_BYTES, i, cp); + +#endif + + if (i <= 127) + + word(O_CON | i << 8); + + else { + + word(O_CON); + + word(i); + + } + + while (i > 0) { + + w = *cp ? *cp++ : ' '; + + w |= (*cp ? *cp++ : ' ') << 8; + + word(w); + + i -= 2; + + } + + return (oldlc); + + case O_CONC: + +#ifdef DEBUG + + (string = "'x'")[1] = p[1]; + +#endif + + suboppr = 0; + + op = O_CON1; +++ cp = otext[O_CON1]; +++ subop = p[1]; +++ goto around; +++ case O_CONC4: +++#ifdef DEBUG +++ (string = "'x'")[1] = p[1]; +++#endif +++ suboppr = 0; +++ op = O_CON14; + + subop = p[1]; + + goto around; + + case O_CON1: +++ case O_CON14: + + suboppr = subop = p[1]; + +around: + + n--; + + break; + + case O_CASEBEG: + + casewrd = 0; + + return (oldlc); + + case O_CASEEND: + + if ((unsigned) lc & 1) { + + lc--; + + word(casewrd); + + } + + return (oldlc); + + case O_CASE1: + +#ifdef DEBUG - if (opt('c')) +++ if (opt('k')) + + printf(")#%5d\tCASE1\t%d\n" - , lc - HEAD_BYTES +++ , lc - HEADER_BYTES + + , ( int ) *( ( long * ) &p[1] ) ); + +#endif + + /* + + * this to build a byte size case table + + * saving bytes across calls in casewrd + + * so they can be put out by word() + + */ + + lc++; + + if ((unsigned) lc & 1) - casewrd = *( ( long * ) &p[1] ); +++ casewrd = *( ( long * ) &p[1] ) & 0377; + + else { + + lc -= 2; + + word ( casewrd + + | ( ( int ) *( ( long * ) &p[1] ) << 8 ) ); + + } + + return (oldlc); + + case O_CASE2: + +#ifdef DEBUG - if (opt('c')) +++ if (opt('k')) + + printf(")#%5d\tCASE2\t%d\n" - , lc - HEAD_BYTES +++ , lc - HEADER_BYTES + + , ( int ) *( ( long * ) &p[1] ) ); + +#endif + + word( ( short ) *( ( long * ) &p[1] ) ); + + return (oldlc); +++ case O_FCALL: +++ if (p[1] == 0) +++ goto longgen; +++ /* and fall through */ +++ case O_PUSH: +++ if (p[1] == 0) +++ return (oldlc); +++ if (p[1] < 128 && p[1] >= -128) { +++ suboppr = subop = p[1]; +++ p++; +++ n--; +++ break; +++ } +++ goto longgen; + + case O_TRA4: + + case O_CALL: +++ case O_FSAV: + + case O_GOTO: - case O_TRACNT: +++ case O_NAM: +++ case O_READE: + + /* absolute long addressing */ - p[1] -= HEAD_BYTES; - n++; +++ p[1] -= HEADER_BYTES; +++ goto longgen; +++ case O_RV1: +++ case O_RV14: +++ case O_RV2: +++ case O_RV24: +++ case O_RV4: +++ case O_RV8: +++ case O_RV: +++ case O_LV: +++ if (p[1] < SHORTADDR && p[1] >= -SHORTADDR) +++ break; +++ else { +++ op += O_LRV - O_RV; +++ cp = otext[op]; +++ } +++ case O_BEG: +++ case O_NODUMP: + + case O_CON4: + + case O_CASE4: + + case O_RANG4: - case O_RANG4 + 1: /* O_RANG24 */ +++ case O_RANG24: + + case O_RSNG4: - case O_RSNG4 + 1: /* O_RSNG24 */ +++ case O_RSNG24: +++ longgen: + + { + + short *sp = &p[1]; + + long *lp = &p[1]; + + +++ n = (n << 1) - 1; +++ if ( op == O_LRV ) +++ n--; + +#ifdef DEBUG - if (opt('c')) +++ if (opt('k')) + + { - printf( ")#%5d\t%s" , lc - HEAD_BYTES , cp ); +++ printf( ")#%5d\t%s" , lc - HEADER_BYTES , cp+1 ); + + if (suboppr) + + printf(":%1d", suboppr); + + for ( i = 1 ; i < n + + ; i += sizeof ( long )/sizeof ( short ) ) + + printf( "\t%D " , *lp ++ ); + + pchr ( '\n' ); + + } + +#endif + + if ( op != O_CASE4 ) + + word ( op | subop<<8 ); + + for ( i = 1 ; i < n ; i ++ ) + + word ( *sp ++ ); + + return ( oldlc ); + + } + + } + +#ifdef DEBUG - if (opt('c')) { - printf(")#%5d\t%s", lc - HEAD_BYTES, cp); +++ if (opt('k')) { +++ printf(")#%5d\t%s", lc - HEADER_BYTES, cp+1); + + if (suboppr) + + printf(":%d", suboppr); + + if (string) + + printf("\t%s",string); + + if (n > 1) + + pchr('\t'); + + for (i=1; iclass != TYPE) +++ ap = ap->type; +++ if (ap->value[ NL_ELABEL ] != 0) { +++ /* the list already exists */ +++ return( ap -> value[ NL_ELABEL ] ); +++ } +++# ifdef OBJ +++ oldlc = lc; +++ put(2, O_TRA, lc); +++ ap->value[ NL_ELABEL ] = lc; +++# endif OBJ +++# ifdef PC +++ putprintf( " .data" , 0 ); +++ putprintf( " .align 1" , 0 ); +++ ap -> value[ NL_ELABEL ] = getlab(); +++ putlab( ap -> value[ NL_ELABEL ] ); +++# endif PC +++ /* number of scalars */ +++ next = ap->type; +++ len = next->range[1]-next->range[0]+1; +++# ifdef OBJ +++ put(2, O_CASE2, len); +++# endif OBJ +++# ifdef PC +++ putprintf( " .word %d" , 0 , len ); +++# endif PC +++ /* offsets of each scalar name */ +++ len = (len+1)*sizeof(short); +++# ifdef OBJ +++ put(2, O_CASE2, len); +++# endif OBJ +++# ifdef PC +++ putprintf( " .word %d" , 0 , len ); +++# endif PC +++ next = ap->chain; +++ do { +++ for(strptr = next->symbol; *strptr++; len++) +++ continue; +++ len++; +++# ifdef OBJ +++ put(2, O_CASE2, len); +++# endif OBJ +++# ifdef PC +++ putprintf( " .word %d" , 0 , len ); +++# endif PC +++ } while (next = next->chain); +++ /* list of scalar names */ +++ strptr = getnext(ap, &next); +++# ifdef OBJ +++ do { +++ w = (unsigned) *strptr; +++ if (!*strptr++) +++ strptr = getnext(next, &next); +++ w |= *strptr << 8; +++ if (!*strptr++) +++ strptr = getnext(next, &next); +++ word(w); +++ } while (next); +++ /* jump over the mess */ +++ patch(oldlc); +++# endif OBJ +++# ifdef PC +++ while ( next ) { +++ while ( *strptr ) { +++ putprintf( " .byte 0%o" , 1 , *strptr++ ); +++ for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) { +++ putprintf( ",0%o" , 1 , *strptr++ ); +++ } +++ putprintf( "" , 0 ); +++ } +++ putprintf( " .byte 0" , 0 ); +++ strptr = getnext( next , &next ); +++ } +++ putprintf( " .text" , 0 ); +++# endif PC +++ return( ap -> value[ NL_ELABEL ] ); +++} +++ +++getnext(next, new) + + +++ struct nl *next, **new; +++{ +++ if (next != NIL) { +++ next = next->chain; +++ *new = next; +++ } +++ if (next == NIL) +++ return(""); +++#ifdef OBJ +++ if (opt('k') && cgenflg >= 0) +++ printf(")#%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol); +++#endif +++ return(next->symbol); +++} +++ +++#ifdef OBJ + +/* + + * Putspace puts out a table + + * of nothing to leave space + + * for the case branch table e.g. + + */ + +putspace(n) + + int n; + +{ + + register i; +++ +++ if (cgenflg < 0) +++ /* +++ * code disabled - do nothing +++ */ +++ return(lc); + +#ifdef DEBUG - if (opt('c')) - printf(")#%5d\t.=.+%d\n", lc - HEAD_BYTES, n); +++ if (opt('k')) +++ printf(")#%5d\t.=.+%d\n", lc - HEADER_BYTES, n); + +#endif + + for (i = even(n); i > 0; i -= 2) + + word(0); + +} + + +++putstr(sptr, padding) +++ +++ char *sptr; +++ int padding; +++{ +++ register unsigned short w; +++ register char *strptr = sptr; +++ register int pad = padding; +++ +++ if (cgenflg < 0) +++ /* +++ * code disabled - do nothing +++ */ +++ return(lc); +++#ifdef DEBUG +++ if (opt('k')) +++ printf(")#%5D\t\t\"%s\"\n", lc-HEADER_BYTES, strptr); +++#endif +++ if (pad == 0) { +++ do { +++ w = (unsigned short) * strptr; +++ if (w) +++ w |= *++strptr << 8; +++ word(w); +++ } while (*strptr++); +++ } else { +++ do { +++ w = (unsigned short) * strptr; +++ if (w) { +++ if (*++strptr) +++ w |= *strptr << 8; +++ else { +++ w |= ' ' << 8; +++ pad--; +++ } +++ word(w); +++ } +++ } while (*strptr++); +++ while (pad > 1) { +++ word(' '); +++ pad -= 2; +++ } +++ if (pad == 1) +++ word(' '); +++ else +++ word(0); +++ } +++} +++#endif OBJ +++ +++lenstr(sptr, padding) +++ +++ char *sptr; +++ int padding; +++ +++{ +++ register int cnt; +++ register char *strptr = sptr; +++ +++ cnt = padding; +++ do { +++ cnt++; +++ } while (*strptr++); +++ return((++cnt) & ~1); +++} +++ + +/* + + * Patch repairs the branch + + * at location loc to come + + * to the current location. +++ * for PC, this puts down the label +++ * and the branch just references that label. +++ * lets here it for two pass assemblers. + + */ + +patch(loc) + +{ + + - patchfil(loc, lc-loc-2, 1); +++# ifdef OBJ +++ patchfil(loc, lc-loc-2, 1); +++# endif OBJ +++# ifdef PC +++ putlab( loc ); +++# endif PC + +} + + +++#ifdef OBJ + +patch4(loc) + +{ + + - patchfil(loc, lc - HEAD_BYTES, 2); +++ patchfil(loc, lc - HEADER_BYTES, 2); + +} + + + +/* + + * Patchfil makes loc+2 have value + + * as its contents. + + */ + +patchfil(loc, value, words) - #ifdef VAX - unsigned long loc; - #endif - #ifdef PDP11 - char *loc; - #endif +++ PTR_DCL loc; + + int value, words; + +{ + + register i; + + + + if (cgenflg < 0) + + return; + + if (loc > (unsigned) lc) + + panic("patchfil"); + +#ifdef DEBUG - if (opt('c')) - printf(")#\tpatch %u %d\n", loc - HEAD_BYTES, value); +++ if (opt('k')) +++ printf(")#\tpatch %u %d\n", loc - HEADER_BYTES, value); + +#endif + + do { + + i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2; + + if (i >= 0 && i < 1024) + + obuf[i] = value; + + else { + + lseek(ofil, (long) loc+2, 0); + + write(ofil, &value, 2); + + lseek(ofil, (long) 0, 2); + + } + + loc += 2; + + value = value >> 16; + + } while (--words); + +} - +++ + +/* + + * Put the word o into the code + + */ + +word(o) + + int o; + +{ + + + + *obufp = o; + + obufp++; + + lc += 2; + + if (obufp >= obuf+512) + + pflush(); + +} + + + +extern char *obj; + +/* + + * Flush the code buffer + + */ + +pflush() + +{ + + register i; + + + + i = (obufp - ( ( short * ) obuf ) ) * 2; + + if (i != 0 && write(ofil, obuf, i) != i) + + perror(obj), pexit(DIED); + + obufp = obuf; + +} +++#endif OBJ + + + +/* + + * Getlab - returns the location counter. + + * included here for the eventual code generator. +++ * for PC, thank you! + + */ + +getlab() + +{ +++# ifdef OBJ + + - return (lc); +++ return (lc); +++# endif OBJ +++# ifdef PC +++ static long lastlabel; +++ +++ return ( ++lastlabel ); +++# endif PC + +} + + + +/* + + * Putlab - lay down a label. +++ * for PC, just print the label name with a colon after it. + + */ + +putlab(l) + + int l; + +{ + + +++# ifdef PC +++ putprintf( PREFIXFORMAT , 1 , LABELPREFIX , l ); +++ putprintf( ":" , 0 ); +++# endif PC + + return (l); + +} +++ diff --cc usr/src/cmd/pi/putn.c index 0000000000,a53d55e5c2,0000000000..703d6396ce mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/putn.c +++ b/usr/src/cmd/pi/putn.c @@@@ -1,0 -1,39 -1,0 +1,42 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)putn.c 1.1 8/27/80"; +++ + + /* + + * put[1234] + + * these sort of replace the assembler code + + * which used to mung the stack inserting 1, 2, 3, or 4 and then + + * jmp ( not jsr ) to put. these are more portable, + + * but since they can only receive integer arguments, calls + + * to one of these with long or real arguments must be changed + + * to call put directly. + + */ + + + + /* + + * is there some reason why these aren't #defined? + + */ + + + +put1 ( arg1 ) + + int arg1; + + { + + return ( put ( 1 , arg1 ) ); + + } + + + +put2 ( arg1 , arg2 ) + + int arg1 , arg2; + + { + + return ( put ( 2 , arg1 , arg2 ) ); + + } + + + +put3 ( arg1 , arg2 , arg3 ) + + int arg1 , arg2 , arg3; + + { + + return ( put ( 3 , arg1 , arg2 , arg3 ) ); + + } + + + +put4 ( arg1 , arg2 , arg3 , arg4 ) + + int arg1 , arg2 , arg3 , arg4; + + { + + return ( put ( 4 , arg1 , arg2 , arg3 , arg4 ) ); + + } + + diff --cc usr/src/cmd/pi/rec.c index 0000000000,a281f63bdd,0000000000..bdb8fad05c mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/rec.c +++ b/usr/src/cmd/pi/rec.c @@@@ -1,0 -1,248 -1,0 +1,267 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 Novmeber 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)rec.c 1.2 9/22/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" + + + +/* + + * Build a record namelist entry. + + * Some of the processing here is somewhat involved. + + * The basic structure we are building is as follows. + + * + + * Each record has a main RECORD entry, with an attached + + * chain of fields as ->chain; these include all the fields in all + + * the variants of this record. + + * + + * Attached to NL_VARNT is a chain of VARNT structures + + * describing each of the variants. These are further linked + + * through ->chain. Each VARNT has, in ->range[0] the value of + + * the associated constant, and each points at a RECORD describing + + * the subrecord through NL_VTOREC. These pointers are not unique, + + * more than one VARNT may reference the same RECORD. + + * + + * The involved processing here is in computing the NL_OFFS entry + + * by maxing over the variants. This works as follows. + + * + + * Each RECORD has two size counters. NL_OFFS is the maximum size + + * so far of any variant of this record; NL_FLDSZ gives the size + + * of just the FIELDs to this point as a base for further variants. + + * + + * As we process each variant record, we start its size with the + + * NL_FLDSZ we have so far. After processing it, if its NL_OFFS + + * is the largest so far, we update the NL_OFFS of this subrecord. + + * This will eventually propagate back and update the NL_OFFS of the + + * entire record. + + */ + + + +/* + + * P0 points to the outermost RECORD for name searches. + + */ + +struct nl *P0; + + + +tyrec(r, off) + + int *r, off; + +{ + + + + return tyrec1(r, off, 1); + +} + + + +/* + + * Define a record namelist entry. + + * R is the tree for the record to be built. + + * Off is the offset for the first item in this (sub)record. + + */ + +struct nl * + +tyrec1(r, off, first) + + register int *r; + + int off; + + char first; + +{ + + register struct nl *p, *P0was; + + + + p = defnl(0, RECORD, 0, 0); + + P0was = P0; + + if (first) + + P0 = p; + +#ifndef PI0 + + p->value[NL_FLDSZ] = p->value[NL_OFFS] = off; + +#endif + + if (r != NIL) { + + fields(p, r[2]); + + variants(p, r[3]); + + } +++ /* +++ * round the lengths of records up to their alignments +++ */ +++ p -> value[ NL_OFFS ] = roundup( p -> value[ NL_OFFS ] , align( p ) ); + + P0 = P0was; + + return (p); + +} + + + +/* + + * Define the fixed part fields for p. + + */ + +struct nl * + +fields(p, r) + + struct nl *p; + + int *r; + +{ + + register int *fp, *tp, *ip; + + struct nl *jp; + + + + for (fp = r; fp != NIL; fp = fp[2]) { + + tp = fp[1]; + + if (tp == NIL) + + continue; + + jp = gtype(tp[3]); + + line = tp[1]; + + for (ip = tp[2]; ip != NIL; ip = ip[2]) + + deffld(p, ip[1], jp); + + } + +} + + + +/* + + * Define the variants for RECORD p. + + */ + +struct nl * + +variants(p, r) + + struct nl *p; + + register int *r; + +{ + + register int *vc, *v; + + int *vr; + + struct nl *ct; + + + + if (r == NIL) + + return; + + ct = gtype(r[3]); +++ if ( isnta( ct , "bcsi" ) ) { +++ error("Tag fields cannot be %ss" , nameof( ct ) ); +++ } + + line = r[1]; + + /* + + * Want it even if r[2] is NIL so + + * we check its type in "new" and "dispose" + + * calls -- link it to NL_TAG. + + */ + + p->ptr[NL_TAG] = deffld(p, r[2], ct); + + for (vc = r[4]; vc != NIL; vc = vc[2]) { + + v = vc[1]; + + if (v == NIL) + + continue; + + vr = tyrec1(v[3], p->value[NL_FLDSZ], 0); + +#ifndef PI0 + + if (vr->value[NL_OFFS] > p->value[NL_OFFS]) + + p->value[NL_OFFS] = vr->value[NL_OFFS]; + +#endif + + line = v[1]; + + for (v = v[2]; v != NIL; v = v[2]) + + defvnt(p, v[1], vr, ct); + + } + +} + + + +/* + + * Define a field in subrecord p of record P0 + + * with name s and type t. + + */ + +struct nl * + +deffld(p, s, t) + + struct nl *p; + + register char *s; + + register struct nl *t; + +{ + + register struct nl *fp; + + + + if (reclook(P0, s) != NIL) { + +#ifndef PI1 + + error("%s is a duplicate field name in this record", s); + +#endif + + s = NIL; + + } + +#ifndef PI0 - fp = enter(defnl(s, FIELD, t, p->value[NL_OFFS])); +++ /* +++ * it used to be easy to keep track of offsets of fields +++ * and total sizes of records. +++ * but now, the offset of the field is aligned +++ * so only it knows it's offset, and calculating +++ * the total size of the record is based on it, +++ * rather than just the width of the field. +++ */ +++ fp = enter( defnl( s , FIELD , t , roundup( p -> value[ NL_OFFS ] +++ , align( t ) ) ) ); + +#else + + fp = enter(defnl(s, FIELD, t, 0)); + +#endif + + if (s != NIL) { + + fp->chain = P0->chain; + + P0->chain = fp; + +#ifndef PI0 - p->value[NL_FLDSZ] = p->value[NL_OFFS] += even(width(t)); +++ /* +++ * and the size of the record is incremented. +++ */ +++ p -> value[ NL_OFFS ] = fp -> value[ NL_OFFS ] + width( t ); +++ p -> value[ NL_FLDSZ ] = p -> value[ NL_OFFS ]; + +#endif + + if (t != NIL) { + + P0->nl_flags |= t->nl_flags & NFILES; + + p->nl_flags |= t->nl_flags & NFILES; + + } +++# ifdef PC +++ stabfield( s , p2type( t ) , fp -> value[ NL_OFFS ] +++ , lwidth( t ) ); +++# endif PC + + } + + return (fp); + +} + + + +/* + + * Define a variant from the constant tree of t + + * in subrecord p of record P0 where the casetype + + * is ct and the variant record to be associated is vr. + + */ + +struct nl * + +defvnt(p, t, vr, ct) + + struct nl *p, *vr; + + int *t; + + register struct nl *ct; + +{ + + register struct nl *av; + + + + gconst(t); - if (ct != NIL && incompat(con.ctype, ct)) { +++ if (ct != NIL && incompat(con.ctype, ct , t )) { + +#ifndef PI1 + + cerror("Variant label type incompatible with selector type"); + +#endif + + ct = NIL; + + } + + av = defnl(0, VARNT, ct, 0); + +#ifndef PI1 + + if (ct != NIL) + + uniqv(p); + +#endif + + av->chain = p->ptr[NL_VARNT]; + + p->ptr[NL_VARNT] = av; + + av->ptr[NL_VTOREC] = vr; + + av->range[0] = con.crval; + + return (av); + +} + + + +#ifndef PI1 + +/* + + * Check that the constant label value + + * is unique among the labels in this variant. + + */ + +uniqv(p) + + struct nl *p; + +{ + + register struct nl *vt; + + + + for (vt = p->ptr[NL_VARNT]; vt != NIL; vt = vt->chain) + + if (vt->range[0] == con.crval) { + + error("Duplicate variant case label in record"); + + return; + + } + +} + +#endif + + + +/* + + * See if the field name s is defined + + * in the record p, returning a pointer + + * to it namelist entry if it is. + + */ + +struct nl * + +reclook(p, s) + + register struct nl *p; + + char *s; + +{ + + + + if (p == NIL || s == NIL) + + return (NIL); + + for (p = p->chain; p != NIL; p = p->chain) + + if (p->symbol == s) + + return (p); + + return (NIL); + +} diff --cc usr/src/cmd/pi/rval.c index 0000000000,fb51694929,0000000000..22849a80a6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/rval.c +++ b/usr/src/cmd/pi/rval.c @@@@ -1,0 -1,554 -1,0 +1,1150 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 Novmeber 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)rval.c 1.5 10/28/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++#endif PC + + + +extern char *opnames[]; +++ +++ /* line number of the last record comparison warning */ +++short reccompline = 0; +++ +++#ifdef PC +++ char *relts[] = { +++ "_RELEQ" , "_RELNE" , +++ "_RELTLT" , "_RELTGT" , +++ "_RELTLE" , "_RELTGE" +++ }; +++ char *relss[] = { +++ "_RELEQ" , "_RELNE" , +++ "_RELSLT" , "_RELSGT" , +++ "_RELSLE" , "_RELSGE" +++ }; +++ long relops[] = { +++ P2EQ , P2NE , +++ P2LT , P2GT , +++ P2LE , P2GE +++ }; +++ long mathop[] = { P2MUL , P2PLUS , P2MINUS }; +++ char *setop[] = { "_MULT" , "_ADDT" , "_SUBT" }; +++#endif PC + +/* + + * Rvalue - an expression. + + * + + * Contype is the type that the caller would prefer, nand is important + + * if constant sets or constant strings are involved, the latter + + * because of string padding. +++ * required is a flag whether an lvalue or an rvalue is required. +++ * only VARs and structured things can have gt their lvalue this way. + + */ + +struct nl * - rvalue(r, contype) +++rvalue(r, contype , required ) + + int *r; + + struct nl *contype; +++ int required; + +{ + + register struct nl *p, *p1; + + register struct nl *q; + + int c, c1, *rt, w, g; + + char *cp, *cp1, *opname; + + long l; + + double f; +++ extern int flagwas; +++ struct csetstr csetd; +++# ifdef PC +++ struct nl *rettype; +++ long ctype; +++ long tempoff; +++# endif PC + + + + if (r == NIL) + + return (NIL); + + if (nowexp(r)) + + return (NIL); + + /* + + * Pick up the name of the operation + + * for future error messages. + + */ + + if (r[0] <= T_IN) + + opname = opnames[r[0]]; + + + + /* + + * The root of the tree tells us what sort of expression we have. + + */ + + switch (r[0]) { + + + + /* + + * The constant nil + + */ + + case T_NIL: - put2(O_CON2, 0); +++# ifdef OBJ +++ put(2, O_CON2, 0); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 , P2PTR|P2UNDEF , 0 ); +++# endif PC + + return (nl+TNIL); + + + + /* + + * Function call with arguments. + + */ + + case T_FCALL: +++# ifdef OBJ + + return (funccod(r)); +++# endif OBJ +++# ifdef PC +++ return (pcfunccod( r )); +++# endif PC + + + + case T_VAR: + + p = lookup(r[2]); + + if (p == NIL || p->class == BADUSE) + + return (NIL); + + switch (p->class) { + + case VAR: + + /* + + * If a variable is + + * qualified then get + + * the rvalue by a + + * lvalue and an ind. + + */ + + if (r[3] != NIL) + + goto ind; + + q = p->type; + + if (q == NIL) + + return (NIL); - w = width(q); - switch (w) { - case 8: - w = 6; - case 4: - case 2: - case 1: - put2(O_RV1 + (w >> 1) | bn << 9 - , p->value[0]); - break; - default: - put3(O_RV | bn << 9, p->value[0], w); - } - return (q); +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(2, O_RV8 | bn << 8+INDX, p->value[0]); +++ break; +++ case 4: +++ put(2, O_RV4 | bn << 8+INDX, p->value[0]); +++ break; +++ case 2: +++ put(2, O_RV2 | bn << 8+INDX, p->value[0]); +++ break; +++ case 1: +++ put(2, O_RV1 | bn << 8+INDX, p->value[0]); +++ break; +++ default: +++ put(3, O_RV | bn << 8+INDX, p->value[0], w); +++ } +++# endif OBJ +++# ifdef PC +++ if ( required == RREQ ) { +++ putRV( p -> symbol , bn , p -> value[0] +++ , p2type( q ) ); +++ } else { +++ putLV( p -> symbol , bn , p -> value[0] +++ , p2type( q ) ); +++ } +++# endif PC +++ return (q); + + + + case WITHPTR: + + case REF: + + /* + + * A lvalue for these + + * is actually what one + + * might consider a rvalue. + + */ + +ind: - q = lvalue(r, NOMOD); +++ q = lvalue(r, NOFLAGS , LREQ ); + + if (q == NIL) + + return (NIL); - w = width(q); - switch (w) { - case 8: - w = 6; - case 4: - case 2: - case 1: - put1(O_IND1 + (w >> 1)); - break; - default: - put2(O_IND, w); - } +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(1, O_IND8); +++ break; +++ case 4: +++ put(1, O_IND4); +++ break; +++ case 2: +++ put(1, O_IND2); +++ break; +++ case 1: +++ put(1, O_IND1); +++ break; +++ default: +++ put(2, O_IND, w); +++ } +++# endif OBJ +++# ifdef PC +++ if ( required == RREQ ) { +++ putop( P2UNARY P2MUL , p2type( q ) ); +++ } +++# endif PC + + return (q); + + + + case CONST: + + if (r[3] != NIL) { - error("%s is a constant and cannot be qualified", r[2]); - return (NIL); +++ error("%s is a constant and cannot be qualified", r[2]); +++ return (NIL); + + } + + q = p->type; + + if (q == NIL) + + return (NIL); + + if (q == nl+TSTR) { + + /* + + * Find the size of the string + + * constant if needed. + + */ + + cp = p->ptr[0]; + +cstrng: + + cp1 = cp; + + for (c = 0; *cp++; c++) + + continue; + + if (contype != NIL && !opt('s')) { + + if (width(contype) < c && classify(contype) == TSTR) { + + error("Constant string too long"); + + return (NIL); + + } + + c = width(contype); + + } - put( 2 + (sizeof ( char * )/sizeof ( short )) , O_CONG, c, cp1); +++# ifdef OBJ +++ put( 2 + (sizeof(char *)/sizeof(short)) +++ , O_CONG, c, cp1); +++# endif OBJ +++# ifdef PC +++ putCONG( cp1 , c , required ); +++# endif PC + + /* + + * Define the string temporarily + + * so later people can know its + + * width. + + * cleaned out by stat. + + */ + + q = defnl(0, STR, 0, c); + + q->type = q; + + return (q); + + } + + if (q == nl+T1CHAR) { - put2(O_CONC, p->value[0]); +++# ifdef OBJ +++ put(2, O_CONC, p->value[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , p -> value[0] , 0 +++ , P2CHAR , 0 ); +++# endif PC + + return (q); + + } + + /* + + * Every other kind of constant here + + */ + + switch (width(q)) { + + case 8: + +#ifndef DEBUG - put(5, O_CON8, p->real); +++# ifdef OBJ +++ put(2, O_CON8, p->real); +++# endif OBJ +++# ifdef PC +++ putCON8( p -> real ); +++# endif PC + +#else + + if (hp21mx) { + + f = p->real; + + conv(&f); + + l = f.plong; - put( 3 , O_CON4, l); +++ put(2, O_CON4, l); + + } else - put(5, O_CON8, p->real); +++# ifdef OBJ +++ put(2, O_CON8, p->real); +++# endif OBJ +++# ifdef PC +++ putCON8( p -> real ); +++# endif PC + +#endif + + break; + + case 4: - put( 3 , O_CON4, p->range[0]); +++# ifdef OBJ +++ put(2, O_CON4, p->range[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , p -> range[0] , 0 +++ , P2INT , 0 ); +++# endif PC + + break; + + case 2: - put2(O_CON2, ( short ) p->range[0]); +++# ifdef OBJ +++ put(2, O_CON2, ( short ) p->range[0]); +++# endif OBJ +++# ifdef PC +++ /* +++ * make short constants ints +++ */ +++ putleaf( P2ICON , (short) p -> range[0] +++ , 0 , P2INT , 0 ); +++# endif PC + + break; + + case 1: - put2(O_CON1, p->value[0]); +++# ifdef OBJ +++ put(2, O_CON1, p->value[0]); +++# endif OBJ +++# ifdef PC +++ /* +++ * make char constants ints +++ */ +++ putleaf( P2ICON , p -> value[0] , 0 +++ , P2INT , 0 ); +++# endif PC + + break; + + default: + + panic("rval"); + + } + + return (q); + + + + case FUNC: +++ case FFUNC: + + /* + + * Function call with no arguments. + + */ + + if (r[3]) { + + error("Can't qualify a function result value"); + + return (NIL); + + } - return (funccod((int *) r)); +++# ifdef OBJ +++ return (funccod((int *) r)); +++# endif OBJ +++# ifdef PC +++ return (pcfunccod( r )); +++# endif PC + + + + case TYPE: + + error("Type names (e.g. %s) allowed only in declarations", p->symbol); + + return (NIL); + + + + case PROC: +++ case FPROC: + + error("Procedure %s found where expression required", p->symbol); + + return (NIL); + + default: + + panic("rvid"); + + } + + /* + + * Constant sets + + */ + + case T_CSET: - return (cset(r, contype, NIL)); +++# ifdef OBJ +++ if ( precset( r , contype , &csetd ) ) { +++ if ( csetd.csettype == NIL ) { +++ return NIL; +++ } +++ postcset( r , &csetd ); +++ } else { +++ put( 2, O_PUSH, -width(csetd.csettype)); +++ postcset( r , &csetd ); +++ setran( ( csetd.csettype ) -> type ); +++ put( 2, O_CON24, set.uprbp); +++ put( 2, O_CON24, set.lwrb); +++ put( 2, O_CTTOT, 5 + csetd.singcnt + 2 * csetd.paircnt); +++ } +++ return csetd.csettype; +++# endif OBJ +++# ifdef PC +++ if ( precset( r , contype , &csetd ) ) { +++ if ( csetd.csettype == NIL ) { +++ return NIL; +++ } +++ postcset( r , &csetd ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_CTTOT" ); +++ /* +++ * allocate a temporary and use it +++ */ +++ sizes[ cbn ].om_off -= lwidth( csetd.csettype ); +++ tempoff = sizes[ cbn ].om_off; +++ putlbracket( ftnno , -tempoff ); +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putLV( 0 , cbn , tempoff , P2PTR|P2STRTY ); +++ setran( ( csetd.csettype ) -> type ); +++ putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ postcset( r , &csetd ); +++ putop( P2CALL , P2INT ); +++ } +++ return csetd.csettype; +++# endif PC + + + + /* + + * Unary plus and minus + + */ + + case T_PLUS: + + case T_MINUS: - q = rvalue(r[2], NIL); +++ q = rvalue(r[2], NIL , RREQ ); + + if (q == NIL) + + return (NIL); + + if (isnta(q, "id")) { + + error("Operand of %s must be integer or real, not %s", opname, nameof(q)); + + return (NIL); + + } + + if (r[0] == T_MINUS) { - put1(O_NEG2 + (width(q) >> 2)); - return (isa(q, "d") ? q : nl+T4INT); +++# ifdef OBJ +++ put(1, O_NEG2 + (width(q) >> 2)); +++# endif OBJ +++# ifdef PC +++ putop( P2UNARY P2MINUS , p2type( q ) ); +++# endif PC +++ return (isa(q, "d") ? q : nl+T4INT); + + } + + return (q); + + + + case T_NOT: - q = rvalue(r[2], NIL); +++ q = rvalue(r[2], NIL , RREQ ); + + if (q == NIL) + + return (NIL); + + if (isnta(q, "b")) { + + error("not must operate on a Boolean, not %s", nameof(q)); + + return (NIL); + + } - put1(O_NOT); +++# ifdef OBJ +++ put(1, O_NOT); +++# endif OBJ +++# ifdef PC +++ putop( P2NOT , P2INT ); +++# endif PC + + return (nl+T1BOOL); + + + + case T_AND: + + case T_OR: - p = rvalue(r[2], NIL); - p1 = rvalue(r[3], NIL); +++ p = rvalue(r[2], NIL , RREQ ); +++ p1 = rvalue(r[3], NIL , RREQ ); + + if (p == NIL || p1 == NIL) + + return (NIL); + + if (isnta(p, "b")) { + + error("Left operand of %s must be Boolean, not %s", opname, nameof(p)); + + return (NIL); + + } + + if (isnta(p1, "b")) { + + error("Right operand of %s must be Boolean, not %s", opname, nameof(p1)); + + return (NIL); + + } - put1(r[0] == T_AND ? O_AND : O_OR); +++# ifdef OBJ +++ put(1, r[0] == T_AND ? O_AND : O_OR); +++# endif OBJ +++# ifdef PC +++ /* +++ * note the use of & and | rather than && and || +++ * to force evaluation of all the expressions. +++ */ +++ putop( r[ 0 ] == T_AND ? P2AND : P2OR , P2INT ); +++# endif PC + + return (nl+T1BOOL); + + + + case T_DIVD: - p = rvalue(r[2], NIL); - p1 = rvalue(r[3], NIL); +++# ifdef OBJ +++ p = rvalue(r[2], NIL , RREQ ); +++ p1 = rvalue(r[3], NIL , RREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * force these to be doubles for the divide +++ */ +++ p = rvalue( r[ 2 ] , NIL , RREQ ); +++ if ( isnta( p , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ p1 = rvalue( r[ 3 ] , NIL , RREQ ); +++ if ( isnta( p1 , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++# endif PC + + if (p == NIL || p1 == NIL) + + return (NIL); + + if (isnta(p, "id")) { + + error("Left operand of / must be integer or real, not %s", nameof(p)); + + return (NIL); + + } + + if (isnta(p1, "id")) { + + error("Right operand of / must be integer or real, not %s", nameof(p1)); + + return (NIL); + + } - return (gen(NIL, r[0], width(p), width(p1))); +++# ifdef OBJ +++ return gen(NIL, r[0], width(p), width(p1)); +++# endif OBJ +++# ifdef PC +++ putop( P2DIV , P2DOUBLE ); +++ return nl + TDOUBLE; +++# endif PC + + + + case T_MULT: - case T_SUB: + + case T_ADD: - /* - * If the context hasn't told us - * the type and a constant set is - * present on the left we need to infer - * the type from the right if possible - * before generating left side code. - */ - if (contype == NIL && (rt = r[2]) != NIL && rt[1] == SAWCON) { - codeoff(); - contype = rvalue(r[3], NIL); - codeon(); - if (contype == NIL) - return (NIL); - } - p = rvalue(r[2], contype); - p1 = rvalue(r[3], p); - if (p == NIL || p1 == NIL) - return (NIL); - if (isa(p, "id") && isa(p1, "id")) +++ case T_SUB: +++# ifdef OBJ +++ /* +++ * If the context hasn't told us the type +++ * and a constant set is present +++ * we need to infer the type +++ * before generating code. +++ */ +++ if ( contype == NIL ) { +++ codeoff(); +++ contype = rvalue( r[3] , NIL , RREQ ); +++ codeon(); +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ contype = rvalue( r[2] , NIL , RREQ ); +++ codeon(); +++ } +++ } +++ if ( contype == NIL ) { +++ return NIL; +++ } +++ p = rvalue( r[2] , contype , RREQ ); +++ p1 = rvalue( r[3] , p , RREQ ); +++ if ( p == NIL || p1 == NIL ) +++ return NIL; +++ if (isa(p, "id") && isa(p1, "id")) + + return (gen(NIL, r[0], width(p), width(p1))); - if (isa(p, "t") && isa(p1, "t")) { - if (p != p1) { +++ if (isa(p, "t") && isa(p1, "t")) { +++ if (p != p1) { +++ error("Set types of operands of %s must be identical", opname); +++ return (NIL); +++ } +++ gen(TSET, r[0], width(p), 0); +++ return (p); +++ } +++# endif OBJ +++# ifdef PC +++ /* +++ * the second pass can't do +++ * long op double or double op long +++ * so we have to know the type of both operands +++ * also, it gets tricky for sets, which are done +++ * by function calls. +++ */ +++ codeoff(); +++ p1 = rvalue( r[ 3 ] , contype , RREQ ); +++ codeon(); +++ if ( isa( p1 , "id" ) ) { +++ p = rvalue( r[ 2 ] , contype , RREQ ); +++ if ( ( p == NIL ) || ( p1 == NIL ) ) { +++ return NIL; +++ } +++ if ( isa( p , "i" ) && isa( p1 , "d" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ p1 = rvalue( r[ 3 ] , contype , RREQ ); +++ if ( isa( p , "d" ) && isa( p1 , "i" ) ) { +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ if ( isa( p , "id" ) ) { +++ if ( isa( p , "d" ) || isa( p1 , "d" ) ) { +++ ctype = P2DOUBLE; +++ rettype = nl + TDOUBLE; +++ } else { +++ ctype = P2INT; +++ rettype = nl + T4INT; +++ } +++ putop( mathop[ r[0] - T_MULT ] , ctype ); +++ return rettype; +++ } +++ } +++ if ( isa( p1 , "t" ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( ADDTYPE( P2PTR | P2STRTY , P2FTN ) +++ , P2PTR ) +++ , setop[ r[0] - T_MULT ] ); +++ if ( contype == NIL ) { +++ contype = p1; +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ contype = rvalue( r[2] , NIL , LREQ ); +++ codeon(); +++ } +++ } +++ if ( contype == NIL ) { +++ return NIL; +++ } +++ /* +++ * allocate a temporary and use it +++ */ +++ sizes[ cbn ].om_off -= lwidth( contype ); +++ tempoff = sizes[ cbn ].om_off; +++ putlbracket( ftnno , -tempoff ); +++ if ( tempoff < sizes[ cbn ].om_max ) { +++ sizes[ cbn ].om_max = tempoff; +++ } +++ putLV( 0 , cbn , tempoff , P2PTR|P2STRTY ); +++ p = rvalue( r[2] , contype , LREQ ); +++ if ( isa( p , "t" ) ) { +++ putop( P2LISTOP , P2INT ); +++ if ( p == NIL || p1 == NIL ) { +++ return NIL; +++ } +++ p1 = rvalue( r[3] , p , LREQ ); +++ if ( p != p1 ) { + + error("Set types of operands of %s must be identical", opname); - return (NIL); +++ return NIL; +++ } +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , lwidth( p1 ) / sizeof( long ) , 0 +++ , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2PTR | P2STRTY ); +++ return p; + + } - gen(TSET, r[0], width(p), 0); +++ } +++ if ( isnta( p1 , "idt" ) ) { +++ /* +++ * find type of left operand for error message. +++ */ +++ p = rvalue( r[2] , contype , RREQ ); +++ } + + /* - * Note that set was filled in by the call - * to width above. +++ * don't give spurious error messages. + + */ - if (r[0] == T_SUB) - put2(NIL, 0177777 << ((set.uprbp & 017) + 1)); - return (p); - } +++ if ( p == NIL || p1 == NIL ) { +++ return NIL; +++ } +++# endif PC + + if (isnta(p, "idt")) { + + error("Left operand of %s must be integer, real or set, not %s", opname, nameof(p)); + + return (NIL); + + } + + if (isnta(p1, "idt")) { + + error("Right operand of %s must be integer, real or set, not %s", opname, nameof(p1)); + + return (NIL); + + } + + error("Cannot mix sets with integers and reals as operands of %s", opname); + + return (NIL); + + + + case T_MOD: + + case T_DIV: - p = rvalue(r[2], NIL); - p1 = rvalue(r[3], NIL); +++ p = rvalue(r[2], NIL , RREQ ); +++ p1 = rvalue(r[3], NIL , RREQ ); + + if (p == NIL || p1 == NIL) + + return (NIL); + + if (isnta(p, "i")) { + + error("Left operand of %s must be integer, not %s", opname, nameof(p)); + + return (NIL); + + } + + if (isnta(p1, "i")) { + + error("Right operand of %s must be integer, not %s", opname, nameof(p1)); + + return (NIL); + + } - return (gen(NIL, r[0], width(p), width(p1))); +++# ifdef OBJ +++ return (gen(NIL, r[0], width(p), width(p1))); +++# endif OBJ +++# ifdef PC +++ putop( r[ 0 ] == T_DIV ? P2DIV : P2MOD , P2INT ); +++ return ( nl + T4INT ); +++# endif PC + + + + case T_EQ: + + case T_NE: - case T_GE: - case T_LE: - case T_GT: + + case T_LT: +++ case T_GT: +++ case T_LE: +++ case T_GE: + + /* + + * Since there can be no, a priori, knowledge + + * of the context type should a constant string + + * or set arise, we must poke around to find such + + * a type if possible. Since constant strings can + + * always masquerade as identifiers, this is always + + * necessary. + + */ + + codeoff(); - p1 = rvalue(r[3], NIL); +++ p1 = rvalue(r[3], NIL , RREQ ); + + codeon(); + + if (p1 == NIL) + + return (NIL); + + contype = p1; - if (p1 == nl+TSET || p1->class == STR) { - /* - * For constant strings we want - * the longest type so as to be - * able to do padding (more importantly - * avoiding truncation). For clarity, - * we get this length here. - */ - codeoff(); - p = rvalue(r[2], NIL); - codeon(); - if (p == NIL) - return (NIL); - if (p1 == nl+TSET || width(p) > width(p1)) +++# ifdef OBJ +++ if (p1->class == STR) { +++ /* +++ * For constant strings we want +++ * the longest type so as to be +++ * able to do padding (more importantly +++ * avoiding truncation). For clarity, +++ * we get this length here. +++ */ +++ codeoff(); +++ p = rvalue(r[2], NIL , RREQ ); +++ codeon(); +++ if (p == NIL) +++ return (NIL); +++ if (width(p) > width(p1)) +++ contype = p; +++ } else if ( isa( p1 , "t" ) ) { +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ contype = rvalue( r[2] , NIL , RREQ ); +++ codeon(); +++ if ( contype == NIL ) { +++ return NIL; +++ } +++ } +++ } +++ /* +++ * Now we generate code for +++ * the operands of the relational +++ * operation. +++ */ +++ p = rvalue(r[2], contype , RREQ ); +++ if (p == NIL) +++ return (NIL); +++ p1 = rvalue(r[3], p , RREQ ); +++ if (p1 == NIL) +++ return (NIL); +++# endif OBJ +++# ifdef PC +++ c1 = classify( p1 ); +++ if ( c1 == TSET || c1 == TSTR || c1 == TREC ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , c1 == TSET ? relts[ r[0] - T_EQ ] +++ : relss[ r[0] - T_EQ ] ); +++ /* +++ * for [] and strings, comparisons are done on +++ * the maximum width of the two sides. +++ * for other sets, we have to ask the left side +++ * what type it is based on the type of the right. +++ * (this matters for intsets). +++ */ +++ if ( c1 == TSTR ) { +++ codeoff(); +++ p = rvalue( r[ 2 ] , NIL , LREQ ); +++ codeon(); +++ if ( p == NIL ) { +++ return NIL; +++ } +++ if ( lwidth( p ) > lwidth( p1 ) ) { + + contype = p; - } - /* - * Now we generate code for - * the operands of the relational - * operation. - */ - p = rvalue(r[2], contype); - if (p == NIL) - return (NIL); - p1 = rvalue(r[3], p); - if (p1 == NIL) - return (NIL); +++ } +++ } else if ( c1 == TSET ) { +++ if ( contype == lookup( intset ) -> type ) { +++ codeoff(); +++ p = rvalue( r[ 2 ] , NIL , LREQ ); +++ codeon(); +++ if ( p == NIL ) { +++ return NIL; +++ } +++ contype = p; +++ } +++ } +++ /* +++ * put out the width of the comparison. +++ */ +++ putleaf( P2ICON , lwidth( contype ) , 0 , P2INT , 0 ); +++ /* +++ * and the left hand side, +++ * for sets, strings, records +++ */ +++ p = rvalue( r[ 2 ] , contype , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ p1 = rvalue( r[ 3 ] , p , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ putop( P2CALL , P2INT ); +++ } else { +++ /* +++ * the easy (scalar or error) case +++ */ +++ p = rvalue( r[ 2 ] , contype , RREQ ); +++ if ( p == NIL ) { +++ return NIL; +++ /* +++ * since the second pass can't do +++ * long op double or double op long +++ * we may have to do some coercing. +++ */ +++ if ( isa( p , "i" ) && isa( p1 , "d" ) ) +++ putop( P2SCONV , P2DOUBLE ); +++ } +++ p1 = rvalue( r[ 3 ] , p , RREQ ); +++ if ( isa( p , "d" ) && isa( p1 , "i" ) ) +++ putop( P2SCONV , P2DOUBLE ); +++ putop( relops[ r[0] - T_EQ ] , P2INT ); +++ } +++# endif PC + + c = classify(p); + + c1 = classify(p1); + + if (nocomp(c) || nocomp(c1)) + + return (NIL); + + g = NIL; + + switch (c) { + + case TBOOL: + + case TCHAR: + + if (c != c1) + + goto clash; + + break; + + case TINT: + + case TDOUBLE: + + if (c1 != TINT && c1 != TDOUBLE) + + goto clash; + + break; + + case TSCAL: + + if (c1 != TSCAL) + + goto clash; + + if (scalar(p) != scalar(p1)) + + goto nonident; + + break; + + case TSET: + + if (c1 != TSET) + + goto clash; + + if (p != p1) + + goto nonident; + + g = TSET; + + break; +++ case TREC: +++ if ( c1 != TREC ) { +++ goto clash; +++ } +++ if ( p != p1 ) { +++ goto nonident; +++ } +++ if (r[0] != T_EQ && r[0] != T_NE) { +++ error("%s not allowed on records - only allow = and <>" , opname ); +++ return (NIL); +++ } +++ g = TREC; +++ break; + + case TPTR: + + case TNIL: + + if (c1 != TPTR && c1 != TNIL) + + goto clash; + + if (r[0] != T_EQ && r[0] != T_NE) { - error("%s not allowed on pointers - only allow = and <>"); +++ error("%s not allowed on pointers - only allow = and <>" , opname ); + + return (NIL); + + } + + break; + + case TSTR: + + if (c1 != TSTR) + + goto clash; + + if (width(p) != width(p1)) { + + error("Strings not same length in %s comparison", opname); + + return (NIL); + + } + + g = TSTR; + + break; + + default: + + panic("rval2"); + + } - return (gen(g, r[0], width(p), width(p1))); +++# ifdef OBJ +++ return (gen(g, r[0], width(p), width(p1))); +++# endif OBJ +++# ifdef PC +++ return nl + TBOOL; +++# endif PC + +clash: + + error("%ss and %ss cannot be compared - operator was %s", clnames[c], clnames[c1], opname); + + return (NIL); + +nonident: + + error("%s types must be identical in comparisons - operator was %s", clnames[c1], opname); + + return (NIL); + + + + case T_IN: - rt = r[3]; - if (rt != NIL && rt[0] == T_CSET) - p1 = cset(rt, NLNIL, 1); - else { - p1 = rvalue(r[3], NIL); +++ rt = r[3]; +++# ifdef OBJ +++ if (rt != NIL && rt[0] == T_CSET) { +++ precset( rt , NIL , &csetd ); +++ p1 = csetd.csettype; +++ if (p1 == NIL) +++ return NIL; +++ postcset( rt, &csetd); +++ } else { +++ p1 = stkrval(r[3], NIL , RREQ ); + + rt = NIL; - } - if (p1 == nl+TSET) { - warning(); - error("... in [] makes little sense, since it is always false!"); - put1(O_CON1, 0); - return (nl+T1BOOL); - } - p = rvalue(r[2], NIL); +++ } +++# endif OBJ +++# ifdef PC +++ if (rt != NIL && rt[0] == T_CSET) { +++ if ( precset( rt , NIL , &csetd ) ) { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_IN" ); +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_INCT" ); +++ } +++ p1 = csetd.csettype; +++ if (p1 == NIL) +++ return NIL; +++ } else { +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_IN" ); +++ codeoff(); +++ p1 = rvalue(r[3], NIL , LREQ ); +++ codeon(); +++ } +++# endif PC +++ p = stkrval(r[2], NIL , RREQ ); + + if (p == NIL || p1 == NIL) + + return (NIL); + + if (p1->class != SET) { + + error("Right operand of 'in' must be a set, not %s", nameof(p1)); + + return (NIL); + + } + + if (incompat(p, p1->type, r[2])) { + + cerror("Index type clashed with set component type for 'in'"); + + return (NIL); + + } - convert(p, nl+T2INT); + + setran(p1->type); - if (rt == NIL) - put4(O_IN, width(p1), set.lwrb, set.uprbp); - else - put1(O_INCT); +++# ifdef OBJ +++ if (rt == NIL || csetd.comptime) +++ put(4, O_IN, width(p1), set.lwrb, set.uprbp); +++ else +++ put(2, O_INCT, 3 + csetd.singcnt + 2*csetd.paircnt); +++# endif OBJ +++# ifdef PC +++ if ( rt == NIL || rt[0] != T_CSET ) { +++ putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ p1 = rvalue( r[3] , NIL , LREQ ); +++ putop( P2LISTOP , P2INT ); +++ } else if ( csetd.comptime ) { +++ putleaf( P2ICON , set.lwrb , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ putleaf( P2ICON , set.uprbp , 0 , P2INT , 0 ); +++ putop( P2LISTOP , P2INT ); +++ postcset( r[3] , &csetd ); +++ putop( P2LISTOP , P2INT ); +++ } else { +++ postcset( r[3] , &csetd ); +++ } +++ putop( P2CALL , P2INT ); +++# endif PC + + return (nl+T1BOOL); - + + default: + + if (r[2] == NIL) + + return (NIL); + + switch (r[0]) { + + default: + + panic("rval3"); + + + + + + /* + + * An octal number + + */ + + case T_BINT: + + f = a8tol(r[2]); + + goto conint; + + + + /* + + * A decimal number + + */ + + case T_INT: + + f = atof(r[2]); + +conint: + + if (f > MAXINT || f < MININT) { + + error("Constant too large for this implementation"); + + return (NIL); + + } + + l = f; + + if (bytes(l, l) <= 2) { - put2(O_CON2, ( short ) l); +++# ifdef OBJ +++ put(2, O_CON2, ( short ) l); +++# endif OBJ +++# ifdef PC +++ /* +++ * short constants are ints +++ */ +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++# endif PC + + return (nl+T2INT); + + } - put( 3 , O_CON4, l); +++# ifdef OBJ +++ put(2, O_CON4, l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++# endif PC + + return (nl+T4INT); + + + + /* + + * A floating point number + + */ + + case T_FINT: - put(5, O_CON8, atof(r[2])); +++# ifdef OBJ +++ put(2, O_CON8, atof(r[2])); +++# endif OBJ +++# ifdef PC +++ putCON8( atof( r[2] ) ); +++# endif PC + + return (nl+TDOUBLE); + + + + /* + + * Constant strings. Note that constant characters + + * are constant strings of length one; there is + + * no constant string of length one. + + */ + + case T_STRNG: + + cp = r[2]; + + if (cp[1] == 0) { - put2(O_CONC, cp[0]); +++# ifdef OBJ +++ put(2, O_CONC, cp[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 ); +++# endif PC + + return (nl+T1CHAR); + + } + + goto cstrng; + + } + + + + } + +} + + + +/* + + * Can a class appear + + * in a comparison ? + + */ + +nocomp(c) + + int c; + +{ + + + + switch (c) { +++ case TREC: +++ if ( line != reccompline ) { +++ reccompline = line; +++ warning(); +++ if ( opt( 's' ) ) { +++ standard(); +++ } +++ error("record comparison is non-standard"); +++ } +++ break; + + case TFILE: + + case TARY: - case TREC: + + error("%ss may not participate in comparisons", clnames[c]); + + return (1); + + } + + return (NIL); + +} +++ +++ /* +++ * this is sort of like gconst, except it works on expression trees +++ * rather than declaration trees, and doesn't give error messages for +++ * non-constant things. +++ * as a side effect this fills in the con structure that gconst uses. +++ * this returns TRUE or FALSE. +++ */ +++constval(r) +++ register int *r; +++{ +++ register struct nl *np; +++ register *cn; +++ char *cp; +++ int negd, sgnd; +++ long ci; +++ +++ con.ctype = NIL; +++ cn = r; +++ negd = sgnd = 0; +++loop: +++ /* +++ * cn[2] is nil if error recovery generated a T_STRNG +++ */ +++ if (cn == NIL || cn[2] == NIL) +++ return FALSE; +++ switch (cn[0]) { +++ default: +++ return FALSE; +++ case T_MINUS: +++ negd = 1 - negd; +++ /* and fall through */ +++ case T_PLUS: +++ sgnd++; +++ cn = cn[2]; +++ goto loop; +++ case T_NIL: +++ con.cpval = NIL; +++ con.cival = 0; +++ con.crval = con.cival; +++ con.ctype = nl + TNIL; +++ break; +++ case T_VAR: +++ np = lookup(cn[2]); +++ if (np == NIL || np->class != CONST) { +++ return FALSE; +++ } +++ if ( cn[3] != NIL ) { +++ return FALSE; +++ } +++ con.ctype = np->type; +++ switch (classify(np->type)) { +++ case TINT: +++ con.crval = np->range[0]; +++ break; +++ case TDOUBLE: +++ con.crval = np->real; +++ break; +++ case TBOOL: +++ case TCHAR: +++ case TSCAL: +++ con.cival = np->value[0]; +++ con.crval = con.cival; +++ break; +++ case TSTR: +++ con.cpval = np->ptr[0]; +++ break; +++ default: +++ con.ctype = NIL; +++ return FALSE; +++ } +++ break; +++ case T_BINT: +++ con.crval = a8tol(cn[2]); +++ goto restcon; +++ case T_INT: +++ con.crval = atof(cn[2]); +++ if (con.crval > MAXINT || con.crval < MININT) { +++ derror("Constant too large for this implementation"); +++ con.crval = 0; +++ } +++restcon: +++ ci = con.crval; +++#ifndef PI0 +++ if (bytes(ci, ci) <= 2) +++ con.ctype = nl+T2INT; +++ else +++#endif +++ con.ctype = nl+T4INT; +++ break; +++ case T_FINT: +++ con.ctype = nl+TDOUBLE; +++ con.crval = atof(cn[2]); +++ break; +++ case T_STRNG: +++ cp = cn[2]; +++ if (cp[1] == 0) { +++ con.ctype = nl+T1CHAR; +++ con.cival = cp[0]; +++ con.crval = con.cival; +++ break; +++ } +++ con.ctype = nl+TSTR; +++ con.cpval = cp; +++ break; +++ } +++ if (sgnd) { +++ if (isnta(con.ctype, "id")) { +++ derror("%s constants cannot be signed", nameof(con.ctype)); +++ return FALSE; +++ } else if (negd) +++ con.crval = -con.crval; +++ } +++ return TRUE; +++} diff --cc usr/src/cmd/pi/send.h index 0000000000,0000000000,0000000000..ef74c70969 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/send.h @@@@ -1,0 -1,0 -1,0 +1,32 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)send.h 1.1 8/27/80"; */ +++ +++#define RINIT 1 +++#define RENQ 2 +++#define RTREE 3 +++#define RTRFREE 4 +++#define RTRCHK 5 +++#define REVENIT 6 +++#define RSTRING 7 +++#define REVLAB 8 +++#define REVCNST 9 +++#define REVTBEG 10 +++#define REVTYPE 11 +++#define REVTEND 12 +++#define REVVBEG 13 +++#define REVVAR 14 +++#define REVVEND 15 +++#define REVFHDR 16 +++#define REVFFWD 17 +++#define REVFBDY 18 +++#define REVFEND 19 +++#define ROPUSH 20 +++#define ROPOP 21 +++#define ROSET 22 +++#define RKILL 23 +++#define RFINISH 24 +++ +++#define RLAST 24 +++ +++extern char *trdesc[]; diff --cc usr/src/cmd/pi/stab.c index 0000000000,0000000000,0000000000..3f99d53a92 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/stab.c @@@@ -1,0 -1,0 -1,0 +1,313 @@@@ +++/* Copyright (c) 1980 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stab.c 1.3 9/4/80"; +++ +++ /* +++ * procedures to put out sdb symbol table information. +++ * and stabs for separate compilation type checking. +++ * these use the new .stabs, .stabn, and .stabd directives +++ */ +++ +++#include "whoami.h" +++#ifdef PC +++ /* and the rest of the file */ +++# include "0.h" +++# include +++ +++ /* +++ * additional symbol definition for +++ * that is used by the separate compilation facility -- +++ * eventually, should be updated to include this +++ */ +++ +++# include "pstab.h" +++# include "pc.h" +++ +++ /* +++ * absolute value: line numbers are negative if error recovery. +++ */ +++#define ABS( x ) ( x < 0 ? -x : x ) +++ +++ /* +++ * variables +++ */ +++stabvar( name , type , level , offset , length , line ) +++ char *name; +++ int type; +++ int level; +++ int offset; +++ int length; +++ int line; +++ { +++ +++ /* +++ * for separate compilation +++ */ +++ if ( level == 1 ) { +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , N_PGVAR , ABS( line ) ); +++ } +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ if ( level == 1 ) { +++ putprintf( "\",0x%x,0,0x%x,0" , 0 , N_GSYM , type ); +++ } else { +++ putprintf( "\",0x%x,0,0x%x,0x%x" , 0 , N_LSYM , type , offset ); +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0,0x%x" , 0 , N_LENG , length ); +++ +++} +++ +++ +++ /* +++ * parameters +++ */ +++stabparam( name , type , offset , length ) +++ char *name; +++ int type; +++ int offset; +++ int length; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0x%x,0x%x" , 0 , N_PSYM , type , offset ); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0,0x%x" , 0 , N_LENG , length ); +++ } +++ +++ /* +++ * fields +++ */ +++stabfield( name , type , offset , length ) +++ char *name; +++ int type; +++ int offset; +++ int length; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0x%x,0x%x" , 0 , N_SSYM , type , offset ); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0,0x%x" , 0 , N_LENG , length ); +++ } +++ +++ /* +++ * left brackets +++ */ +++stablbrac( level ) +++ int level; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabd 0x%x,0,0x%x" , 0 , N_LBRAC , level ); +++ } +++ +++ /* +++ * right brackets +++ */ +++stabrbrac( level ) +++ int level; +++ { +++ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabd 0x%x,0,0x%x" , 0 , N_RBRAC , level ); +++ } +++ +++ /* +++ * functions +++ */ +++stabfunc( name , class , line , level ) +++ char *name; +++ int class; +++ int line; +++ long level; +++ { +++ int type; +++ long i; +++ +++ /* +++ * for separate compilation +++ */ +++ if ( level == 1 ) { +++ if ( class == FUNC ) { +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , N_PGFUNC , ABS( line ) ); +++ } else if ( class == PROC ) { +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , N_PGPROC , ABS( line ) ); +++ } +++ } +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , name ); +++ putprintf( "\",0x%x,0,0x%x," , 1 , N_FUN , line ); +++ for ( i = 1 ; i < level ; i++ ) { +++ putprintf( EXTFORMAT , 1 , enclosing[ i ] ); +++ } +++ putprintf( EXTFORMAT , 0 , name ); +++ } +++ +++ /* +++ * source line numbers +++ */ +++stabline( line ) +++ int line; +++ { +++ if ( ! opt('g') ) { +++ return; +++ } +++ putprintf( " .stabd 0x%x,0,0x%x" , 0 , N_SLINE , ABS( line ) ); +++ } +++ +++ /* +++ * source files +++ */ +++stabsource( filename ) +++ char *filename; +++ { +++ int label; +++ +++ /* +++ * for separate compilation +++ */ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0" , 0 +++ , filename , N_PC , N_PSO ); +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ label = getlab(); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , filename ); +++ putprintf( "\",0x%x,0,0," , 1 , N_SO ); +++ putprintf( PREFIXFORMAT , 0 , LLABELPREFIX , label ); +++ putprintf( PREFIXFORMAT , 1 , LLABELPREFIX , label ); +++ putprintf( ":" , 0 ); +++ } +++ +++ /* +++ * included files get one or more of these: +++ * one as they are entered by a #include, +++ * and one every time they are returned to by nested #includes +++ */ +++stabinclude( filename ) +++ char *filename; +++ { +++ int label; +++ +++ /* +++ * for separate compilation +++ */ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0" , 0 +++ , filename , N_PC , N_PSOL ); +++ /* +++ * for sdb +++ */ +++ if ( ! opt('g') ) { +++ return; +++ } +++ label = getlab(); +++ putprintf( " .stabs \"" , 1 ); +++ putprintf( NAMEFORMAT , 1 , filename ); +++ putprintf( "\",0x%x,0,0," , 1 , N_SOL ); +++ putprintf( PREFIXFORMAT , 0 , LLABELPREFIX , label ); +++ putprintf( PREFIXFORMAT , 1 , LLABELPREFIX , label ); +++ putprintf( ":" , 0 ); +++ } +++ +++ +++/* +++ * global Pascal symbols : +++ * labels, types, constants, and external procedure and function names: +++ * These are used by the separate compilation facility +++ * to be able to check for disjoint header files. +++ */ +++ +++ /* +++ * global labels +++ */ +++stabglabel( label , line ) +++ char *label; +++ int line; +++ { +++ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , label , N_PC , N_PGLABEL , ABS( line ) ); +++ } +++ +++ /* +++ * global constants +++ */ +++stabgconst( const , line ) +++ char *const; +++ int line; +++ { +++ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , const , N_PC , N_PGCONST , ABS( line ) ); +++ } +++ +++ /* +++ * global types +++ */ +++stabgtype( type , line ) +++ char *type; +++ int line; +++ { +++ +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , type , N_PC , N_PGTYPE , ABS( line ) ); +++ } +++ +++ +++ /* +++ * external functions and procedures +++ */ +++stabefunc( name , class , line ) +++ char *name; +++ int class; +++ int line; +++ { +++ int type; +++ +++ if ( class == FUNC ) { +++ type = N_PEFUNC; +++ } else if ( class == PROC ) { +++ type = N_PEPROC; +++ } else { +++ return; +++ } +++ putprintf( " .stabs \"%s\",0x%x,0,0x%x,0x%x" , 0 +++ , name , N_PC , type , ABS( line ) ); +++ } +++ +++#endif PC diff --cc usr/src/cmd/pi/stat.c index 0000000000,9e318041c1,0000000000..c4b44b2bf7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/stat.c +++ b/usr/src/cmd/pi/stat.c @@@@ -1,0 -1,571 -1,0 +1,752 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)stat.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pcops.h" +++# include "pc.h" +++#endif PC + + + +int cntstat; - short cnts = 2; +++short cnts = 3; + +#include "opcode.h" + + + +/* + + * Statement list + + */ + +statlist(r) + + int *r; + +{ + + register *sl; + + + + for (sl=r; sl != NIL; sl=sl[2]) + + statement(sl[1]); + +} + + + +/* + + * Statement + + */ + +statement(r) + + int *r; + +{ + + register *s; + + register struct nl *snlp; +++ long soffset; + + + + s = r; + + snlp = nlp; +++ soffset = sizes[ cbn ].om_off; + +top: + + if (cntstat) { + + cntstat = 0; + + putcnt(); + + } + + if (s == NIL) + + return; + + line = s[1]; + + if (s[0] == T_LABEL) { + + labeled(s[2]); + + s = s[3]; + + noreach = 0; + + cntstat = 1; + + goto top; + + } + + if (noreach) { + + noreach = 0; + + warning(); + + error("Unreachable statement"); + + } + + switch (s[0]) { + + case T_PCALL: + + putline(); - proc(s); +++# ifdef OBJ +++ proc(s); +++# endif OBJ +++# ifdef PC +++ pcproc( s ); +++# endif PC + + break; + + case T_ASGN: + + putline(); + + asgnop(s); + + break; + + case T_GOTO: + + putline(); + + gotoop(s[2]); + + noreach = 1; + + cntstat = 1; + + break; + + default: + + level++; + + switch (s[0]) { + + default: + + panic("stat"); + + case T_IF: + + case T_IFEL: + + ifop(s); + + break; + + case T_WHILE: + + whilop(s); + + noreach = 0; + + break; + + case T_REPEAT: + + repop(s); + + break; + + case T_FORU: + + case T_FORD: - forop(s); +++# ifdef OBJ +++ forop(s); +++# endif OBJ +++# ifdef PC +++ pcforop( s ); +++# endif PC + + noreach = 0; + + break; + + case T_BLOCK: + + statlist(s[2]); + + break; + + case T_CASE: + + putline(); - caseop(s); +++# ifdef OBJ +++ caseop(s); +++# endif OBJ +++# ifdef PC +++ pccaseop( s ); +++# endif PC + + break; + + case T_WITH: + + withop(s); + + break; + + case T_ASRT: + + putline(); + + asrtop(s); + + break; + + } + + --level; + + if (gotos[cbn]) + + ungoto(); + + break; + + } + + /* + + * Free the temporary name list entries defined in + + * expressions, e.g. STRs, and WITHPTRs from withs. + + */ + + nlfree(snlp); +++ /* +++ * free any temporaries allocated for this statement +++ * these come from strings and sets. +++ */ +++ if ( soffset != sizes[ cbn ].om_off ) { +++ sizes[ cbn ].om_off = soffset; +++# ifdef PC +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++# endif PC +++ } + +} + + + +ungoto() + +{ + + register struct nl *p; + + + + for (p = gotos[cbn]; p != NIL; p = p->chain) + + if ((p->nl_flags & NFORWD) != 0) { + + if (p->value[NL_GOLEV] != NOTYET) + + if (p->value[NL_GOLEV] > level) + + p->value[NL_GOLEV] = level; + + } else + + if (p->value[NL_GOLEV] != DEAD) + + if (p->value[NL_GOLEV] > level) + + p->value[NL_GOLEV] = DEAD; + +} + + + +putcnt() + +{ + + - if (monflg == 0) +++ if (monflg == 0) { + + return; - cnts++; - put2(O_COUNT, cnts); +++ } +++ inccnt( getcnt() ); + +} + + +++int +++getcnt() +++ { +++ +++ return ++cnts; +++ } +++ +++inccnt( counter ) +++ int counter; +++ { +++ +++# ifdef OBJ +++ put2(O_COUNT, counter ); +++# endif OBJ +++# ifdef PC +++ putRV( PCPCOUNT , 0 , counter * sizeof (long) , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2ASG P2PLUS , P2INT ); +++ putdot( filename , line ); +++# endif PC +++ } +++ + +putline() + +{ + + + +# ifdef OBJ + + if (opt('p') != 0) + + put2(O_LINO, line); - # endif +++# endif OBJ +++# ifdef PC +++ static lastline; +++ +++ if ( line != lastline ) { +++ stabline( line ); +++ lastline = line; +++ } +++ if ( opt( 'p' ) ) { +++ if ( opt('t') ) { +++ putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) +++ , "_LINO" ); +++ putop( P2UNARY P2CALL , P2INT ); +++ putdot( filename , line ); +++ } else { +++ putRV( STMTCOUNT , 0 , 0 , P2INT ); +++ putleaf( P2ICON , 1 , 0 , P2INT , 0 ); +++ putop( P2ASG P2PLUS , P2INT ); +++ putdot( filename , line ); +++ } +++ } +++# endif PC + +} + + + +/* + + * With varlist do stat + + * + + * With statement requires an extra word + + * in automatic storage for each level of withing. + + * These indirect pointers are initialized here, and + + * the scoping effect of the with statement occurs + + * because lookup examines the field names of the records + + * associated with the WITHPTRs on the withlist. + + */ + +withop(s) + + int *s; + +{ + + register *p; + + register struct nl *r; + + int i; + + int *swl; + + long soffset; + + + + putline(); + + swl = withlist; + + soffset = sizes[cbn].om_off; + + for (p = s[2]; p != NIL; p = p[2]) { - sizes[cbn].om_off -= sizeof ( int * ); - # ifdef PPC - putlbracket(); - # endif - put2(O_LV | cbn <<9, i = sizes[cbn].om_off); - r = lvalue(p[1], MOD); +++ i = sizes[cbn].om_off -= sizeof ( int * ); +++ if (sizes[cbn].om_off < sizes[cbn].om_max) +++ sizes[cbn].om_max = sizes[cbn].om_off; +++# ifdef OBJ +++ put2(O_LV | cbn <<8+INDX, i ); +++# endif OBJ +++# ifdef PC +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++ putRV( 0 , cbn , i , P2PTR|P2STRTY ); +++# endif PC +++ r = lvalue(p[1], MOD , LREQ ); + + if (r == NIL) + + continue; + + if (r->class != RECORD) { + + error("Variable in with statement refers to %s, not to a record", nameof(r)); + + continue; + + } + + r = defnl(0, WITHPTR, r, i); + + r->nl_next = withlist; + + withlist = r; - # ifdef VAX - put1 ( O_AS4 ); - # endif - # ifdef PDP11 - put1(O_AS2); - # endif +++# ifdef OBJ +++ put(1, PTR_AS); +++# endif OBJ +++# ifdef PC +++ putop( P2ASSIGN , P2PTR|P2STRTY ); +++ putdot( filename , line ); +++# endif PC + + } - if (sizes[cbn].om_off < sizes[cbn].om_max) - sizes[cbn].om_max = sizes[cbn].om_off; + + statement(s[3]); + + sizes[cbn].om_off = soffset; - # ifdef PPC - putlbracket(); - # endif +++# ifdef PC +++ putlbracket( ftnno , -sizes[cbn].om_off ); +++# endif PC + + withlist = swl; + +} + + + +extern flagwas; + +/* + + * var := expr + + */ + +asgnop(r) + + int *r; + +{ + + register struct nl *p; + + register *av; + + + + if (r == NIL) + + return (NIL); + + /* + + * Asgnop's only function is + + * to handle function variable + + * assignments. All other assignment + + * stuff is handled by asgnop1. +++ * the if below checks for unqualified lefthandside: +++ * necessary for fvars. + + */ + + av = r[2]; + + if (av != NIL && av[0] == T_VAR && av[3] == NIL) { + + p = lookup1(av[2]); + + if (p != NIL) + + p->nl_flags = flagwas; + + if (p != NIL && p->class == FVAR) { + + /* + + * Give asgnop1 the func + + * which is the chain of + + * the FVAR. + + */ + + p->nl_flags |= NUSED|NMOD; + + p = p->chain; + + if (p == NIL) { - rvalue(r[3], NIL); +++ rvalue(r[3], NIL , RREQ ); + + return; + + } - put2(O_LV | bn << 9, p->value[NL_OFFS]); - if (isa(p->type, "i") && width(p->type) == 1) - asgnop1(r, nl+T2INT); - else - asgnop1(r, p->type); +++# ifdef OBJ +++ put2(O_LV | bn << 8+INDX, p->value[NL_OFFS]); +++ if (isa(p->type, "i") && width(p->type) == 1) +++ asgnop1(r, nl+T2INT); +++ else +++ asgnop1(r, p->type); +++# endif OBJ +++# ifdef PC +++ /* +++ * this should be the lvalue of the fvar, +++ * but since the second pass knows to use +++ * the address of the left operand of an +++ * assignment, what i want here is an rvalue. +++ * see note in funchdr about fvar allocation. +++ */ +++ p = p -> ptr[ NL_FVAR ]; +++ putRV( p -> symbol , bn , p -> value[ NL_OFFS ] +++ , p2type( p -> type ) ); +++ asgnop1( r , p -> type ); +++# endif PC + + return; + + } + + } + + asgnop1(r, NIL); + +} + + + +/* + + * Asgnop1 handles all assignments. + + * If p is not nil then we are assigning + + * to a function variable, otherwise + + * we look the variable up ourselves. + + */ + +struct nl * + +asgnop1(r, p) + + int *r; + + register struct nl *p; + +{ + + register struct nl *p1; + + + + if (r == NIL) + + return (NIL); + + if (p == NIL) { - p = lvalue(r[2], MOD|ASGN|NOUSE); - if (p == NIL) { - rvalue(r[3], NIL); - return (NIL); - } +++# ifdef OBJ +++ p = lvalue(r[2], MOD|ASGN|NOUSE , LREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * since the second pass knows that it should reference +++ * the lefthandside of asignments, what i need here is +++ * an rvalue. +++ */ +++ p = lvalue( r[2] , MOD|ASGN|NOUSE , RREQ ); +++# endif PC +++ if ( p == NIL ) { +++ rvalue( r[3] , NIL , RREQ ); +++ return NIL; +++ } + + } - p1 = rvalue(r[3], p); +++# ifdef OBJ +++ p1 = rvalue(r[3], p , RREQ ); +++# endif OBJ +++# ifdef PC +++ /* +++ * if this is a scalar assignment, +++ * then i want to rvalue the righthandside. +++ * if this is a structure assignment, +++ * then i want an lvalue to the righthandside. +++ * that's what the intermediate form sez. +++ */ +++ switch ( classify( p ) ) { +++ case TINT: +++ case TCHAR: +++ case TBOOL: +++ case TSCAL: +++ precheck( p , "_RANG4" , "_RSNG4" ); +++ case TDOUBLE: +++ case TPTR: +++ p1 = rvalue( r[3] , p , RREQ ); +++ break; +++ default: +++ p1 = rvalue( r[3] , p , LREQ ); +++ break; +++ } +++# endif PC + + if (p1 == NIL) + + return (NIL); + + if (incompat(p1, p, r[3])) { + + cerror("Type of expression clashed with type of variable in assignment"); + + return (NIL); + + } + + switch (classify(p)) { +++ case TINT: + + case TBOOL: + + case TCHAR: - case TINT: + + case TSCAL: - rangechk(p, p1); +++# ifdef OBJ +++ rangechk(p, p1); +++# endif OBJ +++# ifdef PC +++ postcheck( p ); +++# endif PC + + case TDOUBLE: + + case TPTR: - gen(O_AS2, O_AS2, width(p), width(p1)); +++# ifdef OBJ +++ gen(O_AS2, O_AS2, width(p), width(p1)); +++# endif OBJ +++# ifdef PC +++ putop( P2ASSIGN , p2type( p ) ); +++ putdot( filename , line ); +++# endif PC + + break; + + default: - put2(O_AS, width(p)); +++# ifdef OBJ +++ put2(O_AS, width(p)); +++# endif OBJ +++# ifdef PC +++ putstrop( P2STASG , p2type( p ) +++ , lwidth( p ) , align( p ) ); +++ putdot( filename , line ); +++# endif PC + + } - # ifdef PPC - putexpr(); - # endif + + return (p); /* Used by for statement */ + +} + + +++#ifdef OBJ + +/* + + * for var := expr [down]to expr do stat + + */ + +forop(r) + + int *r; + +{ + + register struct nl *t1, *t2; + + int l1, l2, l3; + + long soffset; + + register op; + + struct nl *p; + + int *rr, goc, i; + + + + p = NIL; + + goc = gocnt; + + if (r == NIL) + + goto aloha; + + putline(); + + /* + + * Start with assignment + + * of initial value to for variable + + */ + + t1 = asgnop1(r[2], NIL); + + if (t1 == NIL) { - rvalue(r[3], NIL); +++ rvalue(r[3], NIL , RREQ ); + + statement(r[4]); + + goto aloha; + + } + + rr = r[2]; /* Assignment */ + + rr = rr[2]; /* Lhs variable */ + + if (rr[3] != NIL) { + + error("For variable must be unqualified"); - rvalue(r[3], NIL); +++ rvalue(r[3], NIL , RREQ ); + + statement(r[4]); + + goto aloha; + + } + + p = lookup(rr[2]); + + p->value[NL_FORV] = 1; + + if (isnta(t1, "bcis")) { + + error("For variables cannot be %ss", nameof(t1)); + + statement(r[4]); + + goto aloha; + + } + + /* + + * Allocate automatic + + * space for limit variable + + */ + + sizes[cbn].om_off -= 4; - # ifdef PPC - putlbracket(); - # endif + + if (sizes[cbn].om_off < sizes[cbn].om_max) + + sizes[cbn].om_max = sizes[cbn].om_off; + + i = sizes[cbn].om_off; + + /* + + * Initialize the limit variable + + */ - put2(O_LV | cbn<<9, i); - t2 = rvalue(r[3], NIL); +++ put2(O_LV | cbn<<8+INDX, i); +++ t2 = rvalue(r[3], NIL , RREQ ); + + if (incompat(t2, t1, r[3])) { + + cerror("Limit type clashed with index type in 'for' statement"); + + statement(r[4]); + + goto aloha; + + } + + put1(width(t2) <= 2 ? O_AS24 : O_AS4); - # ifdef PPC - putexpr(); - # endif + + /* + + * See if we can skip the loop altogether + + */ + + rr = r[2]; + + if (rr != NIL) - rvalue(rr[2], NIL); - put2(O_RV4 | cbn<<9, i); +++ rvalue(rr[2], NIL , RREQ ); +++ put2(O_RV4 | cbn<<8+INDX, i); + + gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4); + + /* + + * L1 will be patched to skip the body of the loop. + + * L2 marks the top of the loop when we go around. + + */ + + put2(O_IF, (l1 = getlab())); + + putlab(l2 = getlab()); + + putcnt(); + + statement(r[4]); + + /* + + * now we see if we get to go again + + */ + + if (opt('t') == 0) { + + /* + + * Easy if we dont have to test + + */ - put2(O_RV4 | cbn<<9, i); +++ put2(O_RV4 | cbn<<8+INDX, i); + + if (rr != NIL) - lvalue(rr[2], MOD); +++ lvalue(rr[2], MOD , RREQ ); + + put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2); + + } else { + + line = r[1]; + + putline(); + + if (rr != NIL) - rvalue(rr[2], NIL); - put2(O_RV4 | cbn << 9, i); +++ rvalue(rr[2], NIL , RREQ ); +++ put2(O_RV4 | cbn << 8+INDX, i); + + gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4); + + l3 = put2(O_IF, getlab()); - lvalue((int *) rr[2], MOD); - rvalue(rr[2], NIL); +++ lvalue((int *) rr[2], MOD , RREQ ); +++ rvalue(rr[2], NIL , RREQ ); + + put2(O_CON2, 1); + + t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2); + + rangechk(t1, t2); /* The point of all this */ + + gen(O_AS2, O_AS2, width(t1), width(t2)); + + put2(O_TRA, l2); + + patch(l3); + + } + + sizes[cbn].om_off += 4; - # ifdef PPC - putlbracket(); - # endif + + patch(l1); + +aloha: + + noreach = 0; + + if (p != NIL) + + p->value[NL_FORV] = 0; + + if (goc != gocnt) + + putcnt(); + +} +++#endif OBJ + + + +/* + + * if expr then stat [ else stat ] + + */ + +ifop(r) + + int *r; + +{ + + register struct nl *p; - register l1, l2; +++ register l1, l2; /* l1 is start of else, l2 is end of else */ + + int nr, goc; + + + + goc = gocnt; + + if (r == NIL) + + return; + + putline(); - p = rvalue(r[2], NIL); +++ p = rvalue(r[2], NIL , RREQ ); + + if (p == NIL) { + + statement(r[3]); + + noreach = 0; + + statement(r[4]); + + noreach = 0; + + return; + + } + + if (isnta(p, "b")) { + + error("Type of expression in if statement must be Boolean, not %s", nameof(p)); + + statement(r[3]); + + noreach = 0; + + statement(r[4]); + + noreach = 0; + + return; + + } - l1 = put2(O_IF, getlab()); +++# ifdef OBJ +++ l1 = put2(O_IF, getlab()); +++# endif OBJ +++# ifdef PC +++ l1 = getlab(); +++ putleaf( P2ICON , l1 , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++# endif PC + + putcnt(); + + statement(r[3]); + + nr = noreach; + + if (r[4] != NIL) { + + /* + + * else stat + + */ + + --level; + + ungoto(); + + ++level; - l2 = put2(O_TRA, getlab()); +++# ifdef OBJ +++ l2 = put2(O_TRA, getlab()); +++# endif OBJ +++# ifdef PC +++ l2 = getlab(); +++ putjbr( l2 ); +++# endif PC + + patch(l1); + + noreach = 0; + + statement(r[4]); + + noreach &= nr; + + l1 = l2; + + } else + + noreach = 0; + + patch(l1); + + if (goc != gocnt) + + putcnt(); + +} + + + +/* + + * while expr do stat + + */ + +whilop(r) + + int *r; + +{ + + register struct nl *p; + + register l1, l2; + + int goc; + + + + goc = gocnt; + + if (r == NIL) + + return; + + putlab(l1 = getlab()); + + putline(); - p = rvalue(r[2], NIL); +++ p = rvalue(r[2], NIL , RREQ ); + + if (p == NIL) { + + statement(r[3]); + + noreach = 0; + + return; + + } + + if (isnta(p, "b")) { + + error("Type of expression in while statement must be Boolean, not %s", nameof(p)); + + statement(r[3]); + + noreach = 0; + + return; + + } - put2(O_IF, (l2 = getlab())); +++ l2 = getlab(); +++# ifdef OBJ +++ put2(O_IF, l2); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l2 , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++# endif PC + + putcnt(); + + statement(r[3]); - put2(O_TRA, l1); +++# ifdef OBJ +++ put2(O_TRA, l1); +++# endif OBJ +++# ifdef PC +++ putjbr( l1 ); +++# endif PC + + patch(l2); + + if (goc != gocnt) + + putcnt(); + +} + + + +/* + + * repeat stat* until expr + + */ + +repop(r) + + int *r; + +{ + + register struct nl *p; + + register l; + + int goc; + + + + goc = gocnt; + + if (r == NIL) + + return; + + l = putlab(getlab()); + + putcnt(); + + statlist(r[2]); + + line = r[1]; - p = rvalue(r[3], NIL); +++ p = rvalue(r[3], NIL , RREQ ); + + if (p == NIL) + + return; + + if (isnta(p,"b")) { + + error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p)); + + return; + + } - put2(O_IF, l); +++# ifdef OBJ +++ put2(O_IF, l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++ putop( P2CBRANCH , P2INT ); +++ putdot( filename , line ); +++# endif PC + + if (goc != gocnt) + + putcnt(); + +} + + + +/* + + * assert expr + + */ + +asrtop(r) + + register int *r; + +{ + + register struct nl *q; + + + + if (opt('s')) { + + standard(); + + error("Assert statement is non-standard"); + + } + + if (!opt('t')) + + return; + + r = r[2]; - q = rvalue((int *) r, NLNIL); +++# ifdef OBJ +++ q = rvalue((int *) r, NLNIL , RREQ ); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 +++ , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_ASRT" ); +++ q = stkrval( r , NLNIL , RREQ ); +++# endif PC + + if (q == NIL) + + return; + + if (isnta(q, "b")) + + error("Assert expression must be Boolean, not %ss", nameof(q)); - put1(O_ASRT); +++# ifdef OBJ +++ put1(O_ASRT); +++# endif OBJ +++# ifdef PC +++ putop( P2CALL , P2INT ); +++ putdot( filename , line ); +++# endif PC + +} diff --cc usr/src/cmd/pi/stklval.c index 0000000000,0000000000,0000000000..c62b436acc new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/stklval.c @@@@ -1,0 -1,0 -1,0 +1,26 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stklval.c 1.1 8/27/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++ +++/* +++ * Lvalue computes the address +++ * of a qualified name and +++ * leaves it on the stack. +++ */ +++struct nl * +++stklval(r, modflag) +++ int *r, modflag; +++{ +++ /* +++ * For the purposes of the interpreter stklval +++ * is the same as an lvalue. +++ */ +++ +++ return(lvalue(r, modflag , LREQ )); +++} diff --cc usr/src/cmd/pi/stkrval.c index 0000000000,0000000000,0000000000..aa46cbbb2d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/stkrval.c @@@@ -1,0 -1,0 -1,0 +1,382 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stkrval.c 1.3 10/2/80"; +++ +++#include "whoami.h" +++#include "0.h" +++#include "tree.h" +++#include "opcode.h" +++#include "objfmt.h" +++#ifdef PC +++# include "pcops.h" +++#endif PC +++ +++/* +++ * stkrval Rvalue - an expression, and coerce it to be a stack quantity. +++ * +++ * Contype is the type that the caller would prefer, nand is important +++ * if constant sets or constant strings are involved, the latter +++ * because of string padding. +++ */ +++/* +++ * for the obj version, this is a copy of rvalue hacked to use fancy new +++ * push-onto-stack-and-convert opcodes. +++ * for the pc version, i just call rvalue and convert if i have to, +++ * based on the return type of rvalue. +++ */ +++struct nl * +++stkrval(r, contype , required ) +++ register int *r; +++ struct nl *contype; +++ long required; +++{ +++ register struct nl *p; +++ register struct nl *q; +++ register char *cp, *cp1; +++ register int c, w; +++ int **pt; +++ long l; +++ double f; +++ +++ if (r == NIL) +++ return (NIL); +++ if (nowexp(r)) +++ return (NIL); +++ /* +++ * The root of the tree tells us what sort of expression we have. +++ */ +++ switch (r[0]) { +++ +++ /* +++ * The constant nil +++ */ +++ case T_NIL: +++# ifdef OBJ +++ put(2, O_CON14, 0); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , 0 , 0 , P2INT , 0 ); +++# endif PC +++ return (nl+TNIL); +++ +++ case T_FCALL: +++ case T_VAR: +++ p = lookup(r[2]); +++ if (p == NIL || p->class == BADUSE) +++ return (NIL); +++ switch (p->class) { +++ case VAR: +++ /* +++ if a variable is +++ * qualified then get +++ * the rvalue by a +++ * stklval and an ind. +++ */ +++ if (r[3] != NIL) +++ goto ind; +++ q = p->type; +++ if (q == NIL) +++ return (NIL); +++ if (classify(q) == TSTR) +++ return(stklval(r, NOFLAGS)); +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(2, O_RV8 | bn << 8+INDX, p->value[0]); +++ return(q); +++ case 4: +++ put(2, O_RV4 | bn << 8+INDX, p->value[0]); +++ return(q); +++ case 2: +++ put(2, O_RV24 | bn << 8+INDX, p->value[0]); +++ return(q); +++ case 1: +++ put(2, O_RV14 | bn << 8+INDX, p->value[0]); +++ return(q); +++ default: +++ put(3, O_RV | bn << 8+INDX, p->value[0], w); +++ return(q); +++ } +++# endif OBJ +++# ifdef PC +++ return rvalue( r , contype , required ); +++# endif PC +++ +++ case WITHPTR: +++ case REF: +++ /* +++ * A stklval for these +++ * is actually what one +++ * might consider a rvalue. +++ */ +++ind: +++ q = stklval(r, NOFLAGS); +++ if (q == NIL) +++ return (NIL); +++ if (classify(q) == TSTR) +++ return(q); +++# ifdef OBJ +++ w = width(q); +++ switch (w) { +++ case 8: +++ put(1, O_IND8); +++ return(q); +++ case 4: +++ put(1, O_IND4); +++ return(q); +++ case 2: +++ put(1, O_IND24); +++ return(q); +++ case 1: +++ put(1, O_IND14); +++ return(q); +++ default: +++ put(2, O_IND, w); +++ return(q); +++ } +++# endif OBJ +++# ifdef PC +++ if ( required == RREQ ) { +++ putop( P2UNARY P2MUL , p2type( q ) ); +++ } +++ return q; +++# endif PC +++ +++ case CONST: +++ if (r[3] != NIL) { +++ error("%s is a constant and cannot be qualified", r[2]); +++ return (NIL); +++ } +++ q = p->type; +++ if (q == NIL) +++ return (NIL); +++ if (q == nl+TSTR) { +++ /* +++ * Find the size of the string +++ * constant if needed. +++ */ +++ cp = p->ptr[0]; +++cstrng: +++ cp1 = cp; +++ for (c = 0; *cp++; c++) +++ continue; +++ w = 0; +++ if (contype != NIL && !opt('s')) { +++ if (width(contype) < c && classify(contype) == TSTR) { +++ error("Constant string too long"); +++ return (NIL); +++ } +++ w = width(contype) - c; +++ } +++# ifdef OBJ +++ put(2, O_LVCON, lenstr(cp1, w)); +++ putstr(cp1, w); +++# endif OBJ +++# ifdef PC +++ putCONG( cp1 , c + w , LREQ ); +++# endif PC +++ /* +++ * Define the string temporarily +++ * so later people can know its +++ * width. +++ * cleaned out by stat. +++ */ +++ q = defnl(0, STR, 0, c); +++ q->type = q; +++ return (q); +++ } +++ if (q == nl+T1CHAR) { +++# ifdef OBJ +++ put(2, O_CONC4, p->value[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , p -> value[0] , 0 , P2CHAR , 0 ); +++# endif PC +++ return(q); +++ } +++ /* +++ * Every other kind of constant here +++ */ +++# ifdef OBJ +++ switch (width(q)) { +++ case 8: +++#ifndef DEBUG +++ put(2, O_CON8, p->real); +++ return(q); +++#else +++ if (hp21mx) { +++ f = p->real; +++ conv(&f); +++ l = f.plong; +++ put(2, O_CON4, l); +++ } else +++ put(2, O_CON8, p->real); +++ return(q); +++#endif +++ case 4: +++ put(2, O_CON4, p->range[0]); +++ return(q); +++ case 2: +++ put(2, O_CON24, (short)p->range[0]); +++ return(q); +++ case 1: +++ put(2, O_CON14, (short)p->range[0]); +++ return(q); +++ default: +++ panic("stkrval"); +++ } +++# endif OBJ +++# ifdef PC +++ return rvalue( r , contype , required ); +++# endif PC +++ +++ case FUNC: +++ case FFUNC: +++ /* +++ * Function call +++ */ +++ pt = (int **)r[3]; +++ if (pt != NIL) { +++ switch (pt[1][0]) { +++ case T_PTR: +++ case T_ARGL: +++ case T_ARY: +++ case T_FIELD: +++ error("Can't qualify a function result value"); +++ return (NIL); +++ } +++ } +++# ifdef OBJ +++ q = p->type; +++ if (classify(q) == TSTR) { +++ c = width(q); +++ put(2, O_LVCON, even(c+1)); +++ putstr("", c); +++ put(1, O_SDUP4); +++ p = funccod(r); +++ put(2, O_AS, c); +++ return(p); +++ } +++ p = funccod(r); +++ if (width(p) <= 2) +++ put(1, O_STOI); +++# endif OBJ +++# ifdef PC +++ p = pcfunccod( r ); +++# endif PC +++ return (p); +++ +++ case TYPE: +++ error("Type names (e.g. %s) allowed only in declarations", p->symbol); +++ return (NIL); +++ +++ case PROC: +++ case FPROC: +++ error("Procedure %s found where expression required", p->symbol); +++ return (NIL); +++ default: +++ panic("stkrvid"); +++ } +++ case T_PLUS: +++ case T_MINUS: +++ case T_NOT: +++ case T_AND: +++ case T_OR: +++ case T_DIVD: +++ case T_MULT: +++ case T_SUB: +++ case T_ADD: +++ case T_MOD: +++ case T_DIV: +++ case T_EQ: +++ case T_NE: +++ case T_GE: +++ case T_LE: +++ case T_GT: +++ case T_LT: +++ case T_IN: +++ p = rvalue(r, contype , required ); +++# ifdef OBJ +++ if (width(p) <= 2) +++ put(1, O_STOI); +++# endif OBJ +++ return (p); +++ case T_CSET: +++ p = rvalue(r, contype , required ); +++ return (p); +++ default: +++ if (r[2] == NIL) +++ return (NIL); +++ switch (r[0]) { +++ default: +++ panic("stkrval3"); +++ +++ /* +++ * An octal number +++ */ +++ case T_BINT: +++ f = a8tol(r[2]); +++ goto conint; +++ +++ /* +++ * A decimal number +++ */ +++ case T_INT: +++ f = atof(r[2]); +++conint: +++ if (f > MAXINT || f < MININT) { +++ error("Constant too large for this implementation"); +++ return (NIL); +++ } +++ l = f; +++ if (bytes(l, l) <= 2) { +++# ifdef OBJ +++ put(2, O_CON24, (short)l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , (short) l , 0 , P2INT , 0 ); +++# endif PC +++ return(nl+T4INT); +++ } +++# ifdef OBJ +++ put(2, O_CON4, l); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , l , 0 , P2INT , 0 ); +++# endif PC +++ return (nl+T4INT); +++ +++ /* +++ * A floating point number +++ */ +++ case T_FINT: +++# ifdef OBJ +++ put(2, O_CON8, atof(r[2])); +++# endif OBJ +++# ifdef PC +++ putCON8( atof( r[2] ) ); +++# endif PC +++ return (nl+TDOUBLE); +++ +++ /* +++ * Constant strings. Note that constant characters +++ * are constant strings of length one; there is +++ * no constant string of length one. +++ */ +++ case T_STRNG: +++ cp = r[2]; +++ if (cp[1] == 0) { +++# ifdef OBJ +++ put(2, O_CONC4, cp[0]); +++# endif OBJ +++# ifdef PC +++ putleaf( P2ICON , cp[0] , 0 , P2CHAR , 0 ); +++# endif PC +++ return(nl+T1CHAR); +++ } +++ goto cstrng; +++ } +++ +++ } +++} diff --cc usr/src/cmd/pi/string.c index 0000000000,31f05c704e,0000000000..2cd1b7003d mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/string.c +++ b/usr/src/cmd/pi/string.c @@@@ -1,0 -1,160 -1,0 +1,150 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)string.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#ifndef PI01 + +#ifndef PXP + +#include "send.h" + +#endif + +#endif + + + +/* + + * STRING SPACE DECLARATIONS + + * + + * Strng is the base of the current + + * string space and strngp the + + * base of the free area therein. + + * Strp is the array of descriptors. + + */ + +#ifndef PI0 + +STATIC char strings[STRINC]; + +STATIC char *strng = strings; + +STATIC char *strngp = strings; + +#else + +char *strng, *strngp; + +#endif + +#ifndef PI01 + +#ifndef PXP + +STATIC char *strp[20]; + +STATIC char **stract strp; + +int strmax; + +#endif + +#endif + + + +#ifndef PI01 + +#ifndef PXP + +#ifndef PI0 + +initstring() + +#else + +initstring(strings) + + char *strings; + +#endif + +{ + + + + *stract++ = strings; + +#ifdef PI0 + + strng = strngp = strings; + +#endif + + strmax = STRINC * 2; + +} + +#endif + +#endif + + + +/* + + * Copy a string into the string area. + + */ + +char * + +savestr(cp) + + register char *cp; + +{ + + register int i; + + + + i = strlen(cp) + 1; + + if (strngp + i >= strng + STRINC) { + + strngp = malloc(STRINC); + + if (strngp == -1) { + + yerror("Ran out of memory (string)"); + + pexit(DIED); + + } + +#ifndef PI01 + +#ifndef PXP + + *stract++ = strngp; + + strmax =+ STRINC; + +#endif + +#endif + + strng = strngp; + + } + + strcpy(strngp, cp); + + cp = strngp; + + strngp = cp + i; + +#ifdef PI0 + + send(RSTRING, cp); + +#endif + + return (cp); + +} + + + +#ifndef PI1 + +#ifndef PXP + +esavestr(cp) + + char *cp; + +{ + + + +#ifdef PI0 + + send(REVENIT); + +#endif + + strngp = ( (char *) ( ( (int) (strngp + 1) ) &~ 1 ) ); + + return (savestr(cp)); + +} + +#endif + +#endif + + + +#ifndef PI01 + +#ifndef PXP + +soffset(cp) + + register char *cp; + +{ + + register char **sp; + + register int i; + + + + if (cp == NIL || cp == OCT || cp == HEX) + + return (-cp); + + for (i = STRINC, sp = strp; sp < stract; sp++) { + + if (cp >= *sp && cp < (*sp + STRINC)) + + return (i + (cp - *sp)); + + i =+ STRINC; + + } + + i = nlfund(cp); + + if (i != 0) + + return (i); + + panic("soffset"); + +} + +#ifdef PI1 + +sreloc(i) + + register int i; + +{ + + + + if (i == 0 || i == -OCT || i == -HEX) + + return (-i); + + if (i < STRINC) { + + if (i >= INL) + + panic("sreloc INL"); + + i = nl[i].symbol; + + if (i == 0) + + panic("sreloc nl[i]"); + + return (i); + + } + + if (i > strmax || i < 0) + + panic("sreloc"); + + return (strp[(i / STRINC) - 1] + (i % STRINC)); + +} + + + +evenit() + +{ + + + + strngp = (strngp + 1) &~ 1; + +} + +#endif + +#endif + +#endif diff --cc usr/src/cmd/pi/subr.c index 0000000000,4aa269f1a4,0000000000..a02db2cc89 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/subr.c +++ b/usr/src/cmd/pi/subr.c @@@@ -1,0 -1,221 -1,0 +1,217 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - #include "whoami" - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.2 November 1978 - */ + + +++static char sccsid[] = "@(#)subr.c 1.2 11/13/80"; +++ +++#include "whoami.h" + +#include "0.h" + + + +#ifndef PI1 + +/* + + * Does the string fp end in '.' and the character c ? + + */ + +dotted(fp, c) + + register char *fp; + + char c; + +{ + + register int i; + + + + i = strlen(fp); + + return (i > 1 && fp[i - 2] == '.' && fp[i - 1] == c); + +} + + + +/* + + * Toggle the option c. + + */ + +togopt(c) + + char c; + +{ + + register char *tp; + + - tp = &opts[c-'a']; +++ tp = &opt( c ); + + *tp = 1 - *tp; + +} + + + +/* + + * Set the time vector "tvec" to the + + * modification time stamp of a file. + + */ + +gettime( filename ) + + char *filename; + +{ + +#include + + struct stat stb; + + + + stat(filename, &stb); + + tvec = stb.st_mtime; + +} + + + +/* + + * Convert a "ctime" into a Pascal styple time line + + */ + +char * + +myctime(tv) + + int *tv; + +{ + + register char *cp, *dp; + + char *cpp; + + register i; + + static char mycbuf[26]; + + + + cpp = ctime(tv); + + dp = mycbuf; + + cp = cpp; + + cpp[16] = 0; + + while (*dp++ = *cp++); + + dp--; + + cp = cpp+19; + + cpp[24] = 0; + + while (*dp++ = *cp++); + + return (mycbuf); + +} + + + +/* + + * Is "fp" in the command line list of names ? + + */ + +inpflist(fp) + + char *fp; + +{ + + register i, *pfp; + + + + pfp = pflist; + + for (i = pflstc; i > 0; i--) + + if (strcmp(fp, *pfp++) == 0) + + return (1); + + return (0); + +} + +#endif + + + +extern int errno; + +extern char *sys_errlist[]; + + + +/* + + * Boom! + + */ + +Perror(file, error) + + char *file, *error; + +{ + + +++ write(2, file, strlen(file)); +++ write(2, ": ", 2); +++ write(2, error, strlen(error)); +++ write(2, "\n", 1); +++/* + + errno = 0; + + sys_errlist[0] = error; + + perror(file); +++*/ + +} + + + +int * + +calloc(num, size) + + int num, size; + +{ + + register int p1, *p2, nbyte; + + + + nbyte = (num*size+( ( sizeof ( int ) ) - 1 ) ) & ~( ( sizeof ( int ) ) - 1 ); + + if ((p1 = malloc(nbyte)) == -1 || p1==0) + + return (-1); + + p2 = p1; + + nbyte /= sizeof ( int ); + + do { + + *p2++ = 0; + + } while (--nbyte); + + return (p1); + +} + + + +/* + + * Compare strings: s1>s2: >0 s1==s2: 0 s1>= 1; + +#ifdef PI0 + + send(ROPOP, c); + +#endif + +} diff --cc usr/src/cmd/pi/tree.c index 0000000000,16f90c3c34,0000000000..4b7dfeaec5 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/tree.c +++ b/usr/src/cmd/pi/tree.c @@@@ -1,0 -1,190 -1,0 +1,179 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)tree.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + + + +/* + + * TREE SPACE DECLARATIONS + + */ + +struct tr { + + int *tr_low; + + int *tr_high; + +} ttab[MAXTREE], *tract; + + + +/* + + * The variable space is the + + * absolute base of the tree segments. + + * (exactly the same as ttab[0].tr_low) + + * Spacep is maintained to point at the + + * beginning of the next tree slot to + + * be allocated for use by the grammar. + + * Spacep is used "extern" by the semantic + + * actions in pas.y. + + * The variable tract is maintained to point + + * at the tree segment out of which we are + + * allocating (the active segment). + + */ + +int *space, *spacep; + + + +/* + + * TREENMAX is the maximum width + + * in words that any tree node + + * due to the way in which the parser uses + + * the pointer spacep. + + */ + +#define TREENMAX 6 + + + +int trspace[ITREE]; + +int *space = trspace; + +int *spacep = trspace; + +struct tr *tract = ttab; + + + +/* + + * Inittree allocates the first tree slot + + * and sets up the first segment descriptor. + + * A lot of this work is actually done statically + + * above. + + */ + +inittree() + +{ + + + + ttab[0].tr_low = space; + + ttab[0].tr_high = &space[ITREE]; + +} + + + +/* + + * Tree builds the nodes in the + + * parse tree. It is rarely called + + * directly, rather calls are made + + * to tree[12345] which supplies the + + * first argument to save space in + + * the code. Tree also guarantees + + * that spacep points to the beginning + + * of the next slot it will return, + + * a property required by the parser + + * which was always true before we + + * segmented the tree space. + + */ + +int *tree(cnt, a) + + int cnt; + +{ + + register int *p, *q; + + register int i; + + + + i = cnt; + + p = spacep; + + q = &a; + + do + + *p++ = *q++; + + while (--i); + + q = spacep; + + spacep = p; + + if (p+TREENMAX >= tract->tr_high) + + /* + + * this peek-ahead should + + * save a great number of calls + + * to tralloc. + + */ + + tralloc(TREENMAX); + + return (q); + +} + + + +/* + + * Tralloc preallocates enough + + * space in the tree to allow + + * the grammar to use the variable + + * spacep, as it did before the + + * tree was segmented. + + */ + +tralloc(howmuch) + +{ + + register char *cp; + + register i; + + + + if (spacep + howmuch >= tract->tr_high) { + + i = TRINC; + + cp = malloc(i * sizeof ( int )); + + if (cp == -1) { + + yerror("Ran out of memory (tralloc)"); + + pexit(DIED); + + } + + spacep = cp; + + tract++; + + if (tract >= &ttab[MAXTREE]) { + + yerror("Ran out of tree tables"); + + pexit(DIED); + + } + + tract->tr_low = cp; + + tract->tr_high = tract->tr_low+i; + + } + +} + + + +extern int yylacnt; + +extern bottled; + +#ifdef PXP + +#endif + +/* + + * Free up the tree segments + + * at the end of a block. + + * If there is scanner lookahead, + + * i.e. if yylacnt != 0 or there is bottled output, then we + + * cannot free the tree space. + + * This happens only when errors + + * occur and the forward move extends + + * across "units". + + */ + +trfree() + +{ + + + + if (yylacnt != 0 || bottled != NIL) + + return; + +#ifdef PXP + + if (needtree()) + + return; + +#endif + + spacep = space; + + while (tract->tr_low > spacep || tract->tr_high <= spacep) { + + free(tract->tr_low); + + tract->tr_low = NIL; + + tract->tr_high = NIL; + + tract--; + + if (tract < ttab) + + panic("ttab"); + + } + +#ifdef PXP + + packtree(); + +#endif + +} + + + +/* + + * Copystr copies a token from + + * the "token" buffer into the + + * tree space. + + */ + +copystr(token) + + register char *token; + +{ + + register char *cp; + + register int i; + + + + i = (strlen(token) + sizeof ( int )) & ~( ( sizeof ( int ) ) - 1 ); + + tralloc(i / sizeof ( int )); + + strcpy(spacep, token); + + cp = spacep; + + spacep = cp + i; + + tralloc(TREENMAX); + + return (cp); + +} diff --cc usr/src/cmd/pi/tree.h index 0000000000,4e636acb1f,0000000000..ca8b8c1579 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/tree.h +++ b/usr/src/cmd/pi/tree.h @@@@ -1,0 -1,81 -1,0 +1,85 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)tree.h 1.1 8/27/80"; */ +++ + +#define T_MINUS 1 + +#define T_MOD 2 + +#define T_DIV 3 + +#define T_DIVD 4 + +#define T_MULT 5 + +#define T_ADD 6 + +#define T_SUB 7 + +#define T_EQ 8 + +#define T_NE 9 + +#define T_LT 10 + +#define T_GT 11 + +#define T_LE 12 + +#define T_GE 13 + +#define T_NOT 14 + +#define T_AND 15 + +#define T_OR 16 + +#define T_ASGN 17 + +#define T_PLUS 18 + +#define T_IN 19 + +#define T_LISTPP 20 + +#define T_PDEC 21 + +#define T_FDEC 22 + +#define T_PVAL 23 + +#define T_PVAR 24 + +#define T_PFUNC 25 + +#define T_PPROC 26 + +#define T_NIL 27 + +#define T_STRNG 28 + +#define T_CSTRNG 29 + +#define T_PLUSC 30 + +#define T_MINUSC 31 + +#define T_ID 32 + +#define T_INT 33 + +#define T_FINT 34 + +#define T_CINT 35 + +#define T_CFINT 36 + +#define T_TYPTR 37 + +#define T_TYPACK 38 + +#define T_TYSCAL 39 + +#define T_TYRANG 40 + +#define T_TYARY 41 + +#define T_TYFILE 42 + +#define T_TYSET 43 + +#define T_TYREC 44 + +#define T_TYFIELD 45 + +#define T_TYVARPT 46 + +#define T_TYVARNT 47 + +#define T_CSTAT 48 + +#define T_BLOCK 49 + +#define T_BSTL 50 + +#define T_LABEL 51 + +#define T_PCALL 52 + +#define T_FCALL 53 + +#define T_CASE 54 + +#define T_WITH 55 + +#define T_WHILE 56 + +#define T_REPEAT 57 + +#define T_FORU 58 + +#define T_FORD 59 + +#define T_GOTO 60 + +#define T_IF 61 + +#define T_ASRT 62 + +#define T_CSET 63 + +#define T_RANG 64 + +#define T_VAR 65 + +#define T_ARGL 66 + +#define T_ARY 67 + +#define T_FIELD 68 + +#define T_PTR 69 + +#define T_WEXP 70 + +#define T_PROG 71 + +#define T_BINT 72 + +#define T_CBINT 73 + +#define T_IFEL 74 + +#define T_IFX 75 + +#define T_TYID 76 + +#define T_COPSTR 77 + +#define T_BOTTLE 78 + +#define T_RFIELD 79 + +#define T_FLDLST 80 + +#define T_LAST 81 diff --cc usr/src/cmd/pi/treen.c index 0000000000,8649ed3752,0000000000..b6e6ae22a0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/treen.c +++ b/usr/src/cmd/pi/treen.c @@@@ -1,0 -1,35 -1,0 +1,38 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)treen.c 1.1 8/27/80"; +++ + + /* + + * is there some reason why these aren't #defined? + + */ + + + +tree1 ( arg1 ) + + int arg1; + + { + + tree ( 1 , arg1 ); + + } + + + +tree2 ( arg1 , arg2 ) + + int arg1 , arg2; + + { + + tree ( 2 , arg1 , arg2 ); + + } + + + +tree3 ( arg1 , arg2 , arg3 ) + + int arg1 , arg2 , arg3; + + { + + tree ( 3 , arg1 , arg2 , arg3 ); + + } + + + +tree4 ( arg1 , arg2 , arg3 , arg4 ) + + int arg1 , arg2 , arg3 , arg4; + + { + + tree ( 4 , arg1 , arg2 , arg3 , arg4 ); + + } + + + +tree5 ( arg1 , arg2 , arg3 , arg4 , arg5 ) + + int arg1 , arg2 , arg3 , arg4 , arg5; + + { + + tree ( 5 , arg1 , arg2 , arg3 , arg4 , arg5 ); + + } + + diff --cc usr/src/cmd/pi/type.c index 0000000000,ae7ca598f9,0000000000..fee06b5091 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/type.c +++ b/usr/src/cmd/pi/type.c @@@@ -1,0 -1,355 -1,0 +1,388 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)type.c 1.4 9/4/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" +++#include "objfmt.h" + + + +/* + + * Type declaration part + + */ + +typebeg() + +{ + + +++/* +++ * this allows for multiple +++ * declaration parts unless +++ * standard option has been +++ * specified. +++ * If routine segment is being +++ * compiled, do level one processing. +++ */ +++ + +#ifndef PI1 - if (parts & VPRT) - error("Type declarations must precede var declarations"); - if (parts & TPRT) - error("All types must be declared in one type part"); - parts |= TPRT; +++ if (!progseen) +++ level1(); +++ if ( parts[ cbn ] & ( VPRT | RPRT ) ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Type declarations should precede var and routine declarations"); +++ } +++ if (parts[ cbn ] & TPRT) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All types should be declared in one type part"); +++ } +++ parts[ cbn ] |= TPRT; + +#endif + + /* + + * Forechain is the head of a list of types that + + * might be self referential. We chain them up and + + * process them later. + + */ + + forechain = NIL; + +#ifdef PI0 + + send(REVTBEG); + +#endif + +} + + + +type(tline, tid, tdecl) + + int tline; + + char *tid; + + register int *tdecl; + +{ + + register struct nl *np; + + + + np = gtype(tdecl); + + line = tline; - if (np != NIL && (tdecl[0] == T_ID || tdecl[0] == T_TYID)) - np = nlcopy(np); + +#ifndef PI0 + + enter(defnl(tid, TYPE, np, 0))->nl_flags |= NMOD; + +#else + + enter(defnl(tid, TYPE, np, 0)); + + send(REVTYPE, tline, tid, tdecl); + +#endif +++ +++#ifdef PC +++ if (cbn == 1) { +++ stabgtype( tid , line ); +++ } +++#endif PC +++ + +# ifdef PTREE + + { + + pPointer Type = TypeDecl( tid , tdecl ); + + pPointer *Types; + + + + pSeize( PorFHeader[ nesting ] ); + + Types = &( pDEF( PorFHeader[ nesting ] ).PorFTypes ); + + *Types = ListAppend( *Types , Type ); + + pRelease( PorFHeader[ nesting ] ); + + } + +# endif + +} + + + +typeend() + +{ + + + +#ifdef PI0 + + send(REVTEND); + +#endif + + foredecl(); + +} + + + +/* + + * Return a type pointer (into the namelist) + + * from a parse tree for a type, building + + * namelist entries as needed. + + */ + +struct nl * + +gtype(r) + + register int *r; + +{ + + register struct nl *np; + + register char *cp; - int oline; +++ register int oline, w; + + + + if (r == NIL) + + return (NIL); + + oline = line; + + if (r[0] != T_ID) + + oline = line = r[1]; + + switch (r[0]) { + + default: + + panic("type"); + + case T_TYID: + + r++; + + case T_ID: + + np = lookup(r[1]); + + if (np == NIL) + + break; + + if (np->class != TYPE) { + +#ifndef PI1 + + error("%s is a %s, not a type as required", r[1], classes[np->class]); + +#endif + + np = NIL; + + break; + + } + + np = np->type; + + break; + + case T_TYSCAL: + + np = tyscal(r); + + break; + + case T_TYRANG: + + np = tyrang(r); + + break; + + case T_TYPTR: + + np = defnl(0, PTR, 0, 0 ); + + np -> ptr[0] = r[2]; + + np->nl_next = forechain; + + forechain = np; + + break; + + case T_TYPACK: + + np = gtype(r[2]); + + break; + + case T_TYARY: + + np = tyary(r); + + break; + + case T_TYREC: + + np = tyrec(r[2], 0); + +# ifdef PTREE + + /* + + * mung T_TYREC[3] to point to the record + + * for RecTCopy + + */ + + r[3] = np; + +# endif + + break; + + case T_TYFILE: + + np = gtype(r[2]); + + if (np == NIL) + + break; + +#ifndef PI1 + + if (np->nl_flags & NFILES) + + error("Files cannot be members of files"); + +#endif + + np = defnl(0, FILET, np, 0); + + np->nl_flags |= NFILES; + + break; + + case T_TYSET: + + np = gtype(r[2]); + + if (np == NIL) + + break; + + if (np->type == nl+TDOUBLE) { + +#ifndef PI1 + + error("Set of real is not allowed"); + +#endif + + np = NIL; + + break; + + } + + if (np->class != RANGE && np->class != SCAL) { + +#ifndef PI1 + + error("Set type must be range or scalar, not %s", nameof(np)); + +#endif + + np = NIL; + + break; + + } + +#ifndef PI1 + + if (width(np) > 2) + + error("Implementation restriction: sets must be indexed by 16 bit quantities"); + +#endif + + np = defnl(0, SET, np, 0); + + break; + + } + + line = oline; +++ w = lwidth(np); +++ if (w >= TOOMUCH) { +++ error("Storage requirement of %s exceeds the implementation limit of %d by %d bytes", +++ nameof(np), TOOMUCH-1, w-TOOMUCH+1); +++ np = NIL; +++ } + + return (np); + +} + + + +/* + + * Scalar (enumerated) types + + */ + +tyscal(r) + + int *r; + +{ - register struct nl *np, *op; +++ register struct nl *np, *op, *zp; + + register *v; + + int i; + + + + np = defnl(0, SCAL, 0, 0); + + np->type = np; + + v = r[2]; + + if (v == NIL) + + return (NIL); + + i = -1; +++ zp = np; + + for (; v != NIL; v = v[2]) { + + op = enter(defnl(v[1], CONST, np, ++i)); + +#ifndef PI0 + + op->nl_flags |= NMOD; + +#endif + + op->value[1] = i; +++ zp->chain = op; +++ zp = op; + + } + + np->range[1] = i; + + return (np); + +} + + + +/* + + * Declare a subrange. + + */ + +tyrang(r) + + register int *r; + +{ + + register struct nl *lp, *hp; + + double high; + + int c, c1; + + + + gconst(r[3]); + + hp = con.ctype; + + high = con.crval; + + gconst(r[2]); + + lp = con.ctype; + + if (lp == NIL || hp == NIL) + + return (NIL); + + if (norange(lp) || norange(hp)) + + return (NIL); + + c = classify(lp); + + c1 = classify(hp); + + if (c != c1) { + +#ifndef PI1 + + error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp)); + +#endif + + return (NIL); + + } + + if (c == TSCAL && scalar(lp) != scalar(hp)) { + +#ifndef PI1 + + error("Scalar types must be identical in subranges"); + +#endif + + return (NIL); + + } + + if (con.crval > high) { + +#ifndef PI1 + + error("Range lower bound exceeds upper bound"); + +#endif + + return (NIL); + + } + + lp = defnl(0, RANGE, hp->type, 0); + + lp->range[0] = con.crval; + + lp->range[1] = high; + + return (lp); + +} + + + +norange(p) + + register struct nl *p; + +{ + + if (isa(p, "d")) { + +#ifndef PI1 + + error("Subrange of real is not allowed"); + +#endif + + return (1); + + } + + if (isnta(p, "bcsi")) { + +#ifndef PI1 + + error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p)); + +#endif + + return (1); + + } + + return (0); + +} + + + +/* + + * Declare arrays and chain together the dimension specification + + */ + +struct nl * + +tyary(r) + + int *r; + +{ + + struct nl *np; + + register *tl; + + register struct nl *tp, *ltp; + + int i; + + + + tp = gtype(r[3]); + + if (tp == NIL) + + return (NIL); + + np = defnl(0, ARRAY, tp, 0); + + np->nl_flags |= (tp->nl_flags) & NFILES; + + ltp = np; + + i = 0; + + for (tl = r[2]; tl != NIL; tl = tl[2]) { + + tp = gtype(tl[1]); + + if (tp == NIL) { + + np = NIL; + + continue; + + } + + if (tp->class == RANGE && tp->type == nl+TDOUBLE) { + +#ifndef PI1 + + error("Index type for arrays cannot be real"); + +#endif + + np = NIL; + + continue; + + } + + if (tp->class != RANGE && tp->class != SCAL) { + +#ifndef PI1 + + error("Array index type is a %s, not a range or scalar as required", classes[tp->class]); + +#endif + + np = NIL; + + continue; + + } + + if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) { + +#ifndef PI1 + + error("Value of dimension specifier too large or small for this implementation"); + +#endif + + continue; + + } + + tp = nlcopy(tp); + + i++; + + ltp->chain = tp; + + ltp = tp; + + } + + if (np != NIL) + + np->value[0] = i; + + return (np); + +} + + + +/* + + * Delayed processing for pointers to + + * allow self-referential and mutually + + * recursive pointer constructs. + + */ + +foredecl() + +{ + + register struct nl *p, *q; + + + + for (p = forechain; p != NIL; p = p->nl_next) { + + if (p->class == PTR && p -> ptr[0] != 0) + + { + + p->type = gtype(p -> ptr[0]); + +#ifndef PI1 + + if (p->type != NIL && ( ( p->type )->nl_flags & NFILES)) + + error("Files cannot be members of dynamic structures"); + +#endif + +# ifdef PTREE + + { + + if ( pUSE( p -> inTree ).PtrTType == pNIL ) { + + pPointer PtrTo = tCopy( p -> ptr[0] ); + + + + pDEF( p -> inTree ).PtrTType = PtrTo; + + } + + } + +# endif + + p -> ptr[0] = 0; + + } + + } + +} diff --cc usr/src/cmd/pi/var.c index 0000000000,266e160726,0000000000..0287e9f415 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/var.c +++ b/usr/src/cmd/pi/var.c @@@@ -1,0 -1,246 -1,0 +1,421 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)var.c 1.3 9/2/80"; +++ +++#include "whoami.h" + +#include "0.h" +++#include "align.h" +++#ifdef PC +++# include "pc.h" +++# include "pcops.h" +++# include "iorec.h" +++#endif PC + + + +/* + + * Declare variables of a var part. DPOFF1 is + + * the local variable storage for all prog/proc/func + + * modules aside from the block mark. The total size + + * of all the local variables is entered into the + + * size array. + + */ + +varbeg() + +{ + + +++/* this allows for multiple declaration +++ * parts except when the "standard" +++ * option has been specified. +++ * If routine segment is being compiled, +++ * do level one processing. +++ */ +++ + +#ifndef PI1 - if (parts & VPRT) - error("All variables must be declared in one var part"); - parts |= VPRT; - #endif - #ifndef PI0 - sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; +++ if (!progseen) +++ level1(); +++ if ( parts[ cbn ] & RPRT ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("Variable declarations should precede routine declarations"); +++ } +++ if ( parts[ cbn ] & VPRT ) { +++ if ( opt( 's' ) ) { +++ standard(); +++ } else { +++ warning(); +++ } +++ error("All variables should be declared in one var part"); +++ } +++ parts[ cbn ] |= VPRT; + +#endif +++ /* +++ * #ifndef PI0 +++ * sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; +++ * #endif +++ */ + + forechain = NIL; + +#ifdef PI0 + + send(REVVBEG); + +#endif + +} + + + +var(vline, vidl, vtype) + +#ifdef PI0 + + int vline, *vidl, *vtype; + +{ + + register struct nl *np; + + register int *vl; + + + + np = gtype(vtype); + + line = vline; - for (vl = vidl; vl != NIL; vl = vl[2]) - enter(defnl(vl[1], VAR, np, 0)); +++ for (vl = vidl; vl != NIL; vl = vl[2]) { +++ } +++ } + + send(REVVAR, vline, vidl, vtype); + +} + +#else + + int vline; + + register int *vidl; + + int *vtype; + +{ + + register struct nl *np; + + register struct om *op; + + long w; + + int o2; + + int *ovidl = vidl; + + + + np = gtype(vtype); + + line = vline; +++ /* +++ * widths are evened out +++ */ + + w = (lwidth(np) + 1) &~ 1; + + op = &sizes[cbn]; + + for (; vidl != NIL; vidl = vidl[2]) { - op->om_off -= w; - o2 = op->om_off; +++# ifdef OBJ +++ op -> om_off = roundup( op -> om_off - w , align( np ) ); +++ o2 = op -> om_off; +++# endif OBJ +++# ifdef PC +++ if ( cbn == 1 ) { +++ /* +++ * global variables are not accessed off the fp +++ * but rather by their names. +++ */ +++ o2 = 0; +++ } else { +++ /* +++ * locals are aligned, too. +++ */ +++ op -> om_off = roundup( op -> om_off - w +++ , align( np ) ); +++ o2 = op -> om_off; +++ } +++# endif PC + + enter(defnl(vidl[1], VAR, np, o2)); +++ if ( np -> nl_flags & NFILES ) { +++ dfiles[ cbn ] = TRUE; +++ } +++# ifdef PC +++ if ( cbn == 1 ) { +++ putprintf( " .data" , 0 ); +++ putprintf( " .comm " , 1 ); +++ putprintf( EXTFORMAT , 1 , vidl[1] ); +++ putprintf( ",%d" , 0 , w ); +++ putprintf( " .text" , 0 ); +++ } +++ stabvar( vidl[1] , p2type( np ) , cbn , o2 , w , line ); +++# endif PC + + } + +# ifdef PTREE + + { + + pPointer *Vars; + + pPointer Var = VarDecl( ovidl , vtype ); + + + + pSeize( PorFHeader[ nesting ] ); + + Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars ); + + *Vars = ListAppend( *Vars , Var ); + + pRelease( PorFHeader[ nesting ] ); + + } + +# endif + +} + +#endif + + + +varend() + +{ + + + + foredecl(); + +#ifndef PI0 + + sizes[cbn].om_max = sizes[cbn].om_off; + +#else + + send(REVVEND); + +#endif + +} + + + +/* + + * Evening + + */ + +even(w) + + register int w; + +{ + + if (w < 0) + + return (w & ~1); + + return ((w+1) & ~1); + +} + + + +/* + + * Find the width of a type in bytes. + + */ + +width(np) + + struct nl *np; + +{ + + + + return (lwidth(np)); + +} + + - long lwidth(np) +++long +++lwidth(np) + + struct nl *np; + +{ + + register struct nl *p; + + long w; + + + + p = np; + + if (p == NIL) + + return (0); + +loop: + + switch (p->class) { + + case TYPE: + + switch (nloff(p)) { + + case TNIL: + + return (2); + + case TSTR: + + case TSET: + + panic("width"); + + default: + + p = p->type; + + goto loop; + + } + + case ARRAY: + + return (aryconst(p, 0)); + + case PTR: - case FILET: + + return ( sizeof ( int * ) ); +++ case FILET: +++# ifdef OBJ +++ return ( sizeof ( int * ) ); +++# endif OBJ +++# ifdef PC +++ return ( sizeof(struct iorec) +++ + lwidth( p -> type ) ); +++# endif PC + + case RANGE: + + if (p->type == nl+TDOUBLE) + +#ifdef DEBUG + + return (hp21mx ? 4 : 8); + +#else + + return (8); + +#endif + + case SCAL: + + return (bytes(p->range[0], p->range[1])); + + case SET: + + setran(p->type); - return ( (set.uprbp>>3) + 1); +++ return roundup( ( set.uprbp >> 3 ) + 1 , A_SET ); + + case STR: + + case RECORD: + + return ( p->value[NL_OFFS] ); + + default: + + panic("wclass"); + + } + +} + + +++ /* +++ * round up x to a multiple of y +++ * for computing offsets of aligned things. +++ * y had better be positive. +++ * rounding is in the direction of x. +++ */ +++long +++roundup( x , y ) +++ long x; +++ register long y; +++ { +++ +++ if ( y == 0 ) { +++ return 0; +++ } +++ if ( x >= 0 ) { +++ return ( ( ( x + ( y - 1 ) ) / y ) * y ); +++ } else { +++ return ( ( ( x - ( y - 1 ) ) / y ) * y ); +++ } +++ } +++ +++ /* +++ * alignment of an object using the c alignment scheme +++ */ +++int +++align( np ) +++ struct nl *np; +++ { +++ register struct nl *p; +++ +++ p = np; +++ if ( p == NIL ) { +++ return 0; +++ } +++alignit: +++ switch ( p -> class ) { +++ case TYPE: +++ switch ( nloff( p ) ) { +++ case TNIL: +++ return A_POINT; +++ case TSTR: +++ return A_CHAR; +++ case TSET: +++ return A_SET; +++ default: +++ p = p -> type; +++ goto alignit; +++ } +++ case ARRAY: +++ /* +++ * arrays are aligned as their component types +++ */ +++ p = p -> type; +++ goto alignit; +++ case PTR: +++ return A_POINT; +++ case FILET: +++ return A_FILET; +++ case RANGE: +++ if ( p -> type == nl+TDOUBLE ) { +++ return A_DOUBLE; +++ } +++ /* else, fall through */ +++ case SCAL: +++ switch ( bytes( p -> range[0] , p -> range[1] ) ) { +++ case 4: +++ return A_LONG; +++ case 2: +++ return A_SHORT; +++ case 1: +++ return A_CHAR; +++ default: +++ panic( "align: scal" ); +++ } +++ case SET: +++ return A_SET; +++ case STR: +++ return A_CHAR; +++ case RECORD: +++ /* +++ * follow chain through all fields in record, +++ * taking max of alignments of types of fields. +++ * short circuit out if i reach the maximum alignment. +++ * this is pretty likely, as A_MAX is only 4. +++ */ +++ { +++ register long recalign; +++ register long fieldalign; +++ +++ recalign = A_MIN; +++ p = p -> chain; +++ while ( ( p != NIL ) && ( recalign < A_MAX ) ) { +++ fieldalign = align( p -> type ); +++ if ( fieldalign > recalign ) { +++ recalign = fieldalign; +++ } +++ p = p -> chain; +++ } +++ return recalign; +++ } +++ default: +++ panic( "align" ); +++ } +++ } +++ + +/* + + * Return the width of an element + + * of a n time subscripted np. + + */ + +long aryconst(np, n) + + struct nl *np; + + int n; + +{ + + register struct nl *p; + + long s, d; + + + + if ((p = np) == NIL) + + return (NIL); + + if (p->class != ARRAY) + + panic("ary"); - s = width(p->type); +++ s = lwidth(p->type); + + /* + + * Arrays of anything but characters are word aligned. + + */ + + if (s & 1) + + if (s != 1) + + s++; + + /* + + * Skip the first n subscripts + + */ + + while (n >= 0) { + + p = p->chain; + + n--; + + } + + /* + + * Sum across remaining subscripts. + + */ + + while (p != NIL) { + + if (p->class != RANGE && p->class != SCAL) + + panic("aryran"); + + d = p->range[1] - p->range[0] + 1; + + s *= d; + + p = p->chain; + + } + + return (s); + +} + + + +/* + + * Find the lower bound of a set, and also its size in bits. + + */ + +setran(q) + + struct nl *q; + +{ + + register lb, ub; + + register struct nl *p; + + + + p = q; + + if (p == NIL) + + return (NIL); + + lb = p->range[0]; + + ub = p->range[1]; + + if (p->class != RANGE && p->class != SCAL) + + panic("setran"); + + set.lwrb = lb; + + /* set.(upperbound prime) = number of bits - 1; */ + + set.uprbp = ub-lb; + +} + + + +/* + + * Return the number of bytes required to hold an arithmetic quantity + + */ + +bytes(lb, ub) + + long lb, ub; + +{ + + + +#ifndef DEBUG + + if (lb < -32768 || ub > 32767) + + return (4); + + else if (lb < -128 || ub > 127) + + return (2); + +#else + + if (!hp21mx && (lb < -32768 || ub > 32767)) + + return (4); + + if (lb < -128 || ub > 127) + + return (2); + +#endif + + else + + return (1); + +} diff --cc usr/src/cmd/pi/version.c index 0000000000,7a4584d80f,0000000000..462664eaea mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/version.c +++ b/usr/src/cmd/pi/version.c @@@@ -1,0 -1,23 -1,0 +1,25 @@@@ - /* Copyright (c) 1979 Regents of the University of California */ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)version.c 1.1 8/27/80"; + + + + /* + + * this writes the declaration of the character string version + + * onto standard output. + + * useful for makeing Version.c give the correct date for pi. + + */ + + + +#include + + + +char *ctime(); + + + +long clock; + +char *cstring; + + + +main() + + { + + time( &clock ); + + cstring = ctime( &clock ); + + cstring[ 24 ] = '\0'; + + printf( "char version[] = \"%s\";\n" , cstring ); + + } + + diff --cc usr/src/cmd/pi/whoami.h index 0000000000,0000000000,0000000000..c2624de057 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/pi/whoami.h @@@@ -1,0 -1,0 -1,0 +1,32 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)piwhoami.h 1.1 10/1/80"; */ +++ +++/* +++ * am i generating an obj file (OBJ), +++ * postfix binary input to the 2nd pass of the portable c compiler (PC), +++ * or pTrees (PTREE)? +++ */ +++#define OBJ +++#undef PC +++#undef PTREE +++ +++/* +++ * am i the vax or the pdp11 version +++ */ +++#define VAX +++#undef PDP11 +++ +++/* +++ * am i pi or pxp? +++ */ +++#define PI +++#undef PXP +++ +++/* +++ * am i both passes, or am i only one of the two passes pi0 or pi1? +++ */ +++#define PI01 +++#undef PI0 +++#undef PI1 +++ diff --cc usr/src/cmd/pi/yy.h index 0000000000,369c60d293,0000000000..a28814fbf7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yy.h +++ b/usr/src/cmd/pi/yy.h @@@@ -1,0 -1,296 -1,0 +1,286 @@@@ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.2 November 1978 - */ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)yy.h 1.1 8/27/80"; */ + + + +#include "y.tab.h" + +/* + + * INPUT/OUTPUT + + */ + + + +/* + + * The buffer for the input file is normally "ibuf". + + * When files are included, however, this may be + + * pushed down in the stack of currently active + + * files. For this reason, the pointer ibp always + + * references the i/o buffer of the current input file. + + */ + +FILE *ibuf, *ibp; + + + +/* + + * Line and token buffers. Charbuf is the character buffer for + + * input lines, token the buffer for tokens returned + + * by the scanner. CBSIZE defines the maximum line + + * length allowed on input and is doubtless too small. + + * The token buffer should be a local array in yylex. + + */ + +#define CBSIZE 161 + + + +char charbuf[CBSIZE], *bufp, token[CBSIZE]; + + + +#define digit(c) (c >= '0' && c <= '9') + +#define alph(c) ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) + + + +/* + + * Flag to prevent reprinting current line after + + * an error. + + */ + +char yyprtd; + + + +/* + + * The following variables are maintained by + + * the scanner in the file lex and used in scanning + + * and in parsing. + + * + + * The variable yychar is the current scanner character. + + * Currently, the scanner must be called as + + * yychar = yylex() + + * even though it should set yychar itself. + + * Yychar has value YEOF at end of file, and negative value if + + * there is no yychar, e.g. after a shift in the parser. + + * + + * The variable yycol is the current column in the line whose number + + * is given by yyline. Yyecol and yyeline give the position for an + + * error message to flag, usually the start of an input token. + + * Yylval is the semantic return from the scanner. + + * + + * In fact all of these variables are "per token". + + * In the usual case, only the copies in the scanner token structure + + * 'Y' are used, and the #defines below serve to make them look + + * like variables. + + * + + * For the purposes of the error recovery, however, they are copied + + * and restored quite freely. For the error recovery also, the + + * file name which the input line this token is on and the seek + + * pointer of this line in its source file are saved as yyefile + + * and yyseekp. The global variable yylinpt is the seek pointer + + * of the current input line. + + */ + +int yycol; + +int yyline; + +int yyseqid; + +int yysavc; + +int yylinpt; + + + +/* *** NOTE *** + + * It would be much better to not have the Yyeline and Yyefile + + * in the scanner structure and to have a mechanism for mapping + + * seqid's to these globally. + + */ + +struct yytok { + + int Yychar; + + int Yylval; + + int Yyecol; + + int Yyeline; + + int Yyseekp; + + char *Yyefile; + + int Yyeseqid; + +} Y, OY; + + + +#define yychar Y.Yychar + +#define yylval Y.Yylval + +#define yyecol Y.Yyecol + +#define yyeline Y.Yyeline + +#define yyseekp Y.Yyseekp + +#define yyefile Y.Yyefile + +#define yyeseqid Y.Yyeseqid + + + +/* + + * Yyval is the semantic value returned by a reduction. + + * It is what "$$" is expanded to by yacc. + + */ + +int *Ps, *yyval; + + + +/* + + * N is the length of a reduction. + + * Used externally by "lineof" to get the left and + + * right margins for a reduction. + + */ + +int N; + +/* + + * Definitions for looking up keywords. + + * The keyword array is called yykey, and + + * lastkey points at the end of it. + + */ + +char *lastkey; + + + +struct kwtab { + + char *kw_str; + + int kw_val; + +} yykey[]; + + + +/* + + * ERROR RECOVERY EXTERNALS + + */ + + + +#define CLIMIT 40 /* see yyrecover.c */ + +char *tokname(); + +char *charname(); + + + +char *classes[]; + + + +/* + + * Tokens which yacc doesn't define + + */ + +#define YEOF 0 + +#define ERROR 256 + + + +/* + + * Limit on the number of syntax errors + + */ + +#define MAXSYNERR 100 + + + +/* + + * Big costs + + */ + +#define HUGE 50 + +#define INFINITY 100 + + + +/* + + * Kinds of panics + + */ + +#define PDECL 0 + +#define PSTAT 1 + +#define PEXPR 2 + +#define PPROG 3 + + + +#define yyresume() yyResume = 1; + + + +char yyResume; + + + +char dquote; + + + +char errout; + + + +/* + + * Yyidwant and yyidhave are the namelist classes + + * of identifiers associated with a identifier reduce + + * error, set before the recovery is called. + + * Since they may be set again during the forward move + + * they must be saved by yyrecover, which uses them in printing + + * error messages. + + */ + +int yyidhave, yyidwant; + + + +/* + + * The variables yy*shifts are used to prevent looping and the printing + + * of spurious messages in the parser. Yyshifts gives the number of + + * true input shifts since the last corrective action. YyOshifts + + * is the value of yyshifts before it was last cleared, and is used + + * by yyPerror in yypanic.c to suppress messages. + + * + + * Yytshifts counts true input shifts. It is used to prevent looping + + * inserting unique symbols. If yytshifts == yyTshifts (local to + + * yyrecover.c) then there has been no shift over true input since + + * the last unique symbol insertion. We refuse, in this case, + + * to insert more unique symbols so as to prevent looping. + + * + + * The recovery cannot loop because it guarantees the progress of the + + * parse, i.e.: + + * + + * 1) Any insertion guarantees to shift over 2 symbols, a replacement + + * over one symbol. + + * + + * 2) Unique symbol insertions are limited to one for each true + + * symbol of input, or "safe" insertion of the keywords "end" + + * and "until" at zero cost (safe since these are know to match + + * stack that cannot have been generated - e.g. "begin" or "repeat") + + * + + * 3) We never panic more than once from a given state without + + * shifting over input, i.e. we force the parse stack to shrink + + * after each unsuccessful panic. + + */ + +int yyshifts, yyOshifts; + +unsigned yytshifts; + + + +#ifdef PXP + + + +/* + + * Identifier class definitions + + */ + +#define UNDEF 0 + +#define CONST 1 + +#define TYPE 2 + +#define VAR 3 + +#define ARRAY 4 + +#define PTRFILE 5 + +#define RECORD 6 + +#define FIELD 7 + +#define PROC 8 + +#define FUNC 9 + +#define FVAR 10 + +#define REF 11 + +#define PTR 12 + +#define FILET 13 + +#define SET 14 + +#define RANGE 15 + +#define LABEL 16 + +#define WITHPTR 17 + +#define SCAL 18 + +#define STR 19 + +#define PROG 20 + +#define IMPROPER 21 + + + +/* + + * COMMENT FORMATTING DEFINITIONS + + */ + + + +/* + + * Count of tokens on this input line + + * Note that this can be off if input is not syntactically correct. + + */ + +int yytokcnt; + +int yywhcnt; + + + +/* + + * Types of comments + + */ + +#define CLMARG 0 + +#define CALIGN 1 + +#define CTRAIL 2 + +#define CRMARG 3 + +#define CSRMARG 4 + +#define CNL 5 + +#define CNLBL 6 + +#define CFORM 7 + +#define CINCLUD 8 + + + +/* + + * Comment structure + + * Cmhp is the head of the current list of comments + + */ + +struct comment { + + struct comment *cmnext; + + int cmdelim; + + struct commline *cml; + + int cmjust; + + int cmseqid; + +} *cmhp; + + + +/* + + * Structure for holding a comment line + + */ + +struct commline { + + char *cmtext; + + int cmcol; /* Only used for first line of comment currently */ + + struct commline *cml; + +}; + + + +struct W { + + int Wseqid; + + int Wcol; + +} yyw[MAXDEPTH + 1], *yypw; + + + +#define commform() quickcomm(CFORM) + +#define commnl() quickcomm(CNL) + +#define commnlbl() quickcomm(CNLBL) + +#endif diff --cc usr/src/cmd/pi/yycopy.c index 0000000000,bf569f296a,0000000000..1c3b8c9161 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yycopy.c +++ b/usr/src/cmd/pi/yycopy.c @@@@ -1,0 -1,19 -1,0 +1,19 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)yycopy.c 1.1 8/27/80"; +++ + +#include "0.h" + +#include "yy.h" + + + +OYcopy () + + { + + register int *r0 = & OY; + + register int *r1 = & Y; + + register int r2 = ( sizeof ( struct yytok ) ) / ( sizeof ( int ) ); + + + + do + + { + + * r0 ++ = * r1 ++ ; + + } + + while ( -- r2 > 0 ); + + } - - - diff --cc usr/src/cmd/pi/yycosts.c index 0000000000,c3e3779c85,0000000000..f0ec79c740 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yycosts.c +++ b/usr/src/cmd/pi/yycosts.c @@@@ -1,0 -1,243 -1,0 +1,232 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yycosts.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * Symbol costs for Pascal. + + * + + * Cost strategy of August 14, 1977. + + * + + * The costs determined by the routines in this file are used by + + * the recovery in choosing appropriate corrections. + + * The cost vectors and the error productions in the grammar + + * work together to define the corrective capacity of the grammar. + + * + + * The costs here largely derive from those given in Steve Rhode's + + * thesis for the Pascal-I error correcting parser which he implemented. + + * Some minor changes have been made to adjust for the fact that + + * the current error recovery is not as "smart", both because of the + + * limited forward move and because of the lack of any type information + + * about identifiers. + + * + + * These adjustments largely take the form of increased costs for certain + + * tokens, noticeably keywords which are major brackets such as "begin" + + * "label", "procedure", etc. + + * + + * The overall weighting strategy is still similar to Rhodes' strategy. + + * The costs can be considered: + + * + + * LOW <= 3 + + * MEDIUM 4 or 5 + + * HIGH >= 6 + + */ + + + +/* + + * Insertion costs + + * + + * In addition to the normal symbol insertion costs, + + * there are zero cost insertions here. + + * The current error recovery system treats symbols + + * which have zero insertion cost in a special way, + + * inserting them but suppressing diagnostics. + + * This allows the system to hold of on bracketing + + * error diagnostics about missing end's until the + + * reduction occurs which knows the line number of the + + * corresponding "begin", "repeat", etc. + + * A more intelligent and useful diagnostic can then + + * be printed. + + * + + * Although this routine never allows the insertion + + * of the keyword begin, it can be inserted after a + + * procedure or function body starts, if it was omitted + + * by a special case in the panic routine, which notices + + * the keywords in the statement body of the procedure + + * and inserts the begin to recover. + + * + + * Similarly, we do not insert end-of-file, but + + * the fact that end-of-file is the unique input + + * is noticed by the recovery routines as a special + + * case and handled there. + + */ + +inscost(sy, before) + + register int sy, before; + +{ + + + + switch (before) { + + case YEND: + + if (sy == YEND) + + break; + + case YPROCEDURE: + + case YFUNCTION: + + if (sy == YUNTIL || sy == YEND) + + return (0); + + } + + switch (sy) { + + case ';': + + return (1); + + case ',': + + case ':': + + case YOF: + + case YDO: + + return (2); + + case YARRAY: + + case '+': + + case '*': + + return (3); + + default: + + return (4); + + case '^': + + case YNOT: + + case YLABEL: + + case YCONST: + + case YTYPE: + + case YVAR: + + case YUNTIL: + + case '(': + + case '[': + + case YWHILE: + + case YWITH: + + case YASSERT: + + return (5); + + case YPROCEDURE: + + case YFUNCTION: + + case YCASE: + + return (6); + + case YEND: + + return (8); + + case YBEGIN: + + case YEOF: + + case YREPEAT: + + case YRECORD: + + return (INFINITY); + + } + +} + + + +/* + + * Replacement costs + + * + + * Most replacement costs are the same as an insertion + + * plus a deletion cost. One special case is the replacement + + * of a large number of keywords by an identifier. + + * These are given lower costs, especially the keyword "to". + + */ + +repcost(what, with) + + register int what, with; + +{ + + register int c; + + + + if (with == what) + + return (INFINITY); + + if (with == YID && what > ERROR) + + switch (what) { + + case YID: + + case YDOTDOT: + + case YINT: + + case YBINT: + + case YSTRING: + + case YNUMB: + + break; + + case YTO: + + return (3); + + default: + + return (5); + + case YRECORD: + + case YTHEN: + + return (6); + + case YBEGIN: + + break; + + } + + if (what == ';' && (with == ',' || with == '.')) + + return (CLIMIT - 1); + + c = delcost(what) + inscost(with); + + /* + + * It costs extra to replace something which has + + * semantics by something which doesn't. + + */ + + if (nullsem(what) == NIL && nullsem(with) != NIL) + + c =+ 4; + + return (c); + +} + + + +/* + + * Deletion costs + + */ + +delcost(what) + + int what; + +{ + + + + switch (what) { + + case '.': + + case ':': + + case ',': + + case '=': + + case '(': + + return (3); + + case YELSE: + + case YTHEN: + + return (4); + + default: + + return (5); + + case YLABEL: + + case YCONST: + + case YTYPE: + + case YVAR: + + return (10); + + case YPROCEDURE: + + case YFUNCTION: + + case YBEGIN: + + case YEND: + + return ((CLIMIT * 3) / 4); + + case ';': + + case YEOF: + + return (INFINITY); + + } + +} + +#ifdef DEBUG + + + +/* - * Routine to print out costs with "-C" option. +++ * Routine to print out costs with "-K" option. + + */ + +char yysyms[] ";,:=*+/-|&()[]<>~^"; + + + + + +yycosts() + +{ + + register int c; + + register char *cp; + + + + printf("Insert\tDelete\tRep(ID)\tSymbol\n"); + + for (cp = yysyms; *cp; cp++) + + yydocost(*cp); + + for (c = ERROR + 1; c < YLAST; c++) + + yydocost(c); + +#ifdef PXP + + flush(); + +#endif + +} + + + +yydocost(c) + + int c; + +{ + + + + printf("%4d\t", inscost(c, -1)); + + printf("%4d\t", delcost(c)); + + if (repcost(c, YID) != inscost(YID) + delcost(c)) + + printf("%4d", repcost(c, YID)); + + printf("\t%s%s\n", charname(c)); + +} + +#endif diff --cc usr/src/cmd/pi/yyerror.c index 0000000000,38678dcb55,0000000000..e8fe41a13c mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyerror.c +++ b/usr/src/cmd/pi/yyerror.c @@@@ -1,0 -1,108 -1,0 +1,99 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyerror.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * Yerror prints an error + + * message and then returns + + * NIL for the tree if needed. + + * The error is flagged on the + + * current line which is printed + + * if the listing is turned off. + +#ifdef PXP + + * + + * As is obvious from the fooling around + + * with fout below, the Pascal system should + + * be changed to use the new library "lS". + +#endif + + */ + +yerror(s, a1, a2, a3, a4, a5) + + char *s; + +{ + +#ifdef PI + + char buf[256]; + +#endif + + register int i, j; + + static yySerrs; + +#ifdef PXP + + int ofout; + +#endif + + - if (errpfx == 'w' && opt('w') != 0) +++ if (errpfx == 'w' && opt('w') != 0) { +++ errpfx = 'E'; + + return; +++ } + +#ifdef PXP + + flush(); + + ofout = fout[0]; + + fout[0] = errout; + +#endif + + yyResume = 0; + +#ifdef PI + + geterr(s, buf); + + s = buf; + +#endif + + yysync(); + + pchr(errpfx); + + pchr(' '); + + for (i = 3; i < yyecol; i++) + + pchr('-'); + + printf("^--- "); + +/* + + if (yyecol > 60) + + printf("\n\t"); + +*/ + + printf(s, a1, a2, a3, a4, a5); + + pchr('\n'); + + if (errpfx == 'E') + +#ifdef PI - eflg++, cgenflg++; +++ eflg++, codeoff(); + +#endif + +#ifdef PXP + + eflg++; + +#endif + + errpfx = 'E'; + + yySerrs++; + + if (yySerrs >= MAXSYNERR) { + + yySerrs = 0; + + yerror("Too many syntax errors - QUIT"); + + pexit(ERRS); + + } + +#ifdef PXP + + flush(); + + fout[0] = ofout; + + return (0); + +#endif + +} + + + +/* + + * A bracketing error message + + */ + +brerror(where, what) + + int where; + + char *what; + +{ + + + + if (where == 0) { + + line = yyeline; + + setpfx(' '); + + error("End matched %s on line %d", what, where); + + return; + + } + + if (where < 0) + + where = -where; + + yerror("Inserted keyword end matching %s on line %d", what, where); + +} diff --cc usr/src/cmd/pi/yyget.c index 0000000000,13ca0685b9,0000000000..f8d5c5c159 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyget.c +++ b/usr/src/cmd/pi/yyget.c @@@@ -1,0 -1,342 -1,0 +1,341 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyget.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +#ifdef PXP + +int yytokcnt; + +#endif + + + +/* + + * Readch returns the next + + * character from the current + + * input line or -1 on end-of-file. + + * It also maintains yycol for use in + + * printing error messages. + + */ + +readch() + +{ + + register i, c; + + + + if (*bufp == '\n' && bufp >= charbuf) { + +#ifdef PXP + + yytokcnt = 0; + +#endif + + if (getline() < 0) + + return (-1); + + } + + c = *++bufp; + + if (c == '\t') + + yycol = ((yycol + 8) & ~7); + + else + + yycol++; + + return (c); + +} + + + +/* + + * Definitions of the structures used for the + + * include facility. The variable "ibp" points + + * to the getc buffer of the current input file. + + * There are "inclev + 1" current include files, + + * and information in saved in the incs stack + + * whenever a new level of include nesting occurs. + + * + + * Ibp in the incs structure saves the pointer + + * to the previous levels input buffer; + + * filename saves the previous file name; + + * Printed saves whether the previous file name + + * had been printed before this nesting occurred; + + * and yyline is the line we were on on the previous file. + + */ + + + +#define MAXINC 10 + + + +struct inc { + + FILE *ibp; + + char *filename; + + int Printed; + + int yyline; + + int yyLinpt; + +} incs[MAXINC]; + + + +extern char *printed; + + + +int inclev = -1; + + + +#ifdef PXP + +/* + + * These initializations survive only if + + * pxp is asked to pretty print one file. + + * Otherwise they are destroyed by the initial + + * call to getline. + + */ + +char charbuf[CBSIZE] = " program x(output);\n"; + +int yycol = 8; + +char *bufp = charbuf; + + + +#endif + +/* + + * YyLinpt is the seek pointer to the beginning of the + + * next line in the file. + + */ + +int yyLinpt; + + + +/* + + * Getline places the next line + + * from the input stream in the + + * line buffer, returning -1 at YEOF. + + */ + +getline() + +{ + + register char *cp; + + register CHAR c; + +#ifdef PXP + + static char ateof; + +#endif + + register FILE *ib; + + int i; + + + + if (opt('l') && yyprtd == 0) + + yyoutline(); + + yyprtd = 0; + +top: + + yylinpt = yyLinpt; + + yyline++; + + yyseqid++; + + cp = charbuf; + + ib = ibp; + + i = sizeof charbuf - 1; + + for (;;) { + + c = getc(ib); + + if (c == EOF) { + + if (uninclud()) + + goto top; + +#ifdef PXP + + if (ateof == 0 && bracket) { + + strcpy(charbuf, "begin end.\n"); + + ateof = 1; + + goto out; + + } + +#endif + + bufp = "\n"; + + yyline--; + + yyseqid--; + + yyprtd = 1; + + return (-1); + + } + + *cp++ = c; + + if (c == '\n') + + break; + + if (--i == 0) { + + line = yyline; + + error("Input line too long - QUIT"); + + pexit(DIED); + + } + + } + + *cp = 0; + + yyLinpt = yylinpt + cp - charbuf; + + if (includ()) + + goto top; + +#ifdef PXP + + if (cp == &charbuf[1]) + + commnl(); + + else if (cp == &charbuf[2]) + + switch (charbuf[0]) { + + case ' ': + + commnlbl(); + + break; + + case '\f': + + commform(); + + } + +#endif + + if (opt('u')) + + setuflg(); + +out: + + bufp = charbuf - 1; + + yycol = 8; + + return (1); + +} + + + +/* + + * Check an input line to see if it is a "#include" pseudo-statement. + + * We allow arbitrary blanks in the line and the file name + + * may be delimited by either 's or "s. A single semicolon + + * may be placed after the name, but nothing else is allowed + + */ + +includ() + +{ + + register char *cp, *dp; + + char ch; + + register struct inc *ip; + + + + cp = charbuf; + + if (*cp++ != '#') + + return (0); + + cp = skipbl(cp); + + for (dp = "include"; *dp; dp++) + + if (*dp != *cp++) + + return (0); + + line = yyline; + + cp = skipbl(cp); + + ch = *cp++; + + if (ch != '\'' && ch != '"') { + + /* + + * This should be a yerror flagging the place + + * but its not worth figuring out the column. + + */ + + line = yyline; + + error("Include syntax error - expected ' or \" not found - QUIT"); + + pexit(DIED); + + } + + for (dp = cp; *dp != ch; dp++) + + if (*dp == 0) { + + line = yyline; + + error("Missing closing %c for include file name - QUIT", ch); + + pexit(DIED); + + } + + *dp++ = 0; + +/* + + * if (*dp == ';') + + * dp++; + + * dp = skipbl(dp); + + * if (*dp != '\n') { + + * line = yyline; + + * error("Garbage after filename in include"); + + * pexit(DIED); + + * } + + */ - if (!dotted(cp, 'i')) { +++ if ((!dotted(cp, 'i')) && (!dotted(cp, 'h'))) { + + line = yyline; - error("Include filename must end in .i"); +++ error("Include filename must end in .i or .h"); + + } + +#ifdef PXP + + commincl(cp, ch); + + if (noinclude) + + return (1); + +#endif + + inclev++; + + if (inclev > MAXINC) { + + line = yyline; + + error("Absurdly deep include nesting - QUIT"); + + pexit(DIED); + + } + + ip = &incs[inclev]; + + ip->filename = filename; + + filename = savestr(cp); + +/* + + * left over from before stdio + + * + + * cp = malloc(518); + + * if (cp == -1) { + + * error("Ran out of memory (include)"); + + * pexit(DIED); + + * } + + * + + */ + + ip->ibp = ibp; + + if ( ( ibp = fopen(filename, "r" ) ) == NULL ) { + + perror(filename); + + pexit(DIED); + + } + + if (inpflist(filename)) { + +#ifdef PI + + opush('l'); + +#endif + +#ifdef PXP + + opush('z'); + +#endif + + } + + ip->Printed = printed; + + printed = 0; + + ip->yyline = yyline; + + yyline = 0; + + ip->yyLinpt = yyLinpt; + + yyLinpt = 0; + +/* + + * left over from before stdio + + * + + * ip->ibp = ibp; + + * ibp = cp; + + * + + */ +++# ifdef PC +++ stabinclude( filename ); +++# endif PC + + return (1); + +} + + + +skipbl(ocp) + + char *ocp; + +{ + + register char *cp; + + + + cp = ocp; + + while (*cp == ' ' || *cp == '\t') + + cp++; + + return (cp); + +} + + + + + +/* + + * At the end of an include, + + * close the file, free the input buffer, + + * and restore the environment before + + * the "push", including the value of + + * the z option for pxp and the l option for pi. + + */ + +uninclud() + +{ + + register struct inc *ip; + + + + if (inclev < 0) + + return (0); + +/* + + * left over from before stdio: becomes fclose ( ibp ) + + * + + * close(ibp[0]); + + * free(ibp); + + * + + */ + + fclose ( ibp ); + + ip = &incs[inclev]; + + ibp = ip->ibp; + + yyline = ip->yyline; + + if (inpflist(filename)) { + +#ifdef PI + + opop('l'); + +#endif + +#ifdef PXP + + opop('z'); + +#endif + + } + + filename = ip->filename; + + yyLinpt = ip->yyLinpt; + + /* + + * If we printed out the nested name, + + * then we should print all covered names again. + + * If we didn't print out the nested name + + * we print the uncovered name only if it + + * has not been printed before (unstack). + + */ + + if (printed) { + + printed = 0; + + while (ip >= incs) { + + ip->Printed = 0; + + ip--; + + } + + } else + + printed = ip->Printed; +++# ifdef PC +++ if ( inclev == 0 ) { +++ stabsource( filename ); +++ } else { +++ stabinclude( filename ); +++ } +++# endif PC + + inclev--; + + return (1); + +} diff --cc usr/src/cmd/pi/yyid.c index 0000000000,e13047c185,0000000000..9dc1b188bc mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyid.c +++ b/usr/src/cmd/pi/yyid.c @@@@ -1,0 -1,258 -1,0 +1,255 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyid.c 1.2 10/2/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +#ifdef PI + +extern int *yypv; + +/* + + * Determine whether the identifier whose name + + * is "cp" can possibly be a kind, which is a + + * namelist class. We look through the symbol + + * table for the first instance of cp as a non-field, + + * and at all instances of cp as a field. + + * If any of these are ok, we return true, else false. + + * It would be much better to handle with's correctly, + + * even to just know whether we are in a with at all. + + * + + * Note that we don't disallow constants on the lhs of assignment. + + */ + +identis(cp, kind) + + register char *cp; + + int kind; + +{ + + register struct nl *p; + + int i; + + + + /* + + * Cp is NIL when error recovery inserts it. + + */ + + if (cp == NIL) + + return (1); + + + + /* + + * Record kind we want for possible later use by yyrecover + + */ + + yyidwant = kind; + + yyidhave = NIL; + + i = ( (int) cp ) & 077; + + for (p = disptab[i]; p != NIL; p = p->nl_next) + + if (p->symbol == cp) { + + if (yyidok(p, kind)) + + goto gotit; + + if (p->class != FIELD && p->class != BADUSE) + + break; + + } + + if (p != NIL) + + for (p = p->nl_next; p != NIL; p = p->nl_next) + + if (p->symbol == cp && p->class == FIELD && yyidok(p, kind)) + + goto gotit; + + return (0); + +gotit: + + if (p->class == BADUSE && !Recovery) { + + yybadref(p, OY.Yyeline); + + yypv[0] = NIL; + + } + + return (1); + +} + + + +/* + + * A bad reference to the identifier cp on line + + * line and use implying the addition of kindmask + + * to the mask of kind information. + + */ + +yybaduse(cp, line, kindmask) + + register char *cp; + + int line, kindmask; + +{ + + register struct nl *p, *oldp; + + int i; + + + + i = ( (int) cp ) & 077; + + for (p = disptab[i]; p != NIL; p = p->nl_next) + + if (p->symbol == cp) + + break; + + oldp = p; + + if (p == NIL || p->class != BADUSE) + + p = enter(defnl(cp, BADUSE, 0, 0)); + + p->value[NL_KINDS] =| kindmask; + + yybadref(p, line); + + return (oldp); + +} + + + + /* + + * ud is initialized so that esavestr will allocate + + * sizeof ( struct udinfo ) bytes for the 'real' struct udinfo + + */ + +struct udinfo ud = { ~0 , ~0 , 0}; + +/* + + * Record a reference to an undefined identifier, + + * or one which is improperly used. + + */ + +yybadref(p, line) + + register struct nl *p; + + int line; + +{ + + register struct udinfo *udp; + + + + if (p->chain != NIL && p->chain->ud_line == line) + + return; + + udp = esavestr(&ud); + + udp->ud_line = line; + + udp->ud_next = p->chain; + + p->chain = udp; + +} + + - #define varkinds ((1<class == BADUSE) { + + if (kind == VAR) + + return (p->value[0] & varkinds); + + return (p->value[0] & (1 << kind)); + + } + + if (yyidok1(p, kind)) + + return (1); + + if (yyidhave != NIL) + + yyidhave = IMPROPER; + + else + + yyidhave = p->class; + + return (0); + +} + + + +yyidok1(p, kind) + + register struct nl *p; + + int kind; + +{ + + int i; + + + + switch (kind) { + + case FUNC: - if (p->class == FVAR) - return(1); +++ return ( p -> class == FUNC +++ || p -> class == FVAR +++ || p -> class == FFUNC ); +++ case PROC: +++ return ( p -> class == PROC || p -> class == FPROC ); + + case CONST: + + case TYPE: - case PROC: + + case FIELD: + + return (p->class == kind); + + case VAR: + + return (p->class == CONST || yyisvar(p, NIL)); + + case ARRAY: + + case RECORD: + + return (yyisvar(p, kind)); + + case PTRFILE: + + return (yyisvar(p, PTR) || yyisvar(p, FILET)); + + } + +} + + + +yyisvar(p, class) + + register struct nl *p; + + int class; + +{ + + + + switch (p->class) { + + case FIELD: + + case VAR: + + case REF: + + case FVAR: + + /* + + * We would prefer to return + + * parameterless functions only. + + */ + + case FUNC: +++ case FFUNC: + + return (class == NIL || (p->type != NIL && p->type->class == class)); +++ case PROC: +++ case FPROC: +++ return ( class == NIL ); + + } + + return (0); + +} + +#endif + +#ifdef PXP + +#ifndef DEBUG + +identis() + +{ + + + + return (1); + +} + +#endif + +#ifdef DEBUG + +extern char *classes[]; + + + +char kindchars[] "UCTVAQRDPF"; + +/* + + * Fake routine "identis" for pxp when testing error recovery. + + * Looks at letters in variable names to answer questions + + * about attributes. Mapping is + + * C const_id + + * T type_id + + * V var_id also if any of AQRDF + + * A array_id + + * Q ptr_id + + * R record_id + + * D field_id D for "dot" + + * P proc_id + + * F func_id + + */ + +identis(cp, kind) + + register char *cp; + + int kind; + +{ + + register char *dp; + + char kindch; + + + + /* + + * Don't do anything unless -T + + */ + + if (!typetest) + + return (1); + + + + /* + + * Inserted symbols are always correct + + */ + + if (cp == NIL) + + return (1); + + /* + + * Set up the names for error messages + + */ + + yyidwant = classes[kind]; + + for (dp = kindchars; *dp; dp++) + + if (any(cp, *dp)) { + + yyidhave = classes[dp - kindchars]; + + break; + + } + + + + /* + + * U in the name means undefined + + */ + + if (any(cp, 'U')) + + return (0); + + + + kindch = kindchars[kind]; + + if (kindch == 'V') + + for (dp = "AQRDF"; *dp; dp++) + + if (any(cp, *dp)) + + return (1); + + return (any(cp, kindch)); + +} + +#endif + +#endif diff --cc usr/src/cmd/pi/yylex.c index 0000000000,2f735c6998,0000000000..5773821b9f mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yylex.c +++ b/usr/src/cmd/pi/yylex.c @@@@ -1,0 -1,349 -1,0 +1,338 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yylex.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * Scanner + + */ + +int yylacnt; + + + +#define YYLASIZ 10 + + + +struct yytok Yla[YYLASIZ]; + + + +unyylex(y) + + struct yylex *y; + +{ + + + + if (yylacnt == YYLASIZ) + + panic("unyylex"); + + copy(&Yla[yylacnt], y, sizeof Yla[0]); + + yylacnt++; + + + +} + + + +yylex() + +{ + + register c; + + register **ip; + + register char *cp; + + int f; + + char delim; + + + + if (yylacnt != 0) { + + yylacnt--; + + copy(&Y, &Yla[yylacnt], sizeof Y); + + return (yychar); + + } + + if (c = yysavc) + + yysavc = 0; + + else + + c = readch(); + +#ifdef PXP + + yytokcnt++; + +#endif + + + +next: + + /* + + * skip white space + + */ + +#ifdef PXP + + yywhcnt = 0; + +#endif + + while (c == ' ' || c == '\t') { + +#ifdef PXP + + if (c == '\t') + + yywhcnt++; + + yywhcnt++; + +#endif + + c = readch(); + + } + + yyecol = yycol; + + yyeline = yyline; + + yyefile = filename; + + yyeseqid = yyseqid; + + yyseekp = yylinpt; + + cp = token; + + yylval = yyline; + + switch (c) { + + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g': + + case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n': + + case 'o': case 'p': case 'q': case 'r': case 's': case 't': case 'u': + + case 'v': case 'w': case 'x': case 'y': case 'z': + + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G': + + case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N': + + case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U': + + case 'V': case 'W': case 'X': case 'Y': case 'Z': + + do { + + *cp++ = c; + + c = readch(); + + } while (alph(c) || digit(c)); + + *cp = 0; + + if (opt('s')) + + for (cp = token; *cp; cp++) + + if (*cp >= 'A' && *cp <= 'Z') { + + *cp =| ' '; + + } + + yysavc = c; + + ip = hash(0, 1); + + if (*ip < yykey || *ip >= lastkey) { + + yylval = *ip; + + return (YID); + + } + + yylval = yyline; + + /* + + * For keywords + + * the lexical token + + * is magically retrieved + + * from the keyword table. + + */ + + return ((*ip)[1]); + + case '0': case '1': case '2': case '3': case '4': + + case '5': case '6': case '7': case '8': case '9': + + f = 0; + + do { + + *cp++ = c; + + c = readch(); + + } while (digit(c)); + + if (c == 'b' || c == 'B') { + + /* + + * nonstandard - octal constants + + */ + + if (opt('s')) { + + standard(); + + yerror("Octal constants are non-standard"); + + } + + *cp = 0; + + yylval = copystr(token); + + return (YBINT); + + } + + if (c == '.') { + + c = readch(); + + if (c == '.') { + + *cp = 0; + + yysavc = YDOTDOT; + + yylval = copystr(token); + + return (YINT); + + } + +infpnumb: + + f++; + + *cp++ = '.'; + + if (!digit(c)) { + + yyset(); + + recovered(); + + yerror("Digits required after decimal point"); + + *cp++ = '0'; + + } else + + while (digit(c)) { + + *cp++ = c; + + c = readch(); + + } + + } + + if (c == 'e' || c == 'E') { + + f++; + + *cp++ = c; + + if ((c = yysavc) == 0) + + c = readch(); + + if (c == '+' || c == '-') { + + *cp++ = c; + + c = readch(); + + } + + if (!digit(c)) { + + yyset(); + + yerror("Digits required in exponent"); + + *cp++ = '0'; + + } else + + while (digit(c)) { + + *cp++ = c; + + c = readch(); + + } + + } + + *cp = 0; + + yysavc = c; + + yylval = copystr(token); + + if (f) + + return (YNUMB); + + return (YINT); + + case '"': + + case '`': + + if (!any(bufp + 1, c)) + + goto illch; + + if (!dquote) { + + recovered(); + + dquote++; + + yerror("Character/string delimiter is '"); + + } + + case '\'': + + case '#': + + delim = c; + + do { + + do { + + c = readch(); + + if (c == '\n') { + + yerror("Unmatched %c for string", delim); + + if (cp == token) + + *cp++ = ' ', cp++; + + break; + + } + + *cp++ = c; + + } while (c != delim); + + c = readch(); + + } while (c == delim); + + *--cp = 0; + + if (cp == token) { + + yerror("Null string not allowed"); + + *cp++ = ' '; + + *cp++ = 0; + + } + + yysavc = c; + + yylval = copystr(token); + + return (YSTRING); + + case '.': + + c = readch(); + + if (c == '.') + + return (YDOTDOT); + + if (digit(c)) { + + recovered(); + + yerror("Digits required before decimal point"); + + *cp++ = '0'; + + goto infpnumb; + + } + + yysavc = c; + + return ('.'); + + case '{': + + /* + + * { ... } comment + + */ + +#ifdef PXP + + getcm(c); + +#endif + +#ifdef PI + + c = options(); + + while (c != '}') { + + if (c <= 0) + + goto nonterm; + + if (c == '{') { + + warning(); + + yyset(); + + yerror("{ in a { ... } comment"); + + } + + c = readch(); + + } + +#endif + + c = readch(); + + goto next; + + case '(': + + if ((c = readch()) == '*') { + + /* + + * (* ... *) comment + + */ + +#ifdef PXP + + getcm(c); + + c = readch(); + + goto next; + +#endif + +#ifdef PI + + c = options(); + + for (;;) { + + if (c < 0) { + +nonterm: + + yerror("Comment does not terminate - QUIT"); + + pexit(ERRS); + + } + + if (c == '(' && (c = readch()) == '*') { + + warning(); + + yyset(); + + yerror("(* in a (* ... *) comment"); + + } + + if (c == '*') { + + if ((c = readch()) != ')') + + continue; + + c = readch(); + + goto next; + + } + + c = readch(); + + } + +#endif + + } + + yysavc = c; + + c = '('; + + case ';': + + case ',': + + case ':': + + case '=': + + case '*': + + case '+': + + case '/': + + case '-': + + case '|': + + case '&': + + case ')': + + case '[': + + case ']': + + case '<': + + case '>': + + case '~': + + case '^': + + return (c); + + default: + + switch (c) { + + case YDOTDOT: + + return (c); + + case '\n': + + c = readch(); + +#ifdef PXP + + yytokcnt++; + +#endif + + goto next; + + case '\f': + + c = readch(); + + goto next; + + } + + if (c <= 0) + + return (YEOF); + +illch: + + do + + yysavc = readch(); + + while (yysavc == c); + + yylval = c; + + return (YILLCH); + + } + +} + + + +yyset() + +{ + + + + yyecol = yycol; + + yyeline = yyline; + + yyefile = filename; + + yyseekp = yylinpt; + +} + + + +/* + + * Setuflg trims the current + + * input line to at most 72 chars + + * for the u option. + + */ + +setuflg() + +{ + + + + if (charbuf[71] != '\n') { + + charbuf[72] = '\n'; + + charbuf[73] = 0; + + } + +} diff --cc usr/src/cmd/pi/yymain.c index 0000000000,6da143dab7,0000000000..dc193cdeca mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yymain.c +++ b/usr/src/cmd/pi/yymain.c @@@@ -1,0 -1,171 -1,0 +1,162 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.2 November 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.2 November 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yymain.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" +++#include +++#include "objfmt.h" +++#include + + + +short line = 1; + + + +/* + + * Yymain initializes each of the utility + + * clusters and then starts the processing + + * by calling yyparse. + + */ + +yymain() + +{ + + + + /* + + * Initialize the scanner + + */ + +#ifdef PXP + + if (bracket == 0) { + +#endif + + if (getline() == -1) { + + Perror(filename, "No lines in file"); + + pexit(NOSTART); + + } + +#ifdef PXP + + } else + + yyline = 0; + +#endif + + + +#ifdef PI +++# ifdef OBJ + + magic(); - +++# endif OBJ + +#endif + + /* + + * Initialize the clusters + + * + + initstring(); + + */ + + inithash(); + + inittree(); + +#ifdef PI + + initnl(); + +#endif + + + + /* + + * Process the input + + */ + + yyparse(); + +#ifdef PI +++# ifdef OBJ + + magic2(); - #ifdef DEBUG +++# endif OBJ +++# ifdef DEBUG + + dumpnl(0); - #endif +++# endif + +#endif + +#ifdef PXP + + prttab(); + + if (onefile) { + + extern int outcol; + + + + if (outcol) + + pchr('\n'); + + flush(); + + if (eflg) { + + writef(2, "File not rewritten because of errors\n"); + + pexit(ERRS); + + } - signal(1, 1); - signal(2, 1); +++ signal(SIGHUP, SIG_IGN); +++ signal(SIGINT, SIG_IGN); + + copyfile(); + + } + +#endif + + pexit(eflg ? ERRS : AOK); + +} + + + +#ifdef PXP + +copyfile() + +{ + + extern int fout[]; + + register int c; + + + + close(1); + + if (creat(firstname, 0644) != 1) { + + perror(firstname); + + pexit(ERRS); + + } + + lseek(fout[0], 0l, 0); + + while ((c = read(fout[0], &fout[3], 512)) > 0) { + + if (write(1, &fout[3], c) != c) { + + perror(firstname); + + pexit(ERRS); + + } + + } + +} + +#endif + + + +static - struct { - int magic; - unsigned txt_size; - unsigned data_size; - unsigned bss_size; - unsigned syms_size; - unsigned entry_point; - unsigned tr_size; - unsigned dr_size; - } header; +++struct exec magichdr; + + + +#ifdef PI +++#ifdef OBJ + +magic() + +{ + + - short buf[PX_HEAD_BYTES / sizeof ( short )]; +++ short buf[HEADER_BYTES / sizeof ( short )]; + + unsigned *ubuf = buf; + + register int hf, i; + + - hf = open("/usr/lib/px_header", 0); - if (hf >= 0 && read(hf, buf, PX_HEAD_BYTES) > sizeof header) { - header.magic = ubuf[0]; - header.txt_size = ubuf[1]; - header.data_size = ubuf[2]; - header.bss_size = ubuf[3]; - header.syms_size = ubuf[4]; - header.entry_point = ubuf[5]; - header.tr_size = ubuf[6]; - header.dr_size = ubuf[7]; - for (i = 0; i < PX_HEAD_BYTES / sizeof ( short ); i++) +++ hf = open(PX_HEADER,0); +++ if (hf >= 0 && read(hf, buf, HEADER_BYTES) > sizeof(struct exec)) { +++ magichdr.a_magic = ubuf[0]; +++ magichdr.a_text = ubuf[1]; +++ magichdr.a_data = ubuf[2]; +++ magichdr.a_bss = ubuf[3]; +++ magichdr.a_syms = ubuf[4]; +++ magichdr.a_entry = ubuf[5]; +++ magichdr.a_trsize = ubuf[6]; +++ magichdr.a_drsize = ubuf[7]; +++ for (i = 0; i < HEADER_BYTES / sizeof ( short ); i++) + + word(buf[i]); + + } + + close(hf); - word(0404); + +} +++#endif OBJ + + +++#ifdef OBJ + +magic2() + +{ - int i; +++ struct pxhdr pxhd; + + - if (header.magic != 0407) +++ if (magichdr.a_magic != 0407) + + panic ( "magic2" ); + + pflush(); + + lseek(ofil, 0l, 0); - header.data_size = ( unsigned ) lc - header.txt_size; - header.data_size =- sizeof header; - write(ofil, &header, sizeof header); - lseek(ofil, ( long ) ( PX_HEAD_BYTES - sizeof ( int ) ) , 0); - i = ( ( unsigned ) lc) - PX_HEAD_BYTES; - write(ofil, &i, sizeof (int)); +++ magichdr.a_data = ( unsigned ) lc - magichdr.a_text; +++ magichdr.a_data -= sizeof (struct exec); +++ write(ofil, &magichdr, sizeof(struct exec)); +++ pxhd.objsize = ( ( unsigned ) lc) - HEADER_BYTES; +++ pxhd.maketime = time(0); +++ pxhd.magicnum = MAGICNUM; +++ lseek(ofil, ( long ) ( HEADER_BYTES - sizeof ( pxhd ) ) , 0); +++ write(ofil, &pxhd, sizeof (pxhd)); + +} +++#endif OBJ + +#endif + + + +#ifdef PXP + +writef(i, cp) + +{ + + + + write(i, cp, strlen(cp)); + +} + +#endif diff --cc usr/src/cmd/pi/yyoptions.c index 0000000000,ac75f4db20,0000000000..1145ed00e7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyoptions.c +++ b/usr/src/cmd/pi/yyoptions.c @@@@ -1,0 -1,66 -1,0 +1,74 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyoptions.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * Options processes the option + + * strings which can appear in + + * comments and returns the next character. + + */ + +options() + +{ + + register c, ch; + + register char *optp; + + int ok; + + + + c = readch(); + + if (c != '$') + + return (c); + + do { + + ch = c = readch(); + + switch (c) { + + case 'b': - optp = &opts['b'-'a']; - goto optdig; - case 'x': - optp = &opts['x'-'a']; - goto optdig; - optdig: +++ optp = &opt( 'b' ); + + c = readch(); + + if (!digit(c)) + + return (c); + + *optp = c - '0'; + + c = readch(); + + break; - default: - if (c < 'a' || c > 'z') - return (c); - optp = &opts[c-'a']; +++# ifdef PC +++ case 'C': +++ /* +++ * C is a replacement for t, fake it. +++ */ +++ c = 't'; +++ /* and fall through */ +++ case 'g': +++# endif PC +++ case 'k': +++ case 'l': +++ case 'n': +++ case 'p': +++ case 's': +++ case 't': +++ case 'u': +++ case 'w': +++ case 'z': +++ optp = &opt( c ); + + c = readch(); + + if (c == '+') { + + *optp = 1; + + c = readch(); + + } else if (c == '-') { + + *optp = 0; + + c = readch(); - } else +++ } else { + + return (c); +++ } + + break; +++ default: +++ return (c); + + } + +#ifdef PI0 + + send(ROSET, ch, *optp); + +#endif + + } while (c == ','); - if (opts['u'-'a']) +++ if ( opt( 'u' ) ) + + setuflg(); + + return (c); + +} diff --cc usr/src/cmd/pi/yypanic.c index 0000000000,abdd91ddd1,0000000000..1f27f12a8e mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yypanic.c +++ b/usr/src/cmd/pi/yypanic.c @@@@ -1,0 -1,160 -1,0 +1,149 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yypanic.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +struct yytok oldpos; + +/* + + * The routine yyPerror coordinates the panic when + + * the correction routines fail. Three types of panics + + * are possible - those in a declaration part, those + + * in a statement part, and those in an expression. + + * + + * Declaration part panics consider insertion of "begin", + + * expression part panics will stop on more symbols. + + * The panics are otherwise the same. + + * + + * ERROR MESSAGE SUPPRESSION STRATEGY: August 11, 1977 + + * + + * If the parser has not made at least 2 moves since the last point of + + * error then we want to suppress the supplied error message. + + * Otherwise we print it. + + * We then skip input up to the next solid symbol. + + */ + +yyPerror(cp, kind) + + char *cp; + + register int kind; + +{ + + register int ishifts, brlev; + + + + copy(&oldpos, &Y, sizeof oldpos); + + brlev = 0; + + if (yychar < 0) + + yychar = yylex(); + + for (ishifts = yyshifts; ; yychar = yylex(), yyshifts++) + + switch (yychar) { + + case YILLCH: + + yerror("Illegal character"); + + if (ishifts == yyshifts) + + yyOshifts = 0; + + continue; + + case YEOF: + + goto quiet; + + case ';': + + if (kind == PPROG) + + continue; + + if (kind == PDECL) + + yychar = yylex(); + + goto resume; + + case YEND: + + if (kind == PPROG) + + continue; + + case YPROCEDURE: + + case YFUNCTION: + + goto resume; + + case YLABEL: + + case YTYPE: + + case YCONST: + + case YVAR: + + if (kind == PSTAT) { + + yerror("Declaration found when statement expected"); + + goto quiet; + + } + + case YBEGIN: + + goto resume; + + case YFOR: + + case YREPEAT: + + case YWHILE: + + case YGOTO: + + case YIF: + + if (kind != PDECL) + + goto resume; + + yerror("Expected keyword begin after declarations, before statements"); + + unyylex(&Y); + + yychar = YBEGIN; + + yylval = nullsem(YBEGIN); + + goto quiet; + + case YTHEN: + + case YELSE: + + case YDO: + + if (kind == PSTAT) { + + yychar = yylex(); + + goto resume; + + } + + if (kind == PEXPR) + + goto resume; + + continue; + + case ')': + + case ']': + + if (kind != PEXPR) + + continue; + + if (brlev == 0) + + goto resume; + + if (brlev > 0) + + brlev--; + + continue; + + case '(': + + case '[': + + brlev++; + + continue; + + case ',': + + if (brlev != 0) + + continue; + + case YOF: + + case YTO: + + case YDOWNTO: + + if (kind == PEXPR) + + goto resume; + + continue; + +#ifdef PI + + /* + + * A rough approximation for now + + * Should be much more lenient on suppressing + + * warnings. + + */ + + case YID: + + syneflg++; + + continue; + +#endif + + } + +resume: + + if (yyOshifts >= 2) { + + if (yychar != -1) + + unyylex(&Y); + + copy(&Y, &oldpos, sizeof Y); + + yerror(cp); + + yychar = yylex(); + + } + +quiet: + + if (yyshifts - ishifts > 2 && opt('r')) { + + setpfx('r'); + + yerror("Parsing resumes"); + + } + + /* + + * If we paniced in the statement part, + + * and didn't stop at a ';', then we insert + + * a ';' to prevent the recovery from immediately + + * inserting one and complaining about it. + + */ + + if (kind == PSTAT && yychar != ';') { + + unyylex(&Y); + + yyshifts--; + + yytshifts--; + + yychar = ';'; + + yylval = nullsem(';'); + + } + +} diff --cc usr/src/cmd/pi/yyparse.c index 0000000000,e791c5deb8,0000000000..d8c8afdb90 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyparse.c +++ b/usr/src/cmd/pi/yyparse.c @@@@ -1,0 -1,213 -1,0 +1,202 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyparse.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * Parser for 'yacc' output. + + * Specifially Modified for Berkeley Pascal + + */ + + + +int yystate; /* Current parser state */ + +int *yypv; + +unsigned yytshifts 1; /* Number of "true" shifts */ + + + +/* + + * Parse Tables + + */ + +int yygo[]; + +int yypgo[]; + +int yyr1[]; + +int yyr2[]; + +int yyact[]; + +int yypact[]; + + + +/* + + * Parse and parallel semantic stack + + */ + +int yyv[MAXDEPTH]; + +int yys[MAXDEPTH]; + + + +/* + + * This routine parses the input stream, and + + * returns if it accepts, or if an unrecoverable syntax + + * error is encountered. + + */ + +yyparse() + +{ + + register int *ps, n, *p; + + int paniced, *panicps, idfail; + + + + yystate = 0; + + yychar = yylex(); + + OY.Yychar = -1; + + yyshifts = 3; + + paniced = 0; + + ps = &yys[0]-1; + + yypv = &yyv[0]-1; + +#ifdef PXP + + yypw = &yyw[0]-1; + +#endif + + + +stack: + + /* + + * Push new state and value. + + */ + + if (yypv >= &yyv[MAXDEPTH-1]) { + + yerror("Parse stack overflow"); + + pexit(DIED); + + } + + *++ps = yystate; + + *++yypv = yyval; + +#ifdef PXP + + yypw++; + +#endif + +newstate: + + /* + + * Locate parsing actions for the + + * new parser state. + + */ + + p = &yyact[ yypact[yystate+1] ]; + +actn: + + /* + + * Search the parse actions table + + * for something useful to do. + + * While n is non-positive, it is the negation + + * of the token we are testing for. + + */ + +#ifdef PI + + if ((n = *p++) <= 0) { + + if (yychar < 0) + + yychar = yylex(); + + do + + if ((n =+ yychar) != 0) + + p++; + + while ((n = *p++) <= 0); + + } + +#else + + while ((n = *p++) <= 0) + + if ((n =+ yychar) != 0) + + p++; + +#endif + + switch (n >> 12) { + + + + /* + + * Shift. + + */ + + case 2: + +#ifdef PXP + + yypw[1].Wseqid = yyseqid; + + yypw[1].Wcol = yycol; + +#endif + + OYcopy(); + + yystate = n & 07777; + + yyval = yylval; + +#ifdef PI + + yychar = -1; + +#else + + yychar = yylex(); + +#endif + + yyshifts++; + + yytshifts++; + + goto stack; + + + + /* + + * Reduce. + + */ + + case 3: + + n =& 07777; + + N = yyr2[n]; + + if (N == 1 && OY.Yychar == YID && !yyEactr(n, yypv[0])) { + + idfail = 1; + + goto errin; + + } + + OY.Yychar = -1; + + ps =- N; + + yypv =- N; + +#ifdef PXP + + yypw =- N; + +#endif + + yyval = yypv[1]; + + yyactr(n); + + /* + + * Use goto table to find next state. + + */ + + p = &yygo[yypgo[yyr1[n]]]; + + while (*p != *ps && *p >= 0) + + p =+ 2; + + yystate = p[1]; + + goto stack; + + + + /* + + * Accept. + + */ + + case 4: + + return; + + + + /* + + * Error. + + */ + + case 1: + + idfail = 0; + +errin: + + if ((paniced || yyshifts != 0) && yyrecover(ps, idfail)) { + + paniced = 0; + + ps = Ps; + + yystate = *ps; + + goto newstate; + + } + + /* + + * Find a state where 'error' is a + + * legal shift action. + + */ + + if (paniced && yyshifts <= 0 && ps >= panicps) { + + yypv =- (ps - panicps) + 1; + +#ifdef PXP + + yypw =- (ps - panicps) + 1; + +#endif + + ps = panicps - 1; + + } + + while (ps >= yys) { + + for (p = &yyact[ yypact[*ps+1] ] ; *p <= 0; p=+ 2) + + if (*p == -256) { + + panicps = ps; + + yystate= p[1] & 07777; + + yyOshifts = yyshifts; + + yyshifts = 0; + + paniced = 1; + + goto stack; + + } + + --ps; + + --yypv; + +#ifdef PXP + + --yypw; + +#endif + +#ifdef PI + + if (OY.Yychar != YID) + + syneflg++; + +#endif + + OY.Yychar = -1; + + } + + if (yychar == YEOF) + + yyunexeof(); + + if (yystate == 1) + + yyexeof(); + + yerror("Unrecoverable syntax error - QUIT"); + + return; + + } + + panic("yyparse"); + +} diff --cc usr/src/cmd/pi/yyprint.c index 0000000000,5e19821910,0000000000..efcfc0e89b mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyprint.c +++ b/usr/src/cmd/pi/yyprint.c @@@@ -1,0 -1,108 -1,0 +1,97 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyprint.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +char *tokname(); + + + +STATIC bool bounce; + + + +/* + + * Printing representation of a + + * "character" - a lexical token + + * not in a yytok structure. + + * 'which' indicates which char * you want + + * should always be called as "charname(...,0),charname(...,1)" + + */ + +char * + +charname(ch , which ) + + int ch; + + int which; + +{ + + struct yytok Ych; + + + + Ych.Yychar = ch; + + Ych.Yylval = nullsem(ch); + + return (tokname(&Ych , which )); + +} + + + +/* + + * Printing representation of a token + + * 'which' as above. + + */ + +char * + +tokname(tp , which ) + + register struct yytok *tp; + + int which; + +{ + + register char *cp; + + register struct kwtab *kp; + + char *cp2; + + + + cp2 = ""; + + switch (tp->Yychar) { + + case YCASELAB: + + cp = "case-label"; + + break; + + case YEOF: + + cp = "end-of-file"; + + break; + + case YILLCH: + + cp = "illegal character"; + + break; + + case 256: + + /* error token */ + + cp = "error"; + + break; + + case YID: + + cp = "identifier"; + + break; + + case YNUMB: + + cp = "real number"; + + break; + + case YINT: + + case YBINT: + + cp = "number"; + + break; + + case YSTRING: + + cp = tp->Yylval; + + cp = cp == NIL || cp[1] == 0 ? "character" : "string"; + + break; + + case YDOTDOT: + + cp = "'..'"; + + break; + + default: + + if (tp->Yychar < 256) { + + cp = "'x'\0'x'\0'x'\0'x'"; + + /* + + * for four times reentrant code! + + * used to be: + + * if (bounce = ((bounce + 1) & 1)) + + * cp += 4; + + */ + + bounce = ( bounce + 1 ) % 4; + + cp += (4 * bounce); /* 'x'\0 is 4 chars */ + + cp[1] = tp->Yychar; + + break; + + } + + for (kp = yykey; kp->kw_str != NIL && kp->kw_val != tp->Yychar; kp++) + + continue; + + cp = "keyword "; + + cp2 = kp->kw_str; + + } + + return ( which ? cp2 : cp ); + +} diff --cc usr/src/cmd/pi/yyput.c index 0000000000,a2dce89955,0000000000..53a7e47f61 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyput.c +++ b/usr/src/cmd/pi/yyput.c @@@@ -1,0 -1,285 -1,0 +1,276 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyput.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + +#include "yy.h" + + + +/* + + * Structure describing queued listing lines during the forward move + + * of error recovery. These lines will be stroed by yyoutline during + + * the forward move and flushed by yyoutfl or yyflush when an + + * error occurs or a program termination. + + */ + +struct B { + + int Bmagic; + + int Bline; + + int Bseekp; + + char *Bfile; + + int Bseqid; + + struct B *Bnext; + +} *bottled; + + + +/* + + * Filename gives the current input file, lastname is + + * the last filename we printed, and lastid is the seqid of the last line + + * we printed, to help us avoid printing + + * multiple copies of lines. + + */ + +extern char *filename; + +char *lastname; + +int lastid; + + + +char hadsome; + +char holdbl; + + + +/* + + * Print the current line in the input line + + * buffer or, in a forward move of the recovery, queue it for printing. + + */ + +yyoutline() + +{ + + register struct B *bp; + + + + if (Recovery) { + + bp = tree(6, T_BOTTLE, yyline, yylinpt, filename, yyseqid); + + if (bottled != NIL) + + bp->Bnext = bottled->Bnext, bottled->Bnext = bp; + + else + + bp->Bnext = bp; + + bottled = bp; + + return; + + } + + yyoutfl(yyseqid); + + if (yyseqid != lastid) + + yyprline(charbuf, yyline, filename, yyseqid); + +} + + + +/* + + * Flush all the bottled output. + + */ + +yyflush() + +{ + + + + yyoutfl(32767); + +} + + + +/* + + * Flush the listing to the sequence id toseqid + + */ + +yyoutfl(toseqid) + + int toseqid; + +{ + + register struct B *bp; + + + + bp = bottled; + + if (bp == NIL) + + return; + + bp = bp->Bnext; + + while (bp->Bseqid <= toseqid) { + + yygetline(bp->Bfile, bp->Bseekp, bp->Bline, bp->Bseqid); + + if (bp->Bnext == bp) { + + bottled = NIL; + + break; + + } + + bp = bp->Bnext; + + bottled->Bnext = bp; + + } + +} + + + +FILE *yygetunit = NULL; + +char *yygetfile; + + + +/* + + * Yysync guarantees that the line associated + + * with the current token was the last line + + * printed for a syntactic error message. + + */ + +yysync() + +{ + + + + yyoutfl(yyeseqid); + + if (lastid != yyeseqid) + + yygetline(yyefile, yyseekp, yyeline, yyeseqid); + +} + + + +yySsync() + +{ + + + + yyoutfl(OY.Yyeseqid); + +} + + + +/* + + * Yygetline gets a line from a file after we have + + * lost it. The pointer efile gives the name of the file, + + * seekp its offset in the file, and eline its line number. + + * If this routine has been called before the last file + + * it worked on will be open in yygetunit, with the files + + * name being given in yygetfile. Note that this unit must + + * be opened independently of the unit in use for normal i/o + + * to this file; if it were a dup seeks would seek both files. + + */ + +yygetline(efile, seekp, eline, eseqid) + + char *efile; + + int seekp, eline, eseqid; + +{ + + register int cnt; + + register char *bp; + + char buf[CBSIZE + 1]; + + + + if (lastid == eseqid) + + return; + + if (eseqid == yyseqid) { + + bp = charbuf; + + yyprtd++; + + } else { + + bp = buf; + + if (efile != yygetfile) { + + if ( yygetunit != NULL ) + + fclose( yygetunit ); + + yygetfile = efile; + + yygetunit = fopen( yygetfile , "r" ); + + if (yygetunit < 0) + +oops: + + perror(yygetfile), pexit(DIED); + + } + + if ( fseek( yygetunit , (long) seekp , 0 ) < 0) + + goto oops; + + cnt = fread( bp , sizeof( * bp ) , CBSIZE , yygetunit ); + + if (cnt < 0) + + goto oops; + + bp[cnt] = 0; + + } + + yyprline(bp, eline, efile, eseqid); + +} + + + +yyretrieve() + +{ + + + + yygetline(OY.Yyefile, OY.Yyseekp, OY.Yyeline, OY.Yyeseqid); + +} + + + +/* + + * Print the line in the character buffer which has + + * line number line. The buffer may be terminated by a new + + * line character or a null character. We process + + * form feed directives, lines with only a form feed character, and + + * suppress numbering lines which are empty here. + + */ + +yyprline(buf, line, file, id) + + register char *buf; + + int line; + + char *file; + + int id; + +{ + + + + lastid = id; + + if (buf[0] == '\f' && buf[1] == '\n') { + + printf("\f\n"); + + hadsome = 0; + + holdbl = 0; + + return; + + } + + if (holdbl) { + + pchr('\n'); + + holdbl = 0; + + } + + if (buf[0] == '\n') + + holdbl = 1; + + else { + + yysetfile(file); + + yyprintf(buf, line); + + } + + hadsome = 1; + +} + + + +yyprintf(cp, line) + + register char *cp; + + int line; + +{ + + + + printf("%6d ", line); + + while (*cp != 0 && *cp != '\n') + + pchr(graphic(*cp++)); + + pchr('\n'); + +} + + + +graphic(ch) + + register CHAR ch; + +{ + + + + switch (ch) { + + default: + + if (ch >= ' ') + + return (ch); + + case 0177: + + return ('?'); + + case '\n': + + case '\t': + + return (ch); + + } + +} + + + +extern int nopflg; + + + +char printed 1; + +/* + + * Set the current file name to be file, + + * printing the name, or a header on a new + + * page if required. +++ * there is another yysetfile in error.c +++ * this one is for PI and PXP that one is for PI1 + + */ + +yysetfile(file) + + register char *file; + +{ + + + +#ifdef PXP + + if (nopflg == 1) + + return; + +#endif + + + + if (lastname == file) + + return; + + if (file == filename && opt('n') && (printed & 02) == 0) { + + printed =| 02; + + header(); + + } else + + yyputfn(file); + + lastname = file; + +} + + + +/* + + * Put out an include file name + + * if an error occurs but the name has + + * not been printed (or if another name + + * has been printed since it has). + + */ + +yyputfn(cp) + + register char *cp; + +{ + + extern int outcol; + + + + if (cp == lastname && printed) + + return; + + lastname = cp; + + printed = 1; + +#ifdef PXP + + if (outcol) + + pchr('\n'); + +#endif + + gettime( cp ); + + printf("%s %s:\n" , myctime( &tvec ) , cp ); + + hadsome = 1; + +} diff --cc usr/src/cmd/pi/yyrecover.c index 0000000000,bbad208c45,0000000000..7d8ffd3e54 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyrecover.c +++ b/usr/src/cmd/pi/yyrecover.c @@@@ -1,0 -1,871 -1,0 +1,860 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyrecover.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * Very simplified version of Graham-Rhodes error recovery + + * method for LALR parsers. Backward move is embodied in + + * default reductions of the yacc parser until an error condition + + * is reached. Forward move is over a small number of input tokens + + * and cannot "condense". The basic corrections are: + + * + + * 1) Delete the input token. + + * + + * 2) Replace the current input with a legal input. + + * + + * 3) Insert a legal token. + + * + + * All corrections are weighted, considered only if they allow + + * at least two shifts, and the cost of a correction increases if + + * it allows shifting over only a part of the lookahead. + + * + + * Another error situation is that which occurs when an identifier "fails" + + * a reduction because it is not the required "class". + + * In this case, we also consider replacing this identifier, which has + + * already been shifted over, with an identifier of the correct class. + + * + + * Another correction performed here is unique symbol insertion. + + * If the current state admits only one input, and no other alternative + + * correction presents itself, then that symbol will be inserted. + + * There is a danger in this of looping, and it is handled + + * by counting true shifts over input (see below). + + * + + * + + * A final class of corrections, considered only when the error + + * occurred immediately after a shift over a terminal, involves + + * the three basic corrections above, but with the point of error + + * considered to be before this terminal was shifted over, effectively + + * "unreading" this terminal. This is a feeble attempt at elimination + + * of the left-right bias and because "if" has a low weight and some + + * statements are quite simple i.e. + + * + + * cse ch of ... + + * + + * we can get a small number of errors. The major deficiency of + + * this is that we back up only one token, and that the forward + + * move is over a small number of tokens, often not enough to really + + * tell what the input should be, e.g. in + + * + + * a[i] > a[i - 1] ... + + * + + * In such cases a bad identifier (misspelled keyword) or omitted + + * keyword will be change or inserted as "if" as it has the lowest cost. + + * This is not terribly bad, as "if"s are most common. + + * This also allows the correction of other errors. + + * + + * This recovery depends on the default reductions which delay + + * noticing the error until the parse reaches a state where the + + * relevant "alternatives" are visible. Note that it does not + + * consider tokens which will cause reductions before being + + * shifted over. This requires the grammar to be written in a + + * certain way for the recovery to work correctly. + + * In some sense, also, the recovery suffers because we have + + * LALR(1) tables rather than LR(1) tables, e.g. in + + * + + * if rec.field < rec2,field2 then + + */ + + + +/* + + * Definitions of possible corrective actions + + */ + +#define CPANIC 0 + +#define CDELETE 1 + +#define CREPLACE 2 + +#define CINSERT 3 + +#define CUNIQUE 4 + +#define CCHIDENT 5 + + + +/* + + * Multiplicative cost factors for corrective actions. + + * + + * When an error occurs we take YCSIZ - 1 look-ahead tokens. + + * If a correction being considered will shift over only part of + + * that look-ahead, it is not completely discarded, but rather + + * "weighted", its cost being multiplied by a weighting factor. + + * For a correction to be considered its weighted cost must be less + + * than CLIMIT. + + * + + * Non-weighted costs are considered: + + * + + * LOW <= 3 + + * MEDIUM 4,5 + + * HIGH >= 6 + + * + + * CURRENT WEIGHTING STRATEGY: Aug 20, 1977 + + * + + * For all kinds of corrections we demand shifts over two symbols. + + * Corrections have high weight even after two symbol + + * shifts because the costs for deleting and inserting symbols are actually + + * quite low; we do not want to change weighty symbols + + * on inconclusive evidence. + + * + + * The weights are the same after the third look ahead. + + * This prevents later, unrelated errors from causing "funny" + + * biases of the weights toward one type of correction. + + * + + * Current look ahead is 5 symbols. + + */ + + + +/*** CLIMIT is defined in yy.h for yycosts ***/ + +#define CPRLIMIT 50 + +#define CCHIDCOST 3 + + + +char insmult[8] = {INFINITY, INFINITY, INFINITY, 15, 8, 6, 3, 1}; + +char repmult[7] = {INFINITY, INFINITY, INFINITY, 8, 6, 3, 1}; + +char delmult[6] = {INFINITY, INFINITY, INFINITY, 6, 3, 1}; + + + +#define NOCHAR -1 + + + +#define Eprintf if (errtrace) printf + +#define Tprintf if (testtrace) printf + + + +/* + + * Action arrays of the parser needed here + + */ + +int yyact[], yypact[], *yypv; + + + +/* + + * Yytips is the tip of the stack when using + + * the function loccor to check for local + + * syntactic correctness. As we don't want + + * to copy the whole parser stack, but want + + * to simulate parser moves, we "split" + + * the parser stack and keep the tip here. + + */ + +#define YYTIPSIZ 16 + +int yytips[YYTIPSIZ], yytipct; + +int yytipv[YYTIPSIZ]; + + + +/* + + * The array YC saves the lookahead tokens for the + + * forward moves. + + * Yccnt is the number of tokens in the YC array. + + */ + +#define YCSIZ 6 + + + +int yCcnt; + +struct yytok YC0[YCSIZ + 1]; + +struct yytok *YC; + + + +/* + + * YCps gives the top of stack at + + * the point of error. + + */ + + + +bool yyunique 1; + + + +STATIC unsigned yyTshifts; + + + +/* + + * Cact is the corrective action we have decided on + + * so far, ccost its cost, and cchar the associated token. + + * Cflag tells if the correction is over the previous input token. + + */ + +int cact, ccost, cchar, cflag; + + + +/* + + * ACtok holds the token under + + * consideration when examining + + * the lookaheads in a state. + + */ + +struct yytok ACtok; + + + +#define acchar ACtok.Yychar + +#define aclval ACtok.Yylval + + + +/* + + * Make a correction to the current stack which has + + * top of stack pointer Ps. + + */ + +yyrecover(Ps0, idfail) + + int *Ps0, idfail; + +{ + + register int c, i; + + int yyrwant, yyrhave; + + + +#ifdef PI + + Recovery = 1; + +#endif + + + + YC = &YC0[1]; + +#ifdef DEBUG + + if (errtrace) { + + setpfx('p'); + + yerror("Point of error"); + + printf("States %d %d ...", Ps0[0], Ps0[-1]); + + if (idfail) + + printf(" [Idfail]"); + + pchr('\n'); + + printf("Input %s%s", tokname(&Y , 0) + + , tokname(&Y , 1)); + + } + + + +#endif + + /* + + * We first save the current input token + + * and its associated semantic information. + + */ + + if (yychar < 0) + + yychar = yylex(); + + copy(&YC[0], &Y, sizeof Y); + + + + /* + + * Set the default action and cost + + */ + + cact = CPANIC, ccost = CLIMIT, cflag = 0; + + + + /* + + * Peek ahead + + */ + + for (yCcnt = 1; yCcnt < YCSIZ; yCcnt++) { + + yychar = yylex(); + + copy(&YC[yCcnt], &Y, sizeof YC[0]); + +#ifdef DEBUG + + Eprintf(" | %s%s", tokname(&YC[yCcnt] , 0 ) + + , tokname(&YC[yCcnt] , 1 )); + +#endif + + } + +#ifdef DEBUG + + Eprintf("\n"); + +#endif + + + + /* + + * If we are here because a reduction failed, try + + * correcting that. + + */ + + if (idfail) { + + /* + + * Save the particulars about + + * the kind of identifier we want/have. + + */ + + yyrwant = yyidwant; + + yyrhave = yyidhave; + +#ifdef DEBUG + + Tprintf(" Try Replace %s identifier with %s identifier cost=%d\n", + + classes[yyidhave], classes[yyidwant], CCHIDCOST); + +#endif + + + + /* + + * Save the semantics of the ID on the + + * stack, and null them out to free + + * up the reduction in question. + + */ + + i = yypv[0]; + + yypv[0] = nullsem(YID); + + c = correct(NOCHAR, 0, CCHIDCOST, &repmult[2], Ps0, yypv); + + yypv[0] = i; + +#ifdef DEBUG + + if (c < CPRLIMIT || fulltrace) + + Eprintf("Cost %2d Replace %s identifier with %s identifier\n", c, classes[yyrhave], classes[yyrwant]); + +#endif + + if (c < ccost) + + cact = CCHIDENT, ccost = c, cchar = YID; + + } + + + + /* + + * First try correcting the state we are in + + */ + + trystate(Ps0, yypv, 0, &insmult[1], &delmult[1], &repmult[1]); + + + + /* + + * Now, if we just shifted over a terminal, try + + * correcting it. + + */ + + if (OY.Yychar != -1 && OY.Yylval != nullsem(OY.Yychar)) { + + YC--; + + copy(&YC[0], &OY, sizeof YC[0]); + + trystate(Ps0 - 1, yypv - 1, 1, insmult, delmult, repmult); + + if (cflag == 0) + + YC++; + + else { + + yypv--; + +#ifdef PXP + + yypw--; + +#endif + + Ps0--; + + yCcnt++; + + } + + } + + + + /* + + * Restoring the first look ahead into + + * the scanner token allows the error message + + * routine to print the error message with the text + + * of the correct line. + + */ + + copy(&Y, &YC[0], sizeof Y); + + + + /* + + * Unique symbol insertion. + + * + + * If there was no reasonable correction found, + + * but only one input to the parser is acceptable + + * we report that, and try it. + + * + + * Special precautions here to prevent looping. + + * The number of true inputs shifted over at the point + + * of the last unique insertion is recorded in the + + * variable yyTshifts. If this is not less than + + * the current number in yytshifts, we do not insert. + + * Thus, after one unique insertion, no more unique + + * insertions will be made until an input is shifted + + * over. This guarantees termination. + + */ + + if (cact == CPANIC && !idfail) { + + register int *ap; + + + + ap = &yyact[yypact[*Ps0 + 1]]; + + if (*ap == -ERROR) + + ap =+ 2; + + if (ap[0] <= 0 && ap[2] > 0) { + + cchar = -ap[0]; + + if (cchar == YEOF) + + yyexeof(); + + if (cchar != ERROR && yyTshifts < yytshifts) { + + cact = CUNIQUE; + +#ifdef DEBUG + + Eprintf("Unique symbol %s%s\n" + + , charname(cchar , 0 ) + + , charname(cchar , 1 )); + +#endif + + /* + + * Note that the inserted symbol + + * will not be counted as a true input + + * (i.e. the "yytshifts--" below) + + * so that a true shift will be needed + + * to make yytshifts > yyTshifts. + + */ + + yyTshifts = yytshifts; + + } + + } + + } + + + + /* + + * Set up to perform the correction. + + * Build a token appropriate for replacement + + * or insertion in the yytok structure ACchar + + * having the attributes of the input at the + + * point of error. + + */ + + copy(&ACtok, &YC[0], sizeof ACtok); + + acchar = cchar; + + aclval = nullsem(acchar); + + if (aclval != NIL) + + recovered(); + + switch (cact) { + + /* + + * Panic, just restore the + + * lookahead and return. + + */ + + case CPANIC: + + setpfx('E'); + + if (idfail) { + + copy(&Y, &OY, sizeof Y); + + if (yyrhave == NIL) { + +#ifdef PI + + if (yybaduse(yypv[0], yyeline, ISUNDEF) == NIL) + +#endif + + yerror("Undefined identifier"); + + } else { + + yerror("Improper %s identifier", classes[yyrhave]); + +#ifdef PI + + yybaduse(yypv[0], yyeline, NIL); + +#endif + + } + + /* + + * Suppress message from panic routine + + */ + + yyshifts = 1; + + } + + i = 0; + + /* Note that on one path we dont touch yyshifts ! */ + + break; + + /* + + * Delete the input. + + * Mark this as a shift over true input. + + * Restore the lookahead starting at + + * the second token. + + */ + + case CDELETE: + + if (ccost != 0) + + yerror("Deleted %s%s", tokname(&YC[0] , 0 ) + + , tokname(&YC[0] , 1 )); + + yytshifts++; + + i = 1; + + yyshifts = 0; + + break; + + /* + + * Replace the input with a new token. + + */ + + case CREPLACE: + + if (acchar == YEOF) + + yyexeof(); + + if (acchar == YEND) + + aclval = NIL; + + yerror("Replaced %s%s with a %s%s", + + tokname(&YC[0] , 0 ), + + tokname(&YC[0] , 1 ), + + tokname(&ACtok , 0 ), + + tokname(&ACtok , 1 )); + + copy(&YC[0], &ACtok, sizeof YC[0]); + + i = 0; + + yyshifts = 0; + + break; + + /* + + * Insert a token. + + * Don't count this token as a true input shift. + + * For inserted "end"s pas.y is responsible + + * for the error message later so suppress it. + + * Restore all the lookahead. + + */ + + case CINSERT: + + if (acchar == YEOF) + + yyexeof(); + + if (acchar != YEND) + + yerror("Inserted %s%s", + + tokname(&ACtok , 0 ), + + tokname(&ACtok , 1 )); + + yytshifts--; + + i = 0; + + yyshifts = 0; + + break; + + /* + + * Make a unique symbol correction. + + * Like an insertion but a different message. + + */ + + case CUNIQUE: + + setpfx('E'); + + yerror("Expected %s%s", + + tokname(&ACtok , 0 ), + + tokname(&ACtok , 1 )); + + yytshifts--; + + i = 0; + + if (ccost == 0 || yyunique) + + yyshifts = 0; + + else + + yyshifts = -1; + + break; + + /* + + * Change an identifier's type + + * to make it work. + + */ + + case CCHIDENT: + + copy(&Y, &OY, sizeof Y); + +#ifdef PI + + i = 1 << yyrwant; + +#endif + + if (yyrhave == NIL) { + + yerror("Undefined %s", classes[yyrwant]); + +#ifdef PI + + i =| ISUNDEF; + +#endif + + } else + + yerror("Replaced %s id with a %s id", classes[yyrhave], classes[yyrwant]); + +#ifdef PI + + yybaduse(yypv[0], yyeline, i); + +#endif + + yypv[0] = nullsem(YID); + + i = 0; + + yyshifts = 0; + + break; + + } + + + + /* + + * Restore the desired portion of the lookahead, + + * and possibly the inserted or unique inserted token. + + */ + + for (yCcnt--; yCcnt >= i; yCcnt--) + + unyylex(&YC[yCcnt]); + + if (cact == CINSERT || cact == CUNIQUE) + + unyylex(&ACtok); + + + + /* + + * Put the scanner back in sync. + + */ + + yychar = yylex(); + + + + /* + + * We succeeded if we didn't "panic". + + */ + + Recovery = 0; + + Ps = Ps0; + + return (cact != CPANIC); + +} + + + +yyexeof() + +{ + + + + yerror("End-of-file expected - QUIT"); + + pexit(ERRS); + +} + + + +yyunexeof() + +{ + + + + yerror("Unexpected end-of-file - QUIT"); + + pexit(ERRS); + +} + + + +/* + + * Try corrections with the state at Ps0. + + * Flag is 0 if this is the top of stack state, + + * 1 if it is the state below. + + */ + +trystate(Ps0, Pv0, flag, insmult, delmult, repmult) + + int *Ps0, *Pv0, flag; + + char *insmult, *delmult, *repmult; + +{ + + /* + + * C is a working cost, ap a pointer into the action + + * table for looking at feasible alternatives. + + */ + + register int c, *ap; + + int i, *actions; + + + +#ifdef DEBUG + + Eprintf("Trying state %d\n", *Ps0); + +#endif + + /* + + * Try deletion. + + * Correct returns a cost. + + */ + +#ifdef DEBUG + + Tprintf(" Try Delete %s%s cost=%d\n", + + tokname(&YC[0] , 0 ), + + tokname(&YC[0] , 1 ), + + delcost(YC[0].Yychar)); + +#endif + + c = delcost(YC[0].Yychar); + +#ifndef DEBUG + + if (c < ccost) { + +#endif + + c = correct(NOCHAR, 1, c, delmult, Ps0, Pv0); + +#ifdef DEBUG + + if (c < CPRLIMIT || fulltrace) + + Eprintf("Cost %2d Delete %s%s\n", c, + + tokname(&YC[0] , 0 ), + + tokname(&YC[0] , 1 )); + +#endif + + if (c < ccost) + + cact = CDELETE, ccost = c, cflag = flag; + +#ifndef DEBUG + + } + +#endif + + + + /* + + * Look at the inputs to this state + + * which will cause parse action shift. + + */ + + aclval = NIL; + + ap = &yyact[yypact[*Ps0 + 1]]; + + + + /* + + * Skip action on error to + + * detect true unique inputs. + + * Error action is always first. + + */ + + if (*ap == -ERROR) + + ap=+ 2; + + + + /* + + * Loop through the test actions + + * for this state. + + */ + + for (actions = ap; *ap <= 0; ap =+ 2) { + + /* + + * Extract the token of this action + + */ + + acchar = -*ap; + + + + /* + + * Try insertion + + */ + +#ifdef DEBUG + + Tprintf(" Try Insert %s%s cost=%d\n" + + , charname(acchar , 0 ) + + , charname(acchar , 1 ) + + , inscost(acchar)); + +#endif + + c = inscost(acchar, YC[0].Yychar); + +#ifndef DEBUG + + if (c < ccost) { + +#endif + + if (c == 0) { + + c = correct(acchar, 0, 1, insmult + 1, Ps0, Pv0); + +#ifdef DEBUG + + Eprintf("Cost %2d Freebie %s%s\n", c + + , charname(acchar , 0 ) + + , charname(acchar , 1 )); + +#endif + + if (c < ccost) + + cact = CUNIQUE, ccost = 0, cchar = acchar, cflag = flag; + + } else { + + c = correct(acchar, 0, c, insmult, Ps0, Pv0); + +#ifdef DEBUG + + if (c < CPRLIMIT || fulltrace) + + Eprintf("Cost %2d Insert %s%s\n", c + + , charname(acchar , 0 ) + + , charname(acchar , 1 )); + +#endif + + if (c < ccost) + + cact = CINSERT, ccost = c, cchar = acchar, cflag = flag; + + } + +#ifndef DEBUG + + } + +#endif + + + + /* + + * Try replacement + + */ + +#ifdef DEBUG + + Tprintf(" Try Replace %s%s with %s%s cost=%d\n", + + tokname(&YC[0] , 0 ), + + tokname(&YC[0] , 1 ), + + charname(acchar , 0 ), + + charname(acchar , 1 ), + + repcost(YC[0].Yychar, acchar)); + +#endif + + c = repcost(YC[0].Yychar, acchar); + +#ifndef DEBUG + + if (c < ccost) { + +#endif + + c = correct(acchar, 1, repcost(YC[0].Yychar, acchar), repmult, Ps0, Pv0); + +#ifdef DEBUG + + if (c < CPRLIMIT || fulltrace) + + Eprintf("Cost %2d Replace %s%s with %s%s\n", + + c, + + tokname(&YC[0] , 0 ), + + tokname(&YC[0] , 1 ), + + tokname(&ACtok , 0 ), + + tokname(&ACtok , 1 )); + +#endif + + if (c < ccost) + + cact = CREPLACE, ccost = c, cchar = acchar, cflag = flag; + +#ifndef DEBUG + + } + +#endif + + } + +} + + + +int *yCpv; + +char yyredfail; + + + +/* + + * The ntok structure is used to build a + + * scanner structure for tokens inserted + + * from the argument "fchar" to "correct" below. + + */ + +static struct yytok ntok; + + + +/* + + * Compute the cost of a correction + + * C is the base cost for it. + + * Fchar is the first input character from + + * the current state, NOCHAR if none. + + * The rest of the inputs come from the array + + * YC, starting at origin and continuing to the + + * last character there, YC[yCcnt - 1].Yychar. + + * + + * The cost returned is INFINITE if this correction + + * allows no shifts, otherwise is weighted based + + * on the number of shifts this allows against the + + * maximum number possible with the available lookahead. + + */ + +correct(fchar, origin, c, multvec, Ps0, Pv0) + + register int fchar, c; + + int origin; + + char *multvec; + + int *Ps0, *Pv0; + +{ + + register char *mv; + + + + /* + + * Ps is the top of the parse stack after the most + + * recent local correctness check. Loccor returns + + * NIL when we cannot shift. + + */ + + register int *ps; + + + + yyredfail = 0; + + /* + + * Initialize the tip parse and semantic stacks. + + */ + + ps = Ps0; + + yytips[0] = *ps; + + ps--; + + yytipv[0] = Pv0[0]; + + yCpv = Pv0 - 1; + + yytipct = 1; + + + + /* + + * Shift while possible. + + * Adjust cost as necessary. + + */ + + mv = multvec; + + do { + + if (fchar != NOCHAR) { + + copy(&ntok, &YC[0], sizeof ntok); + + ntok.Yychar = fchar, ntok.Yylval = nullsem(fchar); + + fchar = NOCHAR; + + ps = loccor(ps, &ntok); + + } else + + ps = loccor(ps, &YC[origin++]); + + if (ps == NIL) { + + if (yyredfail && mv > multvec) + + mv--; + + c =* *mv; + + break; + + } + + mv++; + + } while (*mv != 1); + + return (c); + +} + + + +extern int yygo[], yypgo[], yyr1[], yyr2[]; + +/* + + * Local syntactic correctness check. + + * The arguments to this routine are a + + * top of stack pointer, ps, and an input + + * token tok. Also, implicitly, the contents + + * of the yytips array which contains the tip + + * of the stack, and into which the new top + + * state on the stack will be placed if we shift. + + * + + * If we succeed, we return a new top of stack + + * pointer, else we return NIL. + + */ + +loccor(ps, ntok) + + int *ps; + + struct yytok *ntok; + +{ + + register int *p, n; + + register int nchar; + + int i; + + + + if (ps == NIL) + + return (NIL); + + nchar = ntok->Yychar; + + yyeline = ntok->Yyeline; + +#ifdef DEBUG + + Tprintf(" Stack "); + + for (i = yytipct - 1; i >= 0; i--) + + Tprintf("%d ", yytips[i]); + + Tprintf("| %d, Input %s%s\n", *ps + + , charname(nchar , 0 ) + + , charname(nchar , 1 )); + +#endif + + /* + + * As in the yacc parser yyparse, + + * p traces through the action list + + * and "n" is the information associated + + * with the action. + + */ + +newstate: + + p = &yyact[ yypact[yytips[yytipct - 1]+1] ]; + + + +actn: + + /* + + * Search the parse actions table + + * for something useful to do. + + * While n is non-positive, it is the + + * arithmetic inverse of the token to be tested. + + * This allows a fast check. + + */ + + while ((n = *p++) <= 0) + + if ((n =+ nchar) != 0) + + p++; + + switch (n >> 12) { + + /* + + * SHIFT + + */ + + case 2: + + n =& 07777; + + yyredfail = 0; + + if (nchar == YID) + + yyredfail++; + + if (yytipct == YYTIPSIZ) { + +tipover: + +#ifdef DEBUG + + Tprintf("\tTIP OVFLO\n"); + +#endif + + return (NIL); + + } + + yytips[yytipct] = n; + + yytipv[yytipct] = ntok->Yylval; + + yytipct++; + +#ifdef DEBUG + + Tprintf("\tShift to state %d\n", n); + +#endif + + return (ps); + + /* + + * REDUCE + + */ + + case 3: + + n =& 07777; + + if (yyEactr(n, yytipv[yytipct - 1]) == 0) { + +#ifdef DEBUG + + Tprintf("\tYyEactr objects: have %s id, want %s id\n", classes[yyidhave], classes[yyidwant]); + +#endif + + return (NIL); + + } + + yyredfail = 0; + + i = yyr2[n]; + +#ifdef DEBUG + + Tprintf("\tReduce, length %d,", i); + +#endif + + if (i > yytipct) { + + i =- yytipct; + + yytipct = 0; + + ps =- i; + + yCpv =- i; + + } else + + yytipct =- i; + + if (yytipct >= YYTIPSIZ) + + goto tipover; + + /* + + * Use goto table to find next state + + */ + + p = &yygo[yypgo[yyr1[n]]]; + + i = yytipct ? yytips[yytipct - 1] : *ps; + + while (*p != i && *p >= 0) + + p =+ 2; + +#ifdef DEBUG + + Tprintf(" new state %d\n", p[1]); + +#endif + + yytips[yytipct] = p[1]; + + yytipct++; + + goto newstate; + + /* + + * ACCEPT + + */ + + case 4: + +#ifdef DEBUG + + Tprintf("\tAccept\n"); + +#endif + + return (ps); + + /* + + * ERROR + + */ + + case 1: + +#ifdef DEBUG + + Tprintf("\tError\n"); + +#endif + + return (0); + + } + + panic("loccor"); + +} diff --cc usr/src/cmd/pi/yyseman.c index 0000000000,1353a1d269,0000000000..135e2d5447 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yyseman.c +++ b/usr/src/cmd/pi/yyseman.c @@@@ -1,0 -1,47 -1,0 +1,36 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pi - Pascal interpreter code translator - * - * Charles Haley, Bill Joy UCB - * Version 1.1 February 1978 - * - * - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yyseman.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "yy.h" + + + +/* + + * Assign semantics to a generated token + + * + + * Most terminals have a semantic value the current + + * input line. If they are generated they are flagged + + * by having this number negated. + + * + + * The terminals which have true semantics such + + * as identifiers and strings are instead given + + * semantic value NIL here - we do not attempt + + * to do repair, e.g. by giving generated integers + + * the value 1, etc. + + */ + +nullsem(ch) + + int ch; + +{ + + + + switch (ch) { + + case YID: + + case YINT: + + case YNUMB: + + case YBINT: + + case YSTRING: + + return (NIL); + + default: + + return (-yyeline); + + } + +} diff --cc usr/src/cmd/pi/yytree.c index 0000000000,686357edf8,0000000000..4a1afe5f3b mode 000000,100644,000000..100644 --- a/usr/src/cmd/pi/yytree.c +++ b/usr/src/cmd/pi/yytree.c @@@@ -1,0 -1,161 -1,0 +1,156 @@@@ + +/* Copyright (c) 1979 Regents of the University of California */ - # - /* - * pxp - Pascal execution profiler - * - * Bill Joy UCB - * Version 1.1 February 1978 - */ + + - #include "whoami" +++static char sccsid[] = "@(#)yytree.c 1.1 8/27/80"; +++ +++#include "whoami.h" + +#include "0.h" + +#include "tree.h" + + + +extern int *spacep; + + + +/* + + * LIST MANIPULATION ROUTINES + + * + + * The grammar for Pascal is written left recursively. + + * Because of this, the portions of parse trees which are to resemble + + * lists are in the somewhat inconvenient position of having + + * the nodes built from left to right, while we want to eventually + + * have as semantic value the leftmost node. + + * We could carry the leftmost node as semantic value, but this + + * would be inefficient as to add a new node to the list we would + + * have to chase down to the end. Other solutions involving a head + + * and tail pointer waste space. + + * + + * The simple solution to this apparent dilemma is to carry along + + * a pointer to the leftmost node in a list in the rightmost node + + * which is the current semantic value of the list. + + * When we have completed building the list, we can retrieve this + + * left end pointer very easily; neither adding new elements to the list + + * nor finding the left end is thus expensive. As the bottommost node + + * has an unused next pointer in it, no space is wasted either. + + * + + * The nodes referred to here are of the T_LISTPP type and have + + * the form: + + * + + * T_LISTPP some_pointer next_element + + * + + * Here some_pointer points to the things of interest in the list, + + * and next_element to the next thing in the list except for the + + * rightmost node, in which case it points to the leftmost node. + + * The next_element of the rightmost node is of course zapped to the + + * NIL pointer when the list is completed. + + * + + * Thinking of the lists as tree we heceforth refer to the leftmost + + * node as the "top", and the rightmost node as the "bottom" or as + + * the "virtual root". + + */ + + + +/* + + * Make a new list + + */ + +newlist(new) + + register int *new; + +{ + + + + if (new == NIL) + + return (NIL); + + return (tree3(T_LISTPP, new, spacep)); + +} + + + +/* + + * Add a new element to an existing list + + */ + +addlist(vroot, new) + + register int *vroot; + + int *new; + +{ + + register int *top; + + + + if (new == NIL) + + return (vroot); + + if (vroot == NIL) + + return (newlist(new)); + + top = vroot[2]; + + vroot[2] = spacep; + + return (tree3(T_LISTPP, new, top)); + +} + + + +/* + + * Fix up the list which has virtual root vroot. + + * We grab the top pointer and return it, zapping the spot + + * where it was so that the tree is not circular. + + */ + +fixlist(vroot) + + register int *vroot; + +{ + + register int *top; + + + + if (vroot == NIL) + + return (NIL); + + top = vroot[2]; + + vroot[2] = NIL; + + return (top); + +} + + + + + +/* + + * Set up a T_VAR node for a qualified variable. + + * Init is the initial entry in the qualification, + + * or NIL if there is none. + + * + + * if we are building pTrees, there has to be an extra slot for + + * a pointer to the namelist entry of a field, if this T_VAR refers + + * to a field name within a WITH statement. + + * this extra field is set in lvalue, and used in VarCopy. + + */ + +setupvar(var, init) + + char *var; + + register int *init; + +{ + + + + if (init != NIL) + + init = newlist(init); + +# ifndef PTREE + + return (tree4(T_VAR, NOCON, var, init)); + +# else + + return tree5( T_VAR , NOCON , var , init , NIL ); + +# endif + +} + + + + /* + + * set up a T_TYREC node for a record + + * + + * if we are building pTrees, there has to be an extra slot for + + * a pointer to the namelist entry of the record. + + * this extra field is filled in in gtype, and used in RecTCopy. + + */ + +setuptyrec( line , fldlst ) + + int line; + + int *fldlst; + + { + + + +# ifndef PTREE + + return tree3( T_TYREC , line , fldlst ); + +# else + + return tree4( T_TYREC , line , fldlst , NIL ); + +# endif + + } + + + + /* + + * set up a T_FIELD node for a field. + + * + + * if we are building pTrees, there has to be an extra slot for + + * a pointer to the namelist entry of the field. + + * this extra field is set in lvalue, and used in SelCopy. + + */ + +setupfield( field , other ) + + int *field; + + int *other; + + { + + + +# ifndef PTREE + + return tree3( T_FIELD , field , other ); + +# else + + return tree4( T_FIELD , field , other , NIL ); + +# endif + + } diff --cc usr/src/cmd/pr.c index 0000000000,880661e8be,0000000000..01509836a9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/pr.c +++ b/usr/src/cmd/pr.c @@@@ -1,0 -1,421 -1,0 +1,436 @@@@ +++static char *sccsid = "@(#)pr.c 4.1 (Berkeley) 10/1/80"; + +/* + + * print file with headings + + * 2+head+2+page[56]+5 + + */ + + + +#include + +#include + +#include + +#include + + +++/* Making putcp a macro sped things up by 14%. */ +++#define putcp(c) if (page >= fpage) putchar(c) +++ + +int ncol = 1; + +char *header; + +int col; + +int icol; + +FILE *file; + +char *bufp; + +#define BUFS 6720 + +char buffer[BUFS]; /* for multi-column output */ + +char obuf[BUFSIZ]; + +#define FF 014 + +int line; + +char *colp[72]; + +int nofile; + +char isclosed[10]; + +FILE *ifile[10]; + +char **lastarg; + +int peekc; + +int fpage; + +int page; + +int colw; + +int nspace; + +int width = 72; + +int length = 66; + +int plength = 61; + +int margin = 10; + +int ntflg; +++int fflg; + +int mflg; + +int tabc; + +char *tty; + +int mode; + +char *ttyname(); + +char *ctime(); + + + +main(argc, argv) + +char **argv; + +{ + + int nfdone; + + int onintr(); + + + + setbuf(stdout, obuf); + + if (signal(SIGINT, SIG_IGN) != SIG_IGN) + + signal(SIGINT, onintr); + + lastarg = &argv[argc-1]; + + fixtty(); + + for (nfdone=0; argc>1; argc--) { + + argv++; + + if (**argv == '-') { + + switch (*++*argv) { + + case 'h': + + if (argc>=2) { + + header = *++argv; + + argc--; + + } + + continue; + + + + case 't': + + ntflg++; + + continue; + + +++ case 'f': +++ fflg++; +++ plength = 60; +++ continue; +++ + + case 'l': + + length = atoi(++*argv); + + continue; + + + + case 'w': + + width = atoi(++*argv); + + continue; + + + + case 's': + + if (*++*argv) + + tabc = **argv; + + else + + tabc = '\t'; + + continue; + + + + case 'm': + + mflg++; + + continue; + + + + default: + + ncol = atoi(*argv); + + continue; + + } + + } else if (**argv == '+') { + + fpage = atoi(++*argv); + + } else { + + print(*argv, argv); + + nfdone++; + + if (mflg) + + break; + + } + + } + + if (nfdone==0) + + print((char *)0, (char **)0); + + done(); + +} + + + +done() + +{ + + + + if (tty) + + chmod(tty, mode); + + exit(0); + +} + + + +onintr() + +{ + + + + if (tty) + + chmod(tty, mode); + + _exit(1); + +} + + + +fixtty() + +{ + + struct stat sbuf; + + + + tty = ttyname(1); + + if (tty == 0) + + return; + + stat(tty, &sbuf); + + mode = sbuf.st_mode&0777; + + chmod(tty, 0600); + +} + + + +print(fp, argp) + +char *fp; + +char **argp; + +{ + + extern char *sprintf(); + + struct stat sbuf; + + register sncol; + + register char *sheader; + + register char *cbuf; + + char linebuf[150], *cp; + + + + if (ntflg) + + margin = 0; + + else + + margin = 10; + + if (length <= margin) + + length = 66; + + if (width <= 0) + + width = 72; + + if (ncol>72 || ncol>width) { + + fprintf(stderr, "pr: No room for columns.\n"); + + done(); + + } + + if (mflg) { + + mopen(argp); + + ncol = nofile; + + } + + colw = width/(ncol==0? 1 : ncol); + + sncol = ncol; + + sheader = header; + + plength = length-5; + + if (ntflg) + + plength = length; + + if (--ncol<0) + + ncol = 0; + + if (mflg) + + fp = 0; + + if (fp) { + + if((file=fopen(fp, "r"))==NULL) { + + if (tty==NULL) + + fprintf(stderr, "pr: can't open %s\n", fp); + + ncol = sncol; + + header = sheader; + + return; + + } + + stat(fp, &sbuf); + + } else { + + file = stdin; + + time(&sbuf.st_mtime); + + } + + if (header == 0) + + header = fp?fp:""; + + cbuf = ctime(&sbuf.st_mtime); + + cbuf[16] = '\0'; + + cbuf[24] = '\0'; + + page = 1; + + icol = 0; + + colp[ncol] = bufp = buffer; + + if (mflg==0) + + nexbuf(); + + while (mflg&&nofile || (!mflg)&&tpgetc(ncol)>0) { + + if (mflg==0) { + + colp[ncol]--; + + if (colp[ncol] < buffer) + + colp[ncol] = &buffer[BUFS]; + + } + + line = 0; + + if (ntflg==0) { - sprintf(linebuf, "\n\n%s %s %s Page %d\n\n\n", - cbuf+4, cbuf+20, header, page); +++ if (fflg) { +++ /* Assume a ff takes two blank lines at the +++ top of the page. */ +++ line = 2; +++ sprintf(linebuf, "%s %s %s Page %d\n\n\n", +++ cbuf+4, cbuf+20, header, page); +++ } else +++ sprintf(linebuf, "\n\n%s %s %s Page %d\n\n\n", +++ cbuf+4, cbuf+20, header, page); + + for(cp=linebuf;*cp;) put(*cp++); + + } + + putpage(); - if (ntflg==0) - while(line=10) { + + fprintf(stderr, "pr: Too many args\n"); + + done(); + + } + + } + +} + + + +putpage() + +{ + + register int lastcol, i, c; + + int j; + + + + if (ncol==0) { + + while (line512) + + n = 512; + + if((n=fread(rbufp,1,n,file)) <= 0){ + + fclose(file); + + *rbufp = 0376; + + } + + else { + + rbufp += n; + + if (rbufp >= &buffer[BUFS]) + + rbufp = buffer; + + *rbufp = 0375; + + } + + bufp = rbufp; + +} + + + +tpgetc(ai) + +{ + + register char **p; + + register int c, i; + + + + i = ai; + + if (mflg) { + + if((c=getc(ifile[i])) == EOF) { + + if (isclosed[i]==0) { + + isclosed[i] = 1; + + if (--nofile <= 0) + + return(0); + + } + + return('\n'); + + } + + if (c==FF && ncol>0) + + c = '\n'; + + return(c); + + } + +loop: + + c = **(p = &colp[i]) & 0377; + + if (c == 0375) { + + nexbuf(); + + c = **p & 0377; + + } + + if (c == 0376) + + return(0); + + (*p)++; + + if (*p >= &buffer[BUFS]) + + *p = buffer; + + if (c==0) + + goto loop; + + return(c); + +} + + + +pgetc(i) + +{ + + register int c; + + + + if (peekc) { + + c = peekc; + + peekc = 0; + + } else + + c = tpgetc(i); + + if (tabc) + + return(c); + + switch (c) { + + + + case '\t': + + icol++; + + if ((icol&07) != 0) + + peekc = '\t'; + + return(' '); + + + + case '\n': + + icol = 0; + + break; + + + + case 010: + + case 033: + + icol--; + + break; + + } + + if (c >= ' ') + + icol++; + + return(c); + +} + +put(ac) + +{ + + register int ns, c; + + + + c = ac; + + if (tabc) { + + putcp(c); + + if (c=='\n') + + line++; + + return; + + } + + switch (c) { + + + + case ' ': + + nspace++; + + col++; + + return; + + + + case '\n': + + col = 0; + + nspace = 0; + + line++; + + break; + + + + case 010: + + case 033: + + if (--col<0) + + col = 0; + + if (--nspace<0) + + nspace = 0; + + + + } + + while(nspace) { + + if (nspace>2 && col > (ns=((col-nspace)|07))) { + + nspace = col-ns-1; + + putcp('\t'); + + } else { + + nspace--; + + putcp(' '); + + } + + } + + if (c >= ' ') + + col++; + + putcp(c); + +} - - putcp(c) - { - if (page >= fpage) - putchar(c); - } diff --cc usr/src/cmd/printenv.c index 0000000000,10d0ed1239,0000000000..17f56b5270 mode 000000,100644,000000..100644 --- a/usr/src/cmd/printenv.c +++ b/usr/src/cmd/printenv.c @@@@ -1,0 -1,44 -1,0 +1,45 @@@@ +++static char *sccsid = "@(#)printenv.c 4.1 (Berkeley) 10/2/80"; + +/* + + * printenv + + * + + * Bill Joy, UCB + + * February, 1979 + + */ + + + +extern char **environ; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register char **ep; + + int found = 0; + + + + argc--, argv++; + + if (environ) + + for (ep = environ; *ep; ep++) + + if (argc == 0 || prefix(argv[0], *ep)) { + + register char *cp = *ep; + + + + found++; + + if (argc) { + + while (*cp && *cp != '=') + + cp++; + + if (*cp == '=') + + cp++; + + } + + printf("%s\n", cp); + + } + + exit (!found); + +} + + + +prefix(cp, dp) + + char *cp, *dp; + +{ + + + + while (*cp && *dp && *cp == *dp) + + cp++, dp++; + + if (*cp == 0) + + return (*dp == '='); + + return (0); + +} diff --cc usr/src/cmd/prmail.c index 0000000000,0000000000,0000000000..59a51e9f98 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/prmail.c @@@@ -1,0 -1,0 -1,0 +1,61 @@@@ +++static char *sccsid = "@(#)prmail.c 4.1 (Berkeley) 10/9/80"; +++ +++#include +++/* +++ * prmail +++ */ +++struct passwd *getpwuid(); +++char *getenv(); +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ register struct passwd *pp; +++ +++ --argc, ++argv; +++ if (chdir("/usr/spool/mail") < 0) { +++ perror("/usr/spool/mail"); +++ exit(1); +++ } +++ if (argc == 0) { +++ char *user = getenv("USER"); +++ if (user == 0) { +++ pp = getpwuid(getuid()); +++ if (pp == 0) { +++ printf("Who are you?\n"); +++ exit(1); +++ } +++ user = pp->pw_name; +++ } +++ prmail(user, 0); +++ } else +++ while (--argc >= 0) +++ prmail(*argv++, 1); +++ exit(0); +++} +++ +++#include +++#include +++ +++prmail(user, other) +++ char *user; +++{ +++ struct stat stb; +++ char cmdbuf[256]; +++ +++ if (stat(user, &stb) < 0) { +++ printf("No mail for %s.\n", user); +++ return; +++ } +++ if (access(user, "4") < 0) { +++ printf("Mailbox for %s unreadable\n", user); +++ return; +++ } +++ if (other) +++ printf(">>> %s <<<\n", user); +++ sprintf(cmdbuf, "more %s", user); +++ system(cmdbuf); +++ if (other) +++ printf("-----\n\n"); +++} diff --cc usr/src/cmd/ps.c index 0000000000,ac451c301a,0000000000..53b2e2c3bb mode 000000,100644,000000..100644 --- a/usr/src/cmd/ps.c +++ b/usr/src/cmd/ps.c @@@@ -1,0 -1,702 -1,0 +1,1078 @@@@ +++static char *sccsid = "@(#)ps.c 4.7 (Berkeley) 10/20/80"; + +/* - * ps - process status - * This is the augmented UCB ps for UCB/VM Unix (9/79) - * examine and print certain things about processes - * usage: ps [acgklrt#uvwx] [corefile] [swapfile] [system] +++ * ps; VAX 4BSD version + + */ + + + +#include - #include +++#include +++#include + +#include + +#include - #include + +#include + +#include + +#include +++#include + +#include + +#include + +#include - #include +++#include +++#include + + + +struct nlist nl[] = { + + { "_proc" }, + +#define X_PROC 0 - { "_swapdev" }, - #define X_SWAPDEV 1 - { "_swplo" }, - #define X_SWPLO 2 - { "_Usrptma" }, - #define X_USRPTMA 3 +++ { "_Usrptmap" }, +++#define X_USRPTMA 1 + + { "_usrpt" }, - #define X_USRPT 4 +++#define X_USRPT 2 + + { "_text" }, - #define X_TEXT 5 +++#define X_TEXT 3 + + { "_nswap" }, - #define X_NSWAP 6 +++#define X_NSWAP 4 +++ { "_maxslp" }, +++#define X_MAXSLP 5 +++ { "_ccpu" }, +++#define X_CCPU 6 +++ { "_ecmx" }, +++#define X_ECMX 7 + + { 0 }, + +}; + + - struct proc mproc; - struct text text[NTEXT]; +++struct savcom { +++ union { +++ struct lsav *lp; +++ float u_pctcpu; +++ struct vsav *vp; +++ int s_ssiz; +++ } sun; +++ struct asav *ap; +++} savcom[NPROC]; +++ +++struct asav { +++ char *a_cmdp; +++ int a_flag; +++ short a_stat, a_uid, a_pid, a_nice, a_pri, a_slptime, a_time; +++ size_t a_size, a_rss, a_tsiz, a_txtrss; +++ short a_xccount; +++ char a_tty[DIRSIZ+1]; +++ dev_t a_ttyd; +++ time_t a_cpu; +++}; +++ +++char *lhdr; +++struct lsav { +++ short l_ppid; +++ char l_cpu; +++ int l_addr; +++ caddr_t l_wchan; +++}; +++ +++char *uhdr; +++char *shdr; + + - #define INTPPG (NBPG/sizeof(int)) /* ints per page */ +++char *vhdr; +++struct vsav { +++ u_int v_majflt; +++ size_t v_swrss, v_txtswrss; +++ float v_pctcpu; +++}; +++ +++struct proc proc[8]; /* 8 = a few, for less syscalls */ +++struct proc *mproc; +++struct text *text; +++ +++int paduser1; /* avoid hardware mem clobbering botch */ + +union { - struct user yy; - int xx[INTPPG][UPAGES]; - } zz; +++ struct user user; +++ char upages[UPAGES][NBPG]; +++} user; +++#define u user.user +++int paduser2; /* avoid hardware mem clobbering botch */ +++ + +#define clear(x) ((int)x & 0x7fffffff) - #define u zz.yy - int chkpid = 0; - int aflg; /* -a: all processes, not just mine */ - int cflg; /* -c: complete listing of args, not just comm. */ - int gflg; /* -g: complete listing including group headers, etc */ - int kflg; /* -k: read from core file instead of real memory */ - int lflg; /* -l: long listing form */ - int rflg; /* -r: raw output in style */ - int sflg; /* -s: stack depth */ - int uflg; /* -u: user name */ - int vflg; /* -v: virtual memory statistics */ - int wflg; /* -w[w]: wide terminal */ - int xflg; /* -x: ALL processes, even those without ttys */ - int login; /* -: this is a login shell */ +++ +++int chkpid; +++int aflg, cflg, eflg, gflg, kflg, lflg, sflg, uflg, vflg, xflg; + +char *tptr; - char *gettty(); +++char *gettty(), *getcmd(), *getname(), *savestr(), *alloc(), *state(); +++double pcpu(), pmem(); + +int pscomp(); - struct pte pagetbl[NPTEPG]; - int kmem; - int mem; - int swap; - daddr_t swplo; - int nswap; - int Usrptma; - int usrpt; - - int ndev; - struct devl { - char dname[DIRSIZ]; - dev_t dev; - } devl[256]; - - struct psout outargs[NPROC]; /* info for first npr processes */ - int npr; /* number of processes found so far */ - int argwidth; /* number of chars of args to print */ - - char *coref; +++int nswap, maxslp; +++double ccpu; +++int ecmx; +++struct pte *Usrptma, *usrpt; +++ +++struct ttys { +++ char name[DIRSIZ+1]; +++ dev_t ttyd; +++ struct ttys *next; +++ struct ttys *cand; +++} *allttys, *cand[16]; +++ +++struct savcom savcom[NPROC]; +++int npr; +++ +++int cmdstart; +++int twidth; +++char *kmemf, *memf, *swapf, *nlistf; +++int kmem, mem, swap; +++int rawcpu, sumcpu; +++ +++int pcbpf; +++int argaddr; +++extern char _sobuf[]; + + + +main(argc, argv) - char **argv; +++ char **argv; + +{ - int i; - char *ap; - int uid, puid; - char obuf[BUFSIZ]; - register struct nlist *nlp; +++ register int i, j; +++ register char *ap; +++ int uid; +++ off_t procp; + + - setbuf(stdout, obuf); +++ if (chdir("/dev") < 0) { +++ perror("/dev"); +++ exit(1); +++ } +++ twidth = 80; +++ setbuf(stdout, _sobuf); + + argc--, argv++; - if (argc>0) { +++ if (argc > 0) { + + ap = argv[0]; + + while (*ap) switch (*ap++) { - case '-': - break; + + +++ case 'C': +++ rawcpu++; +++ break; +++ case 'S': +++ sumcpu++; +++ break; + + case 'a': + + aflg++; + + break; - + + case 'c': - cflg++; +++ cflg = !cflg; +++ break; +++ case 'e': +++ eflg++; + + break; - + + case 'g': + + gflg++; + + break; - + + case 'k': + + kflg++; + + break; - + + case 'l': + + lflg++; + + break; - - case 'r': - rflg++; - break; - + + case 's': + + sflg++; + + break; - + + case 't': - if(*ap) +++ if (*ap) + + tptr = ap; + + aflg++; + + gflg++; + + if (*tptr == '?') + + xflg++; + + while (*ap) + + ap++; + + break; - + + case 'u': + + uflg++; + + break; - + + case 'v': +++ cflg = 1; + + vflg++; + + break; - + + case 'w': - wflg++; +++ if (twidth == 80) +++ twidth = 132; +++ else +++ twidth = BUFSIZ; + + break; - + + case 'x': + + xflg++; + + break; - + + default: - chkpid=atoi(--ap); - *ap = '\0'; +++ if (!isdigit(ap[-1])) +++ break; +++ chkpid = atoi(--ap); +++ *ap = 0; + + aflg++; + + xflg++; + + break; + + } + + } - coref = "/dev/kmem"; - if(kflg) - coref = argc > 1 ? argv[1] : "/vmcore"; - - if ((kmem = open(coref, 0)) < 0) { - perror(coref); - done(1); +++ openfiles(argc, argv); +++ getkvars(argc, argv); +++ getdev(); +++ uid = getuid(); +++ printhdr(); +++ procp = nl[X_PROC].n_value; +++ for (i=0; i 8) +++ j = 8; +++ j *= sizeof (struct proc); +++ if (read(kmem, (char *)proc, j) != j) +++ cantread("proc table", kmemf); +++ procp += j; +++ for (j = j / sizeof (struct proc) - 1; j >= 0; j--) { +++ mproc = &proc[j]; +++ if (mproc->p_stat == 0 || +++ mproc->p_pgrp == 0 && xflg == 0) +++ continue; +++ if (tptr == 0 && gflg == 0 && xflg == 0 && +++ mproc->p_ppid == 1 && (mproc->p_flag&SDETACH) == 0) +++ continue; +++ if (uid != mproc->p_uid && aflg==0 || +++ chkpid != 0 && chkpid != mproc->p_pid) +++ continue; +++ if (vflg && gflg == 0 && xflg == 0) { +++ if (mproc->p_stat == SZOMB || +++ mproc->p_flag&SWEXIT) +++ continue; +++ if (mproc->p_slptime > MAXSLP && +++ (mproc->p_stat == SSLEEP || +++ mproc->p_stat == SSTOP)) +++ continue; +++ } +++ save(); +++ } + + } - if ((mem = open("/dev/mem", 0)) < 0) { - fprintf(stderr, "No mem\n"); - done(1); +++ qsort(savcom, npr, sizeof(savcom[0]), pscomp); +++ for (i=0; iap->a_flag & SWEXIT) +++ printf(" "); +++ else if (sp->ap->a_stat == SZOMB) +++ printf(" "); +++ else if (sp->ap->a_pid == 0) +++ printf(" swapper"); +++ else if (sp->ap->a_pid == 2) +++ printf(" pagedaemon"); +++ else +++ printf(" %.*s", twidth - cmdstart - 2, sp->ap->a_cmdp); +++ printf("\n"); + + } - if (kflg) - mem = kmem; +++ exit(npr == 0); +++} + + - if ((swap = open(argc>2 ? argv[2]: "/dev/drum", 0)) < 0) { - fprintf(stderr, "Can't open /dev/drum\n"); - done(1); - } +++openfiles(argc, argv) +++ char **argv; +++{ + + - nlist(argc>3 ? argv[3] : "/vmunix", nl); - if (nl[0].n_type==0) { - fprintf(stderr, "No namelist\n"); - done(1); +++ kmemf = "kmem"; +++ if (kflg) +++ kmemf = argc > 1 ? argv[1] : "/vmcore"; +++ kmem = open(kmemf, 0); +++ if (kmem < 0) { +++ perror(kmemf); +++ exit(1); + + } +++ if (kflg) { +++ mem = kmem; +++ memf = kmemf; +++ } else { +++ memf = "mem"; +++ mem = open(memf, 0); +++ if (mem < 0) { +++ perror(memf); +++ exit(1); +++ } +++ } +++ swapf = argc>2 ? argv[2]: "drum"; +++ swap = open(swapf, 0); +++ if (swap < 0) { +++ perror(swapf); +++ exit(1); +++ } +++} +++ +++getkvars(argc, argv) +++ char **argv; +++{ +++ register struct nlist *nlp; + + - if(chdir("/dev") < 0) { - fprintf(stderr, "Can't change to /dev\n"); - done(1); +++ nlistf = argc > 3 ? argv[3] : "/vmunix"; +++ nlist(nlistf, nl); +++ if (nl[0].n_type == 0) { +++ fprintf(stderr, "%s: No namelist\n", nlistf); +++ exit(1); + + } + + if (kflg) - for (nlp= nl; nlp < &nl[sizeof (nl)/sizeof (nl[0])]; nlp++) - nlp->n_value &= 0x7ffffffff; - Usrptma = nl[X_USRPTMA].n_value; - usrpt = nl[X_USRPT].n_value; - /* - * read kmem to find swap dev. - */ - lseek(kmem, (long)nl[X_SWAPDEV].n_value, 0); - read(kmem, &nl[X_SWAPDEV].n_value, sizeof(nl[X_SWAPDEV].n_value)); - /* - * Find base and size of swap - */ - lseek(kmem, (long)nl[X_SWPLO].n_value, 0); - read(kmem, &swplo, sizeof(swplo)); +++ for (nlp = nl; nlp < &nl[sizeof (nl)/sizeof (nl[0])]; nlp++) +++ nlp->n_value = clear(nlp->n_value); +++ Usrptma = (struct pte *)nl[X_USRPTMA].n_value; +++ usrpt = (struct pte *)nl[X_USRPT].n_value; + + lseek(kmem, (long)nl[X_NSWAP].n_value, 0); - read(kmem, &nswap, sizeof (nswap)); - /* - * If v flag get text table - */ - if (vflg) { - lseek(kmem, (long)nl[X_TEXT].n_value, 0); - read(kmem, text, sizeof (text)); +++ if (read(kmem, &nswap, sizeof (nswap)) != sizeof (nswap)) { +++ cantread("nswap", kmemf); +++ exit(1); + + } - if (kflg) - swplo = 0; - getdev(); - uid = getuid(); - if (sflg + lflg + vflg + uflg > 1) { - printf("Cannot combine s, l, v, and/or u.\n"); +++ lseek(kmem, (long)nl[X_MAXSLP].n_value, 0); +++ if (read(kmem, &maxslp, sizeof (maxslp)) != sizeof (maxslp)) { +++ cantread("maxslp", kmemf); + + exit(1); + + } - /* different psout widths depending on how much printed & w flag */ - if (wflg <= 1) { - argwidth = 63; - if (wflg) argwidth += 52; /* 132 col term */ - if (lflg) argwidth -= 49; /* extra junk printed */ - if (vflg) argwidth -= 48; /* extra junk for -v */ - if (sflg) argwidth -= 4; /* 4 cols of stack size */ - if (uflg) argwidth -= 27; /* user name */ - } else argwidth = 127; - if (rflg) - ; /* No heading for raw output */ - else if (lflg) - printf(" F S UID PID PPID CPU PRI NICE ADDR SZ RSS WCHAN TTY TIME COMMAND\n"); - else if (vflg) - printf("F PID TT TIME TIM SL MINFLT MAJFLT SIZE RSS SRS TSIZ TRS PF COMMAND\n"); - else if (uflg) - printf("USER PID %%CPU NICE SZ RSS TTY TIME COMMAND\n"); - else if (chkpid==0) { - if (sflg) - printf(" SSIZ"); - printf(" PID TTY TIME COMMAND\n"); +++ lseek(kmem, (long)nl[X_CCPU].n_value, 0); +++ if (read(kmem, &ccpu, sizeof (ccpu)) != sizeof (ccpu)) { +++ cantread("ccpu", kmemf); +++ exit(1); + + } - fflush(stdout); - for (i=0; i 1) { +++ fprintf(stderr, "ps: specify only one of s,l,v and u\n"); +++ exit(1); +++ } +++ hdr = lflg ? lhdr : (vflg ? vhdr : (uflg ? uhdr : shdr)); +++ if (lflg+vflg+uflg+sflg == 0) +++ hdr += strlen("SSIZ "); +++ cmdstart = strlen(hdr); +++ printf("%s COMMAND\n", hdr); +++ fflush(stdout); + +} + + +++cantread(what, fromwhat) +++ char *what, *fromwhat; +++{ +++ +++ fprintf(stderr, "ps: error reading %s from %s", what, fromwhat); +++} +++ +++struct direct dbuf; +++int dialbase; +++ + +getdev() + +{ - #include + + register FILE *df; - struct stat sbuf; - struct direct dbuf; +++ register struct ttys *dp; + + - if ((df = fopen("/dev", "r")) == NULL) { - fprintf(stderr, "Can't open /dev\n"); - done(1); +++ dialbase = -1; +++ if ((df = fopen(".", "r")) == NULL) { +++ fprintf(stderr, "Can't open . in /dev\n"); +++ exit(1); + + } - ndev = 0; - while (fread(&dbuf, sizeof(dbuf), 1, df) == 1) { - if(dbuf.d_ino == 0) +++ while (fread((char *)&dbuf, sizeof(dbuf), 1, df) == 1) { +++ if (dbuf.d_ino == 0) + + continue; - if(stat(dbuf.d_name, &sbuf) < 0) - continue; - if ((sbuf.st_mode&S_IFMT) != S_IFCHR) - continue; - strcpy(devl[ndev].dname, dbuf.d_name); - devl[ndev].dev = sbuf.st_rdev; - ndev++; +++ maybetty(dp); + + } + + fclose(df); + +} + + - savcom(puid) +++/* +++ * Attempt to avoid stats by guessing minor device +++ * numbers from tty names. Console is known, +++ * know that r(hp|up|mt) are unlikely as are different mem's, +++ * floppy, null, tty, etc. +++ */ +++maybetty() + +{ - int abuf[INTPPG]; - long addr; - register int *ip; - register struct psout *a; - register char *cp, *cp1; - long tm; - int cc, nbad; - int szpt, p0br; - register char *tp; - struct dblock db; - struct pte apte; +++ register char *cp = dbuf.d_name; +++ register struct ttys *dp; +++ int x; +++ struct stat stb; + + - /* skip long sleeping or dead processes if -v unless -g or -x */ - if (!gflg && vflg && !xflg) { - switch (mproc.p_stat) { +++ switch (cp[0]) { +++ +++ case 'c': +++ if (!strcmp(cp, "console")) { +++ x = 0; +++ goto donecand; +++ } +++ /* cu[la]? are possible!?! don't rule them out */ +++ break; + + - case SSLEEP: - case SSTOP: - if (mproc.p_slptime > MAXSLP) +++ case 'd': +++ if (!strcmp(cp, "drum")) +++ return (0); +++ break; +++ +++ case 'f': +++ if (!strcmp(cp, "floppy")) +++ return (0); +++ break; +++ +++ case 'k': +++ cp++; +++ if (*cp == 'U') +++ cp++; +++ goto trymem; +++ +++ case 'r': +++ cp++; +++ if (*cp == 'r' || *cp == 'u' || *cp == 'h') +++ cp++; +++#define is(a,b) cp[0] == 'a' && cp[1] == 'b' +++ if (is(r,p) || is(u,p) || is(r,k) || is(r,m) || is(m,t)) { +++ cp += 2; +++ if (isdigit(*cp) && cp[2] == 0) + + return (0); - break; +++ } +++ break; + + - case SRUN: - case SIDL: - break; +++ case 'm': +++trymem: +++ if (cp[0] == 'm' && cp[1] == 'e' && cp[2] == 'm' && cp[3] == 0) +++ return (0); +++ break; +++ +++ case 'n': +++ if (!strcmp(cp, "null")) +++ return (0); +++ break; + + - case SZOMB: +++ case 'v': +++ if ((cp[1] == 'a' || cp[1] == 'p') && isdigit(cp[2]) && +++ cp[3] == 0) + + return (0); +++ break; +++ } +++mightbe: +++ cp = dbuf.d_name; +++ while (cp < &dbuf.d_name[DIRSIZ] && *cp) +++ cp++; +++ --cp; +++ x = 0; +++ if (cp[-1] == 'd') { +++ if (dialbase == -1) { +++ if (stat("ttyd0", &stb) == 0) +++ dialbase = stb.st_rdev & 017; +++ else +++ dialbase = -2; + + } +++ if (dialbase == -2) +++ x = 0; +++ else +++ x = 11; + + } - /* read in the user structure */ - if ((mproc.p_flag& SLOAD ) == 0) { - /* not loaded - get from swap */ - addr = (mproc.p_swaddr+swplo)<<9; - lseek(swap, addr, 0); - if (read(swap, &u, sizeof(u)) != sizeof(u)) - return(0); - } else { - /* loaded, get each page from memory separately */ - for(cc=0; cc dbuf.d_name && isdigit(cp[-1]) && isdigit(*cp)) +++ x += 10 * (cp[-1] - ' ') + cp[0] - '0'; +++ else if (*cp >= 'a' && *cp <= 'f') +++ x += 10 + *cp - 'a'; +++ else if (isdigit(*cp)) +++ x += *cp - '0'; +++ else +++ x = -1; +++donecand: +++ dp = (struct ttys *)alloc(sizeof (struct ttys)); +++ strncpy(dp->name, dbuf.d_name, DIRSIZ); +++ dp->next = allttys; +++ dp->ttyd = -1; +++ allttys = dp; +++ if (x == -1) +++ return; +++ x &= 017; +++ dp->cand = cand[x]; +++ cand[x] = dp; +++} +++ +++char * +++gettty() +++{ +++ register char *p; +++ register struct ttys *dp; +++ struct stat stb; +++ int x; +++ +++ if (u.u_ttyp == 0) +++ return("?"); +++ x = u.u_ttyd & 017; +++ for (dp = cand[x]; dp; dp = dp->cand) { +++ if (dp->ttyd == -1) { +++ if (stat(dp->name, &stb) == 0 && +++ (stb.st_mode&S_IFMT)==S_IFCHR) +++ dp->ttyd = stb.st_rdev; +++ else +++ dp->ttyd = -2; + + } +++ if (dp->ttyd == u.u_ttyd) +++ goto found; + + } - tp = gettty(); - if (tptr && strcmpn(tptr, tp, 2)) - return(0); - a = &outargs[npr]; - /* saving com starts here */ - a->o_uid = puid; - a->o_pid = mproc.p_pid; - a->o_flag = mproc.p_flag; - a->o_ppid = mproc.p_ppid; - a->o_cpu = mproc.p_cpu; - a->o_pctcpu = 0.0; /* This needs to be fixed later */ - a->o_pri = mproc.p_pri; - a->o_nice = mproc.p_nice; - a->o_addr0 = mproc.p_addr[0]; - a->o_dsize = mproc.p_dsize; - a->o_ssize = mproc.p_ssize; - a->o_rssize = mproc.p_rssize; - a->o_swrss = mproc.p_swrss; - a->o_wchan = mproc.p_wchan; - a->o_pgrp = mproc.p_pgrp; - a->o_tty[0] = tp[0]; - a->o_tty[1] = tp[1] ? tp[1] : ' '; - a->o_ttyd = u.u_ttyd; - a->o_stat = mproc.p_stat; - a->o_flag = mproc.p_flag; - if (a->o_stat==SZOMB) return(1); - a->o_utime = u.u_utime; - a->o_stime = u.u_stime; - a->o_cutime = u.u_cutime; - a->o_cstime = u.u_cstime; - a->o_sigs = u.u_signal[SIGINT] + u.u_signal[SIGQUIT]; - a->o_time = mproc.p_time; - a->o_slptime = mproc.p_slptime; - a->o_uname[0] = 0; - if (sflg) { - for (cp = (char *)u.u_stack; cp < (char *)&u + ctob(UPAGES); cp++) - if (*cp) - break; - a->o_stksize = (int) ((char *)&u + ctob(UPAGES) - cp); - } - if (mproc.p_stat==SZOMB) return(1); - if (vflg) { - register struct text *xp; - - if (mproc.p_textp) { - xp = &text[mproc.p_textp - (struct text *)nl[5].n_value]; - a->o_xsize = xp->x_size; - a->o_xrssize = xp->x_rssize; - } else { - a->o_xsize = 0; - a->o_xrssize = 0; +++ /* ick */ +++ for (dp = allttys; dp; dp = dp->next) { +++ if (dp->ttyd == -1) { +++ if (stat(dp->name, &stb) == 0) +++ dp->ttyd = stb.st_rdev; +++ else +++ dp->ttyd = -2; + + } - a->o_aveflt = mproc.p_aveflt; - a->o_minorflt = u.u_minorflt; - a->o_majorflt = u.u_majorflt; +++ if (dp->ttyd == u.u_ttyd) +++ goto found; + + } - strcpy(a->o_comm, u.u_comm); - if (cflg) - return (1); - a->o_args[0] = 0; /* in case of early return */ - if ((mproc.p_flag & SLOAD) == 0) { - vstodb(0, 1, &u.u_smap, &db, 1); - addr = ctob(swplo + db.db_base); - lseek(swap, addr, 0); - if (read(swap, abuf, sizeof(abuf)) != sizeof(abuf)) - goto garbage; +++ return ("?"); +++found: +++ p = dp->name; +++ if (p[0]=='t' && p[1]=='t' && p[2]=='y') +++ p += 3; +++ return (p); +++} +++ +++save() +++{ +++ register struct savcom *sp; +++ register struct asav *ap; +++ register char *cp; +++ register struct text *xp; +++ char *ttyp, *cmdp; +++ +++ if (mproc->p_stat != SZOMB && getu() == 0) +++ return; +++ ttyp = gettty(); +++ if (xflg == 0 && ttyp[0] == '?' || tptr && strcmpn(tptr, ttyp, 2)) +++ return; +++ sp = &savcom[npr]; +++ cmdp = getcmd(); +++ if (cmdp == 0) +++ return; +++ sp->ap = ap = (struct asav *)alloc(sizeof (struct asav)); +++ sp->ap->a_cmdp = cmdp; +++#define e(a,b) ap->a = mproc->b +++ e(a_flag, p_flag); e(a_stat, p_stat); e(a_nice, p_nice); +++ e(a_uid, p_uid); e(a_pid, p_pid); e(a_pri, p_pri); +++ e(a_slptime, p_slptime); e(a_time, p_time); +++ ap->a_tty[0] = ttyp[0]; +++ ap->a_tty[1] = ttyp[1] ? ttyp[1] : ' '; +++ if (ap->a_stat == SZOMB) { +++ register struct xproc *xp = (struct xproc *)mproc; +++ +++ ap->a_cpu = xp->xp_vm.vm_utime + xp->xp_vm.vm_stime; + + } else { - szpt = u.u_pcb.pcb_szpt; - p0br = kflg ? clear((int)mproc.p_p0br) : (int)mproc.p_p0br; - cc = Usrptma + (p0br + NBPG*(szpt-1) - usrpt)/NPTEPG; - lseek(kmem, cc, 0); - if (read(kmem, &apte, sizeof(apte)) != sizeof(apte)) - goto garbage; - lseek(mem, ctob(apte.pg_pfnum), 0); - if (read(mem,pagetbl,sizeof(pagetbl)) != sizeof(pagetbl)) - goto garbage; - if (pagetbl[NPTEPG-1].pg_fod == 0 && pagetbl[NPTEPG-1].pg_pfnum) { - lseek(mem,ctob((pagetbl[NPTEPG-1].pg_pfnum)),0); - if (read(mem,abuf,sizeof(abuf)) != sizeof(abuf)) - goto garbage; - } else { - vstodb(0, 1, &u.u_smap, &db, 1); - addr = ctob(swplo + db.db_base); - lseek(swap, addr, 0); - if (read(swap, abuf, sizeof(abuf)) != sizeof(abuf)) - goto garbage; +++ ap->a_size = mproc->p_dsize + mproc->p_ssize; +++ e(a_rss, p_rssize); +++ ap->a_ttyd = u.u_ttyd; +++ ap->a_cpu = u.u_vm.vm_utime + u.u_vm.vm_stime; +++ if (sumcpu) +++ ap->a_cpu += u.u_cvm.vm_utime + u.u_cvm.vm_stime; +++ if (mproc->p_textp && text) { +++ xp = &text[mproc->p_textp - +++ (struct text *)nl[X_TEXT].n_value]; +++ ap->a_tsiz = xp->x_size; +++ ap->a_txtrss = xp->x_rssize; +++ ap->a_xccount = xp->x_ccount; + + } + + } - abuf[INTPPG] = 0; - for (ip = &abuf[INTPPG-2]; ip > abuf;) { - if (*--ip == -1 || *ip == 0) { - cp = (char *)(ip+1); - if (*cp==0) - cp++; - nbad = 0; - for (cp1 = cp; cp1 < (char *)&abuf[INTPPG]; cp1++) { - cc = *cp1&0177; - if (cc==0) - *cp1 = ' '; - else if (cc < ' ' || cc > 0176) { - if (++nbad >= 5) { - *cp1++ = ' '; - break; - } - *cp1 = '?'; - } else if (cc=='=') { - *cp1 = 0; - while (cp1>cp && *--cp1!=' ') - *cp1 = 0; +++#undef e +++ ap->a_cpu /= HZ; +++ if (lflg) { +++ register struct lsav *lp; +++ +++ sp->sun.lp = lp = (struct lsav *)alloc(sizeof (struct lsav)); +++#define e(a,b) lp->a = mproc->b +++ e(l_ppid, p_ppid); e(l_cpu, p_cpu); +++ if (ap->a_stat != SZOMB) +++ e(l_wchan, p_wchan); +++#undef e +++ lp->l_addr = pcbpf; +++ } else if (vflg) { +++ register struct vsav *vp; +++ +++ sp->sun.vp = vp = (struct vsav *)alloc(sizeof (struct vsav)); +++#define e(a,b) vp->a = mproc->b +++ if (ap->a_stat != SZOMB) { +++ e(v_swrss, p_swrss); +++ vp->v_majflt = u.u_vm.vm_majflt; +++ if (mproc->p_textp) +++ vp->v_txtswrss = xp->x_swrss; +++ } +++ vp->v_pctcpu = pcpu(); +++#undef e +++ } else if (uflg) +++ sp->sun.u_pctcpu = pcpu(); +++ else if (sflg) { +++ if (ap->a_stat != SZOMB) { +++ for (cp = (char *)u.u_stack; +++ cp < &user.upages[UPAGES][NBPG]; ) +++ if (*cp++) + + break; - } - } - while (*--cp1==' ') - *cp1 = 0; - strcpy(a->o_args, cp); - garbage: - cp = a->o_args; - if (cp[0]=='-'&&cp[1]<=' ' || cp[0]=='?' || cp[0]<=' ') { - strcat(cp, " ("); - strcat(cp, u.u_comm); - strcat(cp, ")"); - } - cp[127] = 0; /* max room in psout is 128 chars */ - if (xflg || gflg || tptr || cp[0]!='-') - return(1); - return(0); +++ sp->sun.s_ssiz = (&user.upages[UPAGES][NBPG] - cp); + + } + + } - goto garbage; +++ npr++; + +} + + - prcom(a) - register struct psout *a; +++double +++pmem(ap) +++ register struct asav *ap; + +{ - long tm; +++ double fracmem; +++ int szptudot; + + - if (rflg) { - write(1, a, sizeof (*a)); - return(0); +++ if ((ap->a_flag&SLOAD) == 0) +++ fracmem = 0.0; +++ else { +++ szptudot = UPAGES + clrnd(ctopt(ap->a_size+ap->a_tsiz)); +++ fracmem = ((float)ap->a_rss+szptudot)/CLSIZE/ecmx; +++ if (ap->a_xccount) +++ fracmem += ((float)ap->a_txtrss)/CLSIZE/ +++ ap->a_xccount/ecmx; + + } - if (lflg) { - printf("%4x %c", 0xffff & a->o_flag, - "0SWRIZT"[a->o_stat]); - printf("%4d", a->o_uid); - } else if (vflg) { - switch (a->o_stat) { - - case SSLEEP: - case SSTOP: - if ((a->o_flag & SLOAD) == 0) - printf("W"); - else if (a->o_pri >= PZERO) - printf("S"); - else if (a->o_flag & SPAGE) - printf("P"); - else - printf("D"); - break; +++ return (100.0 * fracmem); +++} + + - case SRUN: - case SIDL: - if (a->o_flag & SLOAD) - printf("R"); - else - printf("W"); - break; +++double +++pcpu() +++{ +++ time_t time; +++ +++ time = mproc->p_time; +++ if (time == 0 || (mproc->p_flag&SLOAD) == 0) +++ return (0.0); +++ if (rawcpu) +++ return (100.0 * mproc->p_pctcpu); +++ return (100.0 * mproc->p_pctcpu / (1.0 - exp(time * log(ccpu)))); +++} +++ +++getu() +++{ +++ struct pte *pteaddr, apte; +++ int pad1; /* avoid hardware botch */ +++ struct pte arguutl[UPAGES+CLSIZE]; +++ int pad2; /* avoid hardware botch */ +++ register int i; +++ int ncl, size; +++ +++ size = sflg ? ctob(UPAGES) : sizeof (struct user); +++ if ((mproc->p_flag & SLOAD) == 0) { +++ lseek(swap, ctob(mproc->p_swaddr), 0); +++ if (read(swap, (char *)&user.user, size) != size) { +++ fprintf(stderr, "ps: cant read u for pid %d from %s\n", +++ mproc->p_pid, swapf); +++ return (0); + + } - if (a->o_nice > NZERO) - printf("N"); - else - printf(" "); - } else if (uflg) { - printf("%-8.8s", a->o_uname); - } - if (sflg) { - printf("%5d", a->o_stksize); - } - printf("%6u", a->o_pid); - if (lflg) - printf("%6u%4d%4d%4d%6x", a->o_ppid, a->o_cpu&0377, - a->o_pri, a->o_nice, a->o_addr0); - else if (uflg) - printf("%5.1f%4d ", a->o_pctcpu, a->o_nice); - if (lflg || uflg) - printf("%4d%5d", a->o_dsize+a->o_ssize, a->o_rssize); - if (lflg) - if (a->o_wchan) - printf("%6x", clear(a->o_wchan)); - else - printf(" "); - printf(" %-2.2s", a->o_tty); - if (a->o_stat==SZOMB) { - printf(" "); - return(1); - } - tm = (a->o_utime + a->o_stime + 30)/60; - printf("%3ld:", tm/60); - tm %= 60; - printf(tm<10?"0%ld":"%ld", tm); - if (vflg) { - /* - tm = (a->o_stime + 30) / 60; - printf(" %2ld:", tm/60); - tm %= 60; - printf(tm<10?"0%ld":"%ld", tm); - */ - printf("%4d%3d", a->o_time, a->o_slptime); - } - #ifdef notdef - if (0 && lflg==0) { /* 0 == old tflg (print long times) */ - tm = (a->o_cstime + 30)/60; - printf(" %2ld:", tm/60); - tm %= 60; - printf(tm<10?"0%ld":"%ld", tm); - tm = (a->o_cutime + 30)/60; - printf(" %2ld:", tm/60); - tm %= 60; - printf(tm<10?"0%ld":"%ld", tm); - } - #endif - if (vflg) { - printf("%7d%7d",a->o_minorflt,a->o_majorflt); - printf("%5d%4d%4d", a->o_dsize+a->o_ssize, a->o_rssize, a->o_swrss); - printf("%5d%4d", a->o_xsize, a->o_xrssize); - printf("%3d", a->o_aveflt); +++ pcbpf = 0; +++ argaddr = 0; +++ return (1); + + } - if (a->o_pid == 0) { - printf(" swapper"); - return(1); +++ pteaddr = &Usrptma[btokmx(mproc->p_p0br) + mproc->p_szpt - 1]; +++ lseek(kmem, kflg ? clear(pteaddr) : (int)pteaddr, 0); +++ if (read(kmem, (char *)&apte, sizeof(apte)) != sizeof(apte)) { +++ printf("ps: cant read indir pte to get u for pid %d from %s\n", +++ mproc->p_pid, swapf); +++ return (0); + + } - if (a->o_pid == 2) { - printf(" pagedaemon"); - return(1); +++ lseek(mem, +++ ctob(apte.pg_pfnum+1) - (UPAGES+CLSIZE) * sizeof (struct pte), 0); +++ if (read(mem, (char *)arguutl, sizeof(arguutl)) != sizeof(arguutl)) { +++ printf("ps: cant read page table for u of pid %d from %s\n", +++ mproc->p_pid, swapf); +++ return (0); + + } - if (cflg) { - printf(" %s", a->o_comm); - return(1); +++ if (arguutl[0].pg_fod == 0 && arguutl[0].pg_pfnum) +++ argaddr = ctob(arguutl[0].pg_pfnum); +++ else +++ argaddr = 0; +++ pcbpf = arguutl[CLSIZE].pg_pfnum; +++ ncl = (size + NBPG*CLSIZE - 1) / (NBPG*CLSIZE); +++ while (--ncl >= 0) { +++ i = ncl * CLSIZE; +++ lseek(mem, ctob(arguutl[CLSIZE+i].pg_pfnum), 0); +++ if (read(mem, user.upages[i], CLSIZE*NBPG) != CLSIZE*NBPG) { +++ printf("ps: cant read page %d of u of pid %d from %s\n", +++ arguutl[CLSIZE+i].pg_pfnum, mproc->p_pid, memf); +++ return(0); +++ } + + } - a -> o_args[argwidth] = 0; /* force it to quit early */ - printf(" %s", a->o_args); + + return (1); + +} + + + +char * - gettty() +++getcmd() + +{ - register i; - register char *p; +++ char cmdbuf[BUFSIZ]; +++ int pad1; /* avoid hardware botch */ +++ union { +++ char argc[CLSIZE*NBPG]; +++ int argi[CLSIZE*NBPG/sizeof (int)]; +++ } argspac; +++ int pad2; /* avoid hardware botch */ +++ register char *cp; +++ register int *ip; +++ char c; +++ int nbad; +++ struct dblock db; + + - if (u.u_ttyp==0) - return("?"); - for (i=0; ip_stat == SZOMB || mproc->p_flag&(SSYS|SWEXIT)) +++ return (""); +++ if (cflg) { +++ strncpy(cmdbuf, u.u_comm, sizeof (u.u_comm)); +++ return (savestr(cmdbuf)); +++ } +++ if ((mproc->p_flag & SLOAD) == 0 || argaddr == 0) { +++ vstodb(0, CLSIZE, &u.u_smap, &db, 1); +++ lseek(swap, ctob(db.db_base), 0); +++ if (read(swap, (char *)&argspac, sizeof(argspac)) +++ != sizeof(argspac)) +++ goto bad; +++ } else { +++ lseek(mem, argaddr, 0); +++ if (read(mem, (char *)&argspac, sizeof (argspac)) +++ != sizeof (argspac)) +++ goto bad; +++ } +++ ip = &argspac.argi[CLSIZE*NBPG/sizeof (int)]; +++ ip -= 2; /* last arg word and .long 0 */ +++ while (*--ip) +++ if (ip == argspac.argi) +++ goto retucomm; +++ *(char *)ip = ' '; +++ ip++; +++ nbad = 0; +++ for (cp = (char *)ip; cp < &argspac.argc[CLSIZE*NBPG]; cp++) { +++ c = *cp & 0177; +++ if (c == 0) +++ *cp = ' '; +++ else if (c < ' ' || c > 0176) { +++ if (++nbad >= 5*(eflg+1)) { +++ *cp++ = ' '; +++ break; +++ } +++ *cp = '?'; +++ } else if (eflg == 0 && c == '=') { +++ while (*--cp != ' ') +++ if (cp <= (char *)ip) +++ break; +++ break; + + } + + } - return("?"); +++ *cp = 0; +++ while (*--cp == ' ') +++ *cp = 0; +++ cp = (char *)ip; +++ strncpy(cmdbuf, cp, &argspac.argc[CLSIZE*NBPG] - cp); +++ if (cp[0] == '-' || cp[0] == '?' || cp[0] <= ' ') { +++ strcat(cmdbuf, " ("); +++ strncat(cmdbuf, u.u_comm, sizeof(u.u_comm)); +++ strcat(cmdbuf, ")"); +++ } +++/* +++ if (xflg == 0 && gflg == 0 && tptr == 0 && cp[0] == '-') +++ return (0); +++*/ +++ return (savestr(cmdbuf)); +++ +++bad: +++ fprintf(stderr, "ps: error locating command name for pid %d\n", +++ mproc->p_pid); +++retucomm: +++ strcpy(cmdbuf, " ("); +++ strncat(cmdbuf, u.u_comm, sizeof (u.u_comm)); +++ strcat(cmdbuf, ")"); +++ return (savestr(cmdbuf)); +++} +++ +++char *lhdr = +++" F UID PID PPID CP PRI NI ADDR SZ RSS WCHAN STAT TT TIME"; +++lpr(sp) +++ struct savcom *sp; +++{ +++ register struct asav *ap = sp->ap; +++ register struct lsav *lp = sp->sun.lp; +++ +++ printf("%6x%4d%6u%6u%3d%4d%3d%5x%4d%5d", +++ ap->a_flag, ap->a_uid, +++ ap->a_pid, lp->l_ppid, lp->l_cpu&0377, ap->a_pri-PZERO, +++ ap->a_nice-NZERO, lp->l_addr, ap->a_size/2, ap->a_rss/2); +++ printf(lp->l_wchan ? " %5x" : " ", (int)lp->l_wchan&0xfffff); +++ printf(" %4.4s ", state(ap)); +++ ptty(ap->a_tty); +++ ptime(ap); +++} +++ +++ptty(tp) +++ char *tp; +++{ +++ +++ printf("%-2.2s", tp); +++} +++ +++ptime(ap) +++ struct asav *ap; +++{ +++ +++ printf("%3ld:%02ld", ap->a_cpu / HZ, ap->a_cpu % HZ); +++} +++ +++char *uhdr = +++"USER PID %CPU %MEM SZ RSS TT STAT TIME"; +++upr(sp) +++ struct savcom *sp; +++{ +++ register struct asav *ap = sp->ap; +++ int vmsize, rmsize; +++ +++ vmsize = (ap->a_size + ap->a_tsiz)/2; +++ rmsize = ap->a_rss/2; +++ if (ap->a_xccount) +++ rmsize += ap->a_txtrss/ap->a_xccount/2; +++ printf("%-8.8s %5d%5.1f%5.1f%5d%5d", +++ getname(ap->a_uid), ap->a_pid, sp->sun.u_pctcpu, pmem(ap), +++ vmsize, rmsize); +++ putchar(' '); +++ ptty(ap->a_tty); +++ printf(" %4.4s", state(ap)); +++ ptime(ap); +++} +++ +++char *vhdr = +++" PID TT STAT TIME SL RE PAGEIN SIZE RSS SRS TSIZ TRS %CPU %MEM"; +++vpr(sp) +++ struct savcom *sp; +++{ +++ register struct vsav *vp = sp->sun.vp; +++ register struct asav *ap = sp->ap; +++ +++ printf("%5u ", ap->a_pid); +++ ptty(ap->a_tty); +++ printf(" %4.4s", state(ap)); +++ ptime(ap); +++ printf("%3d%3d%7d%5d%5d%5d%5d%4d%5.1f%5.1f", +++ ap->a_slptime, ap->a_time > 99 ? 99 : ap->a_time, vp->v_majflt, +++ ap->a_size/2, ap->a_rss/2, vp->v_swrss/2, +++ ap->a_tsiz/2, ap->a_txtrss/2, vp->v_pctcpu, pmem(ap)); +++} +++ +++char *shdr = +++"SSIZ PID TT STAT TIME"; +++spr(sp) +++ struct savcom *sp; +++{ +++ register struct asav *ap = sp->ap; +++ +++ if (sflg) +++ printf("%4d ", sp->sun.s_ssiz); +++ printf("%5u", ap->a_pid); +++ putchar(' '); +++ ptty(ap->a_tty); +++ printf(" %4.4s", state(ap)); +++ ptime(ap); +++} +++ +++char * +++state(ap) +++ register struct asav *ap; +++{ +++ char stat, load, nice, anom; +++ static char res[5]; +++ +++ switch (ap->a_stat) { +++ +++ case SSTOP: +++ stat = 'T'; +++ break; +++ +++ case SSLEEP: +++ if (ap->a_pri >= PZERO) +++ if (ap->a_slptime >= MAXSLP) +++ stat = 'I'; +++ else +++ stat = 'S'; +++ else if (ap->a_flag & SPAGE) +++ stat = 'P'; +++ else +++ stat = 'D'; +++ break; +++ +++ case SWAIT: +++ case SRUN: +++ case SIDL: +++ stat = 'R'; +++ break; +++ +++ case SZOMB: +++ stat = 'Z'; +++ break; +++ +++ default: +++ stat = '?'; +++ } +++ load = ap->a_flag & SLOAD ? ' ' : 'W'; +++ if (ap->a_nice < NZERO) +++ nice = '<'; +++ else if (ap->a_nice > NZERO) +++ nice = 'N'; +++ else +++ nice = ' '; +++ anom = ap->a_flag & (SANOM|SUANOM) ? 'A' : ' '; +++ res[0] = stat; res[1] = load; res[2] = nice; res[3] = anom; +++ return (res); + +} + + + +/* + + * Given a base/size pair in virtual swap area, + + * return a physical base/size pair which is the + + * (largest) initial, physically contiguous block. + + */ + +vstodb(vsbase, vssize, dmp, dbp, rev) + + register int vsbase; + + int vssize; + + struct dmap *dmp; + + register struct dblock *dbp; + +{ + + register int blk = DMMIN; + + register swblk_t *ip = dmp->dm_map; + + + + if (vsbase < 0 || vsbase + vssize > dmp->dm_size) + + panic("vstodb"); + + while (vsbase >= blk) { + + vsbase -= blk; + + if (blk < DMMAX) + + blk *= 2; + + ip++; + + } + + if (*ip <= 0 || *ip + blk > nswap) + + panic("vstodb *ip"); + + dbp->db_size = min(vssize, blk - vsbase); + + dbp->db_base = *ip + (rev ? blk - (vsbase + dbp->db_size) : vsbase); + +} + + +++/*ARGSUSED*/ + +panic(cp) + + char *cp; + +{ + + + +#ifdef DEBUG + + printf("%s\n", cp); + +#endif + +} + + + +min(a, b) + +{ + + + + return (a < b ? a : b); + +} + + - done(exitno) +++pscomp(s1, s2) +++ struct savcom *s1, *s2; + +{ - if (login) { - printf("Press return when done: "); - getchar(); - } - exit(exitno); +++ register int i; +++ +++ if (uflg) +++ return (s2->sun.u_pctcpu > s1->sun.u_pctcpu ? 1 : -1); +++ if (vflg) +++ return (vsize(s2) - vsize(s1)); +++ i = s1->ap->a_ttyd - s2->ap->a_ttyd; +++ if (i == 0) +++ i = s1->ap->a_pid - s2->ap->a_pid; +++ return (i); +++} +++ +++vsize(sp) +++ struct savcom *sp; +++{ +++ register struct asav *ap = sp->ap; +++ register struct vsav *vp = sp->sun.vp; +++ +++ if (ap->a_flag & SLOAD) +++ return (ap->a_rss + +++ ap->a_txtrss / (ap->a_xccount ? ap->a_xccount : 1)); +++ return (vp->v_swrss + (ap->a_xccount ? 0 : vp->v_txtswrss)); + +} + + +++#define NMAX 8 +++#define NUID 2048 +++ +++char names[NUID][NMAX+1]; +++ + +/* - * fixup figures out everybodys name and sorts into a nice order. +++ * Stolen from ls... + + */ - fixup(np) int np; { - register int i; +++char * +++getname(uid) +++{ + + register struct passwd *pw; +++ static init; + + struct passwd *getpwent(); + + - if (uflg) { - /* - * If we want names, traverse the password file. For each - * passwd entry, look for it in the processes. - * In case of multiple entries in /etc/passwd, we believe - * the first one (same thing ls does). - */ - while ((pw=getpwent()) != NULL) { - for (i=0; i pw_uid) { - if (outargs[i].o_uname[0] == 0) - strcpy(outargs[i].o_uname, pw -> pw_name); - } - } +++ if (uid >= 0 && uid < NUID && names[uid][0]) +++ return (&names[uid][0]); +++ if (init == 2) +++ return (0); +++ if (init == 0) +++ setpwent(), init = 1; +++ while (pw = getpwent()) { +++ if (pw->pw_uid >= NUID) +++ continue; +++ if (names[pw->pw_uid][0]) +++ continue; +++ strncpy(names[pw->pw_uid], pw->pw_name, NMAX); +++ if (pw->pw_uid == uid) +++ return (&names[uid][0]); + + } +++ init = 2; +++ endpwent(); +++ return (0); +++} + + - qsort(outargs, np, sizeof(outargs[0]), pscomp); +++char *freebase; +++int nleft; +++ +++char * +++alloc(size) +++ int size; +++{ +++ register char *cp; +++ register int i; +++ +++ if (size > nleft) { +++ freebase = (char *)sbrk(i = size > 2048 ? size : 2048); +++ if (freebase == 0) { +++ fprintf(stderr, "ps: ran out of memory\n"); +++ exit(1); +++ } +++ nleft = i - size; +++ } else +++ nleft -= size; +++ cp = freebase; +++ for (i = size; --i >= 0; ) +++ *cp++ = 0; +++ freebase = cp; +++ return (cp - size); + +} + + - pscomp(x1, x2) struct psout *x1, *x2; { - register int c; +++char * +++savestr(cp) +++ char *cp; +++{ +++ register int len; +++ register char *dp; + + - c = (x1)->o_ttyd - (x2)->o_ttyd; - if (c==0) c = (x1)->o_pid - (x2)->o_pid; - return(c); +++ len = strlen(cp); +++ dp = (char *)alloc(len+1); +++ strcpy(dp, cp); +++ return (dp); + +} diff --cc usr/src/cmd/pstat.c index 0000000000,536f6b9c11,0000000000..2455dc754a mode 000000,100644,000000..100644 --- a/usr/src/cmd/pstat.c +++ b/usr/src/cmd/pstat.c @@@@ -1,0 -1,558 -1,0 +1,626 @@@@ +++static char *sccsid = "@(#)pstat.c 4.3 (Berkeley) 11/15/80"; + +/* + + * Print system stuff + + */ + + + +#define mask(x) (x&0377) + +#define clear(x) ((int)x&0x7fffffff) + + + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include + +#include +++#include +++#include + + + +char *fcore = "/dev/kmem"; + +char *fnlist = "/vmunix"; + +int fc; + + - struct setup { - char name[8]; - int type; - unsigned value; - } setup[] = { +++struct nlist nl[] = { + +#define SINODE 0 - "_inode", 0, 0, +++ { "_inode" }, + +#define STEXT 1 - "_text", 0, 0, +++ { "_text" }, + +#define SPROC 2 - "_proc", 0, 0, +++ { "_proc" }, + +#define SDZ 3 - "_dz_tty", 0, 0, +++ { "_dz_tty" }, + +#define SNDZ 4 - "_dz_cnt", 0, 0, +++ { "_dz_cnt" }, + +#define SKL 5 - "_cons", 0, 0, +++ { "_cons" }, + +#define SFIL 6 - "_file", 0, 0, - #define SMPXC 7 - "_mpx_cha", 0, 0, - #define SMPXM 8 - "_mpx_mac", 0, 0, - #define SMPXB1 9 - "_mptbc", 0, 0, - #define SMPXB2 10 - "_mptbuf", 0, 0, - #define SMPSM 11 - "_mpsm", 0, 0, +++ { "_file" }, +++#define USRPTMA 7 +++ { "_Usrptmap" }, +++#define USRPT 8 +++ { "_usrpt" }, +++#define SNSWAP 9 +++ { "_nswap" }, +++#define SWAPMAP 10 +++ { "_swapmap" }, +++#define SDH 11 +++ { "_dh11" }, +++#define SNDH 12 +++ { "_ndh11" }, + + 0, + +}; + + + +int inof; + +int txtf; + +int prcf; + +int ttyf; - int mpxf; + +int usrf; + +long ubase; + +int filf; +++int swpf; +++int totflg; + +char partab[1]; + +struct cdevsw cdevsw[1]; + +struct bdevsw bdevsw[1]; + +int allflg; + +int kflg; +++struct pte *Usrptma; +++struct pte *usrpt; + + + +main(argc, argv) + +char **argv; + +{ + + register char *argp; + + + + argc--, argv++; + + while (argc > 0 && **argv == '-') { + + argp = *argv++; + + argp++; + + argc--; + + while (*argp++) + + switch (argp[-1]) { + + +++ case 'T': +++ totflg++; +++ break; +++ + + case 'a': + + allflg++; + + break; + + + + case 'i': + + inof++; + + break; + + + + case 'k': + + kflg++; + + fcore = "/vmcore"; + + break; + + + + case 'x': + + txtf++; + + break; +++ + + case 'p': + + prcf++; + + break; + + + + case 't': + + ttyf++; + + break; + + - case 'm': - mpxf++; - break; - + + case 'u': + + if (argc == 0) + + break; + + argc--; + + usrf++; + + sscanf( *argv++, "%x", &ubase); + + break; + + + + case 'f': + + filf++; + + break; +++ case 's': +++ swpf++; +++ break; + + } + + } + + if (argc>0) + + fcore = argv[0]; + + if ((fc = open(fcore, 0)) < 0) { + + printf("Can't find %s\n", fcore); + + exit(1); + + } + + if (argc>1) + + fnlist = argv[1]; - nlist(fnlist, setup); +++ nlist(fnlist, nl); + + if (kflg) { - register struct setup *sp; - for (sp=setup; sp->value; sp++) - sp->value &= 0x7fffffff; +++ register struct nlist *nlp; +++ for (nlp=nl; nlp < &nl[sizeof (nl)/sizeof(nl[0])]; nlp++) +++ nlp->n_value = clear(nlp->n_value); + + } - if (setup[SINODE].type == -1) { +++ usrpt = (struct pte *)nl[USRPT].n_value; +++ Usrptma = (struct pte *)nl[USRPTMA].n_value; +++ if (nl[0].n_type == 0) { + + printf("no namelist\n"); + + exit(1); + + } - if (inof) +++ if (filf||totflg) +++ dofil(); +++ if (inof||totflg) + + doinode(); - if (txtf) +++ if (prcf||totflg) +++ doproc(); +++ if (txtf||totflg) + + dotext(); + + if (ttyf) + + dotty(); - if (prcf) - doproc(); + + if (usrf) + + dousr(); - if (filf) - dofil(); - /* - if(mpxf) - dompx(); - */ +++ if (swpf||totflg) +++ doswap(); + +} + + + +doinode() + +{ + + register struct inode *ip; + + struct inode xinode[NINODE]; + + register int nin, loc; + + + + nin = 0; - lseek(fc, (long)setup[SINODE].value, 0); +++ lseek(fc, (long)nl[SINODE].n_value, 0); + + read(fc, xinode, sizeof(xinode)); + + for (ip = xinode; ip < &xinode[NINODE]; ip++) + + if (ip->i_count) + + nin++; - printf("%d active xinodes\n", nin); - printf(" LOC FLAGS CNT DEVICE INO MODE NLK UID SIZE/DEV\n"); - loc = setup[SINODE].value; +++ if (totflg) { +++ printf("%3d/%3d inodes\n", nin, NINODE); +++ return; +++ } +++ printf("%d/%d active xinodes\n", nin, NINODE); +++ printf(" LOC FLAGS CNT DEVICE INO MODE NLK UID SIZE/DEV\n"); +++ loc = nl[SINODE].n_value; + + for (ip = xinode; ip < &xinode[NINODE]; ip++, loc += sizeof(xinode[0])) { + + if (ip->i_count == 0) + + continue; + + printf("%8.1x ", loc); + + putf(ip->i_flag&ILOCK, 'L'); + + putf(ip->i_flag&IUPD, 'U'); + + putf(ip->i_flag&IACC, 'A'); + + putf(ip->i_flag&IMOUNT, 'M'); + + putf(ip->i_flag&IWANT, 'W'); + + putf(ip->i_flag&ITEXT, 'T'); + + printf("%4d", ip->i_count&0377); + + printf("%4d,%3d", major(ip->i_dev), minor(ip->i_dev)); - printf("%5l", ip->i_number); +++ printf("%6d", ip->i_number); + + printf("%6x", ip->i_mode & 0xffff); + + printf("%4d", ip->i_nlink); + + printf("%4d", ip->i_uid); + + if ((ip->i_mode&IFMT)==IFBLK || (ip->i_mode&IFMT)==IFCHR) + + printf("%6d,%3d", major(ip->i_un.i_rdev), minor(ip->i_un.i_rdev)); + + else + + printf("%10ld", ip->i_size); + + printf("\n"); + + } + +} + + + +putf(v, n) + +{ + + if (v) + + printf("%c", n); + + else + + printf(" "); + +} + + + +dotext() + +{ + + register struct text *xp; + + struct text xtext[NTEXT]; + + register loc; + + int ntx; + + + + ntx = 0; - lseek(fc, (long)setup[STEXT].value, 0); +++ lseek(fc, (long)nl[STEXT].n_value, 0); + + read(fc, xtext, sizeof(xtext)); + + for (xp = xtext; xp < &xtext[NTEXT]; xp++) + + if (xp->x_iptr!=NULL) + + ntx++; - printf("%d text segments\n", ntx); - printf(" LOC FLAGS DADDR CADDR RSS SIZE IPTR CNT CCNT\n"); - loc = setup[STEXT].value; +++ if (totflg) { +++ printf("%3d/%3d texts\n", ntx, NTEXT); +++ return; +++ } +++ printf(" LOC FLAGS DADDR CADDR RSS SIZE IPTR CNT CCNT\n"); +++ loc = nl[STEXT].n_value; + + for (xp = xtext; xp < &xtext[NTEXT]; xp++, loc+=sizeof(xtext[0])) { + + if (xp->x_iptr == NULL) + + continue; + + printf("%8.1x", loc); + + printf(" "); + + putf(xp->x_flag&XPAGI, 'P'); + + putf(xp->x_flag&XTRC, 'T'); + + putf(xp->x_flag&XWRIT, 'W'); + + putf(xp->x_flag&XLOAD, 'L'); + + putf(xp->x_flag&XLOCK, 'K'); + + putf(xp->x_flag&XWANT, 'w'); - printf("%5x", xp->x_daddr); +++ printf("%5x", xp->x_daddr[0]); + + printf("%11x", xp->x_caddr); + + printf("%5d", xp->x_rssize); + + printf("%5d", xp->x_size); + + printf("%10.1x", xp->x_iptr); + + printf("%5d", xp->x_count&0377); - printf("%4d", xp->x_ccount); +++ printf("%5d", xp->x_ccount); + + printf("\n"); + + } + +} + + + +doproc() + +{ + + struct proc xproc[NPROC]; + + register struct proc *pp; + + register loc, np; +++ struct pte apte; + + - lseek(fc, (long)setup[SPROC].value, 0); +++ lseek(fc, (long)nl[SPROC].n_value, 0); + + read(fc, xproc, sizeof(xproc)); + + np = 0; + + for (pp=xproc; pp < &xproc[NPROC]; pp++) + + if (pp->p_stat) + + np++; - printf("%d processes\n", np); - printf(" LOC S F POIP PRI SIG UID SLP TIM CPU NI PGRP PID PPID ADDR RSS SRSS SIZE WCHAN LINK TEXTP CLKT\n"); - for (loc=setup[SPROC].value,pp=xproc; pp<&xproc[NPROC]; pp++,loc+=sizeof(xproc[0])) { +++ if (totflg) { +++ printf("%3d/%3d processes\n", np, NPROC); +++ return; +++ } +++ printf("%d/%d processes\n", np, NPROC); +++ printf(" LOC S F POIP PRI SIG UID SLP TIM CPU NI PGRP PID PPID ADDR RSS SRSS SIZE WCHAN LINK TEXTP CLKT\n"); +++ for (loc=nl[SPROC].n_value,pp=xproc; pp<&xproc[NPROC]; pp++,loc+=sizeof(xproc[0])) { + + if (pp->p_stat==0 && allflg==0) + + continue; + + printf("%8x", loc); + + printf(" %2d", pp->p_stat); + + printf(" %4x", pp->p_flag & 0xffff); + + printf(" %4d", pp->p_poip); + + printf(" %3d", pp->p_pri); - printf(" %4x", pp->p_sig); +++ printf(" %8x", pp->p_sig); + + printf(" %4d", pp->p_uid); + + printf(" %3d", pp->p_slptime); + + printf(" %3d", pp->p_time); + + printf(" %4d", pp->p_cpu&0377); + + printf(" %3d", pp->p_nice); + + printf(" %6d", pp->p_pgrp); + + printf(" %6d", pp->p_pid); + + printf(" %6d", pp->p_ppid); - printf(" %8x", pp->p_addr[0]); +++ if (kflg) +++ pp->p_addr = (struct pte *)clear((int)pp->p_addr); +++ lseek(fc, (long)(Usrptma+btokmx(pp->p_addr)), 0); +++ read(fc, &apte, sizeof(apte)); +++ printf(" %8x", ctob(apte.pg_pfnum+1) - sizeof(struct pte) * UPAGES); + + printf(" %4x", pp->p_rssize); + + printf(" %4x", pp->p_swrss); + + printf(" %5x", pp->p_dsize+pp->p_ssize); + + printf(" %7x", clear(pp->p_wchan)); + + printf(" %7x", clear(pp->p_link)); + + printf(" %7x", clear(pp->p_textp)); + + printf(" %u", pp->p_clktim); + + printf("\n"); + + } + +} + + + +dotty() + +{ - struct tty dz_tty[32]; +++ struct tty dz_tty[64]; + + int ndz; + + register struct tty *tp; + + register char *mesg; + + + + printf("1 cons\n"); - lseek(fc, (long)setup[SKL].value, 0); +++ lseek(fc, (long)nl[SKL].n_value, 0); + + read(fc, dz_tty, sizeof(dz_tty[0])); - mesg = " RAW CAN OUT MODE ADDR DEL COL STATE PGRP\n"; +++ mesg = " # RAW CAN OUT MODE ADDR DEL COL STATE PGRP DISC\n"; + + printf(mesg); - ttyprt(&dz_tty[0]); - if (setup[SNDZ].type == -1) - return; - lseek(fc, (long)setup[SNDZ].value, 0); +++ ttyprt(&dz_tty[0], 0); +++ if (nl[SNDZ].n_type == 0) +++ goto dh; +++ lseek(fc, (long)nl[SNDZ].n_value, 0); + + read(fc, &ndz, sizeof(ndz)); + + printf("%d dz lines\n", ndz); - lseek(fc, (long)setup[SDZ].value, 0); +++ lseek(fc, (long)nl[SDZ].n_value, 0); + + read(fc, dz_tty, sizeof(dz_tty)); + + for (tp = dz_tty; tp < &dz_tty[ndz]; tp++) - ttyprt(tp); +++ ttyprt(tp, tp - dz_tty); +++dh: +++ if (nl[SNDH].n_type == 0) +++ return; +++ lseek(fc, (long)nl[SNDH].n_value, 0); +++ read(fc, &ndz, sizeof(ndz)); +++ printf("%d dh lines\n", ndz); +++ lseek(fc, (long)nl[SDH].n_value, 0); +++ read(fc, dz_tty, sizeof(dz_tty)); +++ for (tp = dz_tty; tp < &dz_tty[ndz]; tp++) +++ ttyprt(tp, tp - dz_tty); + +} + + - ttyprt(atp) +++ttyprt(atp, line) + +struct tty *atp; + +{ + + register struct tty *tp; + + +++ printf("%2d", line); + + tp = atp; - printf("%4d", tp->t_rawq.c_cc); - printf("%4d", tp->t_canq.c_cc); +++ switch (tp->t_line) { +++ +++ case NETLDISC: +++ if (tp->t_rec) +++ printf("%4d%4d", 0, tp->t_inbuf); +++ else +++ printf("%4d%4d", tp->t_inbuf, 0); +++ break; +++ +++ default: +++ printf("%4d", tp->t_rawq.c_cc); +++ printf("%4d", tp->t_canq.c_cc); +++ } + + printf("%4d", tp->t_outq.c_cc); + + printf("%8.1o", tp->t_flags); + + printf(" %8.1x", tp->t_addr); + + printf("%3d", tp->t_delct); + + printf("%4d ", tp->t_col); + + putf(tp->t_state&TIMEOUT, 'T'); + + putf(tp->t_state&WOPEN, 'W'); + + putf(tp->t_state&ISOPEN, 'O'); + + putf(tp->t_state&CARR_ON, 'C'); + + putf(tp->t_state&BUSY, 'B'); + + putf(tp->t_state&ASLEEP, 'A'); + + putf(tp->t_state&XCLUDE, 'X'); + +/* + + putf(tp->t_state&HUPCLS, 'H'); + + */ + + printf("%6d", tp->t_pgrp); +++ switch (tp->t_line) { +++ +++ case NTTYDISC: +++ printf(" ntty"); +++ break; +++ +++ case NETLDISC: +++ printf(" net"); +++ break; +++ } + + printf("\n"); + +} + + + +dousr() + +{ + + struct user U; + + register i, j, *ip; + + + + /* This wins only if PAGSIZ > sizeof (struct user) */ + + lseek(fc, ubase * NBPG, 0); + + read(fc, &U, sizeof(U)); - /* - printf("rsav %.1o %.1o\n", U.u_rsav[0], U.u_rsav[1]); - */ - printf("segflg, error %d, %d\n", U.u_segflg, U.u_error); - printf("uids %d,%d,%d,%d\n", U.u_uid,U.u_gid,U.u_ruid,U.u_rgid); - printf("procp %.1x\n", U.u_procp); +++ printf("pcb"); +++ ip = (int *)&U.u_pcb; +++ while (ip < &U.u_arg[0]) { +++ if ((ip - (int *)&U.u_pcb) % 4 == 0) +++ printf("\t"); +++ printf("%x ", *ip++); +++ if ((ip - (int *)&U.u_pcb) % 4 == 0) +++ printf("\n"); +++ } +++ if ((ip - (int *)&U.u_pcb) % 4 != 0) +++ printf("\n"); +++ printf("arg\t"); +++ for (i=0; i<5; i++) +++ printf(" %.1x", U.u_arg[i]); +++ printf("\n"); +++ for (i=0; if_count) + + nf++; - printf("%d open files\n", nf); +++ if (totflg) { +++ printf("%3d/%3d files\n", nf, NFILE); +++ return; +++ } +++ printf("%d/%d open files\n", nf, NFILE); + + printf(" LOC FLG CNT INO OFFS\n"); - for (fp=xfile,loc=setup[SFIL].value; fp < &xfile[NFILE]; fp++,loc+=sizeof(xfile[0])) { +++ for (fp=xfile,loc=nl[SFIL].n_value; fp < &xfile[NFILE]; fp++,loc+=sizeof(xfile[0])) { + + if (fp->f_count==0) + + continue; + + printf("%8x ", loc); + + putf(fp->f_flag&FREAD, 'R'); + + putf(fp->f_flag&FWRITE, 'W'); + + putf(fp->f_flag&FPIPE, 'P'); + + printf("%4d", mask(fp->f_count)); + + printf("%9.1x", fp->f_inode); + + printf(" %ld\n", fp->f_un.f_offset); + + } + +} + + - /********* - #include - dompx() +++doswap() + +{ - struct chan chan[C]; - struct mach mach[M]; - struct line line[M-1]; - int mptbc; - char mptbuf[TBSIZ]; - register struct chan *cp; - register struct mach *mp; - register struct line *lp; - int loc, nc; - - lseek(fc, (long)setup[SMPXC].value, 0); - read(fc, chan, sizeof(chan)); - lseek(fc, (long)setup[SMPXM].value, 0); - read(fc, mach, sizeof(mach)); - lseek(fc, (long)setup[SMPXB1].value, 0); - read(fc, &mptbc, sizeof(mptbc)); - lseek(fc, (long)setup[SMPXB2].value, 0); - read(fc, mptbuf, sizeof(mptbuf)); - lseek(fc, (long)setup[SMPSM].value, 0); - read(fc, line, sizeof(line)); - nc = 0; - for(cp=chan; cp < &chan[C]; cp++) - if(cp->cflag&ALLOC) - nc++; - printf("%d mpx channels\n", nc); - printf(" LOC FLG M C DEST\n"); - for(cp=chan,loc=setup[SMPXC].value; cp < &chan[C]; cp++,loc=+sizeof(chan[0])) { - if((cp->cflag&ALLOC) == 0) - continue; - printf("%7.1o ", loc); - putf(cp->cflag&BLOCK, 'B'); - putf(cp->cflag&WWAIT, 'B'); - putf(cp->cflag&CRUN, 'R'); - putf(cp->cflag&RWAIT, 'W'); - putf(cp->cflag&ALLOC, 'A'); - putf(cp->cflag&DIS, 'D'); - putf(cp->cflag&DLY, 'D'); - printf(" %1d %3d ", mask(cp->m), mask(cp->c)); - printf("%7.1o ", cp->dest); - printf("\n"); - } +++ struct proc proc[NPROC]; +++ struct text xtext[NTEXT]; +++ struct map swapmap[SMAPSIZ]; +++ register struct proc *pp; +++ int nswap, used, tused, free; +++ register struct map *mp; +++ register struct text *xp; + + - printf("%d mpx machines\n", M); - printf(" LOC FLG RCH RCN XCH XCN\n"); - for(mp=mach,loc=setup[SMPXM].value; mp < &mach[M]; mp++,loc=+sizeof(mach[0])) { - printf("%7.1o ", loc); - putf(mp->mflag&RNEXT, 'N'); - putf(mp->mflag&MRUN, 'R'); - putf(mp->mflag&XNEXT, 'N'); - printf(" %3d", mask(mp->rchan)); - printf(" %3d", mask(mp->rcount)); - printf(" %3d", mask(mp->xchan)); - printf(" %3d", mask(mp->xcount)); - for(nc=0; nc<128; nc++) { - cp = mp->chanp[nc]; - if(cp == 0) - continue; - printf(" %d-%o", nc, cp); - } - printf("\n"); +++ lseek(fc, (long)nl[SPROC].n_value, 0); +++ read(fc, proc, sizeof(proc)); +++ lseek(fc, (long)nl[SWAPMAP].n_value, 0); +++ read(fc, swapmap, sizeof(swapmap)); +++ lseek(fc, (long)nl[SNSWAP].n_value, 0); +++ read(fc, &nswap, sizeof(nswap)); +++ free = 0; +++ for (mp = swapmap; mp < &swapmap[SMAPSIZ]; mp++) +++ free += mp->m_size; +++ lseek(fc, (long)nl[STEXT].n_value, 0); +++ read(fc, xtext, sizeof(xtext)); +++ tused = 0; +++ for (xp = xtext; xp < &xtext[NTEXT]; xp++) +++ if (xp->x_iptr!=NULL) +++ tused += xdsize(xp); +++ used = tused; +++ for (pp = proc; pp < &proc[NPROC]; pp++) { +++ if (pp->p_stat == 0 || pp->p_stat == SZOMB) +++ continue; +++ if (pp->p_flag & SSYS) +++ continue; +++ used += up(pp->p_dsize) + up(pp->p_ssize); +++ if ((pp->p_flag&SLOAD) == 0) +++ used += vusize(pp); + + } - printf("%d mpx lines\n", M-1); - printf(" LOC RSQ XSQ AKF XMF STE TIM SUM\n"); - for(lp=line,loc=setup[SMPSM].value; lp < &line[M-1]; lp++, loc =+ sizeof(line[0])) { - printf("%7.1o ", loc); - printf("%3o ", lp->rseq); - printf("%3o ", lp->xseq); - printf("%3o ", lp->ackf); - printf("%3o ", lp->xflag); - printf("%3d ", lp->state); - printf("%3d ", lp->time); - printf("%7o\n", lp->sum); +++ /* a DMMAX block goes to argmap */ +++ if (totflg) { +++ printf("%3d/%3d 00k swap\n", used/2/100, (used+free)/2/100); +++ return; + + } - printf("last characters recieved\n"); - nc = -1; - loc = mptbc; - for(;;) { - if(nc != mptbuf[loc]) { - if(nc >= 0) - printf(")\n"); - nc = mptbuf[loc]; - printf("%d(", nc); - } else - printf(","); - loc++; - if(loc >= TBSIZ) - loc = 0; - if(loc == mptbc) - break; - printf("%o", mask(mptbuf[loc])); - loc++; - if(loc >= TBSIZ) - loc = 0; - if(loc == mptbc) - break; +++ printf("%d used (%d text), %d free, %d missing\n", +++ used/2, tused/2, free/2, (nswap - DMMAX - (used + free))/2); +++} +++ +++up(size) +++ register int size; +++{ +++ register int i, block; +++ +++ i = 0; +++ block = DMMIN; +++ while (i < size) { +++ i += block; +++ if (block < DMMAX) +++ block *= 2; + + } - printf(")\n"); +++ return (i); +++} +++ +++vusize(p) +++struct proc *p; +++{ +++ register int tsz = p->p_tsize / NPTEPG; +++ +++ return (clrnd(UPAGES + clrnd(ctopt(p->p_tsize+p->p_dsize+p->p_ssize+UPAGES)) - tsz)); +++} +++ +++xdsize(xp) +++struct text *xp; +++{ +++ +++ if (xp->x_flag & XPAGI) +++ return (clrnd(xp->x_size + ctopt(xp->x_size))); +++ return (xp->x_size); + +} - *********/ diff --cc usr/src/cmd/pti.c index 0000000000,ff63de4002,0000000000..1c2f9a662a mode 000000,100644,000000..100644 --- a/usr/src/cmd/pti.c +++ b/usr/src/cmd/pti.c @@@@ -1,0 -1,394 -1,0 +1,400 @@@@ +++static char *sccsid = "@(#)pti.c 4.1 (Berkeley) 10/1/80"; + +#define DBL 0200 + +/* + +C version of pti + +*/ + + + +char *ap; + +char ibuf[512]; + +char *ibufp = ibuf; + +char *eibufp = ibuf; + +int fid; + +int esc; + +int escd; + +int verd; + +int esct; + +int osize = 02; + +int size = 02; + +int leadtot; + +int railmag; + +int lead; + +int mcase; + +int stab[] = {010,0,01,07,02,03,04,05,0211,06,0212,0213,0214,0215,0216,0217}; + +int rtab[] = {6, 7, 8, 9, 10, 11, 12, 14, 16, 18, 20, 22, 24, 28, 36, 18}; + +char *asctab[128]; + +char *spectab[128]; + +long offset; + +int lflg; + +int xxx; + + + +main(argc,argv) + +int argc; + +char **argv; + +{ + + register i, j; + + register char *k; + + extern ex(); + + + + while((--argc > 0) && ((++argv)[0][0]=='-')){ + + switch(argv[0][1]){ + + case 'l': + + lflg++; + + continue; + + default: + + ap = &argv[0][1]; + + while(((j = *ap++ - '0') >= 0) + + && (j <= 9))offset = 8*offset +j; + + continue; + + } + + } + + if(argc){ + + if((fid=open(argv[0], 0)) < 0){ + + printf("Cannot open: %s\n",argv[0]); + + exit(1); + + } + + } + + lseek(fid,offset,0); + + while((i = getc()) >= 0){ + + if(i & 0200){ + + if(!lflg)printf("%o ",i); + + esc += (~i) & 0177; + + continue; + + } + + if(esc){ + + if(escd){ + + if(!lflg)printf("< %d\n",esc); + + esc = -esc; + + }else{ + + if(!lflg)printf("> %d\n",esc); + + } + + esct += esc; + + esc = 0; + + } + + if(!lflg)printf("%o ",i); + + if(!i){if(!lflg)printf("\n"); continue;} + + switch(i){ + + case 0100: /*init*/ + + escd = verd = mcase = railmag = 0; + + if(!lflg)printf("Initialize\n"); + + continue; + + case 0101: /*lower rail*/ + + railmag &= ~01; + + if(!lflg)printf("Lower rail\n"); + + continue; + + case 0102: /*upper rail*/ + + railmag |= 01; + + if(!lflg)printf("Upper rail\n"); + + continue; + + case 0103: /*upper mag*/ + + railmag |= 02; + + if(!lflg)printf("Upper mag\n"); + + continue; + + case 0104: /*lower mag*/ + + railmag &= ~02; + + if(!lflg)printf("Lower mag\n"); + + continue; + + case 0105: /*lower case*/ + + mcase = 0; + + if(!lflg)printf("Lower case\n"); + + continue; + + case 0106: /*upper case*/ + + mcase = 0100; + + if(!lflg)printf("Upper case\n"); + + continue; + + case 0107: /*escape forward*/ + + escd = 0; + + if(!lflg)printf("> mode, %d\n",esct); + + continue; + + case 0110: /*escape backward*/ + + escd = 1; + + if(!lflg)printf("< mode, %d\n",esct); + + continue; + + case 0111: /*stop*/ + + if(!lflg)printf("STOP\n"); + + continue; + + case 0112: /*lead forward*/ + + verd = 0; + + if(!lflg)printf("Lead forward, %d\n",leadtot); + + continue; + + case 0114: /*lead backward*/ + + verd = 1; + + if(!lflg)printf("Lead backward, %d\n",leadtot); + + continue; + + case 0115: /*undefined*/ +++ if(!lflg)printf("New page\n"); +++ continue; + + case 0116: +++ lead = 64 * getc(); +++ goto leadin; + + case 0117: + + case 0113: + + if(!lflg)printf("Undefined code\n"); + + continue; + + } + + if((i & 0340) == 0140){ /*leading*/ + + lead = (~i) & 037; +++leadin: + + if(!lflg)printf("Lead %d\n",lead); + + if(verd)lead = -lead; + + leadtot += lead; + + continue; + + } + + if((i & 0360) == 0120){ /*size change*/ + + i &= 017; + + for(j = 0; i != (stab[j] & 017); j++); + + osize = size; + + size = stab[j]; + + if(!lflg){ + + printf("Size %d",rtab[j]); + + if(!(osize & DBL) && (size & DBL))printf(", double\n"); + + else if((osize & DBL) && !(size & DBL))printf(", single\n"); + + else printf("\n"); + + } + + continue; + + } + + if(i & 0300)continue; + + i = (i & 077) | mcase; + + if(railmag != 03)k = asctab[i]; + + else k = spectab[i]; + + if(!lflg)printf("%s\n",k); + + continue; + + } + + ex(); + +} + +ex(){ + + printf("Total lead %d\n",leadtot); + + exit(0); + +} + +getc(){ + + register i; + + + + if(ibufp >= eibufp){ + + if((i=read(fid,ibuf,512)) <= 0)ex(); + + eibufp = ibuf + i; + + ibufp = ibuf; + + } + + return(*ibufp++ & 0377); + +} + +char *asctab[128] = { + + 0, /*blank*/ + +"h", /*h*/ + +"t", /*t*/ + +"n", /*n*/ + +"m", /*m*/ + +"l", /*l*/ + +"i", /*i*/ + +"z", /*z*/ + +"s", /*s*/ + +"d", /*d*/ + +"b", /*b*/ + +"x", /*x*/ + +"f", /*f*/ + +"j", /*j*/ + +"u", /*u*/ + +"k", /*k*/ + + 0, /*blank*/ + +"p", /*p*/ + +"-", /*_ 3/4 em dash*/ + +";", /*;*/ + + 0, /*blank*/ + +"a", /*a*/ + +"_", /*rule*/ + +"c", /*c*/ + +"`", /*` open*/ + +"e", /*e*/ + +"'", /*' close*/ + +"o", /*o*/ + + 0, /*1/4*/ + +"r", /*r*/ + + 0, /*1/2*/ + +"v", /*v*/ + +"-", /*- hyphen*/ + +"w", /*w*/ + +"q", /*q*/ + +"/", /*/*/ + +".", /*.*/ + +"g", /*g*/ + + 0, /*3/4*/ + +",", /*,*/ + +"&", /*&*/ + +"y", /*y*/ + + 0, /*blank*/ + +"%", /*%*/ + + 0, /*blank*/ + +"Q", /*Q*/ + +"T", /*T*/ + +"O", /*O*/ + +"H", /*H*/ + +"N", /*N*/ + +"M", /*M*/ + +"L", /*L*/ + +"R", /*R*/ + +"G", /*G*/ + +"I", /*I*/ + +"P", /*P*/ + +"C", /*C*/ + +"V", /*V*/ + +"E", /*E*/ + +"Z", /*Z*/ + +"D", /*D*/ + +"B", /*B*/ + +"S", /*S*/ + +"Y", /*Y*/ + + 0, /*blank*/ + +"F", /*F*/ + +"X", /*X*/ + +"A", /*A*/ + +"W", /*W*/ + +"J", /*J*/ + +"U", /*U*/ + +"K", /*K*/ + +"0", /*0*/ + +"1", /*1*/ + +"2", /*2*/ + +"3", /*3*/ + +"4", /*4*/ + +"5", /*5*/ + +"6", /*6*/ + +"7", /*7*/ + +"8", /*8*/ + +"9", /*9*/ + +"*", /***/ + +"-", /*minus*/ + + 0, /*fi*/ + + 0, /*fl*/ + + 0, /*ff*/ + + 0, /*cent mark*/ + + 0, /*ffl*/ + + 0, /* ffi */ + +"(", /*(*/ + +")", /*)*/ + +"[", /*[*/ + +"]", /*]*/ + + 0, /*degree*/ + + 0, /*dagger*/ + +"=", /*=*/ + + 0, /*registered*/ + +":", /*:*/ + +"+", /*+*/ + + 0, /*blank*/ + +"!", /*!*/ + + 0, /*bullet*/ + +"?", /*?*/ + +"'", /*foot mark*/ + +"|", /*|*/ + + 0, /*blank*/ + + 0, /*copyright*/ + + 0, /*square*/ + +"$" }; /*$*/ + + + +char *spectab[128] = { + + 0, /*blank*/ + + 0, /*psi*/ + + 0, /*theta*/ + + 0, /*nu*/ + + 0, /*mu*/ + + 0, /*lambda*/ + + 0, /*iota*/ + + 0, /*zeta*/ + + 0, /*sigma*/ + + 0, /*delta*/ + + 0, /*beta*/ + + 0, /*xi*/ + + 0, /*eta*/ + + 0, /*phi*/ + + "u", /*upsilon*/ + + 0, /*kappa*/ + + 0, /*blank*/ + + 0, /*pi*/ + + "@", /*at sign @*/ + + 0, /*down arrow*/ + + 0, /*blank*/ + + 0, /*alpha*/ + +"|", /*or*/ + + 0, /*chi*/ + +"\"", /*"*/ + + 0, /*epsilon*/ + + "=", /*equals*/ + + "o", /*omicron*/ + + 0, /*left arrow*/ + + 0, /*rho*/ + + 0, /*up arrow*/ + + 0, /*tau*/ + +"_", /*underrule*/ + +"\\", /*\*/ + + 0, /*Psi*/ + + 0, /*bell system sign*/ + + 0, /*infinity*/ + + 0, /*gamma*/ + + 0, /*improper superset*/ + + 0, /*proportional to*/ + + 0, /*right hand*/ + + 0, /*omega*/ + + 0, /*blank*/ + + 0, /*gradient*/ + + 0, /*blank*/ + + 0, /*Phi*/ + + 0, /*Theta*/ + + 0, /*Omega*/ + + 0, /*cup (union)*/ + + 0, /*root en*/ + + 0, /*terminal sigma*/ + + 0, /*Lambda*/ + + "-", /*some horizontal line*/ + + 0, /*Gamma*/ + + 0, /*integral sign*/ + + 0, /*Pi*/ + + 0, /*subset of*/ + + 0, /*superset of*/ + + 0, /*approximates*/ + + 0, /*partial derivative*/ + + 0, /*Delta*/ + + 0, /*square root*/ + + 0, /*Sigma*/ + + 0, /*approx =*/ + + 0, /*blank*/ + +">", /*>*/ + + 0, /*Xi*/ + +"<", /*<*/ + +"/", /*slash (longer)*/ + + 0, /*cap (intersection)*/ + + "Y", /*Upsilon*/ + + 0, /*not*/ + +"|", /*right ceiling (rt of ")*/ + +"|", /*left top (of big curly)*/ + +"|", /*bold vertical*/ + +"|", /*left center of big curly bracket*/ + +"|", /*left bottom*/ + +"|", /*right top*/ + +"|", /*right center of big curly bracket*/ + +"|", /*right bot*/ + +"|", /*right floor (rb of ")*/ + +"|", /*left floor (left bot of big sq bract)*/ + +"|", /*left ceiling (lt of ")*/ + +"x", /*multiply*/ + + 0, /*divide*/ + + 0, /*plus-minus*/ + + 0, /*<=*/ + + 0, /*>=*/ + + 0, /*identically equal*/ + + 0, /*not equal*/ + +"{", /*{*/ + +"}", /*}*/ + +"'", /*' acute accent*/ + +"`", /*` grave accent*/ + +"^", /*^*/ + + "#", /*sharp*/ + + 0, /*left hand*/ + + 0, /*member of*/ + +"~", /*~*/ + + 0, /*empty set*/ + + 0, /*blank*/ + + 0, /*dbl dagger*/ + +"|", /*box rule*/ + + "*", /*telephone asterisk?*/ + + 0, /*improper subset*/ + + 0, /*circle*/ + + 0, /*blank*/ + + "+", /*eqn plus sign*/ + + 0, /*right arrow*/ + + 0 }; /*section mark*/ diff --cc usr/src/cmd/ptx.c index 0000000000,5edbdf42cd,0000000000..b3b01bacf3 mode 000000,100644,000000..100644 --- a/usr/src/cmd/ptx.c +++ b/usr/src/cmd/ptx.c @@@@ -1,0 -1,551 -1,0 +1,552 @@@@ +++static char *sccsid = "@(#)ptx.c 4.1 (Berkeley) 10/1/80"; + +# + + + +/* permuted title index + + ptx [-t] [-i ignore] [-o only] [-w num] [-f] [input] [output] + + Ptx reads the input file and permutes on words in it. + + It excludes all words in the ignore file. + + Alternately it includes words in the only file. + + if neither is given it excludes the words in /usr/lib/eign. + + + + The width of the output line can be changed to num + + characters. If omitted 72 is default unless troff than 100. + + the -f flag tells the program to fold the output + + the -t flag says the output is for troff and the + + output is then wider. + + + + make: cc ptx.c -lS + + */ + + + +#include + +#include + +#include + +#define DEFLTX "/usr/lib/eign" + +#define TILDE 0177 + +#define SORT "/usr/bin/sort" + +#define N 30 + +#define MAX N*BUFSIZ + +#define LMAX 200 + +#define MAXT 2048 + +#define MASK 03777 + +#define SET 1 + + + +#define isabreak(c) (btable[c]) + + + +extern char *calloc(), *mktemp(); + +extern char *getline(); + +int status; + + + + + +char *hasht[MAXT]; + +char line[LMAX]; + +char btable[128]; + +int ignore; + +int only; + +int llen = 72; + +int gap = 3; + +int gutter = 3; + +int mlen = LMAX; + +int wlen; + +int rflag; + +int halflen; + +char *strtbufp, *endbufp; + +char *empty = ""; + + + +char *infile; + +FILE *inptr = stdin; + + + +char *outfile; + +FILE *outptr = stdout; + + + +char *sortfile; /* output of sort program */ + +char nofold[] = {'-', 'd', 't', TILDE, 0}; + +char fold[] = {'-', 'd', 'f', 't', TILDE, 0}; + +char *sortopt = nofold; + +FILE *sortptr; + + + +char *bfile; /*contains user supplied break chars */ + +FILE *bptr; + + + +main(argc,argv) + +int argc; + +char **argv; + +{ + + register int c; + + register char *bufp; + + int pid; + + char *pend; + + extern onintr(); + + + + char *xfile; + + FILE *xptr; + + + + if(signal(SIGHUP,onintr)==SIG_IGN) + + signal(SIGHUP,SIG_IGN); + + if(signal(SIGINT,onintr)==SIG_IGN) + + signal(SIGINT,SIG_IGN); + + signal(SIGPIPE,onintr); + + signal(SIGTERM,onintr); + + + +/* argument decoding */ + + + + xfile = DEFLTX; + + argv++; + + while(argc>1 && **argv == '-') { + + switch (*++*argv){ + + + + case 'r': + + rflag++; + + break; + + case 'f': + + sortopt = fold; + + break; + + + + case 'w': + + if(argc >= 2) { + + argc--; + + wlen++; + + llen = atoi(*++argv); + + if(llen == 0) + + diag("Wrong width:",*argv); + + if(llen > LMAX) { + + llen = LMAX; + + msg("Lines truncated to 200 chars.",empty); + + } + + break; + + } + + + + case 't': + + if(wlen == 0) + + llen = 100; + + break; + + case 'g': + + if(argc >=2) { + + argc--; + + gap = gutter = atoi(*++argv); + + } + + break; + + + + case 'i': + + if(only) + + diag("Only file already given.",empty); + + if (argc>=2){ + + argc--; + + ignore++; + + xfile = *++argv; + + } + + break; + + + + case 'o': + + if(ignore) + + diag("Ignore file already given",empty); + + if (argc>=2){ + + only++; + + argc--; + + xfile = *++argv; + + } + + break; + + + + case 'b': + + if(argc>=2) { + + argc--; + + bfile = *++argv; + + } + + break; + + + + default: + + msg("Illegal argument:",*argv); + + } + + argc--; + + argv++; + + } + + + + if(argc>3) + + diag("Too many filenames",empty); + + else if(argc==3){ + + infile = *argv++; + + outfile = *argv; + + if((outptr = fopen(outfile,"w")) == NULL) + + diag("Cannot open output file:",outfile); + + } else if(argc==2) { + + infile = *argv; + + outfile = 0; + + } + + + + + + /* Default breaks of blank, tab and newline */ + + btable[' '] = SET; + + btable['\t'] = SET; + + btable['\n'] = SET; + + if(bfile) { + + if((bptr = fopen(bfile,"r")) == NULL) + + diag("Cannot open break char file",bfile); + + + + while((c = getc(bptr)) != EOF) + + btable[c] = SET; + + } + + + +/* Allocate space for a buffer. If only or ignore file present + + read it into buffer. Else read in default ignore file + + and put resulting words in buffer. + + */ + + + + + + if((strtbufp = calloc(N,BUFSIZ)) == NULL) + + diag("Out of memory space",empty); + + bufp = strtbufp; + + endbufp = strtbufp+MAX; + + + + if((xptr = fopen(xfile,"r")) == NULL) + + diag("Cannot open file",xfile); + + + + while(bufp < endbufp && (c = getc(xptr)) != EOF) { + + if(isabreak(c)) { + + if(storeh(hash(strtbufp,bufp),strtbufp)) + + diag("Too many words",xfile); + + *bufp++ = '\0'; + + strtbufp = bufp; + + } + + else { + + *bufp++ = (isupper(c)?tolower(c):c); + + } + + } + + if (bufp >= endbufp) + + diag("Too many words in file",xfile); + + endbufp = --bufp; + + + + /* open output file for sorting */ + + + + sortfile = mktemp("/tmp/ptxsXXXXX"); + + if((sortptr = fopen(sortfile, "w")) == NULL) + + diag("Cannot open output for sorting:",sortfile); + + + +/* get a line of data and compare each word for + + inclusion or exclusion in the sort phase + +*/ + + + + if (infile!=0 && (inptr = fopen(infile,"r")) == NULL) + + diag("Cannot open data: ",infile); + + while(pend=getline()) + + cmpline(pend); + + fclose(sortptr); + + + + switch (pid = fork()){ + + + + case -1: /* cannot fork */ + + diag("Cannot fork",empty); + + + + case 0: /* child */ + + execl(SORT, SORT, sortopt, "+0", "-1", "+1", + + sortfile, "-o", sortfile, 0); + + + + default: /* parent */ + + while(wait(&status) != pid); + + } + + + + + + getsort(); + + onintr(); + +} + + + +msg(s,arg) + +char *s; + +char *arg; + +{ + + fprintf(stderr,"%s %s\n",s,arg); + + return; + +} + +diag(s,arg) + +char *s, *arg; + +{ + + + + msg(s,arg); + + exit(1); + +} + + + + + +char *getline() + +{ + + + + register c; + + register char *linep; + + char *endlinep; + + + + + + endlinep= line + mlen; + + linep = line; + + /* Throw away leading white space */ + + + + while(isspace(c=getc(inptr))) + + ; + + if(c==EOF) + + return(0); + + ungetc(c,inptr); + + while(( c=getc(inptr)) != EOF) { + + switch (c) { + + + + case '\t': + + if(linephalflen-1) + + p3b = p3a+halflen-1; + + p2a = ltrim(ref,p2b=linep,halflen-1); + + if(p2b-p2a>halflen-1) + + p2a = p2b-halflen-1; + + p1b = rtrim(p1a=p3b+(isspace(p3b[0])!=0),tilde, + + w=halflen-(p2b-p2a)-gap); + + if(p1b-p1a>w) + + p1b = p1a; + + p4a = ltrim(ref,p4b=p2a-(isspace(p2a[-1])!=0), + + w=halflen-(p3b-p3a)-gap); + + if(p4b-p4a>w) + + p4a = p4b; + + fprintf(outptr,".xx \""); + + putout(p1a,p1b); + + /* tilde-1 to account for extra space before TILDE */ + + if(p1b!=(tilde-1) && p1a!=p1b) + + fprintf(outptr,"/"); + + fprintf(outptr,"\" \""); + + if(p4a==p4b && p2a!=ref && p2a!=p2b) + + fprintf(outptr,"/"); + + putout(p2a,p2b); + + fprintf(outptr,"\" \""); + + putout(p3a,p3b); + + /* ++p3b to account for extra blank after TILDE */ + + /* ++p3b to account for extra space before TILDE */ + + if(p1a==p1b && ++p3b!=tilde) + + fprintf(outptr,"/"); + + fprintf(outptr,"\" \""); + + if(p1a==p1b && p4a!=ref && p4a!=p4b) + + fprintf(outptr,"/"); + + putout(p4a,p4b); + + if(rflag) + + fprintf(outptr,"\" %s\n",tilde); + + else + + fprintf(outptr,"\"\n"); + + linep = line; + + break; + + + + case '"': + + /* put double " for " */ + + *linep++ = c; + + default: + + *linep++ = c; + + } + + } + +} + + + +char *rtrim(a,c,d) + +char *a,*c; + +{ + + char *b,*x; + + b = c; + + for(x=a+1; x<=c&&x-a<=d; x++) + + if((x==c||isspace(x[0]))&&!isspace(x[-1])) + + b = x; + + if(b=c&&b-x<=d; x--) + + if(!isspace(x[0])&&(x==c||isspace(x[-1]))) + + a = x; + + if(a>c&&!isspace(a[-1])) + + a--; + + return(a); + +} + + + +putout(strt,end) + +char *strt, *end; + +{ + + char *cp; + + + + cp = strt; + + + + for(cp=strt; cp>2)) & MASK; + + return(k); + +} + + + +storeh(num,strtp) + +int num; + +char *strtp; + +{ + + int i; + + + + for(i=num; i + +#include + +#include + +#include + + + +char dot[] = "."; + +char dotdot[] = ".."; + +char name[BUFSIZ]; + +int file; + +int off = -1; + +struct stat d, dd; + +struct direct dir; + + + +main() + +{ + + int rdev, rino; + + + + stat("/", &d); + + rdev = d.st_dev; + + rino = d.st_ino; + + for (;;) { + + stat(dot, &d); + + if (d.st_ino==rino && d.st_dev==rdev) + + prname(); + + if ((file = open(dotdot,0)) < 0) { + + fprintf(stderr,"pwd: cannot open ..\n"); + + exit(1); + + } + + fstat(file, &dd); + + chdir(dotdot); + + if(d.st_dev == dd.st_dev) { + + if(d.st_ino == dd.st_ino) + + prname(); + + do + + if (read(file, (char *)&dir, sizeof(dir)) < sizeof(dir)) { + + fprintf(stderr,"read error in ..\n"); + + exit(1); + + } + + while (dir.d_ino != d.st_ino); + + } + + else do { + + if(read(file, (char *)&dir, sizeof(dir)) < sizeof(dir)) { + + fprintf(stderr,"read error in ..\n"); + + exit(1); + + } + + stat(dir.d_name, &dd); + + } while(dd.st_ino != d.st_ino || dd.st_dev != d.st_dev); + + close(file); + + cat(); + + } + +} + + + +prname() + +{ + + write(1, "/", 1); + + if (off<0) + + off = 0; + + name[off] = '\n'; + + write(1, name, off+1); + + exit(0); + +} + + + +cat() + +{ + + register i, j; + + + + i = -1; + + while (dir.d_name[++i] != 0); + + if ((off+i+2) > BUFSIZ-1) + + prname(); + + for(j=off+1; j>=0; --j) + + name[j+i+1] = name[j]; + + off=i+off+1; + + name[i] = '/'; + + for(--i; i>=0; --i) + + name[i] = dir.d_name[i]; + +} diff --cc usr/src/cmd/px/00case.h index 0000000000,0000000000,0000000000..87c8498719 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/00case.h @@@@ -1,0 -1,0 -1,0 +1,126 @@@@ +++# +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)00case.h 4.1 10/10/80"; +++# +++# Berkeley Pascal Assembler Kernel +++# +++ .globl _interpret #normal interpreter entry point +++# +++# register definitions +++# +++# registers R0 - R6 are for scratch use +++# +++ .set lino, r11 +++ .set lc, r10 +++ .set dp, r9 +++ .set loop, r8 +++ .set buf, r7 +++# +++# Global constants +++# +++ .set R2,0x004 #register fields in call mask +++ .set R3,0x008 +++ .set R4,0x010 +++ .set R5,0x020 +++ .set R6,0x040 +++ .set R7,0x080 +++ .set R8,0x100 +++ .set R9,0x200 +++ .set R10,0x400 +++ .set R11,0x800 +++ .set SIGINT,2 #interrupt signal +++ .set SIGFPE,8 #arithmetic exception signal +++ .set SIGSEGV,11 #segmentation violation +++ .set MASK,6 #offset of save mask in call stack +++ .set FP,12 #offset of "fp" in call stack +++ .set PC,16 #offset of "pc" in call stack +++ .set REGS,20 #beginning of saved registers in call stack +++ .set O_DATE,0345 #DATE opcode number +++ .set O_TIME,0346 #TIME opcode number +++ .set tempsize,-1024 #maximum required temporary stack space +++# +++# program variables +++# +++ .globl _display #runtime display +++ .globl _file #current file name +++ .globl _fchain #head of active file chain +++ .globl _llimit #max number of output lines +++ .globl _stcnt #number of stmts executed +++ .globl _stlim #max number of stmts to exec +++ .globl _nodump #1 => no postmortum dump +++ .globl _perrno #interpreter error number +++ .globl _profcnts #PX profile execution counts +++ .globl _pxpbuf #ptr to pxp buffer +++ .globl _pxpsize #size of pxp buffer +++ .globl _argc #number of passed args +++ .globl _argv #values of passed args +++ .globl __iob #base of I/O buffer block +++ .globl __sobuf #standard output buffer +++# +++# system subroutines +++# +++ .globl _signal +++ .globl _time +++ .globl _times +++# +++# system math routines +++# +++ .globl _atan +++ .globl _cos +++ .globl _exp +++ .globl _log +++ .globl _sin +++ .globl _sqrt +++ .globl _srand +++ .globl _rand +++# +++# pascal specific subroutines +++# +++ .globl _error #error message routine +++ .globl _palloc #heap allocator +++ .globl _pfree +++ .globl _cttot #set constructor +++ .globl _inct #set inclusion +++ .globl _pdattim #getting date, time info +++ .globl _perror #process pxp errors +++# +++# initializing the interpreter +++# +++_interpret: +++ .word 0xffc #register save mask +++ moval iloop,r8 +++ tstl 8(ap) #check for profiling +++ beql l0050 +++ moval ploop,r8 #set profiling request +++l0050: +++ callg *4(ap),l0051 #set ap to base of program +++ ret +++l0051: +++ .word 0 +++ bispsw $0xe0 #enable overflow traps +++ movl ap,r10 #program start address +++ moval _display,r9 +++ moval -4(sp),(r9) +++ pushal stderr #set up global file variables +++ movl sp,stderr+FLEV +++ movl _llimit,stderr+LLIMIT +++ calls $0,_unit #init active file +++ pushal stdout +++ movl sp,stdout+FLEV +++ movl _llimit,stdout+LLIMIT +++ pushal stdin +++ movl sp,stdin+FLEV +++ moval stdin,_fchain +++ jmp (r8) #begin interpreter +++# +++# main interpreter loop +++# the instruction 'jmp (loop)' +++# transfers here +++# +++ploop: +++ movzbl (r10),r0 +++ incl _profcnts[r0] +++iloop: +++ caseb (r10)+,$0,$255 +++optab: diff --cc usr/src/cmd/px/01int.s index 0000000000,0000000000,0000000000..59f0c0466e new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/01int.s @@@@ -1,0 -1,0 -1,0 +1,97 @@@@ +++# +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)01int.s 4.1 10/10/80"; +++# +++_HALT: +++ movw $EHALT,_perrno +++ jbr error +++ +++_GOTO: +++ cvtbl (r10)+,r0 +++ movl _display(r0),r6 #r6 has exit dp value +++ addl3 (r10),ap,r10 #establish return address +++L0101: +++ cmpl r6,(r9) #check for done +++ blss egoto #missed the requested frame +++ beql L0102 +++ pushl (r9) #flush and close local files +++ calls $1,_pclose +++ movl (r9),sp #deallocate local vars +++ movl 16(sp),(r9) #restore old display entry +++ movl 20(sp),r9 #get old display pointer +++ brb L0101 #continue +++L0102: +++ movl 4(sp),_file #restore old I/O info +++ movl 8(sp),r7 +++ movl *(r9),sp #reset sp to top of stack +++ jmp (r8) +++egoto: +++ movl $EGOTO,_perrno +++ jbr error +++ +++_LINO: +++ cmpl *(r9),sp #check stack integrity +++ jneq stknemp +++ cvtbl (r10)+,r11 #update line number +++ bneq L0103 +++ movzwl (r10)+,r11 +++L0103: +++ aoblss _stlim,_stcnt,L0104 #update statement count +++ movw $ESTLIM,_perrno +++ jbr error +++stknemp: +++ movw $ESTKNEMP,_perrno +++ jbr error +++L0104: +++ jmp (r8) +++ +++_IF: +++ tstw (sp)+ +++ beql _TRA +++ addl2 $3,r10 +++ jmp (r8) +++ +++_TRA4: +++ addl3 1(r10),ap,r10 +++ jmp (r8) +++ +++_TRA: +++ incl r10 +++ cvtwl (r10),r0 +++ addl2 r0,r10 +++ jmp (r8) +++ +++_PUSH: +++ cvtbl (r10)+,r0 +++ bneq L0105 +++ movl (r10)+,r0 +++L0105: +++ mnegl r0,r0 +++ blbc r0,L0106 +++ incl r0 +++L0106: +++ subl3 r0,sp,r1 #r1 points to new top of stack +++ clrl tempsize(r1) #check for memory (fault => not available) +++ movl r1,sp #allocate the memory +++ movc5 $0,(r2),$0,r0,(sp) +++ jmp (r8) +++ +++_SDUP2: +++ incl r10 +++ movw (sp),-(sp) +++ jmp (r8) +++ +++_SDUP4: +++ incl r10 +++ movl (sp),-(sp) +++ jmp (r8) +++ +++_ASRT: +++ incl r10 +++ tstw (sp)+ +++ beql L0107 +++ jmp (r8) +++L0107: +++ movw $EASRT,_perrno +++ jbr error diff --cc usr/src/cmd/px/02relset.s index 0000000000,40d0e6e7da,0000000000..bf47952cbc mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/02relset.s +++ b/usr/src/cmd/px/02relset.s @@@@ -1,0 -1,100 -1,0 +1,101 @@@@ + +# - # 02relset.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)02relset.s 4.1 10/10/80"; + +# + +# RELATIONALS ON SETS + +# + +_RELT: + + cvtbl (r10)+,r5 #r5 has jump opcode - cvtwl (r10)+,r1 #r1 has comparison length (bytes) +++ movzwl (r10)+,r1 #r1 has comparison length (bytes) + + movl r1,r4 #r4 has stack length + + blbc r4,l0211 + + incl r4 + +l0211: + + addl3 sp,r4,r3 #r3 has addr of lower operand + + addl2 r3,r4 #r4 points to cleared stack - ashl $1,r5,r5 #maintain compatability + + jsb *settab(r5) #calc condition, return boolean in r0 + + movl r4,sp #reset stack + + cmpl r5,$20 #check for branch + + bgtr l0212 + + movw r0,-(sp) #put boolean on stack + + jmp (r8) + +l0212: + + tstl r0 + + beql l0213 + + addl2 $2,r10 #continue on true + + jmp (r8) + +l0213: + + cvtwl (r10),r0 #skip on false + + addl2 r0,r10 + + jmp (r8) + + + + .align 1 - settab: #condition code branch table - .long seteq #generate boolean answer +++settab: #condition code branch table +++ .long seteq #generate boolean answer + + .long setne + + .long setlt + + .long setgt + + .long setle + + .long setge - .long seteq #branch on condition false +++ .long seteq #branch on condition false + + .long setne + + .long setlt + + .long setgt + + .long setle + + .long setge + + + +setlt: + + moval 4(sp),r2 #skip over return address + + ashl $-1,r1,r1 + +l0214: + + bicw3 (r2),(r3),r0 + + bneq false + + bicw2 (r3)+,(r2)+ + + bneq l0216 #need only check <= for remainder of set + + sobgtr r1,l0214 + +false: + + clrl r0 + + rsb + +setle: + + moval 4(sp),r2 + + ashl $-1,r1,r1 + +l0215: + + bicw2 (r2)+,(r3)+ + + bneq false + +l0216: + + sobgtr r1,l0215 + +true: + + movl $1,r0 + + rsb + +seteq: + + cmpc3 r1,(r3),4(sp) + + beql true + + clrl r0 + + rsb + +setne: + + cmpc3 r1,(r3),4(sp) + + bneq true + + clrl r0 + + rsb + +setgt: + + moval 4(sp),r2 + + ashl $-1,r1,r1 + +l0217: + + bicw3 (r3),(r2),r0 + + bneq false + + bicw2 (r2)+,(r3)+ + + bneq l0219 #need only check >= for remainder of set + + sobgtr r1,l0217 + + clrl r0 + + rsb + +setge: + + moval 4(sp),r2 + + ashl $-1,r1,r1 + +l0218: + + bicw2 (r3)+,(r2)+ + + bneq false + +l0219: + + sobgtr r1,l0218 + + movl $1,r0 + + rsb diff --cc usr/src/cmd/px/03rel.s index 0000000000,0000000000,0000000000..3651c1501c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/03rel.s @@@@ -1,0 -1,0 -1,0 +1,141 @@@@ +++# +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)03rel.s 4.1 10/10/80"; +++# +++# RELATIONAL OPERATORS +++# +++_REL2: +++ cvtbl (r10)+,r0 +++ movw (sp)+,r1 +++ cmpw (sp)+,r1 +++ jmp *reltab(r0) +++_REL42: +++ cvtbl (r10)+,r0 +++ movl (sp)+,r1 +++ cvtwl (sp)+,r2 +++ cmpl r2,r1 +++ jmp *reltab(r0) +++_REL24: +++ cvtbl (r10)+,r0 +++ cvtwl (sp)+,r1 +++ cmpl (sp)+,r1 +++ jmp *reltab(r0) +++_REL4: +++ cvtbl (r10)+,r0 +++ movl (sp)+,r1 +++ cmpl (sp)+,r1 +++ jmp *reltab(r0) +++_REL28: +++ cvtbl (r10)+,r0 +++ cvtwd (sp)+,r1 +++ cmpd (sp)+,r1 +++ jmp *reltab(r0) +++_REL48: +++ cvtbl (r10)+,r0 +++ cvtld (sp)+,r1 +++ cmpd (sp)+,r1 +++ jmp *reltab(r0) +++_REL82: +++ cvtbl (r10)+,r0 +++ movd (sp)+,r1 +++ cvtwd (sp)+,r3 +++ cmpd r3,r1 +++ jmp *reltab(r0) +++_REL84: +++ cvtbl (r10)+,r0 +++ movd (sp)+,r1 +++ cvtld (sp)+,r3 +++ cmpd r3,r1 +++ jmp *reltab(r0) +++_REL8: +++ cvtbl (r10)+,r0 +++ movd (sp)+,r1 +++ cmpd (sp)+,r1 +++ jmp *reltab(r0) +++_RELG: +++ cvtbl (r10)+,r5 #r5 has jump opcode +++ movzwl (r10)+,r1 #r1 has comparison length +++ movl r1,r4 #r4 has stack length +++ blbc r4,l0201 +++ incl r4 +++l0201: +++ addl3 sp,r4,r3 #r3 has addr of bottom operand +++ addl2 r3,r4 #r4 points to cleared stack +++ cmpc3 r1,(r3),(sp) #do comparison +++ movpsl r2 #save condition codes +++ movl r4,sp #update stack +++ bicpsw $15 #restore condition codes +++ bispsw r2 +++ jmp *reltab(r5) +++ +++ .align 1 +++reltab: +++ .long releq +++ .long relne +++ .long rellt +++ .long relgt +++ .long relle +++ .long relge +++ .long ifeq +++ .long ifne +++ .long iflt +++ .long ifgt +++ .long ifle +++ .long ifge +++ +++releq: +++ beql True +++ clrw -(sp) +++ jmp (r8) +++relne: +++ bneq True +++ clrw -(sp) +++ jmp (r8) +++rellt: +++ blss True +++ clrw -(sp) +++ jmp (r8) +++relgt: +++ bgtr True +++ clrw -(sp) +++ jmp (r8) +++relle: +++ bleq True +++ clrw -(sp) +++ jmp (r8) +++relge: +++ bgeq True +++ clrw -(sp) +++ jmp (r8) +++True: +++ movw $1,-(sp) +++ jmp (r8) +++ifeq: +++ bneq iftra +++ addl2 $2,r10 +++ jmp (r8) +++ifne: +++ beql iftra +++ addl2 $2,r10 +++ jmp (r8) +++iflt: +++ bgeq iftra +++ addl2 $2,r10 +++ jmp (r8) +++ifgt: +++ bleq iftra +++ addl2 $2,r10 +++ jmp (r8) +++ifle: +++ bgtr iftra +++ addl2 $2,r10 +++ jmp (r8) +++ifge: +++ blss iftra +++ addl2 $2,r10 +++ jmp (r8) +++iftra: +++ cvtwl (r10),r0 +++ addl2 r0,r10 +++ jmp (r8) diff --cc usr/src/cmd/px/04as.s index 0000000000,f80fec884d,0000000000..1ece018c42 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/04as.s +++ b/usr/src/cmd/px/04as.s @@@@ -1,0 -1,53 -1,0 +1,55 @@@@ + +# - # 04as.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)04as.s 4.1 10/10/80"; + +# + +# ASSIGNMENT OPERATORS + +# + +_AS2: + + incl r10 + + movw (sp)+,*(sp)+ + + jmp (r8) + +_AS24: + + incl r10 + + cvtwl (sp)+,*(sp)+ + + jmp (r8) + +_AS42: + + incl r10 + + cvtlw (sp)+,*(sp)+ + + jmp (r8) + +_AS4: + + incl r10 + + movl (sp)+,*(sp)+ + + jmp (r8) + +_AS21: + + incl r10 + + cvtwb (sp)+,*(sp)+ + + jmp (r8) + +_AS41: + + incl r10 + + cvtlb (sp)+,*(sp)+ + + jmp (r8) + +_AS28: + + incl r10 + + cvtwd (sp)+,*(sp)+ + + jmp (r8) + +_AS48: + + incl r10 + + cvtld (sp)+,*(sp)+ + + jmp (r8) + +_AS8: + + incl r10 + + movd (sp)+,*(sp)+ + + jmp (r8) + +_AS: + + cvtbl (r10)+,r0 + + bneq l0401 - cvtwl (r10)+,r0 #r0 has data length in bytes +++ movzwl (r10)+,r0 #r0 has data length in bytes + +l0401: + + addl3 sp,r0,r6 #r6 points to destination addr + + blbc r6,l0402 #adjust for word boundry + + incl r6 + +l0402: + + movc3 r0,(sp),*(r6)+ #move data from stack to dest + + movl r6,sp #update stack pointer + + jmp (r8) diff --cc usr/src/cmd/px/05index.s index 0000000000,c7e77caae6,0000000000..40f7217cf4 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/05index.s +++ b/usr/src/cmd/px/05index.s @@@@ -1,0 -1,58 -1,0 +1,66 @@@@ + +# - # 05index.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)05index.s 4.1 10/10/80"; + +# + +# OFF, INDEX and NIL + +# + +_OFF: + + cvtbl (r10)+,r0 + + bneq l0501 - cvtwl (r10)+,r0 +++ movzwl (r10)+,r0 + +l0501: + + addl2 r0,(sp) + + jmp (r8) + +_INX2: + + cvtbl (r10)+,r0 + + bneq l0502 + + cvtwl (r10)+,r0 #r0 has size + +l0502: - cvtwl (r10)+,r1 #r1 has lower bound - cvtwl (r10)+,r2 #r2 has upper bound - cvtwl (sp)+,r3 #r3 contains subscript - subl2 r1,r3 #r3 has base subscript - index r3,$0,r2,r0,$0,r1 #r1 has calculated offset - addl2 r1,(sp) #calculate actual address +++ clrl r3 #r3 has base subscript +++ subw3 (r10)+,(sp)+,r3 +++ blss esubscr #check lower bound +++ cmpw r3,(r10)+ #check upper bound +++ bgtru esubscr +++ mull2 r0,r3 #calc byte offset +++ addl2 r3,(sp) #calculate actual address + + jmp (r8) + +_INX4: + + cvtbl (r10)+,r0 + + bneq l0503 + + cvtwl (r10)+,r0 #r0 has size + +l0503: + + cvtwl (r10)+,r1 #r1 has lower bound - cvtwl (r10)+,r2 #r2 has upper bound - movl (sp)+,r3 #r3 contains subscript - subl2 r1,r3 #r3 has base subscript - index r3,$0,r2,r0,$0,r1 #r1 has calculated offset - addl2 r1,(sp) #calculate actual address +++ movzwl (r10)+,r2 #r2 has upper-lower bound +++ subl3 r1,(sp)+,r3 #r3 has base subscript +++ cmpl r3,r2 #check for out of bounds +++ bgtru esubscr +++ mull2 r0,r3 #calc byte offset +++ addl2 r3,(sp) #calculate actual address + + jmp (r8) +++esubscr: +++ movl $ESUBSCR,_perrno +++ jbr error + +_NIL: + + incl r10 + + tstl (sp) + + jeql l0504 + + jmp (r8) + +l0504: + + movw $ENILPTR,_perrno + + jbr error + +_INX4P2: + + cvtbl (r10)+,r0 #r0 has shift amount + + cvtwl (r10)+,r2 #r2 has lower bound + + subl3 r2,(sp)+,r1 #r1 has base subscript + + ashl r0,r1,r1 + + addl2 r1,(sp) + + jmp (r8) + +_INX2P2: + + cvtbl (r10)+,r0 #r0 has shift amount - clrl r1 #clear upper half of r1 - subw3 (r10)+,(sp)+,r1 #r1 has base subscript - ashl r0,r1,r1 - addl2 r1,(sp) +++ cvtwl (r10)+,r1 #r1 has base array value +++ cvtwl (sp)+,r2 #r2 has subscript value +++ subl2 r1,r2 #r2 has element offset +++ ashl r0,r2,r2 #r2 has byte offset +++ addl2 r2,(sp) + + jmp (r8) diff --cc usr/src/cmd/px/06add.s index 0000000000,3b71d8d410,0000000000..8866ba7ab0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/06add.s +++ b/usr/src/cmd/px/06add.s @@@@ -1,0 -1,52 -1,0 +1,54 @@@@ + +# - # 06add.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)06add.s 4.1 10/10/80"; + +# + +# ADDITION + +# + +_ADD2: + + incl r10 + + cvtwl (sp)+,r0 + + cvtwl (sp)+,r1 + + addl3 r0,r1,-(sp) + + jmp (r8) + +_ADD24: + + incl r10 + + cvtwl (sp)+,r0 + + addl2 r0,(sp) + + jmp (r8) + +_ADD42: + + incl r10 + + movl (sp)+,r0 + + cvtwl (sp)+,r1 + + addl3 r0,r1,-(sp) + + jmp (r8) + +_ADD4: + + incl r10 + + addl2 (sp)+,(sp) + + jmp (r8) + +_ADD28: + + incl r10 + + cvtwd (sp)+,r0 + + addd2 r0,(sp) + + jmp (r8) + +_ADD82: + + incl r10 + + movd (sp)+,r0 + + cvtwd (sp)+,r2 + + addd3 r0,r2,-(sp) + + jmp (r8) + +_ADD48: + + incl r10 + + cvtld (sp)+,r0 + + addd2 r0,(sp) + + jmp (r8) + +_ADD84: + + incl r10 + + movd (sp)+,r0 + + cvtld (sp)+,r2 + + addd3 r0,r2,-(sp) + + jmp (r8) + +_ADD8: + + incl r10 + + addd2 (sp)+,(sp) + + jmp (r8) diff --cc usr/src/cmd/px/07sub.s index 0000000000,85158abb40,0000000000..915eb708f7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/07sub.s +++ b/usr/src/cmd/px/07sub.s @@@@ -1,0 -1,52 -1,0 +1,54 @@@@ + +# - # 07sub.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)07sub.s 4.1 10/10/80"; + +# + +# SUBTRACTION + +# + +_SUB2: + + incl r10 + + cvtwl (sp)+,r0 + + cvtwl (sp)+,r1 + + subl3 r0,r1,-(sp) + + jmp (r8) + +_SUB24: + + incl r10 + + cvtwl (sp)+,r0 + + subl2 r0,(sp) + + jmp (r8) + +_SUB42: + + incl r10 + + movl (sp)+,r0 + + cvtwl (sp)+,r1 + + subl3 r0,r1,-(sp) + + jmp (r8) + +_SUB4: + + incl r10 + + subl2 (sp)+,(sp) + + jmp (r8) + +_SUB28: + + incl r10 + + cvtwd (sp)+,r0 + + subd2 r0,(sp) + + jmp (r8) + +_SUB82: + + incl r10 + + movd (sp)+,r0 + + cvtwd (sp)+,r2 + + subd3 r0,r2,-(sp) + + jmp (r8) + +_SUB48: + + incl r10 + + cvtld (sp)+,r0 + + subd2 r0,(sp) + + jmp (r8) + +_SUB84: + + incl r10 + + movd (sp)+,r0 + + cvtld (sp)+,r2 + + subd3 r0,r2,-(sp) + + jmp (r8) + +_SUB8: + + incl r10 + + subd2 (sp)+,(sp) + + jmp (r8) diff --cc usr/src/cmd/px/08call.s index 0000000000,0000000000,0000000000..8da78f936d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/08call.s @@@@ -1,0 -1,0 -1,0 +1,101 @@@@ +++# +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)08call.s 4.1 10/10/80"; +++# +++_CALL: +++ cvtbl (r10)+,r0 #entry level of new proc +++ movl (r10)+,r1 #new entry point +++ pushr $R11|R10|R9 #save lino, lc, dp +++ addl2 ap,r1 #calc new entry point +++ addl3 2(r1),ap,r10 +++ moval _display(r0),r9 #set up new display pointer +++ jmp (r8) +++ +++_FCALL: +++ cvtbl (r10)+,r0 #r0 has number of bytes of arguments +++ bneq L0801 +++ movl (r10)+,r0 +++L0801: +++ movl (sp)+,r6 #r6 points to formal call struct +++ pushr $R11|R10|R9 #save lino, lc, dp +++ movl (r6),r10 #set new entry point +++ cmpl 6(r10),r0 #check arg count +++ bneq enargs +++ addl3 $_display,4(r6),r9 #set up new display pointer +++ movl 4(r6),r1 #save current display, restore formal display +++ movc3 r1,_display+4,8(r6)[r1] +++ movc3 4(r6),8(r6),_display+4 +++ jmp (r8) +++enargs: +++ movw $ENARGS,_perrno +++ jbr error +++ +++_FSAV: +++ movl (sp),r6 #r6 points to formal call struct +++ cvtbl (r10)+,4(r6) #set block number +++ addl3 (r10)+,ap,r0 #r0 pts to TRA4 +++ addl3 2(r0),ap,(r6) #set entry address +++ movc3 4(r6),_display+4,8(r6) #save current display +++ jmp (r8) +++ +++_FRTN: +++ cvtbl (r10)+,r0 #r0 has size of returned object +++ bneq L0802 +++ movzwl (r10)+,r0 +++L0802: +++ addl3 r0,sp,r1 #r1 points to stack loc of formal call struct +++ movl (r1),r6 #r6 points to formal call struct +++ movc3 r0,(sp),4(sp) #move down the returned value +++ addl2 $4,sp #throw away leftover +++ movl 4(r6),r1 #r1 has display size +++ movc3 r1,8(r6)[r1],_display+4 #restore previous display +++ jmp (r8) +++# +++_NODUMP: +++ moval iloop,r8 #disable profiling +++ incw _nodump +++ bicpsw $0xe0 #disable overflow checks +++ +++_BEG: +++ movzbl (r10)+,r1 #r1 has name size +++ movl (r10)+,r0 #r0 has local variable size +++ addl2 $4,r9 #enter local scope +++ pushl (r9) #save old display value +++ pushal (r10)+ #pointer to entry info +++ movzwl (r10)+,r11 #set new lino +++ addl2 r1,r10 #skip over name text +++ pushl r7 #save I/O info +++ pushl _file +++ subl2 $4,sp #space for top of frame pointer +++ movl sp,(r9) #set new display pointer +++ addl3 r0,sp,r3 #r3 points to new top of stack +++ clrl tempsize(r3) #check for memory (fault => not available) +++ movl r3,(sp) #set new top of stack pointer +++ movl r3,sp #allocate local variables +++ mnegl r0,r6 #r6 has amount of space to alloc +++ cmpl r6,$65535 #check for out of character range +++ bleq L0804 +++L0803: +++ movc5 $0,(r2),$0,$65535,(r3) #continue zero of local variables +++ acbl $65536,$-65535,r6,L0803 #deduct amount zeroed and continue +++L0804: +++ movc5 $0,(r2),$0,r6,(r3) #zero out local variables +++ jmp (r8) +++ +++_END: +++ pushl (r9) #flush and close local files +++ calls $1,_pclose +++ movl (r9),sp #deallocate local vars +++ addl2 $4,sp #pop TOS ptr +++ movl (sp)+,_file #restore old I/O info +++ movl (sp)+,r7 +++ movzwl *(sp)+,r0 #r0 has number of bytes of parameters +++ movl (sp)+,(r9) #restore old display entry +++ cmpl r9,$_display+4 #exiting main proc ??? +++ beql L0805 +++ popr $R11|R10|R9 #restore lino, lc, dp +++ addl2 r0,sp #deallocate parameters +++ jmp (r8) +++L0805: +++ ret #end of interpretation diff --cc usr/src/cmd/px/10mul.s index 0000000000,669043a820,0000000000..305768eb01 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/10mul.s +++ b/usr/src/cmd/px/10mul.s @@@@ -1,0 -1,58 -1,0 +1,59 @@@@ + +# - # 10mul.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)10mul.s 4.1 10/10/80"; + +# + +# MULTIPLICATION AND SQUARING + +# - _SQR2: - movw (sp),-(sp) + +_MUL2: + + incl r10 + + cvtwl (sp)+,r0 + + cvtwl (sp)+,r1 + + mull3 r0,r1,-(sp) + + jmp (r8) + +_MUL24: + + incl r10 + + cvtwl (sp)+,r0 + + mull2 r0,(sp) + + jmp (r8) + +_MUL42: + + incl r10 + + movl (sp)+,r0 + + cvtwl (sp)+,r1 + + mull3 r0,r1,-(sp) + + jmp (r8) +++_SQR2: + +_SQR4: + + movl (sp),-(sp) + +_MUL4: + + incl r10 + + mull2 (sp)+,(sp) + + jmp (r8) + +_MUL28: + + incl r10 + + cvtwd (sp)+,r0 + + muld2 r0,(sp) + + jmp (r8) + +_MUL82: + + incl r10 + + movd (sp)+,r0 + + cvtwd (sp)+,r2 + + muld3 r0,r2,-(sp) + + jmp (r8) + +_MUL48: + + incl r10 + + cvtld (sp)+,r0 + + muld2 r0,(sp) + + jmp (r8) + +_MUL84: + + incl r10 + + movd (sp)+,r0 + + cvtld (sp)+,r2 + + muld3 r0,r2,-(sp) + + jmp (r8) + +_SQR8: + + movd (sp),-(sp) + +_MUL8: + + incl r10 + + muld2 (sp)+,(sp) + + jmp (r8) diff --cc usr/src/cmd/px/12div.s index 0000000000,2047bc068a,0000000000..4059c626f6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/12div.s +++ b/usr/src/cmd/px/12div.s @@@@ -1,0 -1,26 -1,0 +1,28 @@@@ + +# - # 12div.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)12div.s 4.1 10/10/80"; + +# + +# INTEGER DIVISION + +# + +_DIV2: + + incl r10 + + cvtwl (sp)+,r0 + + cvtwl (sp)+,r1 + + divl3 r0,r1,-(sp) + + jmp (r8) + +_DIV24: + + incl r10 + + cvtwl (sp)+,r0 + + divl2 r0,(sp) + + jmp (r8) + +_DIV42: + + incl r10 + + movl (sp)+,r0 + + cvtwl (sp)+,r1 + + divl3 r0,r1,-(sp) + + jmp (r8) + +_DIV4: + + incl r10 + + divl2 (sp)+,(sp) + + jmp (r8) diff --cc usr/src/cmd/px/13mod.s index 0000000000,98f1a3ec7b,0000000000..6e1efe929f mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/13mod.s +++ b/usr/src/cmd/px/13mod.s @@@@ -1,0 -1,33 -1,0 +1,35 @@@@ + +# - # 13mod.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)13mod.s 4.1 10/10/80"; + +# + +# MODULO + +# + +_MOD2: + + incl r10 + + cvtwl (sp),r0 + + cvtwl 2(sp),r2 + + ashq $-32,r1,r1 + + ediv r0,r1,r3,(sp) + + jmp (r8) + +_MOD24: + + incl r10 + + cvtwl (sp)+,r0 + + movl (sp),r2 + + ashq $-32,r1,r1 + + ediv r0,r1,r3,(sp) + + jmp (r8) + +_MOD42: + + incl r10 + + movl (sp)+,r0 + + cvtwl (sp)+,r2 + + ashq $-32,r1,r1 + + ediv r0,r1,r3,-(sp) + + jmp (r8) + +_MOD4: + + incl r10 + + movl (sp)+,r0 + + movl (sp),r2 + + ashq $-32,r1,r1 + + ediv r0,r1,r3,(sp) + + jmp (r8) diff --cc usr/src/cmd/px/14neg.s index 0000000000,9b0a2da7c8,0000000000..48029d5225 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/14neg.s +++ b/usr/src/cmd/px/14neg.s @@@@ -1,0 -1,39 -1,0 +1,36 @@@@ + +# - # 14neg.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)14neg.s 4.1 10/10/80"; + +# + +# NEGATION & ABSOLUTE VALUE + +# - _ABS2: - incl r10 - cvtwl (sp)+,r0 - blss l1401 - pushl r0 - jmp (r8) + +_NEG2: + + incl r10 + + cvtwl (sp)+,r0 + +l1401: + + mnegl r0,-(sp) + + jmp (r8) +++_ABS2: + +_ABS4: + + incl r10 + + tstl (sp) + + jgeq l1402 + + mnegl (sp),(sp) + +l1402: + + jmp (r8) + +_NEG4: + + incl r10 + + mnegl (sp),(sp) + + jmp (r8) + +_ABS8: + + incl r10 + + tstd (sp) + + jgeq l1403 + + mnegd (sp),(sp) + +l1403: + + jmp (r8) + +_NEG8: + + incl r10 + + mnegd (sp),(sp) + + jmp (r8) diff --cc usr/src/cmd/px/15bool.s index 0000000000,0000000000,0000000000..4d28cbc072 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/15bool.s @@@@ -1,0 -1,0 -1,0 +1,20 @@@@ +++# +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)15bool.s 4.1 10/10/80"; +++# +++# BOOLEAN OPERATIONS +++# +++_AND: +++ incl r10 +++ mcomw (sp)+,r0 +++ bicw2 r0,(sp) +++ jmp (r8) +++_OR: +++ incl r10 +++ bisw2 (sp)+,(sp) +++ jmp (r8) +++_NOT: +++ incl r10 +++ xorw2 $1,(sp) +++ jmp (r8) diff --cc usr/src/cmd/px/16dvd.s index 0000000000,167300e35d,0000000000..79ed5afae2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/16dvd.s +++ b/usr/src/cmd/px/16dvd.s @@@@ -1,0 -1,55 -1,0 +1,57 @@@@ + +# - # 16dvd.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)16dvd.s 4.1 10/10/80"; + +# + +# FLOATING DIVISION + +# + +_DVD2: + + incl r10 + + cvtwd (sp)+,r0 + + cvtwd (sp)+,r2 + + divd3 r0,r2,-(sp) + + jmp (r8) + +_DVD24: + + incl r10 + + cvtwd (sp)+,r0 + + cvtld (sp)+,r2 + + divd3 r0,r2,-(sp) + + jmp (r8) + +_DVD42: + + incl r10 + + cvtld (sp)+,r0 + + cvtwd (sp)+,r2 + + divd3 r0,r2,-(sp) + + jmp (r8) + +_DVD4: + + incl r10 + + cvtld (sp),r0 + + cvtld 4(sp),r2 + + divd3 r0,r2,(sp) + + jmp (r8) + +_DVD28: + + incl r10 + + cvtwd (sp)+,r0 + + divd2 r0,(sp) + + jmp (r8) + +_DVD82: + + incl r10 + + movd (sp)+,r0 + + cvtwd (sp)+,r2 + + divd3 r0,r2,-(sp) + + jmp (r8) + +_DVD48: + + incl r10 + + cvtld (sp)+,r0 + + divd2 r0,(sp) + + jmp (r8) + +_DVD84: + + incl r10 + + movd (sp)+,r0 + + cvtld (sp)+,r2 + + divd3 r0,r2,-(sp) + + jmp (r8) + +_DVD8: + + incl r10 + + divd2 (sp)+,(sp) + + jmp (r8) diff --cc usr/src/cmd/px/17ind.s index 0000000000,1aa7697041,0000000000..9121b163c2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/17ind.s +++ b/usr/src/cmd/px/17ind.s @@@@ -1,0 -1,27 -1,0 +1,44 @@@@ + +# - # 17ind.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)17ind.s 4.1 10/10/80"; + +# + +# INDS + +# + +_IND1: + + incl r10 + + cvtbw *(sp)+,-(sp) + + jmp (r8) +++_IND14: +++ incl r10 +++ cvtbl *(sp)+,-(sp) +++ jmp (r8) + +_IND2: + + incl r10 + + movw *(sp)+,-(sp) + + jmp (r8) +++_IND24: +++ incl r10 +++ cvtwl *(sp)+,-(sp) +++ jmp (r8) + +_IND4: + + incl r10 + + pushl *(sp)+ + + jmp (r8) + +_IND8: + + incl r10 + + movq *(sp)+,-(sp) + + jmp (r8) + +_IND: + + movl (sp)+,r1 + + cvtbl (r10)+,r0 - jneq movblk - cvtwl (r10)+,r0 - jbr movblk +++ jneq l1701 +++ movzwl (r10)+,r0 +++l1701: +++ movl r0,r2 #r2 has length of stack space +++ blbc r2,l1702 #adjust r2 to word boundry +++ incl r2 +++l1702: +++ subl2 r2,sp #allocate stack space +++ movc5 r0,(r1),$0,r2,(sp) #move string to stack +++ jmp (r8) diff --cc usr/src/cmd/px/18rv.s index 0000000000,0000000000,0000000000..b2747d21bf new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/18rv.s @@@@ -1,0 -1,0 -1,0 +1,105 @@@@ +++# +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)18rv.s 4.1 10/10/80"; +++# +++# LVALUES and RVALUES +++# +++_LV: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl3 _display(r0),r1,-(sp) +++ jmp (r8) +++_LLV: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,-(sp) +++ jmp (r8) +++_RV1: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl2 _display(r0),r1 +++ cvtbw (r1),-(sp) +++ jmp (r8) +++_LRV1: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,r1 +++ cvtbw (r1),-(sp) +++ jmp (r8) +++_RV14: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl2 _display(r0),r1 +++ cvtbl (r1),-(sp) +++ jmp (r8) +++_LRV14: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,r1 +++ cvtbl (r1),-(sp) +++ jmp (r8) +++_RV2: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl2 _display(r0),r1 +++ movw (r1),-(sp) +++ jmp (r8) +++_LRV2: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,r1 +++ movw (r1),-(sp) +++ jmp (r8) +++_RV24: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl2 _display(r0),r1 +++ cvtwl (r1),-(sp) +++ jmp (r8) +++_LRV24: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,r1 +++ cvtwl (r1),-(sp) +++ jmp (r8) +++_RV4: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl2 _display(r0),r1 +++ pushl (r1) +++ jmp (r8) +++_LRV4: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,r1 +++ pushl (r1) +++ jmp (r8) +++_RV8: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl2 _display(r0),r1 +++ movq (r1),-(sp) +++ jmp (r8) +++_LRV8: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,r1 +++ movq (r1),-(sp) +++ jmp (r8) +++_RV: +++ cvtbl (r10)+,r0 +++ cvtwl (r10)+,r1 +++ addl2 _display(r0),r1 #r1 points to string o be moved +++ movzwl (r10)+,r0 #r0 has length of string to be moved +++ movl r0,r2 #r2 has length of stack space +++ blbc r2,l1801 #adjust r2 to word boundry +++ incl r2 +++l1801: +++ subl2 r2,sp #allocate stack space +++ movc5 r0,(r1),$0,r2,(sp) #move string to stack +++ jmp (r8) +++_LRV: +++ cvtbl (r10)+,r0 +++ addl3 _display(r0),(r10)+,r1 #r1 points to string to be moved +++ movzwl (r10)+,r0 #r0 has length of string to be moved +++ movl r0,r2 #r2 has length of stack space +++ blbc r2,l1802 #adjust r2 to word boundry +++ incl r2 +++l1802: +++ subl2 r2,sp #allocate stack space +++ movc5 r0,(r1),$0,r2,(sp) #move string to stack +++ jmp (r8) diff --cc usr/src/cmd/px/20con.s index 0000000000,08eea6a76a,0000000000..8ca853d466 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/20con.s +++ b/usr/src/cmd/px/20con.s @@@@ -1,0 -1,34 -1,0 +1,51 @@@@ + +# - # 20con.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)20con.s 4.1 10/10/80"; + +# + +# CONOPS + +# + +_CON1: + + cvtbw (r10)+,-(sp) + + jmp (r8) +++_CON14: +++ cvtbl (r10)+,-(sp) +++ jmp (r8) + +_CON2: + + incl r10 + + movw (r10)+,-(sp) + + jmp (r8) +++_CON24: +++ incl r10 +++ cvtwl (r10)+,-(sp) +++ jmp (r8) + +_CON4: + + incl r10 + + pushl (r10)+ + + jmp (r8) + +_CON8: + + incl r10 + + movd (r10)+,-(sp) + + jmp (r8) + +_CON: + + cvtbl (r10)+,r0 + + bneq l2001 - cvtwl (r10)+,r0 #r0 has length to be moved +++ movzwl (r10)+,r0 #r0 has length to be moved + +l2001: + + movl r10,r1 #r1 has addr of data to be moved + + movl r0,r2 #r2 has length of stack space + + blbc r2,l2002 + + incl r2 + +l2002: + + subl2 r2,sp #allocate stack space + + addl2 r2,r10 #advance over data + + movc5 r0,(r1),$0,r2,(sp) #move string to stack + + jmp (r8) +++_LVCON: +++ cvtbl (r10)+,r0 #r0 has literal string length +++ bneq l2003 +++ movzwl (r10)+,r0 +++l2003: +++ pushl r10 #address of literal +++ addl2 r0,r10 #jump over literal +++ jmp (r8) diff --cc usr/src/cmd/px/21rang.s index 0000000000,39f44b73d5,0000000000..806f242cfa mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/21rang.s +++ b/usr/src/cmd/px/21rang.s @@@@ -1,0 -1,55 -1,0 +1,80 @@@@ + +# - # 21rang.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)21rang.s 4.1 10/10/80"; + +# + +# range checking + +# + +_RANG2: + + cvtbl (r10)+,r1 + + bneq l2101 + + cvtwl (r10)+,r1 + +l2101: - cvtwl (r10)+,r2 - cvtwl (sp),r0 - index r0,r1,r2,$1,$1,r3 +++ cmpw (sp),r1 +++ blss erange +++ cmpw (sp),(r10)+ +++ bgtr erange + + jmp (r8) + +_RANG24: + + incl r10 + + cvtwl (sp),r0 - index r0,(r10)+,(r10)+,$1,$1,r2 +++ cmpl r0,(r10)+ +++ blss erange +++ cmpl r0,(r10)+ +++ bgtr erange + + jmp (r8) + +_RANG42: + + cvtbl (r10)+,r0 + + bneq l2102 + + cvtwl (r10)+,r0 + +l2102: + + cvtwl (r10)+,r1 - index (sp),r0,r1,$1,$1,r2 +++ cmpl (sp),r0 +++ blss erange +++ cmpl (sp),r1 +++ bgtr erange + + jmp (r8) + +_RANG4: + + incl r10 - index (sp),(r10)+,(r10)+,$1,$1,r2 +++ cmpl (sp),(r10)+ +++ blss erange +++ cmpl (sp),(r10)+ +++ bgtr erange + + jmp (r8) +++erange: +++ movw $ERANGE,_perrno +++ jbr error + +_RSNG2: + + cvtbl (r10)+,r1 + + bneq l2103 + + cvtwl (r10)+,r1 + +l2103: - cvtwl (sp),r0 - index r0,$0,r1,$1,$1,r2 +++ movw (sp),r0 +++ blss erange +++ cmpw r0,r1 +++ bgtr erange + + jmp (r8) + +_RSNG24: + + incl r10 + + cvtwl (sp),r0 - index r0,$0,(r10)+,$1,$1,r2 +++ blss erange +++ cmpl r0,(r10)+ +++ bgtr erange + + jmp (r8) + +_RSNG42: + + cvtbl (r10)+,r1 + + bneq l2104 + + cvtwl (r10)+,r1 + +l2104: - index (sp),$0,r1,$1,$1,r2 +++ movl (sp),r0 +++ blss erange +++ cmpl r0,r1 +++ bgtr erange + + jmp (r8) + +_RSNG4: + + incl r10 - index (sp),$0,(r10)+,$1,$1,r2 +++ movl (sp),r0 +++ blss erange +++ cmpl r0,(r10)+ +++ bgtr erange + + jmp (r8) diff --cc usr/src/cmd/px/23case.s index 0000000000,0000000000,0000000000..591532d52d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/23case.s @@@@ -1,0 -1,0 -1,0 +1,49 @@@@ +++# +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)23case.s 4.1 10/10/80"; +++# +++# CASE OPERATORS +++# +++_CASE1OP: +++ cvtbl (r10)+,r0 +++ bneq l2401 +++ cvtwl (r10)+,r0 #r0 has length of case table +++l2401: +++ movaw (r10)[r0],r2 #r2 has pointer to cases +++ cvtwl (sp)+,r3 #r3 has case element to find +++ locc r3,r0,(r2) #find case element +++ beql caserr #case not found +++offset: +++ mnegl r0,r0 #calc new lc +++ cvtwl (r2)[r0],r1 +++ addl2 r1,r10 +++ jmp (r8) +++_CASE2OP: +++ cvtbl (r10)+,r0 +++ bneq l2402 +++ cvtwl (r10)+,r0 #r0 has length of case table +++l2402: +++ movaw (r10)[r0],r1 #r1 has pointer to cases +++ movl r1,r2 #save base pointer +++ movzwl (sp)+,r3 #r3 has case element to find +++l2403: +++ cmpw r3,(r1)+ #search for case +++ beqlu offset +++ sobgtr r0,l2403 +++ brb caserr #not found +++_CASE4OP: +++ cvtbl (r10)+,r0 +++ bneq l2404 +++ cvtwl (r10)+,r0 #r0 has length of case table +++l2404: +++ movaw (r10)[r0],r1 #r1 has pointer to cases +++ movl r1,r2 #save base pointer +++ movl (sp)+,r3 #r3 has case element to find +++l2405: +++ cmpl r3,(r1)+ #search for case +++ beqlu offset +++ sobgtr r0,l2405 +++caserr: +++ movw $ECASE,_perrno +++ jbr error diff --cc usr/src/cmd/px/24pxp.s index 0000000000,cbf3f5ae41,0000000000..6227190888 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/24pxp.s +++ b/usr/src/cmd/px/24pxp.s @@@@ -1,0 -1,32 -1,0 +1,27 @@@@ + +# - # 24pxp.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)24pxp.s 4.1 10/10/80"; + +# + +# PXP stuff + +# + +_PXPBUF: + + incl r10 - cvtwl (r10),r0 - addl2 $3,r0 +++ addl3 $1,(r10),r0 + + ashl $2,r0,r0 + + movl r0,_pxpsize + + pushl r0 + + calls $1,_palloc + + movl r0,_pxpbuf + + movl r0,r6 + + cvtwl $0426,(r6)+ + + calls $0,_time + + movl r0,(r6)+ - cvtlw (r10)+,(r6)+ - movw (r10)+,(r6)+ - jmp (r8) - _TRACNT: - incl r10 - cvtwl 6(r10),r0 - addl3 (r10),ap,r10 - incl *_pxpbuf[r0] +++ movl (r10)+,(r6)+ +++ movl (r10)+,(r6)+ + + jmp (r8) + +_COUNT: + + incl r10 + + cvtwl (r10)+,r0 + + incl *_pxpbuf[r0] + + jmp (r8) diff --cc usr/src/cmd/px/25set.s index 0000000000,e5e81c8883,0000000000..0a5ed2c344 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/25set.s +++ b/usr/src/cmd/px/25set.s @@@@ -1,0 -1,125 -1,0 +1,105 @@@@ + +# - # 25set.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)25set.s 4.1 10/10/80"; + +# + +# SET OPERATIONS + +# + +_ADDT: + + cvtbl (r10)+,r0 + + bneq l2501 - cvtwl (r10)+,r0 +++ movzwl (r10)+,r0 + +l2501: - blbc r0,l2502 - incl r0 #r0 has number of bytes in set - l2502: + + addl3 sp,r0,r1 #r1 has pointer to second set - ashl $-1,r0,r0 #r0 has number of words in set +++ ashl $-2,r0,r4 #r4 has number of longs in set + +l2503: - bisw2 (sp)+,(r1)+ - sobgtr r0,l2503 +++ bisl2 (sp)+,(r1)+ +++ sobgtr r4,l2503 + + jmp (r8) + +_SUBT: + + cvtbl (r10)+,r0 + + bneq l2504 - cvtwl (r10)+,r0 +++ movzwl (r10)+,r0 + +l2504: - blbc r0,l2505 - incl r0 #r0 has number of bytes in set - l2505: + + addl3 sp,r0,r1 #r1 has pointer to second set - ashl $-1,r0,r0 #r0 has number of words in set +++ ashl $-2,r0,r4 #r4 has number of longs in set + +l2506: - bicw2 (sp)+,(r1)+ - sobgtr r0,l2506 - bicw2 (r10)+,-(r1) +++ bicl2 (sp)+,(r1)+ +++ sobgtr r4,l2506 + + jmp (r8) + +_MULT: + + cvtbl (r10)+,r0 + + bneq l2507 - cvtwl (r10)+,r0 +++ movzwl (r10)+,r0 + +l2507: - blbc r0,l2508 - incl r0 #r0 has number of bytes in set - l2508: + + addl3 sp,r0,r1 #r1 has pointer to second set - ashl $-1,r0,r0 #r0 has number of words in set +++ ashl $-2,r0,r4 #r4 has number of longs in set + +l2509: - mcomw (sp)+,r3 - bicw2 r3,(r1)+ - sobgtr r0,l2509 +++ mcoml (sp)+,r3 +++ bicl2 r3,(r1)+ +++ sobgtr r4,l2509 + + jmp (r8) + +_CARD: + + cvtbl (r10)+,r0 #r0 has number of bytes in set + + bneq l2510 - cvtwl (r10)+,r0 +++ movzwl (r10)+,r0 + +l2510: + + blbc r0,l2511 + + incl r0 + +l2511: +++ cmpl r0,$2 #check for long align +++ bneq l2525 +++ addl2 $2,r0 #if so append it +++l2525: + + addl3 r0,sp,r4 #r4 has new stack addr + + ashl $3,r0,r0 #r0 has number of bits in set + + mnegl $1,r1 #will init r1 to zero + + mnegl $1,r5 #will init r2 to zero + +l2512: + + incl r1 #count found element + + incl r5 #advance to next field position + +l2521: + + ffs r5,$32,(sp),r5 #find next set bit + + beql l2521 #nothing found, so continue + + cmpl r5,r0 #check for end of field + + blss l2512 #element found, so count and continue + + movl r4,sp #clear stack + + movw r1,-(sp) #put answer on stack + + jmp (r8) + +_CTTOT: - cvtbl (r10)+,-(sp) +++ cvtbl (r10)+,r0 + + bneq l2513 - cvtwl (r10)+,(sp) +++ movzwl (r10)+,r0 + +l2513: - cvtwl (r10)+,-(sp) - cvtwl (r10)+,-(sp) - calls $4,_pcttot - movw r0,sp +++ pushal -4(sp)[r0] +++ calls r0,_cttot + + jmp (r8) + +_IN: + + cvtbl (r10)+,r0 + + bneq l2514 - cvtwl (r10)+,r0 #r0 has size of set +++ movzwl (r10)+,r0 #r0 has size of set + +l2514: - blbc r0,l2515 - incl r0 - l2515: - cvtwl (sp)+,r1 #r1 has set index +++ movl (sp)+,r1 #r1 has set index + + addl3 r0,sp,r4 #r4 points to new top of stack + + subw2 (r10)+,r1 #check below lower + + blssu l2516 + + cmpw r1,(r10)+ #check above upper + + bgtru l2517 + + bbc r1,(sp),l2517 #check for bit set + + movl r4,sp #bit found + + movw $1,-(sp) + + jmp (r8) + +l2516: + + addl2 $2,r10 + +l2517: + + movl r4,sp #bit not found + + clrw -(sp) + + jmp (r8) + +_INCT: - incl r10 - cvtwl (sp)+,r0 #r0 has value to find - cvtwl (sp)+,r1 #r1 has pair count +++ cvtbl (r10)+,r0 +++ bneq l2518 +++ movzwl (r10)+,r0 #r0 has number of elements + +l2518: - cmpw r0,(sp)+ - blss l2519 - cmpw r0,(sp)+ - bgtr l2520 - decl r1 - moval (sp)[r1],sp #clear off remaining data on stack - movw $1,-(sp) #success - jmp (r8) - l2519: - addl2 $2,sp - l2520: - sobgtr r1,l2518 - clrw -(sp) #failure +++ calls r0,_inct +++ movw r0,-(sp) + + jmp (r8) diff --cc usr/src/cmd/px/26for.s index 0000000000,9aba01aa4a,0000000000..30ad76cea9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/26for.s +++ b/usr/src/cmd/px/26for.s @@@@ -1,0 -1,49 -1,0 +1,68 @@@@ + +# - # 26for.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)26for.s 4.1 10/10/80"; + +# + +# FORS + +# + +_FOR1U: + + incl r10 + + movl (sp)+,r0 #r0 ptrs to index variable + + movl (sp)+,r1 #r1 has limit - acbb r1,$1,(r0),repeat - addl2 $2,r10 - jmp (r8) - repeat: +++ cmpb r1,(r0) #check for done +++ bleq done +++ incb (r0) #increment pointer + + cvtwl (r10),r1 + + addl2 r1,r10 + + jmp (r8) +++done: +++ addl2 $2,r10 +++ jmp (r8) + +_FOR2U: + + incl r10 + + movl (sp)+,r0 #r0 ptrs to index variable + + movl (sp)+,r1 #r1 has limit - acbw r1,$1,(r0),repeat - addl2 $2,r10 +++ cmpw r1,(r0) #check for done +++ bleq done +++ incw (r0) #increment pointer +++ cvtwl (r10),r1 +++ addl2 r1,r10 + + jmp (r8) + +_FOR4U: + + incl r10 + + movl (sp)+,r0 #r0 ptrs to index variable - aobleq (sp)+,(r0),repeat - addl2 $2,r10 +++ cmpl (sp)+,(r0) #check for done +++ bleq done +++ incl (r0) #increment pointer +++ cvtwl (r10),r1 +++ addl2 r1,r10 + + jmp (r8) + +_FOR1D: + + incl r10 + + movl (sp)+,r0 #r0 ptrs to index variable + + movl (sp)+,r1 #r1 has limit - acbb r1,$-1,(r0),repeat - addl2 $2,r10 +++ cmpb r1,(r0) #check for done +++ bgeq done +++ decb (r0) #increment pointer +++ cvtwl (r10),r1 +++ addl2 r1,r10 + + jmp (r8) + +_FOR2D: + + incl r10 + + movl (sp)+,r0 #r0 ptrs to index variable + + movl (sp)+,r1 #r1 has limit - acbw r1,$-1,(r0),repeat - addl2 $2,r10 +++ cmpw r1,(r0) #check for done +++ bgeq done +++ decw (r0) #increment pointer +++ cvtwl (r10),r1 +++ addl2 r1,r10 + + jmp (r8) + +_FOR4D: + + incl r10 + + movl (sp)+,r0 #r0 ptrs to index variable - acbl (sp)+,$-1,(r0),repeat - addl2 $2,r10 +++ cmpl (sp)+,(r0) #check for done +++ bgeq done +++ decl (r0) #increment pointer +++ cvtwl (r10),r1 +++ addl2 r1,r10 + + jmp (r8) diff --cc usr/src/cmd/px/27conv.s index 0000000000,07d393a6ad,0000000000..5eb9a3fb1b mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/27conv.s +++ b/usr/src/cmd/px/27conv.s @@@@ -1,0 -1,21 -1,0 +1,23 @@@@ + +# - # 27conv.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)27conv.s 4.1 10/10/80"; + +# + +# CONVERSIONS + +# + +_STOI: + + incl r10 + + cvtwl (sp)+,-(sp) + + jmp (r8) + +_STOD: + + incl r10 + + cvtwd (sp)+,-(sp) + + jmp (r8) + +_ITOD: + + incl r10 + + cvtld (sp)+,-(sp) + + jmp (r8) + +_ITOS: + + incl r10 + + cvtlw (sp)+,-(sp) + + jmp (r8) diff --cc usr/src/cmd/px/28fun.s index 0000000000,3ff093af88,0000000000..51d64d5256 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/28fun.s +++ b/usr/src/cmd/px/28fun.s @@@@ -1,0 -1,268 -1,0 +1,266 @@@@ + +# - # 28fun.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)28fun.s 4.1 10/10/80"; + +# + +# BUILT IN FUNCTIONS + +# + +_LLIMIT: + + incl r10 + + movl (sp)+,r0 #r0 has line limit + + bgtr l2811 + + movl $0x7fffffff,r0 #non-positive indicates no limit + +l2811: + + movl *(sp)+,r1 #r1 has file + + movl r0,LLIMIT(r1) + + jmp (r8) + +_ARGC: + + incl r10 + + pushl _argc + + jmp (r8) + +_ARGV: + + cvtbl (r10)+,r2 + + bneq l2801 - cvtwl (r10)+,r2 #r2 has size of character array +++ movzwl (r10)+,r2 #r2 has size of character array + +l2801: + + movl (sp)+,r3 #r3 has addr of character array - cvtwl (sp)+,r4 #r4 has subscript into argv - blss eargv +++ movl (sp)+,r4 #r4 has subscript into argv + + cmpl r4,_argc - bgeq eargv +++ bgequ eargv + + movl *_argv[r4],r4 #r4 has pointer to argv string + + locc $0,r2,(r4) #find end of string + + subl3 r0,r2,r0 #calculate actual string length + + movc5 r0,(r4),$blank,r2,(r3) #move with blank fill + + jmp (r8) + +eargv: + + movw $EARGV,_perrno + + jbr error + +_WCLCK: + + incl r10 + + pushal -(sp) #space for time + + calls $1,_time + + jmp (r8) + +_SCLCK: - cvtbl $1,r2 +++ cvtbl $1,r6 + + brb l2805 + +_CLCK: - clrl r2 +++ clrl r6 + +l2805: + + incl r10 + + subl2 $16,sp + + pushl sp + + calls $1,_times - movl (sp)[r2],r0 +++ movl (sp)[r6],r0 + + addl2 $16,sp - mull2 $1000,r0 - cvtld r0,r0 - divd2 $HZ,r0 - cvtdl r0,-(sp) +++ mull2 $50,r0 #(60ths * 1000) / 60 +++ divl3 $3,r0,-(sp) # == (60ths * 50) / 3 + + jmp (r8) + +_DATE: + + incl r10 + + pushl $O_DATE + + calls $2,_pdattim + + jmp (r8) + +_TIME: + + incl r10 + + pushl $O_TIME + + calls $2,_pdattim + + jmp (r8) + +_STLIM: + + incl r10 + + movl (sp)+,_stlim - aoblss _stlim,_stcnt,l2812 +++ cmpl _stcnt,_stlim +++ bgeq l2812 +++ jmp (r8) +++l2812: + + movw $ESTLIM,_perrno + + jbr error - l2812: - jmp (r8) + +_SEED: + + incl r10 + + calls $0,_srand + + jmp (r8) + +_RANDOM: + + incl r10 + + calls $0,_rand + + cvtld r0,r1 - divd2 maxint,r1 - movd r1,(sp) +++ divd3 $0d2.147483647e+09,r1,(sp) #div by maxint to get 0..1 + + jmp (r8) - maxint: - .double 0d2.147483647e+09 + +_DISPOSE: - incl r10 +++ movzbl (r10)+,r0 #r0 has size being disposed +++ bneq l2813 +++ movzwl (r10)+,r0 +++l2813: + + movl (sp)+,r6 #r6 points to pointer + + pushl (r6) #fetch pointer value + + calls $1,_pfree #free space + + clrl (r6) #set pointer to nil + + jmp (r8) + +_NEW: - movzbl (r10)+,r0 +++ movzbl (r10)+,r6 + + bneq l2806 - movzwl (r10)+,r0 +++ movzwl (r10)+,r6 + +l2806: - pushl r0 +++ pushl r6 + + calls $1,_palloc + + movl r0,*(sp)+ +++ movc5 $0,(r1),$0,r6,(r0) + + jmp (r8) + +_EXPO: + + incl r10 + + clrl 4(sp) + + movl (sp)+,r0 + + beql l2807 + + bicl2 $0xffff8000,r0 + + ashl $-7,r0,r0 + + subl2 $128,r0 + + movl r0,(sp) + +l2807: + + jmp (r8) + +_ATAN: + + incl r10 + + calls $2,_atan + + movd r0,-(sp) + + jmp (r8) + +_COS: + + incl r10 + + calls $2,_cos + + movd r0,-(sp) + + jmp (r8) + +_EXP: + + incl r10 + + calls $2,_exp + + movd r0,-(sp) + + jmp (r8) + +_SIN: + + incl r10 + + calls $2,_sin + + movd r0,-(sp) + + jmp (r8) + +_LN: + + incl r10 + + tstd (sp) + + bleq eln + + calls $2,_log + + movd r0,-(sp) + + jmp (r8) + +eln: + + movw $ELN,_perrno + + jbr error + +_SQRT: + + incl r10 + + tstd (sp) + + blss esqrt + + calls $2,_sqrt + + movd r0,-(sp) + + jmp (r8) + +esqrt: + + movw $ESQRT,_perrno + + jbr error + +_CHR2: +++_CHR4: + + incl r10 - movw (sp),r0 - blss echr - cmpw r0,$177 +++ movl (sp)+,r0 +++ cmpl r0,$0x7f + + bgtru echr +++ movw r0,-(sp) + + jmp (r8) + +echr: + + movw $ECHR,_perrno + + jbr error - _CHR4: - incl r10 - movl (sp)+,r0 - blss echr - cmpl r0,$177 - bgtru echr - movw r0,-(sp) - jmp (r8) + +_ODD4: - movw (sp)+,(sp) + +_ODD2: +++ movw (sp)+,(sp) + + incl r10 + + bicw2 $0xfffe,(sp) + + jmp (r8) + +_PRED2: + + incl r10 +++ movw (sp)+,(sp) + + decw (sp) + + jmp (r8) + +_PRED4: - incl r10 - decl (sp) - jmp (r8) + +_PRED24: + + incl r10 - cvtwl (sp)+,r0 - subl3 $1,r0,-(sp) +++ decl (sp) + + jmp (r8) + +_SUCC2: + + incl r10 +++ movw (sp)+,(sp) + + incw (sp) + + jmp (r8) + +_SUCC4: - incl r10 - incl (sp) - jmp (r8) + +_SUCC24: + + incl r10 - cvtwl (sp)+,r0 - addl3 $1,r0,-(sp) +++ incl (sp) + + jmp (r8) + +_ROUND: + + incl r10 + + cvtrdl (sp)+,-(sp) + + jmp (r8) + +_TRUNC: + + incl r10 + + cvtdl (sp)+,-(sp) + + jmp (r8) + +_UNDEF: + + incl r10 + + addl2 $8,sp + + clrw -(sp) + + jmp (r8) + +# + +# pack(a,i,z) + +# + +# with: a: array[m..n] of t + +# z: packed array[u..v] of t + +# + +# semantics: for j := u to v do + +# z[j] := a[j-u+i]; + +# + +# need to check: + +# 1. i >= m + +# 2. i+(v-u) <= n (i.e. i-m <= (n-m)-(v-u)) + +# - # on stack: lv(z), lv(a), rv(i) (len 2) +++# on stack: lv(z), lv(a), rv(i) (len 4) + +# + +# move w(t)*(v-u+1) bytes from lv(a)+w(t)*(i-m) to lv(z) + +# + +_PACK: + + cvtbl (r10)+,r0 + + bneq l2809 - cvtwl (r10)+,r0 #r0 has size of "a" types +++ movzwl (r10)+,r0 #r0 has size of "a" types + +l2809: + + clrl r1 #r1 := subscript - lower_bound + + subw3 (r10)+,8(sp),r1 - cvtwl (r10)+,r3 #r3 := high_bound - index r1,$0,r3,r0,$0,r4 #r4 has index of "a" - movc3 (r10)+,*4(sp)[r4],*(sp) #make the move - addl2 $10,sp #clear the stack - jmp (r8) +++ blss epack +++ cmpw r1,(r10)+ #check upper bound +++ bgtru epack +++ mull2 r0,r1 #r1 has byte offset +++ movc3 (r10)+,*4(sp)[r1],*(sp) #make the move +++ addl2 $12,sp #clear the stack +++ jmp (r8) +++epack: +++ movw $EPACK,_perrno +++ jbr error + +# + +# unpack(z,a,i) + +# + +# with: z and a as in pack + +# + +# semantics: for j := u to v do + +# a[j-u+i] := z[j] + +# + +_UNPACK: + + cvtbl (r10)+,r0 + + bneq l2810 - cvtwl (r10)+,r0 #r0 has size of "a" types +++ movzwl (r10)+,r0 #r0 has size of "a" types + +l2810: + + clrl r1 #r1 := subscript - lower_bound + + subw3 (r10)+,8(sp),r1 - cvtwl (r10)+,r3 #r3 := high_bound - index r1,$0,r3,r0,$0,r4 #r4 has index of "a" - movc3 (r10)+,*(sp),*4(sp)[r4] #make the move - addl2 $10,sp #clear the stack - jmp (r8) +++ blss eunpack +++ cmpw r1,(r10)+ #check upper bound +++ bgtru eunpack +++ mull2 r0,r1 #r1 has byte offset +++ movc3 (r10)+,*(sp),*4(sp)[r1] #make the move +++ addl2 $12,sp #clear the stack +++ jmp (r8) +++eunpack: +++ movw $EUNPACK,_perrno +++ jbr error diff --cc usr/src/cmd/px/30read.s index 0000000000,7780671420,0000000000..d45f6c4803 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/30read.s +++ b/usr/src/cmd/px/30read.s @@@@ -1,0 -1,72 -1,0 +1,118 @@@@ + +# - # 30read.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)30read.s 4.2 10/29/80"; + +# + +# READ OPERATIONS + +# + +_GET: + + incl r10 + + calls $0,_iosync #insure that something is in the window +++ jbs $fEOF,FUNIT(r7),eeof + + bisw2 $SYNC,FUNIT(r7) #throw it away + + jmp (r8) +++eeof: +++ movw $EPASTEOF,_perrno +++ jbr error + +_FNIL: + + incl r10 + + movl (sp),r0 - bbs $fWRITE,FUNIT(r0),l3002 #ignore sync of output files - movl r7,r2 - movl _file,r3 +++ jbs $fWRITE,FUNIT(r0),l3002 #ignore sync of output files +++ movl r7,r6 + + calls $0,_unit #do not discard arguement to unit on return + + calls $0,_iosync - movl r2,r7 - movl r3,_file +++ jbs $fEOF,FUNIT(r7),eeof +++ movl r6,r7 +++ movl PFNAME(r7),_file + +l3002: + + jmp (r8) + +_READ4: + + incl r10 + + calls $0,_unsync #prepare input stream + + pushl $0 #space for answer + + pushl sp #ptr to answer space + + pushal rd4 #ptr to input format + + pushl FBUF(r7) #stream + + calls $3,_fscanf + + cmpl $1,r0 + + bneq eiread + + bisw2 $SYNC,FUNIT(r7) + + jmp (r8) + +eiread: + + movw $EBADINUM,_perrno + + jbr error + +_READ8: + + incl r10 + + calls $0,_unsync #prepare input stream + + clrd -(sp) #space for answer + + pushl sp #ptr to answer space + + pushal rd8 #ptr to input format + + pushl FBUF(r7) #stream + + calls $3,_fscanf + + cmpl $1,r0 + + bneq efread + + bisw2 $SYNC,FUNIT(r7) + + jmp (r8) + +efread: + + movw $EBADFNUM,_perrno + + jbr error + +_READLN: + + incl r10 + + calls $0,_iosync - bbs $fEOLN,FUNIT(r7),l3005 #check for already at end of line - pushal rdln - pushl FBUF(r7) - calls $2,_fscanf +++ jbs $fEOLN,FUNIT(r7),l3005 #check for already at end of line +++ movab -1024(sp),sp #temp space +++ pushl FBUF(r7) #file +++ pushl $1024 #buffer +++ pushal 8(sp) #ptr to buffer +++ calls $3,_fgets +++ movab 1024(sp),sp #pop temp space + +l3005: +++ jbs $fEOF,FUNIT(r7),eeof + + bisw2 $SYNC,FUNIT(r7) + + jmp (r8) + +_READC: + + incl r10 + + calls $0,_iosync + + cvtbw (r7),-(sp) +++ jbs $fEOF,FUNIT(r7),eeof + + bisw2 $SYNC,FUNIT(r7) + + jmp (r8) +++_READE: +++ incl r10 +++ calls $0,_unsync #push back char if present +++ subl2 $bufsze,sp #allocate space for name +++ pushl sp #ptr to buffer +++ pushal rden #format string +++ pushl FBUF(r7) #FILE ptr +++ calls $3,_fscanf #read name +++ cmpl r0,$1 #check for valid input +++ bneq entfd +++ locc $0,$bufsze,(sp) #find size of input +++ subl3 r0,$bufsze+1,r6 #r6 has length of input +++ addl3 (r10),ap,r5 #r5 points to candidate data +++ cvtwl (r5)+,r4 #r4 has number of candidates +++ movaw 2(r5)[r4],r1 #r1 has addr of candidate name list +++l3006: +++ subw3 (r5)+,(r5),r0 #r0 has candidate length +++ cmpw r0,r6 #check for correct length +++ bneq l3007 +++ cmpc3 r0,(r1),(sp) #check for actual match +++ beql l3008 +++l3007: +++ addl2 r0,r1 #update ptr to next candidate +++ sobgtr r4,l3006 +++entfd: +++ addl2 $bufsze,sp #deallocate buffer +++ addl2 $4,r10 +++ movw $ENUMNTFD,_perrno +++ jbr error +++l3008: +++ addl2 $bufsze,sp #deallocate buffer +++ addl3 (r10)+,ap,r0 #r0 has number of cases +++ subw3 r4,(r0),-(sp) #push internal value +++ jmp (r8) + + - rd4: .byte '%,'l,'d, 0 - rd8: .byte '%,'l,'f, 0 - rdln: .byte '%,'*,'[,'^,linefeed,'],'%,'*,'c, 0 +++ .set bufsze,84 +++rd4: .asciz "%ld" +++rd8: .asciz "%lf" +++rden: .asciz "%*[ \t\n]%80[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789]", diff --cc usr/src/cmd/px/31write.s index 0000000000,021be9742a,0000000000..c81ada4bdc mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/31write.s +++ b/usr/src/cmd/px/31write.s @@@@ -1,0 -1,107 -1,0 +1,116 @@@@ + +# - # 31write.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)31write.s 4.1 10/10/80"; + +# + +# WRITE OPERATIONS + +# + +_PUT: + + incl r10 + + bbc $fWRITE,FUNIT(r7),ewriteit + + pushl FBUF(r7) #stream + + pushl $1 #number of items + + pushl FSIZE(r7) #item size + + pushl r7 #ptr to data + + calls $4,_fwrite - cleanup: + + movl FBUF(r7),r5 #ptr to FILE + + bbs $ioERR,FLAG(r5),ewrite - cmpl r7,$stdout #check for output to stdout - bneq l3101 - tstw _bufopt #check for buffering on stdout - bneq l3101 - pushl r5 #if unbuffered then flush - calls $1,_fflush - l3101: +++ jmp (r8) +++ +++_WRITEF: +++ cvtbl (r10)+,r5 #r5 has number of longword arguements +++ bbc $fWRITE,FUNIT(r7),ewriteit +++ calls r5,_fprintf #output formatted data +++ movl FBUF(r7),r5 #ptr to FILE +++ bbs $ioERR,FLAG(r5),ewrite +++ jmp (r8) +++ +++_WRITEC: +++ incl r10 +++ bbc $fWRITE,FUNIT(r7),ewriteit +++ pushl FBUF(r7) #stream +++ pushl 4(sp) #push data +++ calls $3,_fputc +++ movl FBUF(r7),r5 +++ bbs $ioERR,FLAG(r5),ewrite #check for I/O error + + jmp (r8) + +ewriteit: + + movw $EWRITEIT,_perrno + + jbr error + +ewrite: + + movw $EWRITE,_perrno + + jbr error + + - _WRITEF: - cvtbl (r10)+,r6 #r6 has length of format string - cvtwl (r10)+,r5 #r5 has number of longword arguements - fentry: +++_WRITES: +++ incl r10 + + bbc $fWRITE,FUNIT(r7),ewriteit - pushal (sp)[r5] #addr of format string - pushl FBUF(r7) #stream - addl2 $2,r5 #r5 has total number of arguements - calls r5,_fprintf #output formatted data - addl2 r6,sp #pop format string - jbr cleanup +++ calls $4,_fwrite #output string +++ movl FBUF(r7),r5 #ptr to FILE +++ bbs $ioERR,FLAG(r5),ewrite +++ jmp (r8) + + + +_WRITLN: - aobleq LLIMIT(r7),LCOUNT(r7),l3105 +++ incl r10 +++ aobleq LLIMIT(r7),LCOUNT(r7),l3101 + + movw $ELLIMIT,_perrno + + jbr error - l3105: - movw $linefeed,-(sp) #push a linefeed - clrl r6 - cmpl r7,$stdout #check for flushing - bneq l3102 - cmpw $1,_bufopt #check for eoln flushing - bneq l3102 - incl r6 #set flush request - brb l3102 +++l3101: +++ bbc $fWRITE,FUNIT(r7),ewriteit +++ pushl FBUF(r7) #stream +++ pushl $linefeed #push a linefeed +++ calls $2,_fputc +++ movl FBUF(r7),r5 +++ bbs $ioERR,FLAG(r5),ewrite #check for I/O error +++ jmp (r8) +++ + +_PAGE: - movw $formfeed,-(sp) #push a formfeed - _WRITEC: - clrl r6 - l3102: + + incl r10 - jbc $fWRITE,FUNIT(r7),ewriteit - cvtwl (sp)+,r2 #hold data +++ bbc $fWRITE,FUNIT(r7),ewriteit + + pushl FBUF(r7) #stream - pushl r2 #push data +++ pushl $formfeed #push a formfeed + + calls $2,_fputc - jlbc r6,cleanup #if no flush request, normal exit + + movl FBUF(r7),r5 + + jbs $ioERR,FLAG(r5),ewrite #check for I/O error - pushl r5 #flush - calls $1,_fflush + + jmp (r8) + + - _WRITES: - cvtbl (r10)+,r5 #r5 has length of format string - cvtwl (r10)+,r6 #r6 has length of data - sentry: - jbc $fWRITE,FUNIT(r7),ewriteit - addl2 sp,r6 #r6 pts to format string - pushl sp #ptr to data - pushl r6 #ptr to format string - addl2 r5,r6 #r6 points to cleared top of stack - pushl FBUF(r7) #stream - calls $3,_fprintf #output string - movl r6,sp #pop data and format string - jbr cleanup - - _WRITEB: - cvtbl (r10)+,r6 #r6 has length of format string - bentry: - jbc $fWRITE,FUNIT(r7),ewriteit - movw (sp)+,r0 #push addr of appropriate string - beql l3103 - pushal s_true - brb l3104 - l3103: - pushal s_false - l3104: - pushal 4(sp) #addr of format string - pushl FBUF(r7) #stream - calls $3,_fprintf #print boolean - addl2 r6,sp #pop format string - jbr cleanup - - s_true: .byte 't,'r,'u,'e,linefeed,0 - s_false:.byte 'f,'a,'l,'s,'e,linefeed,0 +++_NAM: +++ incl r10 +++ addl3 (r10)+,ap,r6 #r6 points to scalar name list +++ movl (sp)+,r3 #r3 has data value +++ cmpw r3,(r6)+ #check for value out of range +++ bgequ enamrng +++ movzwl (r6)[r3],r4 #r4 has string index +++ pushab (r6)[r4] #push string ptr +++ jmp (r8) +++enamrng: +++ movw $ENAMRNG,_perrno +++ jbr error +++_MAX: +++ cvtbl (r10)+,r0 #r0 has width value +++ bneq l3105 +++ movzwl (r10)+,r0 +++l3105: +++ movzwl (r10)+,r1 #r1 has minimum width value +++ movl (sp),r2 #r2 has requested width +++ blss efmt #check for negative values +++ subl2 r0,r2 #shave down value +++ cmpl r1,r2 #check for below minimum width +++ bleq l3106 +++ movl r1,(sp) #force to be at least minimum width +++ jmp (r8) +++l3106: +++ movl r2,(sp) #set to reduced value +++ jmp (r8) +++efmt: +++ movw $EFMTSIZE,_perrno +++ jbr error +++_MIN: +++ cvtbl (r10)+,r0 #r0 has width value +++ bneq l3107 +++ movzwl (r10)+,r0 +++l3107: +++ cmpl (sp),r0 #check for greater than max allowed +++ blss l3108 +++ movl r0,(sp) #use smaller value +++l3108: +++ jmp (r8) diff --cc usr/src/cmd/px/32iostat.s index 0000000000,35b47c62a7,0000000000..8edc53dd44 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/32iostat.s +++ b/usr/src/cmd/px/32iostat.s @@@@ -1,0 -1,40 -1,0 +1,49 @@@@ + +# - # 32iostat.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)32iostat.s 4.2 10/16/80"; + +# + +# FILE ACTIVATION AND STATUS OPERATIONS + +# + +_UNIT: + + incl r10 + + calls $1,_unit + + jmp (r8) + +_UNITINP: + + incl r10 + + pushal stdin + + calls $1,_unit + + jmp (r8) + +_UNITOUT: + + incl r10 + + moval stdout,r7 + + movl stdout+PFNAME,_file + + jmp (r8) + +_EOF: - cvtwl $EOF,r5 - brb l3202 - _EOLN: - cvtwl $EOF+EOLN,r5 +++ incl r10 +++ movl r7,r6 #save active file +++ calls $1,_unit +++ movw $1,-(sp) +++ bitw $EOF,FUNIT(r7) +++ bneq l3202 +++ calls $0,_iosync +++ bitw $EOF,FUNIT(r7) +++ bneq l3202 +++ clrw (sp) + +l3202: +++ movl r6,r7 #restore active file +++ movl PFNAME(r7),_file +++ jmp (r8) +++_EOLN: + + incl r10 - movl _file,r4 #save active file - movl r7,r3 +++ movl r7,r6 #save active file + + calls $1,_unit + + clrw -(sp) - bbs $fEOF,FUNIT(r7),l3204 + + calls $0,_iosync - bitw r5,FUNIT(r7) +++ bitw $EOLN,FUNIT(r7) + + beql l3205 - l3204: + + incw (sp) + +l3205: - movl r3,r7 #restore active file - movl r4,_file +++ movl r6,r7 #restore active file +++ movl PFNAME(r7),_file + + jmp (r8) diff --cc usr/src/cmd/px/33iofile.s index 0000000000,e1e825fab6,0000000000..1999b8eeaa mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/33iofile.s +++ b/usr/src/cmd/px/33iofile.s @@@@ -1,0 -1,106 -1,0 +1,119 @@@@ + +# - # 33iofile.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)33iofile.s 4.2 10/14/80"; + +# + +# FILE HOUSEKEEPING OPERATIONS + +# + +_DEFNAME: - calls $0,_getname - movl r1,sp +++ incl r10 +++ calls $4,_getname + + bisw2 $FDEF,FUNIT(r0) + + jmp (r8) + +_BUFF: - cvtbw (r10)+,_bufopt +++ cvtbl (r10)+,r0 +++ bneq l3301 +++ pushl $0 +++ brb l3303 +++l3301: +++ cmpl r0,$1 +++ bgtr l3302 +++ jmp (r8) +++l3302: +++ pushal __sobuf +++l3303: +++ pushl stdout+FBUF +++ calls $2,_setbuf + + jmp (r8) + +_RESET: - cvtbl (r10),r3 #attempt to rewind only if stdin - bneq l3301 # and no name is given - cmpl *(sp),$stdin - bneq l3301 +++ incl r10 +++ tstl 8(sp) #attempt to rewind only if stdin +++ bneq l3304 # and no name is given +++ cmpl *12(sp),$stdin +++ bneq l3304 + + tstb stdin+FNAME - bneq l3301 +++ bneq l3304 + + pushl stdin+FBUF + + calls $1,_rewind + + tstl r0 # -1 => error + + blss eseek - addl2 $3,r10 - addl2 $4,sp #clear stack +++ addl2 $16,sp #clear stack + + bicw2 $EOF+EOLN,stdin+FUNIT + + bisw2 $SYNC,stdin+FUNIT + + jmp (r8) - l3301: - calls $0,_getname - movl r1,sp +++l3304: +++ calls $4,_getname + + movl r0,r6 + + pushal rdopen + + pushal FNAME(r6) + + calls $2,_fopen - tstl r0 - beql eopen +++ tstl r0 #check for valid open +++ bneq l3305 +++ bbc $fTEMP,FUNIT(r6),eopen #if TEMP file, set at EOF +++ bisw2 $EOF,FUNIT(r6) +++l3305: + + movl r0,FBUF(r6) + + bisw2 $SYNC+FREAD,FUNIT(r6) + + jmp (r8) + +eseek: + + movl stdin+PFNAME,_file + + movw $ESEEK,_perrno + + jbr error + +eopen: + + movl PFNAME(r6),_file + + movw $EOPEN,_perrno + + jbr error + +_REWRITE: - calls $0,_getname - movl r1,sp +++ incl r10 +++ calls $4,_getname + + movl r0,r6 + + movl PFNAME(r6),_file + + pushal wtopen + + pushal FNAME(r6) + + calls $2,_fopen + + tstl r0 + + beql ecreat + + movl r0,FBUF(r6) + + bisw2 $EOF+FWRITE,FUNIT(r6) + + jmp (r8) + +ecreat: + + movw $ECREATE,_perrno + + jbr error +++_FILE: +++ incl r10 +++ pushl FBUF(r7) +++ jmp (r8) + +_FLUSH: + + incl r10 + + calls $1,_unit - bbc $fWRITE,FUNIT(r7),l3302 +++ bbc $fWRITE,FUNIT(r7),l3306 + + pushl FBUF(r7) + + calls $1,_fflush - l3302: +++l3306: + + jmp (r8) + +_REMOVE: - cvtbl (r10)+,r3 #r3 has filename length - bneq l3303 - cvtwl (r10)+,r3 - l3303: - movl r3,r6 #r6 has stack length - blbc r6,l3304 - incl r6 - l3304: - addl3 r3,sp,r1 #r1 pts to end of name - l3305: - cmpb -(r1),$blank #delete trailing blanks - bneq l3306 #(note: could use "spanc" here) - clrb (r1) - sobgtr r3,l3305 - l3306: - movl sp,_file #remove file - pushl sp +++ incl r10 +++ movl (sp)+,r4 #r4 has max name length +++ movl (sp)+,r5 #r5 pts to name +++ locc $blank,r4,(r5) #check for trailing blanks +++ subl2 r0,r4 #deduct blanks if any +++ addl3 $2,r4,r6 #r6 has name + 1 aligned to word +++ bicl2 $1,r6 +++ subl2 r6,sp #allocate space +++ movc5 r4,(r5),$0,r6,(sp) #move in name with zero end +++ pushl sp #unlink file + + calls $1,_unlink - tstl r0 +++ tstl r0 #check for errors + + bneq eremove - addl2 r6,sp +++ addl2 r6,sp #deallocate space + + jmp (r8) + +eremove: - movl _file,sp #recover filename +++ movl sp,_file #point to name + + movw $EREMOVE,_perrno + + jbr error + +_MESSAGE: + + incl r10 + + calls $0,_pflush + + pushal stderr + + calls $1,_unit + + jmp (r8) diff --cc usr/src/cmd/px/34err.s index 0000000000,4b5cdcb393,0000000000..05a5ba4ee9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/34err.s +++ b/usr/src/cmd/px/34err.s @@@@ -1,0 -1,165 -1,0 +1,178 @@@@ + +# - # 34err.s - # - .set ECHR,1 - .set ESYSTEM,2 - .set EBUILTIN,3 - .set EHALT,4 - .set ENILPTR,5 - .set EPASTEOF,6 - .set ESQRT,7 - .set ESTKNEMP,8 - .set ESUBSCR,9 - .set EREFINAF,10 - .set EWRITE,11 - .set ENAMESIZE,12 - .set ELN,13 - .set EBADOP,14 - .set EBADINUM,15 - .set EGOTO,16 - .set ECASE,17 - .set ESEEK,18 - .set ECREATE,19 - .set EOUTOFMEM,20 - .set ECTTOT,21 - .set ESTLIM,22 - .set ESTKOVFLO,23 - .set EBADFNUM,24 - .set EREMOVE,25 - .set ECLOSE,26 - .set EOPEN,27 - .set EARGV,28 - .set EPACK,29 - .set EUNPACK,30 - .set ERANGE,31 - .set EASRT,32 - .set EREADIT,33 - .set EWRITEIT,34 - .set EINTR,35 - .set EASSIGN,36 - .set EFIXADD,37 - .set EFLTADD,38 - .set EFIXSUB,39 - .set EFLTSUB,40 - .set EFIXMUL,41 - .set EFLTMUL,42 - .set EFIXDIV,43 - .set EFLTDIV,44 - .set EMODDIV,45 - .set EFIXNEG,46 - .set ELLIMIT,47 - .set EFRAMESIZE,48 - .set ETRASHHEAP,49 +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)34err.s 4.1 10/10/80"; +++# +++ .set EARGV ,1 +++ .set EASRT ,2 +++ .set EASSIGN ,3 +++ .set EBADFNUM ,4 +++ .set EBADINUM ,5 +++ .set EBADOP ,6 +++ .set EBUILTIN ,7 +++ .set ECASE ,8 +++ .set ECHR ,9 +++ .set ECLOSE,10 +++ .set ECREATE,11 +++ .set EFIXADD,13 +++ .set EFIXDIV,14 +++ .set EFIXMUL,15 +++ .set EFIXNEG,16 +++ .set EFIXSUB,17 +++ .set EFLTADD,18 +++ .set EFLTDIV,19 +++ .set EFLTMUL,20 +++ .set EFLTSUB,21 +++ .set EFMTSIZE,22 +++ .set EGOTO,23 +++ .set EHALT,24 +++ .set EINTR,25 +++ .set ELLIMIT,26 +++ .set ELN,27 +++ .set EMODDIV,28 +++ .set ENAMESIZE,29 +++ .set ENAMRNG,30 +++ .set ENILPTR,31 +++ .set ENUMNTFD,32 +++ .set EOPEN,33 +++ .set EOUTOFMEM,34 +++ .set EPACK,35 +++ .set EPASTEOF,36 +++ .set ERANGE,37 +++ .set EREADIT,38 +++ .set EREFINAF,39 +++ .set EREMOVE,40 +++ .set ESEEK,41 +++ .set ESQRT,42 +++ .set ESTKNEMP,43 +++ .set ESTKOVFLO,44 +++ .set ESTLIM,45 +++ .set ESUBSCR,46 +++ .set ESYSTEM,47 +++ .set ETRASHHEAP,48 +++ .set EUNPACK,49 +++ .set EWRITE,50 +++ .set EWRITEIT,51 +++ .set ECTLWR,12 +++ .set ECTUPR,52 +++ .set ECTSNG,53 +++ .set ENARGS,54 + +# + +# Fielding interrupts and processing errors + +# + +# Process interpreter detected errors + +# + +error: + + movzwl _perrno,-(sp) + + calls $1,_error + + jmp (r8) + + + +_endinterpret: + + .byte 'e,'n,'d, 0 + + + +# + +# Keyboard interrupts + +# + + .align 1 + + .globl _intr + +_intr: + + .word 0 + + pushal _intr #reset interrupt signal + + pushl $SIGINT + + calls $2,_signal + + pushl $EINTR + + calls $1,_error + + ret + +# + +# Segmentation Violations => No more memory available for the stack + +# + + .align 1 + + .globl _memsize + +_memsize: + + .word 0 + + pushl $ESTKOVFLO + + calls $1,_error + + ret + +# +++# Die gracefully on unexpected signals +++# +++ .align 1 +++ .globl _syserr +++_syserr: +++ .word 0 +++ pushl $ESYSTEM +++ calls $1,_error +++ ret +++# + +# Process computational errors + +# + + .align 1 + + .globl _except + +_except: + + .word 0 + + pushal _except #reset signal + + pushl $SIGFPE + + calls $2,_signal - movl PC(fp),r0 #r0 has PC at point following error +++ movl 16(ap),r0 #r0 has PC at point following error + + moval errtbl-4,r1 #r1 points to error offset table + +l3404: + + addl2 $4,r1 #determine cause of error + + cmpl r0,(r1)+ + + blssu l3405 #not in table => system error + + cmpl r0,(r1)+ + + bgtru l3404 + + movzwl (r1),-(sp) #select error message + + brb l3406 + +l3405: + + pushl $ESYSTEM + +l3406: + + calls $1,_error + + ret + +# + +# Table of offsets and their associated errors + +# + + .align 1 + +errtbl: + + .long _AS2, _OFF, EASSIGN - .long _INX2, _NIL, ESUBSCR + + .long _ADD2, _ADD28, EFIXADD + + .long _ADD28, _SUB2, EFLTADD + + .long _SUB2, _SUB28, EFIXSUB - .long _SUB28, _SQR2, EFLTSUB - .long _SQR2, _MUL28, EFIXMUL +++ .long _SUB28, _MUL2, EFLTSUB +++ .long _MUL2, _MUL28, EFIXMUL + + .long _MUL28, _DIV2, EFLTMUL + + .long _DIV2, _MOD2, EFIXDIV + + .long _MOD2, _ABS2, EMODDIV + + .long _ABS2, _ABS8, EFIXNEG + + .long _DVD2, _IND1, EFLTDIV - .long _RANG2, _CASE1OP, ERANGE + + .long _STOI, _UNDEF, EBUILTIN - .long _PACK, _UNPACK, EPACK - .long _UNPACK, _GET, EUNPACK + + .long 0xffffffff + +# + +# recover values of dp and lino from the stack + +# + + .globl _fetchdp + + + +_fetchdp: + + .word R2|R3|R4|R5|R6|R7|R8|R9|R10|R11 + + pushl fp #sift through the stack to get the + + movl sp,oldsp # values of dp and lino + +l3401: + + bicw3 $0xf000,MASK(fp),mask #register save mask + + moval REGS(fp),sp #point to saved registers + + popr mask #pop them + + cmpl PC(fp),$_interpret #check for interpreter frame + + blss l3402 #not found + + cmpl PC(fp),$_endinterpret #check for end of interpreter + + blss l3403 #found + +l3402: + + movl FP(fp),fp #get next frames registers + + jbr l3401 + +l3403: + + movl oldsp,sp #restore current frame + + movl (sp)+,fp + + movl r9,*4(ap) #return dp + + movl r11,*8(ap) #return lino + + ret + + .data + +oldsp: .space 4 #old value of sp + +mask: .space 2 #register pop mask + + .text diff --cc usr/src/cmd/px/35iosubs.s index 0000000000,476677d52c,0000000000..3ca6d49544 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/35iosubs.s +++ b/usr/src/cmd/px/35iosubs.s @@@@ -1,0 -1,415 -1,0 +1,408 @@@@ + +# - # 35iosubs.s +++# Copyright (c) 1979 Regents of the University of California +++# +++# char sccsid[] = "@(#)35iosubs.s 4.2 10/16/80"; + +# + +# IO SUBROUTINES + +# + + .globl _getname #activate a file + + .globl _unit #establish active file + + .globl _iosync #syncronize a file window + + .globl _unsync #push backed synced record for formatted read + + .globl _pflush #flush all active files + + .globl _pclose #close selected files + + .globl _pmflush #flush pxp buffer + +# + +# system I/O routines + +# + + .globl _fclose + + .globl _fflush + + .globl _fopen + + .globl _fprintf + + .globl _fputc + + .globl _fread + + .globl _fscanf + + .globl _fwrite + + .globl _mktemp + + .globl _rewind - .globl _sscanf +++ .globl _setbuf + + .globl _ungetc + + .globl _unlink + +# + +# standard files + +# + +# file records + +# + + .set fnamesze,76 #maximum size of file name + + .set recsze,30+fnamesze #file record size + + .set FNAME,-recsze #name of associated UNIX file + + .set LCOUNT,-30 #number of lines of output + + .set LLIMIT,-26 #maximum number of text lines + + .set FBUF,-22 #FILE pointer + + .set FCHAIN,-18 #chain to next file + + .set FLEV,-14 #ptr to associated file variable + + .set PFNAME,-10 #ptr to name of error msg file + + .set FUNIT,-6 #file status flags + + .set FSIZE,-4 #size of elements in the file + + .set WINDOW,0 #file window element + +# + +# unit flags + +# + + .set FDEF,0x8000 #1 => reserved file name + + .set FTEXT,0x4000 #1 => text file, process EOLN + + .set FWRITE,0x2000 #1 => open for writing + + .set FREAD,0x1000 #1 => open for reading + + .set TEMP,0x0800 #1 => temporary file + + .set SYNC,0x0400 #1 => window is out of sync + + .set EOLN,0x0200 #1 => at end of line + + .set EOF,0x0100 #1 => at end of file + +# + +# bit positions of unit flags + +# + + .set fDEF,15 + + .set fTEXT,14 + + .set fWRITE,13 + + .set fREAD,12 + + .set fTEMP,11 + + .set fSYNC,10 + + .set fEOLN,9 + + .set fEOF,8 + +# + +# standard file buffers + +# + + .set ioEOF,4 #bit position flagging EOF + + .set ioERR,5 #bit position flagging I/O error + + .set FLAG,12 #record offset of error flag + +# + +# standard input file + +# + + .data + + .space fnamesze #name of associated UNIX file + + .long 0 #line count + + .long 0 #line limit + + .long __iob #FILE pointer + + .long stdout #chain to next file + + .long 0 #ptr to associated file variable + + .long sinnam #ptr to name of error msg file + + .word FTEXT+FREAD+SYNC #file status flags + + .long 1 #size of elements in the file + +stdin: + + .word 0 #file window element + +# + +# standard output file + +# + + .space fnamesze #name of associated UNIX file + + .long 0 #line count + + .long 0 #line limit + + .long __iob+16 #FILE pointer + + .long stderr #chain to next file + + .long 0 #ptr to associated file variable + + .long soutnam #ptr to name of error msg file + + .word FTEXT+FWRITE+EOF #file status flags + + .long 1 #size of elements in the file + +stdout: + + .word 0 #file window element + +# + +# standard error file + +# + + .space fnamesze #name of associated UNIX file + + .long 0 #line count + + .long 0 #line limit + + .long __iob+32 #FILE pointer + + .long 0 #chain to next file + + .long 0 #ptr to associated file variable + + .long msgnam #ptr to name of error msg file + + .word FTEXT+FWRITE #file status flags + + .long 1 #size of elements in the file + +stderr: + + .word 0 #file window element + + + +tmpname:.byte 't,'m,'p,'.,'X,'X,'X,'X,'X,'X, 0 + + .text + +sinnam: .byte 's,'t,'a,'n,'d,'a,'r,'d,' ,'i,'n,'p,'u,'t, 0 + +soutnam:.byte 's,'t,'a,'n,'d,'a,'r,'d,' ,'o,'u,'t,'p,'u,'t, 0 + +msgnam: .byte 'M,'e,'s,'s,'a,'g,'e,' ,'f,'i,'l,'e, 0 + +monout: .byte 'p,'m,'o,'n,'.,'o,'u,'t, 0 + +rdopen: .byte 'r, 0 + +wtopen: .byte 'w, 0 + + .set formfeed,12 + + .set linefeed,10 + + .set blank,' + +# + +# getname + +# + +# takes the width of a string in the subopcode and + +# returns a pointer to a file structure in r0 + +# + +# there should be a string on the stack + +# of length the contents of subopcode on top of + +# a pointer to the file variable + +# + +# a new file structure is allocated if needed + +# temporary names are generated, and given + +# names are blank trimmed + +# + +# if a new file buffer is allocated, the address + +# is stored in the file variable. + +# + +# - _getname: - .word R6|R7|R8|R9|R11 - cvtbl (r10)+, r8 # r8 has file name length - moval 4(ap), r9 # r9 will point to cleared stack - addl2 r8, r9 - blbc r9,l3501 - incl r9 - l3501: - movl ( r9)+, r11 # r11 pts to file variable - tstl ( r11) #check for existing file record +++_getname: #(datasze, maxnamlen, name, fileptr) +++#int datasze; +++#int maxnamlen; +++#char *name; +++#struct file **fileptr; +++ +++ .word R6|R7|R8|R9 +++ movl 4(ap),r6 #r6 has data size +++ movl 12(ap), r8 # r8 points to file name +++ movl 16(ap), r9 # r9 pts to file variable +++ tstl ( r9) #check for existing file record + + bneq gotone + +# + +# allocate and initialize a new file record + +# + + clrl r7 # r7 has status flags - cvtwl (r10)+,r6 #r6 has data size +++ tstl r6 #check for size + + bneq l3502 + + movw $FTEXT, r7 #default to text file + + movl $1,r6 #default size + +l3502: + + addl3 $recsze,r6,-(sp)#size of record + + calls $1,_palloc #r0 points to allocated buffer + + addl2 $recsze,r0 #adjust to base of record - l3503: + + clrl LCOUNT(r0) #set default line limits + + movl _llimit,LLIMIT(r0) + + movw r7,FUNIT(r0) #set flags + + movl r6,FSIZE(r0) #set size - movl r11,FLEV(r0) #set ptr to file variable - movl r0,( r11) #set file var ptr +++ movl r9,FLEV(r0) #set ptr to file variable +++ movl r0,( r9) #set file var ptr + +# + +# link the new record into the file chain + +# + + movl $_fchain-FCHAIN,r6 #r6 pts to "previous" record + + movl _fchain,r1 #r1 pts to "next" record + + brb l3505 + +l3504: + + movl r1,r6 #advance previous + + movl FCHAIN(r1),r1 #get next + +l3505: - cmpl FLEV(r1), r11 #check level +++ cmpl FLEV(r1), r9 #check level + + blssu l3504 #continue until greater + + + + movl r1,FCHAIN(r0) #link in new record + + movl r0,FCHAIN(r6) + + - movl r0, r11 # r11 points to file record +++ movl r0, r9 # r9 points to file record + + jbr setname + +# + +# have a previous buffer, dispose of associated file + +# + +gotone: - addl2 $2,r10 #discard data size - movl ( r11), r11 # r11 points to file record - bicw2 $~(FDEF+TEMP+FTEXT),FUNIT( r11) #clear status flags - bbc $fDEF,FUNIT( r11),l3506 #check for predefined file - bicw2 $FDEF,FUNIT( r11) #clear predefined flag +++ movl ( r9), r9 # r9 points to file record +++ bicw2 $~(FDEF+TEMP+FTEXT),FUNIT( r9) #clear status flags +++ bbc $fDEF,FUNIT( r9),l3506 #check for predefined file +++ bicw2 $FDEF,FUNIT( r9) #clear predefined flag + + jbr setname + +l3506: - pushl FBUF( r11) #flush and close previous file +++ pushl FBUF( r9) #flush and close previous file + + calls $1,_fclose - movl FBUF( r11),r0 +++ movl FBUF( r9),r0 + + bbs $ioERR,FLAG(r0),eclose - bbc $fTEMP,FUNIT( r11),setname #check for temp file +++ bbc $fTEMP,FUNIT( r9),setname #check for temp file + + tstl r8 #remove renamed temp files + + beql setname - pushl PFNAME( r11) +++ pushl PFNAME( r9) + + calls $1,_unlink + + tstl r0 #check for remove error + + beql setname - movl PFNAME( r11),_file +++eunlink: +++ movl PFNAME( r9),_file + + movw $EREMOVE,_perrno + + moval error,PC(fp) #error return + + ret + +eclose: - movl PFNAME( r11),_file +++ movl PFNAME( r9),_file + + movw $ECLOSE,_perrno + + moval error,PC(fp) #error return + + ret + +# + +# get the filename associated with the buffer + +# + +setname: + + tstl r8 #check for a given name + + bneq l3508 #br => has a name - tstb FNAME( r11) #check for no current name +++ tstb FNAME( r9) #check for no current name + + bneq l3513 #br => had a previous name so use it + +# + +# no name given and no previous name, so generate + +# a new one of the form tmp.xxxxxx + +# - bisw2 $TEMP,FUNIT( r11)#set status to temporary +++ bisw2 $TEMP,FUNIT( r9)#set status to temporary + + pushal tmpname #get a unique temp name + + calls $1,_mktemp - movl $13, r8 #max length of temp name - brb l3511 - # - # name is given, strip trailing blanks - # - l3508: - bicw2 $TEMP,FUNIT( r11)#set permanent status - moval 4(ap),r0 #r0 pts to end of file name - addl3 r8,r0,r1 #r1 pts to end of name - l3509: - cmpb -(r1),$blank #delete trailing blanks - bneq l3511 #(note: could use "scanc" with source - clrb (r1) # and table reversed) - sobgtr r8,l3509 +++ movl r0, r8 #ptr to new temp name +++ movl $16,r2 #maximum name length +++ brb l3512 + +# + +# put the new name into the structure + +# - l3511: - cmpl r8,$fnamesze #check for name too long - blss l3512 - movw $ENAMESIZE,_perrno - moval error,PC(fp) #error return - ret +++l3508: +++ bicw2 $TEMP,FUNIT( r9) #set permanent status +++ locc $blank,8(ap),( r8) #check for trailing blanks +++ subl3 r0,8(ap),r2 #deduct length of blanks +++ cmpl r2,$fnamesze #check for name too long +++ bgeq enamsze + +l3512: - movc3 r8,(r0),FNAME( r11) #move name into record - clrb FNAME( r11)[ r8] #place null char after name - moval FNAME( r11),PFNAME( r11) #set pointer to name +++ movc3 r2,( r8),FNAME( r9) #move name into record +++ clrb (r3) #place zero after name +++ moval FNAME( r9),PFNAME( r9) #set pointer to name + +l3513: - movl r9,r1 #return ptr to updated stack - movl r11,r0 #return ptr to file record +++ movl r9,r0 #return ptr to file record +++ ret +++enamsze: +++ movw $ENAMESIZE,_perrno +++ moval error,PC(fp) #error return + + ret + +# + +# unit establishes a new active file + +# + +_unit: + + .word 0 + + movl 4(ap),r7 + + beql erefinaf + + bbs $fDEF,FUNIT(r7),erefinaf + + movl PFNAME(r7),_file - cmpl r7,$stdin #flush stdout if activating stdin - bneq l3523 - cmpw _bufopt,$1 # and stdout is line buffered - bneq l3523 - pushl stdout+FBUF - calls $1,_fflush - l3523: + + ret + +erefinaf: + + movw $EREFINAF,_perrno + + moval error,PC(fp) #error return + + ret + +# + +# iosync insures that a useable image is in the buffer window + +# + +_iosync: + + .word R6 + + cvtwl FUNIT(r7),r6 #r6 has FUNIT flags + + bbc $fREAD,r6,eread #error if not open for reading + + bbc $fSYNC,r6,l3515 #check for already synced + + bbs $fEOF,r6,epeof #error if past EOF + + bicw2 $SYNC,r6 #clear unsynced flag + + pushl FBUF(r7) #stream + + pushl $1 #number of items to read + + pushl FSIZE(r7) #data size + + pushl r7 #ptr to input window + + calls $4,_fread + + movl FBUF(r7),r0 #check for EOF + + bbs $ioERR,FLAG(r0),epeof + + bbs $ioEOF,FLAG(r0),eof + + bbc $fTEXT,r6,l3514 #check for text processing + + bicw2 $EOLN,r6 #check for EOLN + + cmpb (r7),$linefeed + + bneq l3514 + + movb $blank,(r7) #blank out linefeed + + bisw2 $EOLN,r6 + +l3514: + + movw r6,FUNIT(r7) #update status flags + +l3515: + + ret + +eof: + + bisw2 $EOF,r6 #set EOF + + movw r6,FUNIT(r7) #update status flags + + pushr $R2|R3|R4|R5 #save registers + + movc5 $0,(r0),$0,FSIZE(r7),(r7) #clear buffer to undefined + + popr $R2|R3|R4|R5 #restore registers + + ret + +eread: + + movw $EREADIT,_perrno + + moval error,PC(fp) #error return + + ret + +epeof: + + movw $EPASTEOF,_perrno + + moval error,PC(fp) #error return + + ret + +# + +# push back last char read to prepare for formatted read + +# + +_unsync: + + .word 0 + + bbc $fREAD,FUNIT(r7),eread #error if not open for reading + + bbs $fSYNC,FUNIT(r7),l3526 #push back window char + + pushl FBUF(r7) + + cvtbl (r7),-(sp) + + calls $2,_ungetc + +l3526: + + ret + +# + +# flush all active output files + +# + +_pflush: + + .word R6 + + movl _fchain,r6 + + beql l3518 + +l3516: + + bbc $fWRITE,FUNIT(r6),l3517 + + pushl FBUF(r6) + + calls $1,_fflush + +l3517: + + movl FCHAIN(r6),r6 + + bneq l3516 + +l3518: + + ret + +# + +# close all active files down to the specified FLEV + +# + +_pclose: - .word R6|R7 - movl _fchain, r7 +++ .word R6|R9 +++ movl _fchain, r9 + + beql l3520 + +l3519: - cmpl FLEV( r7),4(ap) +++ cmpl FLEV( r9),4(ap) + + bgtru l3520 - bbs $fDEF,FUNIT( r7),l3525 - movl FBUF( r7),r6 +++ bbs $fDEF,FUNIT( r9),l3525 +++ movl FBUF( r9),r6 +++ beql l3525 + + pushl r6 + + calls $1,_fclose + + jbs $ioERR,FLAG(r6),eclose +++ bbc $fTEMP,FUNIT( r9),l3525 +++ pushl PFNAME( r9) #remove TEMP files +++ calls $1,_unlink +++ tstl r0 +++ jneq eunlink + +l3525: - subl3 $recsze, r7,-(sp) - movl FCHAIN( r7), r7 +++ subl3 $recsze, r9,-(sp) +++ movl FCHAIN( r9), r9 + + calls $1,_pfree - tstl r7 +++ tstl r9 + + bneq l3519 + +l3520: - movl r7,_fchain +++ movl r9,_fchain + + ret + +# + +# write out the pxp data + +# + +_pmflush: + + .word R6 + + tstl _pxpbuf + + beql l3521 + + pushal wtopen + + pushal monout + + calls $2,_fopen + + tstl r0 + + beql l3522 + + movl r0,r6 + + pushl r6 + + pushl $1 + + pushl _pxpsize + + pushl _pxpbuf + + calls $4,_fwrite + + bbs $ioERR,FLAG(r6),l3522 + + pushl r6 + + calls $1,_fclose + + bbs $ioERR,FLAG(r6),l3522 + +l3521: + + ret + +l3522: + + pushal monout + + calls $1,_perror + + ret diff --cc usr/src/cmd/px/OPnames.h index 0000000000,0000000000,0000000000..5f7f12d420 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/OPnames.h @@@@ -1,0 -1,0 -1,0 +1,262 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)OPnames.h 4.1 10/10/80"; */ +++ +++char *otext[] = { +++ 0, +++ " NODUMP", +++ " BEG", +++ " END", +++ " CALL", +++ " FCALL", +++ " FRTN", +++ " FSAV", +++ " SDUP2", +++ " SDUP4", +++ " TRA", +++ " TRA4", +++ " GOTO", +++ " LINO", +++ " PUSH", +++ 0, +++ " IF", +++ " REL2", +++ " REL4", +++ " REL24", +++ " REL42", +++ " REL8", +++ " RELG", +++ " RELT", +++ " REL28", +++ " REL48", +++ " REL82", +++ " REL84", +++ " AND", +++ " OR", +++ " NOT", +++ 0, +++ " AS2", +++ " AS4", +++ " AS24", +++ " AS42", +++ " AS21", +++ " AS41", +++ " AS28", +++ " AS48", +++ " AS8", +++ " AS", +++ " INX2P2", +++ " INX4P2", +++ " INX2", +++ " INX4", +++ " OFF", +++ " NIL", +++ " ADD2", +++ " ADD4", +++ " ADD24", +++ " ADD42", +++ " ADD28", +++ " ADD48", +++ " ADD82", +++ " ADD84", +++ " SUB2", +++ " SUB4", +++ " SUB24", +++ " SUB42", +++ " SUB28", +++ " SUB48", +++ " SUB82", +++ " SUB84", +++ " MUL2", +++ " MUL4", +++ " MUL24", +++ " MUL42", +++ " MUL28", +++ " MUL48", +++ " MUL82", +++ " MUL84", +++ " ABS2", +++ " ABS4", +++ " ABS8", +++ 0, +++ " NEG2", +++ " NEG4", +++ " NEG8", +++ 0, +++ " DIV2", +++ " DIV4", +++ " DIV24", +++ " DIV42", +++ " MOD2", +++ " MOD4", +++ " MOD24", +++ " MOD42", +++ " ADD8", +++ " SUB8", +++ " MUL8", +++ " DVD8", +++ " STOI", +++ " STOD", +++ " ITOD", +++ " ITOS", +++ " DVD2", +++ " DVD4", +++ " DVD24", +++ " DVD42", +++ " DVD28", +++ " DVD48", +++ " DVD82", +++ " DVD84", +++ " RV1", +++ " RV14", +++ " RV2", +++ " RV24", +++ " RV4", +++ " RV8", +++ " RV", +++ " LV", +++ " LRV1", +++ " LRV14", +++ " LRV2", +++ " LRV24", +++ " LRV4", +++ " LRV8", +++ " LRV", +++ " LLV", +++ " IND1", +++ " IND14", +++ " IND2", +++ " IND24", +++ " IND4", +++ " IND8", +++ " IND", +++ 0, +++ " CON1", +++ " CON14", +++ " CON2", +++ " CON24", +++ " CON4", +++ " CON8", +++ " CON", +++ " LVCON", +++ " RANG2", +++ " RANG42", +++ " RSNG2", +++ " RSNG42", +++ " RANG4", +++ " RANG24", +++ " RSNG4", +++ " RSNG24", +++ " STLIM", +++ " LLIMIT", +++ " BUFF", +++ " HALT", +++ 0, +++ 0, +++ 0, +++ 0, +++ "*ORD2", +++ "*CONG", +++ "*CONC", +++ "*CONC4", +++ "*ABORT", +++ " PXPBUF", +++ " COUNT", +++ 0, +++ " CASE1OP", +++ " CASE2OP", +++ " CASE4OP", +++ "*CASEBEG", +++ "*CASE1", +++ "*CASE2", +++ "*CASE4", +++ "*CASEEND", +++ " ADDT", +++ " SUBT", +++ " MULT", +++ " INCT", +++ " CTTOT", +++ " CARD", +++ " IN", +++ " ASRT", +++ " FOR1U", +++ " FOR2U", +++ " FOR4U", +++ " FOR1D", +++ " FOR2D", +++ " FOR4D", +++ 0, +++ 0, +++ " READE", +++ " READ4", +++ " READC", +++ " READ8", +++ " READLN", +++ " EOF", +++ " EOLN", +++ 0, +++ " WRITEC", +++ " WRITES", +++ " WRITEF", +++ " WRITLN", +++ " PAGE", +++ " NAM", +++ " MAX", +++ " MIN", +++ " UNIT", +++ " UNITINP", +++ " UNITOUT", +++ " MESSAGE", +++ " GET", +++ " PUT", +++ " FNIL", +++ 0, +++ " DEFNAME", +++ " RESET", +++ " REWRITE", +++ " FILE", +++ " REMOVE", +++ " FLUSH", +++ 0, +++ 0, +++ " PACK", +++ " UNPACK", +++ " ARGC", +++ " ARGV", +++ 0, +++ 0, +++ 0, +++ 0, +++ " CLCK", +++ " WCLCK", +++ " SCLCK", +++ " DISPOSE", +++ " NEW", +++ " DATE", +++ " TIME", +++ " UNDEF", +++ " ATAN", +++ " COS", +++ " EXP", +++ " LN", +++ " SIN", +++ " SQRT", +++ " CHR2", +++ " CHR4", +++ " ODD2", +++ " ODD4", +++ " PRED2", +++ " PRED4", +++ " PRED24", +++ " SUCC2", +++ " SUCC4", +++ " SUCC24", +++ " SEED", +++ " RANDOM", +++ " EXPO", +++ " SQR2", +++ " SQR4", +++ " SQR8", +++ " ROUND", +++ " TRUNC" +++}; diff --cc usr/src/cmd/px/errdata index 0000000000,55c2f9f396,0000000000..96101e2136 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/errdata +++ b/usr/src/cmd/px/errdata @@@@ -1,0 -1,49 -1,0 +1,55 @@@@ - ECHR 1 - ESYSTEM 2 - EBUILTIN 3 - EHALT 4 - ENILPTR 5 - EPASTEOF 6 - ESQRT 7 - ESTKNEMP 8 - ESUBSCR 9 - EREFINAF 10 - EWRITE 11 - ENAMESIZE 12 - ELN 13 - EBADOP 14 - EBADINUM 15 - EGOTO 16 - ECASE 17 - ESEEK 18 - ECREATE 19 - EOUTOFMEM 20 - ECTTOT 21 - ESTLIM 22 - ESTKOVFLO 23 - EBADFNUM 24 - EREMOVE 25 - ECLOSE 26 - EOPEN 27 - EARGV 28 - EPACK 29 - EUNPACK 30 - ERANGE 31 - EASRT 32 - EREADIT 33 - EWRITEIT 34 - EINTR 35 - EASSIGN 36 - EFIXADD 37 - EFLTADD 38 - EFIXSUB 39 - EFLTSUB 40 - EFIXMUL 41 - EFLTMUL 42 - EFIXDIV 43 - EFLTDIV 44 - EMODDIV 45 - EFIXNEG 46 - ELLIMIT 47 - EFRAMESIZE 48 - ETRASHHEAP 49 +++"@(#)errdata 4.1 10/10/80" +++EARGV 1 +++EASRT 2 +++EASSIGN 3 +++EBADFNUM 4 +++EBADINUM 5 +++EBADOP 6 +++EBUILTIN 7 +++ECASE 8 +++ECHR 9 +++ECLOSE 10 +++ECREATE 11 +++EFIXADD 13 +++EFIXDIV 14 +++EFIXMUL 15 +++EFIXNEG 16 +++EFIXSUB 17 +++EFLTADD 18 +++EFLTDIV 19 +++EFLTMUL 20 +++EFLTSUB 21 +++EFMTSIZE 22 +++EGOTO 23 +++EHALT 24 +++EINTR 25 +++ELLIMIT 26 +++ELN 27 +++EMODDIV 28 +++ENAMESIZE 29 +++ENAMRNG 30 +++ENILPTR 31 +++ENUMNTFD 32 +++EOPEN 33 +++EOUTOFMEM 34 +++EPACK 35 +++EPASTEOF 36 +++ERANGE 37 +++EREADIT 38 +++EREFINAF 39 +++EREMOVE 40 +++ESEEK 41 +++ESQRT 42 +++ESTKNEMP 43 +++ESTKOVFLO 44 +++ESTLIM 45 +++ESUBSCR 46 +++ESYSTEM 47 +++ETRASHHEAP 48 +++EUNPACK 49 +++EWRITE 50 +++EWRITEIT 51 +++ECTLWR 12 +++ECTUPR 52 +++ECTSNG 53 +++ENARGS 54 diff --cc usr/src/cmd/px/h00vars.h index 0000000000,a49783fbd1,0000000000..70295d1aa9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/h00vars.h +++ b/usr/src/cmd/px/h00vars.h @@@@ -1,0 -1,164 -1,0 +1,164 @@@@ - # +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)h00vars.h 4.1 10/10/80"; */ +++ + +/* + + * px - Berkeley Pascal interpreter + + * + + * Version 2.0, January 1979 + + * + + * Original version by Ken Thompson + + * + + * Substantial revisions by Bill Joy and Chuck Haley + + * November-December 1976 + + * + + * Rewritten for VAX 11/780 by Kirk McKusick + + * Fall 1978 + + * + + * Px is described in detail in the "PX 1.0 Implementation Notes" + + * The source code for px is in several major pieces: + + * + + * int.c C main program which reads in interpreter code + + * 00case.s Driver including main interpreter loop + + * dd*.s Where dd are digits, interpreter instructions + + * grouped by their positions in the interpreter table. + + * p*.c Various C language routines supporting the system. + + * + + * In addition there are several headers defining mappings for error + + * messages names into codes, and a definition of the interpreter transfer + + * table. These are made by the script Emake in this directory and the scripts + + * in the directory '../opcodes'. + + */ +++#define TRUE 1 +++#define FALSE 0 +++#define BITSPERLONG 32 + + + +long argc; + +char **argv; + + + +/* + + * Pascal runtime errors transfer to the routine + + * 'error' in the file perror.c to decode them. + + */ + +int perrno; /* number of error which occurred */ + + + +/* + + * Definitions for memory allocation + + * Memory allocation is done by palloc in utilities.c + + */ + + + +/* + + * The file i/o routines maintain a notion of a "current file". + + * The printing name of this file is kept in the variable + + * "file" for use in error messages. + + */ + +char *file; /* ptr to active file name */ + +long fchain; /* head of active file chain */ - int bufopt; /* controls flushing of std output as follows: - * 0 => flush on every write - * 1 => flush before std read or at end of line - * 2 => normal buffering - */ +++ + +/* + + * THE RUNTIME DISPLAY + + * + + * The entries in the display point to the active static block marks. + + * The first entry in the display is for the global variables, + + * then the procedure or function at level one, etc. + + * Each display entry points to a stack frame as shown: + + * + + * base of stack frame + + * --------------- + + * | | + + * | block mark | + + * | | + + * --------------- <-- display entry points here + + * | | + + * | local | + + * | variables | + + * | | + + * --------------- + + * | | + + * | expression | + + * | temporary | + + * | storage | + + * | | + + * - - - - - - - - + + * + + * The information in the block mark is thus at positive offsets from + + * the display pointer entries while the local variables are at negative + + * offsets. The block mark actually consists of two parts. The first + + * part is created at CALL and the second at entry, i.e. BEGIN. Thus: + + * + + * ------------------------- + + * | | + + * | Saved lino | + + * | Saved lc | + + * | Saved dp | + + * | | + + * ------------------------- + + * | | + + * | Saved (dp) | + + * | | + + * | Current section name | + + * | and entry line ptr | + + * | | + + * | Saved file name and | + + * | file buffer ptr | + + * | | + + * | Empty tos value | + + * | | + + * ------------------------- + + */ + + + +/* + + * Structure for accessing things in the block mark + + */ + +struct stack { + + long *tos; /* pointer to top of stack frame */ + + char *file; /* pointer to active file name */ + + long buf; /* pointer to active file record */ + + struct { - char name[8];/* name of active procedure */ +++ long nargs; /* number of bytes of arguments */ + + short offset; /* offset of procedure in source file */ +++ char name[1];/* name of active procedure */ + + } *entry; + + struct stack *disp; /* previous display value for this level */ + + struct stack **dp; /* pointer to active display entry */ + + long lc; /* previous location counter */ + + long lino; /* previous line number */ - } *display[40]; - - long addrsze; /* size of display addresses */ - - +++ } *display[20]; +++ + +/* + + * Program option variables + + */ + +long stcnt; /* number of statements executed */ + +long stlim; /* max number of statements to execute */ + +long llimit; /* max number of lines per text file */ + +short nodump; /* 1 => no post mortum dump */ + +short mode; /* mode of input to interpreter */ + +#define PX 0 /* normal run of px */ + +#define PIX 1 /* load and go */ + +#define PIPE 2 /* bootstrap via a pipe */ + + + +/* + + * Pxp variables + + */ + +char *pxpbuf; /* pointer to pxp buffer */ + +long pxpsize; /* size of pxp buffer */ + + + +#ifdef profile + +/* + + * Px execution profile data + + */ + +#define numops 256 + +struct cntrec { + + double counts[numops]; /* instruction counts */ + + long runs; /* number of interpreter runs */ + + long startdate; /* date profile started */ + + long usrtime; /* total user time consumed */ + + long systime; /* total system time consumed */ + + double stmts; /* number of pascal statements executed */ + + } profdata; + +long profcnts[numops]; - #define proffile "/usr/ucb/pascal/px/pcnt.out" +++#define proffile "/usr/grad/mckusick/px/profile/pcnt.out" + +FILE *datafile; /* input datafiles */ + +#else + +int profcnts; /* dummy just to keep the linker happy */ + +#endif diff --cc usr/src/cmd/px/h01errs.h index 0000000000,5298000707,0000000000..0b373f3ee9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/h01errs.h +++ b/usr/src/cmd/px/h01errs.h @@@@ -1,0 -1,49 -1,0 +1,58 @@@@ - #define ECHR 1 - #define ESYSTEM 2 - #define EBUILTIN 3 - #define EHALT 4 - #define ENILPTR 5 - #define EPASTEOF 6 - #define ESQRT 7 - #define ESTKNEMP 8 - #define ESUBSCR 9 - #define EREFINAF 10 - #define EWRITE 11 - #define ENAMESIZE 12 - #define ELN 13 - #define EBADOP 14 - #define EBADINUM 15 - #define EGOTO 16 - #define ECASE 17 - #define ESEEK 18 - #define ECREATE 19 - #define EOUTOFMEM 20 - #define ECTTOT 21 - #define ESTLIM 22 - #define ESTKOVFLO 23 - #define EBADFNUM 24 - #define EREMOVE 25 - #define ECLOSE 26 - #define EOPEN 27 - #define EARGV 28 - #define EPACK 29 - #define EUNPACK 30 - #define ERANGE 31 - #define EASRT 32 - #define EREADIT 33 - #define EWRITEIT 34 - #define EINTR 35 - #define EASSIGN 36 - #define EFIXADD 37 - #define EFLTADD 38 - #define EFIXSUB 39 - #define EFLTSUB 40 - #define EFIXMUL 41 - #define EFLTMUL 42 - #define EFIXDIV 43 - #define EFLTDIV 44 - #define EMODDIV 45 - #define EFIXNEG 46 - #define ELLIMIT 47 - #define EFRAMESIZE 48 - #define ETRASHHEAP 49 +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)h01errs.h 4.1 10/10/80"; */ +++ +++#define EARGV 1 +++#define EASRT 2 +++#define EASSIGN 3 +++#define EBADFNUM 4 +++#define EBADINUM 5 +++#define EBADOP 6 +++#define EBUILTIN 7 +++#define ECASE 8 +++#define ECHR 9 +++#define ECLOSE 10 +++#define ECREATE 11 +++#define EFIXADD 13 +++#define EFIXDIV 14 +++#define EFIXMUL 15 +++#define EFIXNEG 16 +++#define EFIXSUB 17 +++#define EFLTADD 18 +++#define EFLTDIV 19 +++#define EFLTMUL 20 +++#define EFLTSUB 21 +++#define EFMTSIZE 22 +++#define EGOTO 23 +++#define EHALT 24 +++#define EINTR 25 +++#define ELLIMIT 26 +++#define ELN 27 +++#define EMODDIV 28 +++#define ENAMESIZE 29 +++#define ENAMRNG 30 +++#define ENILPTR 31 +++#define ENUMNTFD 32 +++#define EOPEN 33 +++#define EOUTOFMEM 34 +++#define EPACK 35 +++#define EPASTEOF 36 +++#define ERANGE 37 +++#define EREADIT 38 +++#define EREFINAF 39 +++#define EREMOVE 40 +++#define ESEEK 41 +++#define ESQRT 42 +++#define ESTKNEMP 43 +++#define ESTKOVFLO 44 +++#define ESTLIM 45 +++#define ESUBSCR 46 +++#define ESYSTEM 47 +++#define ETRASHHEAP 48 +++#define EUNPACK 49 +++#define EWRITE 50 +++#define EWRITEIT 51 +++#define ECTLWR 12 +++#define ECTUPR 52 +++#define ECTSNG 53 +++#define ENARGS 54 diff --cc usr/src/cmd/px/int.c index 0000000000,4b0bf22ad3,0000000000..2ba1c0f59e mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/int.c +++ b/usr/src/cmd/px/int.c @@@@ -1,0 -1,170 -1,0 +1,160 @@@@ - # +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)int.c 4.1 10/10/80"; +++ + +/* + + * px - interpreter for Berkeley Pascal + + * Version 2.0 Winter 1979 + + * + + * Original version for the PDP 11/70 authored by: + + * Bill Joy, Charles Haley, Ken Thompson + + * + + * Rewritten for VAX 11/780 by Kirk McKusick + + */ + + + +#include "stdio.h" + +#include "signal.h" + +#include "h00vars.h" +++#include "objfmt.h" + + + +main(ac,av) + + + +long ac; + +char **av; + + + +{ + +extern intr(); + +extern memsize(); + +extern except(); +++extern syserr(); + +extern char *malloc(); - extern char _sibuf[], _sobuf[]; - long stats[8]; - short unsigned magicnum; - long size; +++extern long createtime; +++struct pxhdr pxhd; + +register long bytesread, block; + +register char *objprog; + +register FILE *prog; + +#define pipe 3 + +#define pipesize 4096 + + + +/* + + * Initialize everything + + */ + +argc = ac; + +argv = av; + +stcnt = 0; + +stlim = 500000; + +llimit = 0x7fffffff; /* set to unlimited */ + +nodump = 0; - bufopt = 1; /* default to line buffering */ + + + +/* + + * Determine how PX was invoked, and how to process the program + + */ + +if (argv[0][0] == '-' && argv[0][1] == 'o') + + { + + file = &argv[0][2]; + + mode = PIX; + + } + +else if (argc <= 1) + + { + + file = "obj"; + + mode = PX; + + } + +else if (argv[1][0] != '-') + + { + + file = argv[1]; + + mode = PX; + + } + +else if (argv[1][1] == 0) + + { + + file = argv[0]; + + mode = PIPE; + + argc -= 1; + + argv[1] = argv[0]; + + argv = &argv[1]; + + } + +else + + { + + fputs("Improper specification of object file to PX\n",stderr); + + exit(1); + + } + + + +/* + + * Process program header information + + */ + +if (mode == PIPE) - { - read(pipe,(char *)(&size),4); - read(pipe,(char *)(&magicnum),2); - } +++ read(pipe,&pxhd,sizeof(struct pxhdr)); + +else + + { + + prog = fopen(file,"r"); + + if (prog == NULL) + + { + + perror(file); + + exit(1); + + } - fstat(fileno(prog),&stats[0]); - size = stats[4]; - fread((char *)(&magicnum),2,1,prog); - if (magicnum == 0407) - { - fseek(prog,1024,0); - fread((char *)(&magicnum),2,1,prog); - size -= 1024; - } +++ fseek(prog,HEADER_BYTES-sizeof(struct pxhdr),0); +++ fread(&pxhd,sizeof(struct pxhdr),1,prog); + + } - size -=2; - if (magicnum == 0404) - /* maintain compatability with 11/70 */ - addrsze = 8; - else if (magicnum == 0403) - /* normal case */ - addrsze = 4; - else +++if (pxhd.maketime < createtime) +++ { +++ fprintf(stderr,"%s is obsolete and must be recompiled\n",file); +++ exit(1); +++ } +++if (pxhd.magicnum != 0403) + + { + + fprintf(stderr,"%s is not a Pascal program\n",file); + + exit(1); + + } + + + +/* + + * Load program into memory + + */ - objprog = malloc(size); +++objprog = malloc(pxhd.objsize); + +if (mode == PIPE) + + { + + bytesread = 0; + + do + + { + + block = read(pipe,objprog+bytesread,pipesize); + + bytesread += block; + + } + + while (block); + + } + +else + + { - bytesread = fread(objprog,1,size,prog); +++ bytesread = fread(objprog,1,pxhd.objsize,prog); + + fclose(prog); + + if (mode == PIX) + + unlink(file); + + } - if (bytesread != size) +++if (bytesread != pxhd.objsize) + + { + + fprintf(stderr,"Read error occurred while loading %s\n",file); + + exit(1); + + } - setbuf(stdin,&_sibuf[0]); - setbuf(stdout,&_sobuf[0]); + +if (mode == PIX) + + fputs("Execution begins...\n",stderr); + +/* + + * set interpreter to catch expected signals and begin interpretation + + */ - signal(SIGINT,intr); +++signal(SIGILL,syserr); +++signal(SIGBUS,syserr); +++signal(SIGSYS,syserr); +++if (signal(SIGINT,SIG_IGN) != SIG_IGN) +++ signal(SIGINT,intr); + +signal(SIGSEGV,memsize); + +signal(SIGFPE,except); + +#ifdef profile + +interpret(objprog,1); + +#else + +interpret(objprog,0); + +#endif + +/* + + * reset signals, deallocate memory, and exit normally + + */ + +signal(SIGINT,SIG_IGN); + +signal(SIGSEGV,SIG_DFL); + +signal(SIGFPE,SIG_DFL); + +pflush(); - /* - pfree(objprog); - */ +++/* pfree(objprog); */ + +psexit(0); + +} diff --cc usr/src/cmd/px/make.ed1 index 0000000000,02a42845fc,0000000000..4eab771042 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/make.ed1 +++ b/usr/src/cmd/px/make.ed1 @@@@ -1,0 -1,13 -1,0 +1,20 @@@@ +++s/"@(#)make.ed1 1.1 10/29/80"/&/ + +e errdata +++1d + +1,$s/^/#define / - w h01errs.h +++w E.s +++e h01errs.h +++g/\define/d +++r E.s +++w + +e errdata +++1d + +1,$s/ //g + +1,$s/^/ .set / + +1,$s/[0-9]*$/,&/ + +w E.s + +e 34err.s + +g/\.set/d - 3r E.s +++-1r E.s + +w + +q diff --cc usr/src/cmd/px/make.ed2 index 0000000000,2950bfe14e,0000000000..8944326eb6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/make.ed2 +++ b/usr/src/cmd/px/make.ed2 @@@@ -1,0 -1,9 -1,0 +1,10 @@@@ +++s/"@(#)make.ed2 1.1 10/29/80"/&/ + +g/^# /s// /g + +g/\([^ ]\)r7/s//\1buf/g + +g/\([^ ]\)r8/s//\1loop/g + +g/\([^ ]\)r9/s//\1dp/g + +g/\([^ ]\)r10/s//\1lc/g + +g/\([^ ]\)r11/s//\1lino/g + +g/ \(r[1789]\)/s//\1/g + +w + +q diff --cc usr/src/cmd/px/makefile index 0000000000,c3f6d43380,0000000000..ad0f9ef06c mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/makefile +++ b/usr/src/cmd/px/makefile @@@@ -1,0 -1,31 -1,0 +1,66 @@@@ - DESTDIR= - CFLAGS = -O -d2 +++SCCSID = "@(#)makefile 4.1 10/10/80" + + - px: int.o perror.o stats.o utilities.o malloc.o px.o - cc -O -o px int.o px.o utilities.o perror.o stats.o malloc.o -lm - int.o: h00vars.h +++CFLAGS = -O -d2 -DVAX -DOBJ +++INSTALLDIR =$(DESTDIR)/usr/ucb +++CC = cc +++AS = as +++RM = rm -f +++ +++PXRUN = int.c perror.c stats.c utilities.c +++ +++PXHDR = 00case.h OPnames.h h00vars.h objfmt.h +++ +++PXINT = 01int.s 02relset.s 03rel.s 04as.s 05index.s 06add.s 07sub.s \ +++ 08call.s 10mul.s 12div.s 13mod.s 14neg.s 15bool.s 16dvd.s \ +++ 17ind.s 18rv.s 20con.s 21rang.s 23case.s 24pxp.s 25set.s \ +++ 26for.s 27conv.s 28fun.s 30read.s 31write.s 32iostat.s \ +++ 33iofile.s 35iosubs.s +++ +++PXUTL = malloc.c opc.c opoff.c pic.c version.c \ +++ make.ed1 make.ed2 errdata +++ +++px: Version.c int.o perror.o stats.o utilities.o malloc.o px.o +++ ${CC} -O -o px Version.c int.o px.o utilities.o \ +++ perror.o stats.o malloc.o -lm +++ +++Version.c: version.c +++ ${CC} -o version version.c +++ ./version >Version.c +++ ${RM} version +++int.o: h00vars.h objfmt.h + +perror.o stats.o: h00vars.h h01errs.h + +utilities.o: h00vars.h h01errs.h h02opcs.h + +malloc.o: h01errs.h - cc -O -c -d2 -Ddebug malloc.c - px.o: [0-3][0-9]*.s - cat [0-3][0-9]*.s | as -d2 -o px.o - h01errs.h: errdata +++ ${CC} -O -c -d2 -Ddebug malloc.c +++px.o: 00case.s 34err.s ${PXINT} +++ cat 00case.s 34err.s ${PXINT} | ${AS} -d2 -o px.o +++00case.s: OPnames.h 00case.h opoff.c +++ ${CC} opoff.c -o opoff +++ ./opoff >optab +++ cat 00case.h optab >00case.s +++ ${RM} opoff optab +++h01errs.h 34err.s: errdata make.ed1 + + ed - h02opcs.h +++ ${RM} opc + + + +install: px - install -s px ${DESTDIR}/usr/ucb/px +++ cp px ${INSTALLDIR}/px + + + +clean: - rm -f *.o px +++ ${RM} *.o px version 00case.s optab opoff opc pic errs h02opcs.h + + - print: +++print: 00case.s 34err.s OPnames.h make.ed2 + + @pr READ_ME makefile + + @ls -l | pr - @pr opcpic h00vars.h int.c +++ @${CC} -o pic pic.c +++ @pic | pr +++ @pr h00vars.h Version.c int.c + + @cat [0-3][0-9]*.s >tmp + + @ed - tmp =allocs && allocp<=alloct,(char *)); + + ASSERT(allock(),(char *)); + + for(p=allocp; ; ) { + + for(temp=0; ; ) { + + if(!testbusy(p->ptr)) { + + while(!testbusy((q=p->ptr)->ptr)) { + + ASSERT(q>p&&qptr = q->ptr; + + } + + if(q>=p+nw && p+nw>=p) + + goto found; + + } + + q = p; + + p = clearbusy(p->ptr); + + if(p>q) + + ASSERT(p<=alloct,(char *)); + + else if(q!=alloct || p!=allocs) { + + ASSERT(q==alloct&&p==allocs,(char *)); + + return(NULL); + + } else if(++temp>1) + + break; + + } + + temp = ((nw+BLOCK/WORD)/(BLOCK/WORD))*(BLOCK/WORD); + + q = (union store *)sbrk(0); + + if(q+temp+GRANULE < q) { + + return(NULL); + + } + + q = (union store *)sbrk(temp*WORD); + + if((INT)q == -1) { + + return(NULL); + + } + + ASSERT(q>alloct,(char *)); + + alloct->ptr = q; + + if(q!=alloct+1) + + alloct->ptr = setbusy(alloct->ptr); + + alloct = q->ptr = q+temp-1; + + alloct->ptr = setbusy(allocs); + + } + +found: + + allocp = p + nw; + + ASSERT(allocp<=alloct,(char *)); + + if(q>allocp) { - allocx = allocp->ptr; + + allocp->ptr = p->ptr; + + } + + p->ptr = setbusy(allocp); + + return((char *)(p+1)); + +} + + - /* freeing strategy tuned for LIFO allocation - */ +++/* +++ * freeing strategy tuned for LIFO allocation +++ */ +++ + +free(ap) - register char *ap; +++ +++ register char *ap; + +{ + + register union store *p = (union store *)ap; + + + + ASSERT(p != 0,(long)); + + ASSERT(p>clearbusy(allocs[1].ptr)&&p<=alloct,(long)); + + ASSERT(allock(),(long)); + + allocp = --p; + + ASSERT(testbusy(p->ptr),(long)); + + p->ptr = clearbusy(p->ptr); + + ASSERT(p->ptr > allocp && p->ptr <= alloct,(long)); + + return(NULL); + +} + + - /* realloc(p, nbytes) reallocates a block obtained from malloc() - * and freed since last call of malloc() - * to have new size nbytes, and old content - * returns new location, or 0 on failure - */ - - char * - realloc(p, nbytes) - register union store *p; - unsigned nbytes; - { - register union store *q; - union store *s, *t; - register unsigned nw; - unsigned onw; - - if(testbusy(p[-1].ptr)) - free((char *)p); - onw = p[-1].ptr - p; - q = (union store *)malloc(nbytes); - if(q==NULL || q==p) - return((char *)q); - s = p; - t = q; - nw = (nbytes+WORD-1)/WORD; - if(nw=p) - (q+(q+nw-p))->ptr = allocx; - return((char *)q); - } - + +#ifdef debug + +allock() + +{ + +#ifdef longdebug + + register union store *p; + + int x; + + x = 0; + + for(p= &allocs[0]; clearbusy(p->ptr) > p; p=clearbusy(p->ptr)) { + + if(p==allocp) + + x++; + + } + + ASSERT(p==alloct,(long)); + + return(x==1|p==allocp); + +#else + + return(1); + +#endif + +} + +#endif - diff --cc usr/src/cmd/px/objfmt.h index 0000000000,0000000000,0000000000..9c095a2b6a new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/objfmt.h @@@@ -1,0 -1,0 -1,0 +1,88 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* static char sccsid[] = "@(#)objfmt.h 4.1 10/10/80"; */ +++ +++#ifdef OBJ +++ /* +++ * the creation time, the size and the magic number of the obj file +++ */ +++ struct pxhdr { +++ int maketime; +++ int objsize; +++ short magicnum; +++ }; +++ +++# define HEADER_BYTES 1024 /* the size of px_header */ +++# define PX_HEADER "/usr/lib/px_header" /* px_header's name */ +++# define PX_INTRP "/usr/ucb/px" /* the interpreter's name */ +++#endif OBJ +++ +++ /* +++ * the file of error messages created by mkstr +++ */ +++#ifdef OBJ +++# define ERR_STRNGS "/usr/lib/pi2.0strings" +++# define ERR_PATHLEN 9 +++#endif OBJ +++#ifdef PC +++# define ERR_STRNGS "/usr/lib/pc2.0strings" +++# define ERR_PATHLEN 9 +++#endif PC +++ +++ /* +++ * these are because of varying sizes of pointers +++ */ +++#ifdef VAX +++# define INDX 2 /* log2 of sizeof( * ) */ +++# define PTR_AS O_AS4 +++# define PTR_RV O_RV4 +++# define PTR_IND O_IND4 +++# define PTR_DCL unsigned long /* for pointer variables */ +++# define SHORTADDR 32768 /* maximum short address */ +++# define TOOMUCH 65536 /* maximum variable size */ +++# define MAXSET 65536 /* maximum set size */ +++ /* +++ * Offsets due to the structure of the runtime stack. +++ * DPOFF1 is the amount of fixed storage in each block allocated +++ * as local variables for the runtime system. +++ * since locals are allocated negative offsets, +++ * -DPOFF1 is the last used implicit local offset. +++ * DPOFF2 is the size of the block mark. +++ * since arguments are allocated positive offsets, +++ * DPOFF2 is the end of the implicit arguments. +++ * for obj, the first argument has the highest offset +++ * from the stackpointer. and the block mark is an +++ * implicit last parameter. +++ * for pc, the first argument has the lowest offset +++ * from the argumentpointer. and the block mark is an +++ * implicit first parameter. +++ */ +++# ifdef OBJ +++# define DPOFF1 0 +++# define DPOFF2 32 +++# define INPUT_OFF -8 /* offset of `input' */ +++# define OUTPUT_OFF -4 /* offset of `output' */ +++# endif OBJ +++# ifdef PC +++# define DPOFF1 ( sizeof rtlocs - sizeof rtlocs.unwind ) +++# define DPOFF2 ( sizeof (long) ) +++# define INPUT_OFF 0 +++# define OUTPUT_OFF 0 +++# endif PC +++# define MAGICNUM 0403 /* obj magic number */ +++#endif VAX +++ +++#ifdef PDP11 +++# define INDX 1 +++# define PTR_AS O_AS2 +++# define PTR_RV O_RV2 +++# define PTR_IND O_IND2 +++# define PTR_DCL char * +++# define TOOMUCH 50000 +++# define SHORTADDR 65536 +++# define MAXSET 65536 /* maximum set size */ +++# define DPOFF2 16 +++# define INPUT_OFF -2 +++# define OUTPUT_OFF -4 +++# define MAGICNUM 0404 +++#endif PDP11 diff --cc usr/src/cmd/px/opc.c index 0000000000,0000000000,0000000000..6ef166d7de new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/opc.c @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)opc.c 4.1 10/10/80"; +++ +++#include "OPnames.h" +++ +++main() { +++ register int i; +++ +++ printf("%s\n\n%s\n\n", +++ "/* Copyright (c) 1979 Regents of the University of California */", +++ "/* static char sccsid[] = \"@(#)opc.c 4.1 10/10/80\"; */"); +++ for (i = 0; i < 256; i++) +++ if (otext[i]) +++ printf("#define O_%s %04o\n", otext[i]+1, i); +++ exit(0); +++} diff --cc usr/src/cmd/px/opoff.c index 0000000000,0000000000,0000000000..5609c37aeb new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/opoff.c @@@@ -1,0 -1,0 -1,0 +1,20 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)opoff.c 4.1 10/10/80"; +++ +++#include "OPnames.h" +++ +++main() { +++ register int i; +++ +++ for (i = 0; i < 256; i++) +++ if (otext[i] && *otext[i] != '*') +++ printf("\t.word\t_%s-optab\n", otext[i]+1); +++ else +++ printf("\t.word\tbadop-optab\n"); +++ printf("badop:\n"); +++ printf("\tincl\tr10\n"); +++ printf("\tmovw\t$EBADOP,_perrno\n"); +++ printf("\tjbr\terror\n"); +++ exit(0); +++} diff --cc usr/src/cmd/px/perror.c index 0000000000,b1bdcf3437,0000000000..24e771d384 mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/perror.c +++ b/usr/src/cmd/px/perror.c @@@@ -1,0 -1,185 -1,0 +1,204 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)perror.c 4.1 10/10/80"; +++ + +#include "stdio.h" + +#include "signal.h" + +#include "h00vars.h" + +#include "h01errs.h" + + + +/* + + * Routine error is called from the interpreter when a runtime error occurs. + + * Its argument is the internal number of the error which occurred. + + * See Edata, Emake etc. + + */ + +error(errnum) + +long errnum; + +{ + +register long i; + +extern long errno; + + + +signal(SIGINT,SIG_IGN); + +signal(SIGSEGV,SIG_DFL); + +signal(SIGFPE,SIG_DFL); + +i = errno; + +pflush(); + +errno = i; + +fputs("\n\n",stderr); + +switch (errnum) { + + case EINTR: + + break; + + case ECHR: + + fputs("Argument to chr out of range\n",stderr); + + break; + + case EASSIGN: + + fputs("Overflow during assignment conversion\n",stderr); + + break; + + case EFIXADD: + + fputs("Overflow in fixed point addition\n",stderr); + + break; + + case EFLTADD: + + fputs("Floating point addition out of range\n",stderr); + + break; + + case EFIXSUB: + + fputs("Overflow in fixed point subtraction\n",stderr); + + break; + + case EFLTSUB: + + fputs("Floating point subtraction out of range\n",stderr); + + break; + + case EFIXMUL: + + fputs("Overflow in fixed point multiplication\n",stderr); + + break; + + case EFLTMUL: + + fputs("Floating point multiplication out of range\n",stderr); + + break; + + case EFIXDIV: + + fputs("Fixed point division by zero\n",stderr); + + break; + + case EFLTDIV: + + fputs("Floating point division error\n",stderr); + + break; + + case EMODDIV: + + fputs("Fixed point modulo by zero\n",stderr); + + break; + + case EFIXNEG: + + fputs("Overflow in fixed point negation\n",stderr); + + break; + + case ESYSTEM: + + fputs("Panic: Computational error in interpreter\n",stderr); + + break; + + case EBUILTIN: + + fputs("Overflow in builtin function\n",stderr); + + break; + + case EHALT: + +/* + + nodump = 0; + +*/ + + fputs("Call to procedure halt\n",stderr); + + break; + + case ENILPTR: + + fputs("Reference through a nil pointer\n",stderr); + + break; + + case EPASTEOF: + + fprintf(stderr,"%s: Tried to read past end of file\n",file); + + break; + + case EREADIT: + + fprintf(stderr,"%s: Attempt to read, but open for writing\n",file); + + break; + + case EWRITEIT: + + fprintf(stderr,"%s: Attempt to write, but open for reading\n",file); + + break; + + case ECLOSE: + + fprintf(stderr,"%s: Close failed\n",file); + + break; + + case ELLIMIT: + + fprintf(stderr,"%s: Line limit exceeded\n",file); + + break; + + case ESQRT: + + fputs("Negative argument to sqrt\n",stderr); + + break; + + case ESTKNEMP: + + fputs("Panic: stack not empty between statements\n",stderr); + + break; + + case ESUBSCR: + + fputs("Subscript out of range\n",stderr); + + break; + + case EREFINAF: + + fputs("Reference to an inactive file\n",stderr); + + break; + + case EWRITE: + + fputs("Could not write to ",stderr); + + perror(file); + + break; + + case EOPEN: + + fputs("Could not open ",stderr); + + perror(file); + + break; + + case ECREATE: + + fputs("Could not create ",stderr); + + perror(file); + + break; + + case EREMOVE: + + fputs("Could not remove ",stderr); + + perror(file); + + break; + + case ESEEK: + + fputs("Could not reset ",stderr); + + perror(file); + + break; + + case ENAMESIZE: + + fputs("File name too long\n",stderr); + + break; + + case ELN: + + fputs("Non-positive argument to ln\n",stderr); + + break; + + case EBADOP: + + fputs("Panic: bad op code\n",stderr); + + break; + + case EBADINUM: + + fputs("Bad data found on integer read\n",stderr); + + break; + + case EBADFNUM: + + fputs("Bad data found on real read\n",stderr); + + break; +++ case ENUMNTFD: +++ fputs("Unknown name found on enumerated type read\n",stderr); +++ break; +++ case ENAMRNG: +++ fputs("Enumerated type value out of range on output\n",stderr); +++ break; +++ case EFMTSIZE: +++ fputs("Negative format width\n",stderr); +++ break; +++ case ENARGS: +++ fputs("Improper number of arguments to formal routine\n" +++ ,stderr); +++ break; + + case EGOTO: + + fputs("Panic: active frame not found in goto\n",stderr); + + break; + + case ECASE: + + fputs("Label not found in case\n",stderr); + + break; + + case EOUTOFMEM: + + fputs("Ran out of memory\n",stderr); + + break; + + case ETRASHHEAP: - fputs("Attempt to dispose of previously deallocated memory\n",stderr); +++ fputs("Improper use of new variables has caused heap integrity check to fail\n",stderr); +++ break; +++ case ECTLWR: +++ fputs("Range lower bound out of set bounds\n", stderr); + + break; - case ECTTOT: - fputs("Constructed set argument exceeds set bounds\n",stderr); +++ case ECTUPR: +++ fputs("Range upper bound out of set bounds\n", stderr); +++ break; +++ case ECTSNG: +++ fputs("Single value out of set bounds\n", stderr); + + break; + + case EARGV: + + fputs("Argument to argv out of range\n",stderr); + + break; + + case EPACK: + + fputs("Bad i to pack(a,i,z)\n",stderr); + + break; + + case EUNPACK: + + fputs("Bad i to unpack(z,a,i)\n",stderr); + + break; + + case ERANGE: + + fputs("Value out of range\n",stderr); + + break; + + case EASRT: + + fputs("Assertion failed\n",stderr); + + break; + + case ESTLIM: + + fputs("Statement count limit exceeded\n",stderr); + + break; + + case ESTKOVFLO: + + fputs("Runtime stack overflow\n",stderr); + + break; - case EFRAMESIZE: - fputs("Compiler restricts declarations to 32768 bytes per block\n",stderr); - break; + + default: + + fputs("Panic: unknown error\n",stderr); + +} - if (nodump == 0) - backtrace(errnum); +++backtrace(errnum); + +psexit(errnum); + +} diff --cc usr/src/cmd/px/pic.c index 0000000000,0000000000,0000000000..a852938f91 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/pic.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)pic.c 4.1 10/10/80"; +++ +++#include "OPnames.h" +++ +++main() { +++ register int j, k; +++ +++ for(j = 0; j < 32; j++) { +++ for (k = 0; k < 256; k += 32) +++ if (otext[j+k]) +++ printf("%03o%cO_%s\t", j+k, *otext[j+k], otext[j+k]+1); +++ else +++ printf("%03o\t\t", j+k); +++ putchar('\n'); +++ if ((j+1)%8 == 0) +++ putchar('\n'); +++ } +++ printf("Starred opcodes are used internally in Pi and are never generated.\n"); +++ exit(0); +++} diff --cc usr/src/cmd/px/stats.c index 0000000000,49766f846b,0000000000..64de02737d mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/stats.c +++ b/usr/src/cmd/px/stats.c @@@@ -1,0 -1,92 -1,0 +1,94 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)stats.c 4.1 10/10/80"; +++ + +#include "stdio.h" + +#include "h00vars.h" + +#include "h01errs.h" + +#define HZ 60 /* interrupt frequency */ + + + +backtrace(errnum) + +long errnum; + +{ + +register struct stack **mydp, *ap; + + struct stack **dp, *disp[20]; + +register char *cp; + +register long i; + + long linum; + + + +fetchdp(&dp,&linum); + +for (i=0; i<20; i++) + + disp[i] = display[i]; + +if (errnum == EINTR) - fputs("\n\tInterrupted at \"",stderr); +++ fputs("\n\tInterrupted in \"",stderr); + +else if (errnum == EHALT) - fputs("\n\tHalted at \"",stderr); +++ fputs("\n\tHalted in \"",stderr); + +else - fputs("\n\tError at \"",stderr); +++ fputs("\n\tError in \"",stderr); + +if (linum <= 0) + + return; + +mydp = dp; + +for (;;){ + + ap = *mydp; - cp = &((ap)->entry)->name[0]; - i = 8; - do - putc(*cp++,stderr); - while (--i && *cp != ' '); + + i = linum - (((ap)->entry)->offset & 0177777); - fprintf(stderr,"\"+%1d near line %1d.\n",i,linum); +++ fprintf(stderr,"%s\"",(ap->entry)->name); +++ if (nodump == 0) +++ fprintf(stderr,"+%1d near line %1d.",i,linum); +++ fputc('\n',stderr); + + *mydp = (ap)->disp; - if (mydp <= &display[addrsze >> 2]){ +++ if (mydp <= &display[1]){ + + for (i=0; i<20; i++) + + display[i] = disp[i]; + + return; + + } + + mydp = (ap)->dp; + + linum = (ap)->lino; + + fputs("\tCalled by \"",stderr); + + } + +} + + + +stats() + +{ + +struct { + + long usr_time; + + long sys_time; + + long child_usr_time; + + long child_sys_time; + + } tbuf; + +register double l; + +register long count; + + + +if (nodump) + + return(0); + +times(&tbuf); + +#ifdef profile + +datafile = fopen(proffile,"r"); + +if (datafile != NULL) { + + count = fread(&profdata,sizeof(profdata),1,datafile); + + if (count != 1) { + + for (count = 0; count < numops; count++) + + profdata.counts[count] = 0.0; + + profdata.runs = 0; + + profdata.startdate = time(0); + + profdata.usrtime = 0; + + profdata.systime = 0; + + profdata.stmts = 0; + + } + + for (count = 0; count < numops; count++) + + profdata.counts[count] += profcnts[count]; + + profdata.runs += 1; + + profdata.stmts += stcnt; + + profdata.usrtime += tbuf.usr_time; + + profdata.systime += tbuf.sys_time; + + datafile = freopen(proffile,"w",datafile); + + if (datafile != NULL) { + + fwrite(&profdata,sizeof(profdata),1,datafile); + + fclose(datafile); + + } + + } + +#endif + +l = tbuf.usr_time; + +l = l / HZ; + +fprintf(stderr,"\n%1ld statements executed in %04.2f seconds cpu time.\n", + + stcnt,l); + +} diff --cc usr/src/cmd/px/utilities.c index 0000000000,0e5f6094d9,0000000000..12451b8f6c mode 000000,100644,000000..100644 --- a/usr/src/cmd/px/utilities.c +++ b/usr/src/cmd/px/utilities.c @@@@ -1,0 -1,111 -1,0 +1,199 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)utilities.c 4.2 10/20/80"; +++ + +#include "stdio.h" + +#include "h00vars.h" + +#include "h01errs.h" + +#include "h02opcs.h" + + + +/* + + * allocate a block of storage on the heap + + */ + +char *palloc(need) + + + +long need; + + + +{ + +extern char *malloc(); + +register char *memblk, *ptr; + + + +memblk = malloc(need); + +if (memblk == 0) + + error(EOUTOFMEM); + +if (memblk == (char *)(-1)) + + error(ETRASHHEAP); + +for(ptr=memblk; ptr upperbnd) { +++ error(ECTLWR); +++ return; +++ } +++ upper = *dataptr++ - lowerbnd; +++ if (upper < 0 || upper > upperbnd) { +++ error(ECTUPR); +++ return; +++ } +++ if (lower > upper) { +++ continue; +++ } +++ lowerdiv = lower / BITSPERLONG; +++ lowermod = lower % BITSPERLONG; +++ upperdiv = upper / BITSPERLONG; +++ uppermod = upper % BITSPERLONG; +++ temp = _mask [lowermod]; +++ if ( lowerdiv == upperdiv ) { +++ temp &= ~_mask[ uppermod + 1 ]; +++ } +++ result[ lowerdiv ] |= temp; +++ limit = &result[ upperdiv-1 ]; +++ for ( lp = &result[ lowerdiv+1 ] ; lp <= limit ; lp++ ) { +++ *lp |= ~0; +++ } +++ if ( lowerdiv != upperdiv ) { +++ result[ upperdiv ] |= ~_mask[ uppermod + 1 ]; +++ } +++ } +++ for (cnt = 0; cnt < singcnt; cnt++) { +++ lower = *dataptr++ - lowerbnd; +++ if (lower < 0 || lower > upperbnd) { +++ error(ECTSNG); +++ return; +++ } +++ lowerdiv = lower / BITSPERLONG; +++ lowermod = lower % BITSPERLONG; +++ result[ lowerdiv ] |= ( 1 << lowermod ); +++ } +++ return(result); +++} +++ +++inct(element, paircnt, singcnt, data) + + +++ register int element; /* element to find */ +++ int paircnt; /* number of pairs to check */ +++ int singcnt; /* number of singles to check */ +++ int data; /* paircnt plus singcnt bounds */ + +{ - register int l, h; - register sets *set, *ap; - - ap = &av; - set = &ap[2 * n]; - while(--n >= 0) { - if ((l = *ap++ - lwrb) < 0 || l > uprbp || - (h = *ap++ - lwrb) < 0 || h > uprbp) - error(ECTTOT); - while (l <= h) { - set[l >> 4] = set[l >> 4] | 1 << (l & 017); - l++; +++ register int *dataptr; +++ register int cnt; +++ +++ dataptr = &data; +++ for (cnt = 0; cnt < paircnt; cnt++) { +++ if (element < *dataptr++) { +++ dataptr++; +++ continue; +++ } +++ if (element <= *dataptr++) { +++ return TRUE; +++ } +++ } +++ for (cnt = 0; cnt < singcnt; cnt++) { +++ if (element == *dataptr++) { +++ return TRUE; + + } + + } - return(set); +++ return FALSE; + +} + + + +char pd_date[] = { + + 8, 9, 10, 4, 5, 6, 10, 22, 23, 10, 0 + +}; + + + +char *ctime(); + + + +pdattim(op, alfap) + +register char *alfap; + +{ + + register char *ap, *cp, *dp; + + long a; + + int i; + + + + time(&a); + + cp = ctime(&a); + + ap = alfap; + + if (op == O_DATE) + + for (dp = pd_date; *dp; *ap++ = cp[*dp++]); + + else + + for (cp = cp + 10, i = 10; i; *ap++ = *cp++, i--); + +} + + + +psexit(code) + + + +long code; + +{ + + + +pmflush(); - if (mode == PIX && nodump == 0) { +++if (mode == PIX) { + + fputs("Execution terminated",stderr); + + if (code) + + fputs(" abnormally",stderr); + + fputc('.',stderr); + + fputc('\n',stderr); + + } + +stats(); + +exit(code); + +} diff --cc usr/src/cmd/px/version.c index 0000000000,0000000000,0000000000..361847df2c new file mode 100644 --- /dev/null +++ b/usr/src/cmd/px/version.c @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)version.c 4.1 10/10/80"; +++ +++ /* +++ * this writes the declaration of the current time stamp +++ * onto standard output. +++ * useful for makeing Ver.c give the correct date for pi. +++ */ +++ +++#include +++ +++main() +++ { +++ printf( "long createtime = %d;\n" , time(0) ); +++ } +++ diff --cc usr/src/cmd/quot.c index 0000000000,b32c9378a7,0000000000..01e75a5e26 mode 000000,100644,000000..100644 --- a/usr/src/cmd/quot.c +++ b/usr/src/cmd/quot.c @@@@ -1,0 -1,235 -1,0 +1,236 @@@@ +++static char *sccsid = "@(#)quot.c 4.1 (Berkeley) 10/1/80"; + +/* + + * Disk usage by user + + */ + + + +char *dargv[] = { + + "/dev/rrp3", + + 0 + +}; + + + +#include + +#include + +#include + +#include + +#include + +#include + +#include + + + +#define ITABSZ 256 + +#define ISIZ (BSIZE/sizeof(struct dinode)) + +#define NUID 1000 + +struct filsys sblock; + +struct dinode itab[ITABSZ]; + +struct du + +{ + + long blocks; + + long nfiles; + + int uid; + + char *name; + +} du[NUID]; + +#define TSIZE 500 + +int sizes[TSIZE]; + +long overflow; + + + +int nflg; + +int fflg; + +int cflg; + + + +int fi; + +unsigned ino; + +unsigned nfiles; + + + +struct passwd *getpwent(); + +char *malloc(); + +char *copy(); + + + +main(argc, argv) + +char **argv; + +{ + + register int n; + + register struct passwd *lp; + + register char **p; + + + + for(n=0; npw_uid; + + if (n>NUID) + + continue; + + if(du[n].name) + + continue; + + du[n].name = copy(lp->pw_name); + + } + + if (argc == 1) { + + for (p = dargv; *p;) { + + check(*p++); + + report(); + + } + + return(0); + + } + + while (--argc) { + + argv++; + + if (argv[0][0]=='-') { + + if (argv[0][1]=='n') + + nflg++; + + else if (argv[0][1]=='f') + + fflg++; + + else if (argv[0][1]=='c') + + cflg++; + + } else { + + check(*argv); + + report(); + + } + + } + + return(0); + +} + + + +check(file) + +char *file; + +{ + + register unsigned i, j; + + register c; + + + + fi = open(file, 0); + + if (fi < 0) { + + printf("cannot open %s\n", file); + + return; + + } + + printf("%s:\n", file); + + sync(); + + bread(1, (char *)&sblock, sizeof sblock); + + nfiles = (sblock.s_isize-2)*(BSIZE/sizeof(struct dinode)); + + ino = 0; + + if (nflg) { + + if (isdigit(c = getchar())) + + ungetc(c, stdin); + + else while (c!='\n' && c != EOF) + + c = getchar(); + + } + + for(i=2; inodi_mode&IFMT) == 0) + + return; + + if (cflg) { + + if ((ip->di_mode&IFMT)!=IFDIR && (ip->di_mode&IFMT)!=IFREG) + + return; + + n = (ip->di_size+BSIZE-1)/BSIZE; + + if (n >= TSIZE) { + + overflow += n; + + n = TSIZE-1; + + } + + sizes[n]++; + + return; + + } + + if (ip->di_uid >= NUID) + + return; + + du[ip->di_uid].blocks += (ip->di_size+BSIZE-1)/BSIZE; + + du[ip->di_uid].nfiles++; + + if (nflg) { + + tryagain: + + if (fino==0) + + if (scanf("%d", &fino)<=0) + + return; + + if (fino > ino) + + return; + + if (finodi_uid].name) + + printf("%.7s ", np); + + else + + printf("%d ", ip->di_uid); + + while ((n = getchar())==' ' || n=='\t') + + ; + + putchar(n); + + while (n!=EOF && n!='\n') { + + n = getchar(); + + putchar(n); + + } + + fino = 0; + + } + +} + + + +bread(bno, buf, cnt) + +unsigned bno; + +char *buf; + +{ + + + + lseek(fi, (long)bno*BSIZE, 0); + + if (read(fi, buf, cnt) != cnt) { + + printf("read error %u\n", bno); + + exit(1); + + } + +} + + + +qcmp(p1, p2) + +register struct du *p1, *p2; + +{ + + if (p1->blocks > p2->blocks) + + return(-1); + + if (p1->blocks < p2->blocks) + + return(1); + + return(strcmp(p1->name, p2->name)); + +} + + + +report() + +{ + + register i; + + + + if (nflg) + + return; + + if (cflg) { + + long t = 0; + + for (i=0; i +++#include +++#include +++#include +++#include +++#include +++ +++struct ar_hdr archdr; +++#define OARMAG 0177545 +++long arsize; +++struct exec exp; +++FILE *fi, *fo; +++long off, oldoff; +++long atol(), ftell(); +++#define TABSZ 5000 +++struct ranlib tab[TABSZ]; +++int tnum; +++#define STRTABSZ 75000 +++char tstrtab[STRTABSZ]; +++int tssiz; +++char *strtab; +++int ssiz; +++int new; +++char tempnm[] = "__.SYMDEF"; +++char firstname[17]; +++ +++main(argc, argv) +++char **argv; +++{ +++ char cmdbuf[BUFSIZ]; +++ char magbuf[SARMAG+1]; +++ +++ --argc; +++ while(argc--) { +++ fi = fopen(*++argv,"r"); +++ if (fi == NULL) { +++ fprintf(stderr, "ranlib: cannot open %s\n", *argv); +++ continue; +++ } +++ off = SARMAG; +++ fread(magbuf, 1, SARMAG, fi); +++ if (strncmp(magbuf, ARMAG, SARMAG)) { +++ if (*(int *)magbuf == OARMAG) +++ fprintf(stderr, "old format "); +++ else +++ fprintf(stderr, "not an "); +++ fprintf(stderr, "archive: %s\n", *argv); +++ continue; +++ } +++ fseek(fi, 0L, 0); +++ new = tnum = 0; +++ if (nextel(fi) == 0) { +++ fclose(fi); +++ continue; +++ } +++ do { +++ long o; +++ register n; +++ struct nlist sym; +++ +++ fread((char *)&exp, 1, sizeof(struct exec), fi); +++ if (N_BADMAG(exp)) +++ continue; +++ if (exp.a_syms == 0) { +++ fprintf(stderr, "ranlib: warning: %s(%s): no symbol table\n", *argv, archdr.ar_name); +++ exit(1); +++ } +++ o = N_STROFF(exp) - sizeof (struct exec); +++ if (ftell(fi)+o+sizeof(ssiz) >= off) { +++ fprintf(stderr, "ranlib: %s(%s): old format .o file\n", *argv, archdr.ar_name); +++ exit(1); +++ } +++ fseek(fi, o, 1); +++ fread((char *)&ssiz, 1, sizeof (ssiz), fi); +++ strtab = (char *)calloc(1, ssiz); +++ if (strtab == 0) { +++ fprintf(stderr, "ranlib: ran out of memory\n"); +++ exit(1); +++ } +++ fread(strtab+sizeof(ssiz), ssiz - sizeof(ssiz), 1, fi); +++ fseek(fi, -(exp.a_syms+ssiz), 1); +++ n = exp.a_syms / sizeof(struct nlist); +++ while (--n >= 0) { +++ fread((char *)&sym, 1, sizeof(sym), fi); +++ if (sym.n_un.n_strx == 0) +++ continue; +++ sym.n_un.n_name = strtab + sym.n_un.n_strx; +++ if ((sym.n_type&N_EXT)==0) +++ continue; +++ switch (sym.n_type&N_TYPE) { +++ +++ case N_UNDF: +++ if (sym.n_value!=0) +++ stash(&sym); +++ continue; +++ +++ default: +++ stash(&sym); +++ continue; +++ } +++ } +++ } while(nextel(fi)); +++ new = fixsize(); +++ fclose(fi); +++ fo = fopen(tempnm, "w"); +++ if(fo == NULL) { +++ fprintf(stderr, "can't create temporary\n"); +++ exit(1); +++ } +++ tnum *= sizeof (struct ranlib); +++ fwrite(&tnum, 1, sizeof (tnum), fo); +++ tnum /= sizeof (struct ranlib); +++ fwrite((char *)tab, tnum, sizeof(struct ranlib), fo); +++ fwrite(&tssiz, 1, sizeof (tssiz), fo); +++ fwrite(tstrtab, tssiz, 1, fo); +++ fclose(fo); +++ if(new) +++ sprintf(cmdbuf, "ar rlb %s %s %s\n", firstname, *argv, tempnm); +++ else +++ sprintf(cmdbuf, "ar rl %s %s\n", *argv, tempnm); +++ if(system(cmdbuf)) +++ fprintf(stderr, "ranlib: ``%s'' failed\n", cmdbuf); +++ else +++ fixdate(*argv); +++ unlink(tempnm); +++ } +++ exit(0); +++} +++ +++nextel(af) +++FILE *af; +++{ +++ register r; +++ register char *cp; +++ +++ oldoff = off; +++ fseek(af, off, 0); +++ r = fread((char *)&archdr, 1, sizeof(struct ar_hdr), af); +++ if (r != sizeof(struct ar_hdr)) +++ return(0); +++ for (cp=archdr.ar_name; cp < & archdr.ar_name[sizeof(archdr.ar_name)]; cp++) +++ if (*cp == ' ') +++ *cp = '\0'; +++ arsize = atol(archdr.ar_size); +++ if (arsize & 1) +++ arsize++; +++ off = ftell(af) + arsize; +++ return(1); +++} +++ +++stash(s) +++ struct nlist *s; +++{ +++ int i; +++ register char *cp; +++ +++ if(tnum >= TABSZ) { +++ fprintf(stderr, "ranlib: symbol table overflow\n"); +++ exit(1); +++ } +++ tab[tnum].ran_un.ran_strx = tssiz; +++ tab[tnum].ran_off = oldoff; +++ for (cp = s->n_un.n_name; tstrtab[tssiz++] = *cp++;) +++ if (tssiz > STRTABSZ) { +++ fprintf(stderr, "ranlib: string table overflow\n"); +++ exit(1); +++ } +++ tnum++; +++} +++ +++fixsize() +++{ +++ int i; +++ off_t offdelta; +++ +++ if (tssiz&1) +++ tssiz++; +++ offdelta = sizeof(archdr) + sizeof (tnum) + tnum * sizeof(struct ranlib) + +++ sizeof (tssiz) + tssiz; +++ off = SARMAG; +++ nextel(fi); +++ if(strncmp(archdr.ar_name, tempnm, sizeof (archdr.ar_name)) == 0) { +++ new = 0; +++ offdelta -= sizeof(archdr) + arsize; +++ } else { +++ new = 1; +++ strncpy(firstname, archdr.ar_name, sizeof(archdr.ar_name)); +++ } +++ for(i=0; i +++#include +++/* +++ * Reboot +++ */ +++static char *sccsid = "@(#)reboot.c 4.1 (Berkeley) 10/9/80"; +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ +++ int howto; +++ register char *argp; +++ +++ argc--, argv++; +++ howto = 0; +++ while (argc > 0) { +++ if (!strcmp(*argv, "-s")) +++ howto |= RB_SINGLE; +++ else if (!strcmp(*argv, "-n")) +++ howto |= RB_NOSYNC; +++ else if (!strcmp(*argv, "-a")) +++ howto |= RB_ASKNAME; +++ else { +++ fprintf(stderr, +++ "usage: reboot [ -a ] [ -n ] [ -s ]\n"); +++ exit(1); +++ } +++ argc--, argv++; +++ } +++ syscall(55, howto); +++ perror("reboot"); +++} diff --cc usr/src/cmd/renice.c index 0000000000,afb1ac1413,0000000000..5c3a58e85d mode 000000,100644,000000..100644 --- a/usr/src/cmd/renice.c +++ b/usr/src/cmd/renice.c @@@@ -1,0 -1,73 -1,0 +1,73 @@@@ +++static char *sccsid = "@(#)renice.c 4.1 (Berkeley) 10/1/80"; + +#include +++#include +++#include + +#include +++#include + +#include + + + +struct proc proc[NPROC]; - struct { - char name[8]; - int type; - unsigned value; - } nl[] = { - "_proc", 0, 0, +++struct nlist nl[] = { +++ {"_proc"}, {0}, 0, + + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + +}; + + + +/* + + * Change the running priority (nice) of a process which is already + + * running. + + * + + * Author: Kurt Shoens + + */ + + + +main(argc, argv) + + char **argv; + +{ + + register struct proc *pp; + + int pid, nice; + + int addr, mem, a1, a2, coreaddr; + + + + if (argc != 2 && argc != 3) { + + fprintf(stderr, "usage: renice pid [ priority ]\n"); + + exit(1); + + } + + if (geteuid()) { + + fprintf(stderr, "NOT super user\n"); + + exit(1); + + } + + pid = atoi(argv[1]); + + nice = atoi(argc == 3 ? argv[2] : "19"); + + if (nice > 20) + + nice = 20; + + if (nice < -20) + + nice = -20; + + nice += NZERO; + + mem = open("/dev/kmem", 2); + + if (mem < 0) { + + perror("/dev/kmem"); + + exit(1); + + } + + nlist("/vmunix", nl); - addr = nl[0].value; +++ addr = nl[0].n_value; + + if (addr == 0) { + + fprintf(stderr, "/vmunix: _proc not in namelist"); + + exit(1); + + } + + lseek(mem, addr, 0); + + read(mem, &proc[0], sizeof proc); + + for (pp = &proc[0]; pp < &proc[NPROC]; pp++) + + if (pp->p_pid == pid) + + break; + + if (pp >= &proc[NPROC]) { + + fprintf(stderr, "%d: process not found\n", pid); + + exit(1); + + } + + fprintf(stderr, "%d: old nice = %d, new nice = %d\n", + + pid, + + pp->p_nice - NZERO, + + nice - NZERO); + + a1 = (int)&pp->p_nice; + + a2 = (int)&proc[0]; + + coreaddr = a1-a2+addr; + + lseek(mem, (long)coreaddr, 0); + + write(mem, &nice, 1); + +} diff --cc usr/src/cmd/reset.c index 0000000000,177404782e,0000000000..c7210c3b13 mode 000000,100644,000000..100644 --- a/usr/src/cmd/reset.c +++ b/usr/src/cmd/reset.c @@@@ -1,0 -1,32 -1,0 +1,46 @@@@ +++static char *sccsid = "@(#)reset.c 4.2 (Berkeley) 10/9/80"; + +/* - * reset - set the teletype mode bits to be sensible - * - * Kurt Shoens - * - * Very useful after crapping out in raw. - * Modified by Mark Horton to know about tchars - * and to not mess with peoples chars unless they are null. +++ * reset + + */ + +#include - #define chk(val, dft) (val==0 ? dft : val) +++ +++#define CTRL(x) ('x'&037) + + + +main() + +{ + + struct sgttyb buf; + + struct tchars tbuf; +++ struct ltchars ltbuf; + + + + gtty(2, &buf); + + ioctl(2, TIOCGETC, &tbuf); +++ ioctl(2, TIOCGLTC, <buf); + + buf.sg_flags &= ~(RAW|CBREAK|VTDELAY|ALLDELAY); + + buf.sg_flags |= XTABS|ECHO|CRMOD|ANYP; - buf.sg_erase = chk(buf.sg_erase, '\08'); /* ^H */ - buf.sg_kill = chk(buf.sg_kill, '\30'); /* ^X */ - tbuf.t_intrc = chk(tbuf.t_intrc, '\177'); /* ^? */ - tbuf.t_quitc = chk(tbuf.t_quitc, '\34'); /* ^\ */ - tbuf.t_startc = chk(tbuf.t_startc, '\22'); /* ^Q */ - tbuf.t_stopc = chk(tbuf.t_stopc, '\24'); /* ^S */ - tbuf.t_eofc = chk(tbuf.t_eofc, '\4'); /* ^D */ +++ reset(&buf.sg_erase, CTRL(h)); +++ reset(&buf.sg_kill, '@'); +++ reset(&tbuf.t_intrc, 0177); +++ reset(&tbuf.t_quitc, CTRL(\\\\)); +++ reset(&tbuf.t_startc, CTRL(q)); +++ reset(&tbuf.t_stopc, CTRL(s)); +++ reset(&tbuf.t_eofc, CTRL(d)); +++ reset(<buf.t_suspc, CTRL(z)); +++ reset(<buf.t_dsuspc, CTRL(y)); +++ reset(<buf.t_rprntc, CTRL(r)); +++ reset(<buf.t_flushc, CTRL(o)); +++ reset(<buf.t_lnextc, CTRL(v)); +++ reset(<buf.t_werasc, CTRL(w)); + + /* brkc is left alone */ + + ioctl(2, TIOCSETN, &buf); + + ioctl(2, TIOCSETC, &tbuf); +++ ioctl(2, TIOCSLTC, <buf); +++} +++ +++reset(cp, def) +++ char *cp; +++ int def; +++{ +++ +++ if (*cp == 0 || (*cp&0377)==0377) +++ *cp = def; + +} diff --cc usr/src/cmd/restor.c index 0000000000,9e33e094b8,0000000000..59be2f75a0 mode 000000,100644,000000..100644 --- a/usr/src/cmd/restor.c +++ b/usr/src/cmd/restor.c @@@@ -1,0 -1,1147 -1,0 +1,1158 @@@@ +++static char *sccsid = "@(#)restor.c 4.1 (Berkeley) 10/1/80"; +++ + +#define MAXINO 3000 + +#define BITS 8 - #define MAXXTR 60 +++#define MAXXTR 600 + +#define NCACHE 3 + + + +#ifndef STANDALONE + +#include + +#include + +#endif + +#include + +#include + +#include + +#include + +#include + +#include + +#include + + + +#define MWORD(m,i) (m[(unsigned)(i-1)/MLEN]) + +#define MBIT(i) (1<<((unsigned)(i-1)%MLEN)) + +#define BIS(i,w) (MWORD(w,i) |= MBIT(i)) + +#define BIC(i,w) (MWORD(w,i) &= ~MBIT(i)) + +#define BIT(i,w) (MWORD(w,i) & MBIT(i)) + + + +struct filsys sblock; + + + +int fi; + +ino_t ino, maxi, curino; + + + +int mt; - char tapename[] = "/dev/rmt1"; +++char tapename[] = "/dev/rmt8"; + +char *magtape = tapename; + +#ifdef STANDALONE + +char mbuf[50]; + +#endif + + + +#ifndef STANDALONE + +daddr_t seekpt; + +int df, ofile; + +char dirfile[] = "rstXXXXXX"; + + + +struct { + + ino_t t_ino; + + daddr_t t_seekpt; + +} inotab[MAXINO]; + +int ipos; + + + +#define ONTAPE 1 + +#define XTRACTD 2 + +#define XINUSE 4 + +struct xtrlist { + + ino_t x_ino; + + char x_flags; + +} xtrlist[MAXXTR]; + + + +char name[12]; + + + +char drblock[BSIZE]; + +int bpt; + +#endif + + + +int eflag; + + + +int volno = 1; + + + +struct dinode tino, dino; + +daddr_t taddr[NADDR]; + + + +daddr_t curbno; + + + +short dumpmap[MSIZ]; + +short clrimap[MSIZ]; + + + + + +int bct = NTREC+1; + +char tbf[NTREC*BSIZE]; + + + +struct cache { + + daddr_t c_bno; + + int c_time; + + char c_block[BSIZE]; + +} cache[NCACHE]; + +int curcache; + + + +main(argc, argv) + +char *argv[]; + +{ + + register char *cp; + + char command; + + int done(); + + + +#ifndef STANDALONE + + mktemp(dirfile); + + if (argc < 2) { + +usage: + + printf("Usage: restor x file file..., restor r filesys, or restor t\n"); + + exit(1); + + } + + argv++; + + argc -= 2; + + for (cp = *argv++; *cp; cp++) { + + switch (*cp) { + + case '-': + + break; + + case 'f': + + magtape = *argv++; + + argc--; + + break; + + case 'r': + + case 'R': + + case 't': + + case 'x': + + command = *cp; + + break; + + default: + + printf("Bad key character %c\n", *cp); + + goto usage; + + } + + } + + if (command == 'x') { + + if (signal(SIGINT, done) == SIG_IGN) + + signal(SIGINT, SIG_IGN); + + if (signal(SIGTERM, done) == SIG_IGN) + + signal(SIGTERM, SIG_IGN); + + + + df = creat(dirfile, 0666); + + if (df < 0) { + + printf("restor: %s - cannot create directory temporary\n", dirfile); + + exit(1); + + } + + close(df); + + df = open(dirfile, 2); + + } + + doit(command, argc, argv); + + if (command == 'x') + + unlink(dirfile); + + exit(0); + +#else + + magtape = "tape"; + + doit('r', 1, 0); + +#endif + +} + + + +doit(command, argc, argv) + +char command; + +int argc; + +char *argv[]; + +{ + + extern char *ctime(); + + register i, k; + + ino_t d; + +#ifndef STANDALONE + + int xtrfile(), skip(); + +#endif + + int rstrfile(), rstrskip(); + + struct dinode *ip, *ip1; + + + +#ifndef STANDALONE + + if ((mt = open(magtape, 0)) < 0) { + + printf("%s: cannot open tape\n", magtape); + + exit(1); + + } + +#else + + do { + + printf("Tape? "); + + gets(mbuf); + + mt = open(mbuf, 0); + + } while (mt == -1); + + magtape = mbuf; + +#endif + + switch(command) { + +#ifndef STANDALONE + + case 't': + + if (readhdr(&spcl) == 0) { + + printf("Tape is not a dump tape\n"); + + exit(1); + + } + + printf("Dump date: %s", ctime(&spcl.c_date)); + + printf("Dumped from: %s", ctime(&spcl.c_ddate)); + + return; + + case 'x': + + if (readhdr(&spcl) == 0) { + + printf("Tape is not a dump tape\n"); + + exit(1); + + } + + if (checkvol(&spcl, 1) == 0) { + + printf("Tape is not volume 1 of the dump\n"); + + exit(1); + + } + + pass1(); /* This sets the various maps on the way by */ + + i = 0; + + while (i < MAXXTR-1 && argc--) { + + if ((d = psearch(*argv)) == 0 || BIT(d, dumpmap) == 0) { + + printf("%s: not on the tape\n", *argv++); + + continue; + + } + + xtrlist[i].x_ino = d; + + xtrlist[i].x_flags |= XINUSE; + + printf("%s: inode %u\n", *argv, d); + + argv++; + + i++; + + } + +newvol: + + flsht(); + + close(mt); + +getvol: + + printf("Mount desired tape volume: Specify volume #: "); + + if (gets(tbf) == NULL) + + return; + + volno = atoi(tbf); + + if (volno <= 0) { + + printf("Volume numbers are positive numerics\n"); + + goto getvol; + + } + + mt = open(magtape, 0); + + if (readhdr(&spcl) == 0) { + + printf("tape is not dump tape\n"); + + goto newvol; + + } + + if (checkvol(&spcl, volno) == 0) { + + printf("Wrong volume (%d)\n", spcl.c_volume); + + goto newvol; + + } + +rbits: + + while (gethead(&spcl) == 0) + + ; + + if (checktype(&spcl, TS_INODE) == 1) { + + printf("Can't find inode mask!\n"); + + goto newvol; + + } + + if (checktype(&spcl, TS_BITS) == 0) + + goto rbits; + + readbits(dumpmap); + + i = 0; + + for (k = 0; xtrlist[k].x_flags; k++) { + + if (BIT(xtrlist[k].x_ino, dumpmap)) { + + xtrlist[k].x_flags |= ONTAPE; + + i++; + + } + + } + + while (i > 0) { + +again: + + if (ishead(&spcl) == 0) + + while(gethead(&spcl) == 0) + + ; + + if (checktype(&spcl, TS_END) == 1) { + + printf("end of tape\n"); + +checkdone: + + for (k = 0; xtrlist[k].x_flags; k++) + + if ((xtrlist[k].x_flags&XTRACTD) == 0) + + goto newvol; + + return; + + } + + if (checktype(&spcl, TS_INODE) == 0) { + + gethead(&spcl); + + goto again; + + } + + d = spcl.c_inumber; + + for (k = 0; xtrlist[k].x_flags; k++) { + + if (d == xtrlist[k].x_ino) { + + printf("extract file %u\n", xtrlist[k].x_ino); + + sprintf(name, "%u", xtrlist[k].x_ino); + + if ((ofile = creat(name, 0666)) < 0) { + + printf("%s: cannot create file\n", name); + + i--; + + continue; + + } + + chown(name, spcl.c_dinode.di_uid, spcl.c_dinode.di_gid); + + getfile(ino, xtrfile, skip, spcl.c_dinode.di_size); + + i--; + + xtrlist[k].x_flags |= XTRACTD; + + close(ofile); + + goto done; + + } + + } + + gethead(&spcl); + +done: + + ; + + } + + goto checkdone; + +#endif + + case 'r': + + case 'R': + +#ifndef STANDALONE + + if ((fi = open(*argv, 2)) < 0) { + + printf("%s: cannot open\n", *argv); + + exit(1); + + } + +#else + + do { + + char charbuf[50]; + + + + printf("Disk? "); + + gets(charbuf); + + fi = open(charbuf, 2); + + } while (fi == -1); + +#endif + +#ifndef STANDALONE + + if (command == 'R') { + + printf("Enter starting volume number: "); + + if (gets(tbf) == EOF) { + + volno = 1; + + printf("\n"); + + } + + else + + volno = atoi(tbf); + + } + + else + +#endif + + volno = 1; + + printf("Last chance before scribbling on %s. ", + +#ifdef STANDALONE + + "disk"); + +#else + + *argv); + +#endif + + while (getchar() != '\n'); + + dread((daddr_t)1, (char *)&sblock, sizeof(sblock)); + + maxi = (sblock.s_isize-2)*INOPB; + + if (readhdr(&spcl) == 0) { + + printf("Missing volume record\n"); + + exit(1); + + } + + if (checkvol(&spcl, volno) == 0) { + + printf("Tape is not volume %d\n", volno); + + exit(1); + + } + + gethead(&spcl); + + for (;;) { + +ragain: + + if (ishead(&spcl) == 0) { + + printf("Missing header block\n"); + + while (gethead(&spcl) == 0) + + ; + + eflag++; + + } + + if (checktype(&spcl, TS_END) == 1) { + + printf("End of tape\n"); + + close(mt); + + dwrite( (daddr_t) 1, (char *) &sblock); + + return; + + } + + if (checktype(&spcl, TS_CLRI) == 1) { + + readbits(clrimap); + + for (ino = 1; ino <= maxi; ino++) + + if (BIT(ino, clrimap) == 0) { + + getdino(ino, &tino); + + if (tino.di_mode == 0) + + continue; + + itrunc(&tino); + + clri(&tino); + + putdino(ino, &tino); + + } + + dwrite( (daddr_t) 1, (char *) &sblock); + + goto ragain; + + } + + if (checktype(&spcl, TS_BITS) == 1) { + + readbits(dumpmap); + + goto ragain; + + } + + if (checktype(&spcl, TS_INODE) == 0) { + + printf("Unknown header type\n"); + + eflag++; + + gethead(&spcl); + + goto ragain; + + } + + ino = spcl.c_inumber; + + if (eflag) + + printf("Resynced at inode %u\n", ino); + + eflag = 0; + + if (ino > maxi) { + + printf("%u: ilist too small\n", ino); + + gethead(&spcl); + + goto ragain; + + } + + dino = spcl.c_dinode; + + getdino(ino, &tino); + + curbno = 0; + + itrunc(&tino); + + clri(&tino); + + for (i = 0; i < NADDR; i++) + + taddr[i] = 0; + + l3tol(taddr, dino.di_addr, 1); + + getfile(d, rstrfile, rstrskip, dino.di_size); + + ip = &tino; + + ltol3(ip->di_addr, taddr, NADDR); + + ip1 = &dino; + + ip->di_mode = ip1->di_mode; + + ip->di_nlink = ip1->di_nlink; + + ip->di_uid = ip1->di_uid; + + ip->di_gid = ip1->di_gid; + + ip->di_size = ip1->di_size; + + ip->di_atime = ip1->di_atime; + + ip->di_mtime = ip1->di_mtime; + + ip->di_ctime = ip1->di_ctime; + + putdino(ino, &tino); + + } + + } + +} + + + +/* + + * Read the tape, bulding up a directory structure for extraction + + * by name + + */ + +#ifndef STANDALONE + +pass1() + +{ + + register i; + + struct dinode *ip; + + int putdir(), null(); + + + + while (gethead(&spcl) == 0) { + + printf("Can't find directory header!\n"); + + } + + for (;;) { + + if (checktype(&spcl, TS_BITS) == 1) { + + readbits(dumpmap); + + continue; + + } + + if (checktype(&spcl, TS_CLRI) == 1) { + + readbits(clrimap); + + continue; + + } + + if (checktype(&spcl, TS_INODE) == 0) { + +finish: + + flsh(); + + close(mt); + + return; + + } + + ip = &spcl.c_dinode; + + i = ip->di_mode & IFMT; + + if (i != IFDIR) { + + goto finish; + + } + + inotab[ipos].t_ino = spcl.c_inumber; + + inotab[ipos++].t_seekpt = seekpt; + + getfile(spcl.c_inumber, putdir, null, spcl.c_dinode.di_size); + + putent("\000\000/"); + + } + +} + +#endif + + + +/* + + * Do the file extraction, calling the supplied functions + + * with the blocks + + */ + +getfile(n, f1, f2, size) + +ino_t n; + +int (*f2)(), (*f1)(); + +long size; + +{ + + register i; + + struct spcl addrblock; + + char buf[BSIZE]; + + + + addrblock = spcl; + + curino = n; + + goto start; + + for (;;) { + + if (gethead(&addrblock) == 0) { + + printf("Missing address (header) block\n"); + + goto eloop; + + } + + if (checktype(&addrblock, TS_ADDR) == 0) { + + spcl = addrblock; + + curino = 0; + + curino = 0; + + return; + + } + +start: + + for (i = 0; i < addrblock.c_count; i++) { + + if (addrblock.c_addr[i]) { + + readtape(buf); + + (*f1)(buf, size > BSIZE ? (long) BSIZE : size); + + } + + else { + + clearbuf(buf); + + (*f2)(buf, size > BSIZE ? (long) BSIZE : size); + + } + + if ((size -= BSIZE) <= 0) { + +eloop: + + while (gethead(&spcl) == 0) + + ; + + if (checktype(&spcl, TS_ADDR) == 1) + + goto eloop; + + curino = 0; + + return; + + } + + } + + } + +} + + + +/* + + * Do the tape i\/o, dealling with volume changes + + * etc.. + + */ + +readtape(b) + +char *b; + +{ + + register i; + + struct spcl tmpbuf; + + + + if (bct >= NTREC) { + + for (i = 0; i < NTREC; i++) + + ((struct spcl *)&tbf[i*BSIZE])->c_magic = 0; + + bct = 0; + + if ((i = read(mt, tbf, NTREC*BSIZE)) < 0) { + + printf("Tape read error: inode %u\n", curino); + + eflag++; + + exit(1); + + } + + if (i == 0) { + + bct = NTREC + 1; + + volno++; + +loop: + + flsht(); + + close(mt); + + printf("Mount volume %d\n", volno); + + while (getchar() != '\n') + + ; + + if ((mt = open(magtape, 0)) == -1) { + + printf("Cannot open tape!\n"); + + goto loop; + + } + + if (readhdr(&tmpbuf) == 0) { + + printf("Not a dump tape.Try again\n"); + + goto loop; + + } + + if (checkvol(&tmpbuf, volno) == 0) { + + printf("Wrong tape. Try again\n"); + + goto loop; + + } + + readtape(b); + + return; + + } + + } + + copy(&tbf[(bct++*BSIZE)], b, BSIZE); + +} + + + +flsht() + +{ + + bct = NTREC+1; + +} + + + +copy(f, t, s) + +register char *f, *t; + +{ + + register i; + + + + i = s; + + do + + *t++ = *f++; + + while (--i); + +} + + + +clearbuf(cp) + +register char *cp; + +{ + + register i; + + + + i = BSIZE; + + do + + *cp++ = 0; + + while (--i); + +} + + + +/* + + * Put and get the directory entries from the compressed + + * directory file + + */ + +#ifndef STANDALONE + +putent(cp) + +char *cp; + +{ + + register i; + + + + for (i = 0; i < sizeof(ino_t); i++) + + writec(*cp++); + + for (i = 0; i < DIRSIZ; i++) { + + writec(*cp); + + if (*cp++ == 0) + + return; + + } + + return; + +} + + + +getent(bf) + +register char *bf; + +{ + + register i; + + + + for (i = 0; i < sizeof(ino_t); i++) + + *bf++ = readc(); + + for (i = 0; i < DIRSIZ; i++) + + if ((*bf++ = readc()) == 0) + + return; + + return; + +} + + + +/* + + * read/write te directory file + + */ + +writec(c) + +char c; + +{ + + drblock[bpt++] = c; + + seekpt++; + + if (bpt >= BSIZE) { + + bpt = 0; + + write(df, drblock, BSIZE); + + } + +} + + + +readc() + +{ + + if (bpt >= BSIZE) { + + read(df, drblock, BSIZE); + + bpt = 0; + + } + + return(drblock[bpt++]); + +} + + + +mseek(pt) + +daddr_t pt; + +{ + + bpt = BSIZE; + + lseek(df, pt, 0); + +} + + + +flsh() + +{ + + write(df, drblock, bpt+1); + +} + + + +/* + + * search the directory inode ino + + * looking for entry cp + + */ + +ino_t + +search(inum, cp) + +ino_t inum; + +char *cp; + +{ + + register i; + + struct direct dir; + + + + for (i = 0; i < MAXINO; i++) + + if (inotab[i].t_ino == inum) { + + goto found; + + } + + return(0); + +found: + + mseek(inotab[i].t_seekpt); + + do { + + getent((char *)&dir); + + if (direq(dir.d_name, "/")) + + return(0); + + } while (direq(dir.d_name, cp) == 0); + + return(dir.d_ino); + +} + + + +/* + + * Search the directory tree rooted at inode 2 + + * for the path pointed at by n + + */ + +psearch(n) + +char *n; + +{ + + register char *cp, *cp1; + + char c; + + + + ino = 2; + + if (*(cp = n) == '/') + + cp++; + +next: + + cp1 = cp + 1; + + while (*cp1 != '/' && *cp1) + + cp1++; + + c = *cp1; + + *cp1 = 0; + + ino = search(ino, cp); + + if (ino == 0) { + + *cp1 = c; + + return(0); + + } + + *cp1 = c; + + if (c == '/') { + + cp = cp1+1; + + goto next; + + } + + return(ino); + +} + + + +direq(s1, s2) + +register char *s1, *s2; + +{ + + register i; + + + + for (i = 0; i < DIRSIZ; i++) + + if (*s1++ == *s2) { + + if (*s2++ == 0) + + return(1); + + } else + + return(0); + + return(1); + +} + +#endif + + + +/* + + * read/write a disk block, be sure to update the buffer + + * cache if needed. + + */ + +dwrite(bno, b) + +daddr_t bno; + +char *b; + +{ + + register i; + + + + for (i = 0; i < NCACHE; i++) { + + if (cache[i].c_bno == bno) { + + copy(b, cache[i].c_block, BSIZE); + + cache[i].c_time = 0; + + break; + + } + + else + + cache[i].c_time++; + + } + + lseek(fi, bno*BSIZE, 0); + + if(write(fi, b, BSIZE) != BSIZE) { + +#ifdef STANDALONE + + printf("disk write error %D\n", bno); + +#else + + fprintf(stderr, "disk write error %ld\n", bno); + +#endif + + exit(1); + + } + +} + + + +dread(bno, buf, cnt) + +daddr_t bno; + +char *buf; + +{ + + register i, j; + + + + j = 0; + + for (i = 0; i < NCACHE; i++) { + + if (++curcache >= NCACHE) + + curcache = 0; + + if (cache[curcache].c_bno == bno) { + + copy(cache[curcache].c_block, buf, cnt); + + cache[curcache].c_time = 0; + + return; + + } + + else { + + cache[curcache].c_time++; + + if (cache[j].c_time < cache[curcache].c_time) + + j = curcache; + + } + + } + + + + lseek(fi, bno*BSIZE, 0); + + if (read(fi, cache[j].c_block, BSIZE) != BSIZE) { + +#ifdef STANDALONE + + printf("read error %D\n", bno); + +#else + + printf("read error %ld\n", bno); + +#endif + + exit(1); + + } + + copy(cache[j].c_block, buf, cnt); + + cache[j].c_time = 0; + + cache[j].c_bno = bno; + +} + + + +/* + + * the inode manpulation routines. Like the system. + + * + + * clri zeros the inode + + */ + +clri(ip) + +struct dinode *ip; + +{ + + int i, *p; +++ if (ip->di_mode&IFMT) +++ sblock.s_tinode++; + + i = sizeof(struct dinode)/sizeof(int); + + p = (int *)ip; + + do + + *p++ = 0; + + while(--i); + +} + + + +/* + + * itrunc/tloop/bfree free all of the blocks pointed at by the inode + + */ + +itrunc(ip) + +register struct dinode *ip; + +{ + + register i; + + daddr_t bn, iaddr[NADDR]; + + + + if (ip->di_mode == 0) + + return; + + i = ip->di_mode & IFMT; + + if (i != IFDIR && i != IFREG) + + return; + + l3tol(iaddr, ip->di_addr, NADDR); + + for(i=NADDR-1;i>=0;i--) { + + bn = iaddr[i]; + + if(bn == 0) continue; + + switch(i) { + + + + default: + + bfree(bn); + + break; + + + + case NADDR-3: + + tloop(bn, 0, 0); + + break; + + + + case NADDR-2: + + tloop(bn, 1, 0); + + break; + + + + case NADDR-1: + + tloop(bn, 1, 1); + + } + + } + + ip->di_size = 0; + +} + + + +tloop(bn, f1, f2) + +daddr_t bn; + +int f1, f2; + +{ + + register i; + + daddr_t nb; + + union { + + char data[BSIZE]; + + daddr_t indir[NINDIR]; + + } ibuf; + + + + dread(bn, ibuf.data, BSIZE); + + for(i=NINDIR-1;i>=0;i--) { + + nb = ibuf.indir[i]; + + if(nb) { + + if(f1) + + tloop(nb, f2, 0); + + else + + bfree(nb); + + } + + } + + bfree(bn); + +} + + + +bfree(bn) + +daddr_t bn; + +{ + + register i; + + union { + + char data[BSIZE]; + + struct fblk frees; - } fbuf; +++ } fbun; +++#define fbuf fbun.frees + + + + if(sblock.s_nfree >= NICFREE) { + + fbuf.df_nfree = sblock.s_nfree; + + for(i=0;i0; j--) { + + sh += NSHIFT; + + nb <<= NSHIFT; + + if(bn < nb) + + break; + + bn -= nb; + + } + + if(j == 0) { + + return((daddr_t)0); + + } + + + + /* + + * fetch the address from the inode + + */ + + if((nb = iaddr[NADDR-j]) == 0) { + + iaddr[NADDR-j] = nb = balloc(); + + } + + + + /* + + * fetch through the indirect blocks + + */ + + for(; j<=3; j++) { + + dread(nb, (char *)indir, BSIZE); + + sh -= NSHIFT; + + i = (bn>>sh) & NMASK; + + nnb = indir[i]; + + if(nnb == 0) { + + nnb = balloc(); + + indir[i] = nnb; + + dwrite(nb, (char *)indir); + + } + + nb = nnb; + + } + + return(nb); + +} + + + +/* + + * read the tape into buf, then return whether or + + * or not it is a header block. + + */ + +gethead(buf) + +struct spcl *buf; + +{ + + readtape((char *)buf); + + if (buf->c_magic != MAGIC || checksum((int *) buf) == 0) + + return(0); + + return(1); + +} + + + +/* + + * return whether or not the buffer contains a header block + + */ + +ishead(buf) + +struct spcl *buf; + +{ + + if (buf->c_magic != MAGIC || checksum((int *) buf) == 0) + + return(0); + + return(1); + +} + + + +checktype(b, t) + +struct spcl *b; + +int t; + +{ + + return(b->c_type == t); + +} + + + + + +checksum(b) + +int *b; + +{ + + register i, j; + + + + j = BSIZE/sizeof(int); + + i = 0; + + do + + i += *b++; + + while (--j); + + if (i != CHECKSUM) { + + printf("Checksum error %o\n", i); + + return(0); + + } + + return(1); + +} + + + +checkvol(b, t) + +struct spcl *b; + +int t; + +{ + + if (b->c_volume == t) + + return(1); + + return(0); + +} + + + +readhdr(b) + +struct spcl *b; + +{ + + if (gethead(b) == 0) + + return(0); + + if (checktype(b, TS_TAPE) == 0) + + return(0); + + return(1); + +} + + + +/* + + * The next routines are called during file extraction to + + * put the data into the right form and place. + + */ + +#ifndef STANDALONE + +xtrfile(b, size) + +char *b; + +long size; + +{ + + write(ofile, b, (int) size); + +} + + + +null() {;} + + + +skip() + +{ + + lseek(ofile, (long) BSIZE, 1); + +} + +#endif + + + + + +rstrfile(b, s) + +char *b; + +long s; + +{ + + daddr_t d; + + + + d = bmap(taddr, curbno); + + dwrite(d, b); + + curbno += 1; + +} + + + +rstrskip(b, s) + +char *b; + +long s; + +{ + + curbno += 1; + +} + + + +#ifndef STANDALONE + +putdir(b) + +char *b; + +{ + + register struct direct *dp; + + register i; + + + + for (dp = (struct direct *) b, i = 0; i < BSIZE; dp++, i += sizeof(*dp)) { + + if (dp->d_ino == 0) + + continue; + + putent((char *) dp); + + } + +} + +#endif + + + +/* + + * read/write an inode from the disk + + */ + +getdino(inum, b) + +ino_t inum; + +struct dinode *b; + +{ + + daddr_t bno; + + char buf[BSIZE]; + + + + bno = (ino - 1)/INOPB; + + bno += 2; + + dread(bno, buf, BSIZE); + + copy(&buf[((inum-1)%INOPB)*sizeof(struct dinode)], (char *) b, sizeof(struct dinode)); + +} + + + +putdino(inum, b) + +ino_t inum; + +struct dinode *b; + +{ + + daddr_t bno; + + char buf[BSIZE]; + + +++ if (b->di_mode&IFMT) +++ sblock.s_tinode--; + + bno = ((ino - 1)/INOPB) + 2; + + dread(bno, buf, BSIZE); + + copy((char *) b, &buf[((inum-1)%INOPB)*sizeof(struct dinode)], sizeof(struct dinode)); + + dwrite(bno, buf); + +} + + + +/* + + * read a bit mask from the tape into m. + + */ + +readbits(m) + +short *m; + +{ + + register i; + + + + i = spcl.c_count; + + + + while (i--) { + + readtape((char *) m); + + m += (BSIZE/(MLEN/BITS)); + + } + + while (gethead(&spcl) == 0) + + ; + +} + + + +done() + +{ + +#ifndef STANDALONE + + unlink(dirfile); + +#endif + + exit(0); + +} diff --cc usr/src/cmd/rev.c index 0000000000,9ced2bfb03,0000000000..1ca9571bc9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/rev.c +++ b/usr/src/cmd/rev.c @@@@ -1,0 -1,44 -1,0 +1,45 @@@@ +++static char *sccsid = "@(#)rev.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +/* reverse lines of a file */ + + + +#define N 256 + +char line[N]; + +FILE *input; + + + +main(argc,argv) + +char **argv; + +{ + + register i,c; + + input = stdin; + + do { + + if(argc>1) { + + if((input=fopen(argv[1],"r"))==NULL) { + + fprintf(stderr,"rev: cannot open %s\n", + + argv[1]); + + exit(1); + + } + + } + + for(;;){ + + for(i=0;i=0) + + putc(line[i],stdout); + + putc('\n',stdout); + + } + +eof: + + fclose(input); + + argc--; + + argv++; + + } while(argc>1); + +} diff --cc usr/src/cmd/rewind.c index 0000000000,c56595f1fe,0000000000..2fbe272377 mode 000000,100644,000000..100644 --- a/usr/src/cmd/rewind.c +++ b/usr/src/cmd/rewind.c @@@@ -1,0 -1,12 -1,0 +1,13 @@@@ +++static char *sccsid = "@(#)rewind.c 4.1 (Berkeley) 10/1/80"; + +/* rewinds mag tape drive */ + +main(argc,argv) char**argv; { + + char *f; + + int fd; + + + + if (argc > 1) f = argv[1]; + + else f = "/dev/mt0"; + + + + fd = open(f,0); + + if (fd < 0) printf("Can't open %s\n",f); + + else close(fd); + +} diff --cc usr/src/cmd/rm.c index 0000000000,fcab28cb44,0000000000..cbb8a00f39 mode 000000,100644,000000..100644 --- a/usr/src/cmd/rm.c +++ b/usr/src/cmd/rm.c @@@@ -1,0 -1,162 -1,0 +1,163 @@@@ +++static char *sccsid = "@(#)rm.c 4.1 (Berkeley) 10/1/80"; + +int errcode; + + + +#include + +#include + +#include + +#include + + + +char *sprintf(); + + + +main(argc, argv) + +char *argv[]; + +{ + + register char *arg; + + int fflg, iflg, rflg; + + + + fflg = 0; + + if (isatty(0) == 0) + + fflg++; + + iflg = 0; + + rflg = 0; - if(argc>1 && argv[1][0]=='-') { +++ while(argc>1 && argv[1][0]=='-') { + + arg = *++argv; + + argc--; + + while(*++arg != '\0') + + switch(*arg) { + + case 'f': + + fflg++; + + break; + + case 'i': + + iflg++; + + break; + + case 'r': + + rflg++; + + break; + + default: + + printf("rm: unknown option %s\n", *argv); + + exit(1); + + } + + } + + while(--argc > 0) { + + if(!strcmp(*++argv, "..")) { + + fprintf(stderr, "rm: cannot remove `..'\n"); + + continue; + + } + + rm(*argv, fflg, rflg, iflg, 0); + + } + + + + exit(errcode); + +} + + + +rm(arg, fflg, rflg, iflg, level) + +char arg[]; + +{ + + struct stat buf; + + struct direct direct; + + char name[100]; + + int d; + + + + if(stat(arg, &buf)) { + + if (fflg==0) { + + printf("rm: %s nonexistent\n", arg); + + ++errcode; + + } + + return; + + } + + if ((buf.st_mode&S_IFMT) == S_IFDIR) { + + if(rflg) { + + if (access(arg, 02) < 0) { + + if (fflg==0) + + printf("%s not changed\n", arg); + + errcode++; + + return; + + } + + if(iflg && level!=0) { - printf("directory %s: ", arg); +++ printf("directory %s, remove? ", arg); + + if(!yes()) + + return; + + } + + if((d=open(arg, 0)) < 0) { + + printf("rm: %s: cannot read\n", arg); + + exit(1); + + } + + while(read(d, (char *)&direct, sizeof(direct)) == sizeof(direct)) { + + if(direct.d_ino != 0 && !dotname(direct.d_name)) { + + sprintf(name, "%s/%.14s", arg, direct.d_name); + + rm(name, fflg, rflg, iflg, level+1); + + } + + } + + close(d); + + errcode += rmdir(arg, iflg); + + return; + + } + + printf("rm: %s directory\n", arg); + + ++errcode; + + return; + + } + + + + if(iflg) { - printf("%s: ", arg); +++ printf("remove %s? ", arg); + + if(!yes()) + + return; + + } + + else if(!fflg) { + + if (access(arg, 02)<0) { - printf("rm: %s %o mode ", arg, buf.st_mode&0777); +++ printf("%s unwritable (mode %o), remove? ", arg, buf.st_mode&0777); + + if(!yes()) + + return; + + } + + } + + if(unlink(arg) && (fflg==0 || iflg)) { + + printf("rm: %s not removed\n", arg); + + ++errcode; + + } + +} + + + +dotname(s) + +char *s; + +{ + + if(s[0] == '.') + + if(s[1] == '.') + + if(s[2] == '\0') + + return(1); + + else + + return(0); + + else if(s[1] == '\0') + + return(1); + + return(0); + +} + + + +rmdir(f, iflg) + +char *f; + +{ + + int status, i; + + + + if(dotname(f)) + + return(0); + + if(iflg) { - printf("%s: ", f); +++ printf("remove %s? ", f); + + if(!yes()) + + return(0); + + } + + while((i=fork()) == -1) + + sleep(3); + + if(i) { + + wait(&status); + + return(status); + + } + + execl("/bin/rmdir", "rmdir", f, 0); + + execl("/usr/bin/rmdir", "rmdir", f, 0); + + printf("rm: can't find rmdir\n"); + + exit(1); + +} + + + +yes() + +{ + + int i, b; + + + + i = b = getchar(); + + while(b != '\n' && b != EOF) + + b = getchar(); + + return(i == 'y'); + +} diff --cc usr/src/cmd/rmail.c index 0000000000,0000000000,0000000000..b158dd1b38 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/rmail.c @@@@ -1,0 -1,0 -1,0 +1,93 @@@@ +++static char *sccsid = "@(#)rmail.c 4.1 (Berkeley) 10/1/80"; +++/* +++ * rmail: front end for mail to stack up those stupid >From ... remote from ... +++ * lines and make a correct return address. This works with the -f option +++ * to /etc/delivermail so it won't work on systems without delivermail. +++ * However, it ought to be easy to modify a standard /bin/mail to do the +++ * same thing. +++ * +++ * NOTE: Rmail is SPECIFICALLY INTENDED for ERNIE COVAX because of its +++ * physical position as a gateway between the uucp net and the arpanet. +++ * By default, other sites will probably want /bin/rmail to be a link +++ * to /bin/mail, as it was intended by BTL. However, other than the +++ * (somewhat annoying) loss of information about when the mail was +++ * originally sent, rmail should work OK on other systems running uucp. +++ * If you don't run uucp you don't even need any rmail. +++ */ +++ +++#include +++FILE *popen(); +++char *index(); +++ +++#define MAILER "/etc/delivermail" +++ +++main(argc, argv) +++char **argv; +++{ +++ FILE *out; /* output to delivermail */ +++ char lbuf[512]; /* one line of the message */ +++ char from[512]; /* accumulated path of sender */ +++ char ufrom[64]; /* user on remote system */ +++ char sys[64]; /* a system in path */ +++ char junk[512]; /* scratchpad */ +++ char cmd[512]; +++ char *to, *cp; +++ +++ to = argv[1]; +++ if (argc != 2) { +++ fprintf(stderr, "Usage: rmail user\n"); +++ exit(1); +++ } +++ +++ for (;;) { +++ fgets(lbuf, sizeof lbuf, stdin); +++ if (strncmp(lbuf, "From ", 5) && strncmp(lbuf, ">From ", 6)) +++ break; +++ /* sscanf(lbuf, "%s %s %s %s %s %s %s remote from %s", junk, ufrom, junk, junk, junk, junk, junk, sys); */ +++ sscanf(lbuf, "%s %s", junk, ufrom); +++ cp = lbuf; +++ for (;;) { +++ cp = index(cp+1, 'r'); +++ if (cp == NULL) +++ cp = "remote from somewhere"; +++#ifdef DEBUG +++ printf("cp='%s'\n", cp); +++#endif +++ if (strncmp(cp, "remote from ", 12)==0) +++ break; +++ } +++ sscanf(cp, "remote from %s", sys); +++ strcat(from, sys); +++ strcat(from, "!"); +++#ifdef DEBUG +++ printf("ufrom='%s', sys='%s', from now '%s'\n", ufrom, sys, from); +++#endif +++ } +++ strcat(from, ufrom); +++ +++ sprintf(cmd, "%s -r%s %s", MAILER, from, to); +++#ifdef DEBUG +++ printf("cmd='%s'\n", cmd); +++#endif +++ out = popen(cmd, "w"); +++ fputs(lbuf, out); +++ while (fgets(lbuf, sizeof lbuf, stdin)) +++ fputs(lbuf, out); +++ pclose(out); +++} +++ +++/* +++ * Return the ptr in sp at which the character c appears; +++ * NULL if not found +++ */ +++ +++char * +++index(sp, c) +++register char *sp, c; +++{ +++ do { +++ if (*sp == c) +++ return(sp); +++ } while (*sp++); +++ return(NULL); +++} diff --cc usr/src/cmd/rmdir.c index 0000000000,5b896c43ee,0000000000..641e74a0b2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/rmdir.c +++ b/usr/src/cmd/rmdir.c @@@@ -1,0 -1,104 -1,0 +1,105 @@@@ +++static char *sccsid = "@(#)rmdir.c 4.1 (Berkeley) 10/1/80"; + +/* + + * Remove directory + + */ + + + +#include + +#include + +#include + +#include + + + +int Errors = 0; + +char *rindex(); + +char *strcat(); + +char *strcpy(); + + + +main(argc,argv) + +int argc; + +char **argv; + +{ + + + + if(argc < 2) { + + fprintf(stderr, "rmdir: arg count\n"); + + exit(1); + + } + + while(--argc) + + rmdir(*++argv); + + exit(Errors!=0); + +} + + + +rmdir(d) + +char *d; + +{ + + int fd; + + char *np, name[500]; + + struct stat st, cst; + + struct direct dir; + + + + strcpy(name, d); + + if((np = rindex(name, '/')) == NULL) + + np = name; + + if(stat(name,&st) < 0) { + + fprintf(stderr, "rmdir: %s non-existent\n", name); + + ++Errors; + + return; + + } + + if (stat("", &cst) < 0) { + + fprintf(stderr, "rmdir: cannot stat \"\""); + + ++Errors; + + exit(1); + + } + + if((st.st_mode & S_IFMT) != S_IFDIR) { + + fprintf(stderr, "rmdir: %s not a directory\n", name); + + ++Errors; + + return; + + } + + if(st.st_ino==cst.st_ino &&st.st_dev==cst.st_dev) { + + fprintf(stderr, "rmdir: cannot remove current directory\n"); + + ++Errors; + + return; + + } + + if((fd = open(name,0)) < 0) { + + fprintf(stderr, "rmdir: %s unreadable\n", name); + + ++Errors; + + return; + + } + + while(read(fd, (char *)&dir, sizeof dir) == sizeof dir) { + + if(dir.d_ino == 0) continue; + + if(!strcmp(dir.d_name, ".") || !strcmp(dir.d_name, "..")) + + continue; + + fprintf(stderr, "rmdir: %s not empty\n", name); + + ++Errors; + + close(fd); + + return; + + } + + close(fd); + + if(!strcmp(np, ".") || !strcmp(np, "..")) { + + fprintf(stderr, "rmdir: cannot remove . or ..\n"); + + ++Errors; + + return; + + } + + strcat(name, "/."); + + if((access(name, 0)) < 0) { /* name/. non-existent */ + + strcat(name, "."); + + goto unl; + + } + + strcat(name, "."); + + if((access(name, 0)) < 0) /* name/.. non-existent */ + + goto unl2; + + if(access(name, 02)) { + + name[strlen(name)-3] = '\0'; + + fprintf(stderr, "rmdir: %s: no permission\n", name); + + ++Errors; + + return; + + } + +unl: + + unlink(name); /* unlink name/.. */ + +unl2: + + name[strlen(name)-1] = '\0'; + + unlink(name); /* unlink name/. */ + + name[strlen(name)-2] = '\0'; + + if (unlink(name) < 0) { + + fprintf(stderr, "rmdir: %s not removed\n", name); + + ++Errors; + + } + +} diff --cc usr/src/cmd/sa.c index 0000000000,0b0e05bfac,0000000000..a55a0bb42c mode 000000,100644,000000..100644 --- a/usr/src/cmd/sa.c +++ b/usr/src/cmd/sa.c @@@@ -1,0 -1,488 -1,0 +1,651 @@@@ +++static char *sccsid = "@(#)sa.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +#include + + + +/* interpret command time accounting */ + + + +#define size 2500 + +#define NC sizeof(acctbuf.ac_comm) + +struct acct acctbuf; + +int lflg; + +int cflg; +++int Dflg; +++int dflg; + +int iflg; + +int jflg; +++int Kflg; +++int kflg; + +int nflg; + +int aflg; + +int rflg; + +int oflg; + +int tflg; + +int vflg; + +int uflg; + +int thres = 1; + +int sflg; + +int bflg; + +int mflg; + + + +struct user { - int ncomm; - int fill; - float fctime; +++ int us_cnt; +++ double us_ctime; +++ double us_io; +++ double us_imem; + +} user[1000]; + + + +struct tab { + + char name[NC]; + + int count; - float realt; - float cput; - float syst; +++ double realt; +++ double cput; +++ double syst; +++ double imem; +++ double io; + +} tab[size]; + + - float treal; - float tcpu; - float tsys; +++double treal; +++double tcpu; +++double tsys; +++double tio; +++double timem; + +int junkp = -1; + +char *sname; - float ncom; +++double ncom; + +time_t expand(); +++char *getname(); + + + +main(argc, argv) + +char **argv; + +{ + + FILE *ff; + + int i, j, k; - extern tcmp(), ncmp(), bcmp(); - extern float sum(); - float ft; +++ int (*cmp)(); +++ extern tcmp(), ncmp(), bcmp(), dcmp(), Dcmp(), kcmp(), Kcmp(); +++ extern double sum(); +++ double ft; + + +++ cmp = tcmp; + + if (argc>1) + + if (argv[1][0]=='-') { + + argv++; + + argc--; + + for(i=1; argv[0][i]; i++) + + switch(argv[0][i]) { + + + + case 'o': + + oflg++; + + break; + + + + case 'i': + + iflg++; + + break; + + + + case 'b': + + bflg++; +++ cmp = bcmp; + + break; + + + + case 'l': + + lflg++; + + break; + + + + case 'c': + + cflg++; + + break; + + +++ case 'd': +++ dflg++; +++ cmp = dcmp; +++ break; +++ +++ case 'D': +++ Dflg++; +++ cmp = Dcmp; +++ break; +++ + + case 'j': + + jflg++; + + break; + + +++ case 'k': +++ kflg++; +++ cmp = kcmp; +++ break; +++ +++ case 'K': +++ Kflg++; +++ cmp = Kcmp; +++ break; +++ + + case 'n': + + nflg++; +++ cmp = ncmp; + + break; + + + + case 'a': + + aflg++; + + break; + + + + case 'r': + + rflg++; + + break; + + + + case 't': + + tflg++; + + break; + + + + case 's': + + sflg++; + + aflg++; + + break; + + + + case '0': + + case '1': + + case '2': + + case '3': + + case '4': + + case '5': + + case '6': + + case '7': + + case '8': + + case '9': + + thres = argv[0][i]-'0'; + + break; + + + + case 'v': + + vflg++; + + break; + + + + case 'u': + + uflg++; + + break; + + + + case 'm': + + mflg++; + + break; + + } + + } + + if (iflg==0) + + init(); + + if (argc<2) + + doacct("/usr/adm/acct"); + + else while (--argc) + + doacct(*++argv); + + if (uflg) { + + return; + + } + + + +/* + + * cleanup pass + + * put junk together + + */ + + + + if (vflg) + + strip(); + + if(!aflg) + + for (i=0; i= 0200)) { + + *cp = '?'; + + } + + } + + if (fbuf.ac_flag&AFORK) { + + for (cp=fbuf.ac_comm; cp < &fbuf.ac_comm[NC]; cp++) + + if (*cp==0) { + + *cp = '*'; + + break; + + } + + } + + x = expand(fbuf.ac_utime) + expand(fbuf.ac_stime); +++ y = fbuf.ac_mem; +++ z = expand(fbuf.ac_io); + + if (uflg) { - printf("%3d%6.1f %.14s\n", fbuf.ac_uid&0377, x/60.0, - fbuf.ac_comm); +++ printf("%3d%6.1fcp %6dmem %6dio %.14s\n", +++ fbuf.ac_uid, x/60.0, y, z, +++ fbuf.ac_comm); + + continue; + + } - c = fbuf.ac_uid&0377; - user[c].ncomm++; - user[c].fctime += x/60.; +++ c = fbuf.ac_uid; +++ user[c].us_cnt++; +++ user[c].us_ctime += x/60.; +++ user[c].us_imem += x * y; +++ user[c].us_io += z; + + ncom += 1.0; + + i = enter(fbuf.ac_comm); +++ tab[i].imem += x * y; +++ timem += x * y; + + tab[i].count++; + + x = expand(fbuf.ac_etime)*60; + + tab[i].realt += x; + + treal += x; + + x = expand(fbuf.ac_utime); + + tab[i].cput += x; + + tcpu += x; + + x = expand(fbuf.ac_stime); + + tab[i].syst += x; + + tsys += x; +++ tab[i].io += z; +++ tio += z; + + } + + fclose(ff); + +} + + + +ncmp(p1, p2) + +struct tab *p1, *p2; + +{ + + + + if(p1->count == p2->count) + + return(tcmp(p1, p2)); + + if(rflg) + + return(p1->count - p2->count); + + return(p2->count - p1->count); + +} + + + +bcmp(p1, p2) + +struct tab *p1, *p2; + +{ - float f1, f2; - float sum(); +++ double f1, f2; +++ double sum(); + + + + f1 = sum(p1)/p1->count; + + f2 = sum(p2)/p2->count; + + if(f1 < f2) { + + if(rflg) + + return(-1); + + return(1); + + } + + if(f1 > f2) { + + if(rflg) + + return(1); + + return(-1); + + } + + return(0); + +} +++ +++Kcmp(p1, p2) +++struct tab *p1, *p2; +++{ +++ +++ if (p1->imem < p2->imem) { +++ if(rflg) +++ return(-1); +++ return(1); +++ } +++ if (p1->imem > p2->imem) { +++ if(rflg) +++ return(1); +++ return(-1); +++ } +++ return(0); +++} +++ +++kcmp(p1, p2) +++struct tab *p1, *p2; +++{ +++ double a1, a2; +++ +++ a1 = p1->imem / ((p1->cput+p1->syst)?(p1->cput+p1->syst):1); +++ a2 = p2->imem / ((p2->cput+p2->syst)?(p2->cput+p2->syst):1); +++ if (a1 < a2) { +++ if(rflg) +++ return(-1); +++ return(1); +++ } +++ if (a1 > a2) { +++ if(rflg) +++ return(1); +++ return(-1); +++ } +++ return(0); +++} +++ +++dcmp(p1, p2) +++struct tab *p1, *p2; +++{ +++ double a1, a2; +++ +++ a1 = p1->io / (p1->count?p1->count:1); +++ a2 = p2->io / (p2->count?p2->count:1); +++ if (a1 < a2) { +++ if(rflg) +++ return(-1); +++ return(1); +++ } +++ if (a1 > a2) { +++ if(rflg) +++ return(1); +++ return(-1); +++ } +++ return(0); +++} +++ +++Dcmp(p1, p2) +++struct tab *p1, *p2; +++{ +++ +++ if (p1->io < p2->io) { +++ if(rflg) +++ return(-1); +++ return(1); +++ } +++ if (p1->io > p2->io) { +++ if(rflg) +++ return(1); +++ return(-1); +++ } +++ return(0); +++} +++ + +tcmp(p1, p2) + +struct tab *p1, *p2; + +{ - extern float sum(); - float f1, f2; +++ extern double sum(); +++ double f1, f2; + + + + f1 = sum(p1); + + f2 = sum(p2); + + if(f1 < f2) { + + if(rflg) + + return(-1); + + return(1); + + } + + if(f1 > f2) { + + if(rflg) + + return(1); + + return(-1); + + } + + return(0); + +} + + - float sum(p) +++double sum(p) + +struct tab *p; + +{ + + + + if(p->name[0] == 0) + + return(0.0); + + return( + + p->cput+ + + p->syst); + +} + + + +init() + +{ + + struct tab tbuf; + + int i; + + FILE *f; + + + + if ((f = fopen("/usr/adm/savacct", "r")) == NULL) + + goto gshm; + + while (fread((char *)&tbuf, sizeof(tbuf), 1, f) == 1) { + + i = enter(tbuf.name); + + ncom += tbuf.count; + + tab[i].count = tbuf.count; + + treal += tbuf.realt; + + tab[i].realt = tbuf.realt; + + tcpu += tbuf.cput; + + tab[i].cput = tbuf.cput; + + tsys += tbuf.syst; + + tab[i].syst = tbuf.syst; +++ tio += tbuf.io; +++ tab[i].io = tbuf.io; +++ timem += tbuf.imem; +++ tab[i].imem = tbuf.imem; + + } + + fclose(f); + + gshm: + + if ((f = fopen("/usr/adm/usracct", "r")) == NULL) + + return; + + fread((char *)user, sizeof(user), 1, f); + + fclose(f); + +} + + + +enter(np) + +char *np; + +{ + + int i, j; + + + + for (i=j=0; i>= 13; + + while (t!=0) { + + t--; + + nt <<= 3; + + } + + return(nt); + +} +++ +++#include +++#include +++ +++struct utmp utmp; +++#define NMAX sizeof (utmp.ut_name) +++#define NUID 2048 +++ +++char names[NUID][NMAX+1]; +++ +++char * +++getname(uid) +++{ +++ register struct passwd *pw; +++ static init; +++ struct passwd *getpwent(); +++ +++ if (names[uid][0]) +++ return (&names[uid][0]); +++ if (init == 2) +++ return (0); +++ if (init == 0) +++ setpwent(), init = 1; +++ while (pw = getpwent()) { +++ if (pw->pw_uid >= NUID) +++ continue; +++ if (names[pw->pw_uid][0]) +++ continue; +++ strncpy(names[pw->pw_uid], pw->pw_name, NMAX); +++ if (pw->pw_uid == uid) +++ return (&names[uid][0]); +++ } +++ init = 2; +++ endpwent(); +++ return (0); +++} diff --cc usr/src/cmd/script.c index 0000000000,21f5aa4ddc,0000000000..ed2a3f0e91 mode 000000,100644,000000..100644 --- a/usr/src/cmd/script.c +++ b/usr/src/cmd/script.c @@@@ -1,0 -1,304 -1,0 +1,329 @@@@ +++static char *sccsid = "@(#)script.c 4.1 (Berkeley) 10/1/80"; + + /* - * + + * script - makes copy of terminal conversation. usage: +++ * + + * script [ -n ] [ -s ] [ -q ] [ -a ] [ -S shell ] [ file ] + + * conversation saved in file. default is DFNAME - * + + */ + + + +#define DFNAME "typescript" + + + +#ifdef HOUXP + +#define STDSHELL "/bin/sh" + +#define NEWSHELL "/p4/3723mrh/bin/csh" + +char *shell = NEWSHELL; + +#endif + + + +#ifdef HOUXT + +#define STDSHELL "/bin/sh" + +#define NEWSHELL "/t1/bruce/ucb/bin/csh" + +char *shell = NEWSHELL; + +#endif + + + +#ifdef CORY + +#define STDSHELL "/bin/sh" + +#define NEWSHELL "/bin/csh" + +char *shell = NEWSHELL; + +#endif + + + +#ifdef CC + +#define STDSHELL "/bin/sh" + +#define NEWSHELL "/bin/csh" + +char *shell = NEWSHELL; + +#endif + + + +#ifndef STDSHELL + +# define V7ENV + +#endif + + + +#ifdef V7ENV +++#include + +/* used for version 7 with environments - gets your environment shell */ + +#define STDSHELL "/bin/sh" + +#define NEWSHELL "/bin/csh" + +char *shell; /* initialized in the code */ + +# include + +# include + +# define MODE st_mode + +# define STAT stat + +char *getenv(); + + + +#else + + + +/* + + * The following is the structure of the block returned by + + * the stat and fstat system calls. + + */ + + + +struct inode { + + char i_minor; /* +0: minor device of i-node */ + + char i_major; /* +1: major device */ + + int i_number; /* +2 */ + + int i_flags; /* +4: see below */ + + char i_nlinks; /* +6: number of links to file */ + + char i_uid; /* +7: user ID of owner */ + + char i_gid; /* +8: group ID of owner */ + + char i_size0; /* +9: high byte of 24-bit size */ + + int i_size1; /* +10: low word of 24-bit size */ + + int i_addr[8]; /* +12: block numbers or device number */ + + int i_actime[2]; /* +28: time of last access */ + + int i_modtime[2]; /* +32: time of last modification */ + +}; + + + +#define IALLOC 0100000 + +#define IFMT 060000 + +#define IFDIR 040000 + +#define IFCHR 020000 + +#define IFBLK 060000 + +#define MODE i_flags + +#define STAT inode + +#endif + + + +char *tty; /* name of users tty so can turn off writes */ + +char *ttyname(); /* std subroutine */ + +int mode = 0622; /* old permission bits for users tty */ + +int outpipe[2]; /* pipe from shell to output */ + +int fd; /* file descriptor of typescript file */ + +int inpipe[2]; /* pipe from input to shell */ + +long tvec; /* current time */ + +char buffer[256]; /* for block I/O's */ + +int n; /* number of chars read */ + +int status; /* dummy for wait sys call */ + +char *fname; /* name of typescript file */ + +int forkval, ttn; /* temps for error checking */ + +int qflg; /* true if -q (quiet) flag */ + +int aflg; /* true if -q (append) flag */ + +struct STAT sbuf; + +int flsh(); + + + +main(argc,argv) int argc; char **argv; { + + + + if ((tty = ttyname(2)) < 0) { + + printf("Nested script not allowed.\n"); + + fail(); + + } + + + +#ifdef V7ENV + + shell = getenv("SHELL"); + +#endif + + + + while ( argc > 1 && argv[1][0] == '-') { + + switch(argv[1][1]) { + + case 'n': + + shell = NEWSHELL; + + break; + + case 's': + + shell = STDSHELL; + + break; + + case 'S': + + shell = argv[2]; + + argc--; argv++; + + break; + + case 'q': + + qflg++; + + break; + + case 'a': + + aflg++; + + break; + + default: + + printf("Bad flag %s - ignored\n",argv[1]); + + } + + argc--; argv++; + + } + + + + if (argc > 1) { + + fname = argv[1]; + + if (!aflg && stat(fname,&sbuf) >= 0) { + + printf("File %s already exists.\n",fname); + + done(); + + } + + } else fname = DFNAME; + + if (!aflg) { + + fd = creat(fname,0); /* so can't cat/lpr typescript from inside */ + + } else { + + /* try to append to existing file first */ + + fd = open(fname,1); + + if (fd >= 0) lseek(fd,0l,2); + + else fd = creat(fname,0); + + } + + if (fd<0) { + + printf("Can't create %s\n",fname); + + if (unlink(fname)==0) { + + printf("because of previous typescript bomb - try again\n"); + + } + + fail(); + + } + + + + chmod(fname,0); /* in case it already exists */ + + fixtty(); + + if (!qflg) { + + printf("Script started, file is %s\n",fname); + + check(write(fd,"Script started on ",18)); + + time(&tvec); + + check(write(fd,ctime(&tvec),25)); + + } + + pipe(inpipe); + + pipe(outpipe); + + + + forkval = fork(); - if (forkval < 0) { - printf("Fork failed - try again.\n"); - fail(); +++ if (forkval < 0) +++ goto ffail; +++ if (forkval == 0) { +++ forkval = fork(); +++ if (forkval < 0) +++ goto ffail; +++ if (forkval == 0) +++ dooutput(); +++ forkval = fork(); +++ if (forkval < 0) +++ goto ffail; +++ if (forkval == 0) +++ doinput(); +++ doshell(); + + } - if (forkval == 0) doshell(); +++ close(inpipe[0]); close(inpipe[1]); +++ close(outpipe[0]); close(outpipe[1]); +++ signal(SIGINT, SIG_IGN); +++ signal(SIGQUIT, done); +++ wait(&status); +++ done(); +++ /*NOTREACHED*/ + + - forkval = fork(); - if (forkval < 0) { - printf("Fork failed. Try again.\n"); - fail(); - } - if (forkval == 0) dooutput(); - else doinput(); +++ffail: +++ printf("Fork failed. Try again.\n"); +++ fail(); + +} + + - doinput() { - int done(); - /* input process - copy tty to pipe and file */ - signal(2,1); /* ignore interrupts from delete */ - signal(3,done); /* fix files when users quits. */ +++/* input process - copy tty to pipe and file */ +++doinput() +++{ +++ +++ signal(SIGINT, SIG_IGN); +++ signal(SIGQUIT, SIG_IGN); +++ signal(SIGTSTP, SIG_IGN); + + + + close(inpipe[0]); + + close(outpipe[0]); + + close(outpipe[1]); + + + + /* main input loop - copy until end of file (ctrl D) */ - while (n=read(0,buffer,256)) { +++ while ((n=read(0,buffer,256)) > 0) { + + check(write(fd,buffer,n)); + + write(inpipe[1],buffer,n); + + } + + + + /* end of script - close files and exit */ + + close(inpipe[1]); + + close(fd); - wait(&status); /* wait for shell to terminate */ - wait(&status); /* wait for output to terminate */ + + done(); + +} + + - dooutput() { - /* do output process - copy to tty & file */ - signal(2,flsh); /* trap to flsh on interrupts */ - signal(3,1); /* ignore quits */ +++/* do output process - copy to tty & file */ +++dooutput() +++{ + + +++ signal(SIGINT, flsh); +++ signal(SIGQUIT, SIG_IGN); +++ signal(SIGTSTP, SIG_IGN); + + close(0); + + close(inpipe[0]); + + close(inpipe[1]); + + close(outpipe[1]); + + + + /* main output proc loop */ + + while (n=read(outpipe[0],buffer,256)) { + + if (n > 0) { /* -1 means trap to flsh just happened */ + + write(1,buffer,n); + + check(write(fd,buffer,n)); + + } + + } + + + + /* output sees eof - close files and exit */ + + if (!qflg) { + + printf("Script done, file is %s\n",fname); + + check(write(fd,"\nscript done on ",16)); + + time(&tvec); + + check(write(fd,ctime(&tvec),25)); + + } + + close(fd); - exit(); +++ exit(0); + +} + + - doshell() { - /* exec shell, after divirting std input & output */ +++/* exec shell, after diverting std input & output */ +++doshell() +++{ +++ + + close(0); + + dup(inpipe[0]); + + close(1); + + dup(outpipe[1]); + + close(2); + + dup(outpipe[1]); + + + + /* close useless files */ + + close(inpipe[0]); + + close(inpipe[1]); + + close(outpipe[0]); + + close(outpipe[1]); - /* signal(2,1); /* shell should ignore interrupts */ - execl(shell,"sh","-i",0); - execl(STDSHELL,"sh","-i",0); - execl(NEWSHELL,"sh","-i",0); +++ execl(shell, "sh", "-i", 0); +++ execl(STDSHELL, "sh", "-i", 0); +++ execl(NEWSHELL, "sh", "-i", 0); + + printf("Can't execute shell\n"); + + fail(); + +} + + + +fixtty() + +{ + + + + fstat(2, &sbuf); + + mode = sbuf.MODE&0777; + + chmod(tty, 0600); + +} + + - flsh() { - /* come here on rubout to flush output - this doesn't work */ - signal(2,flsh); +++/* come here on rubout to flush output - this doesn't work */ +++flsh() +++{ +++ +++ signal(SIGINT, flsh); + + /* lseek(outpipe[0],0l,2); /* seeks on pipes don't work !"$"$!! */ + +} + + - fail() { +++fail() +++{ +++ + + unlink(fname); - kill(0,15); /* shut off other script processes */ +++ kill(0, 15); /* shut off other script processes */ + + done(); + +} + + - done() { - chmod(tty,mode); - chmod(fname,0664); +++done() +++{ +++ +++ chmod(tty, mode); +++ chmod(fname, 0664); + + exit(); + +} + + + +#ifndef V7ENV + +#ifndef CC + +char *ttyname(i) int i; { + + char *string; + + string = "/dev/ttyx"; + + string[8] = ttyn(fd); + + if (string[8] == 'x') return((char *) (-1)); + + else return(string); + +} + +#endif + +#endif + + - check(n) int n; { +++check(n) +++int n; +++{ + + /* checks the result of a write call, if neg + + assume ran out of disk space & die */ + + if (n < 0) { + + write(1,"Disk quota exceeded - script quits\n",35); + + kill(0,15); + + done(); + + } + +} diff --cc usr/src/cmd/sdb/access.c index 0000000000,2f74c4cab0,0000000000..7764f69dc6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/access.c +++ b/usr/src/cmd/sdb/access.c @@@@ -1,0 -1,133 -1,0 +1,161 @@@@ +++static char sccsid[] = "@(#)access.c 4.1 10/9/80"; + +# + +/* + + * + + * UNIX debugger + + * + + */ + + + +#include "head.h" + +struct user u; + + + + + +MSG BADDAT; + +MSG BADTXT; + +MAP txtmap; + +MAP datmap; + +STRING errflg; + +int errno; + + + +INT pid; + + + + + + + + + +/* file handling and access routines */ + + + +int dmask[5] = {0, 0xff, 0xffff, 0xffffff, 0xffffffff}; + + + +/* get data at loc using descriptor format d */ + +long - getval(loc, d) +++getval(loc, d, space) + +ADDR loc; + +char d; { + + register int val; + + - val = get(loc, DSP); +++ val = get(loc, space); + + val &= dmask[dtol(d)]; + + return(val); + +} + + + +/* put value at loc using descriptor format d */ + +putval(loc, d, value) + +ADDR loc; char d; long value; { + + register long val; + + + + val = get(loc, DSP); + + val = (val & !dmask[dtol(d)]) | (value & dmask[dtol(d)]); + + put(loc, DSP, val); + +} + + + +/* put value in named register using descriptor format d */ + +putreg(reg, d, value) + +ADDR reg; char d; long value; { + + register long val; + + + + val = *(ADDR *)(((ADDR)&u)+R0+WORDSIZE*reg); + + val = (val & !dmask[dtol(d)]) | (value & dmask[dtol(d)]); + + *(ADDR *)(((ADDR)&u)+R0+WORDSIZE*reg) = val; + +} + + + +put(adr,space,value) + +L_INT adr; + +{ + + access(WT,adr,space,value); + +} + + + +POS get(adr, space) + +L_INT adr; + +{ + + return(access(RD,adr,space,0)); + +} + + + + + +access(mode,adr,space,value) + +L_INT adr; + +{ + + INT pmode,rd,file; + + ADDR w; +++ if (debug) +++ printf("access(mode=%d,adr=%d,space=%d,value=%d) with pid %d\n", +++ mode, adr, space, value, pid); + + rd = mode==RD; + + + + IF space == NSP THEN return(0); FI + + + + IF pid /* tracing on? */ + + THEN + +#ifndef vax + + IF adr&01 ANDF !rd THEN error(ODDADR); FI + +#endif + + pmode = (space&DSP?(rd?RDUSER:WDUSER):(rd?RIUSER:WIUSER)); + + w = ptrace(pmode, pid, adr, value); +++ if (debug) +++ printf("ptrace(%d,%d,%d,%d) = %d with error=%d\n", +++ pmode, pid, adr, value, w, errno); + +#ifndef vax + + IF adr&01 + + THEN w1 = ptrace(pmode, pid, shorten(adr+1), value); + + w = (w>>8)&LOBYTE | (w1<<8); + + FI + +#endif + + IF errno + + THEN errflg = (space&DSP ? BADDAT : BADTXT); + + FI + + return(w); + + FI + + w = 0; + + IF !chkmap(&adr,space) + + THEN return(0); + + FI + + file=(space&DSP?datmap.ufd:txtmap.ufd); - IF longseek(file,adr)==0 ORF - (rd ? read(file,&w,sizeof(w)) : write(file,&value,sizeof(w))) < 1 - THEN errflg=(space&DSP?BADDAT:BADTXT); - FI +++ if (longseek(file,adr)==0 || +++ (rd ? read(file,&w,sizeof(w)) : write(file,&value,sizeof(w))) < 1) +++ errflg=(space&DSP?BADDAT:BADTXT); + + return(w); + + + +} + + + +chkmap(adr,space) + + REG L_INT *adr; + + REG INT space; + +{ + + REG MAPPTR amap; + + amap=((space&DSP?&datmap:&txtmap)); + + IF space&STAR ORF !within(*adr,amap->b1,amap->e1) - THEN IF within(*adr,amap->b2,amap->e2) - THEN *adr += (amap->f2)-(amap->b2); - ELSE errflg=(space&DSP?BADDAT:BADTXT); return(0); - FI +++ THEN if (within(*adr,amap->b2,amap->e2)) +++ *adr += (amap->f2)-(amap->b2); +++ else { +++ errflg=(space&DSP?BADDAT:BADTXT); return(0); +++ } + + ELSE *adr += (amap->f1)-(amap->b1); + + FI + + return(1); + +} + + + +within(adr,lbd,ubd) + +POS adr, lbd, ubd; + +{ + + return(adr>=lbd && adr=UCHAR) + +# define UNSIGNABLE(x) ((x)<=LONG&&(x)>=CHAR) + +# define ENUNSIGN(x) ((x)+(UNSIGNED-INT)) + +# define DEUNSIGN(x) ((x)+(INT-UNSIGNED)) + +# define ISPTR(x) ((x&TMASK)==PTR) + +# define ISFTN(x) ((x&TMASK)==FTN) /* is x a function type */ + +# define ISARY(x) ((x&TMASK)==ARY) /* is x an array type */ + +# define INCREF(x) (((x&~BTMASK)<>TSHIFT)&~BTMASK&0x3fff)|(x&BTMASK)) + + /* pack and unpack field descriptors (size and offset) */ + +# define PKFIELD(s,o) ((o<<6)|s) + +# define UPKFSZ(v) (v&077) + +# define UPKFOFF(v) (v>>6) + + diff --cc usr/src/cmd/sdb/decode.c index 0000000000,bf7c7aeb66,0000000000..5951708cfe mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/decode.c +++ b/usr/src/cmd/sdb/decode.c @@@@ -1,0 -1,110 -1,0 +1,125 @@@@ +++static char sccsid[] = "@(#)decode.c 4.1 10/9/80"; + +#include "head.h" + + + +/* decode() - read a line from standard input and decode it */ + + + +decode(p) + +char *p; { + + register char c, *q; - integ = scallf = reflag = colonflag = 0; +++ register int diff; +++ integ = scallf = reflag = colonflag = ncolonflag = percentflag = 0; + + proc[0] = cmd = args[0] = var[0] = '\0'; + + argsp = args; + + + + if (eqany(*p, "/?")) { /* regular expression */ + + c = *p; + + redir = (c == '/'); + + reflag = 1; + + p++; + + if (*p == '\n' || *p == c) return(0); + + q = re; + + while(*p != c && *p != '\n') *q++ = *p++; + + *q = '\0'; + + return(0); + + } + + + + if (*p == '!') { /* shell escape */ + + for (q = p; *q != '\n'; q++) ; + + *q = '\0'; + + system(p+1); + + return(0); + + } + + + + if (*p == '\n') { + + cmd = '\n'; + + return(0); + + } + + + + if (*p == ':') { + + colonflag++; + + } + + + + while (*p != '\n') { /* decode item by item */ + + + + if (number(*p)) { /* decimal number */ - if(integ) { +++ if (integ) { + + error("Too many numbers"); + + return(1); + + } + + integ = readint(&p); +++ if (*p == ':') { +++ ncolonflag++; +++ p++; +++ } + + continue; + + } + + + + if (varchar(*p) || eqany(*p, COMMANDS)) { + + /* proc, variable or command */ + + if (cmd != '\0') { + + p = cpall(args, p); + + continue; + + } + + q = p; + + while (varchar(*q) || number(*q) || eqany(*q,COMMANDS)) + + q++; + + if (*q == '(') { /* procedure call */ + + if (proc[0] != '\0') { + + error("Too many procedure calls"); + + return(1); + + } + + scallf = 1; + + p = cpname(proc, p); + + p = cpall(args, p); + + continue; + + } + + if (*q == ':') { /* procedure name */ + + colonflag++; + + p = cpname(proc, p); + + continue; + + } + + if (*q == '$') { /* variable name */ + + p = cpname(var, p); + + continue; + + } + + if (((q-p == 1 && eqany(*p,COMMANDS) && + + (proc[0]=='\0' || eqany(*p, "abcd"))) || - (integ && eqany(*p,COMMANDS))|| eqany(*p, "+-")) +++ (integ && eqany(*p,COMMANDS)) || +++ eqany(*p, "+-?")) + + && !(*p=='-' && *(p+1) == '>')) + + { /* command */ + + cmd = *p++; - if (eqany(cmd, "acers")) { +++ if (eqany(cmd, "Macers")) { + + while(*p == ' ') + + p++; + + p = cpall(args, p); + + } + + continue; + + } + + /* otherwise, its a variable */ + + if (var[0] != '\0') { + + error("Too many variable names"); + + return(1); + + } + + p = cpname(var, p); +++ if (*p == '%') { +++ percentflag++; +++ p++; +++ } +++ if (eqstr(var, ".?")) { +++ var[1] = '\0'; +++ cmd = '?'; +++ } + + if (*p == '\n') { + + cmd = '/'; + + continue; + + } + + if (cmd == '\0') cmd = *p ? *p : '/'; + + p++; + + p = cpall(args,p); + + continue; + + } + + p++; /* otherwise ignore p */ + + } + + return(0); + +} diff --cc usr/src/cmd/sdb/defs.h index 0000000000,f3b55b3933,0000000000..3dc0b957bb mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/defs.h +++ b/usr/src/cmd/sdb/defs.h @@@@ -1,0 -1,197 -1,0 +1,199 @@@@ +++/* "@(#)defs.h 4.1 10/9/80" */ +++# + +/* + + * + + * UNIX debugger - common definitions + + * + + */ + + + + + + + +/* Layout of a.out file (fsym): + + * + + * header of 8 longwords + + * magic number 410 + + * text size ) + + * data size ) padded with 0 to multiple of 4 bytes + + * bss size ) + + * symbol table size + + * entry address + + * size of text relocation info + + * size of data relocation info + + * + + * + + * header: 0 + + * text: 32 + + * data: 32+textsize + + * text reloc: 32+textsize+datasize + + * data reloc: 32+textsize+datasize+textreloc + + * symbol table: 32+textsize+datasize+textreloc+datareloc + + * + + */ + + + +#include + +#include + +#include + +#include + +#include "mac.h" + +#include "mode.h" + + + + + +#define VARB 11 + +#define VARD 13 + +#define VARE 14 + +#define VARM 22 + +#define VARS 28 + +#define VART 29 + + + +#define COREMAGIC 0140000 + + + +/* access modes */ + +#define RD 0 + +#define WT 1 + + + +/* access spaces */ + +#define NSP 0 + +#define ISP 1 + +#define DSP 2 + + + +#define STAR 4 + +#define STARCOM 0200 + +#define DSYM 4 + +#define ISYM 4 + +#define ASYM 2 + +#define NSYM 0 + +#define ESYM (-1) + +#define BKPTSET 1 + +#define BKPTEXEC 2 + +#define SYMSIZ 100 + +#define MAXSIG 20 + + + +#define USERPS PSL + +#define USERPC PC + +#define BPT 03 + +#define TBIT 020 + +#define FD 0200 + + + +/* ptracew modes */ + +#define SETTRC 0 + +#define RDUSER 2 + +#define RIUSER 1 + +#define WDUSER 5 + +#define WIUSER 4 + +#define RUREGS 3 + +#define WUREGS 6 + +#define CONTIN 7 + +#define EXIT 8 + +#define SINGLE 9 + + + +#define FROFF (&(0->fpsr)) + +#define FRLEN 25 + +#define FRMAX 6 + + + +/* the quantities involving ctob() are located in the kernel stack. + +/* the others are in the pcb. + +*/ + +#define KSP 0 + +#define ESP 4 + +#define SSP 8 - #ifdef VAX135 +++#ifndef STD + +#define USP (ctob(UPAGES)-5*4) + +#define R0 (ctob(UPAGES)-18*4) + +#define R1 (ctob(UPAGES)-17*4) + +#define R2 (ctob(UPAGES)-16*4) + +#define R3 (ctob(UPAGES)-15*4) + +#define R4 (ctob(UPAGES)-14*4) + +#define R5 (ctob(UPAGES)-13*4) + +#define R6 (ctob(UPAGES)-12*4) + +#define R7 (ctob(UPAGES)-11*4) + +#define R8 (ctob(UPAGES)-10*4) + +#define R9 (ctob(UPAGES)-9*4) + +#define R10 (ctob(UPAGES)-8*4) + +#define R11 (ctob(UPAGES)-7*4) + +#define AP (ctob(UPAGES)-21*4) + +#define FP (ctob(UPAGES)-20*4) + +#define PC (ctob(UPAGES)-2*4) + +#define PSL (ctob(UPAGES)-1*4) + +#else + +#define USP (ctob(UPAGES)-5*4) + +#define R0 (ctob(UPAGES)-19*4) + +#define R1 (ctob(UPAGES)-18*4) + +#define R2 (ctob(UPAGES)-17*4) + +#define R3 (ctob(UPAGES)-16*4) + +#define R4 (ctob(UPAGES)-15*4) + +#define R5 (ctob(UPAGES)-14*4) + +#define R6 (ctob(UPAGES)-13*4) + +#define R7 (ctob(UPAGES)-12*4) + +#define R8 (ctob(UPAGES)-11*4) + +#define R9 (ctob(UPAGES)-10*4) + +#define R10 (ctob(UPAGES)-9*4) + +#define R11 (ctob(UPAGES)-8*4) + +#define AP (ctob(UPAGES)-7*4) + +#define FP (ctob(UPAGES)-6*4) + +#define PC (ctob(UPAGES)-2*4) + +#define PSL (ctob(UPAGES)-1*4) + +#endif + +#define P0BR 80 + +#define P0LR 84 + +#define P1BR 88 + +#define P1LR 92 + + + +#define MAXOFF 255 + +#define MAXPOS 80 + +#define MAXLIN 128 + +#define EOR '\n' + +#define SP ' ' + +#define TB '\t' + +#define QUOTE 0200 + +#define STRIP 0177 + +#define LOBYTE 0377 + +#define EVEN -2 + + + + + +#ifndef vax + +#define leng(a) ((long)((unsigned)(a))) + +#define shorten(a) ((int)(a)) + +#define itol(a,b) (itolws.I[0]=(a), itolws.I[1]=(b), itolws.L) + +#else + +#define leng(a) itol(0,a) + +#define shorten(a) ((short)(a)) + +#define itol(a,b) (itolws.I[0]=(b), itolws.I[1]=(a), itolws.L) + +#endif + + + + + + + +/* result type declarations */ + +L_INT inkdot(); + +SYMPTR lookupsym(); + +SYMPTR symget(); + +POS get(); + +POS chkget(); + +STRING exform(); + +L_INT round(); + +BKPTR scanbkpt(); + +VOID fault(); + + + + + +INT mkfault; + +INT executing; + +L_INT maxoff; + +L_INT maxpos; + +ADDR sigint; + +ADDR sigqit; + +INT wtflag; + +L_INT maxfile; + +L_INT maxstor; + +L_INT txtsiz; + +L_INT datsiz; + +L_INT datbas; + +L_INT stksiz; + +STRING errflg; + +INT magic; + +L_INT entrypt; + + + +CHAR lastc; + + + +STRING symfil; + +STRING corfil; + +MAP txtmap; + +MAP datmap; diff --cc usr/src/cmd/sdb/display.c index 0000000000,aa3d678347,0000000000..57a500b432 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/display.c +++ b/usr/src/cmd/sdb/display.c @@@@ -1,0 -1,503 -1,0 +1,525 @@@@ +++static char sccsid[] = "@(#)display.c 4.1 10/9/80"; + +#include "head.h" + +#include +++#include + +#include "cdefs.h" + +struct user u; + +BKPTR bkpthead; + + +++#ifdef FLEXNAMES +++#define bread(a,b,c) stread(b,c) +++#define blseek(a,b,c) stseek(b,c) +++#endif +++ + +/* initialize frame pointers to top of call stack */ +++/* MACHINE DEPENDENT */ + +struct proct * + +initframe() { + + argp = *(ADDR *) (((ADDR) &u) + AP); + + frame = *(ADDR *) (((ADDR) &u) + FP); + + callpc = *(ADDR *) (((ADDR) &u) + PC); + + if ((frame == 0) || (frame & 0xf0000000 != 0x70000000)) + + return(badproc); - return(adrtoproc(callpc++)); /* ++ because UNIX backs up instrs */ +++ return(adrtoprocp(callpc++)); /* ++ because UNIX backs up instrs */ + +} + + + + + +struct proct * + +nextframe() { + + callpc = get(frame+16, DSP); + + argp = get(frame+8, DSP); + + frame = get(frame+12, DSP) & EVEN; + + if (callpc > 0x70000000) { /* error handler kludge */ + + callpc = get(argp+12, DSP); + + argp = get(frame+8, DSP); + + frame = get(frame+12, DSP) & EVEN; + + } + + if ((frame == 0) || (frame & 0xf0000000 != 0x70000000)) + + return(badproc); - return(adrtoproc(callpc-1)); +++ return(adrtoprocp(callpc-1)); + +} + + + +/* returns core image address for variable */ +++/* MACHINE DEPENDENT */ + +ADDR + +formaddr(class, addr) + +register char class; + +ADDR addr; { + +if (debug) printf("formaddr(%o, %d)\n", class & 0377, addr); + + switch(class & STABMASK) { + + case N_RSYM: + + return(stackreg(addr)); + + case N_GSYM: + + case N_SSYM: + + case N_STSYM: + + case N_LCSYM: + + return(addr); + + + + case N_PSYM: + + return(argp+addr); + + + + case N_LSYM: + + return(frame+addr); + + + + default: + + printf("Bad class in formaddr: 0%o", + + class & 0377); + + return(0); + + } + +} + + + +char class; + + + +/* + + * stackreg(reg): + + * If the register for the current frame is somewhere on the stack + + * then return the address of where it is, otherwise its still in + + * the register so return the register number. + + * We distinguish the two by noting that register numbers are less + + * than 16 and that stack addresses are greater. + + * + + * MACHINE DEPENDENT + + */ + +ADDR + +stackreg(reg) { + + register int curframe, regfl, mask, i; + + struct proct *procp; + + ADDR regaddr; + + + + curframe = frame; + + regaddr = reg; + + regfl = 0x10000 << reg; + + for (procp=initframe(); frame!=curframe; procp=nextframe()) { + + if (procp == badproc) { + + error("Stackreg error: frame"); + + return(-1); + + } + + mask = get(frame+4, DSP); + + if (mask & regfl) { + + regaddr = frame + 20; + + for (i=0; i> 1; + + } + + if (!(mask & 0x10000)) { + + error("Stackreg error: contents"); + + return(-1); + + } + + } + + } + + return(regaddr); + +} + + + +/* returns address of proc:var. Sets externals class and subflag */ + +ADDR + +varaddr(proc, var) + +char *proc, *var; { + + return(findvar(proc, var, "", 0)); + +} + + + +/* + + * displays values of variables matching proc:var, + + * returns its address + + */ + +ADDR + +dispvar(proc, var, fmt) + +char *proc, *var, *fmt; { + + return(findvar(proc, var, fmt, 1)); + +} + + + +/* + + * Find and print values of all variables matching proc:var + + * using specified format. + + * Returns address of last matching variable. + + * + + * prvar==0 => no output, + + * prvar==1 => output value, + + * prvar==2 => output addr + + */ + +ADDR + +findvar(proc, var, fmt, prvar) + +char *proc, *var, *fmt; { + + ADDR addr = -1, a = -1; + + int metaflag = 0, match=0, nullflag=0, depthcnt = -1; + + char *comblk; + + register struct proct *procp; + + +++ if (percentflag) { /* kludge for register names */ +++ return(regout(var, prvar, fmt)); +++ } +++ + + if (var[0] == '\0') { + + error("Unexpected null variable name"); + + return(-1); + + } + + + + metaflag = eqany('*', proc) || eqany('?', proc) || + + eqany('*', var) || eqany('?', var); + + + + if (proc[0] == '\0') { + + nullflag++; + + proc = curproc()->pname; + + } + + + + comblk = colonflag ? "" : "*"; + + + + if (integ && !eqany(var[0], "->.[")) { + + depthcnt = integ; + + } + + if (integ) { + + if (eqany(var[0], "->.[")) + + match++; + + else + + depthcnt = integ; + + } + + + + procp = initframe(); + + if (!eqany(var[0], "->.[") && !(nullflag && colonflag)) { + + do { + + if (eqpat(proc, procp->pname)) { + + match++; + + if (--depthcnt==0 || integ==0) { + + a = outvar(procp->pname, var, fmt, + + metaflag, integ, N_GSYM, + + 0, prname, comblk, prvar); + + if (a != -1) + + addr = a; + + if (depthcnt == 0) + + break; + + } + + } + + } while ((procp=nextframe()) != badproc); + + } + + + + if ((colonflag || metaflag || a == -1) && + + (nullflag || eqpat(proc, ""))) { + + a = outvar("", var, fmt, metaflag, integ, + + N_GSYM, 0, prname, comblk, prvar); + + if (a != -1) { + + addr = a; + + match++; + + } + + } + + + + if (match==0 && colonflag) { + + procp = initframe(); + + do { + + if (eqstr(curproc()->pname, procp->pname)) + + break; + + } while ((procp=nextframe()) != badproc); + + a = outvar(curproc()->pname, var, fmt, metaflag, + + integ, N_GSYM, 0, prname, + + nullflag ? "_BLNK_" : proc, prvar); + + if (a != -1) { + + addr = a; + + match++; + + } + + } + + +++ if (addr == -1 && match == 0) { +++ addr = extoutvar(var, fmt, metaflag, prvar); +++ if (addr != -1) +++ return(addr); +++ } + + if (match == 0) { + + printf("%s not an active procedure\n", proc); + + return(-1); + + } + + if (addr == -1) { + + if (var[0] == '.') + + var++; + + if (proc[0]) - printf("%.8s:%s not found\n", proc, var); +++#ifndef FLEXNAMES +++ printf("%.16s:%s not found\n", proc, var); +++#else +++ printf("%s:%s not found\n", proc, var); +++#endif + + else + + printf("%s not found\n", var); + + return(-1); + + } + + return(addr); + +} + + + +char * + +typetodesc(type, subflag) + +short type; { + + register int ptr, ftn, ary; + + register char *desc; + + + + static char *typedesc[] = { + + "d", /* undef */ + + "d", /* farg */ + + "c", /* char */ + + "hd", /* short */ + + "d", /* int */ + + "ld", /* long */ + + "f", /* float */ + + "g", /* double */ + + "d", /* strty */ + + "d", /* unionty */ + + "d", /* enumty */ + + "d", /* moety */ + + "bu", /* uchar */ + + "hu", /* ushort */ + + "u", /* unsigned */ + + "lu", /* ulong */ + + "d" /* ? */ + + }; + + + + ptr = ftn = ary = 0; + + + + desc = typedesc[type&BTMASK]; + + for (; type & TMASK; type = DECREF(type)) { + + if (ISPTR(type)) ptr++; + + else if (ISFTN(type)) ftn++; + + else if (ISARY(type)) ary++; + + } + + + + if ((ptr-subflag == 1 || ary-subflag == 1) && desc[0] == 'c') + + return("s"); + + if (debug) + + printf ("PTR %d; FTN %d; ARY %d; DESC %s\n",ptr,ftn,ary,desc); + + if (ptr + ary == subflag) + + return(desc); + + if (ptr) return("x"); + + if (ptr==1 && ftn==1) return("p"); + + return(desc); + +} + + + +typetosize(type, stsize) + +short type; { + + register int ptr, ftn, ary; + + register int size; + + + + static char typesize[] = { + + 4, /* undef */ + + 4, /* farg */ + + 1, /* char */ + + 2, /* short */ + + WORDSIZE, /* int */ + + 4, /* long */ + + 4, /* float */ + + 8, /* double */ + + 0, /* strty */ + + 0, /* unionty */ + + 4, /* enumty */ + + 4, /* moety */ + + 1, /* uchar */ + + 2, /* ushort */ + + 4, /* unsigned */ + + 4, /* ulong */ + + 4 /* ? */ + + }; + + + + ptr = ftn = ary = 0; + + + + size = typesize[type&BTMASK]; + + for (; type & TMASK; type = DECREF(type)) { + + if (ISPTR(type)) ptr++; + + else if (ISFTN(type)) ftn++; + + else if (ISARY(type)) ary++; + + } + + + + if (debug) + + printf ("PTR %d; FTN %d; ARY %d; SIZE %d; STSIZE %d\n", + + ptr,ftn,ary,size,stsize); + + if (ptr>1) return(4); + + if (size == 0) return(stsize); + + else return(size); + +} + + + + + +/* print breakpoints */ + +prbkpt() { + + register BKPTR bkptr; + + register int cnt; + + char *cmdp; + + + + cnt = 0; + + + + for (bkptr = bkpthead; bkptr; bkptr=bkptr->nxtbkpt) + + if (bkptr->flag) { + + cnt++; - printbkpt("", adrtoprocp(bkptr->loc)->pname, - adrtolineno(bkptr->loc)); +++ printbkpt("", adrtoprocp(bkptr->loc), bkptr->loc); + + cmdp = bkptr->comm; + + if (*cmdp != '\n') { + + printf(" <"); + + while (*cmdp != '\n') + + printf("%c", *cmdp++); + + printf(">\n"); + + } + + else + + printf("\n"); + + } + + if (cnt == 0) + + printf("No breakpoints set\n"); + +} + + + +/* interactively delete breakpoints */ + + + +idbkpt() { + + register BKPTR bkptr; + + register int yesflg, cnt; + + register char c; + + + + cnt = 0; + + + + for (bkptr = bkpthead; bkptr; bkptr=bkptr->nxtbkpt) + + if (bkptr->flag) { - printbkpt(" ? ", adrtoprocp(bkptr->loc)->pname, - adrtolineno(bkptr->loc)); +++ printbkpt(" ? ", adrtoprocp(bkptr->loc), bkptr->loc); + + yesflg = 0; + + cnt++; + + do { + + c = getchar(); + + if (c == 'y' || c == 'd') yesflg++; + + } while (c != '\n'); + + if (yesflg) + + bkptr->flag = 0; + + } + + if (cnt == 0) + + printf("No breakpoints set\n"); + +} + + + +/* delete all breakpoints */ + + + +dabkpt() { + + register BKPTR bkptr; + + + + for (bkptr = bkpthead; bkptr; bkptr=bkptr->nxtbkpt) + + bkptr->flag = 0; + +} - printbkpt(s, name, lineno) - char *s, *name; { - if (name[0] == '_') - printf("%.7s:", name+1); - else - printf("%.8s:", name); - - if (lineno != -1) - printf("%d%s", lineno, s); - else - printf("%s", s); +++ +++/* +++ * Print name of breakpoint for a, b, d commands: +++ */ +++printbkpt(s, procp, dot) +++char *s; struct proct *procp; ADDR dot; { +++ adrtolineno(dot); +++ if (dot != lnfaddr) +++ printf("0x%x (", dot); +++ prlnoff(procp, dot); +++ if (dot != lnfaddr) +++ printf(")"); +++ printf("%s", s); + +} + + + +/* print call frame */ + +prframe() { + + prfrx(0); + +} + + + +/* set top to print just the top procedure */ + +prfrx(top) { + + int narg; + + long offset; + + register char class; + + register int endflg; + + char *p; + + struct proct *procp; + + struct nlist stentry; + + + + if ((procp = initframe()) == badproc) return; + + do { + + if (get(frame+12, DSP) == 0) return; + + p = procp->pname; + + if (eqstr("__dbsubc", p)) return; + + if (p[0] == '_') { + + endflg = 1; - printf("%.7s(", p+1); +++#ifndef FLEXNAMES +++ printf("%.15s(", p+1); +++#else +++ printf("%s(", p+1); +++#endif + + } + + else { - printf("%.8s(", p); +++#ifndef FLEXNAMES +++ printf("%.16s(", p); +++#else +++ printf("%s(", p); +++#endif + + endflg = 0; + + } + + if (endflg == 0) { + + offset = procp->st_offset; + + blseek(&sbuf, offset, 0); + + do { + + if (bread(&sbuf, &stentry, sizeof stentry) < + + sizeof stentry) { + + endflg++; + + break; + + } + + class = stentry.n_type & STABMASK; + + } while (class == N_FUN); + + while (class != N_PSYM) { + + if (bread(&sbuf, &stentry, sizeof stentry) < + + sizeof stentry) { + + endflg++; + + break; + + } + + class = stentry.n_type & STABMASK; + + if (class == N_FUN) { + + endflg++; + + break; + + } + + } + + } + + + + narg = get(argp, DSP); + + if (narg & ~0xff) narg = 0; + + argp += WORDSIZE; + + while (narg) { + + if (endflg) { + + printf("%d", get(argp, DSP)); + + argp += 4; + + } else { + + int length; - printf("%.8s=", stentry.n_name); - dispx(argp, "", N_GSYM, stentry.n_desc, 0, 0); +++#ifndef FLEXNAMES +++ printf("%.16s=", stentry.n_name); +++#else +++ printf("%s=", stentry.n_un.n_name); +++#endif +++ dispx(argp, "", N_GSYM, stentry.n_desc, +++ 0, 0, DSP); + + length = typetosize(stentry.n_desc, 0); + + if (length > WORDSIZE) + + argp += length; + + else + + argp += WORDSIZE; + + } + + do { + + if (endflg) break; + + if (bread(&sbuf, &stentry, sizeof stentry) < + + sizeof stentry) { + + endflg++; + + break; + + } + + class = stentry.n_type & STABMASK; + + if (class == N_FUN) { + + endflg++; + + break; + + } + + } while (class != N_PSYM); + + l1: if (--narg != 0) printf(","); + + } + + printf(")"); + + if (debug) printf(" @ 0x%x ", callpc); + + if (procp->sfptr != badfile) + + printf(" [%s:%d]", adrtofilep(callpc-1)->sfilename, + + adrtolineno(callpc-1)); + + printf("\n"); + + } while (((procp = nextframe()) != badproc) && !top); + +} + + - STRING signals[] = { - "", - "hangup", - "interrupt", - "quit", - "illegal instruction", - "trace/BPT", - "IOT", - "EMT", - "floating exception", - "killed", - "bus error", - "memory fault", - "bad system call", - "broken pipe", - "alarm call", - "terminated", - }; + +INT signo; +++STRING signals[]; +++extern nsig; +++sigprint() +++{ + + - sigprint() { - printf("%s", signals[signo]); +++ if (signo < nsig) +++ printf("%s", signals[signo]); +++ else +++ printf("signal %d???", signals[signo]); + +} - diff --cc usr/src/cmd/sdb/docomm.c index 0000000000,09b6ecb5db,0000000000..1e20b489df mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/docomm.c +++ b/usr/src/cmd/sdb/docomm.c @@@@ -1,0 -1,419 -1,0 +1,514 @@@@ +++static char sccsid[] = "@(#)docomm.c 4.1 10/9/80"; + +#include + +#include "head.h" + +#include +++#include + + + +struct user u; + +L_INT cntval; + +INT signo; + +INT adrflg; + +INT pid; + +ADDR userpc; + +char *s; - enum {NOCOM, PRCOM, DSCOM} lastcom; +++enum {NOCOM, PRCOM, DSCOM, DSICOM} lastcom; +++ /* last command: nothing noteworthy, print source, +++ display variable, display instruction */ + + + +docommand() { + + register char *p; + + register int i; + + register ADDR addr, bkaddr; + + struct proct *procp; +++ char s[4]; + + + + cntval = 1; + + adrflg = 0; + + errflg = 0; + + + + if (scallf) { + + doscall(); + + setcur(1); + + lastcom = NOCOM; + + return; + + } + + + + if (reflag) { /* search for regular expression */ + + dore(); + + lastcom = PRCOM; + + return; + + } + + + + if (cmd == '\0') { + + if (integ != 0 && var[0] != '\0') { + + error("Invalid command (1)"); + + return; + + } + + if (integ != 0) { /* print line number */ + + ffind(integ); + + fprint(); + + lastcom = PRCOM; + + return; + + } + + if (var[0] != 0) { + + printf("Unexpected null command\n"); + + return; + + } + + } + + + + switch (cmd) { + + + + case 'Y': + + debug = !debug; + + break; + + + + case 'V': + + version(); + + break; + + +++ case 'M': +++ if (args[0]) { +++ setmap(args); +++ } else { +++ printmap("? map", &txtmap); +++ printmap("/ map", &datmap); +++ } +++ break; +++ +++ case 'x': +++ printregs(); +++ break; +++ +++ case 'X': +++ printpc(); +++ break; +++ + + case 'a': + + if (integ) { + + cpstr(args, "l\n"); + + } else if (proc[0]) { + + cpall(args, "T\n"); + + } else { + + error("Bad arguments"); + + break; + + } + + goto setbrk; + + break; + + + + case 'l': + + setcur(1); + + lastcom = NOCOM; + + break; + + + + case 'T': + + prfrx(1); + + lastcom = NOCOM; + + break; + + + + case 't': + + prframe(); + + lastcom = NOCOM; + + break; + + + + case 'e': + + p = args; + + if (*p == '\0') { - printf("%.8s() in \"%s\"\n", +++#ifndef FLEXNAMES +++ printf("%.16s() in \"%s\"\n", + + curproc()->pname, curfile); +++#else +++ printf("%s() in \"%s\"\n", +++ curproc()->pname, curfile); +++#endif + + break; + + } + + + + while (*p != '\0') + + if (*p++ == '.') goto l1; + + /* argument is procedure name */ + + procp = findproc(args); + + if ((procp->pname[0] != '\0') && (procp->sfptr != badfile)) { + + finit(adrtofilep(procp->paddr)->sfilename); + + ffind(procp->lineno); + + } + + else printf("Can't find %s\n", args); - printf("%.8s() in \"%s\"\n", curproc()->pname, curfile); - lastcom = NOCOM; +++#ifndef FLEXNAMES +++ printf("%.16s() in \"%s\"\n", curproc()->pname, curfile); +++#else +++ printf("%s() in \"%s\"\n", curproc()->pname, curfile); +++#endif +++ lastcom = PRCOM; + + break; + + + + l1: /* argument is filename */ + + finit(args); + + printf("\"%s\"\n", curfile); - lastcom = NOCOM; +++ lastcom = PRCOM; + + break; + + + + case 'p': + + if (integ) ffind(integ); + + fprint(); + + lastcom = PRCOM; + + break; + + + + case 'q': + + exit(0); + + + + case 'w': + + if (integ) ffind(integ); + + i = fline; + + fback(WINDOW/2); + + fprintn(WINDOW); + + ffind(i); + + lastcom = PRCOM; + + break; + + - case 'X': +++ case 'Q': + + prdebug(); + + break; + + + + case 'z': + + if (integ) ffind(integ); + + fprintn(WINDOW); + + lastcom = PRCOM; + + break; + + + + case '-': + + fback(integ ? integ : 1); + + fpargs(); + + lastcom = PRCOM; + + break; + + + + case '+': + + fforward(integ ? integ : 1); + + fpargs(); + + lastcom = PRCOM; + + break; + + + + case '\n': + + switch (lastcom) { + + case PRCOM: + + fforward(1); + + fprint(); + + break; + + case DSCOM: + + oaddr += oincr ? oincr : typetosize(otype, WORDSIZE); + + printf("0x%x/ ", oaddr); + + dispf((ADDR) oaddr, odesc, - oclass == N_RSYM ? oclass : N_GSYM, otype, 0, 0); +++ oclass == N_RSYM ? oclass : N_GSYM, otype, 0, 0, DSP); +++ break; +++ case DSICOM: +++ dot += oincr; +++ prisploc(); +++ dispi(dot, odesc, N_GSYM, 0, 0); + + break; + + } + + break; + + + + case '\004': - fforward(1); - printf("\b"); - fprintn(WINDOW); - lastcom = PRCOM; +++ if (!isatty(0)) +++ exit(0); +++ switch (lastcom) { +++ case PRCOM: +++ fforward(1); +++ printf("\b"); +++ fprintn(WINDOW); +++ lastcom = PRCOM; +++ break; +++ case DSICOM: +++ printf("\b"); +++ for (i=0; iflag = flagss; + + scallx = 0; + + error("Procedure killed"); + + longjmp(env, 0); + + } else { + + dopcs('k'); + + printf("\n"); + + lastcom = NOCOM; + + break; + + } + + + + case 'B': + + prbkpt(); + + break; + + + + case 'b': + + setbrk: + + if (proc[0] == '\0' && integ == 0) { + + integ = fline; + + } - dot = getaddr(proc,integ); +++ setdot(); + + if (dot == -1 || dot == 0) { + + error("Cannot set breakpoint"); + + break; + + } + + dopcs('b'); - s = " b\n"; +++ s[0] = ' '; +++ s[1] = cmd; +++ s[2] = '\n'; +++ s[3] = 0; + + s[1] = cmd; - printbkpt(s, adrtoprocp(dot)->pname, - adrtolineno(dot)); +++ printbkpt(s, adrtoprocp(dot), dot); + + break; + + + + case 'd': + + if (proc[0] == '\0' && integ == 0) { + + idbkpt(); + + break; + + } - dot = getaddr(proc,integ); +++ setdot(); + + if (dot == -1) { + + error("Non existent breakpoint"); + + break; + + } + + dopcs('d'); + + break; + + + + case 'D': + + dabkpt(); + + error("All breakpoints deleted"); + + break; + + + + case 'm': + + addr = varaddr(proc[0] ? proc : curproc()->pname, var); + + printf("stopped with value %d\n", monex(addr, 'd')); + + setcur(1); + + lastcom = NOCOM; + + break; + + +++ case '?': +++ if (!(var[0] == '.' && var[1] == '\0')) +++ setdot(); +++ if (errflg) { +++ error(errflg); +++ break; +++ } +++ prisploc(); +++ dispi(dot, args[0] ? args : "i", N_GSYM, 0, 0); +++ lastcom = DSICOM; +++ break; +++ + + case '/': + + if (var[0] == '.' && var[1] == '\0') { + + if (integ == 0) integ = oaddr; + + dispf((ADDR) integ, args[0] ? args : odesc, - oclass == N_RSYM ? oclass : N_GSYM, otype, 0, 0); +++ oclass == N_RSYM ? oclass : N_GSYM, otype, 0, 0, DSP); + + oaddr = integ; + + } else + + if (integ && (var[0] == '\0')) { - dispf((ADDR) integ, args, N_GSYM, 0, 0, 0); +++ dispf((ADDR) integ, args, N_GSYM, 0, 0, 0, DSP); + + oaddr = integ; + + cpstr(odesc, args); + + oclass = N_GSYM; + + otype = 0; + + } else + + dispvar(proc, var, args); + + lastcom = DSCOM; + + break; + + + + case '=': + + if (var[0] == '\0') { + + if (proc[0]) { + + addr = getaddr(proc, integ); + + if (addr == -1) { + + error("Unknown address"); + + break; + + } + + } + + else + + addr = integ; - dispf(addr, args[0] ? args : "x", 0, -1, 0, 0); +++ dispf(addr, args[0] ? args : "x", 0, -1, 0, 0, DSP); + + } else + + findvar(proc, var, args[0] ? args : "x", 2); + + break; + + + + case '!': + + if (var[0] == '\0') + + addr = getaddr(proc, integ); + + else + + addr = varaddr(proc, var); + + if (addr == -1) + + error("Unknown variable"); + + else { + + if (number(args[0]) || eqany(args[0], ".-")) { + + char *p; + + double atof(); + + union { + + struct{ + + int w1, w2; - }; - struct { - double d; - }; +++ } ww; +++ double d; + + } dbl; + + + + p = (args[0] == '-') ? args+1 : args; + + for (; *p != '.' && *p != 'e'; p++) { + + if (!number(*p)) goto l2; + + } + + dbl.d = atof(args); - putval(addr, 'd', dbl.w1); +++ putval(addr, 'd', dbl.ww.w1); + + if (typetodesc(sl_type,0)[0] == 'g') - putval(addr+WORDSIZE, 'd', dbl.w2); +++ putval(addr+WORDSIZE, 'd', dbl.ww.w2); + + break; + + } - l2: if (sl_class == N_RSYM && addr < 16) +++l2: if (percentflag) +++ *(ADDR *)(((ADDR)&u)+addr) = argvalue(args); +++ else if (sl_class == N_RSYM && addr < 16) + + putreg(addr,typetodesc(sl_type,subflag)[0], + + argvalue(args)); + + else + + putval(addr,typetodesc(sl_type,subflag)[0], + + argvalue(args)); + + } + + lastcom = NOCOM; + + break; + + + + case '"': + + printf(args); + + break; + + } + +} + + + +fpargs() { + + register int i; + + + + switch(args[0]) { + + case 'p': + + case '\0': + + fprint(); + + break; + +case 'w': + + i = fline; + + fback(WINDOW/2); + + fprintn(WINDOW); + + ffind(i); + + break; + + case 'z': + + fprintn(WINDOW); + + break; + + } + +} +++ +++MSG BADTXT; +++/* Used by a, b, c, C, d and g commands to find linenumber */ +++setdot() { +++ if (ncolonflag) { +++ dot = integ; +++ get(dot, ISP); +++ if (errflg) +++ dot = -1; +++ } else { +++ dot = getaddr(proc, integ); +++ if (dot == -1) +++ errflg = "Bad line number"; +++ } +++} diff --cc usr/src/cmd/sdb/fio.c index 0000000000,82c3b58252,0000000000..1cf1275fe6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/fio.c +++ b/usr/src/cmd/sdb/fio.c @@@@ -1,0 -1,176 -1,0 +1,295 @@@@ +++static char sccsid[] = "@(#)fio.c 4.1 10/9/80"; +++/* +++ * sdb - a symbolic debugger for unix - source file access routines. +++ */ + +#include "head.h" +++#include + + + +/* - * These procedures manage the source files examined by sdb. +++ * These procedures manage the source files examined by sdb, +++ * providing access to lines by number and utilities for printing +++ * and scrolling. One file is kept open by these routines, and +++ * line index tables are maintained for all files which have been +++ * ``current'' at any time so far. This makes line access trivial, +++ * since the location of each line in the files is known, +++ * although we get ``burned'' if the file is changed. +++ * SHOULD WATCH THE MODTIME OF FILES AND REINDEX IF IT CHANGES. +++ */ +++ +++/* +++ * Structure for files which have been ``indexed''. +++ * Contains a pointer to the file name, a pointer to an +++ * array of seek pointers for the lines in the file, +++ * and a next link in a chain of these for all files we have indexed, +++ * The currently open file is cinfo->; the chain of active files is finfo. +++ */ +++struct finfo { +++ char *name; /* name of this file w/o common pfx */ +++ off_t *lines; /* array of seek pointers */ +++/* line i stretches from lines[i-1] to lines[i] - 1, if first line is 1 */ +++ int nlines; /* number of lines in file */ +++/* lines array actually has nlines+1 elements, so last line is bracketed */ +++ struct finfo *next; /* link in chain of known files */ +++} *finfo, *cfile; +++FILE *FIO; /* current open file (only 1 now) */ +++char fibuf[BUFSIZ]; +++/* +++ * We use stdio when first reading the file, but thereafter +++ * use our own routines, because we want to be able +++ * to read backwards efficiently and avoid a tell() system +++ * call on each line. Fseekpt remebers where we are in the current +++ * file. + + */ +++off_t fseekpt; + + - /* Change the current source file to `name'. */ +++/* +++ * Make ``name'' the current source file, if it isn't already. +++ * If we have never seen this file before, then we create a finfo +++ * structure for it indexing the lines (this requires reading the +++ * entire file and building an index, but is well worth it since +++ * we otherwise have to brute force search the files all the time.) +++ */ + +finit(name) - char *name; { - register char *p, *q; +++ char *name; +++{ +++ char buf[BUFSIZ]; +++ register off_t *lp; + + - if (fiobuf.fd) close(fiobuf.fd); - q = name; - for (p=fp; *q; *p++ = *q++) ; - *p = 0; - if ((fiobuf.fd = open(filework,0)) == -1) { +++ if (cfile && !strcmp(cfile->name, name)) +++ return; /* its already current, do nothing */ +++ /* IT WOULD BE BETTER TO HAVE A COUPLE OF FILE DESCRIPTORS, LRU */ +++ if (FIO) { +++ fclose(FIO); +++ FIO = NULL; +++ } +++ /* +++ * Paste the given name onto the common prefix (directory path) +++ * to form the full name of the file to be opened. +++ */ +++ strcpy(fp, name); +++ if ((FIO = fopen(filework, "r")) == NULL) { + + nolines = 1; + + perror(filework); + + return; + + } - binit(&fiobuf); - cpstr(curfile, name); - for (p=fbuf;;p++) { - if (bread(&fiobuf,p,1) <= 0) { - nolines = 1; - printf("%s: No lines in file\n", name); +++ setbuf(FIO, fibuf); +++ fseekpt = -BUFSIZ; /* putatively illegal */ +++ strcpy(curfile, name); +++ /* +++ * See if we have alread indexed this file. +++ * If so, nothing much to do. +++ */ +++ for (cfile = finfo; cfile; cfile = cfile->next) +++ if (!strcmp(cfile->name, name)) + + return; - } - if (*p == '\n') break; +++ /* +++ * Create a structure for this (new) file. +++ * Lines array grows 100 lines at a time. +++ * 1 extra so last line is bracketed. +++ */ +++ cfile = (struct finfo *)sbrk(sizeof (struct finfo)); +++ lp = cfile->lines = (off_t *)sbrk(101 * sizeof (off_t)); +++ *lp++ = 0; /* line 1 starts at 0 ... */ +++ cfile->nlines = 0; +++ /* IT WOULD PROBABLY BE FASTER TO JUST USE GETC AND LOOK FOR \n */ +++ while (fgets(buf, sizeof buf, FIO)) { +++ if ((++cfile->nlines % 100) == 0) +++ sbrk(100 * sizeof (off_t)); +++ /* +++ * Mark end of the cfile->nlines'th line +++ */ +++ lp[0] = lp[-1] + strlen(buf); +++ lp++; + + } - fline = 1; - maxfline = 0; - nolines = 0; - } - - /* Make the next line current. */ - fnext() { - register char *p; - - if (nolines){ +++ if (cfile->nlines == 0) { +++ printf("%s: no lines in file\n", filework); +++ cfile = 0; + + return; + + } - for(p=fbuf;;p++) { - if (bread(&fiobuf,p,1) <= 0) { - p--; - blseek(&fiobuf,0L,0); - fline = 0; - continue; - } - if (*p == '\n') break; - } - fline++; +++ /* +++ * Allocate space for the name, making sure to leave the +++ * break on a word boundary. +++ * IT WOULD BE MUCH BETTER TO USE MALLOC AND REALLOC IN SDB. +++ */ +++ sbrk(lp + ((strlen(name)+sizeof(off_t)-1)&~(sizeof(off_t)-1))); +++ strcpy(cfile->name = (char *)lp, name); +++ cfile->next = finfo; +++ finfo = cfile; + +} + + +++/* +++ * Get the current line (fline) into fbuf +++ */ +++fgetline() +++{ +++ register off_t *op = &cfile->lines[fline-1]; +++ int o, n; + + - /* Make the previous line current. */ - fprev() { - char c; - register int i; - - if (nolines){ +++ n = op[1] - op[0]; +++ fbuf[n] = 0; +++ /* +++ * Case 1. Line begins in current buffer. +++ * +++ * Compute the number of characters into the buffer where +++ * the line starts. If this offset plus its length is greater +++ * than BUFSIZ, then this line splits across a buffer boundary +++ * so take the rest of this buffer and the first part of the next. +++ * Otherwise just take a chunk of this buffer. +++ */ +++ if (*op >= fseekpt && *op < fseekpt + BUFSIZ) { +++case1: +++ o = op[0] - fseekpt; +++ if (o + n > BUFSIZ) { +++ strncpy(fbuf, fibuf+o, BUFSIZ-o); +++ fseekpt += BUFSIZ; +++ read(fileno(FIO), fibuf, BUFSIZ); +++ strncpy(fbuf+BUFSIZ-o, fibuf, n-(BUFSIZ-o)); +++ } else +++ strncpy(fbuf, fibuf+o, n); + + return; + + } - for(i=0; i<3; i++) { - for (;;) { - if (bread(&fiobuf, &c+1, -1) <= 0) { - if (maxfline) blseek(&fiobuf,0L,2); - else { - blseek(&fiobuf,0L,0); - for(;;) { - if (bread(&fiobuf,&c,1)<=0) - break; - if (c == '\n') maxfline++; - } - } - } - if (c == '\n') break; - } +++ /* +++ * Case 2. Line ends in current buffer. +++ * +++ * If the line ends in this buffer (but doesn't begin in +++ * it or else we would have had case 1) take the beginning +++ * part of the buffer (end of the line) and then back up and +++ * get the rest of the line from the end of the previous block. +++ */ +++ if (op[1]-1 >= fseekpt && op[1] <= fseekpt+BUFSIZ) { +++ o = op[1] - fseekpt; +++ strncpy(fbuf+n-o, fibuf, o); +++ fseekpt -= BUFSIZ; +++ lseek(fileno(FIO), fseekpt, 0); +++ read(fileno(FIO), fibuf, BUFSIZ); +++ strncpy(fbuf, fibuf+op[0]-fseekpt, n-o); +++ return; + + } - bread(&fiobuf, &c, 1); /* eat the '\n' */ - - fline -= 2; - if (fline < 0) fline = maxfline - 1; +++ /* +++ * Case 3. Line not in current buffer at all. +++ * +++ * Read in the buffer where the line starts and then go +++ * back and handle as case 1. +++ */ +++ fseekpt = (op[0] / BUFSIZ) * BUFSIZ; +++ lseek(fileno(FIO), fseekpt, 0); +++ read(fileno(FIO), fibuf, BUFSIZ); +++ goto case1; +++} +++ +++/* +++ * Advance current line, end-around (like for / search). +++ */ +++fnext() +++{ + + - fnext(); +++ if (cfile == 0) +++ return; +++ if (fline == cfile->nlines) { +++ fline = 1; +++ } else +++ fline++; +++ fgetline(); + +} + + +++/* +++ * Retreat the current line, end around. +++ */ +++fprev() +++{ + + - /* Print the current line. */ - fprint() { +++ if (cfile == 0) +++ return; +++ if (fline == 1) +++ fline = cfile->nlines; +++ else +++ fline--; +++ fgetline(); +++} +++ +++/* +++ * Print the current line. +++ */ +++fprint() +++{ + + register char *p; + + - if (nolines){ +++ if (cfile == 0) { + + error("No lines in file"); + + return; + + } - printf("%d: ", fline); - p = fbuf; - while(putchar(*p++) != '\n') - ; +++ printf("%d: %s", fline, fbuf); + +} + + - /* Make line `num' current. */ +++/* +++ * Make line `num' current. +++ */ + +ffind(num) - register int num; { - register int i, ofline; +++ register int num; +++{ + + - if (nolines){ +++ if (cfile == 0) + + return; +++ if (num > cfile->nlines) +++ error("Not that many lines in file"); +++ else if (num <= 0) +++ error("Zero or negative line?"); +++ else { +++ fline = num; +++ fgetline(); + + } - ofline = fline; - if (num>fline) - for (i=fline; imaxfline) goto bad; - - return; - - bad: error("Not that many lines in file"); - ffind(ofline); + +} + + - /* Go back n lines. */ - fback(n) { +++/* +++ * Go back n lines. +++ */ +++fback(n) +++{ + + int i; + + - if (nolines){ - return(0); - } - for (i=0; i fline - 1) +++ n = fline - 1; +++ fline -= n; +++ fgetline(); +++ return (n); + +} + + - /* Go forwards n lines. */ - fforward(n) { - int i; +++/* +++ * Go forwards n lines. +++ */ +++fforward(n) +++ int n; +++{ +++ register int fnext; + + - if (nolines){ +++ if (cfile == 0) + + return(0); - } - for (i=0; i cfile->nlines) +++ n = cfile->nlines - fline; +++ fline += n; +++ fgetline(); +++ return (n); + +} + + - /* Print n lines. */ - fprintn(n) { - int i; +++/* +++ * Print (upto) n lines, returning number printed. +++ */ +++fprintn(n) +++ int n; +++{ +++ register int i; + + - if (nolines){ +++ if (cfile == 0) { + + error("No lines in file"); - return(0); +++ return (0); + + } - for (i=0; inlines || i == n) +++ return(i); + + fnext(); - if (fline == 1) break; + + } - fprev(); - return(i); +++ return (n); + +} diff --cc usr/src/cmd/sdb/head.h index 0000000000,b492c813b5,0000000000..1b02dd4b97 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/head.h +++ b/usr/src/cmd/sdb/head.h @@@@ -1,0 -1,122 -1,0 +1,144 @@@@ - - #include - #include - #include "sgtty.h" +++/* "@(#)head.h 4.1 10/9/80" */ + +#include + +#define PAGSIZ (CLSIZE*NBPG) - #include "bio.h" +++#include +++#include +++#include +++#include "old.h" + +#include "defs.h" + + + +/* input line decoding */ + +char proc[30]; /* procedure name */ + +int integ; /* count or number in input */ + +char cmd; /* command letter */ + +char re[128]; /* regular expression */ + +char args[128]; /* arguments */ + +char *argsp; /* pointer to args */ + +char var[60]; /* variable name */ + +int scallf; /* set to 1 iff procedure call */ + +int reflag; /* set to 1 iff re */ + +int redir; /* set to 1 iff forward search */ + +int colonflag; /* set to 1 iff colon typed */ +++int ncolonflag; /* set to 1 iff colon typed after number */ +++int percentflag; /* set to 1 iff percent symbol typed */ + + + +/* source file i/o */ + +char curfile[30]; /* name of file being edited */ + +int fline; /* line number in file */ - int maxfline; /* maximum line number in file, 0 if unknown */ - struct brbuf fiobuf; /* file descriptor */ - char fbuf[256]; /* current line from file */ +++char fbuf[BUFSIZ]; /* current line from file */ + +char filework[128]; /* place to put filename */ + +char *fp; /* pointer to it */ + +int nolines; /* set to 1 iff no lines in file */ +++#ifdef FLEXNAMES +++off_t gstart; /* start of string table in a.out */ +++char *strtab; /* string table from a.out * (in core!) */ +++long ssiz; /* size of string table (for range checks) */ +++#endif + + + +/* returned by slookup */ +++#ifndef FLEXNAMES + +char sl_name[8]; +++#else +++char *sl_name; +++#endif + +char sl_class; + +short sl_type; + +int sl_size, sl_addr; + +int subflag; + + + +/* procedure call information */ + +int scallx; /* procedure call in progress */ + +ADDR fps, aps, pcs; /* old stack frame */ + +BKPTR bkpts; /* old breakpoint */ + +int flagss; /* and its flags */ + +char dschar; /* '/' if value should be displayed */ + + + +/* symbol table info */ + +long ststart; /* offset of symbol table in a.out */ +++#ifndef VMUNIX + +struct brbuf sbuf; /* buffer for symbol table */ +++#endif + +long extstart; /* offset of first external in a.out */ + + + +/* address info */ + +ADDR dot; /* current address */ + +ADDR callpc, frame, argp; /* current stack frame */ + + + +/* other */ + +char odesc[10]; /* descriptor of last displayed variable */ + +ADDR oaddr; /* address of last displayed variable */ + +char otype; /* type of last displayed variable */ + +char oclass; /* class of last displayed variable */ + +char oincr; /* size of last displayed variable */ + +struct sgttyb sdbttym, userttym; + + /* tty modes for sdb and user */ + +char oldargs[128]; + +char prname[50]; /* print name used by outvar */ + +jmp_buf env; /* environment for setjmp, longjmp */ - #define WINDOW 10 /* window size for display commands */ - #define COMMANDS "\004\"+-=!/BCDRSTabcdegklmpqrstwzVXY" - /* each sdb command must appear here */ + +int debug; /* toggled by Y command */ + +time_t symtime; /* modification time of symfil */ +++char *symfil; +++char *corfil; +++ADDR exactaddr, lnfaddr; /* set by adrtolineno() */ +++ADDR firstdata; /* lowest address of data */ + + + +#define STABMASK 0376 - +++#define WINDOW 10 /* window size for display commands */ +++#define COMMANDS "\004\"+-=!/BCDMQRSTXabcdegklmpqrstwxzVXY" +++ /* each sdb command must appear here */ + +#define NUMARGS 16 /* number of args allowed in sub call */ + +#define SUBSTSP 512 /* length of space for sub args and strings */ + +#define WORDSIZE 4 /* wordsize in bytes on this machine */ + + + +#define BIGNUM 0x7fffffff + +#define MAXADDR 1L<<30 + + + +struct filet { +++#ifndef FLEXNAMES + + char sfilename[31]; /* source file name */ +++#else +++ char *sfilename; +++#endif + + char lineflag; /* set iff this is a '#line' file */ + + ADDR faddr; /* address in core */ + + long stf_offset; /* offset in a.out */ + +} *files, *badfile; + + + +struct proct { +++#ifndef FLEXNAMES + + char pname[8]; /* procedure name */ +++#else +++ char *pname; +++#endif + + ADDR paddr; /* address in core */ + + long st_offset; /* offset in a.out */ + + struct filet *sfptr; /* source file name pointer */ + + int lineno; /* line number in source file */ + + char entrypt; /* 1 iff a F77 entry */ + +} *procs, *badproc; + + + + + +#define PROCINCR 20 + +#define FILEINCR 10 + + + +#define varchar(x) ((x>='A' && x<='Z') || (x>='a' && x<='z') || x == '_' || x == '.' || x == '[' || x == ']' || x == '-' || x == '>' || x == '*' || x == '?') + +#define number(x) (x >= '0' && x <= '9') + + + +char *readline(), readchar(), rdc(); + +char *cpname(); + +char *cpstr(), *cpall(); + +char *sbrk(); + +char *typetodesc(); + +int octdigit(), decdigit(); hexdigit(); + +int octconv(), decconv(); hexconv(); + +long readint(), rint(); + +long adrtostoffset(); + +long getval(), argvalue(); + +long slookup(), globallookup(); + +ADDR varaddr(), dispvar(); + +ADDR extaddr(), formaddr(), stackreg(); + +struct proct *curproc(); + +struct proct *findproc(); - struct proct *adrtoproc(); +++struct proct *adrtoprocp(); + +struct proct *initframe(), *nextframe(); + +struct filet *findfile(), *adrtofilep(); diff --cc usr/src/cmd/sdb/mac.h index 0000000000,26d91e6d3b,0000000000..d2eba58231 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/mac.h +++ b/usr/src/cmd/sdb/mac.h @@@@ -1,0 -1,48 -1,0 +1,49 @@@@ +++/* "@(#)mac.h 4.1 10/9/80" */ + +# + +/* + + * UNIX debugger + + */ + + + +#define TYPE typedef + +#define STRUCT struct + +#define UNION union + +#define REG register + + + +#define BEGIN { + +#define END } + + + +#define IF if( + +#define THEN ){ + +#define ELSE } else { + +#define ELIF } else if ( + +#define FI } + + + +#define FOR for( + +#define WHILE while( + +#define DO ){ + +#define OD } + +#define REP do{ + +#define PER }while( + +#define DONE ); + +#define LOOP for(;;){ + +#define POOL } + + + +#define SKIP ; + +#define DIV / + +#define REM % + +#define NEQ ^ + +#define ANDF && + +#define ORF || + + + +#define TRUE (-1) + +#define FALSE 0 + +#define LOBYTE 0377 + +#define HIBYTE 0177400 + +#define STRIP 0177 + +#define HEXMSK 017 + + + +#define SP ' ' + +#define TB '\t' + +#define NL '\n' + + + +#define SCCSID(arg) static char Sccsid[] = "arg" diff --cc usr/src/cmd/sdb/machine.h index 0000000000,5738ec2f18,0000000000..08e11c777f mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/machine.h +++ b/usr/src/cmd/sdb/machine.h @@@@ -1,0 -1,28 -1,0 +1,29 @@@@ +++/* "@(#)machine.h 4.1 10/9/80" */ + +/* + + * UNIX/vax debugger + + */ + + + +/* unix parameters */ + +#define DBNAME "adb\n" + +#define LPRMODE "%R" + +#define OFFMODE "+%R" + +#define TXTRNDSIZ PAGSIZ + + + +TYPE long TXTHDR[8]; + +TYPE long SYMV; + + + +#ifndef vax + +struct {short hiword; short loword;}; /* stupid fp-11 */ + +#endif + + + +/* symbol table in a.out file */ + +struct symtab { + + char symc[8]; + + char symf; + + char sympad[3]; + + SYMV symv; + +}; + +#define SYMTABSIZ (sizeof (struct symtab)) + + + +#define SYMCHK 057 + +#define SYMTYPE(symflg) (symflg&41 ? DSYM : NSYM) diff --cc usr/src/cmd/sdb/main.c index 0000000000,d5d26992b1,0000000000..e272967ac1 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/main.c +++ b/usr/src/cmd/sdb/main.c @@@@ -1,0 -1,153 -1,0 +1,141 @@@@ +++static char sccsid[] = "@(#)main.c 4.1 10/9/80"; + +# + +/* + + * + + * UNIX debugger + + * + + */ + + + +#include "head.h" + +#include + +#include + +#include + + + +INT mkfault; + +INT executing; + +CHAR *lp; + +L_INT maxoff; + +L_INT maxpos; + +ADDR sigint; + +ADDR sigqit; + +INT wtflag; + +L_INT maxfile; + +L_INT maxstor; + +L_INT txtsiz; + +L_INT datsiz; + +L_INT datbas; + +L_INT stksiz; + +STRING errflg; + +INT magic; + +L_INT entrypt; + + + +CHAR lastc; + + + +STRING symfil; + +STRING corfil; + +INT argcount; +++ADDR userpc; + +int fpe(); + + - - - #ifndef STD - char *mktemp(), *tfn; - int tfd; - #endif - + +main(argc, argv) + +REG STRING *argv; + +REG INT argc; + +{ + + register char *p; + + struct stat stbuf; + + +++ userpc = 1; +++ symfil = "a.out"; +++ corfil = "core"; + + maxfile=1L<<24; maxstor=1L<<31; +++#ifndef STD +++#ifndef VAX135 +++ maxstor -= ctob(UPAGES); +++#endif +++#endif + + + + setbuf(stdout, NULL); + + setbuf(stderr, NULL); + + + + WHILE argc>1 + + DO IF eqstr("-w",argv[1]) + + THEN wtflag=2; argc--; argv++; + + ELSE break; + + FI + + OD + + + + IF argc>1 THEN symfil = argv[1]; FI + + IF argc>2 THEN corfil = argv[2]; FI + + fp = filework; + + if (argc > 3) { + + for (p = argv[3]; *p; *fp++ = *p++) ; + + *fp++ = '/'; + + } + + argcount=argc; + + + + if (stat(symfil, &stbuf) == -1) { + + printf("`%s' does not exist\n", symfil); + + exit(4); + + } + + symtime = stbuf.st_mtime; + + if (stat(corfil, &stbuf) != -1) { + + if (symtime > stbuf.st_mtime) + + printf("Warning: `%s' newer than `%s'\n", + + symfil, corfil); + + } + + + + setsym(); setcor(); + + initfp(); +++ mkioptab(); + + + + /* set up variables for user */ + + maxoff=MAXOFF; maxpos=MAXPOS; + + gtty(2, &sdbttym); + + IF (sigint= (ADDR) signal(SIGINT,01))!=01 + + THEN sigint= (ADDR) fault; signal(SIGINT,fault); + + FI + + sigqit= (ADDR) signal(SIGQUIT,1); + + signal(SIGILL, fpe); - #ifdef VAX135 - tfn = "/usr/hpk/sdblog/XXXXXX"; - #endif - #ifdef UCBVAX - tfn = "/usr/staff/hpk/sdblog/XXXXXX"; - #endif - #ifndef STD - tfn = mktemp(tfn); - tfd = open(tfn); - if (tfd < 0) - tfd = creat(tfn, 0666); - lseek(tfd, 0l, 2); - #endif + + + + setjmp(env); + + if (debug) printf("Sdb restarted\n"); + + gtty(2, &userttym); + + if (sdbttym.sg_flags != userttym.sg_flags) + + stty(2, &sdbttym); + + IF executing THEN delbp(); FI + + executing=FALSE; + + + + for (;;) { + + mkfault = 0; + + printf("*"); + + if (decode(readline(stdin)) == 1) { + + printf("Error; try again\n"); + + continue; + + } + + + + if (debug) { + + printf("cmd %c:\n", cmd); + + printf("%s:%s\n", proc, var); + + printf("args-%s;re-%s;integ-%d\n", args, re, integ); - printf("scallf-%d;reflg-%d\n\n", scallf, reflag); +++ printf("scallf-%d;reflg-%d\n", scallf, reflag); +++ printf("colonflag-%d;ncolonflag-%d\n\n", +++ colonflag, ncolonflag); + + } - - #ifndef STD - write(tfd, &cmd, 1); - #endif - + + docommand(); + + } + +} + + + + + +fault(a) + +{ + + signal(a,fault); + + mkfault++; + + printf("\n"); + + longjmp(env, 0); + +} + + + +fpe() { + + signal(SIGILL, fpe); + + error("Illegal floating constant"); + + longjmp(env, 0); + +} diff --cc usr/src/cmd/sdb/message.c index 0000000000,6b39d4205f,0000000000..2f95368aa2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/message.c +++ b/usr/src/cmd/sdb/message.c @@@@ -1,0 -1,24 -1,0 +1,61 @@@@ +++static char sccsid[] = "@(#)message.c 4.1 10/9/80"; + +# + +/* + + * + + * UNIX debugger + + * + + */ + + + + + + + +#include "mac.h" + +#include "mode.h" + + + + + +MSG BADMOD = "bad modifier"; + +MSG NOBKPT = "no breakpoint set"; + +MSG NOPCS = "no process"; + +MSG BADTXT = "text address not found"; + +MSG BADDAT = "data address not found"; + +MSG EXBKPT = "too many breakpoints"; + +MSG BADWAIT = "wait error: process disappeared!"; + +MSG ENDPCS = "process terminated"; + +MSG NOFORK = "try again"; + +MSG SZBKPT = "bkpt: command too long"; + +MSG BADMAG = "bad core magic number"; +++ +++STRING signals[] = { +++ "", +++ "hangup", +++ "interrupt", +++ "quit", +++ "illegal instruction", +++ "trace/BPT", +++ "IOT", +++ "EMT", +++ "floating exception", +++ "killed", +++ "bus error", +++ "memory fault", +++ "bad system call", +++ "broken pipe", +++ "alarm call", +++ "terminated", +++ "signal 16", +++ "stop (signal)", +++ "stop (tty)", +++ "continue (signal)", +++ "child termination", +++ "stop (tty input)", +++ "stop (tty output)", +++ "input available (signal)", +++ "cpu timelimit", +++ "file sizelimit", +++ "signal 26", +++ "signal 27", +++ "signal 28", +++ "signal 29", +++ "signal 30", +++ "signal 31", +++}; +++int nsig = sizeof (signals)/sizeof (signals[0]); diff --cc usr/src/cmd/sdb/mode.h index 0000000000,65036ce359,0000000000..4a8a987d33 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/mode.h +++ b/usr/src/cmd/sdb/mode.h @@@@ -1,0 -1,79 -1,0 +1,80 @@@@ +++/* "@(#)mode.h 4.1 10/9/80" */ + +#include "machine.h" + +/* + + * UNIX debugger + + */ + + + +#define MAXCOM 64 + +#define MAXARG 32 + +#define LINSIZ 256 + +TYPE long ADDR; + +#ifndef vax + +TYPE int INT; + +#else + +TYPE short INT; + +#endif + +TYPE int VOID; + +TYPE long int L_INT; + +TYPE float REAL; + +TYPE double L_REAL; + +TYPE unsigned POS; + +TYPE char BOOL; + +TYPE char CHAR; + +TYPE char *STRING; + +TYPE char MSG[]; + +TYPE struct map MAP; + +TYPE MAP *MAPPTR; + +TYPE struct symtab SYMTAB; + +TYPE SYMTAB *SYMPTR; + +TYPE struct symslave SYMSLAVE; + +TYPE struct bkpt BKPT; + +TYPE BKPT *BKPTR; + + + + + +/* file address maps */ + +struct map { + + L_INT b1; + + L_INT e1; + + L_INT f1; + + L_INT b2; + + L_INT e2; + + L_INT f2; + + INT ufd; + +}; + + + + + +/* slave table for symbols */ + +struct symslave { + + SYMV valslave; + + INT typslave; + +}; + + + +struct bkpt { + + ADDR loc; + + ADDR ins; + + INT count; + + INT initcnt; + + INT flag; + + CHAR comm[MAXCOM]; + + BKPT *nxtbkpt; + +}; + + + +TYPE struct reglist REGLIST; + +TYPE REGLIST *REGPTR; + +struct reglist { + + STRING rname; + + INT roffs; + +}; + + + +struct { + + INT junk[2]; + + INT fpsr; + + REAL Sfr[6]; + +}; + + + +struct { + + INT junk[2]; + + INT fpsr; + + L_REAL Lfr[6]; + +}; + + diff --cc usr/src/cmd/sdb/old.c index 0000000000,0000000000,0000000000..63c36848c4 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/sdb/old.c @@@@ -1,0 -1,0 -1,0 +1,78 @@@@ +++static char sccsid[] = "@(#)old.c 4.1 10/9/80"; +++/* +++ * sdb - a symbolic debugger for UNIX. +++ */ +++ +++/* +++ * This file contains support routines for older versions of the system. +++ */ +++ +++#ifndef VMUNIX +++/* +++ * These routines are used only if the system +++ * doesn't have virtual memory. They +++ * are used only to read the symbol table, which +++ * is simply kept in VM on VMUNIX. +++ */ +++#include +++#include "bio.h" +++ +++bread(brs, buff, nbytes) +++struct brbuf *brs; char *buff; { +++ register int k, nb; +++ +++ if (nbytes > 0) { +++ for (nb=nbytes; nb>0; nb--) { +++ if (brs->nr == 0) { +++ brs->nr = read(brs->fd, brs->next=brs->b, BSIZE); +++ brs->nl = 0; +++ if (brs->nr < 0) return(-1); +++ if (brs->nr == 0) return(nbytes-nb); +++ } +++ *buff++ = *brs->next++; +++ brs->nr--; +++ brs->nl++; +++ } +++ } +++ else { +++ nbytes = -nbytes; +++ for (nb=nbytes; nb>0; nb--) { +++ if (brs->nl == 0) { +++ if ((k=tell(brs->fd)) >= BSIZE + brs->nr) { +++ lseek(brs->fd, (long) -(BSIZE + brs->nr), 1); +++ brs->nl = read(brs->fd, brs->b, BSIZE); +++ } else { +++ lseek(brs->fd, 0L, 0); +++ k = k - brs->nr; +++ if (k < 0) k = 0; +++ brs->nl = read(brs->fd, brs->b, k); +++ } +++ if (brs->nl == 0) return(nbytes-nb); +++ brs->next = brs->b + brs->nl; +++ brs->nr = 0; +++ } +++ *--buff = *--brs->next; +++ brs->nr++; +++ brs->nl--; +++ } +++ } +++ return(nbytes); +++ } +++ +++blseek(brs, offset, flag) +++struct brbuf *brs; long offset; { +++ brs->nl = 0; +++ brs->nr = 0; +++ return(lseek(brs->fd,offset,flag)); +++ } +++ +++binit(brs) +++struct brbuf *brs; { +++ brs->nl = brs->nr = 0; +++} +++ +++long +++tell(fildes) { +++ return(lseek(fildes, 0L, 1)); +++} +++#endif diff --cc usr/src/cmd/sdb/old.h index 0000000000,0000000000,0000000000..0c883b9083 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/sdb/old.h @@@@ -1,0 -1,0 -1,0 +1,10 @@@@ +++/* "@(#)old.h 4.1 10/9/80" */ +++#ifndef VMUNIX +++struct brbuf { +++ int nl, nr; +++ char *next; +++ char b[1024]; +++ int fd; +++}; +++long lseek(); +++#endif diff --cc usr/src/cmd/sdb/opset.c index 0000000000,0000000000,0000000000..76a990f81e new file mode 100644 --- /dev/null +++ b/usr/src/cmd/sdb/opset.c @@@@ -1,0 -1,0 -1,0 +1,228 @@@@ +++static char sccsid[] = "@(#)opset.c 4.1 10/9/80"; +++# +++/* +++ * +++ * UNIX debugger +++ * +++ * Instruction printing routines. +++ * MACHINE DEPENDENT. +++ */ +++ +++#include "head.h" +++SCCSID(@(#)opset.c 2.4); +++ +++STRING errflg; +++L_INT dot; +++INT dotinc; +++L_INT vvar[36]; +++ +++ +++/* instruction printing */ +++ +++/* +++ * Argument access types +++ */ +++#define ACCA (8<<3) /* address only */ +++#define ACCR (1<<3) /* read */ +++#define ACCW (2<<3) /* write */ +++#define ACCM (3<<3) /* modify */ +++#define ACCB (4<<3) /* branch displacement */ +++#define ACCI (5<<3) /* XFC code */ +++ +++/* +++ * Argument data types +++ */ +++#define TYPB 0 /* byte */ +++#define TYPW 1 /* word */ +++#define TYPL 2 /* long */ +++#define TYPQ 3 /* quad */ +++#define TYPF 4 /* floating */ +++#define TYPD 5 /* double floating */ +++ +++ +++TYPE struct optab *OPTAB; +++struct optab { +++ char *iname; +++ char val; +++ char nargs; +++ char argtype[6]; +++} optab[]; +++#define SYSTAB struct systab +++SYSTAB { +++ int argc; +++ char *sname; +++} systab[]; +++STRING regname[]; +++STRING fltimm[]; +++POS type, space, incp; +++ +++int ioptab[256]; /* index by opcode to optab */ +++ +++mkioptab() {/* set up ioptab */ +++REG OPTAB p=optab; while (p->iname) {ioptab[p->val&LOBYTE]=p-optab; p++;} +++} +++ +++extern char *fmtr; +++extern char *fmtR; +++ +++printins(fmt,idsp,ins) +++char fmt; +++#ifndef vax +++REG INT ins; +++#else +++REG L_INT ins; +++#endif +++{ +++ short i,b,mode; char **r; long d; char *fmat; +++ struct proct *procp; +++ REG char * ap; +++ REG OPTAB ip; +++#ifndef vax +++ struct {char b_2,b_3,b_0,b_1;}; +++#else +++ struct {char b_0,b_1,b_2,b_3;}; +++#endif +++ procp = adrtoprocp(dot); +++ if (procp->paddr == dot) { +++ printf("0x%04.4x", ins & 0xffff); +++ oincr = 2; +++ return; +++ } +++ +++ type=DSYM; space=idsp; +++ ins &= LOBYTE; +++ ip=optab+ioptab[ins]; printf("%s\t",ip->iname); incp=1; +++ ap=ip->argtype; +++ for (i=0; inargs; i++,ap++) { +++ vvar[i]=0x80000000; +++ if (i!=0) printc(','); +++ top: +++ if (*ap&ACCB) b= 0xAF + ((*ap&7)<<5); /* branch displacement */ +++ else {b=bchkget(inkdot(incp),idsp); ++incp;} +++ if (b&0300) {/* not short literal */ +++ char *slnptr; +++ int regno; +++ regno = b & 0xF; +++ if (fmt=='i' && regno >= 6 && regno <= 11 && +++ adrtoregvar(regno, procp) != -1) { +++ slnptr = sl_name; +++ r = &slnptr; +++ } +++ else +++ r= ®name[regno]; +++ mode= b >>= 4; +++ mid: +++ switch ((int)mode) { +++ case 4: /* [r] */ printf("[%s]",*r); goto top; +++ case 5: /* r */ printf("%s",*r); break; +++ case 7: /* -(r) */ printc('-'); +++ base: +++ case 6: /* (r) */ printf("(%s)",*r); break; +++ case 9: /* *(r)+ */ printc('*'); +++ case 8: /* (r)+ */ +++ if (r==(regname+0xF)) {/* PC: immediate or absolute */ +++ printc('$'); if (b==9) goto abs; +++ mode=((*ap&7)<<1)+0xA; goto mid; +++ } +++ printf("(%s)+",*r); break; +++ case 0xB: printc('*'); +++ case 0xA: d=bchkget(inkdot(incp),idsp); ++incp; +++ if (d&0x80) d -= 0x100; fmat=fmtr; +++ disp: +++ vvar[i]=d; +++ if (r==(regname+0xF) && b>=0xA) vvar[i] += dot+incp; +++ if (psymoff(vvar[i],r,fmt) && r!=regname+0xF) +++ goto base; +++ break; +++ case 0xD: printc('*'); +++ case 0xC: d=0; +++ d.b_0 = bchkget(inkdot(incp),idsp); ++incp; +++ d.b_1 = bchkget(inkdot(incp),idsp); ++incp; +++ if (d&0x8000) d -= 0x10000; fmat=fmtr; +++ goto disp; +++ case 0xF: printc('*'); +++ case 0xE: +++ abs: +++ d.b_0 = bchkget(inkdot(incp),idsp); ++incp; +++ d.b_1 = bchkget(inkdot(incp),idsp); ++incp; +++ d.b_2 = bchkget(inkdot(incp),idsp); ++incp; +++ d.b_3 = bchkget(inkdot(incp),idsp); ++incp; +++ fmat=fmtR; goto disp; +++ } +++ } else {/* short literal */ +++ vvar[i]=b; +++ if ((*ap&7)==TYPF || (*ap&7)==TYPD) +++ printf("$%s",fltimm[b]); +++ else printf("$%d",b); +++ } +++ } +++ if (ins==0xCF || ins==0xAF || ins==0x8F) {/* CASEx instr */ +++ for (i=0; i<=vvar[2]; ++i) { +++ printc(EOR); printf(" %d: ",i+vvar[1]); +++ d=get(inkdot(incp+i+i),idsp)&0xFFFF; +++ if (d&0x8000) d -= 0x10000; +++ psymoff(inkdot(incp)+d,type,fmt); +++ } +++ incp += vvar[2]+vvar[2]+2; +++ } +++ oincr=incp; +++} +++ +++L_INT inkdot(incr) +++{ +++ L_INT newdot; +++ +++ newdot=dot+incr; +++ return(newdot); +++} +++ +++printc(c) +++char c; { +++ printf("%c", c); +++} +++ +++psymoff(v, r, fmt) +++L_INT v; char fmt, **r; { +++ struct proct *procp; +++ register int diff; +++ if (fmt == 'i') { +++ if (r == regname + 12) { /* parameter */ +++ if ((diff = adrtoparam((ADDR) v, adrtoprocp(dot))) +++ != -1) { +++ printf("%s", sl_name); +++ prdiff(diff); +++ return(0); +++ } +++ } +++ if (r == regname + 13) { /* local */ +++ if ((diff = adrtolocal((ADDR) -v, adrtoprocp(dot)) +++ ) != -1) { +++ printf("%s", sl_name); +++ prdiff(diff); +++ return(0); +++ } +++ } +++ if (v < firstdata) { +++ if ((procp = adrtoprocp((ADDR) v)) != badproc) { +++ prlnoff(procp, v); +++ return(0); +++ } +++ } else { +++ if ((diff = adrtoext((ADDR) v)) != -1) { +++ printf("%s", sl_name); +++ prdiff(diff); +++ return(0); +++ } +++ } +++ } +++ prhex(v); +++ return(1); +++} +++ +++ +++prdiff(diff) { +++ if (diff) { +++ printf("+"); +++ prhex(diff); +++ } +++} diff --cc usr/src/cmd/sdb/optab.c index 0000000000,0000000000,0000000000..83106e520d new file mode 100644 --- /dev/null +++ b/usr/src/cmd/sdb/optab.c @@@@ -1,0 -1,0 -1,0 +1,155 @@@@ +++static char sccsid[] = "@(#)optab.c 4.1 10/9/80"; +++#include "defs.h" +++ +++/* +++ * Instruction printing routines. +++ * MACHINE DEPENDENT +++ * +++ */ +++ +++/* +++ * Argument access types +++ */ +++#define ACCA (8<<3) /* address only */ +++#define ACCR (1<<3) /* read */ +++#define ACCW (2<<3) /* write */ +++#define ACCM (3<<3) /* modify */ +++#define ACCB (4<<3) /* branch displacement */ +++#define ACCI (5<<3) /* XFC code */ +++ +++/* +++ * Argument data types +++ */ +++#define TYPB 0 /* byte */ +++#define TYPW 1 /* word */ +++#define TYPL 2 /* long */ +++#define TYPQ 3 /* quad */ +++#define TYPF 4 /* floating */ +++#define TYPD 5 /* double floating */ +++ +++ +++TYPE struct optab *OPTAB; +++struct optab { +++ char *iname; +++ char val; +++ char nargs; +++ char argtype[6]; +++} optab[] = { +++#define OP(a,b,c,d,e,f,g,h,i) {a,b,c,d,e,f,g,h,i} +++#include "../as/instrs" +++0}; +++ +++#define SYSTAB struct systab +++SYSTAB { +++ int argc; +++ char *sname; +++} systab[] = { +++ 1, "indir", +++ 0, "exit", +++ 0, "fork", +++ 2, "read", +++ 2, "write", +++ 2, "open", +++ 0, "close", +++ 0, "wait", +++ 2, "creat", +++ 2, "link", +++ 1, "unlink", +++ 2, "exec", +++ 1, "chdir", +++ 0, "time", +++ 3, "mknod", +++ 2, "chmod", +++ 2, "chown", +++ 1, "break", +++ 2, "stat", +++ 2, "seek", +++ 0, "getpid", +++ 3, "mount", +++ 1, "umount", +++ 0, "setuid", +++ 0, "getuid", +++ 0, "stime", +++ 3, "ptrace", +++ 0, "alarm", +++ 1, "fstat", +++ 0, "pause", +++ 1, "30", +++ 1, "stty", +++ 1, "gtty", +++ 0, "access", +++ 0, "nice", +++ 0, "sleep", +++ 0, "sync", +++ 1, "kill", +++ 0, "csw", +++ 0, "setpgrp", +++ 0, "tell", +++ 0, "dup", +++ 0, "pipe", +++ 1, "times", +++ 4, "profil", +++ 0, "tiu", +++ 0, "setgid", +++ 0, "getgid", +++ 2, "signal", +++ 0, "49", +++ 0, "50", +++ 0, "51", +++ 0, "52", +++ 0, "53", +++ 0, "54", +++ 0, "55", +++ 0, "56", +++ 0, "57", +++ 0, "58", +++ 0, "59", +++ 0, "60", +++ 0, "61", +++ 0, "62", +++ 0, "63", +++}; +++ +++STRING regname[] = { "r0", "r1", "r2", "r3", "r4", "r5", "r6", "r7", +++ "r8", "r9", "r10","r11","ap", "fp", "sp", "pc"}; +++STRING fltimm[] = { +++"0.5", "0.5625", "0.625", "0.6875", "0.75", "0.8125", "0.875", "0.9375", +++"1.0", "1.125", "1.25", "1.375", "1.5", "1.625", "1.75", "1.875", +++"2.0", "2.25", "2.5", "2.75", "3.0", "3.25", "3.5", "3.75", +++"4.0", "4.5", "5.0", "5.5", "6.0", "6.5", "7.0", "7.5", +++"8.0", "9.0", "10.0", "11.0", "12.0", "13.0", "14.0", "15.0", +++"16.0", "18.0", "20.0", "22.0", "24.0", "26.0", "28.0", "30.0", +++"32.0", "36.0", "40.0", "44.0", "48.0", "52.0", "56.0", "60.0", +++"64.0", "72.0", "80.0", "88.0", "96.0", "104.0", "112.0", "120.0" +++}; +++ +++char *fmtr = {"%r"}; +++char *fmtR = {"%R"}; +++ +++REGLIST reglist [] = { +++ "p1lr", P1LR, +++ "p1br",P1BR, +++ "p0lr", P0LR, +++ "p0br",P0BR, +++ "ksp",KSP, +++ "esp",ESP, +++ "ssp",SSP, +++ "psl", PSL, +++ "pc", PC, +++ "usp",USP, +++ "fp", FP, +++ "ap", AP, +++ "r11", R11, +++ "r10", R10, +++ "r9", R9, +++ "r8", R8, +++ "r7", R7, +++ "r6", R6, +++ "r5", R5, +++ "r4", R4, +++ "r3", R3, +++ "r2", R2, +++ "r1", R1, +++ "r0", R0, +++}; +++ diff --cc usr/src/cmd/sdb/pcs.c index 0000000000,a85f970839,0000000000..33aafd4ffc mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/pcs.c +++ b/usr/src/cmd/sdb/pcs.c @@@@ -1,0 -1,113 -1,0 +1,114 @@@@ +++static char sccsid[] = "@(#)pcs.c 4.1 10/9/80"; + +# + +/* + + * + + * UNIX debugger + + * + + */ + + + +#include "defs.h" + + + + + +MSG NOBKPT; + +MSG SZBKPT; + +MSG EXBKPT; + +MSG NOPCS; + +MSG BADMOD; + + + +/* breakpoints */ + +BKPTR bkpthead; + + + +CHAR lastc; + +struct user u; + + + +INT signo; + +L_INT dot; + +INT pid; + +L_INT cntval; + +L_INT loopcnt; + + + + + + + +/* sub process control */ + + + +subpcs(modif) + +{ + + REG INT check; + + INT execsig,runmode; + + REG BKPTR bkptr; + + STRING comptr; + + execsig=0; loopcnt=cntval; + + + + switch (modif) { + + + + /* delete breakpoint */ + + case 'd': case 'D': + + IF (bkptr=scanbkpt(dot)) + + THEN bkptr->flag=0; return; + + ELSE error(NOBKPT); + + FI + + + + /* set breakpoint */ + + case 'b': case 'B': + + IF (bkptr=scanbkpt(dot)) + + THEN bkptr->flag=0; + + FI + + FOR bkptr=bkpthead; bkptr; bkptr=bkptr->nxtbkpt + + DO IF bkptr->flag == 0 + + THEN break; + + FI + + OD + + IF bkptr==0 + + THEN IF (bkptr=(BKPTR) sbrk(sizeof *bkptr)) == (BKPTR) -1 + + THEN error(SZBKPT); + + ELSE bkptr->nxtbkpt=bkpthead; + + bkpthead=bkptr; + + FI + + FI + + bkptr->loc = dot; + + bkptr->initcnt = bkptr->count = cntval; + + bkptr->flag = BKPTSET; + + check=MAXCOM-1; comptr=bkptr->comm; /* rdc(); */ + + REP *comptr++ = readchar(); + + PER check-- ANDF lastc!=EOR DONE + + *comptr=0; + + IF check + + THEN return; + + ELSE error(EXBKPT); + + FI + + + + /* exit */ + + case 'k' :case 'K': + + IF pid + + THEN printf("%d: killed", pid); endpcs(); return; + + FI + + error(NOPCS); + + + + /* run program */ + + case 'r': case 'R': + + endpcs(); + + setup(); runmode=CONTIN; + + break; + + + + /* single step */ + + case 's': case 'S': + + IF pid + + THEN + + runmode=SINGLE; execsig=getsig(signo); + + ELSE setup(); loopcnt--; + + FI + + break; + + + + /* continue with optional signal */ + + case 'c': case 'C': case 0: + + IF pid==0 THEN error(NOPCS); FI + + runmode=CONTIN; execsig=getsig(signo); + + break; + + + + default: error(BADMOD); + + } + + + + runpcs(runmode,execsig); + + delbp(); + +} + + diff --cc usr/src/cmd/sdb/prvar.c index 0000000000,52533fc9cc,0000000000..3a833e374a mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/prvar.c +++ b/usr/src/cmd/sdb/prvar.c @@@@ -1,0 -1,386 -1,0 +1,538 @@@@ +++static char sccsid[] = "@(#)prvar.c 4.1 10/9/80"; + +#include "head.h" + +#include +++#include + +#include "cdefs.h" + +struct user u; + +BKPTR bkpthead; + +STRING errflg; + + + +/* + + * outvar(): + + * Prints named variable, recursing once for each structure member or + + * subscript. + + * proc:var: variable name + + * fmt: print format + + * metaflag: set iff var contains metacharacters * or ? + + * addr: partial address of variable, initally 0 + + * class: type class of variable + + * subflag: number of levels of subscript indirection + + * prnamep: pointer to end of partially formed print name of variable + + * comblk: name of common block containing variable, if any - * prflag: as in findvar +++ * prvar: as in findvar + + * + + * Here and elsewhere we assume that -1 is an invalid address, and + + * its is used to indicate error. + + */ - outvar(proc, var, fmt, metaflag, addr, class, subflag, prnamep, comblk, prflag) +++outvar(proc, var, fmt, metaflag, addr, class, subflag, prnamep, +++ comblk, prvar) + +ADDR addr; char *proc, *var, *fmt, class, *prnamep, *comblk; { + + char *p, *q, *r, *oldpr; + + register int match; + + long soffset, goffset; + + register ADDR newaddr = -1, arrowaddr; + + register enum {INIT, ARROW, DOT} typeflag; + + + + switch (var[0]) { + + case '\0': - if (prflag == 0) return(addr); +++ if (prvar == 0) return(addr); + + if (metaflag) { + + if (comblk[0] && !(eqstr(comblk, "*"))) +++#ifndef FLEXNAMES + + printf("%.8s:%.8s", comblk, prname); +++#else +++ printf("%s:%s", comblk, prname); +++#endif + + else if (proc[0]) +++#ifndef FLEXNAMES + + printf("%.8s:%.8s", proc, prname); +++#else +++ printf("%s:%s", proc, prname); +++#endif + + else + + printf("%s", prname); - if (prflag == 1) - printf("/ "); - else - printf("= "); + + } - if (prflag == 1) - dispf(addr, fmt, class, sl_type, sl_size, subflag); - else - dispf(addr, fmt, 0, -1, 0, 0); +++ printit(metaflag, prvar, addr, fmt, class, sl_type, +++ sl_size, subflag, DSP); + + return(addr); + + + + case '[': + + *prnamep++ = *var++; + + p = var; + + for (;;) { + + *prnamep++ = *var; + + if (*var == '\0' || *var == ']') break; + + var++; + + } + + newaddr = getindir(class, addr, sl_type); + + newaddr += typetosize(sl_type, sl_size) * readint(&p); + + return(outvar(proc, var+1, fmt, metaflag, newaddr, N_GSYM, - subflag+1, prnamep, comblk, prflag)); +++ subflag+1, prnamep, comblk, prvar)); + + + + case '-': + + case '>': + + typeflag = ARROW; + + while (eqany(*var, "->")) + + *prnamep++ = *var++; + + subflag++; + + arrowaddr = getindir(class, addr, sl_type); + + if (errflg) { + + printf("%s\n", errflg); + + errflg = 0; + + return(0); + + } + + class = N_GSYM; + + if (var[0] == '\0') { + + p = var; +++ newaddr = arrowaddr; + + goto recurse; + + } + + break; + + + + case '.': + + typeflag = DOT; + + if (class == N_RSYM) { + + error("Not with a register variable"); + + return(0); + + } + + *prnamep++ = *var++; + + subflag = 0; + + break; + + + + default: + + typeflag = INIT; + + break; + + } + + + + if (typeflag == INIT) { + + soffset = proc[0] ? adrtostoffset(callpc-1) : -1; + + goffset = proc[0] ? -1 : findfile(curfile)->stf_offset; + + } else { + + soffset = proc[0] ? adrtostoffset(callpc-1) : -1; + + goffset = findfile(curfile)->stf_offset; + + } + + + + p = var; + + oldpr = prnamep; + + while (!eqany(*p, "->.[") && *p != '\0') + + *prnamep++ = *p++; + + *prnamep = '\0'; + + + + match = 0; + + slookinit(); + + + + for (;;) { + + if (soffset != -1) + + if ((soffset = slooknext(var, soffset, typeflag!=INIT, + + comblk)) != -1) + + goto found; + + if (goffset != -1) + + if ((goffset = globallookup(var, goffset, + + typeflag!=INIT)) != -1) + + goto found; + + return(newaddr); + + + + found: + + r = sl_name; + + q = oldpr; + + while (*r) *q++ = *r++; + + *q ='\0'; + + + + switch(typeflag) { + + case INIT: + + class = sl_class & STABMASK; + + if (!varclass(class) || class == N_SSYM) + + goto l; + + newaddr = (class == N_LSYM) ? -sl_addr : sl_addr; + + newaddr = formaddr(class, newaddr); + + break; + + + + case ARROW: + + class = sl_class & STABMASK; + + if (!varclass(class) || class != N_SSYM) + + goto l; + + newaddr = arrowaddr + sl_addr; + + break; + + + + case DOT: + + class = sl_class & STABMASK; + + if (!varclass(class) || class != N_SSYM) + + goto l; + + newaddr = addr + sl_addr; + + break; + + } + + + + recurse: + + newaddr = outvar(proc, p, fmt, metaflag, newaddr, - class, subflag, prnamep, comblk, prflag); +++ class, subflag, prnamep, comblk, prvar); + + + + if (!metaflag) + + return(newaddr); + +l:; } + +} + + +++/* Output external variables. Arguments as in outvar() */ +++extoutvar(var, fmt, metaflag, prvar) +++char *var, *fmt; { +++ long offset; +++ ADDR addr = -1; +++ +++ offset = extstart; +++ sl_addr = -1; +++ +++ for (;;) { +++ offset = extlookup(var, offset); +++ addr = sl_addr; +++ if (offset == -1) +++ return(addr); +++ if (metaflag) +++#ifndef FLEXNAMES +++ printf("%.7s", sl_name); +++#else +++ printf("%s", sl_name); +++#endif +++ printit(metaflag, prvar, addr, fmt[0] ? fmt : "d", +++ N_GSYM, 0, 0, 0, DSP); +++ if (!metaflag) +++ return(addr); +++ } +++} +++ + +prdebug() { + + register struct proct *procp; + + register struct filet *filep; + + + + printf("dot=%d\n", dot); + + printf("extstart = %d\n", extstart); +++ printf("firstdata = %d\n", firstdata); + + for(filep=files;filep->sfilename[0];filep++) + + printf("%s offs %d @ %d flag %d addr 0x%x\n", filep->sfilename, filep->stf_offset, filep, filep->lineflag, filep->faddr); + + for(procp=procs;procp->pname[0];procp++) { +++#ifndef FLEXNAMES +++ printf("%s addr 0x%x; offs %d; sfptr %d; line %d", +++#else + + printf("%8.8s addr 0x%x; offs %d; sfptr %d; line %d", +++#endif + + procp->pname, procp->paddr, procp->st_offset, + + procp->sfptr, procp->lineno); + + if (procp->entrypt) printf(" entrypoint"); + + printf("\n"); + + } + +} + + - /* display addr using format desc or class s */ - dispf(addr, desc, class, type, size, subflag) +++/* +++ * display addr in data space using format desc or class s +++ * type == 1 => use addr for value to print +++ */ +++dispf(addr, desc, class, type, size, subflag, space) +++char *desc; short type; ADDR addr; { +++ dispx(addr, desc, class, type, size, subflag, DSP); +++ printf("\n"); +++} +++ +++/* display addr in instruction space using format desc or class s */ +++/* returns -1 if bad address */ +++dispi(addr, desc, class, type, size, subflag, space) + +char *desc; short type; ADDR addr; { - dispx(addr, desc, class, type, size, subflag); +++ register i; +++ i = dispx(addr, desc, class, type, size, subflag, ISP); + + printf("\n"); +++ return(i); + +} + + - char pd[] = "%x"; - dispx(addr, desc, class, type, size, subflag) +++char pd[3]; +++dispx(addr, desc, class, type, size, subflag, space) + +char *desc; short type; ADDR addr; { + + int i, sflag; + + char *p; + + char dlen, dfmt; + + long value; + + union { - struct { - char c[WORDSIZE]; - }; - struct { - int w; - }; - struct { - float f; - } +++ char c[WORDSIZE]; +++ int w; +++ float f; + + } word; + + union { + + struct{ + + int w1, w2; - }; - struct { - double d; - }; +++ } ww; +++ double d; + + } dbl; + + + + class &= STABMASK; + + if (desc[0] == '\0') desc = typetodesc(type, subflag); + + cpstr(odesc, desc); + + otype = type; + + oclass = class; + + oaddr = addr; + + oincr = 0; - if (debug) printf("dispf(%d,%s,0%o,0%o)\n", addr,desc,class,type); +++ if (debug) printf("dispx(addr=%d,desc=%s,class=%d,type=%d,size=%d,subflg=%d,space=%d)\n", +++ addr, desc, class, type, size, subflag, space); +++ pd[0] = '%'; + + pd[1] = dfmt = 'd'; + + dlen = '\0'; + + for (p = desc; *p; p++) { + + if (*p>= '0' && *p<'9') { + + size = readint(&p); + + p--; + + } else switch (*p) { + + case 'l': + + case 'h': + + case 'b': + + dlen = *p; + + break; + + + + case 'a': + + case 'c': + + case 'd': + + case 'f': + + case 'g': +++ case 'i': +++ case 'I': + + case 'o': + + case 'p': + + case 's': + + case 'u': + + case 'x': + + pd[1] = dfmt = *p; + + break; + + + + default: + + printf("Illegal descriptor: %c\n", *p); - return; - } +++ return(1); + + } +++ } + + - if (type == -1) - value = addr; - else if (class == N_RSYM && addr < 16) { - /* MACHINE DEPENDENT */ - if ((addr > 0 && addr < 6) || addr > 11) { - printf("Bad register var %d\n", addr); - return; - } - value = *(ADDR *)(((ADDR) &u) + R0 + (WORDSIZE)*addr); - } - else { - value = getval(addr, dfmt == 'g' ? 'd' : dfmt); +++ if (type == -1) +++ value = addr; +++ else if (class == N_RSYM && addr < 16) { +++ /* MACHINE DEPENDENT */ +++ if ((addr > 0 && addr < 6) || addr > 11) { +++ printf("Bad register var %d\n", addr); +++ return(-1); + + } +++ value = *(ADDR *)(((ADDR) &u) + R0 + (WORDSIZE)*addr); +++ } +++ else { +++ value = getval(addr, dfmt == 'g' ? 'd' : dfmt, space); +++ } + + - if (errflg) { - printf("%s", errflg); - errflg = 0; - return; - } +++ if (errflg) { +++ printf("%s", errflg); +++ errflg = 0; +++ return(-1); +++ } + + +++ switch (dfmt) { +++ default: + + switch (dfmt) { - default: - switch (dfmt) { - case 'u': - case 'x': - case 'o': - switch (dlen) { - case 'h': - value = (unsigned short) value; - oincr = 2; - break; - case 'b': - value = (unsigned char) value; - oincr = 1; - break; - case 'l': - value = (unsigned long) value; - oincr = 4; - break; - } +++ case 'u': +++ case 'x': +++ case 'o': +++ switch (dlen) { +++ case 'h': +++ value = (unsigned short) value; +++ oincr = 2; +++ break; +++ case 'b': +++ value = (unsigned char) value; +++ oincr = 1; +++ break; +++ case 'l': +++ value = (unsigned long) value; +++ oincr = 4; + + break; - + + default: - switch (dlen) { - case 'h': - value = (short) value; - oincr = 2; - break; - case 'b': - value = (char) value; - oincr = 1; - break; - case 'l': - value = (long) value; - oincr = 4; - break; - } +++ oincr = WORDSIZE; +++ break; + + } - if (value > 0) { - if (value > 9 && dfmt == 'x') - printf("0x"); - else if (value > 7 && dfmt == 'o') - printf("0"); +++ break; +++ +++ default: +++ switch (dlen) { +++ case 'h': +++ value = (short) value; +++ oincr = 2; +++ break; +++ case 'b': +++ value = (char) value; +++ oincr = 1; +++ break; +++ case 'l': +++ value = (long) value; +++ oincr = 4; +++ break; +++ default: +++ oincr = WORDSIZE; +++ break; + + } - printf(pd, value); - return; +++ } +++ if (dfmt == 'x' && (value > 9 || value < 0)) +++ printf("0x"); +++ else if (dfmt == 'o' && (value > 7 || value < 0)) +++ printf("0"); +++ printf(pd, value); +++ return(1); +++ +++ case 'f': +++ pd[1] = 'g'; +++ word.w = value; +++ printf(pd, word.f); +++ return(1); +++ +++ case 'g': +++ dbl.ww.w1 = value; +++ dbl.ww.w2 = (class == (char) N_RSYM) ? +++ *(ADDR *)(((ADDR) &u)+R0+(WORDSIZE)*(addr+1)) : +++ getval(addr+WORDSIZE, 'd', space); +++ printf("%.13g", dbl.d); +++ return(1); +++ +++ case 'p': +++ printf("%s:%d", adrtoprocp(value)->pname, +++ adrtolineno(value)); +++ return(1); +++ +++ case 's': +++ addr = getindir(class, addr, type); +++ goto aa; + + - case 'f': - pd[1] = 'g'; - word.w = value; - printf(pd, word.f); - return; - - case 'g': - dbl.w1 = value; - dbl.w2 = (class == (char) N_RSYM) ? - *(ADDR *)(((ADDR) &u)+R0+(WORDSIZE)*(addr+1)) : - getval(addr+WORDSIZE, 'd'); - printf("%.13g", dbl.d); - return; - - case 'p': - printf("%s:%d", adrtoprocp(value)->pname, - adrtolineno(value)); - return; - - case 's': - addr = getindir(class, addr, type); +++ case 'c': +++ if (size <= 1) { +++ oincr = 1; +++ printchar(value); +++ return(1); +++ } else + + goto aa; - - case 'c': - if (size <= 1) { - oincr = 1; - printchar(value); - return; - } else - goto aa; - - case 'a': - aa: sflag = size == 0; - if (sflag) - size = 128; /* maximum length for s and a */ - else - oincr = size; - for (;;) { - word.w = getval(addr, 'd'); - for (i=0; iufd; +++ printf("%s\t`%s'\n",s,(file<0 ? "-" : (file==fcor ? corfil : symfil))); +++ printf("b1 = 0x%-16x",amap->b1); +++ printf("e1 = 0x%-16x",amap->e1); +++ printf("f1 = 0x%-x",amap->f1); +++ printf("\nb2 = 0x%-16x",amap->b2); +++ printf("e2 = 0x%-16x",amap->e2); +++ printf("f2 = 0x%-x",amap->f2); +++ printf("\n"); +++} +++ +++#define NUMREGS 24 /* number of hardware registers */ +++REGLIST reglist[]; +++ +++printregs() +++{ +++ REG REGPTR p; +++ +++ for (p=reglist; p < ®list[NUMREGS/2]; p++) { +++ printf("%4.4s/ ", p->rname); +++ prhex12(*(ADDR *)(((ADDR)&u)+p->roffs)); +++ printf(" %4.4s/ ",(p+NUMREGS/2)->rname); +++ prhex(*(ADDR *)(((ADDR)&u)+(p+NUMREGS/2)->roffs)); +++ printf("\n"); +++ } +++ printpc(); +++} +++ +++printpc() +++{ +++ dot= *(ADDR *)(((ADDR)&u)+PC); +++ prisploc(); +++ printins('i',ISP,chkget(dot,ISP)); +++ printf("\n"); +++} +++ +++/* print register */ +++REGLIST reglist[]; +++regout(name, prvar, fmt) +++char *name, *fmt; { +++ REG REGPTR p; +++ for (p=reglist; p< ®list[24]; p++) { +++ if (eqstr(name, p->rname)) { +++ printit(0, prvar, *(ADDR *)(((ADDR)&u)+p->roffs), +++ fmt[0] ? fmt : "d", N_GSYM, -1, 0, 0, DSP); +++ return(p->roffs); +++ } +++ } +++ error("Unknown register variable"); +++ return(-1); +++} +++/* Print symbolic location of dot */ +++prisploc() { +++ struct proct *procp; +++ int lineno; +++ +++ printf("0x%x", dot); +++ procp = adrtoprocp(dot); +++ if (procp != badproc) { +++ printf(" ("); +++ prlnoff(procp, dot); +++ printf("): \t"); +++ } else +++ printf(": \t"); +++} diff --cc usr/src/cmd/sdb/rdwr.c index 0000000000,0000000000,0000000000..77fdb565d9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/sdb/rdwr.c @@@@ -1,0 -1,0 -1,0 +1,295 @@@@ +++static char sccsid[] = "@(#)rdwr.c 4.1 10/9/80"; +++/* +++ * sdb - a symbolic debugger for unix - source file access routines. +++ */ +++#include "head.h" +++#include +++ +++/* +++ * These procedures manage the source files examined by sdb, +++ * providing access to lines by number and utilities for printing +++ * and scrolling. One file is kept open by these routines, and +++ * line index tables are maintained for all files which have been +++ * ``current'' at any time so far. This makes line access trivial, +++ * since the location of each line in the files is known, +++ * although we get ``burned'' if the file is changed. +++ * SHOULD WATCH THE MODTIME OF FILES AND REINDEX IF IT CHANGES. +++ */ +++ +++/* +++ * Structure for files which have been ``indexed''. +++ * Contains a pointer to the file name, a pointer to an +++ * array of seek pointers for the lines in the file, +++ * and a next link in a chain of these for all files we have indexed, +++ * The currently open file is cinfo->; the chain of active files is finfo. +++ */ +++struct finfo { +++ char *name; /* name of this file w/o common pfx */ +++ off_t *lines; /* array of seek pointers */ +++/* line i stretches from lines[i-1] to lines[i] - 1, if first line is 1 */ +++ int nlines; /* number of lines in file */ +++/* lines array actually has nlines+1 elements, so last line is bracketed */ +++ struct finfo *next; /* link in chain of known files */ +++} *finfo, *cfile; +++FILE *FIO; /* current open file (only 1 now) */ +++char fibuf[BUFSIZ]; +++/* +++ * We use stdio when first reading the file, but thereafter +++ * use our own routines, because we want to be able +++ * to read backwards efficiently and avoid a tell() system +++ * call on each line. Fseekpt remebers where we are in the current +++ * file. +++ */ +++off_t fseekpt; +++ +++/* +++ * Make ``name'' the current source file, if it isn't already. +++ * If we have never seen this file before, then we create a finfo +++ * structure for it indexing the lines (this requires reading the +++ * entire file and building an index, but is well worth it since +++ * we otherwise have to brute force search the files all the time.) +++ */ +++finit(name) +++ char *name; +++{ +++ char buf[BUFSIZ]; +++ register off_t *lp; +++ +++ if (cfile && !strcmp(cfile->name, name)) +++ return; /* its already current, do nothing */ +++ /* IT WOULD BE BETTER TO HAVE A COUPLE OF FILE DESCRIPTORS, LRU */ +++ if (FIO) { +++ fclose(FIO); +++ FIO = NULL; +++ } +++ /* +++ * Paste the given name onto the common prefix (directory path) +++ * to form the full name of the file to be opened. +++ */ +++ strcpy(fp, name); +++ if ((FIO = fopen(filework, "r")) == NULL) { +++ nolines = 1; +++ perror(filework); +++ return; +++ } +++ setbuf(FIO, fibuf); +++ fseekpt = -BUFSIZ; /* putatively illegal */ +++ strcpy(curfile, name); +++ /* +++ * See if we have alread indexed this file. +++ * If so, nothing much to do. +++ */ +++ for (cfile = finfo; cfile; cfile = cfile->next) +++ if (!strcmp(cfile->name, name)) +++ return; +++ /* +++ * Create a structure for this (new) file. +++ * Lines array grows 100 lines at a time. +++ * 1 extra so last line is bracketed. +++ */ +++ cfile = (struct finfo *)sbrk(sizeof (struct finfo)); +++ lp = cfile->lines = (off_t *)sbrk(101 * sizeof (off_t)); +++ *lp++ = 0; /* line 1 starts at 0 ... */ +++ cfile->nlines = 0; +++ /* IT WOULD PROBABLY BE FASTER TO JUST USE GETC AND LOOK FOR \n */ +++ while (fgets(buf, sizeof buf, FIO)) { +++ if ((++cfile->nlines % 100) == 0) +++ sbrk(100 * sizeof (off_t)); +++ /* +++ * Mark end of the cfile->nlines'th line +++ */ +++ lp[0] = lp[-1] + strlen(buf); +++ lp++; +++ } +++ if (cfile->nlines == 0) { +++ printf("%s: no lines in file\n", filework); +++ cfile = 0; +++ return; +++ } +++ /* +++ * Allocate space for the name, making sure to leave the +++ * break on a word boundary. +++ * IT WOULD BE MUCH BETTER TO USE MALLOC AND REALLOC IN SDB. +++ */ +++ sbrk(lp + ((strlen(name)+sizeof(off_t)-1)&~(sizeof(off_t)-1))); +++ strcpy(cfile->name = (char *)lp, name); +++ cfile->next = finfo; +++ finfo = cfile; +++} +++ +++/* +++ * Get the current line (fline) into fbuf +++ */ +++fgetline() +++{ +++ register off_t *op = &cfile->lines[fline-1]; +++ int o, n; +++ +++ n = op[1] - op[0]; +++ fbuf[n] = 0; +++ /* +++ * Case 1. Line begins in current buffer. +++ * +++ * Compute the number of characters into the buffer where +++ * the line starts. If this offset plus its length is greater +++ * than BUFSIZ, then this line splits across a buffer boundary +++ * so take the rest of this buffer and the first part of the next. +++ * Otherwise just take a chunk of this buffer. +++ */ +++ if (*op >= fseekpt && *op < fseekpt + BUFSIZ) { +++case1: +++ o = op[0] - fseekpt; +++ if (o + n > BUFSIZ) { +++ strncpy(fbuf, fibuf+o, BUFSIZ-o); +++ fseekpt += BUFSIZ; +++ read(fileno(FIO), fibuf, BUFSIZ); +++ strncpy(fbuf+BUFSIZ-o, fibuf, n-(BUFSIZ-o)); +++ } else +++ strncpy(fbuf, fibuf+o, n); +++ return; +++ } +++ /* +++ * Case 2. Line ends in current buffer. +++ * +++ * If the line ends in this buffer (but doesn't begin in +++ * it or else we would have had case 1) take the beginning +++ * part of the buffer (end of the line) and then back up and +++ * get the rest of the line from the end of the previous block. +++ */ +++ if (op[1]-1 >= fseekpt && op[1] <= fseekpt+BUFSIZ) { +++ o = op[1] - fseekpt; +++ strncpy(fbuf+n-o, fibuf, o); +++ fseekpt -= BUFSIZ; +++ lseek(fileno(FIO), fseekpt, 0); +++ read(fileno(FIO), fibuf, BUFSIZ); +++ strncpy(fbuf, fibuf+op[0]-fseekpt, n-o); +++ return; +++ } +++ /* +++ * Case 3. Line not in current buffer at all. +++ * +++ * Read in the buffer where the line starts and then go +++ * back and handle as case 1. +++ */ +++ fseekpt = (op[0] / BUFSIZ) * BUFSIZ; +++ lseek(fileno(FIO), fseekpt, 0); +++ read(fileno(FIO), fibuf, BUFSIZ); +++ goto case1; +++} +++ +++/* +++ * Advance current line, end-around (like for / search). +++ */ +++fnext() +++{ +++ +++ if (cfile == 0) +++ return; +++ if (fline == cfile->nlines) { +++ fline = 1; +++ } else +++ fline++; +++ fgetline(); +++} +++ +++/* +++ * Retreat the current line, end around. +++ */ +++fprev() +++{ +++ +++ if (cfile == 0) +++ return; +++ if (fline == 1) +++ fline = cfile->nlines; +++ else +++ fline--; +++ fgetline(); +++} +++ +++/* +++ * Print the current line. +++ */ +++fprint() +++{ +++ register char *p; +++ +++ if (cfile == 0) { +++ error("No lines in file"); +++ return; +++ } +++ printf("%d: %s", fline, fbuf); +++} +++ +++/* +++ * Make line `num' current. +++ */ +++ffind(num) +++ register int num; +++{ +++ +++ if (cfile == 0) +++ return; +++ if (num > cfile->nlines) +++ error("Not that many lines in file"); +++ else if (num <= 0) +++ error("Zero or negative line?"); +++ else { +++ fline = num; +++ fgetline(); +++ } +++} +++ +++/* +++ * Go back n lines. +++ */ +++fback(n) +++{ +++ int i; +++ +++ if (cfile == 0) +++ return (0); +++ if (n > fline - 1) +++ n = fline - 1; +++ fline -= n; +++ fgetline(); +++ return (n); +++} +++ +++/* +++ * Go forwards n lines. +++ */ +++fforward(n) +++ int n; +++{ +++ register int fnext; +++ +++ if (cfile == 0) +++ return(0); +++ if (fline + n > cfile->nlines) +++ n = cfile->nlines - fline; +++ fline += n; +++ fgetline(); +++ return (n); +++} +++ +++/* +++ * Print (upto) n lines, returning number printed. +++ */ +++fprintn(n) +++ int n; +++{ +++ register int i; +++ +++ if (cfile == 0) { +++ error("No lines in file"); +++ return (0); +++ } +++ for (i = 1; i <= n; i++) { +++ fprint(); +++ if (fline == cfile->nlines || i == n) +++ return(i); +++ fnext(); +++ } +++ return (n); +++} diff --cc usr/src/cmd/sdb/re.c index 0000000000,e7e84971ce,0000000000..073583e3cd mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/re.c +++ b/usr/src/cmd/sdb/re.c @@@@ -1,0 -1,332 -1,0 +1,333 @@@@ +++static char sccsid[] = "@(#)re.c 4.1 10/9/80"; + +#include "head.h" + +#define CBRA 1 + +#define CCHR 2 + +#define CDOT 4 + +#define CCL 6 + +#define NCCL 8 + +#define CDOL 10 + +#define CEOF 11 + +#define CKET 12 + +#define CBACK 18 + + + +#define CSTAR 01 + + - #define LBSIZE BUFSIZ +++#define LBSIZE 512 + +#define ESIZE 256 + +#define NBRA 9 + + + +char expbuf[ESIZE]; + +int circf; + +char *braslist[NBRA]; + +char *braelist[NBRA]; + +char bittab[] = { + + 1, + + 2, + + 4, + + 8, + + 16, + + 32, + + 64, + + 128 + +}; + + + +dore() { + + register int line; + + register char *p; + + + + circf = 0; + + line = fline; + + compile(re); + + do { + + if (redir) fnext(); + + else fprev(); + + p = fbuf; + + while(*p++ != '\n') + + ; + + *--p = '\0'; + + if (match(fbuf)) goto l1; + + } while (fline != line); + + error("No match"); + +l1: *p = '\n'; + + fprint(); + +} + + + + + +compile(astr) + +char *astr; + +{ + + register c; + + register char *ep, *sp; + + char *cstart; + + char *lastep; + + int cclcnt; + + char bracket[NBRA], *bracketp; + + int closed; + + char numbra; + + char neg; + + + + ep = expbuf; + + sp = astr; + + lastep = 0; + + bracketp = bracket; + + closed = numbra = 0; + + if (*sp == '^') { + + circf++; + + sp++; + + } + + for (;;) { + + if (ep >= &expbuf[ESIZE]) + + goto cerror; + + if ((c = *sp++) != '*') + + lastep = ep; + + switch (c) { + + + + case '\0': + + *ep++ = CEOF; + + return; + + + + case '.': + + *ep++ = CDOT; + + continue; + + + + case '*': + + if (lastep==0 || *lastep==CBRA || *lastep==CKET) + + goto defchar; + + *lastep |= CSTAR; + + continue; + + + + case '$': + + if (*sp != '\0') + + goto defchar; + + *ep++ = CDOL; + + continue; + + + + case '[': + + if(&ep[17] >= &expbuf[ESIZE]) + + goto cerror; + + *ep++ = CCL; + + neg = 0; + + if((c = *sp++) == '^') { + + neg = 1; + + c = *sp++; + + } + + cstart = sp; + + do { + + if (c=='\0') + + goto cerror; + + if (c=='-' && sp>cstart && *sp!=']') { + + for (c = sp[-2]; c<*sp; c++) + + ep[c>>3] |= bittab[c&07]; + + sp++; + + } + + ep[c>>3] |= bittab[c&07]; + + } while((c = *sp++) != ']'); + + if(neg) { + + for(cclcnt = 0; cclcnt < 16; cclcnt++) + + ep[cclcnt] ^= -1; + + ep[0] &= 0376; + + } + + + + ep += 16; + + + + continue; + + + + case '\\': + + if((c = *sp++) == '(') { + + if(numbra >= NBRA) { + + goto cerror; + + } + + *bracketp++ = numbra; + + *ep++ = CBRA; + + *ep++ = numbra++; + + continue; + + } + + if(c == ')') { + + if(bracketp <= bracket) { + + goto cerror; + + } + + *ep++ = CKET; + + *ep++ = *--bracketp; + + closed++; + + continue; + + } + + + + if(c >= '1' && c <= '9') { + + if((c -= '1') >= closed) + + goto cerror; + + *ep++ = CBACK; + + *ep++ = c; + + continue; + + } + + + + defchar: + + default: + + *ep++ = CCHR; + + *ep++ = c; + + } + + } + + cerror: + + errexit("RE error\n", (char *)NULL); + +} + + + +match(p1) + +register char *p1; { + + register char *p2; + + register c; + + p2 = expbuf; + + if (circf) { + + if (advance(p1, p2)) + + goto found; + + goto nfound; + + } + + /* fast check for first character */ + + if (*p2==CCHR) { + + c = p2[1]; + + do { + + if (*p1!=c) + + continue; + + if (advance(p1, p2)) + + goto found; + + } while (*p1++); + + goto nfound; + + } + + /* regular algorithm */ + + do { + + if (advance(p1, p2)) + + goto found; + + } while (*p1++); + + nfound: + + return(0); + + found: + + return(1); + +} + + + +advance(lp, ep) + +register char *lp, *ep; + +{ + + register char *curlp; + + char c; + + char *bbeg; + + int ct; + + + + for (;;) switch (*ep++) { + + + + case CCHR: + + if (*ep++ == *lp++) + + continue; + + return(0); + + + + case CDOT: + + if (*lp++) + + continue; + + return(0); + + + + case CDOL: + + if (*lp=='\0') + + continue; + + return(0); + + + + case CEOF: + + return(1); + + + + case CCL: + + c = *lp++ & 0177; + + if(ep[c>>3] & bittab[c & 07]) { + + ep += 16; + + continue; + + } + + return(0); + + case CBRA: + + braslist[*ep++] = lp; + + continue; + + + + case CKET: + + braelist[*ep++] = lp; + + continue; + + + + case CBACK: + + bbeg = braslist[*ep]; + + if (braelist[*ep]==0) + + return(0); + + ct = braelist[*ep++] - bbeg; + + if(ecmp(bbeg, lp, ct)) { + + lp += ct; + + continue; + + } + + return(0); + + + + case CBACK|CSTAR: + + bbeg = braslist[*ep]; + + if (braelist[*ep]==0) + + return(0); + + ct = braelist[*ep++] - bbeg; + + curlp = lp; + + while(ecmp(bbeg, lp, ct)) + + lp += ct; + + while(lp >= curlp) { + + if(advance(lp, ep)) return(1); + + lp -= ct; + + } + + return(0); + + + + + + case CDOT|CSTAR: + + curlp = lp; + + while (*lp++); + + goto star; + + + + case CCHR|CSTAR: + + curlp = lp; + + while (*lp++ == *ep); + + ep++; + + goto star; + + + + case CCL|CSTAR: + + curlp = lp; + + do { + + c = *lp++ & 0177; + + } while(ep[c>>3] & bittab[c & 07]); + + ep += 16; + + goto star; + + + + star: + + if(--lp == curlp) { + + continue; + + } + + + + if(*ep == CCHR) { + + c = ep[1]; + + do { + + if(*lp != c) + + continue; + + if(advance(lp, ep)) + + return(1); + + } while(lp-- > curlp); + + return(0); + + } + + + + do { + + if (advance(lp, ep)) + + return(1); + + } while (lp-- > curlp); + + return(0); + + + + default: + + errexit("RE botch\n", (char *)NULL); + + } + +} + +ecmp(a, b, count) + +char *a, *b; + +{ + + register cc = count; + + while(cc--) + + if(*a++ != *b++) return(0); + + return(1); + +} + + + + + +errexit(s) + +char *s; { + + error(s); + + return; + +} diff --cc usr/src/cmd/sdb/runpcs.c index 0000000000,70c1a13637,0000000000..970ff045e6 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/runpcs.c +++ b/usr/src/cmd/sdb/runpcs.c @@@@ -1,0 -1,370 -1,0 +1,336 @@@@ +++static char sccsid[] = "@(#)runpcs.c 4.1 10/9/80"; + +# + +/* + + * + + * UNIX debugger + + * + + */ + + + +#include "head.h" + +#include +++#include + +struct user u; + +#include + + +++#ifndef SIGTRAP +++#define SIGTRAP SIGTRC +++#endif + + + +MSG NOFORK; + +MSG ENDPCS; + +MSG BADWAIT; + + + +ADDR sigint; + +ADDR sigqit; +++ADDR userpc; + + + +/* breakpoints */ + +BKPTR bkpthead; + + - - REGLIST reglist [] = { - "p1lr", P1LR, - "p1br",P1BR, - "p0lr", P0LR, - "p0br",P0BR, - "ksp",KSP, - "esp",ESP, - "ssp",SSP, - "psl", PSL, - "pc", PC, - "usp",USP, - "fp", FP, - "ap", AP, - "r11", R11, - "r10", R10, - "r9", R9, - "r8", R8, - "r7", R7, - "r6", R6, - "r5", R5, - "r4", R4, - "r3", R3, - "r2", R2, - "r1", R1, - "r0", R0, - }; - - + +CHAR lastc; + + + +INT fcor; + +INT fsym; + +STRING errflg; + +int errno; + +INT signo; + + + +L_INT dot; + +STRING symfil; + +INT wtflag; + +INT pid; + +INT adrflg; + +L_INT loopcnt; + + + + + + + + + + + + + +getsig(sig) + +{ return(sig); + +} + + - ADDR userpc = 1; - + +runpcs(runmode,execsig) + +{ + + REG BKPTR bkpt; + + IF adrflg THEN userpc=dot; FI + + WHILE --loopcnt>=0 + + DO + + if (debug) printf("\ncontinue %x %d\n",userpc,execsig); + + IF runmode==SINGLE + + THEN delbp(); /* hardware handles single-stepping */ + + ELSE /* continuing from a breakpoint is hard */ + + IF bkpt=scanbkpt(userpc) + + THEN execbkpt(bkpt,execsig); execsig=0; + + FI + + setbp(); + + FI + + ptrace(runmode,pid,userpc,execsig); + + bpwait(); chkerr(); execsig=0; delbp(); readregs(); + + + + loop1: IF (signo==0) ANDF (bkpt=scanbkpt(userpc)) + + THEN /* stopped by BPT instruction */ + + if (debug) printf("\n BPT code; '%s'%o'%o'%d", + + bkpt->comm,bkpt->comm[0],EOR,bkpt->flag); + + dot=bkpt->loc; + + IF bkpt->comm[0] != EOR + + THEN acommand(bkpt->comm); + + FI + + IF bkpt->flag==BKPTEXEC + + ORF ((bkpt->flag=BKPTEXEC) + + ANDF bkpt->comm[0]!=EOR) + + THEN execbkpt(bkpt,execsig); execsig=0; loopcnt++; + + goto loop1; - ELSE bkpt->count=bkpt->initcnt; +++ ELSE bkpt->flag=BKPTSET; bkpt->count=bkpt->initcnt; + + FI + + ELSE execsig=signo; + + if (execsig) break; + + FI + + OD + + if (debug) printf("Returning from runpcs\n"); + +} + + + +#define BPOUT 0 + +#define BPIN 1 - INT bpstate = BPOUT; +++INT bpstate; + + + +endpcs() + +{ + + REG BKPTR bkptr; + + if (debug) printf("Entering endpcs with pid=%d\n"); + + IF pid + + THEN ptrace(EXIT,pid,0,0); pid=0; userpc=1; + + FOR bkptr=bkpthead; bkptr; bkptr=bkptr->nxtbkpt + + DO IF bkptr->flag + + THEN bkptr->flag=BKPTSET; + + FI + + OD + + FI + + bpstate=BPOUT; + +} + + + +#ifdef VFORK + +nullsig() + +{ + + + +} + +#endif + + + +setup() + +{ + + close(fsym); fsym = -1; + +#ifdef VFORK + + IF (pid = vfork()) == 0 + +#else + + IF (pid = fork()) == 0 + +#endif + + THEN ptrace(SETTRC,0,0,0); + + signal(SIGINT,sigint); signal(SIGQUIT,sigqit); + +#ifdef VFORK - signal(SIGTRC,nullsig); +++ signal(SIGTRAP,nullsig); + +#endif + + if (debug) printf("About to doexec pid=%d\n",pid); - #ifdef UCBVAX + + doexec(); _exit(0); - #else - doexec(); exit(0); - #endif + + ELIF pid == -1 + + THEN error(NOFORK); + + ELSE bpwait(); readregs(); + + if (debug) printf("About to open symfil = %s\n", symfil); + + fsym=open(symfil,wtflag); + + IF errflg + + THEN printf("%s: cannot execute\n",symfil); + + if (debug) printf("%d %s\n", errflg, errflg); + + endpcs(); + + FI + + FI + + bpstate=BPOUT; + +} + + + +execbkpt(bkptr,execsig) + +BKPTR bkptr; + +{ + + if (debug) printf("exbkpt: %d\n",bkptr->count); + + delbp(); + + ptrace(SINGLE,pid,bkptr->loc,execsig); + + bkptr->flag=BKPTSET; + + bpwait(); chkerr(); readregs(); + +} + + + +extern STRING environ; + + + +doexec() + +{ + + char *argl[MAXARG], args[LINSIZ]; + + register char c, redchar, *argsp, **arglp, *filnam; + + + + arglp = argl; + + argsp = args; + + *arglp++ = symfil; + + c = ' '; + + + + do { + + while (eqany(c, " \t")) { + + c = rdc(); + + } + + if (eqany(c, "<>")) { + + redchar = c; + + do { + + c = rdc(); + + } while (eqany(c, " \t")); + + filnam = argsp; + + do { + + *argsp++ = c; + + c = rdc(); + + } while (!eqany(c, " <>\t\n")); + + *argsp++ = '\0'; + + if (redchar == '<') { + + close(0); + + if (open(filnam,0) < 0) { + + printf("%s: cannot open\n",filnam); - #ifdef UCBVAX - _exit(0); - #else - exit(0); - #endif +++ fflush(stdout); +++ _exit(0); + + } + + } else { + + close(1); + + if (creat(filnam,0666) < 0) { + + printf("%s: cannot create\n",filnam); - #ifdef UCBVAX +++ fflush(stdout); + + _exit(0); - #else - exit(0); - #endif + + } + + } + + } else if (c != '\n') { + + *arglp++ = argsp; + + do { + + *argsp++ = c; + + c = rdc(); + + } while(!eqany(c, " <>\t\n")); + + *argsp++ = '\0'; + + } + + } while (c != '\n'); + + *arglp = (char *) 0; + + if (debug) { + + char **dap; + + printf("About to exect(%s, %d, %d)\n",symfil,argl,environ); + + for (dap = argl; *dap; dap++) { + + printf("%s, ", *dap); + + } + + } + + exect(symfil, argl, environ); + + perror("Returned from exect"); + +} + + + +BKPTR scanbkpt(adr) + +ADDR adr; + +{ + + REG BKPTR bkptr; + + FOR bkptr=bkpthead; bkptr; bkptr=bkptr->nxtbkpt + + DO IF bkptr->flag ANDF bkptr->loc==adr + + THEN break; + + FI + + OD + + return(bkptr); + +} + + + +delbp() + +{ + + REG ADDR a; + + REG BKPTR bkptr; + + IF bpstate!=BPOUT + + THEN + + FOR bkptr=bkpthead; bkptr; bkptr=bkptr->nxtbkpt + + DO IF bkptr->flag + + THEN a=bkptr->loc; + + ptrace(WIUSER,pid,a, + + (bkptr->ins&0xFF)|(ptrace(RIUSER,pid,a,0)&~0xFF)); + + FI + + OD + + bpstate=BPOUT; + + FI + +} + + + +setbp() + +{ + + REG ADDR a; + + REG BKPTR bkptr; + + + + IF bpstate!=BPIN + + THEN + + FOR bkptr=bkpthead; bkptr; bkptr=bkptr->nxtbkpt + + DO IF bkptr->flag + + THEN a = bkptr->loc; + + bkptr->ins = ptrace(RIUSER, pid, a, 0); + + ptrace(WIUSER, pid, a, BPT | (bkptr->ins&~0xFF)); + + IF errno + + THEN error("cannot set breakpoint: "); + + printf("%s:%d @ %d\n", adrtoprocp(dot)->pname, + + adrtolineno(dot), dot); + + FI + + FI + + OD + + bpstate=BPIN; + + FI + +} + + + +bpwait() + +{ + + REG ADDR w; + + ADDR stat; + + + + signal(SIGINT, 1); + + if (debug) printf("Waiting for pid %d\n",pid); + + WHILE (w = wait(&stat))!=pid ANDF w != -1 DONE + + if (debug) printf("Ending wait\n"); + + if (debug) printf("w = %d; pid = %d; stat = %o;\n", w,pid,stat); + + signal(SIGINT,sigint); + + IF w == -1 + + THEN pid=0; + + errflg=BADWAIT; + + ELIF (stat & 0177) != 0177 + + THEN IF signo = stat&0177 + + THEN sigprint(); + + FI + + IF stat&0200 + + THEN error(" - core dumped"); + + close(fcor); + + setcor(); + + FI + + pid=0; + + errflg=ENDPCS; + + ELSE signo = stat>>8; + + if (debug) printf("PC = %d, dbsubn = %d\n", + + ptrace(RUREGS, pid, PC, 0), extaddr("_dbsubn")); - IF signo!=SIGTRC ANDF +++ IF signo!=SIGTRAP ANDF + + ptrace(RUREGS, pid, PC, 0) != extaddr("_dbsubn") + + THEN sigprint(); + + ELSE signo=0; + + FI + + FI + +} + + +++REGLIST reglist[]; + +readregs() + +{ + + /*get REG values from pcs*/ + + REG i; + + FOR i=24; --i>=0; + + DO *(ADDR *)(((ADDR)&u)+reglist[i].roffs) = + + ptrace(RUREGS, pid, reglist[i].roffs, 0); + + OD + + userpc= *(ADDR *)(((ADDR)&u)+PC); + +} + + + +char + +readchar() { + + lastc = *argsp++; + + if (lastc == '\0') lastc = '\n'; + + return(lastc); + +} + + + +char + +rdc() + +{ + + register char c; + + + + c = *argsp++; + + return(c == '\0' ? '\n' : c); + +} diff --cc usr/src/cmd/sdb/setup.c index 0000000000,8aaa15cfbc,0000000000..d24fd5678b mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/setup.c +++ b/usr/src/cmd/sdb/setup.c @@@@ -1,0 -1,168 -1,0 +1,165 @@@@ +++static char sccsid[] = "@(#)setup.c 4.1 10/9/80"; + +# + +/* + + * + + * UNIX debugger + + * + + */ + + + +#include "head.h" + + + +MSG BADMAG; + + + +INT wtflag; + +INT fcor; + +INT fsym; + +L_INT maxfile; + +L_INT maxstor; + +L_INT txtsiz; + +L_INT datsiz; + +L_INT datbas; + +L_INT stksiz; + +STRING errflg; + +INT magic; + +L_INT symbas; + +L_INT symnum; + +L_INT entrypt; + + + +INT argcount; + +INT signo; + +struct user u; + + - STRING symfil = "a.out"; - STRING corfil = "core"; - + +#define TXTHDRSIZ (sizeof(txthdr)) + + + +#ifndef EDDT + +readl(f,p,n) int f,n; long * p;{ + +#ifndef vax + + int t=0; + + do {t += read(f,&(p->loword),2); t += read(f,&(p->hiword),2); p++;} while (--n); + + return(t); + +#else + + return(read(f,p,n*sizeof(long))); + +#endif + +} + +#endif + + + +setsym() + +{ + +#ifndef EDDT + + TXTHDR txthdr; + + + + fsym=getfile(symfil,1); + + txtmap.ufd=fsym; + + IF readl(fsym, txthdr, TXTHDRSIZ/sizeof(txthdr[0]))==TXTHDRSIZ + + THEN magic=txthdr[0]; + + IF magic!=0410 ANDF magic!=0407 ANDF magic!=0412 ANDF magic!=0413 + + THEN magic=0; + + ELSE + + symnum=txthdr[4]/SYMTABSIZ; + + txtsiz=txthdr[1]; + + datsiz=txthdr[2]; + + symbas=txtsiz+datsiz; + + txtmap.f1=txtmap.f2=TXTHDRSIZ; + + switch (magic) { + + + + case 0412: + + txtmap.f1=txtmap.f2=(CLSIZE*NBPG); + + case 0407: + + txtmap.b1=0; + + txtmap.e1=symbas; + + txtmap.b2=datbas=0; + + txtmap.e2=symbas; + + break; + + + + case 0413: + + txtmap.f1=txtmap.f2=(CLSIZE*NBPG); + + case 0410: + + txtmap.b1=0; + + txtmap.e1=txtsiz; + + txtmap.b2=datbas=round(txtsiz,TXTRNDSIZ); + + txtmap.e2=datbas+datsiz; + + txtmap.f2+=txtmap.e1; + + } + + entrypt=txthdr[5]; + + symbas += txthdr[6]+txthdr[7]; + + symbas += magic==0412||magic==0413 ? (CLSIZE*NBPG) : TXTHDRSIZ; + + ststart = symbas; +++#ifdef FLEXNAMES +++ gstart = ststart+txthdr[4]; +++#endif + + /* set up symvec */ + + FI + + FI + + IF magic==0 THEN txtmap.e1=maxfile; FI + +#endif + +} + + + +setcor() + +{ - #ifndef EDDT + + fcor=getfile(corfil,2); + + datmap.ufd=fcor; + + IF read(fcor, &u, ctob(UPAGES))==ctob(UPAGES) - #ifdef VAX135 +++#ifndef STD + + ANDF (u.u_pcb.pcb_ksp & 0xF0000000L)==0x70000000L + +#else + + ANDF (u.u_pcb.pcb_ksp & 0xF0000000L)==0x80000000L + +#endif + + ANDF (u.u_pcb.pcb_usp & 0xF0000000L)==0x70000000L + + THEN + + signo = u.u_arg[0]&017; + + txtsiz = ctob(u.u_tsize); + + datsiz = ctob(u.u_dsize); + + stksiz = ctob(u.u_ssize); + + datmap.b1 = datbas = (magic==0410?round(txtsiz,TXTRNDSIZ):0); + + if (magic == 0413) + + datmap.b1 = datbas = txtsiz; + + datmap.e1=(magic==0407?txtsiz:datmap.b1)+datsiz; + +#ifdef STD + + datmap.f1 = ctob(USIZE); + +#else + + datmap.f1 = ctob(UPAGES); + +#endif + + datmap.b2 = maxstor-stksiz; + + datmap.e2 = maxstor; + +#ifdef STD + + datmap.f2 = ctob(USIZE)+(magic==0410?datsiz:datmap.e1); + +#else + + datmap.f2 = ctob(UPAGES)+((magic==0410 || magic == 0413) + + ? datsiz : datmap.e1); + +#endif + + signo = *(ADDR *)(((ADDR)&u)+ctob(UPAGES)-4*sizeof(int)); + + IF magic ANDF magic!=u.u_exdata.ux_mag + + THEN printf("%s\n",BADMAG); + + FI + + ELSE datmap.e1 = maxfile; + + FI - #endif + +} + + - #ifndef EDDT + +create(f) + +STRING f; + +{ int fd; + + IF (fd=creat(f,0644))>=0 + + THEN close(fd); return(open(f,wtflag)); + + ELSE return(-1); + + FI + +} + + + +getfile(filnam,cnt) + +STRING filnam; + +{ + + REG INT fsym; + + + + IF !eqstr("-",filnam) + + THEN fsym=open(filnam,wtflag); + + IF fsym<0 ANDF argcount>cnt + + THEN IF wtflag + + THEN fsym=create(filnam); + + FI + + IF fsym<0 + + THEN printf("cannot open `%s'\n", filnam); + + FI + + FI + + ELSE fsym = -1; + + FI + + return(fsym); + +} - #endif diff --cc usr/src/cmd/sdb/sub.c index 0000000000,60a789dda6,0000000000..7b986fe6df mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/sub.c +++ b/usr/src/cmd/sdb/sub.c @@@@ -1,0 -1,273 -1,0 +1,364 @@@@ +++static char sccsid[] = "@(#)sub.c 4.1 10/9/80"; + +#include "head.h" + +#include +++#include + +#include "cdefs.h" + +#include + +struct user u; + + + +char * + +readline(f) + +FILE *f; { + + static char buff[128]; + + + + register char *p; + + register int i; + + + + p = buff; + + do { + + if ((i = getc(f)) == EOF) { + + *p++ = '\004'; + + *p = '\n'; + + } + + else *p = i; + + } while (*p++ != '\n'); + + + + return(buff); + +} + + + +char * + +cpname(p, q) + +char *p, *q; { + + while(varchar(*q) || number(*q)) + + *p++ = *q++; + + *p = '\0'; + + return(q); + +} + + + +char * + +cpall(p, q) + +char *p, *q; { + + while (*q != '\n') + + *p++ = *q++; + + *p = '\0'; + + return(q); + +} + + + +eqany(c, s) + +char c, *s; { + + while(*s != '\0') + + if (c == *s++) return(1); + + return(0); + +} + + + +error(s) + +char *s; { + + printf("%s\n", s); + +} + + + +char * + +cpstr(p,q) + +char *p, *q; { + + do { + + *p++ = *q++; + + } while (*q != '\0'); + + *p = '\0'; + +} + +L_INT + +round(a,b) + +REG L_INT a, b; + +{ + + REG L_INT w; + + w = (a/b)*b; + + IF a!=w THEN w += b; FI + + return(w); + +} + + + +/* error handling */ + + + +chkerr() + +{ + + IF errflg ORF mkfault + + THEN error(errflg); + + longjmp(env, 0); + + FI + +} + + + +eqstr(s1, s2) + + REG STRING s1, s2; + +{ +++#ifndef FLEXNAMES + + REG STRING es1; +++#endif + + if (s2 == (STRING) -1) return(0); +++#ifndef FLEXNAMES + + es1 = s1+8; +++#endif + + WHILE *s1++ == *s2 +++#ifndef FLEXNAMES + + DO IF *s2++ == 0 ORF s1>=es1 +++#else +++ DO IF *s2++ == 0 +++#endif + + THEN return(1); + + FI + + OD + + return(0); + +} + + + +longseek(f, a) + +L_INT a; + +{ + + return(lseek(f,(long) a,0) != -1); + +} + + + + + +/* descriptor format to length */ + +dtol(d) + +char d; { + + switch(d) { + + + + case 'a': + + case 's': + + return(0); + + + + case 'b': + + case 'c': + + return(1); + + + + case 'h': + + return(2); + + + + case 'l': + + case 'f': + + return(4); + + + + case 'g': + + return(8); + + + + default: + + return(WORDSIZE); + + } + +} + + + +/* + + * checks equality of pattern pat with str, + + * assuming str is tructaed at length 8 + + */ + +eqpat(pat, str) + +char *pat, *str; { +++#ifndef FLEXNAMES + + return(eqpatr(pat, str, 0)); +++#else +++ return(eqpatr(pat, str)); +++#endif + +} + + +++#ifndef FLEXNAMES + +eqpatr(pat, str, cnt) +++#else +++eqpatr(pat, str) +++#endif + +char *pat, *str; { + + register int i; + + register char p, s; + + + + p = pat[0]; + + s = str[0]; +++#ifndef FLEXNAMES + + if (cnt == 8) return(1); +++#endif + + if (p == '?') { + + if (s == '\0') return(0); +++#ifndef FLEXNAMES + + return(eqpatr(pat+1, str+1, cnt+1)); +++#else +++ return(eqpatr(pat+1, str+1)); +++#endif + + } + + if (p == '*') { + + if (pat[1] == '\0') return(1); +++#ifndef FLEXNAMES + + for(i=1; i<8-cnt; i++) { + + if (eqpatr(pat+1, str+i, cnt+i)) return(1); +++#else +++ for(i=1; ; i++) { +++ if (eqpatr(pat+1, str+i)) return(1); +++#endif + + if (str[i] == '\0') return(0); + + } +++#ifndef FLEXNAMES + + return(0); +++#else +++ /*NOTREACHED*/ +++#endif + + } + + if ((eqany(p, ".[->") || p == '\0') && s == '\0') return(1); + + if (p != s) return(0); +++#ifndef FLEXNAMES + + return(eqpatr(pat+1, str+1, cnt+1)); +++#else +++ return(eqpatr(pat+1, str+1)); +++#endif + +} + + + +/* gets indirect address for pointers and subscripts */ + +getindir(class, addr, type) + +ADDR addr; { + + if (ISARY(type)) return(addr); + + if (class == N_RSYM) + + return(*(ADDR *)(((ADDR) &u) + R0 + (WORDSIZE)*addr)); - return(getval(addr, 'd')); +++ return(getval(addr, 'd', DSP)); + +} + + + +long + +readint(p) + +char **p; { + + int sign; + + + + if (**p == '-') { + + sign = -1; + + (*p)++; + + } else { + + sign = 1; + + } + + if (**p == '0') { + + (*p)++; + + if (**p == 'x' || **p == 'X') { + + (*p)++; + + return(sign * rint(p, 16, hexdigit, hexconv)); + + } + + else return(sign * rint(p, 8, octdigit, octconv)); + + } + + else return(sign * rint(p, 10, decdigit, decconv)); + +} + + + +long + +rint(p, base, digit, conv) + +char **p; + +int (*digit)(), (*conv)(); { + + long value; + + + + value = 0; + + while ((*digit)(**p)) value = base*value + (*conv)(*(*p)++); + + return(value); + +} + + + +octdigit(c) + +char c; { + + return(c >= '0' && c <= '7'); + +} + + + +octconv(c) + +char c; { + + return(c - '0'); + +} + + + +decdigit(c) + +char c; { + + return(c >= '0' && c <= '9'); + +} + + + +decconv(c) + +char c; { + + return(c - '0'); + +} + + + +hexdigit(c) + +char c; { + + return((c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || + + (c >= 'A' && c <= 'F')); + +} + + + +hexconv(c) + +char c; { + + if (c >= '0' && c <= '9') return(c - '0'); + + if (c >= 'a' && c <= 'f') return(c - 'a' + 10); + + if (c >= 'A' && c <= 'F') return(c - 'A' + 10); + + error("hex conversion error"); + + return(0); + +} + + + +/* decodes number, character or variable */ + +long + +argvalue(p) + +char *p; { + + register char ch; + + register long value; + + register ADDR j; + + char var[30]; + + + + ch = *p; + + if (ch == '\'') { + + value = *(p+1); + + } else if ((ch >= '0' && ch <= '9') || ch == '-') { + + value = readint(&p); + + } else if ((ch >= 'a' && ch <= 'z') || (ch >= 'A' && ch <= 'Z') || + + ch == '_') { + + cpname(var, p); + + j = varaddr(curproc()->pname, var); + + if (j == -1) { + + printf("Unknown variable: %s\n", argsp); + + return(-1); + + } - value = getval(j, typetodesc(sl_type, 0)[0]); +++ value = getval(j, typetodesc(sl_type, 0)[0], DSP); + + do { + + p++; + + } while (varchar(*p) || number(*p)); + + } + + return(value); + +} +++ +++prhex(v) +++long v; { +++ if (v < 0) { +++ v = -v; +++ printf("-"); +++ } +++ if (v <= 9) +++ printf("%d", v); +++ else +++ printf("0x%x", v); +++} +++ +++/* print hex number in field of length 12 */ +++prhex12(v) +++long v; { +++ if (v >= -9 && v <= 9) +++ printf("%-12d", v); +++ else +++ printf("0x%-12x", v); +++} +++ +++/* print line number followed by offset */ +++prlnoff(procp, v) +++struct proct *procp; ADDR v; { +++ int lineno, diff; +++ char *name; +++ name = procp->pname; +++ if (name[0] == '_') { +++#ifndef FLEXNAMES +++ printf("%.7s", name+1); +++#else +++ printf("%s", name+1); +++#endif +++ lineno = -1; +++ } else { +++#ifndef FLEXNAMES +++ printf("%8s", name); +++#else +++ printf("%s", name); +++#endif +++ lineno = adrtolineno((ADDR) v); +++ } +++ if (lineno == -1) +++ diff = v - procp->paddr; +++ else { +++ printf(":%d", lineno); +++ diff = v - lnfaddr; /* set by adrtolineno() */ +++ } +++ if (diff) { +++ printf("+"); +++ prhex(diff); +++ } +++} diff --cc usr/src/cmd/sdb/symt.c index 0000000000,a7d46ca6ec,0000000000..ff4082fcbc mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/symt.c +++ b/usr/src/cmd/sdb/symt.c @@@@ -1,0 -1,632 -1,0 +1,1007 @@@@ +++static char sccsid[] = "@(#)symt.c 4.1 10/9/80"; + +#include "head.h" + +#include +++#include +++ +++#ifndef STABTYPES +++#define STABTYPES N_STAB +++#endif + +#include + + + +struct user u; + +int compar(); + +char *symfil; + + +++#ifdef FLEXNAMES +++ +++struct nlist *symtab; +++char nullname[] = {0,0,0,0,0,0,0,0,0}; /* a few 0 bytes */ +++off_t stoff; +++ +++stread(buff, nbytes) +++struct nlist *buff; +++int nbytes; +++{ +++ register int from = stoff; +++ +++ stoff += nbytes; +++ if (stoff >= gstart) +++ return (-1); +++ if (nbytes < 0) { +++ from = stoff; +++ buff--; +++ } +++ from = (from - ststart); +++ *buff = symtab[from/sizeof (struct nlist)]; +++ return (sizeof (struct nlist)); +++} +++ +++stseek(off, rel) +++long off; +++{ +++ +++ if (rel == 1) +++ stoff += off; +++ else +++ stoff = off; +++} +++#define bread(a,b,c) stread(b,c) +++#define blseek(a,b,c) stseek(b,c) +++#endif +++ + +/* initialize file and procedure tables */ + +initfp() { + + struct nlist stentry; + + register struct proct *procp; + + register struct filet *filep; + + struct stat stbuf; + + + + long soffset; - int i; +++ int i, gflag = 0; + + char class; + + register char *p, *q; + + +++#ifdef FLEXNAMES +++ register struct nlist *sp; +++ int malformed = 0; +++ lseek(txtmap.ufd, gstart, 0); +++ if (read(txtmap.ufd, &ssiz, sizeof(ssiz)) != sizeof (ssiz)) { +++ printf("%s: no string table (old format?)\n", symfil); +++ exit(1); +++ } +++ strtab = (char *)malloc(ssiz); +++ if (strtab == 0) { +++ printf("no room for %d bytes of string table\n", ssiz); +++ exit(1); +++ } +++ ssiz -= sizeof (ssiz); +++ if (read(txtmap.ufd, strtab+sizeof (ssiz), ssiz) != ssiz) { +++ printf("%s: error reading string table\n", symfil); +++ exit(1); +++ } +++ i = gstart - ststart; +++ symtab = (struct nlist *)malloc(i); +++ if (symtab == 0) { +++ printf("no room for %d bytes of symbol table\n", i); +++ exit(1); +++ } +++ lseek(txtmap.ufd, ststart, 0); +++ if (read(txtmap.ufd, symtab, i) != i) { +++ printf("%s: error reading symbol table\n", symfil); +++ exit(1); +++ } +++ for (sp = &symtab[i/sizeof (struct nlist)]; --sp >= symtab; ) +++ if (sp->n_un.n_strx != 0) { +++ if (sp->n_un.n_strx < sizeof (ssiz) || sp->n_un.n_strx >= ssiz) { +++ if (malformed == 0) { +++ printf("danger: mangled symbol table\n"); +++ malformed = 1; +++ } +++ sp->n_un.n_name = nullname; +++ } else +++ sp->n_un.n_name = strtab + sp->n_un.n_strx; +++ } else +++ sp->n_un.n_name = nullname; +++#endif +++#ifndef VMUNIX + + sbuf.fd = txtmap.ufd; +++#endif +++ firstdata = MAXPOS; + + soffset = ststart; + + blseek(&sbuf,ststart,0); + + filep = files = badfile = (struct filet *) sbrk(sizeof filep[0]); + + procp = procs = badproc = (struct proct *) sbrk(sizeof procp[0]); + + + + for(;;) { + + if (bread(&sbuf, &stentry, sizeof stentry) < + + sizeof stentry) break; + + class = stentry.n_type & STABMASK; + + switch (class & STABMASK) { + + case N_SO: + + case N_SOL: +++ gflag++; + + if (filep == badfile) { + + p = sbrk(FILEINCR*sizeof filep[0]); + + if (p < 0) { + + perror("sdb"); + + exit(4); + + } + + q = p + FILEINCR*sizeof filep[0]; + + while (p > (char *) procs) + + *--q = *--p; + + badfile += FILEINCR; + + procp = (struct proct *) + + ((char *) procp + + + FILEINCR*sizeof filep[0]); + + procs = (struct proct *) + + ((char *) procs + + + FILEINCR*sizeof filep[0]); + + badproc = (struct proct *) + + ((char *)badproc + + + FILEINCR*sizeof filep[0]); + + } + + filep->faddr = stentry.n_value; + + filep->lineflag = (class == N_SOL); + + filep->stf_offset = soffset; +++#ifndef FLEXNAMES + + p = filep->sfilename; + + for (;;) { - for (i=0; i<8; i++) *p++ = stentry.n_name[i]; +++ for (i=0; i<8; i++) *p++ = stentry.n_un.n_name[i]; + + if (*(p-1) == '\0') break; + + if (bread(&sbuf, &stentry, sizeof stentry) + + < sizeof stentry) + + error("Bad N_SO entry (1)"); + + if ((stentry.n_type & STABMASK) != + + (unsigned char) class) + + error("Bad N_SO entry (2)"); + + soffset += sizeof stentry; + + } +++#else +++ filep->sfilename = stentry.n_un.n_name; +++#endif + + q = filep->sfilename; + + for (p=fp; *q; *p++ = *q++) ; + + *p = 0; + + if (stat(filework, &stbuf) == -1) + + printf("Warning: `%s' not found\n", + + filep->sfilename); + + else if (stbuf.st_mtime > symtime) + + printf("Warning: `%s' newer than `%s'\n", + + filep->sfilename, + + symfil); + + filep++; + + break; + + + + case N_TEXT: - if (stentry.n_name[0] != '_') break; +++ if (stentry.n_un.n_name[0] != '_') break; + + case N_FUN: + + case N_ENTRY: + + if (procp == badproc) { + + if (sbrk(PROCINCR*sizeof procp[0]) < 0) { + + perror("sdb"); + + exit(4); + + } + + badproc += PROCINCR; + + } +++#ifndef FLEXNAMES + + for(i=0; i<8; i++) - procp->pname[i] = stentry.n_name[i]; +++ procp->pname[i] = stentry.n_un.n_name[i]; +++#else +++ procp->pname = stentry.n_un.n_name; +++#endif + + procp->paddr = stentry.n_value; + + procp->st_offset = soffset; + + procp->sfptr = (class != N_TEXT) ? filep - 1 : badfile; + + procp->lineno = (class != N_TEXT) ? stentry.n_desc : 0; + + procp->entrypt = (class & STABMASK) == N_ENTRY; + + procp++; + + break; + + } - if (stentry.n_type & N_EXT && !extstart) { - extstart = soffset; +++ if (stentry.n_type & N_EXT) { +++ if (!extstart) +++ extstart = soffset; +++ if (stentry.n_type == N_DATA | N_EXT || +++ stentry.n_type == N_BSS | N_EXT || +++ stentry.n_value < firstdata) +++ firstdata = stentry.n_value; + + } + + soffset += sizeof stentry; + + } + + qsort(procs, procp-procs, sizeof procs[0], compar); - badproc->st_offset = soffset; +++ badproc->st_offset = badfile->stf_offset = soffset; + + badproc->sfptr = procp->sfptr = badfile; +++#ifndef FLEXNAMES + + badproc->pname[0] = badfile->sfilename[0]= + + procp->pname[0] = filep->sfilename[0] = '\0'; +++#else +++ badproc->pname = badfile->sfilename= +++ procp->pname = filep->sfilename = nullname; +++#endif + + +++ if (!gflag) +++ printf("Warning: `%s' not compiled with -g\n", symfil); + + setcur(1); + +} + + + +/* returns current procedure from state (curfile, fline) */ + +struct proct * + +curproc() { + + register ADDR addr; + + + + addr = getaddr("", fline); + + if (addr == -1) return(badproc); + + return(adrtoprocp(addr)); + + + +} + + + +/* returns procedure s, uses curproc() if s == NULL */ + + + +struct proct * + +findproc(s) + +char *s; { - register struct proct *p; +++ register struct proct *p, *altproc; + + + + if (s[0] == '\0') return(curproc()); +++ altproc = badproc; + + - for(p=procs; p->pname[0]; p++) - if (eqstr(p->pname, s)) return(p); - - if (debug) printf("%s(): unknown name\n", s); - return(badproc); +++ for (p=procs; p->pname[0]; p++) { +++ if (eqpat(s, p->pname)) return(p); +++ if (p->pname[0] == '_' && eqpatr(s, p->pname+1, 1)) +++ altproc = p; +++ } +++ return(altproc); + +} + + + +/* returns file s containing filename */ + +struct filet * + +findfile(s) + +char *s; { + + register struct filet *f; + + for (f=files; f->sfilename[0]; f++) { - if (eqstr(f->sfilename, s)) { +++ if (eqpat(f->sfilename, s)) { + + for( ; f->lineflag; f--) ; + + if (f < files) error("Bad file array"); + + return(f); + + } + + } + + return(f); + +} + + + +/* + + * slookup(): - * looks up variable matching pat starting at offset in a.out, searching - * backwards, ignoring nested blocks to beginning to procedure. +++ * looks up variable matching pat starting at (offset + sizeof stentry) +++ * in a.out, searching backwards, +++ * ignoring nested blocks to beginning to procedure. + + * Returns its offset and symbol table entries decoded in sl_* + + * + + * If comblk == "*" then match both within and outside common blocks, + + * if comblk == "" then match only outside common blocks, + + * else match only within comblk. + + */ + + + +long + +slookup(pat, poffset, stelt) + +long poffset; char *pat; { + + slookinit(); + + slooknext(pat, poffset, stelt, "*"); + +} + + + +int clevel, level, fnameflag, comfound, incomm; + + + +slookinit() { + + clevel = level = fnameflag = comfound = incomm = 0; + +} + + + +long + +slooknext(pat, poffset, stelt, comblk) + +long poffset; char *pat, *comblk; { + + register int i; + + register long offset; + + char class, *q; + + struct nlist stentry; + + struct proct *procp, *p; + + + + offset = poffset + sizeof stentry; + + if (debug) printf("slookup(%s,%d)\n",pat,offset); + + blseek(&sbuf, offset, 0); + + + + for (;;) { + + offset -= sizeof stentry; + + if (offset < ststart) break; + + if (bread(&sbuf, &stentry+1, -sizeof stentry) + + < sizeof stentry) break; + + class = stentry.n_type & STABMASK; + + switch (class & STABMASK) { + + case 0: + + break; + + case N_FUN: + + return(-1); + + case N_RBRAC: + + level++; + + break; + + case N_LBRAC: + + level--; + + break; + + case N_ECOMM: - for (q = &stentry.n_name[7]; q>=stentry.n_name; q--) { +++#ifndef FLEXNAMES +++ for (q = &stentry.n_un.n_name[7]; q>=stentry.n_un.n_name; q--) { + + if (*q == '_') { + + *q = '\0'; + + break; + + } + + } - if (eqpat(comblk, stentry.n_name)) +++#else +++ for (q = stentry.n_un.n_name; *q; q++) +++ continue; +++ if (*--q == '_') +++ *q = 0; +++#endif +++ if (eqpat(comblk, stentry.n_un.n_name)) + + comfound = 1; + + incomm = 1; + + case N_ECOML: + + clevel++; + + break; + + case N_BCOMM: + + comfound = incomm = 0; + + clevel--; + + break; + + case N_FNAME: + + if (fnameflag) + + break; - procp = findproc(stentry.n_name); +++ procp = findproc(stentry.n_un.n_name); + + for (p=procs; p->pname[0]; p++) { + + if (p->entrypt == 0 && + + p->st_offset > procp->st_offset && + + p->st_offset < offset) + + offset = p->st_offset; + + } + + clevel = level = 0; + + fnameflag++; + + blseek(&sbuf, offset, 0); + + break; + + default: - if (level <= 0 && eqpat(pat, stentry.n_name) && - stentry.n_name[0] && class & STABTYPES && +++ if (level <= 0 && eqpat(pat, stentry.n_un.n_name) && +++ stentry.n_un.n_name[0] && class & STABTYPES && + + (eqstr("*", comblk) || + + (comblk[0] == '\0' && incomm == 0) || + + comfound) && + + (stelt == (class == N_SSYM))) { + + if (class == N_LENG) { + + sl_size = stentry.n_value; + + offset -= sizeof stentry; + + bread(&sbuf, &stentry+1, + + -sizeof stentry); +++ if (stentry.n_type&~N_EXT == N_BSS) { +++ bread(&sbuf, &stentry+1, +++ -sizeof stentry); +++ offset -= sizeof stentry; +++ } + + } + + else sl_size = 0; + + sl_class = stentry.n_type & STABMASK; + + sl_type = stentry.n_desc; + + sl_addr = stentry.n_value; +++#ifndef FLEXNAMES + + for (i=0; i<8; i++) sl_name[i] = - stentry.n_name[i]; +++ stentry.n_un.n_name[i]; +++#else +++ sl_name = stentry.n_un.n_name; +++#endif + + if (clevel != 0) docomm(offset); + + return(offset - sizeof stentry); + + } + + } + + } + + return(-1); + +} + + + +/* - * Look up global variable matching pat +++ * Look up global variable matching pat starting at (filestart+sizeof stentry) + + * Return its offset and symbol table entries decoded in sl_* + + */ + +long + +globallookup(pat, filestart, stelt) + +char *pat; long filestart; { + + register int offset, i; + + struct nlist stentry; + + int class, clevel; + + + + if (debug) printf("globallookup(%s,%d)\n", pat,filestart); + + blseek(&sbuf, filestart, 0); + + offset = filestart - sizeof stentry; + + clevel = 0; + + do { + + if (bread(&sbuf, &stentry, sizeof stentry) < + + sizeof stentry) return(-1); + + offset += sizeof stentry; + + } while ((stentry.n_type & STABMASK) == N_SO); + + for (;;) { + + class = stentry.n_type & STABMASK; + + switch (class & STABMASK) { + + case N_SO: + + return(-1); + + case N_ECOMM: + + clevel--; + + break; + + case N_BCOMM: + + clevel++; + + break; + + default: - if (eqpat(pat, stentry.n_name) - && stentry.n_name[0] && class & STABTYPES) { +++ if (eqpat(pat, stentry.n_un.n_name) +++ && stentry.n_un.n_name[0] && class & STABTYPES) { + + sl_class = stentry.n_type & STABMASK; + + if (sl_class != N_GSYM && sl_class != N_SSYM && - sl_class != N_STSYM) goto g1; +++ sl_class != N_STSYM && sl_class != N_LCSYM) goto g1; + + if (stelt != (sl_class == N_SSYM)) goto g1; + + sl_size = 0; + + sl_type = stentry.n_desc; + + sl_addr = stentry.n_value; - for (i=0; i<8; i++) sl_name[i] = stentry.n_name[i]; +++#ifndef FLEXNAMES +++ for (i=0; i<8; i++) sl_name[i] = stentry.n_un.n_name[i]; +++#else +++ sl_name = stentry.n_un.n_name; +++#endif + + if (clevel != 0) docomm(offset); + + goto g2; + + } + + } + +g1: if (bread(&sbuf, &stentry, sizeof stentry) < sizeof stentry) + + return(-1); + + offset += sizeof stentry; + + } + +g2: bread(&sbuf, &stentry, sizeof stentry); +++ if (stentry.n_type&~N_EXT==N_BSS) { +++ bread(&sbuf, &stentry, sizeof stentry); +++ offset += sizeof stentry; +++ } + + if (((stentry.n_type & STABMASK) == N_LENG) && - (eqpat(sl_name, stentry.n_name))) +++ (eqpat(sl_name, stentry.n_un.n_name))) + + sl_size = stentry.n_value; + + + + if (sl_class == N_GSYM && (clevel == 0)) { + + blseek(&sbuf, extstart, 0); + + for(;;) { + + if (bread(&sbuf, &stentry, sizeof stentry) + + < sizeof stentry) + + return(-1); - if (stentry.n_name[0] != '_') continue; - if (eqpatr(sl_name, stentry.n_name+1, 1)) { +++ if (stentry.n_un.n_name[0] != '_') continue; +++ if (eqpatr(sl_name, stentry.n_un.n_name+1, 1)) { + + sl_addr = stentry.n_value; + + break; + + } + + } + + } + + return(offset + sizeof stentry); + +} + + + +/* core address to procedure (pointer to proc array) */ + +struct proct * + +adrtoprocp(addr) + +ADDR addr; { + + register struct proct *procp, *lastproc; + + lastproc = badproc; + + for (procp=procs; procp->pname[0]; procp++) { + + if (procp->paddr > addr) break; + + if (procp->entrypt == 0) + + lastproc = procp; + + } + + return (lastproc); + +} + + + + + +/* core address to file (pointer to file array) */ + +struct filet * + +adrtofilep(addr) + +ADDR addr; { + + register struct filet *filep; + + for (filep=files; filep->sfilename[0]; filep++) { + + if (filep->faddr > addr) break; + + } + + return (filep != files ? filep-1 : badfile); + +} + + - /* core address to linenumber */ +++/* +++ * core address to linenumber +++ * Sets external exactaddr to addr if addr is NOT the first instruction +++ * of a line, set to -1 otherwise. +++ * Sets external lnfaddr to address of first statement in line. +++ */ + +long lastoffset; + + + +adrtolineno(addr) + +ADDR addr; { + + register int lineno; + + long offset; + + struct nlist stentry; + + +++ exactaddr = addr; + + lineno = lastoffset = -1; - offset = adrtoproc(addr)->st_offset; +++ offset = adrtoprocp(addr)->st_offset; + + blseek(&sbuf, offset, 0); + + for (;;) { + + if (bread(&sbuf, &stentry, sizeof stentry) + + < sizeof stentry) break; +++ if (stentry.n_type == N_SO) +++ break; + + if (stentry.n_type == N_SLINE) { - if (stentry.n_value > addr) break; +++ if (stentry.n_value > addr) +++ break; + + lastoffset = offset; + + lineno = stentry.n_desc; +++ lnfaddr = stentry.n_value; +++ if (stentry.n_value == addr) +++ exactaddr = -1; + + } + + offset += sizeof stentry; + + } + + return (lineno); + +} + + + + + +/* address to a.out offset */ + +long + +adrtostoffset(addr) + +ADDR addr; { + + adrtolineno(addr); + + return(lastoffset); + +} + + + + + +/* + + * Set (curfile, lineno) from core image. + + * Returns 1 if there is a core image, 0 otherwise. + + * + + * Print the current line iff verbose is set. + + */ + +setcur(verbose) { + + register struct proct *procp; + + + + dot = *(ADDR *) (((ADDR) &u) + PC); + + + + if (dot == 0) { + + printf("No core image\n"); + + goto setmain; + + } + + procp = adrtoprocp(dot); + + if ((procp->sfptr) != badfile) { + + finit(adrtofilep(procp->paddr)->sfilename); + + ffind(adrtolineno(dot)); + + if (verbose) { +++ if (exactaddr != -1) +++ printf("0x%x in ", exactaddr); +++#ifndef FLEXNAMES + + printf("%.8s:", procp->pname); +++#else +++ printf("%s:", procp->pname); +++#endif + + fprint(); + + } + + return(1); + + } + + if (verbose) { + + if (procp->pname[0] == '_') +++#ifndef FLEXNAMES + + printf("%.7s: address 0x%x\n", procp->pname+1, dot); +++#else +++ printf("%s: address 0x%x\n", procp->pname+1, dot); +++#endif + + else +++#ifndef FLEXNAMES + + printf("%.8s: address %d\n", procp->pname, dot); +++#else +++ printf("%s: address %d\n", procp->pname, dot); +++#endif + + } + + + +setmain: + + procp = findproc("MAIN_"); + + if ((procp->pname[0] != 'M') || (procp->sfptr == badfile)) { + + procp = findproc("main"); + + if ((procp->pname[0] != 'm') || (procp->sfptr == badfile)) { - nolines = 1; - printf("main not compiled with debug flag\n"); +++ /* printf("main not compiled with debug flag\n"); */ + + return(0); + + } + + } + + finit(procp->sfptr->sfilename); + + ffind(procp->lineno); + + return(0); + +} + + + +compar(a, b) + +struct proct *a, *b; { + + if (a->paddr == b->paddr) { + + if (a->pname[0] == '_') return(-1); + + if (b->pname[0] == '_') return(1); + + return(0); + + } + + return(a->paddr < b->paddr ? -1 : 1); + +} + + + +/* gets offset of file or procedure named s */ + +nametooffset(s) + +char *s; { + + register struct filet *f; + + register struct proct *p; + + + + if (*s == '\0') + + return(-1); + + if (eqany('.', s)) { + + f = findfile(s); + + return(f->sfilename[0] ? f->stf_offset : -1); + + } + + p = findproc(s); + + return(p->pname[0] ? p->st_offset : -1); + +} +++ + +/* returns s if its a filename, its file otherwise */ + +char * + +nametofile(s) + +char *s; { + + register struct proct *p; + + + + if (eqany('.', s)) { + + return(s); + + } + + p = findproc(s); + + return(adrtofilep(p->paddr)->sfilename); + +} + + + + + +/* line number to address, starting at offset in a.out */ + +/* assumes that offset is within file */ + +lntoaddr(lineno, offset, file) + +long offset; char *file; { + + struct nlist stentry; + + register int i, ignore = 0; + + register int bestln=BIGNUM; + + ADDR bestaddr; + + char *p; + + + + blseek(&sbuf, offset, 0); + + + + do { + + if (bread(&sbuf, &stentry, sizeof stentry) < + + sizeof stentry) return(-1); + + } while ((stentry.n_type & STABMASK) == N_SO); + + for (;;) { + + switch(stentry.n_type & STABMASK) { + + case N_SLINE: + + if (!ignore) { + + if (stentry.n_desc == lineno) + + return(stentry.n_value); + + if (stentry.n_desc > lineno && + + stentry.n_desc < bestln) { + + bestln = stentry.n_desc; + + bestaddr = stentry.n_value; + + } + + } + + break; + + + + case N_SO: + + goto ret; + + + + case N_SOL: + + p = file; +++#ifndef FLEXNAMES + + for (;;) { + + for (i=0; i<8; i++) { - if (*p != stentry.n_name[i]) goto neq; +++ if (*p != stentry.n_un.n_name[i]) goto neq; + + if (*p++ == '\0') break; + + } - if (stentry.n_name[7] == '\0') +++ if (stentry.n_un.n_name[7] == '\0') + + break; + + if (bread(&sbuf, &stentry, sizeof stentry) + + < sizeof stentry) + + error("Bad N_SO entry (1)"); + + if ((stentry.n_type & STABMASK) != + + (unsigned char) N_SOL) + + error("Bad N_SO entry (2)"); + + } +++#else +++ if (strcmp(file, stentry.n_un.n_name)) +++ goto neq; +++#endif + + ignore = 0; + + break; + + + +neq: ignore++; + + break; + + } + + if (bread(&sbuf, &stentry, sizeof stentry) < sizeof stentry) + + break; + + } + +ret: return(bestln == BIGNUM ? -1 : bestaddr); + +} + + + +/* gets address of proc:number */ + +getaddr(proc,integ) + +char *proc; { + + register long offset; + + register char *s, *f; + + ADDR addr; + + + + s = proc[0] ? proc : curfile; + + if (*s == '\0') + + return(-1); + + offset = nametooffset(s); + + f = nametofile(s); + + if (debug) printf("getaddr() computed offset %d", offset); + + if (offset == -1) { + + addr = extaddr(proc); + + if (addr != -1) addr += 2; /* MACHINE DEPENDENT */ + + if (debug) printf(" extaddr computed %d\n", addr); + + return(addr); + + } + + if (integ) + + addr = lntoaddr(integ, offset, s); + + else { - addr = findproc(proc)->paddr + 2; /* MACHINE DEPENDENT */ +++ ADDR oldaddr; +++ oldaddr = findproc(proc)->paddr + 2; /* MACHINE DEPENDENT */ + + addr = lntoaddr(adrtolineno(addr)+1, offset, f); +++ if (addr == -1) +++ addr = oldaddr; + + } + + if (debug) printf(" and addr %d\n", addr); + + if (addr == -1) return(-1); + + return(addr); + +} + + + +/* returns address of external */ + +ADDR + +extaddr(name) + +char *name; { + + struct nlist stentry; + + blseek(&sbuf, extstart, 0); + + + + for (;;) { + + if (bread(&sbuf, &stentry, sizeof stentry) < sizeof stentry) + + return(-1); - if (stentry.n_name[0] == '_' && - eqpatr(name, stentry.n_name+1, 1)) +++ if (stentry.n_un.n_name[0] == '_' && +++ eqpatr(name, stentry.n_un.n_name+1, 1)) + + return(stentry.n_value); + + } + +} + + +++ +++/* +++ * Look up external data symbol matching pat starting at +++ * (filestart+sizeof stentry) +++ * Return its address in sl_addr and name in sl_name. +++ */ +++long +++extlookup(pat, filestart) +++char *pat; long filestart; { +++ register int offset, i; +++ struct nlist stentry; +++ +++ blseek(&sbuf, filestart, 0); +++ offset = filestart - sizeof stentry; +++ do { +++ if (bread(&sbuf, &stentry, sizeof stentry) < +++ sizeof stentry) return(-1); +++ offset += sizeof stentry; +++ } while ((stentry.n_type & STABMASK) == N_SO); +++ for (;;) { +++ if (stentry.n_un.n_name[0] == '_' && +++ stentry.n_type == (N_DATA | N_EXT) && +++ eqpatr(pat, stentry.n_un.n_name+1, 1)) { +++ sl_addr = stentry.n_value; +++#ifndef FLEXNAMES +++ for (i=0; i<7; i++) sl_name[i] = stentry.n_un.n_name[i+1]; +++#else +++ sl_name = stentry.n_un.n_name; +++#endif +++ return(offset + sizeof stentry); +++ } +++g1: if (bread(&sbuf, &stentry, sizeof stentry) < sizeof stentry) +++ return(-1); +++ offset += sizeof stentry; +++ } +++} +++ + +/* find enclosing common blocks and fix up addresses */ + +docomm(offset) + +long offset; { + + struct nlist stentry; + + + + for (;;) { + + if (bread(&sbuf, &stentry, sizeof stentry) < sizeof stentry) { + + error("Bad common block"); + + return; + + } + + sl_class = N_GSYM; + + if ((stentry.n_type & STABMASK) == N_ECOMM) { - sl_addr += extaddr(stentry.n_name); +++ sl_addr += extaddr(stentry.n_un.n_name); + + blseek(&sbuf, offset, 0); + + return; + + } + + if ((stentry.n_type & STABMASK) == N_ECOML) { + + sl_addr += stentry.n_value; + + blseek(&sbuf, offset, 0); + + return; + + } + + } + +} + + + +/* determine if class is that of a variable */ + +char pctypes[] = {N_GSYM, N_STSYM, N_LCSYM, N_RSYM, N_SSYM, N_LSYM, + + N_PSYM, 0}; + +varclass(class) + +char class; { + + char *p; + + + + for (p=pctypes; *p; p++) { + + if (class == *p) + + return(1); + + } + + return(0); + +} +++ +++/* +++ * address to external name +++ * returns difference between addr and address of external +++ * name returned in sl_name +++ */ +++adrtoext(addr) +++ADDR addr; { +++ struct nlist stentry; +++ register int i, prevdiff = MAXPOS, diff; +++ +++ blseek(&sbuf, extstart, 0); +++ for (;;) { +++ if (bread(&sbuf, &stentry, sizeof stentry) +++ < sizeof stentry) +++ return (prevdiff!=MAXPOS ? prevdiff : -1); +++ if (stentry.n_type == (N_DATA | N_EXT) || +++ stentry.n_type == (N_BSS | N_EXT)) { +++ diff = addr - stentry.n_value; +++ if (diff >= 0 && diff < prevdiff) { +++#ifndef FLEXNAMES +++ for (i=0; i<7; i++) +++ sl_name[i] = stentry.n_un.n_name[i+1]; +++#else +++ sl_name = stentry.n_un.n_name; +++#endif +++ if (diff == 0) +++ return(0); +++ prevdiff = diff; +++ } +++ } +++ } +++} +++ +++/* +++ * address to local name in procp +++ * returns difference between addr and address of local +++ * returned in sl_name +++ */ +++adrtolocal(addr, procp) +++ADDR addr; struct proct *procp; { +++ struct nlist stentry; +++ register int i, prevdiff = MAXPOS, diff; +++ +++ blseek(&sbuf, procp->st_offset + sizeof stentry, 0); +++ for (;;) { +++ if (bread(&sbuf, &stentry, sizeof stentry) +++ < sizeof stentry) +++ return(prevdiff!=MAXPOS ? prevdiff : -1); +++ if (stentry.n_type == N_FUN) +++ return(prevdiff!=MAXPOS ? prevdiff : -1); +++ if (stentry.n_type == N_LSYM) { +++ diff = addr - stentry.n_value; +++ if (diff >= 0 && diff < prevdiff) { +++#ifndef FLEXNAMES +++ for (i=0; i<8; i++) +++ sl_name[i] = stentry.n_un.n_name[i]; +++#else +++ sl_name = stentry.n_un.n_name; +++#endif +++ if (diff == 0) +++ return(0); +++ prevdiff = diff; +++ } +++ } +++ } +++} +++ +++/* +++ * address to parameter name in procp +++ * returns difference between addr and address of local +++ * returned in sl_name +++ */ +++adrtoparam(addr, procp) +++ADDR addr; struct proct *procp; { +++ struct nlist stentry; +++ register int i, prevdiff = MAXPOS, diff; +++ +++ blseek(&sbuf, procp->st_offset + sizeof stentry, 0); +++ for (;;) { +++ if (bread(&sbuf, &stentry, sizeof stentry) +++ < sizeof stentry) +++ return(prevdiff!=MAXPOS ? prevdiff : -1); +++ if (stentry.n_type == N_FUN) +++ return(prevdiff!=MAXPOS ? prevdiff : -1); +++ if (stentry.n_type == N_PSYM) { +++ diff = addr - stentry.n_value; +++ if (diff >= 0 && diff < prevdiff) { +++#ifndef FLEXNAMES +++ for (i=0; i<8; i++) +++ sl_name[i] = stentry.n_un.n_name[i]; +++#else +++ sl_name = stentry.n_un.n_name; +++#endif +++ if (diff == 0) +++ return(0); +++ prevdiff = diff; +++ } +++ } +++ } +++} +++ +++/* +++ * register number to register variable name in procp +++ * returned in sl_name +++ */ +++adrtoregvar(regno, procp) +++ADDR regno; struct proct *procp; { +++ struct nlist stentry; +++ register int i; +++ +++ blseek(&sbuf, procp->st_offset + sizeof stentry, 0); +++ for (;;) { +++ if (bread(&sbuf, &stentry, sizeof stentry) +++ < sizeof stentry) return(-1); +++ if (stentry.n_type == N_FUN) +++ return(-1); +++ if (stentry.n_type == N_RSYM) { +++ if (stentry.n_value == regno) { +++#ifndef FLEXNAMES +++ for (i=0; i<8; i++) +++ sl_name[i] = stentry.n_un.n_name[i]; +++#else +++ sl_name = stentry.n_un.n_name; +++#endif +++ return(0); +++ } +++ } +++ } +++} +++ +++/* sets file map for M command */ +++setmap(s) +++char *s; { +++ union { +++ MAP *m; +++ L_INT *mp; +++ } amap; +++ int starflag = 0; +++ +++ amap.mp = 0; +++ for (; *s; s++) { +++ switch (*s) { +++ case '/': +++ amap.m = &datmap; +++ break; +++ case '?': +++ amap.m = &txtmap; +++ break; +++ case '*': +++ starflag++; +++ break; +++ default: +++ goto sout; +++ } +++ } +++ +++sout: if (amap.mp == 0) { +++ error("Map `?' or `/' must be specified"); +++ return; +++ } +++ if (starflag) +++ amap.mp += 3; +++ for (; *s; s++) { +++ if (*s >= '0' && *s <= '9') +++ *(amap.mp)++ = readint(&s); +++ } +++} diff --cc usr/src/cmd/sdb/udef.c index 0000000000,c5bd755138,0000000000..7cff87608f mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/udef.c +++ b/usr/src/cmd/sdb/udef.c @@@@ -1,0 -1,2 -1,0 +1,3 @@@@ +++static char sccsid[] = "@(#)udef.c 4.1 10/9/80"; + +#include + +char u[ctob(UPAGES)]; /* struct user u */ diff --cc usr/src/cmd/sdb/version.c index 0000000000,14fe9cd96b,0000000000..4c6df53d84 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/version.c +++ b/usr/src/cmd/sdb/version.c @@@@ -1,0 -1,3 -1,0 +1,4 @@@@ +++static char sccsid[] = "@(#)version.c 4.1 10/9/80"; + +version() { - error("Version 2.5+"); +++ error("Version 2.6 - February 1, 1980"); + +} diff --cc usr/src/cmd/sdb/xeq.c index 0000000000,586969150a,0000000000..3e0ce25b5f mode 000000,100644,000000..100644 --- a/usr/src/cmd/sdb/xeq.c +++ b/usr/src/cmd/sdb/xeq.c @@@@ -1,0 -1,336 -1,0 +1,330 @@@@ +++static char sccsid[] = "@(#)xeq.c 4.1 10/9/80"; + +#include "head.h" + +#include +++#include + +struct user u; + +#include + +INT signo; + +INT adrflg; + +INT pid; + +ADDR userpc; + +L_INT cntval; + + + + + +/* service routines for sub process control */ + + + + + +/* + + * single step until loc with descriptor format d is modified + + * return its new value. + + */ + +monex(loc, d) + +ADDR loc; char d; { + + register ADDR oldval; + + - oldval = getval(loc, d); +++ oldval = getval(loc, d, DSP); + + do { + + subpcs('s'); - } while (oldval == getval(loc, d)); - return(getval(loc, d)); +++ } while (oldval == getval(loc, d, DSP)); +++ return(getval(loc, d, DSP)); + +} + + + +/* single step count source stmts */ + +singstep(count, cmd) + + char cmd; { + + register int thisline, curline; + + register struct proct *thisproc; + + + + if (sdbttym.sg_flags != userttym.sg_flags) + + stty(2, &userttym); + + dot = *(ADDR *) (((ADDR) &u) + PC); + + thisproc = adrtoprocp(dot); + + thisline = adrtolineno(dot); + + if (count == 0) count = 1; + + for(; count; count--) { + + do { - if (cmd == 'S') { +++ if (cmd == 'S') { /* MACHINE DEPENDENT */ + + dot = *(ADDR *) (((ADDR) &u) + PC); + + if ((get(dot,ISP) & 0xff) == 0xfb){ /* calls */ + + int retaddr; + + subpcs('s'); + + retaddr = + + *(ADDR *) (((ADDR) &u) + USP) + 16; + + retaddr = dot = get(retaddr, DSP); + + subpcs('b'); + + subpcs('c'); + + dot = retaddr; + + subpcs('d'); + + dot = *(ADDR *) (((ADDR) &u) + PC); + + if (retaddr != dot && signo == 0) { + + gtty(2, &userttym); + + if (sdbttym.sg_flags != + + userttym.sg_flags) + + stty(2, &sdbttym); + + printf("Breakpoint at \n"); + + return; + + } + + continue; + + } + + } + + + + subpcs('s'); + + dot = *(ADDR *) (((ADDR) &u) + PC); + + curline = adrtolineno(dot); + + } while (!signo && + + ((thisproc == adrtoprocp(dot) && thisline == curline) || + + curline == -1)); + + gtty(2, &userttym); + + if (sdbttym.sg_flags != userttym.sg_flags) + + stty(2, &sdbttym); + + if (signo) return; + + } + +} + + + +doscall() { - int subargs[NUMARGS]; /* subargs[0] = address, - subargs[1] = number of arguments - subargs[2:NUMARGS] = actual arguments */ +++ int subargs[NUMARGS]; +++ /* subargs[0] = address, +++ * subargs[1] = number of arguments +++ * subargs[2:NUMARGS] = actual arguments +++ */ + + union { - struct { - int w[128-NUMARGS]; - }; - struct { - char c[4*(128-NUMARGS)]; - }; +++ int w[128-NUMARGS]; +++ char c[4*(128-NUMARGS)]; + + }substr; + + + + register int i, numchars, *subargp; + + register char ch; + + ADDR straddr, adr, praddr; + + ADDR j; + + + + praddr = extaddr(proc); + + if (praddr == -1) { + + printf("Cannot find %s\n", proc); + + return; + + } + + straddr = extaddr("_dbargs"); + + if (straddr == -1) { + + error("Program not loaded with -lg"); + + return; + + } + + + + numchars = 0; + + subargp = subargs; + + argsp++; + + *subargp++ = praddr; + + subargp++; + + + + for (i=0; i sizeof substr.c) { + + error("Too many string constants"); + + return; + + } + + } + + } else if ((ch >= '0' && ch <= '9') || ch == '-') { + + *subargp++ = readint(&argsp); + + } else if ((ch >= 'a' && ch <= 'z') || + + (ch >= 'A' && ch <= 'Z') || ch == '_') { + + cpname(var, argsp); + + j = varaddr(curproc()->pname, var); + + if (j == -1) { + + return; + + } + + *subargp++ = + + sl_class == N_RSYM ? + + *(ADDR *)(((ADDR) &u) + R0 + (WORDSIZE)*j) : - getval(j, typetodesc(sl_type, 0)[0]); +++ getval(j, typetodesc(sl_type, 0)[0], DSP); + + do { + + argsp++; + + } while (varchar(*argsp) || number(*argsp)); + + } else if (ch != ')') { + + printf("Unexpected character %c\n", ch); + + return; + + } + + + + do { + + ch = *argsp++; + + } while(ch == ' '); + + if (ch == ')') { + + if (scallx == 0) { + + scallx = 1; + + pcs = *(ADDR *)(((ADDR)&u)+PC); + + fps = *(ADDR *)(((ADDR)&u)+FP); + + aps = *(ADDR *)(((ADDR)&u)+AP); + + if (bkpts = scanbkpt(userpc)) { + + if (flagss = bkpts->flag) { + + bkpts->flag = BKPTSET; + + } + + } + + } + + dot = *(ADDR *)(((ADDR)&u)+PC) = extaddr("_dbsubc"); + + if (dot == -1) { + + error("Internal error - cannot find _dbsubc"); + + return; + + } + + adrflg = 1; + + cntval = 1; + + if (pid == 0 || signo) subpcs('r'); + + subargs[1] = (subargp - subargs) - 2; + + adr = straddr; + + for (j=0; j<=(subargp-subargs); j++) { + + put(adr, DSP, subargs[j]); + + adr += WORDSIZE; + + } + + adr = straddr + sizeof subargs; + + for (j=0; j<(numchars+WORDSIZE-1)/WORDSIZE; j++) { + + put(adr, DSP, substr.w[j]); + + adr += WORDSIZE; + + } + + dschar = *argsp++; + + errflg = 0; + + dopcs('c'); + + if (!signo) printf("Breakpoint"); + + printf(" at\n"); + + return; + + } + + while (*argsp == ' ' || *argsp == ',') + + argsp++; + + } + + + + error ("Too many arguments"); + + + +} + + + + + +/* get arguments from core file, place them in args */ + +getargs() { + + struct proct *procp; + + ADDR p, av; + + int ac, i; + + char *argsp = args; + + union { - struct { - char c[WORDSIZE]; - }; - struct { - int w; - }; - struct { - float f; - } +++ char c[WORDSIZE]; +++ int w; +++ float f; + + } word; + + + + if ((procp = initframe()) == badproc) goto old1; + + do { + + if (eqstr("main", procp->pname)) + + goto fnd; + + } while ((procp = nextframe()) != badproc); + + + +old1: cpstr(args, oldargs); + + printf("%s %s\n", symfil, args); + + return; + + + +fnd: ac = get(argp, DSP); + + if ((ac == 0) || (ac & 0xff)) goto old1; + + ac = get(argp+4, DSP); + + av = (ADDR) get(argp+8, DSP); + + + + av += WORDSIZE; + + ac--; + + + + for (; ac; ac--) { + + p = (ADDR) get(av, DSP); + + av += WORDSIZE; + + for (;;) { + + word.w = get(p, DSP); + + for (i=0; iflag = flagss; + + scallx = 0; + + longjmp(env, 0); + + } + +} + + + +/* execute commands from a breakpoint */ + +acommand(cmds) + +char *cmds; { + + char *p = cmds; + + int endflg = 0; + + + + setcur(0); + + do { /* process a command */ + + for (;;) { + + if (*p == ';') { + + *p = '\n'; + + break; + + } + + if (*p == '\n') { + + endflg++; + + break; + + } + + p++; + + } + + if (decode(cmds) == 1) { + + printf("Bad command: "); + + do { + + printf("%c", *cmds); + + } while (*cmds++ != '\n'); + + return; + + } + + docommand(); + + p = cmds = p + 1; + + } while (!endflg); + +} diff --cc usr/src/cmd/size.c index 0000000000,6aedaef5ff,0000000000..ce27d2b175 mode 000000,100644,000000..100644 --- a/usr/src/cmd/size.c +++ b/usr/src/cmd/size.c @@@@ -1,0 -1,46 -1,0 +1,49 @@@@ - #include - #include - +++static char *sccsid = "@(#)size.c 4.2 (Berkeley) 10/9/80"; + +/* - size -- determine object size +++ * size +++ */ + + - */ +++#include +++#include + + - int a_magic[] = {A_MAGIC1,A_MAGIC2,A_MAGIC3,A_MAGIC4,0412,0413,0}; +++int header; + + + +main(argc, argv) + +char **argv; + +{ + + struct exec buf; + + long sum; + + int gorp,i; + + FILE *f; + + + + if (argc==1) { + + *argv = "a.out"; + + argc++; + + --argv; + + } + + gorp = argc; + + while(--argc) { + + ++argv; + + if ((f = fopen(*argv, "r"))==NULL) { + + printf("size: %s not found\n", *argv); + + continue; + + } + + fread((char *)&buf, sizeof(buf), 1, f); - for(i=0;a_magic[i];i++) - if(a_magic[i] == buf.a_magic) break; - if(a_magic[i] == 0) { +++ if(N_BADMAG(buf)) { + + printf("size: %s not an object file\n", *argv); + + fclose(f); + + continue; + + } - if (gorp>2) - printf("%s: ", *argv); - printf("%u+%u+%u = ", buf.a_text,buf.a_data,buf.a_bss); +++ if (header == 0) { +++ printf("text\tdata\tbss\tdec\thex\n"); +++ header = 1; +++ } +++ printf("%u\t%u\t%u\t", buf.a_text,buf.a_data,buf.a_bss); + + sum = (long) buf.a_text + (long) buf.a_data + (long) buf.a_bss; - printf("%Db = 0x%Xb\n", sum, sum); +++ printf("%ld\t%lx", sum, sum); +++ if (gorp>2) +++ printf("\t%s", *argv); +++ printf("\n"); + + fclose(f); + + } + +} diff --cc usr/src/cmd/sleep.c index 0000000000,a52bc3d3c0,0000000000..de0465137f mode 000000,100644,000000..100644 --- a/usr/src/cmd/sleep.c +++ b/usr/src/cmd/sleep.c @@@@ -1,0 -1,21 -1,0 +1,22 @@@@ +++static char *sccsid = "@(#)sleep.c 4.1 (Berkeley) 10/1/80"; + +main(argc, argv) + +char **argv; + +{ + + int c, n; + + char *s; + + + + n = 0; + + if(argc < 2) { + + printf("arg count\n"); + + exit(0); + + } + + s = argv[1]; + + while(c = *s++) { + + if(c<'0' || c>'9') { + + printf("bad character\n"); + + exit(0); + + } + + n = n*10 + c - '0'; + + } + + sleep(n); + +} diff --cc usr/src/cmd/soelim.c index 0000000000,39699b5710,0000000000..8bb0bf712c mode 000000,100644,000000..100644 --- a/usr/src/cmd/soelim.c +++ b/usr/src/cmd/soelim.c @@@@ -1,0 -1,100 -1,0 +1,101 @@@@ +++static char *sccsid = "@(#)soelim.c 4.1 (Berkeley) 10/1/80"; + +#include + +/* + + * soelim - a filter to process n/troff input eliminating .so's + + * + + * Author: Bill Joy UCB July 8, 1977 + + * + + * This program eliminates .so's from a n/troff input stream. + + * It can be used to prepare safe input for submission to the + + * phototypesetter since the software supporting the operator + + * doesn't let him do chdir. + + * + + * This is a kludge and the operator should be given the + + * ability to do chdir. + + * + + * This program is more generally useful, it turns out, because + + * the program tbl doesn't understand ".so" directives. + + */ + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + + + argc--; + + argv++; + + if (argc == 0) { + + fprintf(stderr, "Usage: %s file [ file ... ]\n", argv[-1]); + + exit(1); + + } + + do { + + process(argv[0]); + + argv++; + + argc--; + + } while (argc > 0); + + exit(0); + +} + + + +process(file) + + char *file; + +{ + + register char *cp; + + register int c; + + char fname[BUFSIZ]; + + FILE *soee; + + + + soee = fopen(file, "r"); + + if (soee == NULL) { + + perror(file); + + return; + + } + + for (;;) { + + c = getc(soee); + + if (c < 0) + + break; + + if (c != '.') + + goto simple; + + c = getc(soee); + + if (c != 's') { + + putchar('.'); + + goto simple; + + } + + c = getc(soee); + + if (c != 'o') { + + printf(".s"); + + goto simple; + + } + + do + + c = getc(soee); + + while (c == ' ' || c == '\t'); + + cp = fname; + + for (;;) { + + switch (c) { + + + + case ' ': + + case '\t': + + case '\n': + + case EOF: + + goto donename; + + + + default: + + *cp++ = c; + + c = getc(soee); + + continue; + + } + + } + +donename: + + if (cp == fname) { + + printf(".so"); + + goto simple; + + } + + *cp++ = 0; + + process(fname); + + continue; + +simple: + + if (c == EOF) + + break; + + putchar(c); + + } + + fclose(soee); + +} diff --cc usr/src/cmd/sort.c index 0000000000,bccb330d29,0000000000..2be25eef89 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sort.c +++ b/usr/src/cmd/sort.c @@@@ -1,0 -1,902 -1,0 +1,912 @@@@ +++static char *sccsid = "@(#)sort.c 4.2 (Berkeley) 10/9/80"; + +#include + +#include + +#include + +#include + +#include + + + +#define L 512 + +#define N 7 + +#define C 20 + +#define MEM (16*2048) + +#define NF 10 + + + +FILE *is, *os; + +char *dirtry[] = {"/usr/tmp", "/tmp", NULL}; + +char **dirs; + +char file1[30]; + +char *file = file1; + +char *filep; + +int nfiles; + +unsigned nlines; + +unsigned ntext; + +int *lspace; + +char *tspace; + +int cmp(), cmpa(); + +int (*compare)() = cmpa; + +char *eol(); + +int term(); + +int mflg; + +int cflg; + +int uflg; + +char *outfil; + +int unsafeout; /*kludge to assure -m -o works*/ + +char tabchar; + +int eargc; + +char **eargv; + + + +char zero[256]; + + + +char fold[256] = { + + 0200,0201,0202,0203,0204,0205,0206,0207, + + 0210,0211,0212,0213,0214,0215,0216,0217, + + 0220,0221,0222,0223,0224,0225,0226,0227, + + 0230,0231,0232,0233,0234,0235,0236,0237, + + 0240,0241,0242,0243,0244,0245,0246,0247, + + 0250,0251,0252,0253,0254,0255,0256,0257, + + 0260,0261,0262,0263,0264,0265,0266,0267, + + 0270,0271,0272,0273,0274,0275,0276,0277, + + 0300,0301,0302,0303,0304,0305,0306,0307, + + 0310,0311,0312,0313,0314,0315,0316,0317, + + 0320,0321,0322,0323,0324,0325,0326,0327, + + 0330,0331,0332,0333,0334,0335,0336,0337, + + 0340,0341,0342,0343,0344,0345,0346,0347, + + 0350,0351,0352,0353,0354,0355,0356,0357, + + 0360,0361,0362,0363,0364,0365,0366,0367, + + 0370,0371,0372,0373,0374,0375,0376,0377, + + 0000,0001,0002,0003,0004,0005,0006,0007, + + 0010,0011,0012,0013,0014,0015,0016,0017, + + 0020,0021,0022,0023,0024,0025,0026,0027, + + 0030,0031,0032,0033,0034,0035,0036,0037, + + 0040,0041,0042,0043,0044,0045,0046,0047, + + 0050,0051,0052,0053,0054,0055,0056,0057, + + 0060,0061,0062,0063,0064,0065,0066,0067, + + 0070,0071,0072,0073,0074,0075,0076,0077, + + 0100,0101,0102,0103,0104,0105,0106,0107, + + 0110,0111,0112,0113,0114,0115,0116,0117, + + 0120,0121,0122,0123,0124,0125,0126,0127, + + 0130,0131,0132,0133,0134,0134,0136,0137, + + 0140,0101,0102,0103,0104,0105,0106,0107, + + 0110,0111,0112,0113,0114,0115,0116,0117, + + 0120,0121,0122,0123,0124,0125,0126,0127, + + 0130,0131,0132,0173,0174,0175,0176,0177 + +}; + +char nofold[256] = { + + 0200,0201,0202,0203,0204,0205,0206,0207, + + 0210,0211,0212,0213,0214,0215,0216,0217, + + 0220,0221,0222,0223,0224,0225,0226,0227, + + 0230,0231,0232,0233,0234,0235,0236,0237, + + 0240,0241,0242,0243,0244,0245,0246,0247, + + 0250,0251,0252,0253,0254,0255,0256,0257, + + 0260,0261,0262,0263,0264,0265,0266,0267, + + 0270,0271,0272,0273,0274,0275,0276,0277, + + 0300,0301,0302,0303,0304,0305,0306,0307, + + 0310,0311,0312,0313,0314,0315,0316,0317, + + 0320,0321,0322,0323,0324,0325,0326,0327, + + 0330,0331,0332,0333,0334,0335,0336,0337, + + 0340,0341,0342,0343,0344,0345,0346,0347, + + 0350,0351,0352,0353,0354,0355,0356,0357, + + 0360,0361,0362,0363,0364,0365,0366,0367, + + 0370,0371,0372,0373,0374,0375,0376,0377, + + 0000,0001,0002,0003,0004,0005,0006,0007, + + 0010,0011,0012,0013,0014,0015,0016,0017, + + 0020,0021,0022,0023,0024,0025,0026,0027, + + 0030,0031,0032,0033,0034,0035,0036,0037, + + 0040,0041,0042,0043,0044,0045,0046,0047, + + 0050,0051,0052,0053,0054,0055,0056,0057, + + 0060,0061,0062,0063,0064,0065,0066,0067, + + 0070,0071,0072,0073,0074,0075,0076,0077, + + 0100,0101,0102,0103,0104,0105,0106,0107, + + 0110,0111,0112,0113,0114,0115,0116,0117, + + 0120,0121,0122,0123,0124,0125,0126,0127, + + 0130,0131,0132,0133,0134,0135,0136,0137, + + 0140,0141,0142,0143,0144,0145,0146,0147, + + 0150,0151,0152,0153,0154,0155,0156,0157, + + 0160,0161,0162,0163,0164,0165,0166,0167, + + 0170,0171,0172,0173,0174,0175,0176,0177 + +}; + + + +char nonprint[256] = { + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 + +}; + + + +char dict[256] = { + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1, + + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + + 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1, + + 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1, + + 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1 + +}; + + + +struct field { + + char *code; + + char *ignore; + + int nflg; + + int rflg; + + int bflg[2]; + + int m[2]; + + int n[2]; + +} fields[NF]; + +struct field proto = { + + nofold+128, + + zero+128, + + 0, + + 1, + + 0,0, + + 0,-1, + + 0,0 + +}; + +int nfields; + +int error = 1; + +char *setfil(); + +char *sbrk(); + +char *brk(); + + + +main(argc, argv) + +char **argv; + +{ + + register a; + + extern char end[1]; + + char *ep; + + char *arg; + + struct field *p, *q; + + int i; - unsigned pid; + + + + copyproto(); + + eargv = argv; + + while (--argc > 0) { + + if(**++argv == '-') for(arg = *argv;;) { + + switch(*++arg) { + + case '\0': + + if(arg[-1] == '-') + + eargv[eargc++] = "-"; + + break; + + + + case 'o': + + if(--argc > 0) + + outfil = *++argv; + + continue; + + + + case 'T': + + if (--argc > 0) + + dirtry[0] = *++argv; + + continue; + + + + default: + + field(++*argv,nfields>0); + + break; + + } + + break; + + } else if (**argv == '+') { + + if(++nfields>=NF) { + + diag("too many keys",""); + + exit(1); + + } + + copyproto(); + + field(++*argv,0); + + } else + + eargv[eargc++] = *argv; + + } + + q = &fields[0]; + + for(a=1; a<=nfields; a++) { + + p = &fields[a]; + + if(p->code != proto.code) continue; + + if(p->ignore != proto.ignore) continue; + + if(p->nflg != proto.nflg) continue; + + if(p->rflg != proto.rflg) continue; + + if(p->bflg[0] != proto.bflg[0]) continue; + + if(p->bflg[1] != proto.bflg[1]) continue; + + p->code = q->code; + + p->ignore = q->ignore; + + p->nflg = q->nflg; + + p->rflg = q->rflg; + + p->bflg[0] = p->bflg[1] = q->bflg[0]; + + } + + if(eargc == 0) + + eargv[eargc++] = "-"; + + if(cflg && eargc>1) { + + diag("can check only 1 file",""); + + exit(1); + + } + + safeoutfil(); + + + + ep = end + MEM; + + lspace = (int *)sbrk(0); + + while((int)brk(ep) == -1) + + ep -= 512; + + brk(ep -= 512); /* for recursion */ + + a = ep - (char*)lspace; + + nlines = (a-L); + + nlines /= (5*(sizeof(char *)/sizeof(char))); + + ntext = nlines*8; + + tspace = (char *)(lspace + nlines); + + a = -1; + + for(dirs=dirtry; *dirs; dirs++) { + + sprintf(filep=file1, "%s/stm%05uaa", *dirs, getpid()); + + while (*filep) + + filep++; + + filep -= 2; + + if ( (a=creat(file, 0600)) >=0) + + break; + + } + + if(a < 0) { + + diag("can't locate temp",""); + + exit(1); + + } + + close(a); - signal(SIGHUP, term); +++ unlink(file); +++ if (signal(SIGHUP, SIG_IGN) != SIG_IGN) +++ signal(SIGHUP, term); + + if (signal(SIGINT, SIG_IGN) != SIG_IGN) + + signal(SIGINT, term); + + signal(SIGPIPE,term); - signal(SIGTERM,term); +++ if (signal(SIGTERM, SIG_IGN) != SIG_IGN) +++ signal(SIGTERM,term); + + nfiles = eargc; + + if(!mflg && !cflg) { + + sort(); + + fclose(stdin); + + } + + for(a = mflg|cflg?0:eargc; a+N=nfiles) + + i = nfiles; + + newfile(); + + merge(a, i); + + } + + if(a != nfiles) { + + oldfile(); + + merge(a, nfiles); + + } + + error = 0; + + term(); + +} + + + +sort() + +{ + + register char *cp; + + register char **lp; + + register c; + + int done; + + int i; + + char *f; + + + + done = 0; + + i = 0; + + c = EOF; + + do { + + cp = tspace; + + lp = (char **)lspace; + + while(lp < (char **)lspace+nlines && cp < tspace+ntext) { + + *lp++ = cp; + + while(c != '\n') { + + if(c != EOF) { + + *cp++ = c; + + c = getc(is); + + continue; + + } else if(is) + + fclose(is); + + if(i < eargc) { + + if((f = setfil(i++)) == 0) + + is = stdin; + + else if((is = fopen(f, "r")) == NULL) + + cant(f); + + c = getc(is); + + } else + + break; + + } + + *cp++ = '\n'; + + if(c == EOF) { + + done++; + + lp--; + + break; + + } + + c = getc(is); + + } + + qsort((char **)lspace, lp); + + if(done == 0 || nfiles != eargc) + + newfile(); + + else + + oldfile(); + + while(lp > (char **)lspace) { + + cp = *--lp; + + if(*cp) + + do + + putc(*cp, os); + + while(*cp++ != '\n'); + + } + + fclose(os); + + } while(done == 0); + +} + + + +struct merg + +{ + + char l[L]; + + FILE *b; + +} *ibuf[256]; + + + +merge(a,b) + +{ + + struct merg *p; + + register char *cp, *dp; + + register i; + + struct merg **ip, *jp; + + char *f; + + int j; + + int k, l; + + int muflg; + + + + p = (struct merg *)lspace; + + j = 0; + + for(i=a; i < b; i++) { + + f = setfil(i); + + if(f == 0) + + p->b = stdin; + + else if((p->b = fopen(f, "r")) == NULL) + + cant(f); + + ibuf[j] = p; + + if(!rline(p)) j++; + + p++; + + } + + + + do { + + i = j; + + qsort((char **)ibuf, (char **)(ibuf+i)); + + l = 0; + + while(i--) { + + cp = ibuf[i]->l; + + if(*cp == '\0') { + + l = 1; + + if(rline(ibuf[i])) { + + k = i; + + while(++k < j) + + ibuf[k-1] = ibuf[k]; + + j--; + + } + + } + + } + + } while(l); + + + + muflg = mflg & uflg | cflg; + + i = j; + + while(i > 0) { + + cp = ibuf[i-1]->l; + + if(!cflg && (uflg == 0 || muflg || + + (*compare)(ibuf[i-1]->l,ibuf[i-2]->l))) + + do + + putc(*cp, os); + + while(*cp++ != '\n'); + + if(muflg){ + + cp = ibuf[i-1]->l; + + dp = p->l; + + do { + + } while((*dp++ = *cp++) != '\n'); + + } + + for(;;) { + + if(rline(ibuf[i-1])) { + + i--; + + if(i == 0) + + break; + + if(i == 1) + + muflg = uflg; + + } + + ip = &ibuf[i]; + + while(--ip>ibuf&&(*compare)(ip[0]->l,ip[-1]->l)<0){ + + jp = *ip; + + *ip = *(ip-1); + + *(ip-1) = jp; + + } + + if(!muflg) + + break; + + j = (*compare)(ibuf[i-1]->l,p->l); + + if(cflg) { + + if(j > 0) + + disorder("disorder:",ibuf[i-1]->l); + + else if(uflg && j==0) + + disorder("nonunique:",ibuf[i-1]->l); + + } else if(j == 0) + + continue; + + break; + + } + + } + + p = (struct merg *)lspace; + + for(i=a; ib); + + p++; + + if(i >= eargc) + + unlink(setfil(i)); + + } + + fclose(os); + +} + + + +rline(mp) + +struct merg *mp; + +{ + + register char *cp; + + register char *ce; + + FILE *bp; + + register c; + + + + bp = mp->b; + + cp = mp->l; + + ce = cp+L; + + do { + + c = getc(bp); + + if(c == EOF) + + return(1); + + if(cp>=ce) + + cp--; + + *cp++ = c; + + } while(c!='\n'); + + return(0); + +} + + + +disorder(s,t) + +char *s, *t; + +{ + + register char *u; + + for(u=t; *u!='\n';u++) ; + + *u = 0; + + diag(s,t); + + term(); + +} + + + +newfile() + +{ + + register char *f; + + + + f = setfil(nfiles); + + if((os=fopen(f, "w")) == NULL) { + + diag("can't create ",f); + + term(); + + } + + nfiles++; + +} + + + +char * + +setfil(i) + +{ + + + + if(i < eargc) + + if(eargv[i][0] == '-' && eargv[i][1] == '\0') + + return(0); + + else + + return(eargv[i]); + + i -= eargc; + + filep[0] = i/26 + 'a'; + + filep[1] = i%26 + 'a'; + + return(file); + +} + + + +oldfile() + +{ + + + + if(outfil) { + + if((os=fopen(outfil, "w")) == NULL) { + + diag("can't create ",outfil); + + term(); + + } + + } else + + os = stdout; + +} + + + +safeoutfil() + +{ + + register int i; + + struct stat obuf,ibuf; + + + + if(!mflg||outfil==0) + + return; + + if(stat(outfil,&obuf)==-1) + + return; + + for(i=eargc-N;i0; k<=nfields; k++) { + + fp = &fields[k]; + + pa = i; + + pb = j; + + if(k) { + + la = skip(pa, fp, 1); + + pa = skip(pa, fp, 0); + + lb = skip(pb, fp, 1); + + pb = skip(pb, fp, 0); + + } else { + + la = eol(pa); + + lb = eol(pb); + + } + + if(fp->nflg) { +++ if(tabchar) { +++ if(parflg; + + if(*pa == '-') { + + pa++; + + sa = -sa; + + } + + if(*pb == '-') { + + pb++; + + sb = -sb; + + } + + for(ipa = pa; ipa pa && ipb > pb) + + if(b = *--ipb - *--ipa) + + a = b; + + while(ipa > pa) + + if(*--ipa != '0') + + return(-sa); + + while(ipb > pb) + + if(*--ipb != '0') + + return(sb); + + if(a) return(a*sa); + + if(*(pa=jpa) == '.') + + pa++; + + if(*(pb=jpb) == '.') + + pb++; + + if(sa==sb) + + while(pacode; + + ignore = fp->ignore; + +loop: + + while(ignore[*pa]) + + pa++; + + while(ignore[*pb]) + + pb++; + + if(pa>=la || *pa=='\n') + + if(pbrflg); + + else continue; + + if(pb>=lb || *pb=='\n') + + return(-fp->rflg); + + if((sa = code[*pb++]-code[*pa++]) == 0) + + goto loop; + + return(sa*fp->rflg); + + } + + if(uflg) + + return(0); + + return(cmpa(i, j)); + +} + + + +cmpa(pa, pb) + +register char *pa, *pb; + +{ + + while(*pa == *pb) { + + if(*pa++ == '\n') + + return(0); + + pb++; + + } + + return( + + *pa == '\n' ? fields[0].rflg: + + *pb == '\n' ?-fields[0].rflg: + + *pb > *pa ? fields[0].rflg: + + -fields[0].rflg + + ); + +} + + + +char * + +skip(pp, fp, j) + +struct field *fp; + +char *pp; + +{ + + register i; + + register char *p; + + + + p = pp; + + if( (i=fp->m[j]) < 0) + + return(eol(p)); + + while(i-- > 0) { + + if(tabchar != 0) { + + while(*p != tabchar) + + if(*p != '\n') + + p++; + + else goto ret; - p++; +++ if(i>0||j==0) +++ p++; + + } else { + + while(blank(*p)) + + p++; + + while(!blank(*p)) + + if(*p != '\n') + + p++; + + else goto ret; + + } + + } - if(fp->bflg[j]) +++ if(tabchar==0&&fp->bflg[j]) + + while(blank(*p)) + + p++; + + i = fp->n[j]; + + while(i-- > 0) { + + if(*p != '\n') + + p++; + + else goto ret; + + } + +ret: + + return(p); + +} + + + +char * + +eol(p) + +register char *p; + +{ + + while(*p != '\n') p++; + + return(p); + +} + + + +copyproto() + +{ + + register i; + + register int *p, *q; + + + + p = (int *)&proto; + + q = (int *)&fields[nfields]; + + for(i=0; ibflg[k]++; + + break; + + + + case 'd': + + p->ignore = dict+128; + + break; + + + + case 'f': + + p->code = fold+128; + + break; + + case 'i': + + p->ignore = nonprint+128; + + break; + + + + case 'c': + + cflg = 1; + + continue; + + + + case 'm': + + mflg = 1; + + continue; + + + + case 'n': + + p->nflg++; + + break; + + case 't': + + tabchar = *++s; + + if(tabchar == 0) s--; + + continue; + + + + case 'r': + + p->rflg = -1; + + continue; + + case 'u': + + uflg = 1; + + break; + + + + case '.': + + if(p->m[k] == -1) /* -m.n with m missing */ + + p->m[k] = 0; + + d = &fields[0].n[0]-&fields[0].m[0]; + + + + default: + + p->m[k+d] = number(&s); + + } + + compare = cmp; + + } + +} + + + +number(ppa) + +char **ppa; + +{ + + int n; + + register char *pa; + + pa = *ppa; + + n = 0; + + while(isdigit(*pa)) { + + n = n*10 + *pa - '0'; + + *ppa = pa++; + + } + + return(n); + +} + + + +blank(c) + +{ + + if(c==' ' || c=='\t') + + return(1); + + return(0); + +} + + + +#define qsexc(p,q) t= *p;*p= *q;*q=t + +#define qstexc(p,q,r) t= *p;*p= *r;*r= *q;*q=t + + + +qsort(a,l) + +char **a, **l; + +{ + + register char **i, **j; + + char **k; + + char **lp, **hp; + + int c; + + char *t; + + unsigned n; + + + + + + + +start: + + if((n=l-a) <= 1) + + return; + + + + + + n /= 2; + + hp = lp = a+n; + + i = a; + + j = l-1; + + + + + + for(;;) { + + if(i < lp) { + + if((c = (*compare)(*i, *lp)) == 0) { + + --lp; + + qsexc(i, lp); + + continue; + + } + + if(c < 0) { + + ++i; + + continue; + + } + + } + + + +loop: + + if(j > hp) { + + if((c = (*compare)(*hp, *j)) == 0) { + + ++hp; + + qsexc(hp, j); + + goto loop; + + } + + if(c > 0) { + + if(i == lp) { + + ++hp; + + qstexc(i, hp, j); + + i = ++lp; + + goto loop; + + } + + qsexc(i, j); + + --j; + + ++i; + + continue; + + } + + --j; + + goto loop; + + } + + + + + + if(i == lp) { + + if(uflg) + + for(k=lp+1; k<=hp;) **k++ = '\0'; + + if(lp-a >= l-hp) { + + qsort(hp+1, l); + + l = lp; + + } else { + + qsort(a, lp); + + a = hp+1; + + } + + goto start; + + } + + + + + + --lp; + + qstexc(j, lp, i); + + j = --hp; + + } + +} + + diff --cc usr/src/cmd/spline.c index 0000000000,00b453dc9a,0000000000..6e5ac1a183 mode 000000,100644,000000..100644 --- a/usr/src/cmd/spline.c +++ b/usr/src/cmd/spline.c @@@@ -1,0 -1,333 -1,0 +1,334 @@@@ +++static char *sccsid = "@(#)spline.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +#define NP 1000 + +#define INF 1.e37 + + + +struct proj { int lbf,ubf; float a,b,lb,ub,quant,mult,val[NP]; } x,y; + +float *diag, *r; + +float dx = 1.; + +float ni = 100.; + +int n; + +int auta; + +int periodic; + +float konst = 0.0; + +float zero = 0.; + + + +/* Spline fit technique + +let x,y be vectors of abscissas and ordinates + + h be vector of differences h9i8=x9i8-x9i-1988 + + y" be vector of 2nd derivs of approx function + +If the points are numbered 0,1,2,...,n+1 then y" satisfies + +(R W Hamming, Numerical Methods for Engineers and Scientists, + +2nd Ed, p349ff) + + h9i8y"9i-1988+2(h9i8+h9i+18)y"9i8+h9i+18y"9i+18 + + + + = 6[(y9i+18-y9i8)/h9i+18-(y9i8-y9i-18)/h9i8] i=1,2,...,n + + + +where y"908 = y"9n+18 = 0 + +This is a symmetric tridiagonal system of the form + + + + | a918 h928 | |y"918| |b918| + + | h928 a928 h938 | |y"928| |b928| + + | h938 a938 h948 | |y"938| = |b938| + + | . | | .| | .| + + | . | | .| | .| + +It can be triangularized into + + | d918 h928 | |y"918| |r918| + + | d928 h938 | |y"928| |r928| + + | d938 h948 | |y"938| = |r938| + + | . | | .| | .| + + | . | | .| | .| + +where + + d918 = a918 + + + + r908 = 0 + + + + d9i8 = a9i8 - h9i8829/d9i-18 1=0;){ /* back substitute */ + + end = i==n-1; + + hi1 = end?x.val[1]-x.val[0]: + + x.val[i+1]-x.val[i]; + + D2yi1 = D2yi; + + if(i>0){ + + hi = x.val[i]-x.val[i-1]; + + corr = end?2*s+u:zero; + + D2yi = (end*v+r[i]-hi1*D2yi1-s*D2yn1)/ + + (diag[i]+corr); + + if(end) D2yn1 = D2yi; + + if(i>1){ + + a = 2*(hi+hi1); + + if(i==1) a += konst*hi; + + if(i==n-2) a += konst*hi1; + + d = diag[i-1]; + + s = -s*d/hi; + + }} + + else D2yi = D2yn1; + + if(!periodic) { + + if(i==0) D2yi = konst*D2yi1; + + if(i==n-2) D2yi1 = konst*D2yi; + + } + + if(end) continue; + + m = hi1>0?ni:-ni; + + m = 1.001*m*hi1/(x.ub-x.lb); + + if(m<=0) m = 1; + + h = hi1/m; + + for(j=m;j>0||i==0&&j==0;j--){ /* interpolate */ + + x0 = (m-j)*h/hi1; + + x1 = j*h/hi1; + + yy = D2yi*(x0-x0*x0*x0)+D2yi1*(x1-x1*x1*x1); + + yy = y.val[i]*x0+y.val[i+1]*x1 -hi1*hi1*yy/6; + + printf("%f ",x.val[i]+j*h); + + printf("%f\n",yy); + + } + + } + + return(1); + + } + +readin() { + + for(n=0;nlbf && p->lb>(p->val[i])) p->lb = p->val[i]; + + if(!p->ubf && p->ub<(p->val[i])) p->ub = p->val[i]; } + + } + + + + + +main(argc,argv) + + char *argv[];{ + + extern char *malloc(); + + int i; + + x.lbf = x.ubf = y.lbf = y.ubf = 0; + + x.lb = INF; + + x.ub = -INF; + + y.lb = INF; + + y.ub = -INF; + + while(--argc > 0) { + + argv++; + +again: switch(argv[0][0]) { + + case '-': + + argv[0]++; + + goto again; + + case 'a': + + auta = 1; + + numb(&dx,&argc,&argv); + + break; + + case 'k': + + numb(&konst,&argc,&argv); + + break; + + case 'n': + + numb(&ni,&argc,&argv); + + break; + + case 'p': + + periodic = 1; + + break; + + case 'x': + + if(!numb(&x.lb,&argc,&argv)) break; + + x.lbf = 1; + + if(!numb(&x.ub,&argc,&argv)) break; + + x.ubf = 1; + + break; + + default: + + fprintf(stderr, "Bad agrument\n"); + + exit(1); + + } + + } + + if(auta&&!x.lbf) x.lb = 0; + + readin(); + + getlim(&x); + + getlim(&y); + + i = (n+1)*sizeof(dx); + + diag = (float *)malloc((unsigned)i); + + r = (float *)malloc((unsigned)i); + + if(r==NULL||!spline()) for(i=0;i + + + +unsigned count = 1000; + +int fnumber; + +char fname[100]; + +char *ifil; + +char *ofil; + +FILE *is; + +FILE *os; + + + +main(argc, argv) + +char *argv[]; + +{ + + register i, c, f; + + int iflg = 0; + + + + for(i=1; i + +/* + + * ssp - single space output + + * + + * Bill Joy UCB August 25, 1977 + + * + + * Compress multiple empty lines to a single empty line. + + * Option - compresses to nothing. + + */ + + + +char poof, hadsome; + + + +int ibuf[256]; + + + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register int c; + + FILE *f; + + + + argc--, argv++; + + do { + + while (argc > 0 && argv[0][0] == '-') { + + poof = 1; + + argc--, argv++; + + } + + f = stdin; + + if (argc > 0) { + + if ((f=fopen(argv[0], "r")) == NULL) { + + fflush(f); + + perror(argv[0]); + + exit(1); + + } + + argc--, argv++; + + } + + for (;;) { + + c = getc(f); + + if (c == -1) + + break; + + if (c != '\n') { + + hadsome = 1; + + putchar(c); + + continue; + + } + + /* + + * Eat em up + + */ + + if (hadsome) + + putchar('\n'); + + c = getc(f); + + if (c == -1) + + break; + + if (c != '\n') { + + putchar(c); + + hadsome = 1; + + continue; + + } + + do + + c = getc(f); + + while (c == '\n'); + + if (!poof && hadsome) + + putchar('\n'); + + if (c == -1) + + break; + + putchar(c); + + hadsome = 1; + + } + + } while (argc > 0); + +} diff --cc usr/src/cmd/strings.c index 0000000000,9bb8c26188,0000000000..a3f494487b mode 000000,100644,000000..100644 --- a/usr/src/cmd/strings.c +++ b/usr/src/cmd/strings.c @@@@ -1,0 -1,143 -1,0 +1,121 @@@@ +++static char *sccsid = "@(#)strings.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + + + +long ftell(); + + + +/* - * Strings - extract strings from an object file for whatever - * - * Bill Joy UCB - * April 22, 1978 - * - * The algorithm is to look for sequences of "non-junk" characters - * The variable "minlen" is the minimum length string printed. - * This helps get rid of garbage. - * Default minimum string length is 4 characters. +++ * strings + + */ + + + +struct exec header; + + + +char *infile = "Standard input"; + +int oflg; + +int asdata; + +long offset; + +int minlength = 4; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + + + argc--, argv++; + + while (argc > 0 && argv[0][0] == '-') { + + register int i; + + if (argv[0][1] == 0) + + asdata++; + + else for (i = 1; argv[0][i] != 0; i++) switch (argv[0][i]) { + + + + case 'o': + + oflg++; + + break; + + + + case 'a': + + asdata++; + + break; + + + + default: + + if (!isdigit(argv[0][i])) { - fprintf(stderr, "Usage: strings [ - ] [ -o ] [ -# ] [ file ... ]\n"); +++ fprintf(stderr, "Usage: strings [ -a ] [ -o ] [ -# ] [ file ... ]\n"); + + exit(1); + + } + + minlength = argv[0][i] - '0'; + + for (i++; isdigit(argv[0][i]); i++) + + minlength = minlength * 10 + argv[0][i] - '0'; + + i--; + + break; + + } + + argc--, argv++; + + } + + do { + + if (argc > 0) { + + if (freopen(argv[0], "r", stdin) == NULL) { + + perror(argv[0]); + + exit(1); + + } + + infile = argv[0]; + + argc--, argv++; + + } + + fseek(stdin, (long) 0, 0); + + if (asdata || + + fread((char *)&header, sizeof header, 1, stdin) != 1 || - !ismagic(header.a_magic)) { +++ N_BADMAG(header)) { + + fseek(stdin, (long) 0, 0); + + find((long) 100000000L); + + continue; + + } - fseek(stdin, (long) header.a_text, 1); +++ fseek(stdin, (long) N_TXTOFF(header)+header.a_text, 1); + + find((long) header.a_data); + + } while (argc > 0); + +} + + + +find(cnt) + + long cnt; + +{ + + static char buf[BUFSIZ]; + + register char *cp; + + register int c, cc; + + + + cp = buf, cc = 0; + + for (; cnt != 0; cnt--) { + + c = getc(stdin); + + if (c == '\n' || dirt(c) || cnt == 0) { + + if (cp > buf && cp[-1] == '\n') + + --cp; + + *cp++ = 0; + + if (cp > &buf[minlength]) { + + if (oflg) + + printf("%7D ", ftell(stdin) - cc - 1); + + printf("%s\n", buf); + + } + + cp = buf, cc = 0; + + } else { + + if (cp < &buf[sizeof buf - 2]) + + *cp++ = c; + + cc++; + + } + + if (ferror(stdin) || feof(stdin)) + + break; + + } + +} + + + +dirt(c) + + int c; + +{ + + + + switch (c) { + + + + case '\n': + + case '\f': + + return (0); + + + + case 0177: + + return (1); + + + + default: + + return (c > 0200 || c < ' '); + + } + +} - - ismagic(a) - int a; - { - - switch (a) { - - case A_MAGIC1: - case A_MAGIC2: - case A_MAGIC3: - case A_MAGIC4: - return (1); - } - return (0); - } diff --cc usr/src/cmd/strip.c index 0000000000,b74747c7bf,0000000000..c9a06986e9 mode 000000,100644,000000..100644 --- a/usr/src/cmd/strip.c +++ b/usr/src/cmd/strip.c @@@@ -1,0 -1,116 -1,0 +1,112 @@@@ +++static char *sccsid = "@(#)strip.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + + + +#define BUFSIZ BSIZE + + + +char *tname; + +char *mktemp(); + +struct exec head; - int a_magic[] = {A_MAGIC1, A_MAGIC2, A_MAGIC3, A_MAGIC4, 0412, 0413, 0}; + +int status; + +int tf; + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + + + signal(SIGHUP, SIG_IGN); + + signal(SIGINT, SIG_IGN); + + signal(SIGQUIT, SIG_IGN); + + tname = mktemp("/tmp/sXXXXX"); + + close(creat(tname, 0600)); + + tf = open(tname, 2); + + if(tf < 0) { + + printf("cannot create temp file\n"); + + exit(2); + + } + + for(i=1; i 1) + + break; + + } + + close(tf); + + unlink(tname); + + exit(status); + +} + + + +strip(name) + +char *name; + +{ + + register f; + + long size; + + int i; + + + + f = open(name, 0); + + if(f < 0) { + + printf("cannot open %s\n", name); + + status = 1; + + goto out; + + } + + read(f, (char *)&head, sizeof(head)); - for(i=0;a_magic[i];i++) - if(a_magic[i] == head.a_magic) break; - if(a_magic[i] == 0) { +++ if (N_BADMAG(head)) { + + printf("%s not in a.out format\n", name); + + status = 1; + + goto out; + + } + + if ((head.a_syms == 0) && (head.a_trsize == 0) && (head.a_drsize ==0)) { + + printf("%s already stripped\n", name); + + goto out; + + } + + size = (long)head.a_text + head.a_data; + + head.a_syms = head.a_trsize = head.a_drsize = 0 ; - + + lseek(tf, (long)0, 0); + + write(tf, (char *)&head, sizeof(head)); - if (head.a_magic == 0412 || head.a_magic == 0413) { +++ if (head.a_magic == ZMAGIC) + + size += PAGSIZ - sizeof (head); - } - if(copy(name, f, tf, size)) { +++ if (copy(name, f, tf, size)) { + + status = 1; + + goto out; + + } + + size += sizeof(head); + + close(f); + + f = creat(name, 0666); + + if(f < 0) { + + printf("%s cannot recreate\n", name); + + status = 1; + + goto out; + + } + + lseek(tf, (long)0, 0); + + if(copy(name, tf, f, size)) + + status = 2; + + + +out: + + close(f); + +} + + + +copy(name, fr, to, size) + +char *name; + +long size; + +{ + + register s, n; + + char buf[BUFSIZ]; + + + + while(size != 0) { + + s = BUFSIZ; + + if(size < BUFSIZ) + + s = size; + + n = read(fr, buf, s); + + if(n != s) { + + printf("%s unexpected eof\n", name); + + return(1); + + } + + n = write(to, buf, s); + + if(n != s) { + + printf("%s unexpected write eof\n", name); + + return(1); + + } + + size -= s; + + } + + return(0); + +} diff --cc usr/src/cmd/stty.c index 0000000000,969e8cbddc,0000000000..7639887b8e mode 000000,100644,000000..100644 --- a/usr/src/cmd/stty.c +++ b/usr/src/cmd/stty.c @@@@ -1,0 -1,363 -1,0 +1,512 @@@@ +++static char *sccsid ="@(#)stty.c 4.2 (Berkeley) 10/11/80"; + +/* + + * set teletype modes + + */ + + + +#include + +#include + + + +struct + +{ + + char *string; + + int speed; + +} speeds[] = { + + "0", B0, + + "50", B50, + + "75", B75, + + "110", B110, + + "134", B134, + + "134.5",B134, + + "150", B150, + + "200", B200, + + "300", B300, + + "600", B600, + + "1200", B1200, + + "1800", B1800, + + "2400", B2400, + + "4800", B4800, + + "9600", B9600, + + "exta", EXTA, + + "extb", EXTB, + + 0, + +}; + +struct + +{ + + char *string; + + int set; + + int reset; +++ int lset; +++ int lreset; + +} modes[] = { - "even", - EVENP, 0, - - "-even", - 0, EVENP, - - "odd", - ODDP, 0, - - "-odd", - 0, ODDP, - - "raw", - RAW, 0, - - "-raw", - 0, RAW, - - "cooked", - 0, RAW, - - "-nl", - CRMOD, 0, - - "nl", - 0, CRMOD, - - "echo", - ECHO, 0, - - "-echo", - 0, ECHO, - - "LCASE", - LCASE, 0, - - "lcase", - LCASE, 0, - - "-LCASE", - 0, LCASE, - - "-lcase", - 0, LCASE, - - "-tabs", - XTABS, 0, - - "tabs", - 0, XTABS, - - - "cbreak", - CBREAK, 0, - - "-cbreak", - 0, CBREAK, - - "cr0", - CR0, CR3, - - "cr1", - CR1, CR3, - - "cr2", - CR2, CR3, - - "cr3", - CR3, CR3, - - "tab0", - TAB0, XTABS, - - "tab1", - TAB1, XTABS, - - "tab2", - TAB2, XTABS, - - "nl0", - NL0, NL3, - - "nl1", - NL1, NL3, - - "nl2", - NL2, NL3, - - "nl3", - NL3, NL3, - - "ff0", - FF0, FF1, - - "ff1", - FF1, FF1, - - "bs0", - BS0, BS1, - - "bs1", - BS1, BS1, - - "33", - CR1, ALLDELAY, - - "tty33", - CR1, ALLDELAY, - - "37", - FF1+CR2+TAB1+NL1, ALLDELAY, - - "tty37", - FF1+CR2+TAB1+NL1, ALLDELAY, - - "05", - NL2, ALLDELAY, - - "vt05", - NL2, ALLDELAY, - - "tn", - CR1, ALLDELAY, - - "tn300", - CR1, ALLDELAY, - - "ti", - CR2, ALLDELAY, - - "ti700", - CR2, ALLDELAY, - - "tek", - FF1, ALLDELAY, - +++ "even", EVENP, 0, 0, 0, +++ "-even", 0, EVENP, 0, 0, +++ "odd", ODDP, 0, 0, 0, +++ "-odd", 0, ODDP, 0, 0, +++ "raw", RAW, 0, 0, 0, +++ "-raw", 0, RAW, 0, 0, +++ "cooked", 0, RAW, 0, 0, +++ "-nl", CRMOD, 0, 0, 0, +++ "nl", 0, CRMOD, 0, 0, +++ "echo", ECHO, 0, 0, 0, +++ "-echo", 0, ECHO, 0, 0, +++ "LCASE", LCASE, 0, 0, 0, +++ "lcase", LCASE, 0, 0, 0, +++ "-LCASE", 0, LCASE, 0, 0, +++ "-lcase", 0, LCASE, 0, 0, +++ "-tabs", XTABS, 0, 0, 0, +++ "tabs", 0, XTABS, 0, 0, +++ "tandem", TANDEM, 0, 0, 0, +++ "-tandem", 0, TANDEM, 0, 0, +++ "cbreak", CBREAK, 0, 0, 0, +++ "-cbreak", 0, CBREAK, 0, 0, +++ "cr0", CR0, CR3, 0, 0, +++ "cr1", CR1, CR3, 0, 0, +++ "cr2", CR2, CR3, 0, 0, +++ "cr3", CR3, CR3, 0, 0, +++ "tab0", TAB0, XTABS, 0, 0, +++ "tab1", TAB1, XTABS, 0, 0, +++ "tab2", TAB2, XTABS, 0, 0, +++ "nl0", NL0, NL3, 0, 0, +++ "nl1", NL1, NL3, 0, 0, +++ "nl2", NL2, NL3, 0, 0, +++ "nl3", NL3, NL3, 0, 0, +++ "ff0", FF0, FF1, 0, 0, +++ "ff1", FF1, FF1, 0, 0, +++ "bs0", BS0, BS1, 0, 0, +++ "bs1", BS1, BS1, 0, 0, +++ "33", CR1, ALLDELAY, 0, 0, +++ "tty33", CR1, ALLDELAY, 0, 0, +++ "37", FF1+CR2+TAB1+NL1, ALLDELAY, 0, 0, +++ "tty37", FF1+CR2+TAB1+NL1, ALLDELAY, 0, 0, +++ "05", NL2, ALLDELAY, 0, 0, +++ "vt05", NL2, ALLDELAY, 0, 0, +++ "tn", CR1, ALLDELAY, 0, 0, +++ "tn300", CR1, ALLDELAY, 0, 0, +++ "ti", CR2, ALLDELAY, 0, 0, +++ "ti700", CR2, ALLDELAY, 0, 0, +++ "tek", FF1, ALLDELAY, 0, 0, +++ "crtbs", 0, 0, LCRTBS, LPRTERA, +++ "-crtbs", 0, 0, 0, LCRTBS, +++ "prterase", 0, 0, LPRTERA, LCRTBS+LCRTKIL+LCRTERA, +++ "-prterase", 0, 0, 0, LPRTERA, +++ "crterase", 0, 0, LCRTERA, LPRTERA, +++ "-crterase", 0, 0, 0, LCRTERA, +++ "crtkill", 0, 0, LCRTKIL, LPRTERA, +++ "-crtkill", 0, 0, 0, LCRTKIL, +++ "tilde", 0, 0, LTILDE, 0, +++ "-tilde", 0, 0, 0, LTILDE, +++ "mdmbuf", 0, 0, LMDMBUF, 0, +++ "-mdmbuf", 0, 0, 0, LMDMBUF, +++ "litout", 0, 0, LLITOUT, 0, +++ "-litout", 0, 0, 0, LLITOUT, +++ "tostop", 0, 0, LTOSTOP, 0, +++ "-tostop", 0, 0, 0, LTOSTOP, +++ "flusho", 0, 0, LFLUSHO, 0, +++ "-flusho", 0, 0, 0, LFLUSHO, +++ "nohang", 0, 0, LNOHANG, 0, +++ "-nohang", 0, 0, 0, LNOHANG, +++ "etxack", 0, 0, LETXACK, 0, +++ "-etxack", 0, 0, 0, LETXACK, +++ "intrup", 0, 0, LINTRUP, 0, +++ "-intrup", 0, 0, 0, LINTRUP, +++ "ctlecho", 0, 0, LCTLECH, 0, +++ "-ctlecho", 0, 0, 0, LCTLECH, +++ "pendin", 0, 0, LPENDIN, 0, +++ "-pendin", 0, 0, 0, LPENDIN, + + 0, - }; +++}; + + - char *arg; + +struct tchars tc; +++struct ltchars ltc; + +struct sgttyb mode; +++int lmode; +++int oldisc, ldisc; +++ +++#define CTRL(x) ('x'&037) +++ +++struct special { +++ char *name; +++ char *cp; +++ char def; +++} special[] = { +++ "erase", &mode.sg_erase, CTRL(h), +++ "kill", &mode.sg_kill, '@', +++ "intr", &tc.t_intrc, 0177, +++ "quit", &tc.t_quitc, CTRL(\\\\), +++ "start", &tc.t_startc, CTRL(q), +++ "stop", &tc.t_stopc, CTRL(s), +++ "eof", &tc.t_eofc, CTRL(d), +++ "brk", &tc.t_brkc, 0377, +++ "susp", <c.t_suspc, CTRL(z), +++ "dsusp", <c.t_dsuspc, CTRL(y), +++ "rprnt", <c.t_rprntc, CTRL(r), +++ "flush", <c.t_flushc, CTRL(o), +++ "werase", <c.t_werasc, CTRL(w), +++ "lnext", <c.t_lnextc, CTRL(v), +++ 0 +++}; +++char *arg; + + - main(argc, argv) - char *argv[]; +++int argc; +++char **argv; +++main(iargc, iargv) +++char **iargv; + +{ + + int i; +++ register struct special *sp; +++ char obuf[BUFSIZ]; + + +++ setbuf(stderr, obuf); +++ argc = iargc; +++ argv = iargv; + + gtty(1, &mode); +++ ioctl(1, TIOCGETD, &ldisc); +++ oldisc = ldisc; + + ioctl(1, TIOCGETC, &tc); +++ ioctl(1, TIOCLGET, &lmode); +++ ioctl(1, TIOCGLTC, <c); + + if(argc == 1) { - prmodes(); +++ prmodes(0); +++ exit(0); +++ } +++ if (argc == 2 && !strcmp(argv[1], "all")) { +++ prmodes(1); + + exit(0); + + } +++ if (argc == 2 && !strcmp(argv[1], "everything")) { +++ prmodes(2); +++ exit(0); +++ } +++/* +++ if (argc == 2 && !strcmp(argv[1], "all")) { +++ prmodes(2); +++ exit(0); +++ } +++*/ + + while(--argc > 0) { - + + arg = *++argv; + + if (eq("ek")){ + + mode.sg_erase = '#'; + + mode.sg_kill = '@'; +++ continue; + + } - if (eq("erase") && --argc) { - if (**++argv == '^') - mode.sg_erase = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - mode.sg_erase = **argv; - } - if (eq("intr") && --argc) { - if (**++argv == '^') - tc.t_intrc = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - tc.t_intrc = **argv; +++ if (eq("new")){ +++ ldisc = NTTYDISC; +++ if (ioctl(1, TIOCSETD, &ldisc)<0) +++ perror("ioctl"); +++ continue; + + } - if (eq("quit") && --argc) { - if (**++argv == '^') - tc.t_quitc = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - tc.t_quitc = **argv; +++ if (eq("newcrt")){ +++ ldisc = NTTYDISC; +++ lmode &= ~LPRTERA; +++ lmode |= LCRTBS|LCTLECH; +++ if (mode.sg_ospeed >= B1200) +++ lmode |= LCRTERA|LCRTKIL; +++ if (ioctl(1, TIOCSETD, &ldisc)<0) +++ perror("ioctl"); +++ continue; + + } - if (eq("start") && --argc) { - if (**++argv == '^') - tc.t_startc = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - tc.t_startc = **argv; +++ if (eq("crt")){ +++ lmode &= ~LPRTERA; +++ lmode |= LCRTBS|LCTLECH; +++ if (mode.sg_ospeed >= B1200) +++ lmode |= LCRTERA|LCRTKIL; +++ continue; + + } - if (eq("stop") && --argc) { - if (**++argv == '^') - tc.t_stopc = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - tc.t_stopc = **argv; - } - if (eq("eof") && --argc) { - if (**++argv == '^') - tc.t_eofc = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - tc.t_eofc = **argv; - } - if (eq("brk") && --argc) { - if (**++argv == '^') - tc.t_brkc = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - tc.t_brkc = **argv; - } - if (eq("kill") && --argc) { - if (**++argv == '^') - mode.sg_kill = (*(argv[1]) == '?') ? 0177 : (*argv)[1] & 037; - else - mode.sg_kill = **argv; +++ if (eq("old")){ +++ ldisc = 0; +++ if (ioctl(1, TIOCSETD, &ldisc)<0) +++ perror("ioctl"); +++ continue; + + } +++ for (sp = special; sp->name; sp++) +++ if (eq(sp->name)) { +++ if (--argc == 0) +++ goto done; +++ if (**++argv == 'u') +++ *sp->cp = 0377; +++ else if (**argv == '^') +++ *sp->cp = (*(argv[1]) == '?') ? +++ 0177 : (*argv)[1] & 037; +++ else +++ *sp->cp = **argv; +++ goto cont; +++ } + + if (eq("gspeed")) { + + mode.sg_ispeed = B300; + + mode.sg_ospeed = B9600; +++ continue; + + } + + if (eq("hup")) { + + ioctl(1, TIOCHPCL, NULL); - } else +++ continue; +++ } + + for(i=0; speeds[i].string; i++) - if(eq(speeds[i].string)) +++ if(eq(speeds[i].string)) { + + mode.sg_ispeed = mode.sg_ospeed = speeds[i].speed; +++ goto cont; +++ } +++ if (eq("speed")) { +++ gtty(open("/dev/tty", 0), &mode); +++ for(i=0; speeds[i].string; i++) +++ if (mode.sg_ospeed == speeds[i].speed) { +++ printf("%s\n", speeds[i].string); +++ exit(0); +++ } +++ printf("unknown\n"); +++ exit(1); +++ } + + for(i=0; modes[i].string; i++) + + if(eq(modes[i].string)) { + + mode.sg_flags &= ~modes[i].reset; + + mode.sg_flags |= modes[i].set; +++ lmode &= ~modes[i].lreset; +++ lmode |= modes[i].lset; + + } + + if(arg) + + fprintf(stderr,"unknown mode: %s\n", arg); +++cont: +++ ; + + } - stty(1,&mode); +++done: +++ ioctl(1, TIOCSETN, &mode); + + ioctl(1, TIOCSETC, &tc); +++ ioctl(1, TIOCSLTC, <c); +++ ioctl(1, TIOCLSET, &lmode); + +} + + + +eq(string) + +char *string; + +{ + + int i; + + + + if(!arg) + + return(0); + + i = 0; + +loop: + + if(arg[i] != string[i]) + + return(0); + + if(arg[i++] != '\0') + + goto loop; + + arg = 0; + + return(1); + +} + + - prmodes() +++prmodes(all) + +{ + + register m; - +++ int any; +++ +++ if(ldisc==NETLDISC) +++ fprintf(stderr, "net discipline, "); +++ else if(ldisc==NTTYDISC) +++ fprintf(stderr, "new tty, "); +++ else if(all==2) +++ fprintf(stderr, "old tty, "); + + if(mode.sg_ispeed != mode.sg_ospeed) { - prspeed("input speed ", mode.sg_ispeed); +++ prspeed("input speed ", mode.sg_ispeed); + + prspeed("output speed ", mode.sg_ospeed); + + } else + + prspeed("speed ", mode.sg_ispeed); - pit(mode.sg_erase, "erase", "; "); - pit(mode.sg_kill, "kill", "; "); - pit(tc.t_intrc, "intr", "; "); - pit(tc.t_quitc, "quit", "\n"); - pit(tc.t_startc, "start", "; "); - pit(tc.t_stopc, "stop", "; "); - pit(tc.t_eofc, "eof", "; "); - pit(tc.t_brkc, "brk", "\n"); +++ fprintf(stderr, all==2 ? "\n" : "; "); + + m = mode.sg_flags; - if(m & EVENP) fprintf(stderr,"even "); - if(m & ODDP) fprintf(stderr,"odd "); - fprintf(stderr,"-raw "+((m&RAW)!=0)); - fprintf(stderr,"-nl "+((m&CRMOD)==0)); - fprintf(stderr,"-echo "+((m&ECHO)!=0)); - fprintf(stderr,"-lcase "+((m&LCASE)!=0)); +++ if(all==2 || (m&(EVENP|ODDP))!=(EVENP|ODDP)) { +++ if(m & EVENP) fprintf(stderr,"even "); +++ if(m & ODDP) fprintf(stderr,"odd "); +++ } +++ if(all==2 || m&RAW) +++ fprintf(stderr,"-raw "+((m&RAW)!=0)); +++ if(all==2 || (m&CRMOD)==0) +++ fprintf(stderr,"-nl "+((m&CRMOD)==0)); +++ if(all==2 || (m&ECHO)==0) +++ fprintf(stderr,"-echo "+((m&ECHO)!=0)); +++ if(all==2 || (m&LCASE)) +++ fprintf(stderr,"-lcase "+((m&LCASE)!=0)); +++ if(all==2 || (m&TANDEM)) +++ fprintf(stderr,"-tandem "+((m&TANDEM)!=0)); + + fprintf(stderr,"-tabs "+((m&XTABS)!=XTABS)); - fprintf(stderr,"-cbreak "+((m&CBREAK)!=0)); - delay((m&NLDELAY)/NL1, "nl"); +++ if(all==2 || (m&CBREAK)) +++ fprintf(stderr,"-cbreak "+((m&CBREAK)!=0)); +++ if(all==2 || (m&NLDELAY)) +++ delay((m&NLDELAY)/NL1, "nl"); + + if ((m&TBDELAY)!=XTABS) + + delay((m&TBDELAY)/TAB1, "tab"); - delay((m&CRDELAY)/CR1, "cr"); - delay((m&VTDELAY)/FF1, "ff"); - delay((m&BSDELAY)/BS1, "bs"); - fprintf(stderr,"\n"); +++ if(all==2 || (m&CRDELAY)) +++ delay((m&CRDELAY)/CR1, "cr"); +++ if(all==2 || (m&VTDELAY)) +++ delay((m&VTDELAY)/FF1, "ff"); +++ if(all==2 || (m&BSDELAY)) +++ delay((m&BSDELAY)/BS1, "bs"); +++ if (all) +++ fprintf(stderr,"\n"); +++#define lpit(what,str) \ +++ if (all==2||(lmode&what)) { \ +++ fprintf(stderr,str+((lmode&what)!=0)); any++; \ +++ } +++ if (ldisc == NTTYDISC) { +++ int newcrt = (lmode&(LCTLECH|LCRTBS)) == (LCTLECH|LCRTBS) && +++ (lmode&(LCRTERA|LCRTKIL)) == +++ ((mode.sg_ospeed > B300) ? LCRTERA|LCRTKIL : 0); +++ if (newcrt) { +++ if (all==2) +++ fprintf(stderr, "crt: (crtbs crterase crtkill ctlecho) "); +++ else +++ fprintf(stderr, "crt "); +++ any++; +++ } else { +++ lpit(LCRTBS, "-crtbs "); +++ lpit(LCRTERA, "-crterase "); +++ lpit(LCRTKIL, "-crtkill "); +++ lpit(LCTLECH, "-ctlecho "); +++ lpit(LPRTERA, "-prterase "); +++ } +++ lpit(LTOSTOP, "-tostop "); +++ lpit(LINTRUP, "-intrup "); +++ if (all==2) { +++ fprintf(stderr, "\n"); +++ any = 0; +++ } +++ lpit(LTILDE, "-tilde "); +++ lpit(LFLUSHO, "-flusho "); +++ lpit(LMDMBUF, "-mdmbuf "); +++ lpit(LLITOUT, "-litout "); +++ lpit(LNOHANG, "-nohang "); +++ lpit(LETXACK, "-etxack "); +++ lpit(LPENDIN, "-pendin "); +++ if (any) +++ fprintf(stderr,"\n"); +++ } else if (!all) +++ fprintf(stderr,"\n"); +++ if (all) { +++ switch (ldisc) { +++ +++ case 0: +++ fprintf(stderr,"\ +++erase kill intr quit stop eof\ +++\n"); +++ pcol(mode.sg_erase, -1); +++ pcol(mode.sg_kill, -1); +++ pcol(tc.t_intrc, -1); +++ pcol(tc.t_quitc, -1); +++ pcol(tc.t_stopc, tc.t_startc); +++ pcol(tc.t_eofc, tc.t_brkc); +++ fprintf(stderr,"\n"); +++ break; +++ +++ case NTTYDISC: +++ fprintf(stderr,"\ +++erase kill werase rprnt flush lnext susp intr quit stop eof\ +++\n"); +++ pcol(mode.sg_erase, -1); +++ pcol(mode.sg_kill, -1); +++ pcol(ltc.t_werasc, -1); +++ pcol(ltc.t_rprntc, -1); +++ pcol(ltc.t_flushc, -1); +++ pcol(ltc.t_lnextc, -1); +++ pcol(ltc.t_suspc, ltc.t_dsuspc); +++ pcol(tc.t_intrc, -1); +++ pcol(tc.t_quitc, -1); +++ pcol(tc.t_stopc, tc.t_startc); +++ pcol(tc.t_eofc, tc.t_brkc); +++ fprintf(stderr,"\n"); +++ break; +++ } +++ } else if (ldisc != NETLDISC) { +++ register struct special *sp; +++ int first = 1; +++ for (sp = special; sp->name; sp++) { +++ if ((*sp->cp&0377) != (sp->def&0377)) { +++ pit(*sp->cp, sp->name, first ? "" : ", "); +++ first = 0; +++ }; +++ if (sp->cp == &tc.t_brkc && ldisc == 0) +++ break; +++ } +++ if (first == 0) +++ fprintf(stderr, "\n"); +++ } +++} +++ +++pcol(ch1, ch2) +++ int ch1, ch2; +++{ +++ int nout = 0; +++ +++ ch1 &= 0377; +++ ch2 &= 0377; +++ if (ch1 == ch2) +++ ch2 = 0377; +++ for (; ch1 != 0377 || ch2 != 0377; ch1 = ch2, ch2 = 0377) { +++ if (ch1 == 0377) +++ continue; +++ if (ch1 & 0200) { +++ fprintf(stderr, "M-"); +++ nout += 2; +++ ch1 &= ~ 0200; +++ } +++ if (ch1 == 0177) { +++ fprintf(stderr, "^"); +++ nout++; +++ ch1 = '?'; +++ } else if (ch1 < ' ') { +++ fprintf(stderr, "^"); +++ nout++; +++ ch1 += '@'; +++ } +++ fprintf(stderr, "%c", ch1); +++ nout++; +++ if (ch2 != 0377) { +++ fprintf(stderr, "/"); +++ nout++; +++ } +++ } +++ while (nout < 7) { +++ fprintf(stderr, " "); +++ nout++; +++ } + +} + + + +pit(what, itsname, sep) - unsigned char what; +++ unsigned what; + + char *itsname, *sep; + +{ + + - fprintf(stderr, "%s", itsname); +++ what &= 0377; +++ fprintf(stderr, "%s%s", sep, itsname); + + if (what == 0377) { - fprintf(stderr, " %s", sep); +++ fprintf(stderr, " "); + + return; + + } + + fprintf(stderr, " = "); + + if (what & 0200) { + + fprintf(stderr, "M-"); + + what &= ~ 0200; + + } + + if (what == 0177) { + + fprintf(stderr, "^"); + + what = '?'; + + } else if (what < ' ') { + + fprintf(stderr, "^"); + + what += '@'; + + } - fprintf(stderr, "%c%s", what, sep); +++ fprintf(stderr, "%c", what); + +} + + + +delay(m, s) + +char *s; + +{ + + + + if(m) + + fprintf(stderr,"%s%d ", s, m); + +} + + + +int speed[] = { + + 0,50,75,110,134,150,200,300,600,1200,1800,2400,4800,9600,0,0 + +}; + + + +prspeed(c, s) + +char *c; + +{ + + - fprintf(stderr,"%s%d baud\n", c, speed[s]); +++ fprintf(stderr,"%s%d baud", c, speed[s]); + +} diff --cc usr/src/cmd/su.c index 0000000000,0e78c67907,0000000000..48de85b1ee mode 000000,100644,000000..100644 --- a/usr/src/cmd/su.c +++ b/usr/src/cmd/su.c @@@@ -1,0 -1,111 -1,0 +1,104 @@@@ +++static char *sccsid = "@(#)su.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + + + +struct passwd *pwd,*getpwnam(); + +char *crypt(); + +char *getpass(); + + + +main(argc,argv) + +int argc; + +char **argv; + +{ + + char *nptr; + + char *password; + + int badsw = 0; + + char *shell = "/bin/sh"; +++ int niced = 0; + + + + if(argc > 1) + + nptr = argv[1]; - else +++ else { + + nptr = "root"; +++ nice(-4); +++ niced = -4; +++ } + + if((pwd=getpwnam(nptr)) == NULL) { + + printf("Unknown id: %s\n",nptr); + + exit(1); + + } + + if(pwd->pw_passwd[0] == '\0' || getuid() == 0) + + goto ok; + + password = getpass("Password:"); + + if(badsw || (strcmp(pwd->pw_passwd, crypt(password, pwd->pw_passwd)) != 0)) { + +bad: + + printf("Sorry\n"); + + if(pwd->pw_uid == 0) { + + FILE *console = fopen("/dev/console", "w"); + + if (console != NULL) { + + fprintf(console, "BADSU: %s %s\r\n", getlogin(), ttyname(2)); + + fclose(console); + + } + + } + + exit(2); + + } - if(pwd->pw_uid == 0 && badroot(getgid(),getuid())) - goto bad; - + +ok: + + endpwent(); + + if(pwd->pw_uid == 0) { + + FILE *console = fopen("/dev/console", "w"); + + if (console != NULL) { + + fprintf(console, "SU: %s %s\r\n", getlogin(), ttyname(2)); + + fclose(console); + + } + + } + + setgid(pwd->pw_gid); + + setuid(pwd->pw_uid); + + if (pwd->pw_shell && *pwd->pw_shell) + + shell = pwd->pw_shell; + + homeis(pwd->pw_dir); + + shellis(shell); +++ nice(-niced); + + execl(shell, "su", 0); + + printf("No shell\n"); + + exit(3); + +} - badroot(gid,uid) - { - /* - if(gid!=10 || (uid > 15 && (uid!=40 && uid!=209 && uid!=203 - && uid!=54 && uid!=245))) - return(1); - else - */ - return(0); - } + + + +char **environ; + + + +homeis(hp) + + char *hp; + +{ + + register char *cp, *dp; + + register char **ep = environ; + + static char homebuf[128]; + + + + while (dp = *ep++) { + + for (cp = "HOME"; *cp == *dp && *cp; cp++, dp++) + + continue; + + if (*cp == 0 && (*dp == '=' || *dp == 0)) { + + strcpy(homebuf, "HOME="); + + strcat(homebuf, hp); + + *--ep = homebuf; + + return; + + } + + } + +} + + + +shellis(sp) + + char *sp; + +{ + + register char *cp, *dp; + + register char **ep = environ; + + static char shellbuf[128]; + + + + while (dp = *ep++) { + + for (cp = "SHELL"; *cp == *dp && *cp; cp++, dp++) + + continue; + + if (*cp == 0 && (*dp == '=' || *dp == 0)) { + + strcpy(shellbuf, "SHELL="); + + strcat(shellbuf, sp); + + *--ep = shellbuf; + + return; + + } + + } + +} diff --cc usr/src/cmd/sum.c index 0000000000,64acab1ccd,0000000000..e8f667a924 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sum.c +++ b/usr/src/cmd/sum.c @@@@ -1,0 -1,48 -1,0 +1,49 @@@@ +++static char *sccsid = "@(#)sum.c 4.1 (Berkeley) 10/1/80"; + +/* + + * Sum bytes in file mod 2^16 + + */ + + + +#include + + + +main(argc,argv) + +char **argv; + +{ + + register unsigned sum; + + register i, c; + + register FILE *f; + + register long nbytes; + + int errflg = 0; + + + + i = 1; + + do { + + if(i < argc) { + + if ((f = fopen(argv[i], "r")) == NULL) { + + fprintf(stderr, "sum: Can't open %s\n", argv[i]); + + errflg += 10; + + continue; + + } + + } else + + f = stdin; + + sum = 0; + + nbytes = 0; + + while ((c = getc(f)) != EOF) { + + nbytes++; + + if (sum&01) + + sum = (sum>>1) + 0x8000; + + else + + sum >>= 1; + + sum += c; + + sum &= 0xFFFF; + + } + + if (ferror(f)) { + + errflg++; + + fprintf(stderr, "sum: read error on %s\n", argc>1?argv[i]:"-"); + + } + + printf("%05u%6ld", sum, (nbytes+BUFSIZ-1)/BUFSIZ); + + if(argc > 2) + + printf(" %s", argv[i]); + + printf("\n"); + + fclose(f); + + } while(++i < argc); + + exit(errflg); + +} diff --cc usr/src/cmd/swapon.c index 0000000000,0000000000,0000000000..daadf0fc56 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/swapon.c @@@@ -1,0 -1,0 -1,0 +1,46 @@@@ +++static char *sccsid = "@(#)swapon.c 4.4 (Berkeley) 10/15/80"; +++#include +++#include +++ +++#define VSWAPON 85 +++ +++main(argc, argv) +++ int argc; +++ char *argv[]; +++{ +++ int stat = 0; +++ +++ --argc, argv++; +++ if (argc == 0) { +++ fprintf(stderr, "usage: swapon name...\n"); +++ exit(1); +++ } +++ if (argc == 1 && !strcmp(*argv, "-a")) { +++ struct fstab *fsp; +++ if (setfsent() == 0) +++ perror(FSTAB), exit(1); +++ while ( (fsp = getfsent()) != 0){ +++ if (strcmp(fsp->fs_type, FSTAB_SW) != 0) +++ continue; +++ printf("Adding %s as swap device\n", +++ fsp->fs_spec); +++ if (syscall(VSWAPON, fsp->fs_spec) == -1) { +++ extern errno; +++ extern char *sys_errlist[]; +++ printf("%s: %s\n", +++ sys_errlist[errno]); +++ stat = 1; +++ } +++ } +++ endfsent(); +++ exit(stat); +++ } +++ do { +++ if (syscall(VSWAPON, *argv++) == -1) { +++ stat = 1; +++ perror(argv[-1]); +++ } +++ argc--; +++ } while (argc > 0); +++ exit(stat); +++} diff --cc usr/src/cmd/symorder.c index 0000000000,b7e613d02e,0000000000..d811b9b864 mode 000000,100644,000000..100644 --- a/usr/src/cmd/symorder.c +++ b/usr/src/cmd/symorder.c @@@@ -1,0 -1,117 -1,0 +1,150 @@@@ - /* symorder orderlist symbolfile - * orderlist is a file containing symbols to be found in symbolfile, - * 1 symbol per line. - * symbolfile is updated in place to put the requested symbols first - * in the symbol table, in the order specified. This is done - * by swapping the old symbols in the required spots with the - * new ones. If all of the order symbols are not found, an - * error is generated. - * - * Modelled after nlist.c the nlist subroutine, which has been - * modified to succeed as soon as all sought symbols are found. - * - * This program was specifically designed to cut down on the read - * overhead of systat(ss) when getting symbols from /unix. +++static char *sccsid = "@(#)symorder.c 4.2 (Berkeley) 10/2/80"; +++/* +++ * symorder - reorder symbol table + + */ - + +#include +++#include +++#include +++#include + +#include - int a_magic[] = {A_MAGIC1, A_MAGIC2, A_MAGIC3, A_MAGIC4, 0}; +++ + +#define SPACE 100 + + +++struct nlist order[SPACE]; +++ +++char *savestr(); +++struct nlist nl1, nl2; +++struct exec exec; +++FILE *strf; +++off_t sa, ss; +++struct stat stb; +++int nsym = 0; +++int symfound = 0; +++char asym[BUFSIZ]; +++ + +main(argc, argv) - char *argv[]; +++ char **argv; + +{ + + register struct nlist *p, *q; + + register FILE *f; - register int sa, na, i, j; - int nsym = 0, symfound = 0, n, o; - struct nlist nl1, nl2; - char buf[20]; - struct nlist order[SPACE]; - struct exec exec; +++ register int na, i, j; +++ int maxlen; +++ int n, o; + + + + if(argc != 3) { + + fprintf(stderr, "Usage: symorder orderlist file\n"); + + exit(1); + + } + + if((f = fopen(argv[1], "r")) == NULL) { - fprintf(stderr, "Can't open "); perror(argv[1]); +++ perror(argv[1]); + + exit(1); + + } - for(p = order; fgets(buf, sizeof buf, f) != NULL; p++, nsym++) - for(i = 0; i < 8 && buf[i] != '\n'; i++) - p->n_name[i] = buf[i]; - fclose(f); - /*** for(i = 0; i < nsym; i++) ***/ - /*** printf("\"%.8s\"\n", order[i].n_name); ***/ - /*** printf("--------\n"); ***/ - if((f = fopen(argv[2], "r")) == NULL) { - fprintf(stderr, "Can't open "); perror(argv[2]); - exit(1); +++ maxlen = 0; +++ for(p = order; fgets(asym, sizeof asym, f) != NULL; p++, nsym++) { +++ for(i = 0; asym[i] && asym[i] != '\n'; i++) +++ continue; +++ if (asym[i] == '\n') +++ asym[i] = 0; +++ p->n_un.n_name = savestr(asym); +++ if (maxlen < strlen(p->n_un.n_name)) +++ maxlen = strlen(p->n_un.n_name); + + } - if((o = open(argv[2], 1)) < 0) { - fprintf(stderr, "Can't update "); perror(argv[2]); +++ fclose(f); +++ if((f = fopen(argv[2], "r")) == NULL) +++ perror(argv[2]), exit(1); +++ if((strf = fopen(argv[2], "r")) == NULL) +++ perror(argv[2]), exit(1); +++ if((o = open(argv[2], 1)) < 0) +++ perror(argv[2]), exit(1); +++ if((fread(&exec, sizeof exec, 1, f)) != 1 || N_BADMAG(exec)) { +++ fprintf(stderr, "symorder: %s: bad format\n", argv[2]); + + exit(1); + + } - if((fread(&exec, sizeof exec, 1, f)) != 1) { - fprintf(stderr, "Can't read "); perror(argv[2]); +++ if (exec.a_syms == 0) { +++ fprintf(stderr, "symorder: %s is stripped\n", argv[2]); + + exit(1); + + } - for(i=0; a_magic[i]; i++) - if(a_magic[i] == exec.a_magic) break; - if(a_magic[i] == 0){ - fprintf(stderr, "Bad Header on %s\n", argv[2]); +++ fstat(fileno(f), &stb); +++ if (stb.st_size < N_STROFF(exec)+sizeof(off_t)) { +++ fprintf(stderr, "symorder: %s is in old format or truncated\n", argv[2]); + + exit(1); + + } - sa = exec.a_text + exec.a_data; - sa += exec.a_trsize + exec.a_drsize; - sa += sizeof exec; +++ sa = N_SYMOFF(exec); + + na = sa; +++ ss = sa + exec.a_syms; + + fseek(f, sa, 0); + + n = exec.a_syms; - + + while(n && symfound < nsym) { + + if(fread(&nl1, sizeof nl1, 1, f) != 1) { + + fprintf(stderr, "Short file "); perror(argv[2]); + + exit(1); + + } - /*** printf("\"%.8s\"\n", nl1.n_name); ***/ + + na += sizeof nl1; + + n -= sizeof nl1; - /*** printf("Trying "); ***/ +++ if (nl1.n_un.n_strx == 0 || nl1.n_type & N_STAB) +++ continue; +++ fseek(strf, ss+nl1.n_un.n_strx, 0); +++ fread(asym, maxlen+1, 1, strf); + + for(j = 0; j < nsym; j++) { - /*** printf("%s ", order[j].n_name); ***/ - for(i = 0; i < 8; i++) - if(nl1.n_name[i] != order[j].n_name[i]) +++ for(i = 0; asym[i]; i++) +++ if(asym[i] != order[j].n_un.n_name[i]) + + goto cont; - /*** printf("Found: %.8s\n", nl1.n_name); ***/ +++ if (order[j].n_un.n_name[i]) +++ goto cont; + + if (order[j].n_value) + + goto cont; + + order[j].n_value = 1; + + fseek(f, (i = (sa+(j * sizeof nl1))), 0); + + if(fread(&nl2, sizeof nl2, 1, f) != 1) - printf("Read err on 2nd sym\n"); +++ printf("Read err on 2nd asym\n"); + + lseek(o, i, 0); + + if(write(o, &nl1, sizeof nl1) == -1) + + perror("write1"); + + lseek(o, na-sizeof nl1, 0); + + if(write(o, &nl2, sizeof nl2) == -1) + + perror("write2"); + + fseek(f, 0, 0); + + fseek(f, na, 0); + + symfound++; + + break; + + cont: ; + + + + } - /*** printf("\n"); ***/ + + } + + if(symfound < nsym) { - fprintf(stderr, "%d Syms not found:\n", nsym - symfound); +++ fprintf(stderr, "%d symbol(s) not found:\n", nsym - symfound); + + for (i = 0; i < nsym; i++) { + + if (order[i].n_value == 0) - printf("%.8s\n", order[i].n_name); +++ printf("%s\n", order[i].n_un.n_name); +++ } +++ } +++} +++ +++#define NSAVETAB 4096 +++char *savetab; +++int saveleft; +++ +++char * +++savestr(cp) +++ register char *cp; +++{ +++ register int len; +++ +++ len = strlen(cp) + 1; +++ if (len > saveleft) { +++ saveleft = NSAVETAB; +++ if (len > saveleft) +++ saveleft = len; +++ savetab = (char *)malloc(saveleft); +++ if (savetab == 0) { +++ fprintf(stderr, +++ "symorder: ran out of memory (savestr)\n"); +++ exit(1); + + } + + } +++ strncpy(savetab, cp, len); +++ cp = savetab; +++ savetab += len; +++ saveleft -= len; +++ return (cp); + +} diff --cc usr/src/cmd/sync.c index 0000000000,3afb9b8256,0000000000..a38100fea5 mode 000000,100644,000000..100644 --- a/usr/src/cmd/sync.c +++ b/usr/src/cmd/sync.c @@@@ -1,0 -1,5 -1,0 +1,6 @@@@ +++static char *sccsid = "@(#)sync.c 4.1 (Berkeley) 10/1/80"; + +main() + +{ + + + + sync(); + +} diff --cc usr/src/cmd/tabs.c index 0000000000,030ca8564d,0000000000..c547043291 mode 000000,100644,000000..100644 --- a/usr/src/cmd/tabs.c +++ b/usr/src/cmd/tabs.c @@@@ -1,0 -1,197 -1,0 +1,198 @@@@ +++static char *sccsid = "@(#)tabs.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + + + +#define SP ' ' + +#define TB '\t' + +#define NL '\n' + + + +# define ESC 033 + +# define RHM 060 + +# define SI 017 + +# define DEL 0177 + +# define SET '1' + +# define CLR '2' + +# define MGN '9' + +# define CR '\r' + +# define BS '\b' + + + +struct sysnod { + + char *sysnam; + + int sysval; + +}; + + + +#define DASI300 1 + +#define DASI300S 2 + +#define DASI450 3 + +#define TN300 4 + +#define TTY37 5 + +#define HP 6 + +struct sysnod tty[] = { + + {"dasi300", DASI300}, + + {"300", DASI300}, + + {"dasi300s", DASI300S}, + + {"300s", DASI300S}, + + {"dasi450", DASI450}, + + {"450", DASI450}, + + {"37", TTY37}, + + {"tty37", TTY37}, + + {"tn300", TN300}, + + {"terminet", TN300}, + + {"tn", TN300}, + + {"hp", HP}, + + {0, 0}, + +}; + +int margset = 1; + + + +syslook(w) + +char *w; + +{ + + register struct sysnod *sp; + + + + for (sp = tty; sp->sysnam!=NULL; sp++) + + if (strcmp(sp->sysnam, w)==0) + + return(sp->sysval); + + return(0); + +} + + + +main(argc,argv) + +int argc; char **argv; + +{ + + struct sgttyb tb; + + int type; + + char *getenv(); + + + + type=0; + + if (argc>=2 && strcmp(argv[1],"-n")==0) { + + margset--; argc--; argv++; + + } + + if (argc>=2) { + + type=syslook(argv[1]); + + } else { + + type=syslook(getenv("TERM")); + + } + + + + switch(type) { + + + + case DASI300: dasi300(); break; + + + + case DASI300S: dasi300(); break; + + + + case DASI450: dasi450(); break; + + + + case TN300: tn300(); break; + + + + case TTY37: tty37(); break; + + + + case HP: hp2645(); break; + + + + default: + + gtty (0, &tb); + + if ( (tb.sg_flags & (LCASE|CRMOD)) == CRMOD) { + + /* test for CR map on, upper case off, i.e. terminet but not 33 */ + + if ((tb.sg_ispeed) == B300) /* test for 300 baud */ + + misc(); + + } + + else if ((tb.sg_flags & (CRMOD|LCASE)) == 0 && (tb.sg_ispeed ) == B150) { + + /* apparent model 37 */ + + tty37(); + + } + + } + +} + + + +clear(n) + +{ + + escape(CLR); + + delay(n); + + putchar(CR); nl(); + +} + + + +delay(n) + +{ + + while (n--) putchar(DEL); + +} + + + +tabs(n) + +{ + + int i,j; + + + + if(margset) n--; + + + + for( i=0; i +++#include + +#include + +#include + +#include - #include - #define BUFSIZ BSIZE +++ + +#define LBIN 4097 + +struct stat statb; +++int follow; +++int piped; + +char bin[LBIN]; + +int errno; + + + +main(argc,argv) + +char **argv; + +{ + + long n,di; - int fromend; + + register i,j,k; +++ char *arg; +++ int partial,bylines,bkwds,fromend,lastnl; + + char *p; - int partial,piped,bylines; - char *arg; +++ + + lseek(0,(long)0,1); + + piped = errno==ESPIPE; + + arg = argv[1]; + + if(argc<=1 || *arg!='-'&&*arg!='+') { + + arg = "-10l"; + + argc++; + + argv--; + + } + + fromend = *arg=='-'; + + arg++; - if(!digit(*arg)) - goto errcom; + + n = 0; - while(digit(*arg)) +++ while(isdigit(*arg)) + + n = n*10 + *arg++ - '0'; + + if(!fromend&&n>0) + + n--; + + if(argc>2) { + + close(0); + + if(open(argv[2],0)!=0) { - write(2,"tail: can't open ",17); - write(2,argv[2],strlen(argv[2])); - write(2,"\n",1); +++ perror(argv[2]); + + exit(1); + + } + + } - bylines = 0; - switch(*arg) { +++ bylines = -1; bkwds = 0; +++ while(*arg) +++ switch(*arg++) { +++ + + case 'b': + + n <<= 9; +++ if(bylines!=-1) goto errcom; +++ bylines=0; + + break; + + case 'c': +++ if(bylines!=-1) goto errcom; +++ bylines=0; +++ break; +++ case 'f': +++ follow = 1; +++ break; +++ case 'r': +++ if(n==0) n = LBIN; +++ bkwds = 1; fromend = 1; bylines = 1; + + break; - case '\0': + + case 'l': +++ if(bylines!=-1) goto errcom; + + bylines = 1; + + break; + + default: + + goto errcom; + + } +++ if (n==0) n = 10; +++ if(bylines==-1) bylines = 1; +++ if(bkwds) follow=0; + + if(fromend) + + goto keep; + + + + /*seek from beginning */ + + + + if(bylines) { + + j = 0; + + while(n-->0) { + + do { + + if(j--<=0) { + + p = bin; + + j = read(0,p,BUFSIZ); - if(j--<=0) exit(0); +++ if(j--<=0) +++ fexit(); + + } + + } while(*p++ != '\n'); + + } + + write(1,p,j); + + } else if(n>0) { + + if(!piped) + + fstat(0,&statb); + + if(piped||(statb.st_mode&S_IFMT)==S_IFCHR) + + while(n>0) { + + i = n>BUFSIZ?BUFSIZ:n; + + i = read(0,bin,i); - if(i<=0) exit(0); +++ if(i<=0) +++ fexit(); + + n -= i; + + } + + else + + lseek(0,n,0); + + } +++copy: + + while((i=read(0,bin,BUFSIZ))>0) + + write(1,bin,i); - exit(0); +++ fexit(); + + + + /*seek from end*/ + + + +keep: - if(n<=0) exit(0); +++ if(n <= 0) +++ fexit(); + + if(!piped) { + + fstat(0,&statb); + + di = !bylines&&n di) + + lseek(0,-di,2); +++ if(!bylines) +++ goto copy; + + } + + partial = 1; + + for(;;) { + + i = 0; + + do { + + j = read(0,&bin[i],LBIN-i); + + if(j<=0) + + goto brka; + + i += j; + + } while(i=LBIN ? i+1: + + i-n+LBIN; + + k--; + + } else { +++ if(bkwds && bin[i==0?LBIN-1:i-1]!='\n'){ /* force trailing newline */ +++ bin[i]='\n'; +++ if(++i>=LBIN) {i = 0; partial = 0;} +++ } + + k = i; + + j = 0; + + do { +++ lastnl = k; + + do { + + if(--k<0) { - if(partial) +++ if(partial) { +++ if(bkwds) write(1,bin,lastnl+1); + + goto brkb; +++ } + + k = LBIN -1; + + } + + } while(bin[k]!='\n'&&k!=i); +++ if(bkwds && j>0){ +++ if(k=LBIN) + + k = 0; + + } while(bin[k]!='\n'&&k!=i); + + } + + if(k='0'&&c<='9'); +++fexit() +++{ register int n; +++ if (!follow || piped) exit(0); +++ for (;;) +++ { sleep(1); +++ while ((n = read (0, bin, BUFSIZ)) > 0) +++ write (1, bin, n); +++ } + +} diff --cc usr/src/cmd/tar.c index 0000000000,60329bf9c8,0000000000..462eb4b87a mode 000000,100644,000000..100644 --- a/usr/src/cmd/tar.c +++ b/usr/src/cmd/tar.c @@@@ -1,0 -1,950 -1,0 +1,976 @@@@ +++static char *sccsid = "@(#)tar.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +#include + +#include + + + +char *sprintf(); + +char *strcat(); + +daddr_t bsrch(); + +#define TBLOCK 512 - #define NBLOCK 20 +++#define NBLOCK 40 + +#define NAMSIZ 100 + +union hblock { + + char dummy[TBLOCK]; + + struct header { + + char name[NAMSIZ]; + + char mode[8]; + + char uid[8]; + + char gid[8]; + + char size[12]; + + char mtime[12]; + + char chksum[8]; + + char linkflag; + + char linkname[NAMSIZ]; + + } dbuf; + +} dblock, tbuf[NBLOCK]; + + + +struct linkbuf { + + ino_t inum; + + dev_t devnum; + + int count; + + char pathname[NAMSIZ]; + + struct linkbuf *nextp; + +} *ihead; + + + +struct stat stbuf; + + - int rflag, xflag, vflag, tflag, mt, cflag, mflag, fflag; +++int rflag, xflag, vflag, tflag, mt, cflag, mflag, fflag, oflag, pflag; + +int term, chksum, wflag, recno, first, linkerrok; + +int freemem = 1; + +int nblock = 1; + + + +daddr_t low; + +daddr_t high; + + + +FILE *tfile; + +char tname[] = "/tmp/tarXXXXXX"; + + + + + +char *usefile; - char magtape[] = "/dev/mt1"; +++char magtape[] = "/dev/rmt8"; + + + +char *malloc(); + + + +main(argc, argv) + +int argc; + +char *argv[]; + +{ + + char *cp; + + int onintr(), onquit(), onhup(), onterm(); + + + + if (argc < 2) + + usage(); + + + + tfile = NULL; + + usefile = magtape; + + argv[argc] = 0; + + argv++; + + for (cp = *argv++; *cp; cp++) + + switch(*cp) { + + case 'f': + + usefile = *argv++; + + fflag++; + + if (nblock == 1) + + nblock = 0; + + break; + + case 'c': + + cflag++; + + rflag++; + + break; +++ case 'o': +++ oflag++; +++ break; +++ case 'p': +++ pflag++; +++ break; + + case 'u': + + mktemp(tname); + + if ((tfile = fopen(tname, "w")) == NULL) { + + fprintf(stderr, "Tar: cannot create temporary file (%s)\n", tname); + + done(1); + + } + + fprintf(tfile, "!!!!!/!/!/!/!/!/!/! 000\n"); + + /* FALL THROUGH */ + + case 'r': + + rflag++; + +noupdate: + + if (nblock != 1 && cflag == 0) { + + fprintf(stderr, "Tar: Blocked tapes cannot be updated (yet)\n"); + + done(1); + + } + + break; + + case 'v': + + vflag++; + + break; + + case 'w': + + wflag++; + + break; + + case 'x': + + xflag++; + + break; + + case 't': + + tflag++; + + break; + + case 'm': + + mflag++; + + break; + + case '-': + + break; + + case '0': + + case '1': + + case '4': + + case '5': + + case '7': + + case '8': - magtape[7] = *cp; +++ magtape[8] = *cp; + + usefile = magtape; + + break; + + case 'b': + + nblock = atoi(*argv++); + + if (nblock > NBLOCK || nblock <= 0) { + + fprintf(stderr, "Invalid blocksize. (Max %d)\n", NBLOCK); + + done(1); + + } + + if (rflag && !cflag) + + goto noupdate; + + break; + + case 'l': + + linkerrok++; + + break; + + default: + + fprintf(stderr, "tar: %c: unknown option\n", *cp); + + usage(); + + } + + + + if (rflag) { + + if (cflag && tfile != NULL) { + + usage(); + + done(1); + + } + + if (signal(SIGINT, SIG_IGN) != SIG_IGN) + + signal(SIGINT, onintr); + + if (signal(SIGHUP, SIG_IGN) != SIG_IGN) + + signal(SIGHUP, onhup); + + if (signal(SIGQUIT, SIG_IGN) != SIG_IGN) + + signal(SIGQUIT, onquit); + +/* + + if (signal(SIGTERM, SIG_IGN) != SIG_IGN) + + signal(SIGTERM, onterm); + +*/ + + if (strcmp(usefile, "-") == 0) { + + if (cflag == 0) { + + fprintf(stderr, "Can only create standard output archives\n"); + + done(1); + + } + + mt = dup(1); + + nblock = 1; + + } + + else if ((mt = open(usefile, 2)) < 0) { + + if (cflag == 0 || (mt = creat(usefile, 0666)) < 0) { + + fprintf(stderr, "tar: cannot open %s\n", usefile); + + done(1); + + } + + } + + if (cflag == 0 && nblock == 0) + + nblock = 1; + + dorep(argv); + + } + + else if (xflag) { + + if (strcmp(usefile, "-") == 0) { + + mt = dup(0); + + nblock = 1; + + } + + else if ((mt = open(usefile, 0)) < 0) { + + fprintf(stderr, "tar: cannot open %s\n", usefile); + + done(1); + + } + + doxtract(argv); + + } + + else if (tflag) { + + if (strcmp(usefile, "-") == 0) { + + mt = dup(0); + + nblock = 1; + + } + + else if ((mt = open(usefile, 0)) < 0) { + + fprintf(stderr, "tar: cannot open %s\n", usefile); + + done(1); + + } + + dotable(); + + } + + else + + usage(); + + done(0); + +} + + + +usage() + +{ + + fprintf(stderr, "tar: usage tar -{txru}[cvfblm] [tapefile] [blocksize] file1 file2...\n"); + + done(1); + +} + + + +dorep(argv) + +char *argv[]; + +{ + + register char *cp, *cp2; + + char wdir[60]; + + + + if (!cflag) { + + getdir(); + + do { + + passtape(); + + if (term) + + done(0); + + getdir(); + + } while (!endtape()); + + if (tfile != NULL) { + + char buf[200]; + + + + strcat(buf, "sort +0 -1 +1nr "); + + strcat(buf, tname); + + strcat(buf, " -o "); + + strcat(buf, tname); + + sprintf(buf, "sort +0 -1 +1nr %s -o %s; awk '$1 != prev {print; prev=$1}' %s >%sX;mv %sX %s", + + tname, tname, tname, tname, tname, tname); + + fflush(tfile); + + system(buf); + + freopen(tname, "r", tfile); + + fstat(fileno(tfile), &stbuf); + + high = stbuf.st_size; + + } + + } + + + + getwdir(wdir); + + while (*argv && ! term) { + + cp2 = *argv; + + if (!strcmp(cp2, "-C") && argv[1]) { + + argv++; + + if (chdir(*argv) < 0) + + perror(*argv); + + else + + getwdir(wdir); + + argv++; + + continue; + + } + + for (cp = *argv; *cp; cp++) + + if (*cp == '/') + + cp2 = cp; + + if (cp2 != *argv) { + + *cp2 = '\0'; + + chdir(*argv); + + *cp2 = '/'; + + cp2++; + + } + + putfile(*argv++, cp2); + + chdir(wdir); + + } + + putempty(); + + putempty(); + + flushtape(); + + if (linkerrok == 1) + + for (; ihead != NULL; ihead = ihead->nextp) + + if (ihead->count != 0) + + fprintf(stderr, "Missing links to %s\n", ihead->pathname); + +} + + + +endtape() + +{ + + if (dblock.dbuf.name[0] == '\0') { + + backtape(); + + return(1); + + } + + else + + return(0); + +} + + + +getdir() + +{ + + register struct stat *sp; + + int i; + + + + readtape( (char *) &dblock); + + if (dblock.dbuf.name[0] == '\0') + + return; + + sp = &stbuf; + + sscanf(dblock.dbuf.mode, "%o", &i); + + sp->st_mode = i; + + sscanf(dblock.dbuf.uid, "%o", &i); + + sp->st_uid = i; + + sscanf(dblock.dbuf.gid, "%o", &i); + + sp->st_gid = i; + + sscanf(dblock.dbuf.size, "%lo", &sp->st_size); + + sscanf(dblock.dbuf.mtime, "%lo", &sp->st_mtime); + + sscanf(dblock.dbuf.chksum, "%o", &chksum); + + if (chksum != checksum()) { + + fprintf(stderr, "directory checksum error\n"); + + done(2); + + } + + if (tfile != NULL) + + fprintf(tfile, "%s %s\n", dblock.dbuf.name, dblock.dbuf.mtime); + +} + + + +passtape() + +{ + + long blocks; + + char buf[TBLOCK]; + + + + if (dblock.dbuf.linkflag == '1') + + return; + + blocks = stbuf.st_size; + + blocks += TBLOCK-1; + + blocks /= TBLOCK; + + + + while (blocks-- > 0) + + readtape(buf); + +} + + + +putfile(longname, shortname) + +char *longname; + +char *shortname; + +{ + + int infile; + + long blocks; + + char buf[TBLOCK]; + + register char *cp, *cp2; + + struct direct dbuf; + + int i, j; + + + + infile = open(shortname, 0); + + if (infile < 0) { + + fprintf(stderr, "tar: %s: cannot open file\n", longname); + + return; + + } + + + + fstat(infile, &stbuf); + + + + if (tfile != NULL && checkupdate(longname) == 0) { + + close(infile); + + return; + + } + + if (checkw('r', longname) == 0) { + + close(infile); + + return; + + } + + + + if ((stbuf.st_mode & S_IFMT) == S_IFDIR) { + + for (i = 0, cp = buf; *cp++ = longname[i++];); + + *--cp = '/'; - cp++; +++ *++cp = 0 ; + + i = 0; +++ if (!oflag) { +++ if( (cp - buf) >= NAMSIZ) { +++ fprintf(stderr, "%s: file name too long\n", longname); +++ close(infile); +++ return; +++ } +++ stbuf.st_size = 0; +++ tomodes(&stbuf); +++ strcpy(dblock.dbuf.name,buf); +++ sprintf(dblock.dbuf.chksum, "%6o", checksum()); +++ writetape( (char *) &dblock); +++ } + + chdir(shortname); + + while (read(infile, (char *)&dbuf, sizeof(dbuf)) > 0 && !term) { + + if (dbuf.d_ino == 0) { + + i++; + + continue; + + } + + if (strcmp(".", dbuf.d_name) == 0 || strcmp("..", dbuf.d_name) == 0) { + + i++; + + continue; + + } + + cp2 = cp; + + for (j=0; j < DIRSIZ; j++) + + *cp2++ = dbuf.d_name[j]; + + *cp2 = '\0'; + + close(infile); + + putfile(buf, cp); + + infile = open(".", 0); + + i++; + + lseek(infile, (long) (sizeof(dbuf) * i), 0); + + } + + close(infile); + + chdir(".."); + + return; + + } + + if ((stbuf.st_mode & S_IFMT) != S_IFREG) { + + fprintf(stderr, "tar: %s is not a file. Not dumped\n", longname); + + return; + + } + + + + tomodes(&stbuf); + + + + cp2 = longname; + + for (cp = dblock.dbuf.name, i=0; (*cp++ = *cp2++) && i < NAMSIZ; i++); + + if (i >= NAMSIZ) { + + fprintf(stderr, "%s: file name too long\n", longname); + + close(infile); + + return; + + } + + + + if (stbuf.st_nlink > 1) { + + struct linkbuf *lp; + + int found = 0; + + + + for (lp = ihead; lp != NULL; lp = lp->nextp) { + + if (lp->inum == stbuf.st_ino && lp->devnum == stbuf.st_dev) { + + found++; + + break; + + } + + } + + if (found) { + + strcpy(dblock.dbuf.linkname, lp->pathname); + + dblock.dbuf.linkflag = '1'; + + sprintf(dblock.dbuf.chksum, "%6o", checksum()); + + writetape( (char *) &dblock); + + if (vflag) { + + fprintf(stderr, "a %s ", longname); + + fprintf(stderr, "link to %s\n", lp->pathname); + + } + + lp->count--; + + close(infile); + + return; + + } + + else { + + lp = (struct linkbuf *) malloc(sizeof(*lp)); + + if (lp == NULL) { + + if (freemem) { + + fprintf(stderr, "Out of memory. Link information lost\n"); + + freemem = 0; + + } + + } + + else { + + lp->nextp = ihead; + + ihead = lp; + + lp->inum = stbuf.st_ino; + + lp->devnum = stbuf.st_dev; + + lp->count = stbuf.st_nlink - 1; + + strcpy(lp->pathname, longname); + + } + + } + + } + + + + blocks = (stbuf.st_size + (TBLOCK-1)) / TBLOCK; + + if (vflag) { + + fprintf(stderr, "a %s ", longname); + + fprintf(stderr, "%ld blocks\n", blocks); + + } + + sprintf(dblock.dbuf.chksum, "%6o", checksum()); + + writetape( (char *) &dblock); + + + + while ((i = read(infile, buf, TBLOCK)) > 0 && blocks > 0) { + + writetape(buf); + + blocks--; + + } + + close(infile); + + if (blocks != 0 || i != 0) + + fprintf(stderr, "%s: file changed size\n", longname); + + while (blocks-- > 0) + + putempty(); + +} + + + + + + + +doxtract(argv) + +char *argv[]; + +{ + + long blocks, bytes; + + char buf[TBLOCK]; + + char **cp; + + int ofile; + + + + for (;;) { + + getdir(); + + if (endtape()) + + break; + + + + if (*argv == 0) + + goto gotit; + + + + for (cp = argv; *cp; cp++) + + if (prefix(*cp, dblock.dbuf.name)) + + goto gotit; + + passtape(); + + continue; + + + +gotit: + + if (checkw('x', dblock.dbuf.name) == 0) { + + passtape(); + + continue; + + } + + - checkdir(dblock.dbuf.name); +++ if(checkdir(dblock.dbuf.name)) +++ continue; + + + + if (dblock.dbuf.linkflag == '1') { + + unlink(dblock.dbuf.name); + + if (link(dblock.dbuf.linkname, dblock.dbuf.name) < 0) { + + fprintf(stderr, "%s: cannot link\n", dblock.dbuf.name); + + continue; + + } + + if (vflag) + + fprintf(stderr, "%s linked to %s\n", dblock.dbuf.name, dblock.dbuf.linkname); + + continue; + + } + + if ((ofile = creat(dblock.dbuf.name, stbuf.st_mode & 07777)) < 0) { + + fprintf(stderr, "tar: %s - cannot create\n", dblock.dbuf.name); + + passtape(); + + continue; + + } + + - chown(dblock.dbuf.name, stbuf.st_uid, stbuf.st_gid); - + + blocks = ((bytes = stbuf.st_size) + TBLOCK-1)/TBLOCK; + + if (vflag) + + fprintf(stderr, "x %s, %ld bytes, %ld tape blocks\n", dblock.dbuf.name, bytes, blocks); + + while (blocks-- > 0) { + + readtape(buf); + + if (bytes > TBLOCK) { + + if (write(ofile, buf, TBLOCK) < 0) { + + fprintf(stderr, "tar: %s: HELP - extract write error\n", dblock.dbuf.name); + + done(2); + + } + + } else + + if (write(ofile, buf, (int) bytes) < 0) { + + fprintf(stderr, "tar: %s: HELP - extract write error\n", dblock.dbuf.name); + + done(2); + + } + + bytes -= TBLOCK; + + } + + close(ofile); + + if (mflag == 0) { + + time_t timep[2]; + + + + timep[0] = time(NULL); + + timep[1] = stbuf.st_mtime; + + utime(dblock.dbuf.name, timep); + + } +++ if(pflag) { +++ chown(dblock.dbuf.name, stbuf.st_uid, stbuf.st_gid); +++ chmod(dblock.dbuf.name, stbuf.st_mode & 07777); +++ } + + } + +} + + + +dotable() + +{ + + for (;;) { + + getdir(); + + if (endtape()) + + break; + + if (vflag) + + longt(&stbuf); + + printf("%s", dblock.dbuf.name); + + if (dblock.dbuf.linkflag == '1') + + printf(" linked to %s", dblock.dbuf.linkname); + + printf("\n"); + + passtape(); + + } + +} + + + +putempty() + +{ + + char buf[TBLOCK]; + + char *cp; + + + + for (cp = buf; cp < &buf[TBLOCK]; ) + + *cp++ = '\0'; + + writetape(buf); + +} + + + +longt(st) + +register struct stat *st; + +{ + + register char *cp; + + char *ctime(); + + + + pmode(st); + + printf("%3d/%1d", st->st_uid, st->st_gid); + + printf("%7D", st->st_size); + + cp = ctime(&st->st_mtime); + + printf(" %-12.12s %-4.4s ", cp+4, cp+20); + +} + + + +#define SUID 04000 + +#define SGID 02000 + +#define ROWN 0400 + +#define WOWN 0200 + +#define XOWN 0100 + +#define RGRP 040 + +#define WGRP 020 + +#define XGRP 010 + +#define ROTH 04 + +#define WOTH 02 + +#define XOTH 01 + +#define STXT 01000 + +int m1[] = { 1, ROWN, 'r', '-' }; + +int m2[] = { 1, WOWN, 'w', '-' }; + +int m3[] = { 2, SUID, 's', XOWN, 'x', '-' }; + +int m4[] = { 1, RGRP, 'r', '-' }; + +int m5[] = { 1, WGRP, 'w', '-' }; + +int m6[] = { 2, SGID, 's', XGRP, 'x', '-' }; + +int m7[] = { 1, ROTH, 'r', '-' }; + +int m8[] = { 1, WOTH, 'w', '-' }; + +int m9[] = { 2, STXT, 't', XOTH, 'x', '-' }; + + + +int *m[] = { m1, m2, m3, m4, m5, m6, m7, m8, m9}; + + + +pmode(st) + +register struct stat *st; + +{ + + register int **mp; + + + + for (mp = &m[0]; mp < &m[9];) + + select(*mp++, st); + +} + + + +select(pairp, st) + +int *pairp; + +struct stat *st; + +{ + + register int n, *ap; + + + + ap = pairp; + + n = *ap++; + + while (--n>=0 && (st->st_mode&*ap++)==0) + + ap++; + + printf("%c", *ap); + +} + + + +checkdir(name) + +register char *name; + +{ + + register char *cp; + + int i; + + for (cp = name; *cp; cp++) { + + if (*cp == '/') { + + *cp = '\0'; + + if (access(name, 01) < 0) { + + register int pid, rp; + + + + if ((pid = fork()) == 0) { + + execl("/bin/mkdir", "mkdir", name, 0); + + execl("/usr/bin/mkdir", "mkdir", name, 0); + + fprintf(stderr, "tar: cannot find mkdir!\n"); + + done(0); + + } + + while ((rp = wait(&i)) >= 0 && rp != pid) + + ; - chown(name, stbuf.st_uid, stbuf.st_gid); +++ if(pflag) { +++ chown(name, stbuf.st_uid, stbuf.st_gid); +++ chmod(dblock.dbuf.name, stbuf.st_mode & 0777); +++ } + + } + + *cp = '/'; + + } + + } +++ return(cp[-1]=='/'); + +} + + + +onintr() + +{ + + signal(SIGINT, SIG_IGN); + + term++; + +} + + + +onquit() + +{ + + signal(SIGQUIT, SIG_IGN); + + term++; + +} + + + +onhup() + +{ + + signal(SIGHUP, SIG_IGN); + + term++; + +} + + + +onterm() + +{ + + signal(SIGTERM, SIG_IGN); + + term++; + +} + + + +tomodes(sp) + +register struct stat *sp; + +{ + + register char *cp; + + + + for (cp = dblock.dummy; cp < &dblock.dummy[TBLOCK]; cp++) + + *cp = '\0'; + + sprintf(dblock.dbuf.mode, "%6o ", sp->st_mode & 07777); + + sprintf(dblock.dbuf.uid, "%6o ", sp->st_uid); + + sprintf(dblock.dbuf.gid, "%6o ", sp->st_gid); + + sprintf(dblock.dbuf.size, "%11lo ", sp->st_size); + + sprintf(dblock.dbuf.mtime, "%11lo ", sp->st_mtime); + +} + + + +checksum() + +{ + + register i; + + register char *cp; + + + + for (cp = dblock.dbuf.chksum; cp < &dblock.dbuf.chksum[sizeof(dblock.dbuf.chksum)]; cp++) + + *cp = ' '; + + i = 0; + + for (cp = dblock.dummy; cp < &dblock.dummy[TBLOCK]; cp++) + + i += *cp; + + return(i); + +} + + + +checkw(c, name) + +char *name; + +{ + + if (wflag) { + + printf("%c ", c); + + if (vflag) + + longt(&stbuf); + + printf("%s: ", name); + + if (response() == 'y'){ + + return(1); + + } + + return(0); + + } + + return(1); + +} + + + +response() + +{ + + char c; + + + + c = getchar(); + + if (c != '\n') + + while (getchar() != '\n'); + + else c = 'n'; + + return(c); + +} + + + +checkupdate(arg) + +char *arg; + +{ + + char name[100]; + + long mtime; + + daddr_t seekp; + + daddr_t lookup(); + + + + rewind(tfile); + + for (;;) { + + if ((seekp = lookup(arg)) < 0) + + return(1); + + fseek(tfile, seekp, 0); + + fscanf(tfile, "%s %lo", name, &mtime); + + if (stbuf.st_mtime > mtime) + + return(1); + + else + + return(0); + + } + +} + + + +done(n) + +{ + + unlink(tname); + + exit(n); + +} + + + +prefix(s1, s2) + +register char *s1, *s2; + +{ + + while (*s1) + + if (*s1++ != *s2++) + + return(0); + + if (*s2) + + return(*s2 == '/'); + + return(1); + +} + + + +getwdir(s) + +char *s; + +{ + + int i; + + int pipdes[2]; + + + + pipe(pipdes); + + if ((i = fork()) == 0) { + + close(1); + + dup(pipdes[1]); + + execl("/bin/pwd", "pwd", 0); + + execl("/usr/bin/pwd", "pwd", 0); + + fprintf(stderr, "pwd failed!\n"); + + printf("/\n"); + + exit(1); + + } + + while (wait((int *)NULL) != -1) + + ; + + read(pipdes[0], s, 50); + + while(*s != '\n') + + s++; + + *s = '\0'; + + close(pipdes[0]); + + close(pipdes[1]); + +} + + + +#define N 200 + +int njab; + +daddr_t + +lookup(s) + +char *s; + +{ + + register i; + + daddr_t a; + + + + for(i=0; s[i]; i++) + + if(s[i] == ' ') + + break; + + a = bsrch(s, i, low, high); + + return(a); + +} + + + +daddr_t + +bsrch(s, n, l, h) + +daddr_t l, h; + +char *s; + +{ + + register i, j; + + char b[N]; + + daddr_t m, m1; + + + + njab = 0; + + + +loop: + + if(l >= h) + + return(-1L); + + m = l + (h-l)/2 - N/2; + + if(m < l) + + m = l; + + fseek(tfile, m, 0); + + fread(b, 1, N, tfile); + + njab++; + + for(i=0; i= h) + + return(-1L); + + m1 = m; + + j = i; + + for(i++; i 0) { + + l = m1; + + goto loop; + + } + + return(m); + +} + + + +cmp(b, s, n) + +char *b, *s; + +{ + + register i; + + + + if(b[0] != '\n') + + exit(2); + + for(i=0; i s[i]) + + return(-1); + + if(b[i+1] < s[i]) + + return(1); + + } + + return(b[i+1] == ' '? 0 : -1); + +} + + + +readtape(buffer) + +char *buffer; + +{ + + int i, j; + + + + if (recno >= nblock || first == 0) { + + if (first == 0 && nblock == 0) + + j = fflag ? NBLOCK : 1; /* orignally, NBLOCK; */ + + else + + j = nblock; + + if ((i = read(mt, tbuf, TBLOCK*j)) < 0) { + + fprintf(stderr, "Tar: tape read error\n"); + + done(3); + + } + + if (first == 0) { + + if ((i % TBLOCK) != 0) { + + fprintf(stderr, "Tar: tape blocksize error\n"); + + done(3); + + } + + i /= TBLOCK; + + if (rflag && i != 1) { + + fprintf(stderr, "Tar: Cannot update blocked tapes (yet)\n"); + + done(4); + + } + + if (i != nblock && (i != 1 || nblock == 0)) { + + fprintf(stderr, "Tar: blocksize = %d\n", i); + + nblock = i; + + } + + } + + recno = 0; + + } + + first = 1; + + copy(buffer, &tbuf[recno++]); + + return(TBLOCK); + +} + + + +writetape(buffer) + +char *buffer; + +{ + + first = 1; + + if (nblock == 0) + + nblock = 1; + + if (recno >= nblock) { + + if (write(mt, tbuf, TBLOCK*nblock) < 0) { + + fprintf(stderr, "Tar: tape write error\n"); + + done(2); + + } + + recno = 0; + + } + + copy(&tbuf[recno++], buffer); + + if (recno >= nblock) { + + if (write(mt, tbuf, TBLOCK*nblock) < 0) { + + fprintf(stderr, "Tar: tape write error\n"); + + done(2); + + } + + recno = 0; + + } + + return(TBLOCK); + +} + + + +backtape() + +{ + + lseek(mt, (long) -TBLOCK, 1); + + if (recno >= nblock) { + + recno = nblock - 1; + + if (read(mt, tbuf, TBLOCK*nblock) < 0) { + + fprintf(stderr, "Tar: tape read error after seek\n"); + + done(4); + + } + + lseek(mt, (long) -TBLOCK, 1); + + } + +} + + + +flushtape() + +{ + + write(mt, tbuf, TBLOCK*nblock); + +} + + + +copy(to, from) + +register char *to, *from; + +{ + + register i; + + + + i = TBLOCK; + + do { + + *to++ = *from++; + + } while (--i); + +} diff --cc usr/src/cmd/tc.c index 0000000000,be2ef07acd,0000000000..ef074fec41 mode 000000,100644,000000..100644 --- a/usr/src/cmd/tc.c +++ b/usr/src/cmd/tc.c @@@@ -1,0 -1,636 -1,0 +1,637 @@@@ +++static char *sccsid = "@(#)tc.c 4.1 (Berkeley) 10/1/80"; + +/* + + * Simulate typesetter on 4014 + +*/ + + + +#include + +#include + + + +#define oput(c) if (pgskip==0) putchar(c); else; + +#define MAXY 3071 + +#define US 037 + +#define GS 035 + +#define ESC 033 + +#define FF 014 + +#define DBL 0200 + + + +int pl = 11*144; + +int mpy = 1; + +int div = 1; + +char *ap; + +int ch; + +int nonumb; + +int psize = 10; + +int dfact = 1; + +int esc; + +int escd; + +int verd; + +int esct; + +int osize = 02; + +int size = 02; + +int rx; + +int xx; + +int yy = MAXY+62+48; + +int leadtot = -31; + +int ohy = -1; + +int ohx = -1; + +int oxb = -1; + +int oly = -1; + +int olx = -1; + +int tflag; + +int railmag; + +int lead; + +int skip; + +int pgskip; + +int ksize = ';'; + +int mcase; + +int stab[] = {010,0,01,07,02,03,04,05,0211,06,0212,0213,0214,0215,0216,0217}; + +int rtab[] = {6, 7, 8, 9, 10, 11, 12, 14, 16, 18, 20, 22, 24, 28, 36, 18}; + +int ktab[] = {';',';',';',';',';',';',':',':','9','9','9','9','8','8','8','9'}; + +int first = 1; + +int alpha; + +extern char *asctab[128]; + +extern char *spectab[128]; + +int erase = 1; + +int (*sigint)(); + +int (*sigquit)(); + + + +main(argc,argv) + +int argc; + +char **argv; + +{ + + register i, j; + + register char *k; + + extern ex(); + + + + while((--argc > 0) && ((++argv)[0][0]=='-')){ + + switch(argv[0][1]){ + + case 'p': + + ap = &argv[0][2]; + + dfact = 72; + + if(i = atoi())pl = i/3; + + continue; + + case 't': + + tflag++; + + continue; + + case 's': + + ap = &argv[0][2]; + + dfact = 1; + + pgskip = atoi(); + + continue; + + default: + + dfact = 1; + + ap = &argv[0][1]; + + if(i = atoi())mpy = i; + + if(i = atoi())div = i; + + continue; + + } + + } + + if(argc){ + + if (freopen(argv[0], "r", stdin) == NULL) { + + fprintf(stderr, "tc: cannot open %s\n", argv[0]); + + exit(1); + + } + + } + + sigint = signal(SIGINT, ex); + + sigquit = signal(SIGQUIT, SIG_IGN); + + while((i = getchar()) != EOF){ + + if(!i)continue; + + if(i & 0200){ + + esc += (~i) & 0177; + + continue; + + } + + if(esc){ + + if(escd)esc = -esc; + + esct += esc; + + xx += (esc*mpy + rx)/div; + + rx = (esc*mpy + rx)%div; + + sendpt(); + + esc = 0; + + } + + switch(i){ + + case 0100: /*init*/ + + escd = verd = mcase = railmag = xx = 0; + + yy = MAXY + 48; + + leadtot = -31; + + ohy = oxb = oly = ohx = olx = -1; + + oput(US); + + fflush(stdout); + + if(!first && !tflag)kwait(); + + if(first){ + + first = 0; + + yy += 62; + + } + + init(); + + continue; + + case 0101: /*lower rail*/ + + railmag &= ~01; + + continue; + + case 0102: /*upper rail*/ + + railmag |= 01; + + continue; + + case 0103: /*upper mag*/ + + railmag |= 02; + + continue; + + case 0104: /*lower mag*/ + + railmag &= ~02; + + continue; + + case 0105: /*lower case*/ + + mcase = 0; + + continue; + + case 0106: /*upper case*/ + + mcase = 0100; + + continue; + + case 0107: /*escape forward*/ + + escd = 0; + + continue; + + case 0110: /*escape backward*/ + + escd = 1; + + continue; + + case 0111: /*stop*/ + + continue; + + case 0112: /*lead forward*/ + + verd = 0; + + continue; + + case 0113: /*undefined*/ + + continue; + + case 0114: /*lead backward*/ + + verd = 1; + + continue; + + case 0115: /*undefined*/ + + case 0116: + + case 0117: + + continue; + + } + + if((i & 0340) == 0140){ /*leading*/ + + lead = (~i) & 037; + + if(verd)lead = -lead; + + if((leadtot += lead) > pl){ + + leadtot = lead; + + oput(US); + + fflush(stdout); + + if(!tflag)kwait(); + + yy = MAXY; + + if(pgskip)--pgskip; + + init(); + + continue; + + } + + if(skip)continue; + + if((yy -= (lead<<1)) < 0){ + + skip++; + + yy = 0; + + }else sendpt(); + + continue; + + } + + if((i & 0360) == 0120){ /*size change*/ + + i &= 017; + + for(j = 0; i != (stab[j] & 017); j++); + + osize = size; + + size = stab[j]; + + psize = rtab[j]; + + ksize = ktab[j]; + + oput(ESC); + + oput(ksize); + + i = 0; + + if(!(osize & DBL) && (size & DBL))i = -55; + + else if((osize & DBL) && !(size & DBL))i = 55; + + if(escd)i = -i; + + esc += i; + + continue; + + } + + if(i & 0300)continue; + + i = (i & 077) | mcase; + + if(railmag != 03)k = asctab[i]; + + else k = spectab[i]; + + if(alpha)sendpt(); + + if(*k!='\0'){ + + oput(US); + + while(*k & 0377)oput(*k++); + + alpha++; + + continue; + + }else{ + + if(railmag != 03){ + + switch(i){ + + case 0124: lig("fi"); break; + + case 0125: lig("fl"); break; + + case 0126: lig("ff"); break; + + case 0130: lig("ffl"); break; + + case 0131: lig("ffi"); break; + + default: continue; + + } + + } + + continue; + + } + + } + + ex(); + +} + +lig(x) + +char *x; + +{ + + register i, j; + + register char *k; + + + + j = 0; + + k = x; + + oput(US); + + oput(*k++); + + i = psize * 8 * mpy / (div * 6); /* 8/36 em */ + + while(*k){ + + xx += i; + + j += i; + + sendpt(); + + oput(US); + + oput(*k++); + + } + + xx -= j; + + sendpt(); + +} + +init(){ + + + + fflush(stdout); + + if(erase){ + + oput(ESC); + + oput(FF); + + }else erase = 1; + + oput(ESC); + + oput(ksize); + + /*delay about a second*/ + +/* let the system do it... + + for(i = 960; i > 0; i--)oput(GS); + +*/ + + skip = 0; + + sendpt(); + +} + +ex(){ + + yy = MAXY; + + xx = 0; + + sendpt(); + + oput(ESC); + + oput(';'); + + oput(US); + + fflush(stdout); + + exit(0); + +} + +kwait(){ + + char buf[128]; char *bptr; char c; + + if(pgskip) return; + +next: + + bptr=buf; + + while((c=readch())&&(c!='\n')) *bptr++=c; + + *bptr=0; + + if(bptr!=buf){ + + bptr = buf; + + if(*bptr == '!'){callunix(&buf[1]); fputs("!\n", stderr); goto next;} + + else switch(*bptr++){ + + case 'e': + + erase = 0; + + goto next; + + case 's': + + ap = &buf[1]; + + dfact = 1; + + pgskip = atoi() + 1; + + goto next; + + default: + + fputs("?\n", stderr); + + goto next; + + } + + } + + else if (c==0) ex(); + + else return; + +} + +callunix(line) + +char line[]; + +{ + + int rc, status, unixpid; + + if( (unixpid=fork())==0 ) { + + signal(SIGINT,sigint); signal(SIGQUIT,sigquit); + + close(0); dup(2); + + execl("/bin/sh", "-sh", "-c", line, 0); + + exit(255); + + } + + else if(unixpid == -1) + + return; + + else{ signal(SIGINT, SIG_IGN); signal(SIGQUIT, SIG_IGN); + + while( (rc = wait(&status)) != unixpid && rc != -1 ) ; + + signal(SIGINT,ex); signal(SIGQUIT,sigquit); + + } + +} + +readch(){ + + char c; + + if (read(2,&c,1)<1) c=0; + + return(c); + +} + +sendpt(){ + + int hy,xb,ly,hx,lx; + + + + oput(GS); + + hy = ((yy>>7) & 037); + + xb = ((xx & 03) + ((yy<<2) & 014) & 017); + + ly = ((yy>>2) & 037); + + hx = ((xx>>7) & 037); + + lx = ((xx>>2) & 037); + + if(hy != ohy)oput(hy | 040); + + if(xb != oxb)oput(xb | 0140); + + if((ly != oly) || (hx != ohx) || (xb != oxb)) + + oput(ly | 0140); + + if(hx != ohx)oput(hx | 040); + + oput(lx | 0100); + + ohy = hy; + + oxb = xb; + + oly = ly; + + ohx = hx; + + olx = lx; + + alpha = 0; + + return; + +} + +atoi() + +{ + + register i, j, acc; + + int field, digits; + + long dd; + + long tscale(); + + + + field = digits = acc = 0; + +a1: + + while(((j = (i = getch()) - '0') >= 0) && (j <= 9)){ + + field++; + + digits++; + + acc = 10*acc + j; + + } + + if(i == '.'){ + + field++; + + digits = 0; + + goto a1; + + } + + if(!(ch = i))ch = 'x'; + + dd = tscale(acc); + + acc = dd; + + if((field != digits) && (digits > 0)){ + + j = 1; + + while(digits--)j *= 10; + + acc = dd/j; + + } + + nonumb = !field; + + ch = 0; + + return(acc); + +} + +long tscale(n) + +int n; + +{ + + register i, j; + + + + switch(i = getch()){ + + case 'u': + + j = 1; + + break; + + case 'p': /*Points*/ + + j = 6; + + break; + + case 'i': /*Inches*/ + + j = 432; + + break; + + case 'c': /*Centimeters; should be 170.0787*/ + + j = 170; + + break; + + case 'P': /*Picas*/ + + j = 72; + + break; + + default: + + j = dfact; + + ch = i; + + } + + return((long)n*j); + +} + +getch(){ + + register i; + + + + if(ch){ + + i = ch; + + ch = 0; + + return(i); + + } + + return(*ap++); + +} + + + +char *asctab[128] = { + +"\0", /*blank*/ + +"h", /*h*/ + +"t", /*t*/ + +"n", /*n*/ + +"m", /*m*/ + +"l", /*l*/ + +"i", /*i*/ + +"z", /*z*/ + +"s", /*s*/ + +"d", /*d*/ + +"b", /*b*/ + +"x", /*x*/ + +"f", /*f*/ + +"j", /*j*/ + +"u", /*u*/ + +"k", /*k*/ + +"\0", /*blank*/ + +"p", /*p*/ + +"-", /*_ 3/4 em dash*/ + +";", /*;*/ + +"\0", /*blank*/ + +"a", /*a*/ + +"_", /*rule*/ + +"c", /*c*/ + +"`", /*` open*/ + +"e", /*e*/ + +"\'", /*' close*/ + +"o", /*o*/ + +"\0", /*1/4*/ + +"r", /*r*/ + +"\0", /*1/2*/ + +"v", /*v*/ + +"-", /*- hyphen*/ + +"w", /*w*/ + +"q", /*q*/ + +"/", /*/*/ + +".", /*.*/ + +"g", /*g*/ + +"\0", /*3/4*/ + +",", /*,*/ + +"&", /*&*/ + +"y", /*y*/ + +"\0", /*blank*/ + +"%", /*%*/ + +"\0", /*blank*/ + +"Q", /*Q*/ + +"T", /*T*/ + +"O", /*O*/ + +"H", /*H*/ + +"N", /*N*/ + +"M", /*M*/ + +"L", /*L*/ + +"R", /*R*/ + +"G", /*G*/ + +"I", /*I*/ + +"P", /*P*/ + +"C", /*C*/ + +"V", /*V*/ + +"E", /*E*/ + +"Z", /*Z*/ + +"D", /*D*/ + +"B", /*B*/ + +"S", /*S*/ + +"Y", /*Y*/ + +"\0", /*blank*/ + +"F", /*F*/ + +"X", /*X*/ + +"A", /*A*/ + +"W", /*W*/ + +"J", /*J*/ + +"U", /*U*/ + +"K", /*K*/ + +"0", /*0*/ + +"1", /*1*/ + +"2", /*2*/ + +"3", /*3*/ + +"4", /*4*/ + +"5", /*5*/ + +"6", /*6*/ + +"7", /*7*/ + +"8", /*8*/ + +"9", /*9*/ + +"*", /***/ + +"-", /*minus*/ + +"", /*fi*/ + +"", /*fl*/ + +"", /*ff*/ + +"\033\016Z\bM\033\017", /*cent sign*/ + +"", /*ffl*/ + +"", /*ffi*/ + +"(", /*(*/ + +")", /*)*/ + +"[", /*[*/ + +"]", /*]*/ + +"\033\016J\033\017", /*degree*/ + +"\033\016M\b_\033\017", /*dagger*/ + +"=", /*=*/ + +"\033\016O\b&\033\017", /*registered*/ + +":", /*:*/ + +"+", /*+*/ + +"\0", /*blank*/ + +"!", /*!*/ + +"\033\016O\b~\033\017", /*bullet*/ + +"?", /*?*/ + +"\'", /*foot mark*/ + +"|", /*|*/ + +"\0", /*blank*/ + +"\033\016O\b#\033\017", /*copyright*/ + +"\033\016L\033\017", /*square*/ + +"$" }; /*$*/ + + + +char *spectab[128] = { + +"\0", /*blank*/ + +"\033\016(\bM\033\017", /*psi*/ + +"\033\016o\b_\033\017", /*theta*/ + +"v\b)", /*nu*/ + +"\033\016V\b,\033\017", /*mu*/ + +"\033\016)\b?\033\017", /*lambda*/ + +"\033\016I\033\017", /*iota*/ + +"S\b\033\016Z\033\017", /*zeta*/ + +"o\b\'", /*sigma*/ + +"o\b\033\0165\033\017", /*delta*/ + +"\033\016b\033\017", /*beta*/ + +"\033\016e\bc\033\017", /*xi*/ + +"j\b\033\016C\033\017", /*eta*/ + +"\033\016O\bM\033\017", /*phi*/ + +"\033\016(\033\017", /*upsilon*/ + +"\033\016k\033\017", /*kappa*/ + +"\0", /*blank*/ + +"T\b\033\016S\033\017", /*pi*/ + +"@", /*at-sign*/ + +"\033\016U\033\017", /*down arrow*/ + +"\0", /*blank*/ + +"\033\016A\033\017", /*alpha*/ + +"|", /*or*/ + +"l\b/", /*chi*/ + +"\"", /*"*/ + +"\033\016E\033\017", /*epsilon*/ + +"=", /*=*/ + +"\033\016O\033\017", /*omicron*/ + +"\033\016[\033\017", /*left arrow*/ + +"\033\016R\033\017", /*rho*/ + +"\033\016Y\033\017", /*up arrow*/ + +"\033\016N\033\017", /*tau*/ + +"_", /*underrule*/ + +"\\", /*\*/ + +"I\b\033\016(\033\017", /*Psi*/ + +"\033\016O\bJ\033\017", /*bell system sign*/ + +"\033\016W\bX\033\017", /*infinity*/ + +"`\b/", /*gamma*/ + +"\033\016X\bF\033\017", /*improper superset*/ + +"\033\016A\033\017", /*proportional to*/ + +"\033\016\\\b]\033\017", /*right hand*/ + +"\033\016W\033\017", /*omega*/ + +"\0", /*blank*/ + +"\033\016G\033\017", /*gradient*/ + +"\0", /*blank*/ + +"I\033\016\bO\033\017", /*Phi*/ + +"O\b=", /*Theta*/ + +"O\b_", /*Omega*/ + +"\033\016V\033\017", /*cup (union)*/ + +"\033\016@\033\017", /*root en*/ + +"s", /*terminal sigma*/ + +"\033\016)\bK\033\017", /*Lambda*/ + +"-", /*minus*/ + +"\033\016S\bK\033\017", /*Gamma*/ + +"\033\016i\033\017", /*integral sign*/ + +"\033\016t\b'\033\017", /*Pi*/ + +"\033\016Z\033\017", /*subset of*/ + +"\033\016X\033\017", /*superset of*/ + +"\033\016T\033\017", /*approximates*/ + +"o\b`", /*partial derivative*/ + +"\033\016H\033\017", /*Delta*/ + +"\033\016I\b'\033\017", /*square root*/ + +">\b\033\016F\b@\033\017", /*Sigma*/ + +"\033\016T\bF\033\017", /*approx =*/ + +"\0", /*blank*/ + +">", /*>*/ + +"\033\016_\bF\b@\033\017", /*Xi*/ + +"<", /*<*/ + +"/", /*slash (longer)*/ + +"\033\016C\033\017", /*cap (intersection)*/ + +"\033\016y\033\017", /*Upsilon*/ + +"\033\016|\033\017", /*not*/ + +"|", /*right ceiling (rt of ")*/ + +"|", /*left top (of big curly)*/ + +"|", /*bold vertical*/ + +"|", /*left center of big curly bracket*/ + +"|", /*left bottom*/ + +"|", /*right top*/ + +"|", /*right center of big curly bracket*/ + +"|", /*right bot*/ + +"|", /*right floor (rb of ")*/ + +"|", /*left floor (left bot of big sq bract)*/ + +"|", /*left ceiling (lt of ")*/ + +"\033\016=\033\017", /*multiply*/ + +"\033\016+\033\017", /*divide*/ + +"+\b_", /*plus-minus*/ + +"\033\016$\033\017", /*<=*/ + +"\033\016^\033\017", /*>=*/ + +"=\b_", /*identically equal*/ + +"\033\016*\033\017", /*not equal*/ + +"{", /*{*/ + +"}", /*}*/ + +"\'", /*' acute accent*/ + +"`", /*` grave accent*/ + +"^", /*^*/ + +"#", /*sharp*/ + +"\033\016|\b[\033\017", /*left hand*/ + +"\033\016c\b_\033\017", /*member of*/ + +"~", /*~*/ + +"\033\016O\b/\033\017", /*empty set*/ + +"\0", /*blank*/ + +"\033\016%\bM\033\017", /*dbl dagger*/ + +"|", /*box rule*/ + +"*", /*asterisk*/ + +"\033\016Z\bF\033\017", /*improper subset*/ + +"\033\016O\033\017", /*circle*/ + +"\0", /*blank*/ + +"+", /*eqn plus*/ + +"\033\016]\033\017", /*right arrow*/ + +"g\b\033\016C\033\017" }; /*section mark*/ diff --cc usr/src/cmd/tee.c index 0000000000,023d135041,0000000000..834e755828 mode 000000,100644,000000..100644 --- a/usr/src/cmd/tee.c +++ b/usr/src/cmd/tee.c @@@@ -1,0 -1,98 -1,0 +1,99 @@@@ +++static char *sccsid = "@(#)tee.c 4.1 (Berkeley) 10/1/80"; + +/* + + * tee-- pipe fitting + + */ + + + +#include + +#include + +#include + +#include + +#include + + + +#define BUFSIZ BSIZE + +int openf[20] = { 1 }; + +int n = 1; + +int t = 0; + +int aflag; + + + +char in[BUFSIZ]; + + + +char out[BUFSIZ]; + + + +extern errno; + +long lseek(); + + + +main(argc,argv) + +char **argv; + +{ + + int register r,w,p; + + struct stat buf; + + while(argc>1&&argv[1][0]=='-') { + + switch(argv[1][1]) { + + case 'a': + + aflag++; + + break; + + case 'i': + + case 0: + + signal(SIGINT, SIG_IGN); + + } + + argv++; + + argc--; + + } + + fstat(1,&buf); + + t = (buf.st_mode&S_IFMT)==S_IFCHR; + + if(lseek(1,0L,1)==-1&&errno==ESPIPE) + + t++; + + while(argc-->1) { + + if(aflag) { + + openf[n] = open(argv[1],1); + + if(openf[n] < 0) + + openf[n] = creat(argv[1],0666); + + lseek(openf[n++],0L,2); + + } else + + openf[n++] = creat(argv[1],0666); + + if(stat(argv[1],&buf)>=0) { + + if((buf.st_mode&S_IFMT)==S_IFCHR) + + t++; + + } else { + + puts("tee: cannot open "); + + puts(argv[1]); + + puts("\n"); + + n--; + + } + + argv++; + + } + + r = w = 0; + + for(;;) { + + for(p=0;p=w) { + + if(t>0&&p>0) break; + + w = read(0,in,BUFSIZ); + + r = 0; + + if(w<=0) { + + stash(p); + + return; + + } + + } + + out[p++] = in[r++]; + + } + + stash(p); + + } + +} + + + +stash(p) + +{ + + int k; + + int i; + + int d; + + d = t ? 16 : p; + + for(i=0; i + +#include + +#include + +#define EQ(a,b) ((tmp=a)==0?0:(strcmp(tmp,b)==0)) + + + +#define DIR 1 + +#define FIL 2 + +int ap; + +int ac; + +char **av; + +char *tmp; + + + +main(argc, argv) + +char *argv[]; + +{ + + + + ac = argc; av = argv; ap = 1; + + if(EQ(argv[0],"[")) { + + if(!EQ(argv[--ac],"]")) + + synbad("] missing",""); + + } + + argv[ac] = 0; + + if (ac<=1) exit(1); + + exit(exp()?0:1); + +} + + + +char *nxtarg(mt) { + + + + if (ap>=ac) { + + if(mt) { + + ap++; + + return(0); + + } + + synbad("argument expected",""); + + } + + return(av[ap++]); + +} + + + +exp() { + + int p1; + + + + p1 = e1(); + + if (EQ(nxtarg(1), "-o")) return(p1 | exp()); + + ap--; + + return(p1); + +} + + + +e1() { + + int p1; + + + + p1 = e2(); + + if (EQ(nxtarg(1), "-a")) return (p1 & e1()); + + ap--; + + return(p1); + +} + + + +e2() { + + if (EQ(nxtarg(0), "!")) + + return(!e3()); + + ap--; + + return(e3()); + +} + + + +e3() { + + int p1; + + register char *a; + + char *p2; + + int int1, int2; + + + + a=nxtarg(0); + + if(EQ(a, "(")) { + + p1 = exp(); + + if(!EQ(nxtarg(0), ")")) synbad(") expected",""); + + return(p1); + + } + + + + if(EQ(a, "-r")) + + return(tio(nxtarg(0), 0)); + + + + if(EQ(a, "-w")) + + return(tio(nxtarg(0), 1)); + + + + if(EQ(a, "-d")) + + return(ftype(nxtarg(0))==DIR); + + + + if(EQ(a, "-f")) + + return(ftype(nxtarg(0))==FIL); + + + + if(EQ(a, "-s")) + + return(fsizep(nxtarg(0))); + + + + if(EQ(a, "-t")) + + if(ap>=ac) + + return(isatty(1)); + + else + + return(isatty(atoi(nxtarg(0)))); + + + + if(EQ(a, "-n")) + + return(!EQ(nxtarg(0), "")); + + if(EQ(a, "-z")) + + return(EQ(nxtarg(0), "")); + + + + p2 = nxtarg(1); + + if (p2==0) + + return(!EQ(a,"")); + + if(EQ(p2, "=")) + + return(EQ(nxtarg(0), a)); + + + + if(EQ(p2, "!=")) + + return(!EQ(nxtarg(0), a)); + + + + if(EQ(a, "-l")) { + + int1=length(p2); + + p2=nxtarg(0); + + } else{ int1=atoi(a); + + } + + int2 = atoi(nxtarg(0)); + + if(EQ(p2, "-eq")) + + return(int1==int2); + + if(EQ(p2, "-ne")) + + return(int1!=int2); + + if(EQ(p2, "-gt")) + + return(int1>int2); + + if(EQ(p2, "-lt")) + + return(int1=int2); + + if(EQ(p2, "-le")) + + return(int1<=int2); + + + + synbad("unknown operator ",p2); + +} + + + +tio(a, f) + +char *a; + +int f; + +{ + + + + f = open(a, f); + + if (f>=0) { + + close(f); + + return(1); + + } + + return(0); + +} + + + +ftype(f) + +char *f; + +{ + + struct stat statb; + + + + if(stat(f,&statb)<0) + + return(0); + + if((statb.st_mode&S_IFMT)==S_IFDIR) + + return(DIR); + + return(FIL); + +} + + + +fsizep(f) + +char *f; + +{ + + struct stat statb; + + if(stat(f,&statb)<0) + + return(0); + + return(statb.st_size>0); + +} + + + +synbad(s1,s2) + +char *s1, *s2; + +{ + + write(2, "test: ", 6); + + write(2, s1, strlen(s1)); + + write(2, s2, strlen(s2)); + + write(2, "\n", 1); + + exit(255); + +} + + + +length(s) + + char *s; + +{ + + char *es=s; + + while(*es++); + + return(es-s-1); + +} diff --cc usr/src/cmd/time.c index 0000000000,5c63d666e4,0000000000..0b03e011e7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/time.c +++ b/usr/src/cmd/time.c @@@@ -1,0 -1,78 -1,0 +1,80 @@@@ +++static char *sccsid = "@(#)time.c 4.2 (Berkeley) 10/9/80"; + +/* time command */ + + + +#include + +#include + +#include + +#include + + + +extern int errno; + +extern char *sys_errlist[]; + + + +main(argc, argv) + +char **argv; + +{ + + struct tms buffer, obuffer; + + int status; + + register p; + + time_t before, after; + + + + if(argc<=1) + + exit(0); + + time(&before); + + p = fork(); + + if(p == -1) { + + fprintf(stderr, "Try again.\n"); + + exit(1); + + } + + if(p == 0) { + + execvp(argv[1], &argv[1]); + + fprintf(stderr, "%s: %s\n", argv[1], sys_errlist[errno]); + + exit(1); + + } + + signal(SIGINT, SIG_IGN); + + signal(SIGQUIT, SIG_IGN); + + times(&obuffer); + + while(wait(&status) != p) + + times(&obuffer); + + time(&after); + + if((status&0377) != 0) + + fprintf(stderr,"Command terminated abnormally.\n"); + + times(&buffer); - fprintf(stderr,"\n"); + + printt("real", (after-before) * 60); + + printt("user", buffer.tms_cutime - obuffer.tms_cutime); + + printt("sys ", buffer.tms_cstime - obuffer.tms_cstime); +++ fprintf(stderr, "\n"); + + exit(status>>8); + +} + + + +char quant[] = { 6, 10, 10, 6, 10, 6, 10, 10, 10 }; + +char *pad = "000 "; + +char *sep = "\0\0.\0:\0:\0\0"; + +char *nsep = "\0\0.\0 \0 \0\0"; + + + +printt(s, a) + +char *s; + +long a; + +{ + + char digit[9]; + + register i; + + char c; + + int nonzero; + + + + for(i=0; i<9; i++) { + + digit[i] = a % quant[i]; + + a /= quant[i]; + + } - fprintf(stderr,s); + + nonzero = 0; + + while(--i>0) { + + c = digit[i]!=0 ? digit[i]+'0': + + nonzero ? '0': + + pad[i]; +++ if (c) + + fprintf(stderr,"%c",c); + + nonzero |= digit[i]; + + c = nonzero?sep[i]:nsep[i]; +++ if (c) + + fprintf(stderr,"%c",c); + + } - fprintf(stderr,"\n"); +++ fprintf(stderr," %s ",s); + +} diff --cc usr/src/cmd/tk.c index 0000000000,715b6a01db,0000000000..9188c7d836 mode 000000,100644,000000..100644 --- a/usr/src/cmd/tk.c +++ b/usr/src/cmd/tk.c @@@@ -1,0 -1,248 -1,0 +1,249 @@@@ +++static char *sccsid = "@(#)tk.c 4.1 (Berkeley) 10/1/80"; + +/* + + * optimize output for Tek 4014 + + */ + + + +#include + +#include + + + +#define MAXY 3071 + +#define LINE 47 + +#define XOFF 248 + +#define US 037 + +#define GS 035 + +#define ESC 033 + +#define CR 015 + +#define FF 014 + +#define SO 016 + +#define SI 017 + + + +int pl = 66*LINE; + +int yyll = -1; + +char obuf[BUFSIZ]; + +int xx = XOFF; + +int xoff = XOFF; + +int coff = 0; + +int ncol = 0; + +int maxcol = 1; + +int yy = MAXY; + +int ohy = -1; + +int ohx = -1; + +int oxb = -1; + +int oly = -1; + +int olx = -1; + +int alpha; + +int ry; + +FILE *ttyin; + + + +main(argc, argv) + +int argc; + +char **argv; + +{ + + register i, j; + + extern ex(); + + + + while (--argc > 0 && (++argv)[0][0]=='-') + + switch(argv[0][1]) { + + case 'p': + + if (i = atoi(&argv[0][2])) + + pl = i; + + yyll = MAXY + 1 - pl; + + break; + + default: + + if (i = atoi(&argv[0][1])) { + + maxcol = i; + + xx = xoff = 0; + + coff = 4096/i; + + } + + break; + + } + + if ((ttyin = fopen("/dev/tty", "r")) != NULL) + + setbuf(ttyin, (char *)NULL); + + if (argc) { + + if (freopen(argv[0], "r", stdin) == NULL) { + + fprintf(stderr, "tk: cannot open %s\n", argv[0]); + + exit(1); + + } + + } + + signal(SIGINT, ex); + + setbuf(stdout, obuf); + + ncol = maxcol; + + init(); + + while ((i = getchar()) != EOF) { + + switch(i) { + + + + case FF: + + yy = 0; + + case '\n': + + xx = xoff; + + yy -= LINE; + + alpha = 0; + + if (yy < yyll) { + + ncol++; + + yy = 0; + + sendpt(0); + + putchar(US); + + fflush(stdout); + + if (ncol >= maxcol) + + kwait(); + + init(); + + } + + continue; + + + + case CR: + + xx = xoff; + + alpha = 0; + + continue; + + + + case ' ': + + xx += 31; + + alpha = 0; + + continue; + + + + case '\t': /*tabstops at 8*31=248*/ + + j = ((xx-xoff)/248) + 1; + + xx += j*248 - (xx-xoff); + + alpha = 0; + + continue; + + + + case '\b': + + xx -= 31; + + alpha = 0; + + continue; + + + + case ESC: + + switch(i = getchar()) { + + case '7': + + yy += LINE; + + alpha = 0; + + continue; + + case '8': + + yy += (LINE + ry)/2; + + ry = (LINE + ry)%2; + + alpha = 0; + + continue; + + case '9': + + yy -= (LINE - ry)/2; + + ry = -(LINE - ry)%2; + + alpha = 0; + + continue; + + default: + + continue; + + } + + + + default: + + sendpt(alpha); + + if (alpha==0) { + + putchar(US); + + alpha = 1; + + } + + putchar(i); + + if (i>' ') + + xx += 31; + + continue; + + } + + } + + xx = xoff; + + yy = 0; + + sendpt(0); + + putchar(US); + + kwait(); + + ex(); + +} + + + +init() + +{ + + ohx = oxb = olx = ohy = oly = -1; + + if (ncol >= maxcol) { + + ncol = 0; + + if (maxcol > 1) + + xoff = 0; + + else + + xoff = XOFF; + + } else + + xoff += coff; + + xx = xoff; + + yy = MAXY; + + if (ncol==0) + + fputs("\033\014\033;", stdout); + + sendpt(0); + +} + + + +ex() + +{ + + yy = MAXY; + + xx = 0; + + fputs("\033;\037", stdout); + + sendpt(1); + + exit(0); + +} + + + +kwait() + +{ + + register c; + + + + fflush(stdout); + + if (ttyin==NULL) + + return; + + while ((c=getc(ttyin))!='\n') { + + if (c=='!') { + + execom(); + + printf("!\n"); + + fflush(stdout); + + continue; + + } + + if (c==EOF) + + ex(); + + } + +} + + + +execom() + +{ + + int (*si)(), (*sq)(); + + + + if (fork() != 0) { + + si = signal(SIGINT, SIG_IGN); + + sq = signal(SIGQUIT, SIG_IGN); + + wait((int *)NULL); + + signal(SIGINT, si); + + signal(SIGQUIT, sq); + + return; + + } + + if (isatty(fileno(stdin)) == 0) { + + if (freopen("/dev/tty", "r", stdin)==NULL) + + freopen("/dev/null", "r", stdin); + + } + + execl("/bin/sh", "sh", "-t", 0); + +} + + + +sendpt(a) + +{ + + register zz; + + int hy,xb,ly,hx,lx; + + + + if (a) + + return; + + if ((zz = yy) < 0) + + zz = 0; + + hy = ((zz>>7) & 037); + + xb = ((xx & 03) + ((zz<<2) & 014) & 017); + + ly = ((zz>>2) & 037); + + hx = ((xx>>7) & 037); + + lx = ((xx>>2) & 037); + + putchar(GS); + + if (hy != ohy) + + putchar(hy | 040); + + if (xb != oxb) + + putchar(xb | 0140); + + if ((ly != oly) || (hx != ohx) || (xb != oxb)) + + putchar(ly | 0140); + + if (hx != ohx) + + putchar(hx | 040); + + putchar(lx | 0100); + + ohy = hy; + + oxb = xb; + + oly = ly; + + ohx = hx; + + olx = lx; + + alpha = 0; + +} diff --cc usr/src/cmd/touch.c index 0000000000,33bcc501cb,0000000000..59555eb78f mode 000000,100644,000000..100644 --- a/usr/src/cmd/touch.c +++ b/usr/src/cmd/touch.c @@@@ -1,0 -1,70 -1,0 +1,71 @@@@ +++static char *sccsid = "@(#)touch.c 4.1 (Berkeley) 10/1/80"; + +#include + + + + + +main(argc,argv) + +int argc; + +char *argv[]; + +{ + +int i; + +static int force = 1; + + + +for(i = 1 ; i < argc ; ++i) + + if( strcmp(argv[i], "-c") ) + + touch(force, argv[i]); + + else + + force = 0; + +} + + + + + + + + + +#include + +#include + + + + + +touch(force, name) + +int force; + +char *name; + +{ + +struct stat stbuff; + +char junk[1]; + +int fd; + + + +if( stat(name,&stbuff) < 0) + + if(force) + + goto create; + + else + + { + + fprintf(stderr, "touch: file %s does not exist.\n", name); + + return; + + } + + + +if(stbuff.st_size == 0) + + goto create; + + + +if( (fd = open(name, 2)) < 0) + + goto bad; + + + +if( read(fd, junk, 1) < 1) + + { + + close(fd); + + goto bad; + + } + +lseek(fd, 0L, 0); + +if( write(fd, junk, 1) < 1 ) + + { + + close(fd); + + goto bad; + + } + +close(fd); + +return; + + + +bad: + + fprintf(stderr, "Cannot touch %s\n", name); + + return; + + + +create: + + if( (fd = creat(name, 0666)) < 0) + + goto bad; + + close(fd); + +} diff --cc usr/src/cmd/tr.c index 0000000000,01395ba2da,0000000000..894c27d423 mode 000000,100644,000000..100644 --- a/usr/src/cmd/tr.c +++ b/usr/src/cmd/tr.c @@@@ -1,0 -1,132 -1,0 +1,133 @@@@ +++static char *sccsid = "@(#)tr.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +/* tr - transliterate data stream */ + +int dflag = 0; + +int sflag = 0; + +int cflag = 0; + +int save = 0; + +char code[256]; + +char squeez[256]; + +char vect[256]; + +struct string { int last, max; char *p; } string1, string2; + + + +main(argc,argv) + +char **argv; + +{ + + register i; + + int j; + + register c, d; + + char *compl; + + int lastd; + + + + string1.last = string2.last = 0; + + string1.max = string2.max = 0; + + string1.p = string2.p = ""; + + + + if(--argc>0) { + + argv++; + + if(*argv[0]=='-'&&argv[0][1]!=0) { + + while(*++argv[0]) + + switch(*argv[0]) { + + case 'c': + + cflag++; + + continue; + + case 'd': + + dflag++; + + continue; + + case 's': + + sflag++; + + continue; + + } + + argc--; + + argv++; + + } + + } + + if(argc>0) string1.p = argv[0]; + + if(argc>1) string2.p = argv[1]; + + for(i=0; i<256; i++) + + code[i] = vect[i] = 0; + + if(cflag) { + + while(c = next(&string1)) + + vect[c&0377] = 1; + + j = 0; + + for(i=1; i<256; i++) + + if(vect[i]==0) vect[j++] = i; + + vect[j] = 0; + + compl = vect; + + } + + for(i=0; i<256; i++) + + squeez[i] = 0; + + lastd = 0; + + for(;;){ + + if(cflag) c = *compl++; + + else c = next(&string1); + + if(c==0) break; + + d = next(&string2); + + if(d==0) d = lastd; + + else lastd = d; + + squeez[d&0377] = 1; + + code[c&0377] = dflag?1:d; + + } + + while(d = next(&string2)) + + squeez[d&0377] = 1; + + squeez[0] = 1; + + for(i=0;i<256;i++) { + + if(code[i]==0) code[i] = i; + + else if(dflag) code[i] = 0; + + } + + + + while((c=getc(stdin)) != EOF ) { + + if(c == 0) continue; + + if(c = code[c&0377]&0377) + + if(!sflag || c!=save || !squeez[c&0377]) + + putchar(save = c); + + } + + exit(0); + +} + + + +next(s) + +struct string *s; + +{ + + + +again: + + if(s->max) { + + if(s->last++ < s->max) + + return(s->last); + + s->max = s->last = 0; + + } + + if(s->last && *s->p=='-') { + + nextc(s); + + s->max = nextc(s); + + if(s->max==0) { + + s->p--; + + return('-'); + + } + + if(s->max < s->last) { + + s->last = s->max-1; + + return('-'); + + } + + goto again; + + } + + return(s->last = nextc(s)); + +} + + + +nextc(s) + +struct string *s; + +{ + + register c, i, n; + + + + c = *s->p++; + + if(c=='\\') { + + i = n = 0; + + while(i<3 && (c = *s->p)>='0' && c<='7') { + + n = n*8 + c - '0'; + + i++; + + s->p++; + + } + + if(i>0) c = n; + + else c = *s->p++; + + } + + if(c==0) *--s->p = 0; + + return(c&0377); + +} diff --cc usr/src/cmd/tsort.c index 0000000000,d876a5e66f,0000000000..7802f1e2ca mode 000000,100644,000000..100644 --- a/usr/src/cmd/tsort.c +++ b/usr/src/cmd/tsort.c @@@@ -1,0 -1,205 -1,0 +1,206 @@@@ +++static char *sccsid = "@(#)tsort.c 4.1 (Berkeley) 10/1/80"; + +/* topological sort + + * input is sequence of pairs of items (blank-free strings) + + * nonidentical pair is a directed edge in graph + + * identical pair merely indicates presence of node + + * output is ordered list of items consistent with + + * the partial ordering specified by the graph + +*/ + +#include "stdio.h" + + + +/* the nodelist always has an empty element at the end to + + * make it easy to grow in natural order + + * states of the "live" field:*/ + +#define DEAD 0 /* already printed*/ + +#define LIVE 1 /* not yet printed*/ + +#define VISITED 2 /*used only in findloop()*/ + + + +struct nodelist { + + struct nodelist *nextnode; + + struct predlist *inedges; + + char *name; + + int live; + +} firstnode = {NULL, NULL, NULL, DEAD}; + + + +/* a predecessor list tells all the immediate + + * predecessors of a given node + +*/ + +struct predlist { + + struct predlist *nextpred; + + struct nodelist *pred; + +}; + + + +struct nodelist *index(); + +struct nodelist *findloop(); + +struct nodelist *mark(); + +char *malloc(); + +char *empty = ""; + + + +/* the first for loop reads in the graph, + + * the second prints out the ordering + +*/ + +main(argc,argv) + +char **argv; + +{ + + register struct predlist *t; + + FILE *input = stdin; + + register struct nodelist *i, *j; + + int x; + + char precedes[50], follows[50]; + + if(argc>1) { + + input = fopen(argv[1],"r"); + + if(input==NULL) + + error("cannot open ", argv[1]); + + } + + for(;;) { + + x = fscanf(input,"%s%s",precedes, follows); + + if(x==EOF) + + break; + + if(x!=2) + + error("odd data",empty); + + i = index(precedes); + + j = index(follows); + + if(i==j||present(i,j)) + + continue; + + t = (struct predlist *)malloc(sizeof(struct predlist)); + + t->nextpred = j->inedges; + + t->pred = i; + + j->inedges = t; + + } + + for(;;) { + + x = 0; /*anything LIVE on this sweep?*/ + + for(i= &firstnode; i->nextnode!=NULL; i=i->nextnode) { + + if(i->live==LIVE) { + + x = 1; + + if(!anypred(i)) + + break; + + } + + } + + if(x==0) + + break; + + if(i->nextnode==NULL) + + i = findloop(); + + printf("%s\n",i->name); + + i->live = DEAD; + + } + +} + + + +/* is i present on j's predecessor list? + +*/ + +present(i,j) + +struct nodelist *i, *j; + +{ + + register struct predlist *t; + + for(t=j->inedges; t!=NULL; t=t->nextpred) + + if(t->pred==i) + + return(1); + + return(0); + +} + + + +/* is there any live predecessor for i? + +*/ + +anypred(i) + +struct nodelist *i; + +{ + + register struct predlist *t; + + for(t=i->inedges; t!=NULL; t=t->nextpred) + + if(t->pred->live==LIVE) + + return(1); + + return(0); + +} + + + +/* turn a string into a node pointer + +*/ + +struct nodelist * + +index(s) + +register char *s; + +{ + + register struct nodelist *i; + + register char *t; + + for(i= &firstnode; i->nextnode!=NULL; i=i->nextnode) + + if(cmp(s,i->name)) + + return(i); + + for(t=s; *t; t++) ; + + t = malloc((unsigned)(t+1-s)); + + i->nextnode = (struct nodelist *)malloc(sizeof(struct nodelist)); + + if(i->nextnode==NULL||t==NULL) + + error("too many items",empty); + + i->name = t; + + i->live = LIVE; + + i->nextnode->nextnode = NULL; + + i->nextnode->inedges = NULL; + + i->nextnode->live = DEAD; + + while(*t++ = *s++); + + return(i); + +} + + + +cmp(s,t) + +register char *s, *t; + +{ + + while(*s==*t) { + + if(*s==0) + + return(1); + + s++; + + t++; + + } + + return(0); + +} + + + +error(s,t) + +char *s, *t; + +{ + + note(s,t); + + exit(1); + +} + + + +note(s,t) + +char *s,*t; + +{ + + fprintf(stderr,"tsort: %s%s\n",s,t); + +} + + + +/* given that there is a cycle, find some + + * node in it + +*/ + +struct nodelist * + +findloop() + +{ + + register struct nodelist *i, *j; + + for(i= &firstnode; i->nextnode!=NULL; i=i->nextnode) + + if(i->live==LIVE) + + break; + + note("cycle in data",empty); + + i = mark(i); + + if(i==NULL) + + error("program error",empty); + + for(j= &firstnode; j->nextnode!=NULL; j=j->nextnode) + + if(j->live==VISITED) + + j->live = LIVE; + + return(i); + +} + + + +/* depth-first search of LIVE predecessors + + * to find some element of a cycle; + + * VISITED is a temporary state recording the + + * visits of the search + +*/ + +struct nodelist * + +mark(i) + +register struct nodelist *i; + +{ + + register struct nodelist *j; + + register struct predlist *t; + + if(i->live==DEAD) + + return(NULL); + + if(i->live==VISITED) + + return(i); + + i->live = VISITED; + + for(t=i->inedges; t!=NULL; t=t->nextpred) { + + j = mark(t->pred); + + if(j!=NULL) { + + note(i->name,empty); + + return(j); + + } + + } + + return(NULL); + +} diff --cc usr/src/cmd/tty.c index 0000000000,cedc61a47b,0000000000..9f2b30d0c8 mode 000000,100644,000000..100644 --- a/usr/src/cmd/tty.c +++ b/usr/src/cmd/tty.c @@@@ -1,0 -1,18 -1,0 +1,19 @@@@ +++static char *sccsid = "@(#)tty.c 4.1 (Berkeley) 10/1/80"; + +/* + + * Type tty name + + */ + + + +char *ttyname(); + + + +main(argc, argv) + +char **argv; + +{ + + register char *p; + + + + p = ttyname(0); + + if(argc==2 && !strcmp(argv[1], "-s")) + + ; + + else + + printf("%s\n", (p? p: "not a tty")); + + exit(p? 0: 1); + +} diff --cc usr/src/cmd/ul.c index 0000000000,f3469e0ce3,0000000000..9db187478e mode 000000,100644,000000..100644 --- a/usr/src/cmd/ul.c +++ b/usr/src/cmd/ul.c @@@@ -1,0 -1,145 -1,0 +1,286 @@@@ +++static char *sccsid = "@(#)ul.c 4.1 (Berkeley) 10/1/80"; + +/* - * - * ul - General underline filter. Converts underlines by - * the standard backspacing method to the code used by the - * particular terminal to underline. - * +++ * ul + + */ + +#include - char buf[BUFSIZ]; - char isul[BUFSIZ]; - char termcap[1024]; - char ulbuf[BUFSIZ]; - char *stul, *endul, *chul; - char *backspace; - char *termtype; - int outc(); - char *tgetstr(); - char *getenv(); - - main(argc,argv) char **argv; { +++ +++char buf[BUFSIZ]; +++char isul[BUFSIZ]; +++char termcap[1024]; +++char ulbuf[BUFSIZ]; +++char *stul, *endul, *chul; +++char *backspace; +++char *termtype; +++int outc(); +++char *tgetstr(); +++char *getenv(); +++ +++main(argc, argv) +++ int argc; +++ char **argv; +++{ + + register int i; + + char *cp; + + FILE *f; + + - /* Figure out kind of terminal and set up special strings. */ +++ argc--, argv++; + + termtype = getenv("TERM"); + + if (termtype == NULL) + + termtype = "dumb"; - while (argc >= 2 && argv[1][0] == '-') { - switch(argv[1][1]) { +++ while (argc > 0 && argv[0][0] == '-') { +++ switch(argv[0][1]) { +++ + + case 't': + + case 'T': /* for nroff compatibility */ - if (argv[1][2]) - termtype = &argv[1][2]; +++ if (argv[0][2]) +++ termtype = &argv[0][2]; + + else { - termtype = argv[2]; +++ termtype = argv[1]; + + argc--; + + argv++; + + } + + break; +++ case 'i': +++ argc--, argv++; +++ iul(argc, argv); +++ exit(0); +++ + + default: - printf("Bad switch: %s\n",argv[1]); +++ printf("Usage: ul [ -i ] [ -tTerm ] file...\n"); + + exit(1); + + } + + } + + switch(tgetent(termcap, termtype)) { - case 1: /* All is well */ - /* Terminals that don't need any help. */ - if (tgetflag("ul") || tgetflag("os")) - execv("/bin/cat",argv); - cp = ulbuf; - if ((backspace = tgetstr("bc",&cp)) == NULL) - backspace = "\b"; - /* - * Handle terminals that have start underline/stop - * underline sequences, as well as those with - * underline char sequences (we assume the sequence - * moves the cursor forward one character). - * If we can't find underline sequences, we - * settle for standout sequences. - */ - if ( (chul=tgetstr("uc",&cp)) == NULL) - chul = ""; - if ( (stul=tgetstr("us",&cp)) == NULL && - (!*chul) && (stul=tgetstr("so",&cp)) == NULL) - stul = ""; - if ( (endul=tgetstr("ue",&cp)) == NULL && - (!*chul) && (endul=tgetstr("se",&cp)) == NULL) - endul = ""; - break; - default:/* error opening/reading termcap */ - fprintf(stderr,"trouble reading termcap"); - /* fall through to ... */ - case 0: /* No such terminal type - assume dumb */ - stul = endul = chul = ""; - break; +++ +++ case 1: +++ if (tgetflag("os")) +++ execv("/bin/cat",argv); +++ cp = ulbuf; +++ if ((backspace = tgetstr("bc",&cp)) == NULL) +++ backspace = "\b"; +++ /* +++ * Handle terminals that have start underline/stop +++ * underline sequences, as well as those with +++ * underline char sequences (we assume the sequence +++ * moves the cursor forward one character). +++ * If we can't find underline sequences, we +++ * settle for standout sequences. +++ */ +++ if ((chul=tgetstr("uc",&cp)) == NULL) +++ chul = ""; +++ if ((stul=tgetstr("us",&cp)) == NULL && !tgetflag("ul") && +++ (!*chul) && (stul=tgetstr("so",&cp)) == NULL) +++ stul = ""; +++ if ((endul=tgetstr("ue",&cp)) == NULL && !tgetflag("ul") && +++ (!*chul) && (endul=tgetstr("se",&cp)) == NULL) +++ endul = ""; +++ if (chul==0&&stul==0&&endul==0&&tgetflag("ul")) +++ execv("/bin/cat",argv); +++ break; +++ +++ default: +++ fprintf(stderr,"trouble reading termcap"); +++ /* fall through to ... */ +++ +++ case 0: +++ /* No such terminal type - assume dumb */ +++ stul = endul = chul = ""; +++ break; + + } - if (argc < 2) filter(stdin); - else for (i=1; i 0) { + + p--; + + } + + } else if (c=='_' && isul[p]==0 && buf[p]) { + + isul[p] = 1; + + p++; + + } else { - if (buf[p] == '_') { +++ if (buf[p] == '_') + + isul[p] = 1; - } + + buf[p] = c; + + p++; - if (n < p) n = p; +++ if (n < p) +++ n = p; + + } - if (c=='\n') break; +++ if (c=='\n') +++ break; + + } + + + + state = 0; + + for (p=0; p 0) { +++ if (freopen(argv[0], "r", stdin) == NULL) { +++ perror(argv[0]); +++ exit(1); +++ } +++ argc--; argv++; +++ } +++ while (fgets(linebuf, sizeof linebuf, stdin) != 0) { +++ for (lp = linebuf; *lp; lp++) +++ continue; +++ *--lp = 0; +++ doulg(); +++ dographic(); +++ if (genbuf[0]) +++ printf("\n%s", genbuf); +++ putchar('\n'); +++ fflush(stdout); +++ } +++ } while (argc > 0); +++ exit(0); +++} +++ +++dographic() +++{ +++ register char *lp; +++ register c; +++ +++ for (lp = linebuf; c = *lp++;) { +++ switch (c) { +++ case '\b': +++ if (BACKSPACE == 0) +++ c = '?'; +++ break; +++ default: +++ if (c < ' ' || c == 0177) +++ c = '?'; +++ break; +++ case '\t': +++ break; +++ } +++ putchar(c); +++ } +++} +++ +++doulg() +++{ +++ register char *lp, *gp; +++ char *maxgp; +++ register c; +++ char csw; +++ int col; +++ +++ gp = genbuf; +++ *gp = 0; +++ maxgp = gp; +++ col = 0; +++ for (lp = linebuf; c = *lp++;) { +++ switch (c) { +++ case '\t': +++ while ((col & 7) != 7) { +++ *gp++ = ' '; +++ if (gp >= &genbuf[BUFSIZ - 2]) +++ goto ovflo; +++ col++; +++ } +++ break; +++ default: +++ if (gp >= maxgp) +++ break; +++ c |= (*gp & QUOTE); +++ break; +++ case '_': +++ if (gp >= maxgp) +++ c = QUOTE; +++ else +++ c = *gp | QUOTE; +++ break; +++ case '\b': +++ if (gp > genbuf) { +++ gp--; +++ col--; +++ } +++ continue; +++ } +++ if (gp >= &genbuf[BUFSIZ - 2]) { +++ovflo: +++ fprintf(stderr, "Line too long\n"); +++ exit(1); +++ } +++ *gp++ = c; +++ if (gp > maxgp) +++ maxgp = gp; +++ col++; +++ } +++ *maxgp = 0; +++ strcpy(linebuf, genbuf); +++ for (lp = linebuf, gp = genbuf; c = *lp; gp++, lp++) +++ if (c & QUOTE) { +++ c &= 0177; +++ if (c == 0) +++ *lp = '_', *gp = ' '; +++ else +++ *lp = c, *gp = '-'; +++ } else +++ *gp = ' '; +++ --gp; +++ while (gp >= genbuf && *gp == ' ') +++ --gp; +++ gp[1] = 0; +++} diff --cc usr/src/cmd/umount.c index 0000000000,008c2d1197,0000000000..a24228015c mode 000000,100644,000000..100644 --- a/usr/src/cmd/umount.c +++ b/usr/src/cmd/umount.c @@@@ -1,0 -1,54 -1,0 +1,108 @@@@ +++static char *sccsid = "@(#)umount.c 4.3 (Berkeley) 10/15/80"; +++#include +++#include +++/* +++ * umount +++ */ +++ + +#define NMOUNT 16 + +#define NAMSIZ 32 + + + +struct mtab { + + char file[NAMSIZ]; + + char spec[NAMSIZ]; + +} mtab[NMOUNT]; + + + +main(argc, argv) + +char **argv; + +{ + + register struct mtab *mp; + + register char *p1, *p2; + + int mf; + + + + sync(); + + mf = open("/etc/mtab", 0); + + read(mf, (char *)mtab, NMOUNT*2*NAMSIZ); + + if(argc != 2) { + + printf("arg count\n"); + + return(1); + + } - if (umount(argv[1]) < 0) { - perror("umount"); - return(1); +++ if (strcmp(argv[1], "-a") == 0){ +++ if (setfsent() == 0) +++ perror(FSTAB), exit(1); +++ umountall(); +++ endfsent(); +++ } else { +++ int back; +++ if (back = umountfs(argv[1])){ +++ if (back < 0) +++ perror("umount"); +++ exit(1); +++ } +++ } +++ exit(0); +++} +++/* +++ * It is important to unmount the files in +++ * reverse! order from the order they were mounted, +++ * so that file systems mounted as children to other +++ * file systems get removed in the right order. +++ */ +++umountall() +++{ +++ struct fstab fs; +++ struct fstab *fsp; +++ if ( (fsp = getfsent()) == 0) +++ return; +++ fs = *fsp; /* save info locally; it is static from getfsent() */ +++ umountall(); +++ if (strcmp(fs.fs_file, "/") == 0) +++ return; +++ if (strcmp(fs.fs_type, FSTAB_RW) && +++ strcmp(fs.fs_type, FSTAB_RO)) +++ return; +++ if (umountfs(fs.fs_spec) < 0) +++ fprintf(stdout, "Unmount of special file %s FAILED\n", fs.fs_spec); +++ else +++ fprintf(stdout, "Unmounted special file %s\n", fs.fs_spec); +++ fflush(stdout); +++} +++ +++int umountfs(name) +++ char *name; +++{ +++ register char *p1, *p2; +++ register struct mtab *mp; +++ int mf; +++ +++ if (umount(name) < 0) { +++ return(-1); + + } - p1 = argv[1]; +++ p1 = name; + + while(*p1++) + + ; + + p1--; + + while(*--p1 == '/') + + *p1 = '\0'; - while(p1 > argv[1] && *--p1 != '/') +++ while(p1 > name && *--p1 != '/') + + ; + + if(*p1 == '/') + + p1++; - argv[1] = p1; +++ name = p1; + + for (mp = mtab; mp < &mtab[NMOUNT]; mp++) { - p1 = argv[1]; +++ p1 = name; + + p2 = &mp->spec[0]; + + while (*p1++ == *p2) + + if (*p2++ == 0) { + + for (p1 = mp->file; p1 < &mp->file[NAMSIZ*2];) + + *p1++ = 0; + + mp = &mtab[NMOUNT]; + + while ((--mp)->file[0] == 0); + + mf = creat("/etc/mtab", 0644); + + write(mf, (char *)mtab, (mp-mtab+1)*2*NAMSIZ); + + return(0); + + } + + } - printf("%s not in mount table\n", argv[1]); +++ printf("%s not in mount table\n", name); + + return(1); + +} diff --cc usr/src/cmd/unexpand.c index 0000000000,0000000000,0000000000..cb43ca6336 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/unexpand.c @@@@ -1,0 -1,0 -1,0 +1,89 @@@@ +++static char *sccsid = "@(#)unexpand.c 4.1 (Berkeley) 10/1/80"; +++/* +++ * unexpand - put tabs into a file replacing blanks +++ */ +++#include +++ +++char genbuf[BUFSIZ]; +++char linebuf[BUFSIZ]; +++int all; +++ +++main(argc, argv) +++ int argc; +++ char *argv[]; +++{ +++ register char *cp; +++ +++ argc--, argv++; +++ if (argv[0][0] == '-') { +++ if (strcmp(argv[0], "-a") != 0) { +++ fprintf(stderr, "usage: unexpand [ -a ] file ...\n"); +++ exit(1); +++ } +++ all++; +++ argc--, argv++; +++ } +++ do { +++ if (argc > 0) { +++ if (freopen(argv[0], "r", stdin) == NULL) { +++ perror(argv[0]); +++ exit(1); +++ } +++ argc--, argv++; +++ } +++ while (fgets(genbuf, BUFSIZ, stdin) != NULL) { +++ for (cp = linebuf; *cp; cp++) +++ continue; +++ if (cp > linebuf) +++ cp[-1] = 0; +++ tabify(all); +++ printf("%s", linebuf); +++ } +++ } while (argc > 0); +++ exit(0); +++} +++ +++tabify(c) +++ char c; +++{ +++ register char *cp, *dp; +++ register int dcol; +++ int ocol; +++ +++ ocol = 0; +++ dcol = 0; +++ cp = genbuf, dp = linebuf; +++ for (;;) { +++ switch (*cp) { +++ +++ case ' ': +++ dcol++; +++ break; +++ +++ case '\t': +++ dcol =+ 8; +++ dcol =& ~07; +++ break; +++ +++ default: +++ while (((ocol + 8) &~ 07) <= dcol) { +++ if (ocol + 1 == dcol) +++ break; +++ *dp++ = '\t'; +++ ocol =+ 8; +++ ocol =& ~07; +++ } +++ while (ocol < dcol) { +++ *dp++ = ' '; +++ ocol++; +++ } +++ if (*cp == 0 || c == 0) { +++ strcpy(dp, cp); +++ return; +++ } +++ *dp++ = *cp; +++ ocol++, dcol++; +++ } +++ cp++; +++ } +++} diff --cc usr/src/cmd/uniq.c index 0000000000,36f10011da,0000000000..948ee733a2 mode 000000,100644,000000..100644 --- a/usr/src/cmd/uniq.c +++ b/usr/src/cmd/uniq.c @@@@ -1,0 -1,142 -1,0 +1,143 @@@@ +++static char *sccsid = "@(#)uniq.c 4.1 (Berkeley) 10/1/80"; + +/* + + * Deal with duplicated lines in a file + + */ + +#include + +#include + +int fields; + +int letters; + +int linec; + +char mode; + +int uniq; + +char *skip(); + + + +main(argc, argv) + +int argc; + +char *argv[]; + +{ + + static char b1[1000], b2[1000]; + + + + while(argc > 1) { + + if(*argv[1] == '-') { + + if (isdigit(argv[1][1])) + + fields = atoi(&argv[1][1]); + + else mode = argv[1][1]; + + argc--; + + argv++; + + continue; + + } + + if(*argv[1] == '+') { + + letters = atoi(&argv[1][1]); + + argc--; + + argv++; + + continue; + + } + + if (freopen(argv[1], "r", stdin) == NULL) + + printe("cannot open %s\n", argv[1]); + + break; + + } + + if(argc > 2 && freopen(argv[2], "w", stdout) == NULL) + + printe("cannot create %s\n", argv[2]); + + + + if(gline(b1)) + + exit(0); + + for(;;) { + + linec++; + + if(gline(b2)) { + + pline(b1); + + exit(0); + + } + + if(!equal(b1, b2)) { + + pline(b1); + + linec = 0; + + do { + + linec++; + + if(gline(b1)) { + + pline(b2); + + exit(0); + + } + + } while(equal(b1, b2)); + + pline(b2); + + linec = 0; + + } + + } + +} + + + +gline(buf) + +register char buf[]; + +{ + + register c; + + + + while((c = getchar()) != '\n') { + + if(c == EOF) + + return(1); + + *buf++ = c; + + } + + *buf = 0; + + return(0); + +} + + + +pline(buf) + +register char buf[]; + +{ + + + + switch(mode) { + + + + case 'u': + + if(uniq) { + + uniq = 0; + + return; + + } + + break; + + + + case 'd': + + if(uniq) break; + + return; + + + + case 'c': + + printf("%4d ", linec); + + } + + uniq = 0; + + fputs(buf, stdout); + + putchar('\n'); + +} + + + +equal(b1, b2) + +register char b1[], b2[]; + +{ + + register char c; + + + + b1 = skip(b1); + + b2 = skip(b2); + + while((c = *b1++) != 0) + + if(c != *b2++) return(0); + + if(*b2 != 0) + + return(0); + + uniq++; + + return(1); + +} + + + +char * + +skip(s) + +register char *s; + +{ + + register nf, nl; + + + + nf = nl = 0; + + while(nf++ < fields) { + + while(*s == ' ' || *s == '\t') + + s++; + + while( !(*s == ' ' || *s == '\t' || *s == 0) ) + + s++; + + } + + while(nl++ < letters && *s != 0) + + s++; + + return(s); + +} + + + +printe(p,s) + +char *p,*s; + +{ + + fprintf(stderr, p, s); + + exit(1); + +} diff --cc usr/src/cmd/units.c index 0000000000,2cb49967cc,0000000000..9a9c0a7491 mode 000000,100644,000000..100644 --- a/usr/src/cmd/units.c +++ b/usr/src/cmd/units.c @@@@ -1,0 -1,465 -1,0 +1,466 @@@@ +++static char *sccsid = "@(#)units.c 4.1 (Berkeley) 10/1/80"; + +#include + + + +#define NDIM 10 + +#define NTAB 601 + +char *dfile = "/usr/lib/units"; + +char *unames[NDIM]; + +double getflt(); + +int fperr(); + +struct table *hash(); + +struct unit + +{ + + double factor; + + char dim[NDIM]; + +}; + + + +struct table + +{ + + double factor; + + char dim[NDIM]; + + char *name; + +} table[NTAB]; + +char names[NTAB*10]; + +struct prefix + +{ + + double factor; + + char *pname; + +} prefix[] = + +{ + + 1e-18, "atto", + + 1e-15, "femto", + + 1e-12, "pico", + + 1e-9, "nano", + + 1e-6, "micro", + + 1e-3, "milli", + + 1e-2, "centi", + + 1e-1, "deci", + + 1e1, "deka", + + 1e2, "hecta", + + 1e2, "hecto", + + 1e3, "kilo", + + 1e6, "mega", + + 1e6, "meg", + + 1e9, "giga", + + 1e12, "tera", + + 0.0, 0 + +}; + +FILE *inp; + +int fperrc; + +int peekc; + +int dumpflg; + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + register char *file; + + struct unit u1, u2; + + double f; + + + + if(argc>1 && *argv[1]=='-') { + + argc--; + + argv++; + + dumpflg++; + + } + + file = dfile; + + if(argc > 1) + + file = argv[1]; + + if ((inp = fopen(file, "r")) == NULL) { + + printf("no table\n"); + + exit(1); + + } + + signal(8, fperr); + + init(); + + + +loop: + + fperrc = 0; + + printf("you have: "); + + if(convr(&u1)) + + goto loop; + + if(fperrc) + + goto fp; + +loop1: + + printf("you want: "); + + if(convr(&u2)) + + goto loop1; + + for(i=0; ifactor); + + f = 0; + + for(i=0; idim[i], i, f); + + if(f&1) { + + putchar('/'); + + f = 0; + + for(i=0; idim[i], i, f); + + } + + putchar('\n'); + +} + + + +pu(u, i, f) + +{ + + + + if(u > 0) { + + if(f&2) + + putchar('-'); + + if(unames[i]) + + printf("%s", unames[i]); else + + printf("*%c*", i+'a'); + + if(u > 1) + + putchar(u+'0'); + + return(2); + + } + + if(u < 0) + + return(1); + + return(0); + +} + + + +convr(up) + +struct unit *up; + +{ + + register struct unit *p; + + register c; + + register char *cp; + + char name[20]; + + int den, err; + + + + p = up; + + for(c=0; cdim[c] = 0; + + p->factor = getflt(); + + if(p->factor == 0.) + + p->factor = 1.0; + + err = 0; + + den = 0; + + cp = name; + + + +loop: + + switch(c=get()) { + + + + case '1': + + case '2': + + case '3': + + case '4': + + case '5': + + case '6': + + case '7': + + case '8': + + case '9': + + case '-': + + case '/': + + case ' ': + + case '\t': + + case '\n': + + if(cp != name) { + + *cp++ = 0; + + cp = name; + + err |= lookup(cp, p, den, c); + + } + + if(c == '/') + + den++; + + if(c == '\n') + + return(err); + + goto loop; + + } + + *cp++ = c; + + goto loop; + +} + + + +lookup(name, up, den, c) + +char *name; + +struct unit *up; + +{ + + register struct unit *p; + + register struct table *q; + + register i; + + char *cp1, *cp2; + + double e; + + + + p = up; + + e = 1.0; + + + +loop: + + q = hash(name); + + if(q->name) { + + l1: + + if(den) { + + p->factor /= q->factor*e; + + for(i=0; idim[i] -= q->dim[i]; + + } else { + + p->factor *= q->factor*e; + + for(i=0; idim[i] += q->dim[i]; + + } + + if(c >= '2' && c <= '9') { + + c--; + + goto l1; + + } + + return(0); + + } + + for(i=0; cp1 = prefix[i].pname; i++) { + + cp2 = name; + + while(*cp1 == *cp2++) + + if(*cp1++ == 0) { + + cp1--; + + break; + + } + + if(*cp1 == 0) { + + e *= prefix[i].factor; + + name = cp2-1; + + goto loop; + + } + + } + + for(cp1 = name; *cp1; cp1++); + + if(cp1 > name+1 && *--cp1 == 's') { + + *cp1 = 0; + + goto loop; + + } + + printf("cannot recognize %s\n", name); + + return(1); + +} + + + +equal(s1, s2) + +char *s1, *s2; + +{ + + register char *c1, *c2; + + + + c1 = s1; + + c2 = s2; + + while(*c1++ == *c2) + + if(*c2++ == 0) + + return(1); + + return(0); + +} + + + +init() + +{ + + register char *cp; + + register struct table *tp, *lp; + + int c, i, f, t; + + char *np; + + + + cp = names; + + for(i=0; iname = np; + + lp->factor = 1.0; + + lp->dim[i] = 1; + + } + + lp = hash(""); + + lp->name = cp-1; + + lp->factor = 1.0; + + + +l0: + + c = get(); + + if(c == 0) { - printf("%l units; %l bytes\n\n", i, cp-names); +++ printf("%d units; %d bytes\n\n", i, cp-names); + + if(dumpflg) + + for(tp = &table[0]; tp < &table[NTAB]; tp++) { + + if(tp->name == 0) + + continue; + + printf("%s", tp->name); + + units(tp); + + } + + fclose(inp); + + inp = stdin; + + return; + + } + + if(c == '/') { + + while(c != '\n' && c != 0) + + c = get(); + + goto l0; + + } + + if(c == '\n') + + goto l0; + + np = cp; + + while(c != ' ' && c != '\t') { + + *cp++ = c; + + c = get(); + + if (c==0) + + goto l0; + + if(c == '\n') { + + *cp++ = 0; + + tp = hash(np); + + if(tp->name) + + goto redef; + + tp->name = np; + + tp->factor = lp->factor; + + for(c=0; cdim[c] = lp->dim[c]; + + i++; + + goto l0; + + } + + } + + *cp++ = 0; + + lp = hash(np); + + if(lp->name) + + goto redef; + + convr(lp); + + lp->name = np; + + f = 0; + + i++; + + if(lp->factor != 1.0) + + goto l0; + + for(c=0; cdim[c]; + + if(t>1 || (f>0 && t!=0)) + + goto l0; + + if(f==0 && t==1) { + + if(unames[c]) + + goto l0; + + f = c+1; + + } + + } + + if(f>0) + + unames[f-1] = np; + + goto l0; + + + +redef: + + printf("redefinition %s\n", np); + + goto l0; + +} + + + +double + +getflt() + +{ + + register c, i, dp; + + double d, e; + + int f; + + + + d = 0.; + + dp = 0; + + do + + c = get(); + + while(c == ' ' || c == '\t'); + + + +l1: + + if(c >= '0' && c <= '9') { + + d = d*10. + c-'0'; + + if(dp) + + dp++; + + c = get(); + + goto l1; + + } + + if(c == '.') { + + dp++; + + c = get(); + + goto l1; + + } + + if(dp) + + dp--; + + if(c == '+' || c == '-') { + + f = 0; + + if(c == '-') + + f++; + + i = 0; + + c = get(); + + while(c >= '0' && c <= '9') { + + i = i*10 + c-'0'; + + c = get(); + + } + + if(f) + + i = -i; + + dp -= i; + + } + + e = 1.; + + i = dp; + + if(i < 0) + + i = -i; + + while(i--) + + e *= 10.; + + if(dp < 0) + + d *= e; else + + d /= e; + + if(c == '|') + + return(d/getflt()); + + peekc = c; + + return(d); + +} + + + +get() + +{ + + register c; + + + + if(c=peekc) { + + peekc = 0; + + return(c); + + } + + c = getc(inp); + + if (c == EOF) { + + if (inp == stdin) { + + printf("\n"); + + exit(0); + + } + + return(0); + + } + + return(c); + +} + + + +struct table * + +hash(name) + +char *name; + +{ + + register struct table *tp; + + register char *np; + + register unsigned h; + + + + h = 0; + + np = name; + + while(*np) + + h = h*57 + *np++ - '0'; + + if( ((int)h)<0) h= -(int)h; + + h %= NTAB; + + tp = &table[h]; + +l0: + + if(tp->name == 0) + + return(tp); + + if(equal(name, tp->name)) + + return(tp); + + tp++; + + if(tp >= &table[NTAB]) + + tp = table; + + goto l0; + +} + + + +fperr() + +{ + + + + signal(8, fperr); + + fperrc++; + +} diff --cc usr/src/cmd/update.c index 0000000000,85c05404f0,0000000000..34346c0bec mode 000000,100644,000000..100644 --- a/usr/src/cmd/update.c +++ b/usr/src/cmd/update.c @@@@ -1,0 -1,36 -1,0 +1,40 @@@@ +++static char *sccsid = "@(#)update.c 4.2 (Berkeley) 10/15/80"; + +/* + + * Update the file system every 30 seconds. + + * For cache benefit, open certain system directories. + + */ + + + +#include + + + +char *fillst[] = { + + "/bin", +++ "/lib", + + "/usr", + + "/usr/bin", +++ "/usr/lib", +++ "/usr/ucb", + + 0, + +}; + + + +main() + +{ + + char **f; + + + + if(fork()) + + exit(0); + + close(0); + + close(1); + + close(2); + + for(f = fillst; *f; f++) + + open(*f, 0); + + dosync(); + + for(;;) + + pause(); + +} + + + +dosync() + +{ + + sync(); + + signal(SIGALRM, dosync); + + alarm(30); + +} diff --cc usr/src/cmd/users.c index 0000000000,ab59e38f91,0000000000..50fdd2443a mode 000000,100644,000000..100644 --- a/usr/src/cmd/users.c +++ b/usr/src/cmd/users.c @@@@ -1,0 -1,58 -1,0 +1,63 @@@@ +++static char *sccsid = "@(#)users.c 4.1 (Berkeley) 10/1/80"; + +/* + + * users + + */ + +char *malloc(); + + + +#include + +#include + + +++#define NMAX sizeof(utmp.ut_name) +++#define LMAX sizeof(utmp.ut_line) +++ + +struct utmp utmp; + + + +main(argc, argv) + +char **argv; + +{ + + register char *tp, *s; + + register FILE *fi; + + + + s = "/etc/utmp"; + + if(argc == 2) + + s = argv[1]; + + if ((fi = fopen(s, "r")) == NULL) { + + puts("who: cannot open utmp"); + + exit(1); + + } + + while (fread((char *)&utmp, sizeof(utmp), 1, fi) == 1) { + + if(utmp.ut_name[0] == '\0') + + continue; + + putline(); + + } + + summary(); + +} + + + +char *names[128]; + +char **namp = names; + +putline() + +{ - char temp[9]; - strncpy(temp, utmp.ut_name, 8); +++ char temp[NMAX+1]; +++ strncpy(temp, utmp.ut_name, NMAX); +++ temp[NMAX] = 0; + + *namp = malloc(strlen(temp) + 1); + + strcpy(*namp++, temp); + +} + + + +scmp(p, q) + +char **p, **q; + +{ + + return(strcmp(*p, *q)); + +} + +summary() + +{ + + register char **p; + + + + qsort(names, namp - names, sizeof names[0], scmp); + + for (p=names; p < namp; p++) { + + if (p != names) + + printf(" "); + + printf("%s", *p); + + } + + printf("\n"); + +} diff --cc usr/src/cmd/uucp/conn.c index 0000000000,8743a740c7,0000000000..c6e6420368 mode 000000,100644,000000..100644 --- a/usr/src/cmd/uucp/conn.c +++ b/usr/src/cmd/uucp/conn.c @@@@ -1,0 -1,793 -1,0 +1,798 @@@@ + + /* conn 2.1 5/23/79 19:07:44 */ + +#define CONN + +#include "uucp.h" + +#include + +#include + +#include + +#include + +#include + +#include + + + +static char SiD[] = "@(#)conn 2.1"; + + + +#ifdef DATAKIT + +#include + +#endif + + + + + +#define F_NAME 0 + +#define F_TIME 1 + +#define F_LINE 2 + +#define F_SPEED 3 + +#define F_PHONE 4 + +#define F_LOGIN 5 + + + +jmp_buf Sjbuf; + +int alarmtr(); + +#define INVOKE(a, r) ret = a; if (ret<0) return(r); + +/******* + + * conn(system) + + * char *system; + + * + + * conn - place a telephone call to system and + + * login, etc. + + * + + * return codes: + + * CF_SYSTEM: don't know system + + * CF_TIME: wrong time to call + + * CF_DIAL: call failed + + * CF_LOGIN: login/password dialog failed + + * + + * >0 - file no. - connect ok + + * + + */ + + + +conn(system) + +char *system; + +{ + + int ret, nf; + + int fn; + + char *flds[50]; + + DEBUG(4, "gdial %s\n", "called"); + + INVOKE(gdial(), CF_DIAL) + + DEBUG(4, "finds %s\n", "called"); + + INVOKE(nf = finds(system, flds), nf) + + DEBUG(4, "getto %s\n", "called"); + + INVOKE(fn = getto(flds), CF_DIAL) + + DEBUG(4, "login %s\n", "called"); + + INVOKE(login(nf, flds, fn), CF_LOGIN) + + return(fn); + +} + + + +/*** + + * char * + + * lastc(s) return pointer to last character + + * char *s; + + * + + */ + + + +char * + +lastc(s) + +char *s; + +{ + + while (*s != '\0') s++; + + return(s); + +} + + + +#define MAXDEV 10 + +#define MAXDCH MAXDEV*20 + +#define MAXCODE 30 + +#define MAXCCH MAXCODE*20 + + /* This array tells us about possible acu's, etc. */ + +struct Devices { + + char *D_type; + + char *D_line; + + char *D_calldev; + + int D_speed; + + } Devs [MAXDEV]; + + + +char Devbuff[MAXDCH]; + + + +struct Codes { + + char *C_locs; + + char *C_prefix; + + } Dialcodes [MAXCODE]; + + + +char Codebuff[MAXCCH]; + +int Dcfull = 0; + + + + + +/*** + + * gdial() get device and dial info + + * + + * return codes: 0 | FAIL + + */ + + + +gdial() + +{ + + char *flds[10], *lt; + + char *lb = Devbuff; + + char *lc = Codebuff; + + FILE *fn; + + int nr; + + struct Devices *pd; + + struct Codes *pc; + + if (Dcfull) return(0); + + + + fn = fopen(Devfile, "r"); + + ASSERT(fn != NULL, "CAN'T OPEN %s", Devfile); + + for (pd = Devs; fgets(lb, 200, fn); pd++) { + + lt = lastc(lb); + + nr = getargs(lb, flds); + + ASSERT(nr == 4, "BAD LINE %s", lb); + + pd->D_type = flds[0]; + + pd->D_line = flds[1]; + + pd->D_calldev = flds[2]; + + pd->D_speed = atoi(flds[3]); + + lb = lt; + + ASSERT(lb < Devbuff + MAXDCH, "TOO LONG %s", Devbuff); + + ASSERT(pd < Devs + MAXDEV, "TOO MANY DEVICES %d", MAXCODE); + + } + + pd->D_line = NULL; + + fclose(fn); + + ASSERT(pd > Devs, "BAD FILE %s", Devfile); + + /* Now dialcodes, same way */ + + fn = fopen(Dialfile, "r"); + + ASSERT(fn != NULL, "CAN'T OPEN %s", Dialfile); + + for (pc = Dialcodes; fgets(lc, 200, fn); pc++) { + + lt = lastc(lc); + + nr = getargs(lc, flds); + + if (nr == 1) flds[nr++] = ""; + + ASSERT(nr == 2, "BAD LINE %s", lc); + + pc->C_locs = flds[0]; + + pc->C_prefix = flds[1]; + + lc = lt; + + ASSERT(lc < Codebuff + MAXCCH, "TOO LONG %s", Codebuff); + + ASSERT(pc < Dialcodes + MAXCODE, "MANY DEVICES %d", MAXCODE); + + } + + pc->C_locs = 0; + + fclose(fn); + + return(0); + +} + + + + + +/*** + + * ckdev(type, speed, ndev) + + * char *type, *speed; + + * int ndev; + + * + + * ckdev - return the device number in table Devs for + + * a device with proper attributes. + + * + + * return codes: >= 0 (ok) | FAIL + + */ + + + +ckdev(type, speed, ndev) + +char *type, *speed; + +int ndev; + +{ + + int sp; + + struct Devices *pd; + + + + sp = atoi(speed); + + for (pd = &Devs[ndev]; pd->D_line != NULL; pd++) { + + if (sp != pd->D_speed) + + continue; + + if ((strcmp(pd->D_type, type) == SAME) + + && !mlock(pd->D_line)) + + return(ndev = pd - Devs); + + if ((strcmp(pd->D_line, type) == SAME) + + && !mlock(type)) + + return(ndev = pd - Devs); + + } + + return(FAIL); + +} + + + + + +/*** + + * getto(flds) connect to remote machine + + * char *flds[]; + + * + + * return codes: + + * >0 - file number - ok + + * FAIL - failed + + */ + + + +getto(flds) + +char *flds[]; + +{ + + DEBUG(F_PHONE, "call: no. %s ", flds[4]); + + DEBUG(4, "for sys %s ", flds[F_NAME]); + + + + if (prefix("ACU", flds[F_LINE])) + + return(call(flds)); + + + +#ifdef DATAKIT + + else if (prefix("DK", flds[F_LINE])) + + return(dkcall(flds)); + +#endif + + + + else + + return(direct(flds)); + +} + + + +/*** + + * call(flds) call remote machine + + * char *flds[]; + + * + + * "flds" contains the call information (name, date, type, speed, + + * phone no. ... + + * Ndev has the device no. + + * + + * return codes: + + * >0 - file number - ok + + * FAIL - failed + + */ + + + +call(flds) + +char *flds[]; + +{ + + char *pno, pref[20], phone[20]; + + char *s1, *s2; + + int dcr, i; + + struct Codes *pc; + + + + pno = flds[F_PHONE]; + + s1 = pref; s2 = pno; + + while (isalpha(*s2)) + + *s1++ = *s2++; + + *s1 = '\0'; + + for (pc = Dialcodes; pc->C_locs; pc++) + + if (strcmp(pc->C_locs, pref) == SAME) { + + s1 = pc->C_prefix; + + break; + + } + + sprintf(phone, "%s%s", s1, s2); + + for (i = 0; i < TRYCALLS; i++) { + + DEBUG(4, "Dial %s\n", phone); + + dcr = dialup(phone, flds); + + DEBUG(4, "dcr returned as %d\n", dcr); + + if (dcr != FAIL) + + break; + + } + + return(dcr); + + + +} + + + + /* file descriptor for call unit */ + +int Dnf = 0; + + + +/*** + + * dialup(ph, flds) dial remote machine + + * char *ph; + + * char *flds[]; + + * + + * return codes: + + * file descriptor - succeeded + + * FAIL - failed + + */ + + + +dialup(ph, flds) + +char *ph; + +char *flds[]; + +{ + +#ifdef DIALOUT + + int dcf; + + if ((dcf = dialout(ph, flds[F_SPEED])) < 0) + + return(FAIL); + + return(dcf); + +#endif + + + +#ifndef DIALOUT + + char dcname[20], dnname[20], phone[20]; + + struct Devices *pd; + + int nw, lt, pid, dcf, ndev, timelim; + + extern int Error; + + + + for (ndev = 0;;ndev++) { + + ndev = ckdev(flds[F_LINE], flds[F_SPEED], ndev); + + if (ndev < 0) { + + logent("AVAILABLE DEVICE", "NO"); + + DEBUG(4, "NO AVAILABLE DEVICE %s\n", ""); + + return(FAIL); + + } + + pd = &Devs[ndev]; + + sprintf(dnname, "/dev/%s", pd->D_calldev); + + /* open call unit */ + + Dnf = open(dnname, 1); + + if (Dnf >= 0) + + break; + + delock(pd->D_line); + + } + + sprintf(dcname, "/dev/%s", pd->D_line); + + sprintf(phone, "%s%s", ph, ACULAST); + + DEBUG(4, "dc - %s, ", dcname); + + DEBUG(4, "acu - %s\n", dnname); + + if (setjmp(Sjbuf)) { + + DEBUG(1, "DN write %s\n", "timeout"); + + logent("DIALUP DN write", "TIMEOUT"); + + kill(pid, 9); + + delock(pd->D_line); + + close(Dnf); + + return(FAIL); + + } + + signal(SIGALRM, alarmtr); + + timelim = 5 * strlen(phone); + + alarm(timelim < 30 ? 30 : timelim); + + if ((pid = fork()) == 0) { + + sleep(2); + + fclose(stdin); + + fclose(stdout); + + nw = write(Dnf, phone, lt = strlen(phone)); + + if (nw != lt) { + + DEBUG(1, "ACU write %s\n", "error"); + + logent("DIALUP ACU write", "FAILED"); + + exit(1); + + } + + DEBUG(4, "ACU write ok%s\n", ""); + + exit(0); + + } + + /* open line - will return on carrier */ + + dcf = open(dcname, 2); + + DEBUG(4, "dcf is %d\n", dcf); + + if (dcf < 0) { + + DEBUG(1, "Line open %s\n", "failed"); + + logent("DIALUP LINE open", "FAILED"); + + alarm(0); + + kill(pid, 9); + + close(Dnf); + + return(FAIL); + + } + + ioctl(dcf, TIOCHPCL, 0); + + while ((nw = wait(<)) != pid && nw != -1) + + ; + + alarm(0); + + fflush(stdout); + + fixline(dcf, pd->D_speed); + + DEBUG(4, "Forked %d ", pid); + + DEBUG(4, "Wait got %d ", nw); + + DEBUG(4, "Status %o\n", lt); + + if (lt != 0) { + + close(dcf); + + close(Dnf); + + return(FAIL); + + } + + return(dcf); + +#endif + +} + + + + + +/*** + + * clsacu() close call unit + + * + + * return codes: none + + */ + + + +clsacu() + +{ + + if (Dnf > 0) { + + close(Dnf); + + sleep(5); + + Dnf = 0; + + } + + return; + +} + + + + + +/*** + + * direct(flds) connect to hardware line + + * char *flds[]; + + * + + * return codes: + + * >0 - file number - ok + + * FAIL - failed + + */ + + + +direct(flds) + +char *flds[]; + +{ + + int dcr, ndev; + + char dcname[20]; + + + + ndev = 0; + + if ((ndev = ckdev(flds[F_LINE], flds[F_SPEED], ndev)) < 0) { + + logent("DEVICE", "NOT AVAILABLE"); + + return(FAIL); + + } + + sprintf(dcname, "/dev/%s", Devs[ndev].D_line); + + signal(SIGALRM, alarmtr); + + alarm(10); + + if (setjmp(Sjbuf)) + + return(FAIL); + + dcr = open(dcname, 2); /* read/write */ + + alarm(0); + + if (dcr < 0) + + return(FAIL); + + fflush(stdout); + + fixline(dcr, Devs[ndev].D_speed); + + return(dcr); + +} + + + +#ifdef DATAKIT + + + +#define DKTRIES 2 + + + +/*** + + * dkcall(flds) make datakit connection + + * + + * return codes: + + * >0 - file number - ok + + * FAIL - failed + + */ + + + +dkcall(flds) + +char *flds[]; + +{ + + int dkphone; + + register char *cp; + + register ret, i; + + + + if (setjmp(Sjbuf)) + + return(FAIL); + + signal(SIGALRM, alarmtr); + + dkphone = 0; + + cp = flds[F_PHONE]; + + while(*cp) + + dkphone = 10 * dkphone + (*cp++ - '0'); + + DEBUG(4, "dkphone (%d) ", dkphone); + + for (i = 0; i < DKTRIES; i++) { + + ret = dkdial(D_UU, dkphone, 0); + + DEBUG(4, "dkdial (%d)\n", ret); + + if (ret > -1) + + break; + + } + + return(ret); + +} + +#endif + + + +#define MAXC 300 + + + +/*** + + * finds(sysnam, flds) set system attribute vector + + * char *sysnam, *flds[]; + + * + + * return codes: + + * >0 - number of arguments in vector - succeeded + + * CF_SYSTEM - system name not found + + * CF_TIME - wrong time to call + + */ + + + +finds(sysnam, flds) + +char *sysnam, *flds[]; + +{ + + FILE *fsys; + + static char info[MAXC]; + + char **fnp; + + int na; + + int fnd = 0; + + + + for (fnp = Sysfiles; *fnp != NULL && !fnd; fnp++) { + + fsys = fopen(*fnp, "r"); + + if (fsys == NULL) + + continue; + + while (!fnd && (fgets(info, MAXC, fsys) != NULL)) { + + na = getargs(info, flds); + + if (prefix(sysnam, flds[F_NAME])) + + fnd = 1; + + } + + fclose(fsys); + + } + + if (fnd == 0) + + return(CF_SYSTEM); + + /* format of fields + + * 0 name; + + * 1 time - * 2 acu/hardwired +++ * 2 acu/hardwired/slave + + * 3 speed + + * etc + + */ + + if (ifdate(flds[F_TIME]) == 0) { + + DEBUG(1, "Wrong time to call %s\n", sysnam); + + logent(sysnam, "WRONG TIME TO CALL"); + + return(CF_TIME); + + } +++ if (strcmp(flds[F_LINE], "Slave") == 0) { +++ DEBUG(1, "Slave only, no call to %s tried\n", sysnam); +++ logent(sysnam, "NO CALL FROM SLAVE"); +++ return(CF_TIME); +++ } + + return(na); + +} + + + + + +/*** + + * login(nf, flds, dcr) do log conversation + + * char *flds[]; + + * int nf; + + * + + * return codes: 0 | FAIL + + */ + + + +login(nf, flds, fn) + +char *flds[]; + +int nf, fn; + +{ + + char *want, *altern; + + extern char *index(); + + int k, ok; + + + + ASSERT(nf > 4, "TOO FEW LOG FIELDS %d", nf); + + for (k = F_LOGIN; k < nf; k += 2) { + + want = flds[k]; + + ok = FAIL; + + while (ok != 0) { + + altern = index(want, '-'); + + if (altern != NULL) + + *altern++ = '\0'; + + DEBUG(4, "wanted %s ", want); + + ok = expect(want, fn); + + DEBUG(4, "got %s\n", ok ? "?" : "that"); + + if (ok == 0) + + break; + + if (altern == NULL) { + + logent("LOGIN", "FAILED"); + + return(FAIL); + + } + + want = index(altern, '-'); + + if (want != NULL) + + *want++ = '\0'; + + sendthem(altern, fn); + + } + + sleep(2); + + sendthem(flds[k+1], fn); + + } + + return(0); + +} + + + + + +struct sg_spds {int sp_val, sp_name;} spds[] = { + + { 300, B300}, + + {1200, B1200}, + + {4800, B4800}, + + {9600, B9600}, + + {0, 0} }; + + + +/*** + + * fixline(tty, spwant) set speed/echo/mode... + + * int tty, spwant; + + * + + * return codes: none + + */ + + + +fixline(tty, spwant) + +int tty, spwant; + +{ + + struct sgttyb ttbuf; + + struct sg_spds *ps; + + int speed = -1; + + int ret; + + + + for (ps = spds; ps->sp_val; ps++) + + if (ps->sp_val == spwant) + + speed = ps->sp_name; + + ASSERT(speed >= 0, "BAD SPEED %d", speed); + + ioctl(tty, TIOCGETP, &ttbuf); + + ttbuf.sg_flags =(ANYP|RAW); + + ttbuf.sg_ispeed = ttbuf.sg_ospeed = speed; + + DEBUG(4, "Speed: want %d ", spwant); + + DEBUG(4, "use %o ", speed); + + DEBUG(4, "ps %d\n", ps-spds); + + ret = ioctl(tty, TIOCSETP, &ttbuf); + + ASSERT(ret >= 0, "RETURN FROM STTY %d", ret); + + ioctl(tty, TIOCHPCL, 0); + + ioctl(tty, TIOCEXCL, 0); + + return; + +} + + + + - #define MR 300 +++#define MR 2000 + + + +int Error = 0; + + + +/*** + + * expect(str, fn) look for expected string + + * char *str; + + * + + * return codes: + + * 0 - found + + * FAIL - lost line or too many characters read + + * some character - timed out + + */ + + + +expect(str, fn) + +char *str; + +int fn; + +{ + + static char rdvec[MR]; + + char *rp = rdvec; + + int nextch = 0, kr; + + + + if (strcmp(str, "\"\"") == SAME) + + return(0); + + *rp = 0; + + if (setjmp(Sjbuf)) { + + return(FAIL); + + } + + signal(SIGALRM, alarmtr); + + while (notin(str, rdvec)) { + + alarm(MAXCHARTIME); + + kr = read(fn, &nextch, 1); + + if (kr <= 0) { + + DEBUG(4, "kr - %d\n", kr); + + alarm(0); + + DEBUG(4, "lost line kr - %d, ", kr); + + DEBUG(4, "fn - %d\n", fn); + + logent("LOGIN", "LOST LINE"); + + return(FAIL); + + } + + { + + int c; + + c = nextch & 0177; + + DEBUG(4, "%c", c > 040 ? c : '_'); + + } + + if ((*rp = nextch & 0177) != '\0') + + rp++; + + *rp = '\0'; + + if (rp >= rdvec + MR) + + return(FAIL); + + } + + alarm(0); + + return(0); + +} + + + + + +/*** + + * alarmtr() - catch alarm routine for "expect". + + */ + + + +alarmtr() + +{ + + longjmp(Sjbuf, 1); + +} + + + + + +/*** + + * sendthem(str, fn) send line of login sequence + + * char *str; + + * + + * return codes: none + + */ + + + +sendthem(str, fn) + +char *str; + +int fn; + +{ + + int nw, ns; + + int nulls; + + + + if (prefix("BREAK", str)) { + + sscanf(&str[5], "%1d", &nulls); + + if (nulls <= 0 || nulls > 10) + + nulls = 3; + + /* send break */ + + DEBUG(5, "%s,", str); + + DEBUG(5, "%d\n", nulls); + + genbrk(fn, nulls); + + return; + + } + + + + if (strcmp(str, "EOT") == SAME) { + + write(fn, EOTMSG, strlen(EOTMSG)); + + return; + + } + + if (strcmp(str, "") != SAME) { + + nw = write(fn, str, ns = strlen(str)); + + ASSERT(nw == ns, "BAD WRITE $s", str); + + } + + write(fn, "\n", 1); + + return; + +} + + + +#define BSPEED B150 + + + +/*** + + * genbrk send a break + + * + + * return codes; none + + */ + + + +genbrk(fn, bnulls) + +{ + + struct sgttyb ttbuf; + + int ret, sospeed; + + + + ret = ioctl(fn, TIOCGETP, &ttbuf); + + DEBUG(5, "ioctl ret %d\n", ret); + + sospeed = ttbuf.sg_ospeed; + + ttbuf.sg_ospeed = BSPEED; + + ret = ioctl(fn, TIOCSETP, &ttbuf); + + DEBUG(5, "ioctl ret %d\n", ret); + + ret = write(fn, "\0\0\0\0\0\0\0\0\0\0\0\0", bnulls); + + ASSERT(ret > 0, "BAD WRITE genbrk %d", ret); + + ttbuf.sg_ospeed = sospeed; + + ret = ioctl(fn, TIOCSETP, &ttbuf); + + ret = write(fn, "@", 1); + + ASSERT(ret > 0, "BAD WRITE genbrk %d", ret); + + DEBUG(4, "sent BREAK nulls - %d\n", bnulls); + + return; + +} + + + + + +/*** + + * notin(sh, lg) check for occurrence of substring "sh" + + * char *sh, *lg; + + * + + * return codes: + + * 0 - found the string + + * 1 - not in the string + + */ + + + +notin(sh, lg) + +char *sh, *lg; + +{ + + while (*lg != '\0') { + + if (prefix(sh, lg)) + + return(0); + + else + + lg++; + + } + + return(1); + +} + + + + + +/******* + + * ifdate(s) + + * char *s; + + * + + * ifdate - this routine will check a string (s) + + * like "MoTu0800-1730" to see if the present + + * time is within the given limits. + + * + + * String alternatives: + + * Wk - Mo thru Fr + + * zero or one time means all day + + * Any - any day + + * + + * return codes: + + * 0 - not within limits + + * 1 - within limits + + */ + + + +ifdate(s) + +char *s; + +{ + + static char *days[]={ + + "Su", "Mo", "Tu", "We", "Th", "Fr", "Sa", 0 + + }; + + long clock; + + int i, tl, th, tn, dayok=0; + + struct tm *localtime(); + + struct tm *tp; + + + + time(&clock); + + tp = localtime(&clock); + + while (isalpha(*s)) { + + for (i = 0; days[i]; i++) { + + if (prefix(days[i], s)) + + if (tp->tm_wday == i) + + dayok = 1; + + } + + + + if (prefix("Wk", s)) + + if (tp->tm_wday >= 1 && tp->tm_wday <= 5) + + dayok = 1; + + if (prefix("Any", s)) + + dayok = 1; + + s++; + + } + + + + if (dayok == 0) + + return(0); + + i = sscanf(s, "%d-%d", &tl, &th); + + tn = tp->tm_hour * 100 + tp->tm_min; + + if (i < 2) + + return(1); + + if (tn >= tl && tn <= th) + + return(1); + + return(0); + +} diff --cc usr/src/cmd/uucp/uux.c index 0000000000,a6bd1b96cc,0000000000..66df20a6ad mode 000000,100644,000000..100644 --- a/usr/src/cmd/uucp/uux.c +++ b/usr/src/cmd/uucp/uux.c @@@@ -1,0 -1,344 -1,0 +1,350 @@@@ + + /* uux 2.2 5/24/79 18:33:11 */ + +#include "uucp.h" + +#include "uucpdefs.h" + + + +static char SiD[] = "@(#)uux 2.2"; + + + +#define NOSYSPART 0 + +#define HASSYSPART 1 + + + +#define APPCMD(d) {\ + +char *p;\ + +for (p = d; *p != '\0';) *cmdp++ = *p++;\ + +*cmdp++ = ' ';\ + +*cmdp = '\0';} + + + +#define GENSEND(f, a, b, c, d) {\ + +fprintf(f, "S %s %s %s - %s 0666\n", a, b, c, d);\ + +} + +#define GENRCV(f, a, b, c) {\ + +fprintf(f, "R %s %s %s - \n", a, b, c);\ + +} + +/* + + * + + */ + + + +main(argc, argv) + +char *argv[]; + +{ + + char cfile[NAMESIZE]; /* send commands for files from here */ + + char dfile[NAMESIZE]; /* used for all data files from here */ + + char rxfile[NAMESIZE]; /* to be sent to xqt file (X. ...) */ + + char tfile[NAMESIZE]; /* temporary file name */ + + char tcfile[NAMESIZE]; /* temporary file name */ + + char t2file[NAMESIZE]; /* temporary file name */ + + int cflag = 0; /* commands in C. file flag */ + + int rflag = 0; /* C. files for receiving flag */ + + char buf[BUFSIZ]; + + char inargs[BUFSIZ]; + + int pipein = 0; + + int startjob = 1; + + char path[MAXFULLNAME]; + + char cmd[BUFSIZ]; + + char *ap, *cmdp; + + char prm[BUFSIZ]; + + char syspart[8], rest[MAXFULLNAME]; + + char xsys[8], local[8]; + + FILE *fprx, *fpc, *fpd, *fp; + + FILE *xqtstr(); + + extern char *getprm(), *index(), *lastpart(); + + int uid, ret; + + char redir = '\0'; + + + + uucpname(Myname); + + Ofn = 1; + + Ifn = 0; + + while (argc>1 && argv[1][0] == '-') { + + switch(argv[1][1]){ + + case 'p': + + case '\0': + + pipein = 1; + + break; + + case 'r': + + startjob = 0; + + break; + + case 'x': + + Debug = atoi(&argv[1][2]); + + if (Debug <= 0) + + Debug = 1; + + break; + + default: + + sprintf(stderr, "unknown flag %s\n", argv[1]); + + break; + + } + + --argc; argv++; + + } + + + + DEBUG(4, "\n\n** %s **\n", "START"); + + + + inargs[0] = '\0'; + + for (argv++; argc > 1; argc--) { + + DEBUG(4, "arg - %s:", *argv); + + strcat(inargs, " "); + + strcat(inargs, *argv++); + + } + + DEBUG(4, "arg - %s\n", inargs); + + ret = gwd(Wrkdir); + + if (ret != 0) { + + fprintf(stderr, "can't get working directory; will try to continue\n"); + + strcpy(Wrkdir, "/UNKNOWN"); + + } + + chdir(Spool); + + uid = getuid(); + + guinfo(uid, User, path); + + + + sprintf(local, "%.7s", Myname); + + cmdp = cmd; + + *cmdp = '\0'; + + gename(DATAPRE, local, 'X', rxfile); + + fprx = fopen(rxfile, "w"); + + ASSERT(fprx != NULL, "CAN'T OPEN %s", rxfile); + + chmod(rxfile, 0666); + + gename(DATAPRE, local, 'T', tcfile); + + fpc = fopen(tcfile, "w"); + + ASSERT(fpc != NULL, "CAN'T OPEN %s", tcfile); + + chmod(tcfile, 0666); + + fprintf(fprx, "%c %s %s\n", X_USER, User, local); + + + + /* find remote system name */ + + ap = inargs; + + while ((ap = getprm(ap, prm)) != NULL) { + + if (prm[0] == '>' || prm[0] == '<') { + + ap = getprm(ap, prm); + + continue; + + } + + + + if (prm[0] == ';') { + + APPCMD(prm); + + continue; + + } + + + + split(prm, xsys, rest); + + if (xsys[0] == '\0') + + strcpy(xsys, local); + + break; + + } + + DEBUG(4, "xsys %s\n", xsys); + + if (versys(xsys) != 0) { + + /* bad system name */ + + fprintf(stderr, "bad system name: %s\n", xsys); + + fclose(fprx); + + fclose(fpc); + + unlink(rxfile); + + unlink(tcfile); + + cleanup(101); + + } + + + + if (pipein) { +++ register int c; +++ + + gename(DATAPRE, xsys, 'B', dfile); + + fpd = fopen(dfile, "w"); + + ASSERT(fpd != NULL, "CAN'T OPEN %s", dfile); + + chmod(dfile, 0666); +++ while ((c = getc(stdin)) != EOF) +++ putc(c, fpd); +++#ifdef notdef + + while (fgets(buf, BUFSIZ, stdin) != NULL) + + fputs(buf, fpd); +++#endif + + fclose(fpd); + + if (strcmp(local, xsys) != SAME) { + + GENSEND(fpc, dfile, dfile, User, dfile); + + cflag++; + + } + + fprintf(fprx, "%c %s\n", X_RQDFILE, dfile); + + fprintf(fprx, "%c %s\n", X_STDIN, dfile); + + } + + /* parse command */ + + ap = inargs; + + while ((ap = getprm(ap, prm)) != NULL) { + + DEBUG(4, "prm - %s\n", prm); + + if (prm[0] == '>' || prm[0] == '<') { + + redir = prm[0]; + + continue; + + } + + + + if (prm[0] == '|' || prm[0] == '^') { + + if (cmdp != cmd) + + APPCMD(prm); + + continue; + + } + + + + /* process command or file or option */ + + ret = split(prm, syspart, rest); + + DEBUG(4, "s - %s, ", syspart); + + DEBUG(4, "r - %s, ", rest); + + DEBUG(4, "ret - %d\n", ret); + + if (syspart[0] == '\0') + + strcpy(syspart, local); + + + + if (cmdp == cmd && redir == '\0') { + + /* command */ + + APPCMD(rest); + + continue; + + } + + + + /* process file or option */ + + DEBUG(4, "file s- %s, ", syspart); + + DEBUG(4, "local - %s\n", local); + + /* process file */ + + if (redir == '>') { + + if (rest[0] != '~') + + expfile(rest); + + fprintf(fprx, "%c %s %s\n", X_STDOUT, rest, + + syspart); + + redir = '\0'; + + continue; + + } + + + + if (ret == NOSYSPART) { + + /* option */ + + APPCMD(rest); + + continue; + + } + + + + if (strcmp(xsys, local) == SAME + + && strcmp(xsys, syspart) == SAME) { + + expfile(rest); + + if (redir == '<') + + fprintf(fprx, "%c %s\n", X_STDIN, rest); + + else + + APPCMD(rest); + + redir = '\0'; + + continue; + + } + + + + if (strcmp(syspart, local) == SAME) { + + /* generate send file */ + + expfile(rest); + + gename(DATAPRE, xsys, 'A', dfile); + + DEBUG(4, "rest %s\n", rest); + + if ((chkpth(User, "", rest) || anyread(rest)) != 0) { + + fprintf(stderr, "permission denied %s\n", rest); + + cleanup(1); + + } + + if (xcp(rest, dfile) != 0) { + + fprintf(stderr, "can't copy %s to %s\n", rest, dfile); + + cleanup(1); + + } + + GENSEND(fpc, rest, dfile, User, dfile); + + cflag++; + + if (redir == '<') { + + fprintf(fprx, "%c %s\n", X_STDIN, dfile); + + fprintf(fprx, "%c %s\n", X_RQDFILE, dfile); + + } + + else { + + APPCMD(lastpart(rest)); + + fprintf(fprx, "%c %s %s\n", X_RQDFILE, + + dfile, lastpart(rest)); + + } + + redir = '\0'; + + continue; + + } + + + + if (strcmp(local, xsys) == SAME) { + + /* generate local receive */ + + gename(CMDPRE, syspart, 'R', tfile); + + strcpy(dfile, tfile); + + dfile[0] = DATAPRE; + + fp = fopen(tfile, "w"); + + ASSERT(fp != NULL, "CAN'T OPEN %s", tfile); + + chmod(tfile, 0666); + + expfile(rest); + + GENRCV(fp, rest, dfile, User); + + fclose(fp); + + rflag++; + + if (rest[0] != '~') + + expfile(rest); + + if (redir == '<') { + + fprintf(fprx, "%c %s\n", X_RQDFILE, dfile); + + fprintf(fprx, "%c %s\n", X_STDIN, dfile); + + } + + else { + + fprintf(fprx, "%c %s %s\n", X_RQDFILE, dfile, + + lastpart(rest)); + + APPCMD(lastpart(rest)); + + } + + + + redir = '\0'; + + continue; + + } + + + + if (strcmp(syspart, xsys) != SAME) { + + /* generate remote receives */ + + gename(DATAPRE, syspart, 'R', dfile); + + strcpy(tfile, dfile); + + tfile[0] = CMDPRE; + + fpd = fopen(dfile, "w"); + + ASSERT(fpd != NULL, "CAN'T OPEN %s", dfile); + + chmod(dfile, 0666); + + gename(DATAPRE, xsys, 'T', t2file); + + GENRCV(fpd, rest, t2file, User); + + fclose(fpd); + + GENSEND(fpc, dfile, tfile, User, dfile); + + cflag++; + + if (redir == '<') { + + fprintf(fprx, "%c %s\n", X_RQDFILE, t2file); + + fprintf(fprx, "%c %s\n", X_STDIN, t2file); + + } + + else { + + fprintf(fprx, "%c %s %s\n", X_RQDFILE, t2file, + + lastpart(rest)); + + APPCMD(lastpart(rest)); + + } + + redir = '\0'; + + continue; + + } + + + + /* file on remote system */ + + if (rest[0] != '~') + + expfile(rest); + + if (redir == '<') + + fprintf(fprx, "%c %s\n", X_STDIN, rest); + + else + + APPCMD(rest); + + redir = '\0'; + + continue; + + + + } + + + + fprintf(fprx, "%c %s\n", X_CMD, cmd); + + fclose(fprx); + + + + strcpy(tfile, rxfile); + + tfile[0] = XQTPRE; + + if (strcmp(xsys, local) == SAME) { + + link(rxfile, tfile); + + unlink(rxfile); + + if (startjob) + + if (rflag) + + xuucico(""); + + else + + xuuxqt(); + + } + + else { + + GENSEND(fpc, rxfile, tfile, User, rxfile); + + cflag++; + + } + + + + fclose(fpc); + + if (cflag) { + + gename(CMDPRE, xsys, 'A', cfile); + + link(tcfile, cfile); + + unlink(tcfile); + + if (startjob) + + xuucico(xsys); + + cleanup(0); + + } + + else + + unlink(tcfile); + +} + + + + + +cleanup(code) + +int code; + +{ + + rmlock(NULL); + + DEBUG(1, "exit code %d\n", code); + + exit(code); + +} diff --cc usr/src/cmd/uudecode.c index 0000000000,0000000000,0000000000..c5625265e0 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/uudecode.c @@@@ -1,0 -1,0 -1,0 +1,181 @@@@ +++static char *sccsid = "@(#)uudecode.c 4.1 (Berkeley) 10/1/80"; +++/* +++ * uudecode [input] +++ * +++ * create the specified file, decoding as you go. +++ * used with uuencode. +++ */ +++#include +++#include +++#include +++#include +++ +++/* single character decode */ +++#define DEC(c) (((c) - ' ') & 077) +++ +++main(argc, argv) +++char **argv; +++{ +++ FILE *in, *out; +++ struct stat sbuf; +++ int mode; +++ char dest[128]; +++ char buf[80]; +++ +++ /* optional input arg */ +++ if (argc > 1) { +++ if ((in = fopen(argv[1], "r")) == NULL) { +++ perror(argv[1]); +++ exit(1); +++ } +++ argv++; argc--; +++ } else +++ in = stdin; +++ +++ if (argc != 1) { +++ printf("Usage: uudecode [infile]\n"); +++ exit(2); +++ } +++ +++ /* search for header line */ +++ for (;;) { +++ if (fgets(buf, sizeof buf, in) == NULL) { +++ fprintf(stderr, "No begin line\n"); +++ exit(3); +++ } +++ if (strncmp(buf, "begin ", 6) == 0) +++ break; +++ } +++ sscanf(buf, "begin %o %s", &mode, dest); +++ +++ /* handle ~user/file format */ +++ if (dest[0] == '~') { +++ char *sl; +++ struct passwd *getpwnam(); +++ char *index(); +++ struct passwd *user; +++ char dnbuf[100]; +++ +++ sl = index(dest, '/'); +++ if (sl == NULL) { +++ fprintf(stderr, "Illegal ~user\n"); +++ exit(3); +++ } +++ *sl++ = 0; +++ user = getpwnam(dest+1); +++ if (user == NULL) { +++ fprintf(stderr, "No such user as %s\n", dest); +++ exit(4); +++ } +++ strcpy(dnbuf, user->pw_dir); +++ strcat(dnbuf, "/"); +++ strcat(dnbuf, sl); +++ strcpy(dest, dnbuf); +++ } +++ +++ /* create output file */ +++ out = fopen(dest, "w"); +++ if (out == NULL) { +++ perror(dest); +++ exit(4); +++ } +++ chmod(dest, mode); +++ +++ decode(in, out); +++ +++ if (fgets(buf, sizeof buf, in) == NULL || strcmp(buf, "end\n")) { +++ fprintf(stderr, "No end line\n"); +++ exit(5); +++ } +++ exit(0); +++} +++ +++/* +++ * copy from in to out, decoding as you go along. +++ */ +++decode(in, out) +++FILE *in; +++FILE *out; +++{ +++ char buf[80]; +++ char *bp; +++ int n; +++ +++ for (;;) { +++ /* for each input line */ +++ if (fgets(buf, sizeof buf, in) == NULL) { +++ printf("Short file\n"); +++ exit(10); +++ } +++ n = DEC(buf[0]); +++ if (n <= 0) +++ break; +++ +++ bp = &buf[1]; +++ while (n > 0) { +++ outdec(bp, out, n); +++ bp += 4; +++ n -= 3; +++ } +++ } +++} +++ +++/* +++ * output a group of 3 bytes (4 input characters). +++ * the input chars are pointed to by p, they are to +++ * be output to file f. n is used to tell us not to +++ * output all of them at the end of the file. +++ */ +++outdec(p, f, n) +++char *p; +++FILE *f; +++{ +++ int c1, c2, c3; +++ +++ c1 = DEC(*p) << 2 | DEC(p[1]) >> 4; +++ c2 = DEC(p[1]) << 4 | DEC(p[2]) >> 2; +++ c3 = DEC(p[2]) << 6 | DEC(p[3]); +++ if (n >= 1) +++ putc(c1, f); +++ if (n >= 2) +++ putc(c2, f); +++ if (n >= 3) +++ putc(c3, f); +++} +++ +++ +++/* fr: like read but stdio */ +++int +++fr(fd, buf, cnt) +++FILE *fd; +++char *buf; +++int cnt; +++{ +++ int c, i; +++ +++ for (i=0; i +++#include +++#include +++ +++/* ENC is the basic 1 character encoding function to make a char printing */ +++#define ENC(c) (((c) & 077) + ' ') +++ +++main(argc, argv) +++char **argv; +++{ +++ FILE *in; +++ struct stat sbuf; +++ int mode; +++ +++ /* optional 1st argument */ +++ if (argc > 2) { +++ if ((in = fopen(argv[1], "r")) == NULL) { +++ perror(argv[1]); +++ exit(1); +++ } +++ argv++; argc--; +++ } else +++ in = stdin; +++ +++ if (argc != 2) { +++ printf("Usage: uuencode [infile] remotefile\n"); +++ exit(2); +++ } +++ +++ /* figure out the input file mode */ +++ fstat(fileno(in), &sbuf); +++ mode = sbuf.st_mode & 0777; +++ printf("begin %o %s\n", mode, argv[1]); +++ +++ encode(in, stdout); +++ +++ printf("end\n"); +++ exit(0); +++} +++ +++/* +++ * copy from in to out, encoding as you go along. +++ */ +++encode(in, out) +++FILE *in; +++FILE *out; +++{ +++ char buf[80]; +++ int i, n; +++ +++ for (;;) { +++ /* 1 (up to) 45 character line */ +++ n = fr(in, buf, 45); +++ putc(ENC(n), out); +++ +++ for (i=0; i> 2; +++ c2 = (*p << 4) & 060 | (p[1] >> 4) & 017; +++ c3 = (p[1] << 2) & 074 | (p[2] >> 6) & 03; +++ c4 = p[2] & 077; +++ putc(ENC(c1), f); +++ putc(ENC(c2), f); +++ putc(ENC(c3), f); +++ putc(ENC(c4), f); +++} +++ +++/* fr: like read but stdio */ +++int +++fr(fd, buf, cnt) +++FILE *fd; +++char *buf; +++int cnt; +++{ +++ int c, i; +++ +++ for (i=0; i +++#include +++#include +++#include +++ +++/* #define DEBUG "/usr/spool/uucp/uusend.log" */ +++ +++FILE *in, *out; +++FILE *dout; +++ +++FILE *popen(); +++char *index(); +++ +++int mode = -1; /* mode to chmod new file to */ +++char nextsys[20]; /* next system in the chain */ +++char dnbuf[200]; /* buffer for result of ~user/file */ +++char cmdbuf[256]; /* buffer to build uux command in */ +++ +++struct passwd *user; /* entry in /etc/passwd for ~user */ +++struct passwd *getpwnam(); +++struct stat stbuf; +++ +++char *excl; /* location of first ! in destname */ +++char *sl; /* location of first / in destname */ +++char *sourcename; /* argv[1] */ +++char *destname; /* argv[2] */ +++ +++main(argc, argv) +++int argc; +++char **argv; +++{ +++ register int c; +++ register int count = 0; +++ +++#ifdef DEBUG +++ long t; +++ dout = fopen(DEBUG, "a"); +++ if (dout == NULL) { +++ printf("Cannot append to %s\n", DEBUG); +++ exit(1); +++ } +++ freopen(DEBUG, "a", stdout); +++ freopen(DEBUG, "a", stderr); +++ chmod(DEBUG, 0666); +++ fprintf(dout, "\nuusend run: "); +++ for (c=0; c 1 && argv[1][0] == '-' && argv[1][1]) { +++ switch(argv[1][1]) { +++ case 'm': +++ sscanf(argv[2], "%o", &mode); +++ argc--; argv++; +++ break; +++ default: +++ fprintf(stderr, "Bad flag: %s\n", argv[1]); +++ break; +++ } +++ argc--; argv++; +++ } +++ +++ if (argc != 3) { +++ fprintf(stderr, "Usage: uusend [-m ooo] -/file sys!sys!..!rfile\n"); +++ exit(1); +++ } +++ +++ sourcename = argv[1]; +++ destname = argv[2]; +++ +++ if (sourcename[0] == '-') +++ in = stdin; +++ else { +++ in = fopen(sourcename, "r"); +++ if (in == NULL) { +++ perror(argv[1]); +++ exit(2); +++ } +++ } +++ +++ excl = index(destname, '!'); +++ if (excl) { +++ /* +++ * destname is on a remote system. +++ */ +++ strncpy(nextsys, destname, excl-destname); +++ nextsys[excl-destname] = 0; +++ destname = excl+1; +++ if (mode < 0) { +++ fstat(fileno(in), &stbuf); +++ mode = stbuf.st_mode & 0777; +++ } +++ sprintf(cmdbuf, "uux - \"%s!uusend -m %o - \(%s\)\"", +++ nextsys, mode, destname); +++#ifdef DEBUG +++ fprintf(dout, "remote: nextsys='%s', destname='%s', cmd='%s'\n", nextsys, destname, cmdbuf); +++#endif +++ out = popen(cmdbuf, "w"); +++ } else { +++ /* +++ * destname is local. +++ */ +++ if (destname[0] == '~') { +++#ifdef DEBUG +++ fprintf(dout, "before ~: '%s'\n", destname); +++#endif +++ sl = index(destname, '/'); +++ if (sl == NULL) { +++ fprintf(stderr, "Illegal ~user\n"); +++ exit(3); +++ } +++ *sl++ = 0; +++ user = getpwnam(destname+1); +++ if (user == NULL) { +++ fprintf(stderr, "No such user as %s\n", destname); +++ exit(4); +++ } +++ strcpy(dnbuf, user->pw_dir); +++ strcat(dnbuf, "/"); +++ strcat(dnbuf, sl); +++ destname = dnbuf; +++ } +++ out = fopen(destname, "w"); +++#ifdef DEBUG +++ fprintf(dout, "local, file='%s'\n", destname); +++#endif +++ if (out == NULL) { +++ perror(destname); +++ exit(5); +++ } +++ if (mode > 0) +++ chmod(destname, mode); /* don't bother to check it */ +++ } +++ +++ /* +++ * Now, in any case, copy from in to out. +++ */ +++ +++ while ((c=getc(in)) != EOF) { +++ putc(c, out); +++ count++; +++ } +++#ifdef DEBUG +++ fprintf(dout, "count %d bytes\n", count); +++ fclose(dout); +++#endif +++ +++ fclose(in); +++ fclose(out); /* really should pclose in that case */ +++ exit(0); +++} +++ +++/* +++ * Return the ptr in sp at which the character c appears; +++ * NULL if not found. Included so I don't have to fight the +++ * index/strchr battle. +++ */ +++ +++#define NULL 0 +++ +++char * +++index(sp, c) +++register char *sp, c; +++{ +++ do { +++ if (*sp == c) +++ return(sp); +++ } while (*sp++); +++ return(NULL); +++} diff --cc usr/src/cmd/vfontinfo.c index 0000000000,0000000000,0000000000..a4ae623a3e new file mode 100644 --- /dev/null +++ b/usr/src/cmd/vfontinfo.c @@@@ -1,0 -1,0 -1,0 +1,140 @@@@ +++static char *sccsid = "@(#)vfontinfo.c 4.1 (Berkeley) 10/1/80"; +++/* Font Information for VCat-style fonts +++ * AJH 4/79 +++ * +++ * Modified to print Ascii chars 1/80 by Mark Horton +++ */ +++#include +++#include +++#include +++ +++struct header FontHeader; +++struct dispatch disptable[256] ; +++ +++char IName[100]; +++char * rdchar(); +++long fbase; +++ +++char defascii[256]; +++char *charswanted = defascii; +++int verbose; +++char charbits[4000]; +++int H, W, WB; +++ +++main(argc,argv) +++int argc; +++char **argv; +++ +++{ +++ int FID,i,j; +++ +++ if (argc > 1 && argv[1][0] == '-') { +++ switch(argv[1][1]) { +++ case 'v': +++ verbose++; +++ break; +++ default: +++ printf("Bad flag: %s\n", argv[1]); +++ } +++ argc--; argv++; +++ } +++ if (argc < 2) { +++ fprintf(stderr,"Usage: %s filename", argv[0]); +++ exit(2); +++ } +++ +++ for (i=0; i<128; i++) +++ defascii[i] = i; +++ if (argc >= 3) +++ charswanted = argv[2]; +++ +++ sprintf(IName,"/usr/lib/vfont/%s",argv[1]); +++ if ((FID = open(argv[1],0)) < 0) +++ if ((FID = open(IName,0)) < 0) { +++ printf("Can't find %s\n",argv[1]); +++ exit(8); +++ }; +++ +++ if (read(FID,&FontHeader,sizeof FontHeader) != sizeof FontHeader) +++ error("Bad header in Font file."); +++ +++ if (read(FID,&disptable[0],sizeof disptable) != sizeof disptable) +++ error("Bad dispatch table in Font file"); +++ +++ fbase = sizeof FontHeader + sizeof disptable; +++ +++ if (FontHeader.magic != 0436) +++ printf("Magic number %o wrong\n", FontHeader.magic); +++ printf("Font %s, ",argv[1]); +++ printf("raster size %d, ",FontHeader.size); +++ printf("max width %d, max height %d, xtend %d\n", +++ FontHeader.maxx, FontHeader.maxy,FontHeader.xtend); +++ printf("\n ASCII offset size left right up down width \n"); +++ +++ for (i=0; i<256; i++) { +++ j = charswanted[i]; +++ if (i>0 && j==0) +++ break; +++ if (disptable[j].nbytes != 0) { +++ printf(" %3o %2s %4d %4d %4d %4d %4d %4d %5d\n", +++ j, rdchar(j), +++ disptable[j].addr, +++ disptable[j].nbytes, +++ disptable[j].left, +++ disptable[j].right, +++ disptable[j].up, +++ disptable[j].down, +++ disptable[j].width); +++ if (verbose) { +++ int len = disptable[j].nbytes; +++ int k, l, last; +++ +++ lseek(FID, fbase+disptable[j].addr, 0); +++ read(FID, charbits, len); +++ H = (disptable[j].up) + (disptable[j].down); +++ W = (disptable[j].left) + (disptable[j].right); +++ WB = (W+7)/8; +++ for (k=0; k= 0; last--) +++ if (fbit(k, last)) +++ break; +++ for (l=0; l<=last; l++) { +++ printf("%c", fbit(k,l)?'M':' '); +++ } +++ printf("\n"); +++ } +++ printf("\n"); +++ } +++ } +++ }; +++} +++ +++error(string) +++char *string; +++ +++{ +++ printf("\nvfontinfo: %s\n",string); +++ exit(8); +++}; +++ +++char *rdchar(c) +++char c; +++{ +++ static char ret[3]; +++ ret[0] = isprint(c) ? ' ' : '^'; +++ ret[1] = isprint(c) ? c : c^0100; +++ ret[2] = 0; +++ return (ret); +++} +++ +++int +++fbit(row, col) +++int row, col; +++{ +++ int thisbyte, thisbit, ret; +++ +++ thisbyte = charbits[row*WB + (col>>3)] & 0xff; +++ thisbit = 0x80 >> (col&7); +++ ret = thisbyte & thisbit; +++ return (ret != 0); +++} diff --cc usr/src/cmd/vmstat.c index 0000000000,0d5244f550,0000000000..f4d245d552 mode 000000,100644,000000..100644 --- a/usr/src/cmd/vmstat.c +++ b/usr/src/cmd/vmstat.c @@@@ -1,0 -1,287 -1,0 +1,325 @@@@ +++static char *sccsid = "@(#)vmstat.c 4.2 (Berkeley) 10/15/80"; + +#include + +#include + +#include +++#include +++#include + + - struct - { - char name[8]; - int type; - unsigned value; - } nl[] = { - "_dk_busy", 0, 0, - "_dk_time", 0, 0, - "_dk_numb", 0, 0, - "_rate", 0, 0, - "_total", 0, 0, - "_deficit", 0, 0, - #define X_FORKSTAT 6 - "_forksta", 0, 0, - #define X_SUM 7 - "_sum", 0, 0, - #define X_FIRSTFREE 8 - "_firstfr", 0, 0, - #define X_MAXFREE 9 - "_maxfree", 0, 0, +++struct nlist nl[] = { +++#define X_CPTIME 0 +++ { "_cp_time" }, +++#define X_RATE 1 +++ { "_rate" }, +++#define X_TOTAL 2 +++ { "_total" }, +++#define X_DEFICIT 3 +++ { "_deficit" }, +++#define X_FORKSTAT 4 +++ { "_forkstat" }, +++#define X_SUM 5 +++ { "_sum" }, +++#define X_FIRSTFREE 6 +++ { "_firstfree" }, +++#define X_MAXFREE 7 +++ { "_maxfree" }, +++#define X_BOOTIME 8 +++ { "_bootime" }, +++#define X_DKXFER 9 +++ { "_dk_xfer" }, + +#ifdef ERNIE + +#define X_REC 10 - "_rectime", 0, 0, +++ { "_rectime" }, + +#define X_PGIN 11 - "_pgintim", 0, 0, +++ { "_pgintime" }, + +#endif - "\0\0\0\0\0\0\0\0", 0, 0 +++ { 0 }, + +}; + + +++double stat1(); + +int firstfree, maxfree; - char version[128]; + +struct + +{ + + int busy; - long etime[32]; - long numb[3]; +++ long time[CPUSTATES]; +++ long xfer[DK_NDRIVE]; + + struct vmmeter Rate; + + struct vmtotal Total; + + struct vmmeter Sum; + + struct forkstat Forkstat; + +#ifdef ERNIE + + unsigned rectime; + + unsigned pgintime; + +#endif + +} s, s1, z; + +#define rate s.Rate + +#define total s.Total + +#define sum s.Sum + +#define forkstat s.Forkstat + + +++int iflag = 1; + +int zero; + +int deficit; + +double etime; + +int mf; + + + +main(argc, argv) + +char **argv; + +{ +++ time_t now; + + int lines; + + extern char *ctime(); - register i; - int iter; +++ register i,j; +++ int iter, nintv; +++ time_t bootime; + + double f1, f2; + + long t; + + extern char _sobuf[]; + + + + setbuf(stdout, _sobuf); + + nlist("/vmunix", nl); - if(nl[0].type == -1) { +++ if(nl[0].n_type == 0) { + + printf("no /vmunix namelist\n"); + + exit(1); + + } + + mf = open("/dev/kmem", 0); + + if(mf < 0) { + + printf("cannot open /dev/kmem\n"); + + exit(1); + + } + + iter = 0; + + argc--, argv++; + + while (argc>0 && argv[0][0]=='-') { + + char *cp = *argv++; + + argc--; + + while (*++cp) switch (*cp) { + + + +#ifdef ERNIE + + case 't': + + dotimes(); + + exit(0); + +#endif + + case 'z': + + close(mf); + + mf = open("/dev/kmem", 2); - lseek(mf, (long)nl[X_SUM].value, 0); +++ lseek(mf, (long)nl[X_SUM].n_value, 0); + + write(mf, &z.Sum, sizeof z.Sum); + + exit(0); + + + + case 'f': + + doforkst(); + + exit(0); + + + + case 's': + + dosum(); + + exit(0); + + +++ case 'i': +++ iflag = 0; +++ break; +++ + + default: + + fprintf(stderr, "usage: vmstat [ -fs ] [ interval ] [ count]\n"); + + exit(1); + + } + + } + + if(argc > 1) + + iter = atoi(argv[1]); - lseek(mf, (long)nl[X_FIRSTFREE].value, 0); +++ lseek(mf, (long)nl[X_FIRSTFREE].n_value, 0); + + read(mf, &firstfree, sizeof firstfree); - lseek(mf, (long)nl[X_MAXFREE].value, 0); +++ lseek(mf, (long)nl[X_MAXFREE].n_value, 0); + + read(mf, &maxfree, sizeof maxfree); +++ lseek(mf, (long)nl[X_BOOTIME].n_value, 0); +++ read(mf, &bootime, sizeof bootime); +++ time(&now); +++ nintv = now - bootime; +++ if (nintv <= 0 || nintv > 60*60*24*365*10) { +++ printf("Time makes no sense... namelist must be wrong.\n"); +++ exit(1); +++ } + +reprint: + + lines = 20; + + /* s1 = z; */ +++ if (iflag==0) + +printf("\ - Procs Virtual Real Page Swap Disk Cpu\n\ - RQ DW PW SL SW AVM TX FRE RE PI PO FR DE SR I O D0 D1 D2 CS US NI SY ID\n\ +++ Procs Virtual Real Page Swap Disk Cpu\n\ +++RQ DW PW SW AVM TX FRE RE AT PI PO FR DE SR I O D0 D1 D2 D3 CS US SY ID\n\ +++"); +++ else +++printf("\ +++ Procs Memory Page Swap Disk Faults Cpu\n\ +++ R B W AVM FRE RE AT PI PO FR DE SR I O D0 D1 D2 D3 IN SY CS US SY ID\n\ + +"); + +loop: - lseek(mf, (long)nl[0].value, 0); - read(mf, &s.busy, sizeof s.busy); - lseek(mf, (long)nl[1].value, 0); - read(mf, s.etime, sizeof s.etime); - lseek(mf, (long)nl[2].value, 0); - read(mf, s.numb, sizeof s.numb); - lseek(mf, (long)nl[3].value, 0); - read(mf, &rate, sizeof rate); - lseek(mf, (long)nl[4].value, 0); +++ lseek(mf, (long)nl[X_CPTIME].n_value, 0); +++ read(mf, s.time, sizeof s.time); +++ lseek(mf, (long)nl[X_DKXFER].n_value, 0); +++ read(mf, s.xfer, sizeof s.xfer); +++ if (nintv != 1) { +++ lseek(mf, (long)nl[X_SUM].n_value, 0); +++ read(mf, &rate, sizeof rate); +++ } else { +++ lseek(mf, (long)nl[X_RATE].n_value, 0); +++ read(mf, &rate, sizeof rate); +++ } +++ lseek(mf, (long)nl[X_TOTAL].n_value, 0); + + read(mf, &total, sizeof total); - lseek(mf, (long)nl[5].value, 0); +++ lseek(mf, (long)nl[X_DEFICIT].n_value, 0); + + read(mf, &deficit, sizeof deficit); - for(i=0; i<35; i++) { - t = s.etime[i]; - s.etime[i] -= s1.etime[i]; - s1.etime[i] = t; +++ etime = 0; +++ for (i=0; i < DK_NDRIVE; i++) { +++ t = s.xfer[i]; +++ s.xfer[i] -= s1.xfer[i]; +++ s1.xfer[i] = t; +++ } +++ for (i=0; i < CPUSTATES; i++) { +++ t = s.time[i]; +++ s.time[i] -= s1.time[i]; +++ s1.time[i] = t; +++ etime += s.time[i]; + + } - t = 0; - for(i=0; i<32; i++) - t += s.etime[i]; - etime = t; + + if(etime == 0.) + + etime = 1.; - /* - Procs Virtual Real Page Swap Disk Cpu - RQ DW PW SL SW AVM TX FRE RE PI PO FR DE SR I O D0 D1 D2 CS US NI SY ID - */ - printf("%2d%3d%3d%3d%3d", total.t_rq, total.t_dw, total.t_pw, - total.t_sl, total.t_sw); - printf("%6d%3d%5d", total.t_avm, pct(total.t_avmtxt, total.t_avm), - total.t_free); - printf("%4d%3d", rate.v_pgrec, rate.v_pgin); - printf("%3d%3d%4d%4.1f%2d%2d", - rate.v_pgout, rate.v_dfree, deficit, - (60.0 * rate.v_scan) / LOOPSIZ, - rate.v_swpin, rate.v_swpout); +++ if (iflag) +++ printf("%2d%2d%2d", total.t_rq, total.t_dw+total.t_pw, +++ total.t_sw); +++ else +++ printf("%2d%3d%3d%3d%3d", total.t_rq, total.t_dw, total.t_pw, +++ total.t_sw); +++ if (iflag) +++ printf("%6d%5d", total.t_avm/2, total.t_free/2); +++ else +++ printf("%6d%3d%5d", total.t_avm/2, +++ pct(total.t_avmtxt, total.t_avm), total.t_free/2); +++ printf("%4d%3d%3d", +++ (rate.v_pgrec - (rate.v_xsfrec+rate.v_xifrec))/nintv, +++ (rate.v_xsfrec+rate.v_xifrec)/nintv, rate.v_pgin/nintv); +++ printf("%3d%3d%4d%4.1f%2d%2d", rate.v_pgout/nintv, +++ rate.v_dfree/nintv, deficit/2, +++ (60.0 * rate.v_scan) / (LOOPSIZ*nintv), +++ rate.v_swpin/nintv, rate.v_swpout/nintv); + + etime /= 60.; + + printf(" "); - for(i=0; i<3; i++) - stats(i); - printf("%4d", rate.v_swtch); + + for(i=0; i<4; i++) - stat1(i*8); +++ stats(i); +++ if (iflag) +++ printf("%4d%4d", (rate.v_intr/nintv) - HZ, +++ rate.v_syscall/nintv); +++ printf("%4d", rate.v_swtch/nintv); +++ for(i=0; i 0) { + + sleep(atoi(argv[0])); + + if (--lines <= 0) + + goto reprint; + + goto loop; + + } + +} + + + +#ifdef ERNIE + +dotimes() + +{ + + - lseek(mf, (long)nl[X_REC].value, 0); +++ lseek(mf, (long)nl[X_REC].n_value, 0); + + read(mf, &s.rectime, sizeof s.rectime); - lseek(mf, (long)nl[X_PGIN].value, 0); +++ lseek(mf, (long)nl[X_PGIN].n_value, 0); + + read(mf, &s.pgintime, sizeof s.pgintime); - lseek(mf, (long)nl[X_SUM].value, 0); +++ lseek(mf, (long)nl[X_SUM].n_value, 0); + + read(mf, &sum, sizeof sum); + + printf("%d reclaims, %d total time (usec)\n", sum.v_pgrec, s.rectime); + + printf("average: %d usec / reclaim\n", s.rectime/sum.v_pgrec); + + printf("\n"); + + printf("%d page ins, %d total time (msec)\n",sum.v_pgin, s.pgintime/10); + + printf("average: %8.1f msec / page in\n", s.pgintime/(sum.v_pgin*10.0)); + +} + +#endif + + + +dosum() + +{ + + - lseek(mf, (long)nl[X_SUM].value, 0); +++ lseek(mf, (long)nl[X_SUM].n_value, 0); + + read(mf, &sum, sizeof sum); - printf("%8d swap ins\n", sum.v_swpin); - printf("%8d swap outs\n", sum.v_swpout); - printf("%8d pages swapped in\n", sum.v_pswpin); - printf("%8d pages swapped out\n", sum.v_pswpout); - printf("%8d total address trans. faults taken\n", sum.v_faults); - printf("%8d page ins\n", sum.v_pgin); - printf("%8d page outs\n", sum.v_pgout); - printf("%8d total reclaims\n", sum.v_pgrec); - printf("%8d reclaims from free list\n", sum.v_pgfrec); - printf("%8d intransit blocking page faults\n", sum.v_intrans); - printf("%8d zero fill on demand page faults\n", sum.v_zfod / CLSIZE); - printf("%8d total zero fill pages created\n", sum.v_nzfod); - printf("%8d executable fill on demand page faults\n", sum.v_exfod / CLSIZE); - printf("%8d total executable fill pages created\n", sum.v_nexfod); - printf("%8d file fill on demand page faults\n", sum.v_vrfod / CLSIZE); - printf("%8d total pages set up for fill on demand with vread\n", sum.v_nvrfod); - printf("%8d pages examined by the clock daemon\n", sum.v_scan); - printf("%8d revolutions of the clock hand\n", sum.v_rev); - printf("%8d pages freed by the clock daemon\n", sum.v_dfree); - printf("%8d cpu context switches\n", sum.v_swtch); +++ printf("%9d swap ins\n", sum.v_swpin); +++ printf("%9d swap outs\n", sum.v_swpout); +++ printf("%9d pages swapped in\n", sum.v_pswpin / CLSIZE); +++ printf("%9d pages swapped out\n", sum.v_pswpout / CLSIZE); +++ printf("%9d total address trans. faults taken\n", sum.v_faults); +++ printf("%9d page ins\n", sum.v_pgin); +++ printf("%9d page outs\n", sum.v_pgout); +++ printf("%9d total reclaims\n", sum.v_pgrec); +++ printf("%9d reclaims from free list\n", sum.v_pgfrec); +++ printf("%9d intransit blocking page faults\n", sum.v_intrans); +++ printf("%9d zero fill pages created\n", sum.v_nzfod / CLSIZE); +++ printf("%9d zero fill page faults\n", sum.v_zfod / CLSIZE); +++ printf("%9d executable fill pages created\n", sum.v_nexfod / CLSIZE); +++ printf("%9d executable fill page faults\n", sum.v_exfod / CLSIZE); +++ printf("%9d swap text pages found in free list\n", sum.v_xsfrec); +++ printf("%9d inode text pages found in free list\n", sum.v_xifrec); +++ printf("%9d file fill pages created\n", sum.v_nvrfod / CLSIZE); +++ printf("%9d file fill page faults\n", sum.v_vrfod / CLSIZE); +++ printf("%9d pages examined by the clock daemon\n", sum.v_scan); +++ printf("%9d revolutions of the clock hand\n", sum.v_rev); +++ printf("%9d pages freed by the clock daemon\n", sum.v_dfree / CLSIZE); +++ printf("%9d cpu context switches\n", sum.v_swtch); +++ printf("%9d device interrupts\n", sum.v_intr); +++ printf("%9d pseduo-dma dz interrupts\n", sum.v_pdma); +++ printf("%9d traps\n", sum.v_trap); +++ printf("%9d system calls\n", sum.v_syscall); + +} + + + + + +doforkst() + +{ + + - lseek(mf, (long)nl[X_FORKSTAT].value, 0); +++ lseek(mf, (long)nl[X_FORKSTAT].n_value, 0); + + read(mf, &forkstat, sizeof forkstat); + + printf("%d forks, %d pages, average=%.2f\n", + + forkstat.cntfork, forkstat.sizfork, + + (float) forkstat.sizfork / forkstat.cntfork); + + printf("%d vforks, %d pages, average=%.2f\n", + + forkstat.cntvfork, forkstat.sizvfork, + + (float)forkstat.sizvfork / forkstat.cntvfork); + +} + + + +stats(dn) + +{ - register i; - double f1, f2; - long t; + + - t = 0; - for(i=0; i<32; i++) - if(i & (1<= DK_NDRIVE) { +++ printf(" 0"); + + return; + + } - printf("%3.0f", f2/etime); +++ printf("%3.0f", s.xfer[dn]/etime); + +} + + - stat1(o) +++double +++stat1(row) + +{ +++ double t; + + register i; - long t; - double f1, f2; + + + + t = 0; - for(i=0; i<32; i++) - t += s.etime[i]; - f1 = t; - if(f1 == 0.) - f1 = 1.; - t = 0; - for(i=0; i<8; i++) - t += s.etime[o+i]; - f2 = t; - printf("%3.0f", f2*100./f1); +++ for(i=0; i - #include +++#include + +#include +++#include + +#include - #include + +#include + +#include - #include + +#include + +#include +++#include + +#include + +#include + + +++#define NMAX sizeof(utmp.ut_name) +++#define LMAX sizeof(utmp.ut_line) +++ + +#define ARGWIDTH 33 /* # chars left on 80 col crt for args */ + + + +struct smproc { +++ short w_pid; /* proc.p_pid */ + + char w_flag; /* proc.p_flag */ + + short w_size; /* proc.p_size */ + + long w_seekaddr; /* where to find args */ + + long w_lastpg; /* disk address of stack */ - int w_igintr; /* true if ignores INTR and QUIT */ +++ int w_igintr; /* INTR+3*QUIT, 0=die, 1=ign, 2=catch */ + + time_t w_time; /* CPU time used by this process */ + + time_t w_ctime; /* CPU time used by children */ + + dev_t w_tty; /* tty device of process */ + + char w_comm[15]; /* user.u_comm, null terminated */ + + char w_args[ARGWIDTH+1]; /* args if interesting process */ + +} pr[NPROC]; + + + +struct nlist nl[] = { + + { "_proc" }, + +#define X_PROC 0 + + { "_swapdev" }, + +#define X_SWAPDEV 1 - { "_swplo" }, - #define X_SWPLO 2 - { "_Usrptma" }, - #define X_USRPTMA 3 +++ { "_Usrptmap" }, +++#define X_USRPTMA 2 + + { "_usrpt" }, - #define X_USRPT 4 +++#define X_USRPT 3 + + { "_nswap" }, - #define X_NSWAP 5 +++#define X_NSWAP 4 + + { "_avenrun" }, - #define X_AVENRUN 6 +++#define X_AVENRUN 5 + + { "_bootime" }, - #define X_BOOTIME 7 +++#define X_BOOTIME 6 + + { 0 }, + +}; + + + +FILE *ps; + +FILE *ut; + +FILE *bootfd; + +int kmem; + +int mem; + +int swap; /* /dev/kmem, mem, and swap */ + +int nswap; + +dev_t tty; + +char doing[520]; /* process attached to terminal */ + +time_t proctime; /* cpu time of process in doing */ + +double avenrun[3]; + + + +#define DIV60(t) ((t+30)/60) /* x/60 rounded */ + +#define TTYEQ (tty == pr[i].w_tty) +++#define IGINT (1+3*1) /* ignoring both SIGINT & SIGQUIT */ + + + +char *getargs(); + +char *fread(); + +char *ctime(); +++char *rindex(); + +FILE *popen(); + +struct tm *localtime(); + + + +int debug; /* true if -d flag: debugging output */ + +int header = 1; /* true if -h flag: don't print heading */ + +int lflag = 1; /* true if -l flag: long style output */ + +int login; /* true if invoked as login shell */ + +int idle; /* number of minutes user is idle */ +++int nusers; /* number of users logged in now */ +++char * sel_user; /* login of particular user selected */ +++char firstchar; /* first char of name of prog invoked as */ + +time_t jobtime; /* total cpu time visible */ + +time_t now; /* the current time of day */ + +struct tm *nowt; /* current time as time struct */ + +time_t bootime, uptime; /* time of last reboot & elapsed time since */ + +int np; /* number of processes currently active */ + +struct utmp utmp; + +struct proc mproc; + +struct user up; + +char fill[512]; + + + +main(argc, argv) + + char **argv; + +{ - int days; - register int i; - int empty; +++ int days, hrs, mins; +++ register int i, j; +++ char *cp; +++ register int curpid, empty; + + char obuf[BUFSIZ]; + + + + setbuf(stdout, obuf); + + login = (argv[0][0] == '-'); +++ cp = rindex(argv[0], '/'); +++ firstchar = login ? argv[0][1] : (cp==0) ? argv[0][0] : cp[1]; +++ cp = argv[0]; /* for Usage */ +++ + + while (argc > 1) { + + if (argv[1][0] == '-') { + + for (i=1; argv[1][i]; i++) { + + switch(argv[1][i]) { + + + + case 'd': + + debug++; + + break; + + + + case 'h': + + header = 0; + + break; + + + + case 'l': + + lflag++; + + break; +++ + + case 's': + + lflag = 0; + + break; + + +++ case 'u': +++ case 'w': +++ firstchar = argv[1][1]; +++ break; +++ + + default: + + printf("Bad flag %s\n", argv[1]); + + exit(1); + + } + + } - argc--; argv++; + + } else { - printf("Usage: %s [ -lh ]\n", argv[0]); - exit(1); +++ if (!isalnum(argv[1][0]) || argc > 2) { +++ printf("Usage: %s [ -hlsuw ] [ user ]\n", cp); +++ exit(1); +++ } else +++ sel_user = argv[1]; + + } +++ argc--; argv++; + + } + + - readpr(); +++ if ((kmem = open("/dev/kmem", 0)) < 0) { +++ fprintf(stderr, "No kmem\n"); +++ exit(1); +++ } +++ nlist("/vmunix", nl); +++ if (nl[0].n_type==0) { +++ fprintf(stderr, "No namelist\n"); +++ exit(1); +++ } +++ +++ if (firstchar != 'u') +++ readpr(); + + + + ut = fopen("/etc/utmp","r"); + + if (header) { +++ /* Print time of day */ + + time(&now); + + nowt = localtime(&now); + + prtat(nowt); +++ +++ /* +++ * Print how long system has been up. +++ * (Found by looking for "bootime" in kernel) +++ */ + + lseek(kmem, (long)nl[X_BOOTIME].n_value, 0); + + read(kmem, &bootime, sizeof (bootime)); +++ + + uptime = now - bootime; - printf(" up"); + + days = uptime / (60*60*24); - if (days > 0) { - printf(" %d day%s, ", days, days>1?"s":""); - uptime %= (60*60*24); +++ uptime %= (60*60*24); +++ hrs = uptime / (60*60); +++ uptime %= (60*60); +++ mins = DIV60(uptime); +++ +++ printf(" up"); +++ if (days > 0) +++ printf(" %d day%s,", days, days>1?"s":""); +++ if (hrs > 0 && mins > 0) { +++ printf(" %2d:%02d,", hrs, mins); +++ } else { +++ if (hrs > 0) +++ printf(" %d hr%s,", hrs, hrs>1?"s":""); +++ if (mins > 0) +++ printf(" %d min%s,", mins, mins>1?"s":""); +++ } +++ +++ /* Print number of users logged in to system */ +++ while (fread(&utmp, sizeof(utmp), 1, ut)) { +++ if (utmp.ut_name[0] != '\0') +++ nusers++; + + } - prttime(DIV60(uptime), ""); - printf("\t\t"); - printf("load average:"); +++ rewind(ut); +++ printf(" %d users", nusers); +++ +++ /* +++ * Print 1, 5, and 15 minute load averages. +++ * (Found by looking in kernel for avenrun). +++ */ +++ printf(", load average:"); + + lseek(kmem, (long)nl[X_AVENRUN].n_value, 0); + + read(kmem, avenrun, sizeof(avenrun)); - for (i = 0; i < 3; i++) { - printf(" %.2f", avenrun[i]); - if (i < 2) +++ for (i = 0; i < (sizeof(avenrun)/sizeof(avenrun[0])); i++) { +++ if (i > 0) + + printf(","); +++ printf(" %.2f", avenrun[i]); + + } + + printf("\n"); +++ if (firstchar == 'u') +++ exit(0); +++ +++ /* Headers for rest of output */ + + if (lflag) + + printf("User tty login@ idle JCPU PCPU what\n"); + + else + + printf("User tty idle what\n"); + + fflush(stdout); + + } +++ +++ + + for (;;) { /* for each entry in utmp */ + + if (fread(&utmp, sizeof(utmp), 1, ut) == NULL) { + + fclose(ut); + + exit(0); + + } + + if (utmp.ut_name[0] == '\0') + + continue; /* that tty is free */ +++ if (sel_user && strcmpn(utmp.ut_name, sel_user, NMAX) != 0) +++ continue; /* we wanted only somebody else */ +++ + + gettty(); + + jobtime = 0; + + proctime = 0; + + strcpy(doing, "-"); /* default act: normally never prints */ + + empty = 1; +++ curpid = -1; + + idle = findidle(); + + for (i=0; i 0) +++ if (j==IGINT) +++ printf(" &"); +++ else +++ printf(" & %d %d", j%3, j/3); +++ printf("\n"); +++ } +++ if (empty && pr[i].w_igintr!=IGINT) { +++ empty = 0; +++ curpid = -1; +++ } +++ if(pr[i].w_pid>curpid && (pr[i].w_igintr!=IGINT || empty)){ +++ curpid = pr[i].w_pid; + + strcpy(doing, lflag ? pr[i].w_args : pr[i].w_comm); +++#ifdef notdef + + if (doing[0]==0 || doing[0]=='-' && doing[1]<=' ' || doing[0] == '?') { + + strcat(doing, " ("); + + strcat(doing, pr[i].w_comm); + + strcat(doing, ")"); + + } +++#endif + + } + + } + + putline(); + + } + +} + + + +/* figure out the major/minor device # pair for this tty */ + +gettty() + +{ + + char ttybuf[20]; + + struct stat statbuf; + + + + ttybuf[0] = 0; + + strcpy(ttybuf, "/dev/"); + + strcat(ttybuf, utmp.ut_line); + + stat(ttybuf, &statbuf); + + tty = statbuf.st_rdev; + +} + + + +/* + + * putline: print out the accumulated line of info about one user. + + */ + +putline() + +{ + + register int tm; + + + + /* print login name of the user */ - printf("%-8.8s ", utmp.ut_name); +++ printf("%-*.*s ", NMAX, NMAX, utmp.ut_name); + + + + /* print tty user is on */ + + if (lflag) - /* long form: all (up to) 8 chars */ - printf("%-8.8s", utmp.ut_line); +++ /* long form: all (up to) LMAX chars */ +++ printf("%-*.*s", LMAX, LMAX, utmp.ut_line); + + else { + + /* short form: 2 chars, skipping 'tty' if there */ + + if (utmp.ut_line[0]=='t' && utmp.ut_line[1]=='t' && utmp.ut_line[2]=='y') + + printf("%-2.2s", &utmp.ut_line[3]); + + else + + printf("%-2.2s", utmp.ut_line); + + } + + + + if (lflag) + + /* print when the user logged in */ + + prtat(localtime(&utmp.ut_time)); + + + + /* print idle time */ + + prttime(idle," "); + + + + if (lflag) { + + /* print CPU time for all processes & children */ + + prttime(DIV60(jobtime)," "); + + /* print cpu time for interesting process */ + + prttime(DIV60(proctime)," "); + + } + + + + /* what user is doing, either command tail or args */ + + printf(" %-.32s\n",doing); + + fflush(stdout); + +} + + + +/* find & return number of minutes current tty has been idle */ + +findidle() + +{ + + struct stat stbuf; + + long lastaction, diff; + + char ttyname[20]; + + + + strcpy(ttyname, "/dev/"); - strcatn(ttyname, utmp.ut_line, 8); +++ strcatn(ttyname, utmp.ut_line, LMAX); + + stat(ttyname, &stbuf); + + time(&now); + + lastaction = stbuf.st_atime; + + diff = now - lastaction; + + diff = DIV60(diff); + + if (diff < 0) diff = 0; + + return(diff); + +} + + + +/* + + * prttime prints a time in hours and minutes. + + * The character string tail is printed at the end, obvious + + * strings to pass are "", " ", or "am". + + */ + +prttime(tim, tail) + + time_t tim; + + char *tail; + +{ + + register int didhrs = 0; + + + + if (tim >= 60) { + + printf("%3d:", tim/60); + + didhrs++; + + } else { + + printf(" "); + + } + + tim %= 60; + + if (tim > 0 || didhrs) { + + printf(didhrs&&tim<10 ? "%02d" : "%2d", tim); + + } else { + + printf(" "); + + } + + printf("%s", tail); + +} + + + +/* prtat prints a 12 hour time given a pointer to a time of day */ + +prtat(p) + + struct tm *p; + +{ + + register int t, pm; + + + + t = p -> tm_hour; + + pm = (t > 11); + + if (t > 11) + + t -= 12; + + if (t == 0) + + t = 12; + + prttime(t*60 + p->tm_min, pm ? "pm" : "am"); + +} + + + +/* + + * readpr finds and reads in the array pr, containing the interesting + + * parts of the proc and user tables for each live process. + + */ + +readpr() + +{ + + int pn, mf, addr, c; + + int szpt, pfnum, i; + + struct pte *Usrptma, *usrpt, *pte, apte; - daddr_t swplo; + + struct dblock db; + + - nlist("/vmunix", nl); - if (nl[0].n_type==0) { - fprintf(stderr, "No namelist\n"); - exit(1); - } + + Usrptma = (struct pte *) nl[X_USRPTMA].n_value; + + usrpt = (struct pte *) nl[X_USRPT].n_value; - if ((kmem = open("/dev/kmem", 0)) < 0) { - fprintf(stderr, "No kmem\n"); - exit(1); - } + + if((mem = open("/dev/mem", 0)) < 0) { + + fprintf(stderr, "No mem\n"); + + exit(1); + + } + + if ((swap = open("/dev/drum", 0)) < 0) { + + fprintf(stderr, "No drum\n"); + + exit(1); + + } + + /* + + * read mem to find swap dev. + + */ + + lseek(kmem, (long)nl[X_SWAPDEV].n_value, 0); + + read(kmem, &nl[X_SWAPDEV].n_value, sizeof(nl[X_SWAPDEV].n_value)); + + /* + + * Find base of swap + + */ - lseek(kmem, (long)nl[X_SWPLO].n_value, 0); - read(kmem, &swplo, sizeof(swplo)); + + lseek(kmem, (long)nl[X_NSWAP].n_value, 0); + + read(kmem, &nswap, sizeof(nswap)); + + /* + + * Locate proc table + + */ + + np = 0; + + for (pn=0; pn1) + 3*((int)up.u_signal[3]==1)) + 6*((int)up.u_signal[3]>1); +++ pr[np].w_time = up.u_vm.vm_utime + up.u_vm.vm_stime; +++ pr[np].w_ctime = up.u_cvm.vm_utime + up.u_cvm.vm_stime; + + pr[np].w_tty = up.u_ttyd; + + up.u_comm[14] = 0; /* Bug: This bombs next field. */ + + strcpy(pr[np].w_comm, up.u_comm); - if (pr[np].w_igintr == 0) { - /* - * Get args if there's a chance we'll print it. - * Cant just save pointer: getargs returns static place. - * Cant use strcpyn: that crock blank pads. - */ - pr[np].w_args[0] = 0; - strcatn(pr[np].w_args,getargs(&pr[np]),ARGWIDTH); +++ /* +++ * Get args if there's a chance we'll print it. +++ * Cant just save pointer: getargs returns static place. +++ * Cant use strcpyn: that crock blank pads. +++ */ +++ pr[np].w_args[0] = 0; +++ strcatn(pr[np].w_args,getargs(&pr[np]),ARGWIDTH); +++ if (pr[np].w_args[0]==0 || pr[np].w_args[0]=='-' && pr[np].w_args[1]<=' ' || pr[np].w_args[0] == '?') { +++ strcat(pr[np].w_args, " ("); +++ strcat(pr[np].w_args, pr[np].w_comm); +++ strcat(pr[np].w_args, ")"); + + } + + np++; + + } + +} + + + +/* + + * getargs: given a pointer to a proc structure, this looks at the swap area + + * and tries to reconstruct the arguments. This is straight out of ps. + + */ + +char * + +getargs(p) + + struct smproc *p; + +{ + + int c, addr, nbad; + + static int abuf[512/sizeof(int)]; + + struct pte pagetbl[NPTEPG]; + + register int *ip; + + register char *cp, *cp1; + + + + if ((p->w_flag & SLOAD) == 0) { + + lseek(swap, p->w_lastpg, 0); + + if (read(swap, abuf, sizeof(abuf)) != sizeof(abuf)) + + return(p->w_comm); + + } else { + + c = p->w_seekaddr; + + lseek(mem,c,0); + + if (read(mem,pagetbl,NBPG) != NBPG) + + return(p->w_comm); - if (pagetbl[NPTEPG-1].pg_fod==0 && pagetbl[NPTEPG-1].pg_pfnum) { - lseek(mem,ctob(pagetbl[NPTEPG-1].pg_pfnum),0); +++ if (pagetbl[NPTEPG-1-UPAGES].pg_fod==0 && pagetbl[NPTEPG-1-UPAGES].pg_pfnum) { +++ lseek(mem,ctob(pagetbl[NPTEPG-1-UPAGES].pg_pfnum),0); + + if (read(mem,abuf,sizeof(abuf)) != sizeof(abuf)) + + return(p->w_comm); + + } else { + + lseek(swap, p->w_lastpg, 0); + + if (read(swap, abuf, sizeof(abuf)) != sizeof(abuf)) + + return(p->w_comm); + + } + + } + + abuf[127] = 0; + + for (ip = &abuf[126]; ip > abuf;) { + + /* Look from top for -1 or 0 as terminator flag. */ + + if (*--ip == -1 || *ip == 0) { + + cp = (char *)(ip+1); + + if (*cp==0) + + cp++; + + nbad = 0; /* up to 5 funny chars as ?'s */ + + for (cp1 = cp; cp1 < (char *)&abuf[128]; cp1++) { + + c = *cp1&0177; + + if (c==0) /* nulls between args => spaces */ + + *cp1 = ' '; + + else if (c < ' ' || c > 0176) { + + if (++nbad >= 5) { + + *cp1++ = ' '; + + break; + + } + + *cp1 = '?'; + + } else if (c=='=') { /* Oops - found an + + * environment var, back + + * over & erase it. */ + + *cp1 = 0; + + while (cp1>cp && *--cp1!=' ') + + *cp1 = 0; + + break; + + } + + } + + while (*--cp1==' ') /* strip trailing spaces */ + + *cp1 = 0; + + return(cp); + + } + + } + + return (p->w_comm); + +} + + + +/* + + * Given a base/size pair in virtual swap area, + + * return a physical base/size pair which is the + + * (largest) initial, physically contiguous block. + + */ + +vstodb(vsbase, vssize, dmp, dbp, rev) + + register int vsbase; + + int vssize; + + struct dmap *dmp; + + register struct dblock *dbp; + +{ + + register int blk = DMMIN; + + register swblk_t *ip = dmp->dm_map; + + + + if (vsbase < 0 || vsbase + vssize > dmp->dm_size) + + panic("vstodb"); + + while (vsbase >= blk) { + + vsbase -= blk; + + if (blk < DMMAX) + + blk *= 2; + + ip++; + + } + + if (*ip <= 0 || *ip + blk > nswap) + + panic("vstodb *ip"); + + dbp->db_size = min(vssize, blk - vsbase); + + dbp->db_base = *ip + (rev ? blk - (vsbase + dbp->db_size) : vsbase); + +} + + + +panic(cp) + + char *cp; + +{ + + + + /* printf("%s\n", cp); */ + +} + + + +min(a, b) + +{ + + + + return (a < b ? a : b); + +} diff --cc usr/src/cmd/wall.c index 0000000000,3771936c70,0000000000..0642a3c87b mode 000000,100644,000000..100644 --- a/usr/src/cmd/wall.c +++ b/usr/src/cmd/wall.c @@@@ -1,0 -1,98 -1,0 +1,106 @@@@ +++static char *sccsid = "@(#)wall.c 4.1 (Berkeley) 10/1/80"; +++/* +++ * wall.c - Broadcast a message to all users. +++ * +++ * This program is not related to David Wall, whose Stanford Ph.D. thesis +++ * is entitled "Mechanisms for Broadcast and Selective Broadcast". +++ */ +++ + +#include + +#include + +#include - #define USERS 50 +++#define USERS 128 + + + +char mesg[3000]; + +int msize,sline; + +struct utmp utmp[USERS]; + +char *strcpy(); + +char *strcat(); + +char who[9] = "???"; + +long clock; + +struct tm *localtime(); + +struct tm *localclock; + + + +main(argc, argv) + +char *argv[]; + +{ + + register i; + + register char c; + + register struct utmp *p; + + FILE *f; + + + + if((f = fopen("/etc/utmp", "r")) == NULL) { + + fprintf(stderr, "Cannot open /etc/utmp\n"); + + exit(1); + + } + + clock = time( 0 ); + + localclock = localtime( &clock ); + + fread((char *)utmp, sizeof(struct utmp), USERS, f); + + fclose(f); + + f = stdin; + + if(argc >= 2) { + + /* take message from unix file instead of standard input */ + + if((f = fopen(argv[1], "r")) == NULL) { + + fprintf(stderr,"Cannot open %s\n", argv[1]); + + exit(1); + + } + + } + + while((i = getc(f)) != EOF) mesg[msize++] = i; + + fclose(f); + + sline = ttyslot(2); /* 'utmp' slot no. of sender */ + + if (sline) { - for (i=0;c=utmp[sline].ut_name[i];i++) +++ for (i=0;(c=utmp[sline].ut_name[i]) && iut_name[0] == 0) + + continue; + + sleep(1); + + sendmes(p->ut_line); + + } + + exit(0); + +} + + + +sendmes(tty) + +char *tty; + +{ + + register i; + + char t[50], buf[BUFSIZ]; + + register char *cp; + + register int c, ch; + + FILE *f; + + + + i = fork(); + + if(i == -1) { + + fprintf(stderr, "Try again\n"); + + return; + + } + + if(i) + + return; + + strcpy(t, "/dev/"); + + strcat(t, tty); + + + + if((f = fopen(t, "w")) == NULL) { + + fprintf(stderr,"cannot open %s\n", t); + + exit(1); + + } + + setbuf(f, buf); + + fprintf(f, "\nBroadcast Message from %s (%s) at %d:%02d ...\r\n\n" + + ,who, utmp[sline].ut_line + + , localclock -> tm_hour , localclock -> tm_min ); + + /* fwrite(mesg, msize, 1, f); */ + + for (cp = mesg, c = msize; c-- > 0; cp++) { + + ch = *cp; + + if (ch == '\n') + + putc('\r', f); + + putc(ch, f); + + } + + + + /* + + * Bitchin'. + + */ + + + + exit(0); + +} diff --cc usr/src/cmd/wc.c index 0000000000,3a20b2712e,0000000000..ffa3f5bb54 mode 000000,100644,000000..100644 --- a/usr/src/cmd/wc.c +++ b/usr/src/cmd/wc.c @@@@ -1,0 -1,86 -1,0 +1,195 @@@@ +++static char *sccsid = "@(#)wc.c 4.3 (Berkeley) 11/7/80"; + +/* wc line and word count */ + + + +#include +++long linect, wordct, charct, pagect; +++long tlinect, twordct, tcharct, tpagect; +++int baud=300; /* baud rate */ +++int cps=30; /* # of chars per second */ +++int lpp=66; /* # of lines per page */ +++char *wd = "lwc"; +++int verbose; +++int uucp; + + + +main(argc, argv) + +char **argv; + +{ + + int i, token; + + register FILE *fp; - long linect, wordct, charct; - long tlinect=0, twordct=0, tcharct=0; - char *wd; + + register int c; +++ char *p; + + - wd = "lwc"; - if(argc > 1 && *argv[1] == '-') { - wd = ++argv[1]; +++ while (argc > 1 && *argv[1] == '-') { +++ switch (argv[1][1]) { +++ case 'l': case 'w': case 'c': case 'p': case 't': +++ wd = argv[1]+1; +++ break; +++ case 's': +++ lpp = atoi(argv[1]+2); +++ if (lpp <= 0) +++ goto usage; +++ break; +++ case 'v': +++ verbose++; +++ wd = "lwcpt"; +++ break; +++ case 'u': +++ uucp++; +++ break; +++ case 'b': +++ baud = atoi(argv[1]+2); +++ if (baud == 110) +++ cps = 10; +++ else +++ cps = baud / 10; +++ if (cps <= 0) +++ goto usage; +++ break; +++ default: +++ usage: +++ fprintf(stderr, "Usage: wc [-lwcpt] [-v] [-u] [-spagesize] [-bbaudrate]\n"); +++ exit(1); +++ } + + argc--; + + argv++; + + } + + +++ if (uucp) +++ cps = cps * 9 / 10; /* 27 cps at 300 baud */ +++ +++ if (verbose) { +++ for (p=wd; *p; p++) +++ switch(*p) { +++ case 'l': +++ printf("lines\t"); +++ break; +++ case 'w': +++ printf("words\t"); +++ break; +++ case 'c': +++ printf("chars\t"); +++ break; +++ case 'p': +++ printf("pages\t"); +++ break; +++ case 't': +++ printf("time@%d\t",baud); +++ break; +++ } +++ printf("\n"); +++ } +++ + + i = 1; + + fp = stdin; + + do { + + if(argc>1 && (fp=fopen(argv[i], "r")) == NULL) { + + fprintf(stderr, "wc: can't open %s\n", argv[i]); + + continue; + + } + + linect = 0; + + wordct = 0; + + charct = 0; +++ pagect = 0; + + token = 0; + + for(;;) { + + c = getc(fp); + + if (c == EOF) + + break; + + charct++; + + if(' '1) { + + printf(" %s\n", argv[i]); + + } else + + printf("\n"); + + fclose(fp); + + tlinect += linect; + + twordct += wordct; + + tcharct += charct; +++ tpagect += pagect; + + } while(++i 2) { - wcp(wd, tcharct, twordct, tlinect); +++ wcp(wd, tcharct, twordct, tlinect, tpagect); + + printf(" total\n"); + + } + + exit(0); + +} + + - wcp(wd, charct, wordct, linect) +++wcp(wd, charct, wordct, linect, pagect) + +register char *wd; - long charct; long wordct; long linect; +++long charct; long wordct; long linect, pagect; + +{ + + while (*wd) switch (*wd++) { + + case 'l': - printf("%7ld", linect); +++ ipr(linect); + + break; + + + + case 'w': - printf("%7ld ", wordct); +++ ipr(wordct); + + break; + + + + case 'c': - printf("%7ld", charct); +++ ipr(charct); +++ break; +++ +++ case 'p': +++ ipr(pagect); +++ break; +++ +++ case 't': +++ prttime(charct/cps); + + break; + + } + +} +++ +++ipr(num) +++long num; +++{ +++ if (verbose) +++ printf("%ld\t", num); +++ else +++ printf("%7ld", num); +++} +++ +++prttime(secs) +++long secs; +++{ +++ int hrs,mins; +++ float t; +++ long osecs; +++ char *units; +++ +++ osecs = secs; +++ hrs = secs / (60*60); +++ secs = secs % (60*60); +++ mins = secs / 60; +++ secs = secs % 60; +++ +++ t = osecs; +++ if (hrs) { +++ t /= (60*60); +++ units = "hr"; +++ } else if (mins) { +++ t /= 60; +++ units = "mi"; +++ } else { +++ units = "se"; +++ } +++ printf("%4.1f %2s\t", t, units); +++} diff --cc usr/src/cmd/what.c index 0000000000,0000000000,0000000000..7ff5ca3ed9 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/what.c @@@@ -1,0 -1,0 -1,0 +1,50 @@@@ +++static char *sccsid = "@(#)what.c 4.1 (Berkeley) 10/15/80"; +++#include +++ +++/* +++ * what +++ */ +++ +++char *infile = "Standard input"; +++ +++main(argc, argv) +++ int argc; +++ char *argv[]; +++{ +++ +++ argc--, argv++; +++ do { +++ if (argc > 0) { +++ if (freopen(argv[0], "r", stdin) == NULL) { +++ perror(argv[0]); +++ exit(1); +++ } +++ infile = argv[0]; +++ printf("%s\n", infile); +++ argc--, argv++; +++ } +++ fseek(stdin, (long) 0, 0); +++ find(); +++ } while (argc > 0); +++} +++ +++find() +++{ +++ static char buf[BUFSIZ]; +++ register char *cp; +++ register int c, cc; +++ register char *pat; +++ +++contin: +++ while ((c = getchar()) != EOF) +++ if (c == '@') { +++ for (pat = "(#)"; *pat; pat++) +++ if ((c = getchar()) != *pat) +++ goto contin; +++ putchar('\t'); +++ while ((c = getchar()) != EOF && c && c != '"' && +++ c != '>' && c != '\n') +++ putchar(c); +++ putchar('\n'); +++ } +++} diff --cc usr/src/cmd/whatis.c index 0000000000,c5aab8cc74,0000000000..82953f2269 mode 000000,100644,000000..100644 --- a/usr/src/cmd/whatis.c +++ b/usr/src/cmd/whatis.c @@@@ -1,0 -1,133 -1,0 +1,134 @@@@ +++static char *sccsid = "@(#)whatis.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +/* + + * whatis - what the heck is that file anyways + + * + + * Bill Joy UCB + + */ + + + +char *calloc(); + +char *trim(); + +unsigned blklen(); + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + register char **avp; + + + + argc--, argv++; + + if (argc == 0) { + + fprintf(stderr, "whatis name ...\n"); + + exit(1); + + } + + if (freopen("/usr/lib/whatis", "r", stdin) == NULL) { + + perror("/usr/lib/whatis"); + + exit (1); + + } + + argv[argc] = 0; + + for (avp = argv; *avp; avp++) + + *avp = trim(*avp); + + whatis(argv); + + exit(0); + +} + + + +whatis(argv) + + char **argv; + +{ + + char buf[BUFSIZ]; + + register char *gotit; + + register char **vp; + + + + gotit = calloc(1, blklen(argv)); + + while (fgets(buf, sizeof buf, stdin) != NULL) + + for (vp = argv; *vp; vp++) + + if (match(buf, *vp)) { + + printf("%s", buf); + + gotit[vp - argv] = 1; + + for (vp++; *vp; vp++) + + if (match(buf, *vp)) + + gotit[vp - argv] = 1; + + break; + + } + + for (vp = argv; *vp; vp++) + + if (gotit[vp - argv] == 0) + + printf("%s: not found\n", *vp); + +} + + + +match(buf, str) + + char *buf, *str; + +{ + + register char *bp, *cp; + + + + bp = buf; + +again: + + cp = str; + + while (*bp && *cp && lmatch(*bp, *cp)) + + bp++, cp++; + + if (*cp == 0 && (*bp == '(' || *bp == ',' || *bp == '\t' || *bp == ' ')) + + return (1); + + while (isalpha(*bp) || isdigit(*bp)) + + bp++; + + if (*bp != ',') + + return (0); + + bp++; + + while (isspace(*bp)) + + bp++; + + goto again; + +} + + + +lmatch(c, d) + + char c, d; + +{ + + + + if (c == d) + + return (1); + + if (!isalpha(c) || !isalpha(d)) + + return (0); + + if (islower(c)) + + c = toupper(c); + + if (islower(d)) + + d = toupper(d); + + return (c == d); + +} + + + +unsigned + +blklen(ip) + + register char **ip; + +{ + + register int i = 0; + + + + while (*ip++) + + i++; + + return (i); + +} + + + +char * + +trim(cp) + + register char *cp; + +{ + + register char *dp; + + + + for (dp = cp; *dp; dp++) + + if (*dp == '/') + + cp = dp + 1; + + if (cp[0] != '.') { + + if (cp + 3 <= dp && dp[-2] == '.' && any(dp[-1], "cosa12345678npP")) + + dp[-2] = 0; + + if (cp + 4 <= dp && dp[-3] == '.' && any(dp[-2], "13") && isalpha(dp[-1])) + + dp[-3] = 0; + + } + + return (cp); + +} + + + +any(c, cp) + + register int c; + + register char *cp; + +{ + + + + while (*cp) + + if (c == *cp++) + + return (1); + + return (0); + +} diff --cc usr/src/cmd/whereis.c index 0000000000,d839671183,0000000000..a5faa8696d mode 000000,100644,000000..100644 --- a/usr/src/cmd/whereis.c +++ b/usr/src/cmd/whereis.c @@@@ -1,0 -1,289 -1,0 +1,314 @@@@ +++static char *sccsid = "@(#)whereis.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +#include +++#include +++ +++static char *bindirs[] = { +++ "/etc", +++ "/bin", +++ "/usr/bin", +++ "/usr/games", +++#ifdef CSVAX +++ "/lib", +++ "/usr/ucb", +++ "/usr/lib", +++ "/usr/local", +++ "/usr/new", +++ "/usr/old", +++#endif +++#ifdef CORY +++ "/usr/bin/eecs", +++ "/usr/bin/new", +++ "/usr/bin/v7", +++ "/usr/bin/old", +++ "/usr/bin/UNSUPPORTED", +++#endif +++ 0 +++}; +++static char *mandirs[] = { +++ "/usr/man/man1", +++ "/usr/man/man2", +++ "/usr/man/man3", +++ "/usr/man/man4", +++ "/usr/man/man5", +++ "/usr/man/man6", +++ "/usr/man/man7", +++ "/usr/man/man8", +++#ifdef CORY +++ "/usr/man/manu", +++ "/usr/man/manc", +++ "/usr/man/manv7", +++ "/usr/bin/eecs/mane", +++#endif +++ 0 +++}; +++static char *srcdirs[] = { +++ "/usr/src/cmd", +++ "/usr/src/games", +++ "/usr/src/libc/gen", +++ "/usr/src/libc/stdio", +++#ifdef CSVAX +++ "/usr/src/libc/sys", +++ "/usr/src/new", +++ "/usr/src/old", +++ "/usr/src/local", +++ "/usr/src/undoc", +++#endif +++#ifdef CORY +++ "/usr/bin/eecs/src", +++ "/usr/src/cmd/v7", +++ "/usr/src/cmd/new", +++ "/usr/src/cmd/old", +++ "/usr/src/cmd/UNSUPPORTED", +++#endif +++ 0 +++}; + + + +char sflag = 1; + +char bflag = 1; + +char mflag = 1; + +char **Sflag; + +int Scnt; + +char **Bflag; + +int Bcnt; + +char **Mflag; + +int Mcnt; + +char uflag; + +/* + + * whereis name + + * look for source, documentation and binaries + + */ + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + + +#ifdef CORY + + if (getuid() == 0) + + nice(-20); + + if (((getuid() >> 8) & 0377) > 10) + + setuid(getuid()); + +#endif + + argc--, argv++; + + if (argc == 0) { + +usage: + + fprintf(stderr, "whereis [ -sbmu ] [ -SBM dir ... -f ] name...\n"); + + exit(1); + + } + + do + + if (argv[0][0] == '-') { + + register char *cp = argv[0] + 1; + + while (*cp) switch (*cp++) { + + + + case 'f': + + break; + + + + case 'S': + + getlist(&argc, &argv, &Sflag, &Scnt); + + break; + + + + case 'B': + + getlist(&argc, &argv, &Bflag, &Bcnt); + + break; + + + + case 'M': + + getlist(&argc, &argv, &Mflag, &Mcnt); + + break; + + + + case 's': + + zerof(); + + sflag++; + + continue; + + + + case 'u': + + uflag++; + + continue; + + + + case 'b': + + zerof(); + + bflag++; + + continue; + + + + case 'm': + + zerof(); + + mflag++; + + continue; + + + + default: + + goto usage; + + } + + argv++; + + } else + + lookup(*argv++); + + while (--argc > 0); + +} + + + +getlist(argcp, argvp, flagp, cntp) + + char ***argvp; + + int *argcp; + + char ***flagp; + + int *cntp; + +{ + + + + (*argvp)++; + + *flagp = *argvp; + + *cntp = 0; + + for ((*argcp)--; *argcp > 0 && (*argvp)[0][0] != '-'; (*argcp)--) + + (*cntp)++, (*argvp)++; + + (*argcp)++; + + (*argvp)--; + +} + + + + + +zerof() + +{ + + + + if (sflag && bflag && mflag) + + sflag = bflag = mflag = 0; + +} + +int count; + +int print; + + + + + +lookup(cp) + + register char *cp; + +{ + + register char *dp; + + + + for (dp = cp; *dp; dp++) + + continue; + + for (; dp > cp; dp--) { + + if (*dp == '.') { + + *dp = 0; + + break; + + } + + } + + for (dp = cp; *dp; dp++) + + if (*dp == '/') + + cp = dp + 1; + + if (uflag) { + + print = 0; + + count = 0; + + } else + + print = 1; + +again: + + if (print) + + printf("%s:", cp); + + if (sflag) { + + looksrc(cp); + + if (uflag && print == 0 && count != 1) { + + print = 1; + + goto again; + + } + + } + + count = 0; + + if (bflag) { + + lookbin(cp); + + if (uflag && print == 0 && count != 1) { + + print = 1; + + goto again; + + } + + } + + count = 0; + + if (mflag) { + + lookman(cp); + + if (uflag && print == 0 && count != 1) { + + print = 1; + + goto again; + + } + + } + + if (print) + + printf("\n"); + +} + + + +looksrc(cp) + + char *cp; + +{ - static char *srcdirs[] = { - "cmd", - "libc/gen", - "libc/stdio", - "libc/sys", - "games", - "new", - "old", - "local", - "undoc", - 0 - }; + + if (Sflag == 0) { - chdir("/usr/src"); + + find(srcdirs, cp); + + } else + + findv(Sflag, Scnt, cp); + +} + + + +lookbin(cp) + + char *cp; + +{ - static char *bindirs[] = { - "/etc", - "/bin", - "/lib", - "/usr/bin", - "/usr/ucb", - "/usr/lib", - "/usr/local", - "/usr/new", - "/usr/old", - "/usr/games", - 0 - }; + + if (Bflag == 0) + + find(bindirs, cp); + + else + + findv(Bflag, Bcnt, cp); + +} + + + +lookman(cp) + + char *cp; + +{ - static char *mandirs[] = { - "man1", - "man2", - "man3", - "man4", - "man5", - "man6", - "man7", - "man8", - 0 - }; + + if (Mflag == 0) { - chdir("/usr/man"); + + find(mandirs, cp); + + } else + + findv(Mflag, Mcnt, cp); + +} + + + +findv(dirv, dirc, cp) + + char **dirv; + + int dirc; + + char *cp; + +{ + + + + while (dirc > 0) + + findin(*dirv++, cp), dirc--; + +} + + + +find(dirs, cp) + + char **dirs; + + char *cp; + +{ + + + + while (*dirs) + + findin(*dirs++, cp); + +} + + + +findin(dir, cp) + + char *dir, *cp; + +{ + + register FILE *d; + + struct direct direct; + + + + d = fopen(dir, "r"); + + if (d == NULL) + + return; + + while (fread(&direct, sizeof direct, 1, d) == 1) { + + if (direct.d_ino == 0) + + continue; + + if (itsit(cp, direct.d_name)) { + + count++; + + if (print) + + printf(" %s/%.14s", dir, direct.d_name); + + } + + } + + fclose(d); + +} + + + +itsit(cp, dp) + + register char *cp, *dp; + +{ + + register int i = 14; + + + + if (dp[0] == 's' && dp[1] == '.' && itsit(cp, dp+2)) + + return (1); + + while (*cp && *dp && *cp == *dp) + + cp++, dp++, i--; + + if (*cp == 0 && *dp == 0) + + return (1); + + while (isdigit(*dp)) + + dp++; + + if (*cp == 0 && *dp++ == '.') { + + --i; + + while (i > 0 && *dp) + + if (--i, *dp++ == '.') + + return (*dp++ == 'C' && *dp++ == 0); + + return (1); + + } + + return (0); + +} diff --cc usr/src/cmd/who.c index 0000000000,27e0b1d4bb,0000000000..41a0fd3e7e mode 000000,100644,000000..100644 --- a/usr/src/cmd/who.c +++ b/usr/src/cmd/who.c @@@@ -1,0 -1,62 -1,0 +1,72 @@@@ +++static char *sccsid = "@(#)who.c 4.2 (Berkeley) 11/1/80"; + +/* + + * who + + */ + + + +#include + +#include + +#include +++#include +++#include +++ +++#define NMAX sizeof(utmp.ut_name) +++#define LMAX sizeof(utmp.ut_line) +++ + +struct utmp utmp; + +struct passwd *pw; + +struct passwd *getpwuid(); + + + +char *ttyname(), *rindex(), *ctime(), *strcpy(); + +main(argc, argv) + +char **argv; + +{ + + register char *tp, *s; + + register FILE *fi; +++ extern char _sobuf[]; + + +++ setbuf(stdout, _sobuf); + + s = "/etc/utmp"; + + if(argc == 2) + + s = argv[1]; + + if (argc==3) { + + tp = ttyname(0); + + if (tp) + + tp = rindex(tp, '/') + 1; + + else { /* no tty - use best guess from passwd file */ + + pw = getpwuid(getuid()); + + strcpy(utmp.ut_name, pw?pw->pw_name: "?"); + + strcpy(utmp.ut_line, "tty??"); + + time(&utmp.ut_time); + + putline(); + + exit(0); + + } + + } + + if ((fi = fopen(s, "r")) == NULL) { + + puts("who: cannot open utmp"); + + exit(1); + + } + + while (fread((char *)&utmp, sizeof(utmp), 1, fi) == 1) { + + if(argc==3) { +++ static char myname[]=sysname; + + if (strcmp(utmp.ut_line, tp)) + + continue; - #ifdef vax - printf("(Vax) "); - #endif +++ if (islower(*myname)) +++ *myname = toupper(*myname); +++ printf("(%s) ",myname); + + putline(); + + exit(0); + + } + + if(utmp.ut_name[0] == '\0' && argc==1) + + continue; + + putline(); + + } + +} + + + +putline() + +{ + + register char *cbuf; + + - printf("%-8.8s %-8.8s", utmp.ut_name, utmp.ut_line); +++ printf("%-*.*s %-*.*s", NMAX, NMAX, utmp.ut_name, LMAX, LMAX, utmp.ut_line); + + cbuf = ctime(&utmp.ut_time); + + printf("%.12s\n", cbuf+4); + +} diff --cc usr/src/cmd/whoami.c index 0000000000,78e9971103,0000000000..452fb267cb mode 000000,100644,000000..100644 --- a/usr/src/cmd/whoami.c +++ b/usr/src/cmd/whoami.c @@@@ -1,0 -1,18 -1,0 +1,19 @@@@ +++static char *sccsid = "@(#)whoami.c 4.1 (Berkeley) 10/1/80"; + +#include + +/* + + * whoami + + */ + +struct passwd *getpwuid(); + + + +main() + +{ + + register struct passwd *pp; + + + + pp = getpwuid(getuid()); + + if (pp == 0) { + + printf("Intruder alert.\n"); + + exit(1); + + } + + printf("%s\n", pp->pw_name); + + exit(0); + +} diff --cc usr/src/cmd/write.c index 0000000000,205ffb0ff7,0000000000..626a98f8f7 mode 000000,100644,000000..100644 --- a/usr/src/cmd/write.c +++ b/usr/src/cmd/write.c @@@@ -1,0 -1,191 -1,0 +1,197 @@@@ +++static char *sccsid = "@(#)write.c 4.2 (Berkeley) 11/10/80"; + +/* + + * write to another user + + */ + + + +#include + +#include + +#include + +#include + +#include + +#include + + +++#define NMAX sizeof(ubuf.ut_name) +++#define LMAX sizeof(ubuf.ut_line) +++ + +char *strcat(); + +char *strcpy(); + +struct utmp ubuf; + +int signum[] = {SIGHUP, SIGINT, SIGQUIT, 0}; + +char me[10] = "???"; + +char *him; + +char *mytty; + +char histty[32]; + +char *histtya; + +char *ttyname(); + +char *rindex(); + +int logcnt; + +int eof(); + +int timout(); + +FILE *tf; + +char *getenv(); + + + +main(argc, argv) + +char *argv[]; + +{ + + struct stat stbuf; + + register i; + + register FILE *uf; + + int c1, c2; + + long clock = time( 0 ); + + struct tm *localtime(); + + struct tm *localclock = localtime( &clock ); + + + + if(argc < 2) { + + printf("usage: write user [ttyname]\n"); + + exit(1); + + } + + him = argv[1]; + + if(argc > 2) + + histtya = argv[2]; + + if ((uf = fopen("/etc/utmp", "r")) == NULL) { + + printf("cannot open /etc/utmp\n"); + + goto cont; + + } + + mytty = ttyname(2); + + if (mytty == NULL) { + + printf("Can't find your tty\n"); + + exit(1); + + } + + mytty = rindex(mytty, '/') + 1; + + if (histtya) { + + strcpy(histty, "/dev/"); + + strcat(histty, histtya); + + } + + while (fread((char *)&ubuf, sizeof(ubuf), 1, uf) == 1) { +++ if (ubuf.ut_name[0] == '\0') +++ continue; + + if (strcmp(ubuf.ut_line, mytty)==0) { - for(i=0; i<8; i++) { +++ for(i=0; i 1) { + + printf("%s logged more than once\nwriting to %s\n", him, histty+5); + + } + + if(histty[0] == 0) { + + printf(him); + + if(logcnt) + + printf(" not on that tty\n"); else + + printf(" not logged in\n"); + + exit(1); + + } + + if (access(histty, 0) < 0) { + + printf("No such tty\n"); + + exit(1); + + } + + signal(SIGALRM, timout); + + alarm(5); + + if ((tf = fopen(histty, "w")) == NULL) + + goto perm; + + alarm(0); + + if (fstat(fileno(tf), &stbuf) < 0) + + goto perm; + + if ((stbuf.st_mode&02) == 0) + + goto perm; + + sigs(eof); + + fprintf(tf, "\r\nMessage from "); + +#ifdef interdata + + fprintf(tf, "(Interdata) " ); + +#endif + + fprintf(tf, "%s on %s at %d:%02d ...\r\n" + + , me, mytty , localclock -> tm_hour , localclock -> tm_min ); + + fflush(tf); + + for(;;) { + + char buf[128]; + + i = read(0, buf, 128); + + if(i <= 0) + + eof(); + + if(buf[0] == '!') { + + buf[i] = 0; + + ex(buf); + + continue; + + } + + write(fileno(tf), buf, i); + + if ( buf[ i - 1 ] == '\n' ) + + write( fileno( tf ) , "\r" , 1 ); + + } + + + +perm: + + printf("Permission denied\n"); + + exit(1); + +} + + + +timout() + +{ + + + + printf("Timeout opening their tty\n"); + + exit(1); + +} + + + +eof() + +{ + + + + fprintf(tf, "EOF\r\n"); + + exit(0); + +} + + + +ex(bp) + +char *bp; + +{ + + register i; + + + + sigs(SIG_IGN); + + i = fork(); + + if(i < 0) { + + printf("Try again\n"); + + goto out; + + } + + if(i == 0) { + + sigs((int (*)())0); + + execl(getenv("SHELL") ? getenv("SHELL") : "/bin/sh", "sh", "-c", bp+1, 0); + + exit(0); + + } + + while(wait((int *)NULL) != i) + + ; + + printf("!\n"); + +out: + + sigs(eof); + +} + + + +sigs(sig) + +int (*sig)(); + +{ + + register i; + + + + for(i=0;signum[i];i++) + + signal(signum[i],sig); + +} diff --cc usr/src/cmd/xstr.c index 0000000000,2236b23101,0000000000..40a9791f2f mode 000000,100644,000000..100644 --- a/usr/src/cmd/xstr.c +++ b/usr/src/cmd/xstr.c @@@@ -1,0 -1,428 -1,0 +1,429 @@@@ +++static char *sccsid = "@(#)xstr.c 4.1 (Berkeley) 10/1/80"; + +#include + +#include + +#include + +#include + + + +/* + + * xstr - extract and hash strings in a C program + + * + + * Bill Joy UCB + + * November, 1978 + + */ + + + +#define ignore(a) Ignore((char *) a) + + + +char *calloc(); + +off_t tellpt; + +off_t hashit(); + +char *mktemp(); + +int onintr(); + +char *savestr(); + +char *strcat(); + +char *strcpy(); + +off_t yankstr(); + + + +off_t mesgpt; + +char *strings = "strings"; + + + +int cflg; + +int vflg; + +int readstd; + + + +main(argc, argv) + + int argc; + + char *argv[]; + +{ + + + + argc--, argv++; + + while (argc > 0 && argv[0][0] == '-') { + + register char *cp = &(*argv++)[1]; + + + + argc--; + + if (*cp == 0) { + + readstd++; + + continue; + + } + + do switch (*cp++) { + + + + case 'c': + + cflg++; + + continue; + + + + case 'v': + + vflg++; + + continue; + + + + default: + + fprintf(stderr, "usage: xstr [ -v ] [ -c ] [ - ] [ name ... ]\n"); + + } while (*cp); + + } + + if (signal(SIGINT, SIG_IGN) == SIG_DFL) + + signal(SIGINT, onintr); + + if (cflg || argc == 0 && !readstd) + + inithash(); + + else + + strings = mktemp(savestr("/tmp/xstrXXXXXX")); + + while (readstd || argc > 0) { + + if (freopen("x.c", "w", stdout) == NULL) + + perror("x.c"), exit(1); + + if (!readstd && freopen(argv[0], "r", stdin) == NULL) + + perror(argv[0]), exit(2); + + process("x.c"); + + if (readstd == 0) + + argc--, argv++; + + else + + readstd = 0; + + }; + + flushsh(); + + if (cflg == 0) + + xsdotc(); + + if (strings[0] == '/') + + ignore(unlink(strings)); + + exit(0); + +} + + + +process(name) + + char *name; + +{ + + char *cp; + + char linebuf[BUFSIZ]; + + register int c; + + register int incomm = 0; + + + + printf("char\txstr[];\n"); + + for (;;) { + + if (fgets(linebuf, sizeof linebuf, stdin) == NULL) { + + if (ferror(stdin)) { + + perror(name); + + exit(3); + + } + + break; + + } + + if (linebuf[0] == '#') { + + if (linebuf[1] == ' ' && isdigit(linebuf[2])) + + printf("#line%s", &linebuf[1]); + + else + + printf("%s", linebuf); + + continue; + + } + + for (cp = linebuf; c = *cp++;) switch (c) { + + + + case '"': + + if (incomm) + + goto def; + + printf("(&xstr[%d])", (int) yankstr(&cp)); + + break; + + + + case '\'': + + if (incomm) + + goto def; + + putchar(c); + + if (*cp) + + putchar(*cp++); + + break; + + + + case '/': + + if (incomm || *cp != '*') + + goto def; + + incomm = 1; + + cp++; + + printf("/*"); + + continue; + + + + case '*': + + if (incomm && *cp == '/') { + + incomm = 0; + + cp++; + + printf("*/"); + + continue; + + } + + goto def; + + + +def: + + default: + + putchar(c); + + break; + + } + + } + + if (ferror(stdout)) + + perror("x.c"), onintr(); + +} + + + +off_t + +yankstr(cpp) + + register char **cpp; + +{ + + register char *cp = *cpp; + + register int c, ch; + + char dbuf[BUFSIZ]; + + register char *dp = dbuf; + + register char *tp; + + + + while (c = *cp++) { + + switch (c) { + + + + case '"': + + cp++; + + goto out; + + + + case '\\': + + c = *cp++; + + if (c == 0) + + break; + + if (c == '\n') + + continue; + + for (tp = "b\bt\tr\rn\nf\f\\\\\"\""; ch = *tp++; tp++) + + if (c == ch) { + + c = *tp; + + goto gotc; + + } + + if (!octdigit(c)) { + + *dp++ = '\\'; + + break; + + } + + c -= '0'; + + if (!octdigit(*cp)) + + break; + + c <<= 3, c += *cp++ - '0'; + + if (!octdigit(*cp)) + + break; + + c <<= 3, c += *cp++ - '0'; + + break; + + } + +gotc: + + *dp++ = c; + + } + +out: + + *cpp = --cp; + + *dp = 0; + + return (hashit(dbuf, 1)); + +} + + + +octdigit(c) + + char c; + +{ + + + + return (isdigit(c) && c != '8' && c != '9'); + +} + + + +inithash() + +{ + + char buf[BUFSIZ]; + + register FILE *mesgread = fopen(strings, "r"); + + + + if (mesgread == NULL) + + return; + + for (;;) { + + mesgpt = tellpt; + + if (fgetNUL(buf, sizeof buf, mesgread) == NULL) + + break; + + ignore(hashit(buf, 0)); + + } + + ignore(fclose(mesgread)); + +} + + + +fgetNUL(obuf, rmdr, file) + + char *obuf; + + register int rmdr; + + FILE *file; + +{ + + register c; + + register char *buf = obuf; + + + + while (--rmdr > 0 && (c = xgetc(file)) != 0 && c != EOF) + + *buf++ = c; + + *buf++ = 0; + + return ((feof(file) || ferror(file)) ? NULL : 1); + +} + + + +xgetc(file) + + FILE *file; + +{ + + + + tellpt++; + + return (getc(file)); + +} + + + +#define BUCKETS 128 + + + +struct hash { + + off_t hpt; + + char *hstr; + + struct hash *hnext; + + short hnew; + +} bucket[BUCKETS]; + + + +off_t + +hashit(str, new) + + char *str; + + int new; + +{ + + int i; + + register struct hash *hp, *hp0; + + + + hp = hp0 = &bucket[lastchr(str) & 0177]; + + while (hp->hnext) { + + hp = hp->hnext; + + i = istail(str, hp->hstr); + + if (i >= 0) + + return (hp->hpt + i); + + } + + hp = (struct hash *) calloc(1, sizeof (*hp)); + + hp->hpt = mesgpt; + + hp->hstr = savestr(str); + + mesgpt += strlen(hp->hstr) + 1; + + hp->hnext = hp0->hnext; + + hp->hnew = new; + + hp0->hnext = hp; + + return (hp->hpt); + +} + + + +flushsh() + +{ + + register int i; + + register struct hash *hp; + + register FILE *mesgwrit; + + register int old = 0, new = 0; + + + + for (i = 0; i < BUCKETS; i++) + + for (hp = bucket[i].hnext; hp != NULL; hp = hp->hnext) + + if (hp->hnew) + + new++; + + else + + old++; + + if (new == 0 && old != 0) + + return; + + mesgwrit = fopen(strings, old ? "a" : "w"); + + for (i = 0; i < BUCKETS; i++) + + for (hp = bucket[i].hnext; hp != NULL; hp = hp->hnext) { + + found(hp->hnew, hp->hpt, hp->hstr); + + if (hp->hnew) { + + fseek(mesgwrit, hp->hpt, 0); + + ignore(fwrite(hp->hstr, strlen(hp->hstr) + 1, 1, mesgwrit)); + + if (ferror(mesgwrit)) + + perror(strings), exit(4); + + } + + } + + ignore(fclose(mesgwrit)); + +} + + + +found(new, off, str) + + int new; + + off_t off; + + char *str; + +{ + + register char *cp; + + + + if (vflg == 0) + + return; + + if (!new) + + fprintf(stderr, "found at %d:", (int) off); + + else + + fprintf(stderr, "new at %d:", (int) off); + + prstr(str); + + fprintf(stderr, "\n"); + +} + + + +prstr(cp) + + register char *cp; + +{ + + register int c; + + + + while (c = (*cp++ & 0377)) + + if (c < ' ') + + fprintf(stderr, "^%c", c + '`'); + + else if (c == 0177) + + fprintf(stderr, "^?"); + + else if (c > 0200) + + fprintf(stderr, "\\%03o", c); + + else + + fprintf(stderr, "%c", c); + +} + + + +xsdotc() + +{ + + register FILE *strf = fopen(strings, "r"); + + register FILE *xdotcf; + + + + if (strf == NULL) + + perror(strings), exit(5); + + xdotcf = fopen("xs.c", "w"); + + if (xdotcf == NULL) + + perror("xs.c"), exit(6); + + fprintf(xdotcf, "char\txstr[] = {\n"); + + for (;;) { + + register int i, c; + + + + for (i = 0; i < 8; i++) { + + c = getc(strf); + + if (ferror(strf)) { + + perror(strings); + + onintr(); + + } + + if (feof(strf)) { + + fprintf(xdotcf, "\n"); + + goto out; + + } + + fprintf(xdotcf, "0x%02x,", c); + + } + + fprintf(xdotcf, "\n"); + + } + +out: + + fprintf(xdotcf, "};\n"); + + ignore(fclose(xdotcf)); + + ignore(fclose(strf)); + +} + + + +char * + +savestr(cp) + + register char *cp; + +{ + + register char *dp = (char *) calloc(1, strlen(cp) + 1); + + + + return (strcpy(dp, cp)); + +} + + + +Ignore(a) + + char *a; + +{ + + + + a = a; + +} + + + +ignorf(a) + + int (*a)(); + +{ + + + + a = a; + +} + + + +lastchr(cp) + + register char *cp; + +{ + + + + while (cp[0] && cp[1]) + + cp++; + + return (*cp); + +} + + + +istail(str, of) + + register char *str, *of; + +{ + + register int d = strlen(of) - strlen(str); + + + + if (d < 0 || strcmp(&of[d], str) != 0) + + return (-1); + + return (d); + +} + + + +onintr() + +{ + + + + ignorf(signal(SIGINT, SIG_IGN)); + + if (strings[0] == '/') + + ignore(unlink(strings)); + + ignore(unlink("x.c")); + + ignore(unlink("xs.c")); + + exit(7); + +} diff --cc usr/src/cmd/yes.c index 0000000000,0000000000,0000000000..0d512dfe03 new file mode 100644 --- /dev/null +++ b/usr/src/cmd/yes.c @@@@ -1,0 -1,0 -1,0 +1,7 @@@@ +++static char *sccsid ="@(#)yes.c 4.1 (Berkeley) 10/8/80"; +++main(argc, argv) +++char **argv; +++{ +++ for (;;) +++ printf("%s\n", argc>1? argv[1]: "y"); +++} diff --cc usr/src/games/fortune/fortune.c index 0000000000,0000000000,0000000000..7a7c84dd98 new file mode 100644 --- /dev/null +++ b/usr/src/games/fortune/fortune.c @@@@ -1,0 -1,0 -1,0 +1,166 @@@@ +++#ifdef UCB_SCCSID +++ char *sccsid = "@(#)fortune.c 2.6"; +++#endif +++# include +++# include "strfile.h" +++ +++# define MINW 6 /* minimum wait if desired */ +++# define CPERS 20 /* # of chars for each sec */ +++# define SLEN 160 /* # of chars in short fortune */ +++ +++# define reg register +++ +++short wflag = 0, /* wait desired after fortune */ +++ sflag = 0, /* short fortune desired */ +++ lflag = 0, /* long fortune desired */ +++ oflag = 0, /* offensive fortunes only */ +++ aflag = 0; /* any fortune allowed */ +++ +++char fortfile[100] = FORTFILE, /* fortune database */ +++ *usage[] = { +++ "usage: fortune [ - ] [ -wsloa ] [ file ]", +++ " - - give this summary of usage", +++ " w - have program wait after printing message in order", +++ " to give time to read", +++ " s - short fortune only", +++ " l - long fortune only", +++ " o - offensive fortunes only", +++ " a - any fortune", +++ " Mail suggested fortunes to \"fortune\"" +++ }; +++ +++long seekpts[2]; /* seek pointers to fortunes */ +++ +++main(ac, av) +++int ac; +++char *av[]; { +++ +++ reg char c; +++ reg int nchar = 0; +++ reg FILE *inf; +++ int numforts, /* number of fortunes */ +++ fortune; /* fortune number */ +++ STRFILE tbl; /* input table */ +++ +++ getargs(ac, av); +++ srand(getpid()); +++ if ((inf = fopen(fortfile, "r")) == NULL) { +++ perror(fortfile); +++ exit(-1); +++ } +++ fread(&tbl, (sizeof tbl), 1, inf); +++ numforts = tbl.str_numstr - 1; /* always a null string at the end */ +++ if (tbl.str_longlen < SLEN && lflag) { +++ puts("Sorry, no long strings in this file"); +++ exit(0); +++ } +++ if (tbl.str_shortlen > SLEN && sflag) { +++ puts("Sorry, no short strings in this file"); +++ exit(0); +++ } +++ if (oflag) +++ numforts -= tbl.str_delims[0]; +++ else if (!aflag) +++ numforts = tbl.str_delims[0]; +++ do { +++ fortune = roll(1, numforts) - 1; +++ if (oflag && !aflag) +++ fortune += tbl.str_delims[0]; +++ fseek(inf, (long)(sizeof seekpts[0]) * fortune + sizeof tbl, 0); +++ fread(seekpts, (sizeof seekpts[0]), 2, inf); +++ } while ((sflag && seekpts[1] - seekpts[0] > SLEN) +++ || (lflag && seekpts[1] - seekpts[0] < SLEN)); +++ fseek(inf, seekpts[0], 0); +++ while (c = getc(inf)) { +++ nchar++; +++ putchar(c); +++ } +++ fflush(stdout); +++ if (wflag) +++ sleep(max((int) nchar/CPERS, MINW)); +++} +++/* +++ * This routine evaluates the arguments on the command line +++ */ +++getargs(ac, av) +++int ac; +++reg char *av[]; { +++ +++ reg short bad = 0; +++ reg int i, j; +++ +++ for (i = 1; i < ac; i++) { +++ if (av[i][0] != '-') +++ strcpy(fortfile, av[i]); +++ else +++ switch (av[i][1]) { +++ case '\0': /* give usage */ +++ for (j = 0; j < sizeof usage / sizeof (char *); j++) +++ puts(usage[j]); +++ exit(0); +++ case 'w': /* give time to read */ +++ wflag++; +++ break; +++ case 's': /* short ones only */ +++ sflag++; +++ break; +++ case 'l': /* long ones only */ +++ lflag++; +++ break; +++ case 'o': /* offensive ones only */ +++ oflag++; +++ break; +++ case 'a': /* any fortune */ +++ aflag++; +++ break; +++ default: +++ printf("unknown flag: '%c'\n", av[1][1]); +++ bad++; +++ break; +++ } +++ } +++ if (bad) { +++ printf("use \"%s -\" to get usage\n", av[0]); +++ exit(-1); +++ } +++} +++ +++max(i, j) +++reg int i, j; { +++ +++ return (i >= j ? i : j); +++} +++ +++# ifndef vax +++# define MAXRAND 32767L +++ +++roll(ndie, nsides) +++int ndie, nsides; { +++ +++ reg long tot; +++ reg unsigned n, r; +++ +++ tot = 0; +++ n = ndie; +++ while (n--) +++ tot += rand(); +++ return (int) ((tot * (long) nsides) / ((long) MAXRAND + 1)) + ndie; +++} +++ +++# else +++ +++roll(ndie, nsides) +++reg int ndie, nsides; { +++ +++ reg int tot, r; +++ reg double num_sides; +++ +++ num_sides = nsides; +++ tot = 0; +++ while (ndie--) +++ tot += rand() * (num_sides / 017777777777) + 1; +++ return tot; +++} +++# endif +++ +++ diff --cc usr/src/lib/libF77/Version.c index 0000000000,0000000000,0000000000..1bc5ec4bc6 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libF77/Version.c @@@@ -1,0 -1,0 -1,0 +1,6 @@@@ +++static char junk[] = "\n@(#)LIBF77 VERSION 2.01 11 AUGUST 1980\n"; +++ +++/* +++2.00 11 June 1980. File version.c added to library. +++2.01 11 August 1980. Added rand_.c, courtesy of R. H. Morris. +++*/ diff --cc usr/src/lib/libI77/Version.c index 0000000000,0000000000,0000000000..991fd8e7a1 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libI77/Version.c @@@@ -1,0 -1,0 -1,0 +1,6 @@@@ +++static char junk[] = "\n@(#) LIBI77 VERSION 2.02 2 AUGUST 1980\n"; +++ +++/* +++2.01 $ format added +++2.02 Coding bug in open.c repaired +++*/ diff --cc usr/src/lib/libpc/ACTFILE.c index 0000000000,0000000000,0000000000..d70956c6c7 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ACTFILE.c @@@@ -1,0 -1,0 -1,0 +1,13 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ACTFILE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++FILE * +++ACTFILE(curfile) +++ +++ struct iorec *curfile; +++{ +++ return curfile->fbuf; +++} diff --cc usr/src/lib/libpc/ADDT.c index 0000000000,0000000000,0000000000..646ba3f0be new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ADDT.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ADDT.c 1.1 10/29/80"; +++ +++long * +++ADDT(result0, left, right, size) +++ +++ long *result0; +++ register long *left; +++ register long *right; +++ register int size; +++{ +++ register long *result = result0; +++ +++ do { +++ *result++ = *left++ | *right++; +++ } while (--size); +++ return result0; +++} diff --cc usr/src/lib/libpc/APPEND.c index 0000000000,0000000000,0000000000..f98daf0acb new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/APPEND.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)APPEND.c 1.1 10/31/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++APPEND(filep) +++ +++ register struct iorec *filep; +++{ +++ filep = GETNAME (filep, 0, 0, 0); +++ filep->fbuf = fopen(filep->fname, "a"); +++ if (filep->fbuf == NULL) { +++ ERROR(EOPEN, filep->pfname); +++ return; +++ } +++ filep->funit |= (EOFF | FWRITE); +++ if (filep->fblk > PREDEF) { +++ setbuf(filep->fbuf, &filep->buf[0]); +++ } +++} diff --cc usr/src/lib/libpc/ARGV.c index 0000000000,0000000000,0000000000..5a4aebf92f new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ARGV.c @@@@ -1,0 -1,0 -1,0 +1,26 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ARGV.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++ARGV(subscript, var, size) +++ +++ int subscript; /* subscript into argv */ +++ register char *var; /* pointer to pascal char array */ +++ register int size; /* sizeof(var) */ +++{ +++ register char *cp; +++ +++ if (subscript >= _argc) { +++ ERROR(EARGV, subscript); +++ return; +++ } +++ cp = _argv[subscript]; +++ do { +++ *var++ = *cp++; +++ } while (--size && *cp); +++ while (size--) +++ *var++ = ' '; +++} diff --cc usr/src/lib/libpc/ASRT.c index 0000000000,0000000000,0000000000..8f7b89776a new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ASRT.c @@@@ -1,0 -1,0 -1,0 +1,15 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ASRT.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++ASRT(cond, stmt) +++ +++ short cond; +++ char *stmt; +++{ +++ if (cond) +++ return; +++ ERROR(EASRT, stmt); +++} diff --cc usr/src/lib/libpc/BUFF.c index 0000000000,0000000000,0000000000..382a69c33b new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/BUFF.c @@@@ -1,0 -1,0 -1,0 +1,20 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)BUFF.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++extern char _sobuf[]; +++ +++BUFF(amount) +++ +++ int amount; +++{ +++ struct iorec *curfile; +++ +++ curfile = OUTPUT; +++ if (amount == 0) +++ setbuf(0, ACTFILE(curfile)); +++ else if (amount == 2) +++ setbuf(_sobuf, ACTFILE(curfile)); +++} diff --cc usr/src/lib/libpc/CARD.c index 0000000000,0000000000,0000000000..0e6cdbfecb new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/CARD.c @@@@ -1,0 -1,0 -1,0 +1,36 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)CARD.c 1.1 10/29/80"; +++ +++char _cntbl[] = { +++ 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, +++ 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, +++ 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, +++ 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, +++ 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, +++ 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, +++ 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, +++ 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, +++ 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, +++ 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, +++ 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, +++ 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, +++ 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, +++ 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, +++ 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, +++ 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8 +++ }; +++ +++CARD(setptr, size) +++ +++ register unsigned char *setptr; +++ register int size; +++{ +++ register int cnt; +++ +++ cnt = 0; +++ do { +++ cnt += _cntbl[*setptr++]; +++ } while (--size); +++ return cnt; +++} diff --cc usr/src/lib/libpc/CHR.c index 0000000000,0000000000,0000000000..adf8d516ca new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/CHR.c @@@@ -1,0 -1,0 -1,0 +1,16 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)CHR.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++CHR(value) +++ +++ long value; +++{ +++ if (value < 0 || value > 127) { +++ ERROR(ECHR, value); +++ return; +++ } +++ return value; +++} diff --cc usr/src/lib/libpc/CLCK.c index 0000000000,0000000000,0000000000..6dacd16ddd new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/CLCK.c @@@@ -1,0 -1,0 -1,0 +1,11 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)CLCK.c 1.1 10/29/80"; +++ +++CLCK() +++{ +++ long tim[4]; +++ +++ times(tim); +++ return (tim[0] * 50) / 3; +++} diff --cc usr/src/lib/libpc/CTTOT.c index 0000000000,0000000000,0000000000..398a88510a new file mode 100755 --- /dev/null +++ b/usr/src/lib/libpc/CTTOT.c @@@@ -1,0 -1,0 -1,0 +1,91 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)CTTOT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++long _mask[] = { +++ 0xffffffff , 0xfffffffe , 0xfffffffc , 0xfffffff8 , +++ 0xfffffff0 , 0xffffffe0 , 0xffffffc0 , 0xffffff80 , +++ 0xffffff00 , 0xfffffe00 , 0xfffffc00 , 0xfffff800 , +++ 0xfffff000 , 0xffffe000 , 0xffffc000 , 0xffff8000 , +++ 0xffff0000 , 0xfffe0000 , 0xfffc0000 , 0xfff80000 , +++ 0xfff00000 , 0xffe00000 , 0xffc00000 , 0xff800000 , +++ 0xff000000 , 0xfe000000 , 0xfc000000 , 0xf8000000 , +++ 0xf0000000 , 0xe0000000 , 0xc0000000 , 0x80000000 , +++ 0x00000000 +++ }; +++/* +++ * Constant set constructor +++ */ +++ +++long * +++CTTOT(result, lowerbnd, upperbnd, paircnt, singcnt, data) +++ +++ long *result; /* pointer to final set */ +++ int lowerbnd; /* lower bound of set */ +++ int upperbnd; /* upper - lower of set */ +++ int paircnt; /* number of pairs to construct */ +++ int singcnt; /* number of singles to construct */ +++ int data; /* paircnt plus singcnt sets of data */ +++{ +++ register int lower; +++ register int lowerdiv; +++ register int lowermod; +++ register int upper; +++ int upperdiv; +++ int uppermod; +++ register int *dataptr; +++ register long *lp; +++ long *limit; +++ long temp; +++ long cnt; +++ +++ limit = &result[(upperbnd + 1 + BITSPERLONG - 1) / BITSPERLONG]; +++ for (lp = result; lp < limit; ) +++ *lp++ = 0; +++ dataptr = &data; +++ for (cnt = 0; cnt < paircnt; cnt++) { +++ upper = *dataptr++ - lowerbnd; +++ if (upper < 0 || upper > upperbnd) { +++ ERROR(ECTUPR, *--dataptr); +++ return; +++ } +++ lower = *dataptr++ - lowerbnd; +++ if (lower < 0 || lower > upperbnd) { +++ ERROR(ECTLWR, *--dataptr); +++ return; +++ } +++ if (lower > upper) { +++ continue; +++ } +++ lowerdiv = lower / BITSPERLONG; +++ lowermod = lower % BITSPERLONG; +++ upperdiv = upper / BITSPERLONG; +++ uppermod = upper % BITSPERLONG; +++ temp = _mask [lowermod]; +++ if ( lowerdiv == upperdiv ) { +++ temp &= ~_mask[ uppermod + 1 ]; +++ } +++ result[ lowerdiv ] |= temp; +++ limit = &result[ upperdiv-1 ]; +++ for ( lp = &result[ lowerdiv+1 ] ; lp <= limit ; lp++ ) { +++ *lp |= ~0; +++ } +++ if ( lowerdiv != upperdiv ) { +++ result[ upperdiv ] |= ~_mask[ uppermod + 1 ]; +++ } +++ } +++ for (cnt = 0; cnt < singcnt; cnt++) { +++ lower = *dataptr++ - lowerbnd; +++ if (lower < 0 || lower > upperbnd) { +++ ERROR(ECTSNG, *--dataptr); +++ return; +++ } +++ lowerdiv = lower / BITSPERLONG; +++ lowermod = lower % BITSPERLONG; +++ result[ lowerdiv ] |= ( 1 << lowermod ); +++ } +++ return(result); +++} diff --cc usr/src/lib/libpc/DATE.c index 0000000000,0000000000,0000000000..2adcb4482a new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/DATE.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)DATE.c 1.1 10/29/80"; +++ +++char _pd_date[] = { +++ 8, 9, 10, 4, 5, 6, 10, 22, 23, 10, 0 +++}; +++ +++extern char *ctime(); +++ +++DATE(alfap) +++ +++ register char *alfap; +++{ +++ register char *ap, *cp, *dp; +++ long a; +++ +++ time(&a); +++ cp = ctime(&a); +++ ap = alfap; +++ for (dp = _pd_date; *dp; *ap++ = cp[*dp++]); +++} diff --cc usr/src/lib/libpc/DEFNAME.c index 0000000000,0000000000,0000000000..861e3a8128 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/DEFNAME.c @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)DEFNAME.c 1.1 10/29/80"; +++ +++ +++#include "h00vars.h" +++ +++DEFNAME(filep, name, maxnamlen, datasize) +++ +++ register struct iorec *filep; +++ char *name; +++ int maxnamlen; +++ int datasize; +++{ +++ filep = GETNAME(filep, name, maxnamlen, datasize); +++ filep->funit |= FDEF; +++} diff --cc usr/src/lib/libpc/DISPOSE.c index 0000000000,0000000000,0000000000..413b7aea05 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/DISPOSE.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)DISPOSE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++DISPOSE(var, size) +++ register char **var; /* pointer to pointer being deallocated */ +++ int size; /* sizeof(bletch) */ +++{ +++ if (*var == 0 || *var + size > _maxptr || *var < _minptr) { +++ ERROR(ENILPTR,0); +++ return; +++ } +++ free(*var); +++ if (*var == _minptr) +++ _minptr += size; +++ if (*var + size == _maxptr) +++ _maxptr -= size; +++ *var = (char *)(0); +++} diff --cc usr/src/lib/libpc/ERROR.c index 0000000000,0000000000,0000000000..e31b467f54 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ERROR.c @@@@ -1,0 -1,0 -1,0 +1,176 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ERROR.c 1.1 10/29/80"; +++ +++#include "stdio.h" +++#include "signal.h" +++#include "h01errs.h" +++ +++/* +++ * Routine ERROR is called from the runtime library when a runtime error +++ * occurs. Its arguments are the internal number of the error which occurred, +++ * and an error specific piece of error data. The error file is constructed +++ * from errdata by the makefile using the editor script make.ed1. +++ */ +++ERROR(errnum, errdata) +++ +++ long errnum; +++ union cvt { +++ long longdat; +++ char *strngdat; +++ double dbldat; +++ } errdata; +++{ +++ PFLUSH(); +++ fputc('\n',stderr); +++ SETRACE(); +++ switch (errnum) { +++ case ECHR: +++ fprintf(stderr, "Argument to chr of %d is out of range\n" +++ ,errdata.longdat); +++ return(errdata.longdat); +++ case EHALT: +++ fputs("Call to procedure halt\n",stderr); +++ PCEXIT(0); +++ case ENILPTR: +++ fputs("Pointer value out of legal range\n",stderr); +++ return(0); +++ case EPASTEOF: +++ fprintf(stderr,"%s: Tried to read past end of file\n" +++ ,errdata.strngdat); +++ return(0); +++ case EREADIT: +++ fprintf(stderr,"%s: Attempt to read, but open for writing\n" +++ ,errdata.strngdat); +++ return(0); +++ case EWRITEIT: +++ fprintf(stderr,"%s: Attempt to write, but open for reading\n" +++ ,errdata.strngdat); +++ return(0); +++ case ECLOSE: +++ fprintf(stderr,"%s: Close failed\n",errdata.strngdat); +++ return(0); +++ case ELLIMIT: +++ fprintf(stderr,"%s: Line limit exceeded\n",errdata.strngdat); +++ return(0); +++ case ESQRT: +++ fprintf(stderr,"Negative argument of %E to sqrt\n" +++ ,errdata.dbldat); +++ return(errdata.dbldat); +++ case EREFINAF: +++ fprintf(stderr,"%s: ",errdata.strngdat); +++ case ENOFILE: +++ fputs("Reference to an inactive file\n",stderr); +++ return(0); +++ case EWRITE: +++ fputs("Could not write to ",stderr); +++ perror(errdata.strngdat); +++ return(0); +++ case EOPEN: +++ fputs("Could not open ",stderr); +++ perror(errdata.strngdat); +++ return(0); +++ case ECREATE: +++ fputs("Could not create ",stderr); +++ perror(errdata.strngdat); +++ return(0); +++ case EREMOVE: +++ fputs("Could not remove ",stderr); +++ perror(errdata.strngdat); +++ return(0); +++ case ESEEK: +++ fputs("Could not reset ",stderr); +++ perror(errdata.strngdat); +++ return(0); +++ case ENAMESIZE: +++ fprintf(stderr,"%s: File name too long\n",errdata.strngdat); +++ return(0); +++ case ELN: +++ fprintf(stderr,"Non-positive argument of %E to ln\n" +++ ,errdata.dbldat); +++ return(errdata.dbldat); +++ case EBADINUM: +++ fprintf(stderr,"%s: Bad data found on integer read\n" +++ ,errdata.strngdat); +++ return(0); +++ case EBADFNUM: +++ fprintf(stderr,"%s: Bad data found on real read\n" +++ ,errdata.strngdat); +++ return(0); +++ case ENUMNTFD: +++ fprintf(stderr, +++ "Unknown name \"%s\" found on enumerated type read\n", +++ errdata.strngdat); +++ return(0); +++ case ENAMRNG: +++ fprintf(stderr, +++ "Enumerated type value of %d is out of range on output\n", +++ errdata.longdat); +++ return(errdata.longdat); +++ case EFMTSIZE: +++ fprintf(stderr,"Negative format width: %d\n",errdata.longdat); +++ return(0); +++ case EGOTO: +++ fputs("Active frame not found in non-local goto\n", stderr); +++ return(0); +++ case ECASE: +++ fprintf(stderr,"Label of %d not found in case\n" +++ ,errdata.longdat); +++ return(errdata.longdat); +++ case EOUTOFMEM: +++ fputs("Ran out of memory\n",stderr); +++ return(0); +++ case ECTLWR: +++ fprintf(stderr, "Range lower bound of %d out of set bounds\n", +++ errdata.longdat); +++ return(0); +++ case ECTUPR: +++ fprintf(stderr, "Range upper bound of %d out of set bounds\n", +++ errdata.longdat); +++ return(0); +++ case ECTSNG: +++ fprintf(stderr, "Value of %d out of set bounds\n", +++ errdata.longdat); +++ return(0); +++ case ENARGS: +++ if (errdata.longdat < 0) +++ fprintf(stderr, +++ "There were %d too few arguments to formal routine\n", +++ -errdata.longdat); +++ else +++ fprintf(stderr, +++ "There were %d too many arguments to formal routine\n", +++ errdata.longdat); +++ return(0); +++ case EARGV: +++ fprintf(stderr,"Argument to argv of %d is out of range\n" +++ ,errdata.longdat); +++ return(errdata.longdat); +++ case EPACK: +++ fprintf(stderr,"i = %d: Bad i to pack(a,i,z)\n" +++ ,errdata.longdat); +++ return(errdata.longdat); +++ case EUNPACK: +++ fprintf(stderr,"i = %d: Bad i to unpack(z,a,i)\n" +++ ,errdata.longdat); +++ return(errdata.longdat); +++ case ERANGE: +++ fprintf(stderr,"Value of %d is out of range\n",errdata.longdat); +++ return(errdata.longdat); +++ case ESUBSC: +++ fprintf(stderr,"Subscript value of %d is out of range\n" +++ ,errdata.longdat); +++ return(errdata.longdat); +++ case EASRT: +++ fprintf(stderr,"Assertion failed: %s\n",errdata.strngdat); +++ return(0); +++ case ESTLIM: +++ fprintf(stderr, +++ "Statement count limit exceeded, %d statements executed\n", +++ errdata.longdat); +++ return(errdata.longdat); +++ default: +++ fputs("Panic: unknown error\n",stderr); +++ return(0); +++ } +++} diff --cc usr/src/lib/libpc/EXPO.c index 0000000000,0000000000,0000000000..418581eae8 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/EXPO.c @@@@ -1,0 -1,0 -1,0 +1,12 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)EXPO.c 1.1 10/29/80"; +++ +++EXPO(value) +++ +++ long value; +++{ +++ if (value == 0) +++ return 0; +++ return ((value & ~0xffff8000) >> 7) - 128; +++} diff --cc usr/src/lib/libpc/FCALL.c index 0000000000,0000000000,0000000000..0d3fbc7b5f new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/FCALL.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)FCALL.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++FCALL(frtn) +++ register struct formalrtn *frtn; +++{ +++ register struct display *dp; +++ register struct display *ds; +++ struct display *limit; +++ +++ limit = &frtn->disp[2 * frtn->cbn]; +++ for (dp = &_disply[1], ds = &frtn->disp[frtn->cbn]; ds < limit; ) +++ *ds++ = *dp++; +++ limit = &frtn->disp[frtn->cbn]; +++ for (ds = &frtn->disp[0], dp = &_disply[1]; ds < limit; ) +++ *dp++ = *ds++; +++ return (long)(frtn->entryaddr); +++} diff --cc usr/src/lib/libpc/FLUSH.c index 0000000000,0000000000,0000000000..0471e0418c new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/FLUSH.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)FLUSH.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++FLUSH(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->fblk >= MAXFILES || _actfile[curfile->fblk] != curfile) { +++ ERROR(ENOFILE, 0); +++ return; +++ } +++ if (curfile->funit & FWRITE) { +++ fflush(curfile->fbuf); +++ } +++} diff --cc usr/src/lib/libpc/FNIL.c index 0000000000,0000000000,0000000000..af1aed7da3 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/FNIL.c @@@@ -1,0 -1,0 -1,0 +1,29 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)FNIL.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++char * +++FNIL(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->fblk >= MAXFILES || _actfile[curfile->fblk] != curfile) { +++ ERROR(ENOFILE, 0); +++ return; +++ } +++ if (curfile->funit & FDEF) { +++ ERROR(EREFINAF, curfile->pfname); +++ return; +++ } +++ if (curfile->funit & FREAD) { +++ IOSYNC(curfile); +++ if (curfile->funit & EOFF) { +++ ERROR(EPASTEOF, curfile->pfname); +++ return; +++ } +++ } +++ return curfile->fileptr; +++} diff --cc usr/src/lib/libpc/FRTN.c index 0000000000,0000000000,0000000000..753e815f9b new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/FRTN.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)FRTN.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++FRTN(frtn, result) +++ register struct formalrtn *frtn; +++ int result; +++{ +++ register struct display *dp; +++ register struct display *ds; +++ struct display *limit; +++ +++ limit = &frtn->disp[2 * frtn->cbn]; +++ for (ds = &frtn->disp[frtn->cbn], dp = &_disply[1]; ds < limit; ) +++ *dp++ = *ds++; +++ return result; +++} diff --cc usr/src/lib/libpc/FSAV.c index 0000000000,0000000000,0000000000..150345bc9e new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/FSAV.c @@@@ -1,0 -1,0 -1,0 +1,23 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)FSAV.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++struct formalrtn * +++FSAV(entryaddr, cbn, frtn) +++ long (*entryaddr)(); +++ long cbn; +++ register struct formalrtn *frtn; +++{ +++ register struct display *dp; +++ register struct display *ds; +++ struct display *limit; +++ +++ frtn->entryaddr = entryaddr; +++ frtn->cbn = cbn; +++ limit = &frtn->disp[frtn->cbn]; +++ for (dp = &_disply[1], ds = &frtn->disp[0]; ds < limit; ) +++ *ds++ = *dp++; +++ return frtn; +++} diff --cc usr/src/lib/libpc/GET.c index 0000000000,0000000000,0000000000..88121bfc09 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/GET.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)GET.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++GET(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->funit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ IOSYNC(curfile); +++ if (curfile->funit & EOFF) { +++ ERROR(EPASTEOF, curfile->pfname); +++ return; +++ } +++ curfile->funit |= SYNC; +++} diff --cc usr/src/lib/libpc/GETNAME.c index 0000000000,0000000000,0000000000..9ba1eb113a new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/GETNAME.c @@@@ -1,0 -1,0 -1,0 +1,134 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)GETNAME.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++/* +++ * GETNAME - activate a file +++ * +++ * takes a name, name length, element size, and variable +++ * level and returns a pointer to a file structure. +++ * +++ * a new file structure is initialized if necessary. +++ * temporary names are generated, and given +++ * names are blank trimmed. +++ */ +++ +++struct iorec * +++GETNAME(filep, name, maxnamlen, datasize) +++ +++ register struct iorec *filep; +++ char *name; +++ int maxnamlen; +++ int datasize; +++{ +++ struct iorec *prev; +++ struct iorec *next; +++ register int cnt; +++ struct iorec locvar; +++ extern char *mktemp(); +++ +++ if (filep->fblk >= MAXFILES || _actfile[filep->fblk] != filep) { +++ /* +++ * initialize a new filerecord +++ */ +++ filep->funit = 0; +++ if (datasize == 0) { +++ filep->funit |= FTEXT; +++ datasize = 1; +++ } +++ filep->fsize = datasize; +++ filep->fbuf = 0; +++ filep->lcount = 0; +++ filep->llimit = 0x7fffffff; +++ filep->fileptr = &filep->window[0]; +++ /* +++ * check to see if file is global, or allocated in +++ * the stack by checking its address against the +++ * address of one of our routine's local variables. +++ */ +++ if (filep < &locvar) +++ filep->flev = GLVL; +++ else +++ filep->flev = filep; +++ do { +++ if (++_filefre == MAXFILES) +++ _filefre = PREDEF + 1; +++ } while (_actfile[_filefre] != FILNIL); +++ filep->fblk = _filefre; +++ _actfile[_filefre] = filep; +++ /* +++ * link the newrecord into the file chain +++ */ +++ prev = (struct iorec *)&_fchain; +++ next = _fchain.fchain; +++ while (filep->flev > next->flev) { +++ prev = next; +++ next = next->fchain; +++ } +++ filep->fchain = next; +++ prev->fchain = filep; +++ } else { +++ if (filep->funit & FDEF) { +++ filep->funit &= (TEMP | FTEXT); +++ } else { +++ /* +++ * have a previous buffer, close associated file +++ */ +++ fclose(filep->fbuf); +++ if (ferror(filep->fbuf)) { +++ ERROR(ECLOSE, filep->pfname); +++ return; +++ } +++ /* +++ * renamed temporary files are discarded +++ */ +++ if ((filep->funit & TEMP) && +++ (name != NULL) && +++ (unlink(filep->pfname))) { +++ ERROR(EREMOVE, filep->pfname); +++ return; +++ } +++ filep->funit &= (TEMP | FTEXT); +++ } +++ } +++ /* +++ * get the filename associated with the buffer +++ */ +++ if (name == NULL) { +++ if (*filep->fname != NULL) { +++ return(filep); +++ } +++ /* +++ * no name given and no previous name, so generate +++ * a new one of the form tmp.xxxxxx +++ */ +++ filep->funit |= TEMP; +++ name = mktemp("tmp.XXXXXX"); +++ maxnamlen = 10; +++ } else { +++ /* +++ * trim trailing blanks, and insure that the name +++ * will fit into the file structure +++ */ +++ for (cnt = 0; cnt < maxnamlen; cnt++) +++ if (name[cnt] == '\0' || name[cnt] == ' ') +++ break; +++ if (cnt >= NAMSIZ) { +++ ERROR(ENAMESIZE, name); +++ return; +++ } +++ maxnamlen = cnt; +++ filep->funit &= ~TEMP; +++ } +++ /* +++ * put the new name into the structure +++ */ +++ for (cnt = 0; cnt < maxnamlen; cnt++) +++ filep->fname[cnt] = name[cnt]; +++ filep->fname[cnt] = '\0'; +++ filep->pfname = &filep->fname[0]; +++ return(filep); +++} diff --cc usr/src/lib/libpc/GOTO.s index 0000000000,0000000000,0000000000..3bbc8eb646 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/GOTO.s @@@@ -1,0 -1,0 -1,0 +1,41 @@@@ +++# Copyright (c) 1979 Regents of the University of California +++# +++# sccsid[] = "@(#)GOTO.s 1.1 10/29/80"; +++# +++ .data +++jmplbl: +++ .long 0 +++frame: +++ .long 0 +++ .text +++ +++ .globl _GOTO +++ .align 1 +++_GOTO: +++ .word 0 +++ movl *4(ap),frame #save parameters +++ movl PC(fp),jmplbl +++ moval unwind,PC(fp) #begin unwinding +++ ret +++unwind: +++ tstl (fp) #check for exception vector +++ bneq L1 +++ cmpl ap,__disply+8 #check for past global procedure +++ bgequ egoto +++ moval unwind,PC(fp) #blow away this stack frame +++ ret +++L1: +++ cmpl ap,frame #check for requested frame +++ bgtru egoto #lost it somewhere +++ blssu L2 #not there yet +++ jmp *jmplbl #proceed in this section +++L2: +++ pushl -4(fp) #level of this frame +++ calls $1,*(fp) #call the exception handler +++ movq -12(fp),*-4(fp) #restore the display +++ moval unwind,PC(fp) #blow away this stack frame +++ ret +++egoto: +++ pushl $EGOTO +++ calls $1,_ERROR +++ ret diff --cc usr/src/lib/libpc/HALT.c index 0000000000,0000000000,0000000000..e708489953 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/HALT.c @@@@ -1,0 -1,0 -1,0 +1,10 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)HALT.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++HALT() +++{ +++ ERROR(EHALT, 0); +++} diff --cc usr/src/lib/libpc/IN.c index 0000000000,0000000000,0000000000..26ed8f8306 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/IN.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)IN.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++IN(element, lower, upper, setptr) +++ +++ int element; /* element to check */ +++ int lower; /* lowest element of set */ +++ int upper; /* upper - lower of set */ +++ char setptr[]; /* pointer to set */ +++{ +++ int indx; +++ +++ if ((indx = element - lower) < 0 || indx > upper) +++ return FALSE; +++ if (setptr[indx / BITSPERBYTE] & (1 << (indx % BITSPERBYTE))) +++ return TRUE; +++ return FALSE; +++} diff --cc usr/src/lib/libpc/INCT.c index 0000000000,0000000000,0000000000..bf39af87b8 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/INCT.c @@@@ -1,0 -1,0 -1,0 +1,33 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)INCT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++INCT(element, paircnt, singcnt, data) +++ +++ register int element; /* element to find */ +++ int paircnt; /* number of pairs to check */ +++ int singcnt; /* number of singles to check */ +++ int data; /* paircnt plus singcnt bounds */ +++{ +++ register int *dataptr; +++ register int cnt; +++ +++ dataptr = &data; +++ for (cnt = 0; cnt < paircnt; cnt++) { +++ if (element > *dataptr++) { +++ dataptr++; +++ continue; +++ } +++ if (element >= *dataptr++) { +++ return TRUE; +++ } +++ } +++ for (cnt = 0; cnt < singcnt; cnt++) { +++ if (element == *dataptr++) { +++ return TRUE; +++ } +++ } +++ return FALSE; +++} diff --cc usr/src/lib/libpc/IOSYNC.c index 0000000000,0000000000,0000000000..8d101f82a3 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/IOSYNC.c @@@@ -1,0 -1,0 -1,0 +1,51 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)IOSYNC.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++/* +++ * insure that a usable image is in the buffer window +++ */ +++IOSYNC(curfile) +++ +++ register struct iorec *curfile; +++{ +++ register short unit = curfile->funit; +++ char *limit, *ptr; +++ +++ if (unit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ if ((unit & SYNC) == 0) { +++ return; +++ } +++ if (unit & EOFF) { +++ ERROR(EPASTEOF, curfile->pfname); +++ return; +++ } +++ unit &= ~SYNC; +++ fread(curfile->fileptr, curfile->fsize, 1, curfile->fbuf); +++ if (ferror(curfile->fbuf)) { +++ ERROR(EPASTEOF, curfile->pfname); +++ return; +++ } +++ if (feof(curfile->fbuf)) { +++ curfile->funit = unit | EOFF; +++ limit = &curfile->fileptr[curfile->fsize]; +++ for (ptr = curfile->fileptr; ptr < limit; ) +++ *ptr++ = 0; +++ return; +++ } +++ if (unit & FTEXT) { +++ if (*curfile->fileptr == '\n') { +++ unit |= EOLN; +++ *curfile->fileptr = ' '; +++ } else { +++ unit &= ~EOLN; +++ } +++ } +++ curfile->funit = unit; +++} diff --cc usr/src/lib/libpc/LINO.c index 0000000000,0000000000,0000000000..67dfbc41de new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/LINO.c @@@@ -1,0 -1,0 -1,0 +1,14 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)LINO.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++LINO() +++{ +++ if (++_stcnt >= _stlim) { +++ ERROR(ESTLIM, _stcnt); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/LLIMIT.c index 0000000000,0000000000,0000000000..21a54080f7 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/LLIMIT.c @@@@ -1,0 -1,0 -1,0 +1,20 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)LLIMIT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++LLIMIT(curfile, limit) +++ +++ register struct iorec *curfile; +++ int limit; +++{ +++ if (limit <= 0) +++ limit = 0x7fffffff; +++ curfile->llimit = limit; +++ if (curfile->lcount >= curfile->llimit) { +++ ERROR(ELLIMIT, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/LN.c index 0000000000,0000000000,0000000000..3e156fdc3c new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/LN.c @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)LN.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++double +++LN(value) +++ +++ double value; +++{ +++ if (value <= 0) { +++ ERROR(ELN, value); +++ return; +++ } +++ return log(value); +++} diff --cc usr/src/lib/libpc/MAX.c index 0000000000,0000000000,0000000000..830f7aca69 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/MAX.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)MAX.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++MAX(width, reduce, min) +++ +++ register int width; /* requested width */ +++ int reduce; /* amount of extra space required */ +++ int min; /* minimum amount of space needed */ +++{ +++ if (width < 0) { +++ ERROR(EFMTSIZE, width); +++ return; +++ } +++ if ((width -= reduce) >= min) +++ return width; +++ return min; +++} diff --cc usr/src/lib/libpc/MULT.c index 0000000000,0000000000,0000000000..3c2d3aa4a0 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/MULT.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)MULT.c 1.1 10/29/80"; +++ +++long * +++MULT(result0, left, right, size) +++ +++ long *result0; +++ register long *left; +++ register long *right; +++ register int size; +++{ +++ register long *result = result0; +++ +++ do { +++ *result++ = *left++ & *right++; +++ } while (--size); +++ return result0; +++} diff --cc usr/src/lib/libpc/NAM.c index 0000000000,0000000000,0000000000..527cbac88d new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/NAM.c @@@@ -1,0 -1,0 -1,0 +1,23 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)NAM.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++char * +++NAM(value, name) +++ +++ register int value; /* internal enumerated type value */ +++ char *name; /* ptr to enumerated type name descriptor */ +++{ +++ register short *sptr; +++ +++ sptr = (short *)name; +++ if (value < 0 || value >= *sptr) { +++ ERROR(ENAMRNG, value); +++ return; +++ } +++ sptr++; +++ return name + 2 + sptr[value]; +++} diff --cc usr/src/lib/libpc/NARGCHK.s index 0000000000,0000000000,0000000000..d02bb2ac6a new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/NARGCHK.s @@@@ -1,0 -1,0 -1,0 +1,16 @@@@ +++# Copyright (c) 1979 Regents of the University of California +++# +++# sccsid[] = "@(#)NARGCHK.s 1.1 10/29/80"; +++# +++ .align 1 +++ .globl _NARGCHK +++_NARGCHK: +++ .word 0 +++ cmpl 4(ap),*AP(fp) +++ bneq L1 +++ ret +++L1: +++ subl3 4(ap),*AP(fp),-(sp) +++ pushl $ENARGS +++ calls $2,_ERROR +++ ret diff --cc usr/src/lib/libpc/NEW.c index 0000000000,0000000000,0000000000..efa3f04721 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/NEW.c @@@@ -1,0 -1,0 -1,0 +1,25 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)NEW.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++NEW(var, size) +++ char **var; /* pointer to item being deallocated */ +++ int size; /* sizeof struct pointed to by var */ +++{ +++ extern char *malloc(); +++ char *memblk; +++ +++ memblk = malloc(size); +++ if (memblk == 0) { +++ ERROR(EOUTOFMEM,0); +++ return; +++ } +++ *var = memblk; +++ if (memblk < _minptr) +++ _minptr = memblk; +++ if (memblk + size > _maxptr) +++ _maxptr = memblk + size; +++} diff --cc usr/src/lib/libpc/NEWZ.c index 0000000000,0000000000,0000000000..9ce493c6e6 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/NEWZ.c @@@@ -1,0 -1,0 -1,0 +1,29 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)NEWZ.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++NEWZ(var, size) +++ char **var; /* pointer to item being deallocated */ +++ int size; /* sizeof struct pointed to by var */ +++{ +++ register char *cp; +++ char *limit; +++ extern char *malloc(); +++ +++ cp = malloc(size); +++ if (cp == 0) { +++ ERROR(EOUTOFMEM,0); +++ return; +++ } +++ *var = cp; +++ if (cp < _minptr) +++ _minptr = cp; +++ limit = cp + size; +++ if (limit > _maxptr) +++ _maxptr = limit; +++ for (; cp < limit; *cp++ = '\0') +++ /* void */; +++} diff --cc usr/src/lib/libpc/NIL.c index 0000000000,0000000000,0000000000..cfa544d805 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/NIL.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)NIL.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++char * +++NIL(ptr) +++ +++ char *ptr; /* pointer to struct */ +++{ +++ if (ptr > _maxptr || ptr < _minptr) { +++ ERROR(ENILPTR, 0); +++ return; +++ } +++ return ptr; +++} diff --cc usr/src/lib/libpc/PACK.c index 0000000000,0000000000,0000000000..d329cf11cb new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PACK.c @@@@ -1,0 -1,0 -1,0 +1,50 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PACK.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++/* +++ * pack(a,i,z) +++ * +++ * with: a: array[m..n] of t +++ * z: packed array[u..v] of t +++ * +++ * semantics: for j := u to v do +++ * z[j] := a[j-u+i]; +++ * +++ * need to check: +++ * 1. i >= m +++ * 2. i+(v-u) <= n (i.e. i-m <= (n-m)-(v-u)) +++ * +++ * on stack: lv(z), lv(a), rv(i) (len 4) +++ * +++ * move w(t)*(v-u+1) bytes from lv(a)+w(t)*(i-m) to lv(z) +++ */ +++ +++PACK(i, a, z, size_a, lb_a, ub_a, size_z) +++ +++ int i; /* subscript into a to begin packing */ +++ char *a; /* pointer to structure a */ +++ char *z; /* pointer to structure z */ +++ int size_a; /* sizeof(a_type) */ +++ int lb_a; /* lower bound of structure a */ +++ int ub_a; /* (upper bound of a) - (lb_a + sizeof(z_type)) */ +++ int size_z; /* sizeof(z_type) */ +++{ +++ int subscr; +++ register char *cp; +++ register char *zp = z; +++ register char *limit; +++ +++ subscr = i - lb_a; +++ if (subscr < 0 || subscr > ub_a) { +++ ERROR(EPACK, i); +++ return; +++ } +++ cp = &a[subscr * size_a]; +++ limit = cp + size_z; +++ do { +++ *zp++ = *cp++; +++ } while (cp < limit); +++} diff --cc usr/src/lib/libpc/PAGE.c index 0000000000,0000000000,0000000000..9681c7b2e6 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PAGE.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PAGE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++PAGE(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->funit & FREAD) { +++ ERROR(EWRITEIT, curfile->pfname); +++ return; +++ } +++ fputc(' ', curfile->fbuf); +++ if (ferror(curfile->fbuf)) { +++ ERROR(EWRITE, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/PCEXIT.c index 0000000000,0000000000,0000000000..45b14aa2d6 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PCEXIT.c @@@@ -1,0 -1,0 -1,0 +1,29 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PCEXIT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++PCEXIT(code) +++ +++ int code; +++{ +++ struct { +++ long usr_time; +++ long sys_time; +++ long child_usr_time; +++ long child_sys_time; +++ } tbuf; +++ double l; +++ +++ PCLOSE(GLVL); +++ PFLUSH(); +++ if (_stcnt > 0) { +++ times(&tbuf); +++ l = tbuf.usr_time; +++ l = l / HZ; +++ fprintf(stderr, "\n%1ld %s %04.2f seconds cpu time.\n", +++ _stcnt, "statements executed in", l); +++ } +++ exit(code); +++} diff --cc usr/src/lib/libpc/PCLOSE.c index 0000000000,0000000000,0000000000..a23cfe9d6f new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PCLOSE.c @@@@ -1,0 -1,0 -1,0 +1,34 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PCLOSE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++PCLOSE(level) +++ +++ struct iorec *level; +++{ +++ register struct iorec *next; +++ +++ next = _fchain.fchain; +++ while(next != FILNIL && next->flev <= level) { +++ if (next->fbuf != 0) { +++ if ((next->funit & FDEF) == 0) { +++ fclose(next->fbuf); +++ if (ferror(next->fbuf)) { +++ ERROR(ECLOSE, next->pfname); +++ return; +++ } +++ } +++ if ((next->funit & TEMP) != 0 && +++ unlink(next->pfname)) { +++ ERROR(EREMOVE, next->pfname); +++ return; +++ } +++ } +++ _actfile[next->fblk] = FILNIL; +++ next = next->fchain; +++ } +++ _fchain.fchain = next; +++} diff --cc usr/src/lib/libpc/PCSTART.c index 0000000000,0000000000,0000000000..3d269ff752 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PCSTART.c @@@@ -1,0 -1,0 -1,0 +1,83 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PCSTART.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++/* +++ * program variables +++ */ +++struct display _disply[MAXLVL]; +++int _argc; +++char **_argv; +++long _stlim = 500000; +++long _stcnt = 0; +++char *_minptr = (char *)0x7fffffff; +++char *_maxptr = (char *)0; +++ +++/* +++ * file record variables +++ */ +++long _filefre = PREDEF; +++struct iorechd _fchain = { +++ 0, 0, 0, 0, /* only use fchain field */ +++ INPUT /* fchain */ +++}; +++struct iorec *_actfile[MAXFILES] = { +++ INPUT, +++ OUTPUT, +++ ERR +++}; +++ +++/* +++ * standard files +++ */ +++char _inwin, _outwin, _errwin; +++struct iorechd input = { +++ &_inwin, /* fileptr */ +++ 0, /* lcount */ +++ 0x7fffffff, /* llimit */ +++ &_iob[0], /* fbuf */ +++ OUTPUT, /* fchain */ +++ STDLVL, /* flev */ +++ "standard input", /* pfname */ +++ FTEXT | FREAD | SYNC, /* funit */ +++ 0, /* fblk */ +++ 1 /* fsize */ +++}; +++struct iorechd output = { +++ &_outwin, /* fileptr */ +++ 0, /* lcount */ +++ 0x7fffffff, /* llimit */ +++ &_iob[1], /* fbuf */ +++ ERR, /* fchain */ +++ STDLVL, /* flev */ +++ "standard output", /* pfname */ +++ FTEXT | FWRITE | EOFF, /* funit */ +++ 1, /* fblk */ +++ 1 /* fsize */ +++}; +++struct iorechd _err = { +++ &_errwin, /* fileptr */ +++ 0, /* lcount */ +++ 0x7fffffff, /* llimit */ +++ &_iob[2], /* fbuf */ +++ FILNIL, /* fchain */ +++ STDLVL, /* flev */ +++ "Message file", /* pfname */ +++ FTEXT | FWRITE | EOFF, /* funit */ +++ 2, /* fblk */ +++ 1 /* fsize */ +++}; +++ +++PCSTART() +++{ +++ /* +++ * necessary only on systems which do not initialize +++ * memory to zero +++ */ +++ +++ struct iorec **ip; +++ +++ for (ip = &_actfile[3]; ip < &_actfile[MAXFILES]; *ip++ = FILNIL); +++} diff --cc usr/src/lib/libpc/PFLUSH.c index 0000000000,0000000000,0000000000..c50e336e88 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PFLUSH.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PFLUSH.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++/* +++ * insure that a usable image is in the buffer window +++ */ +++PFLUSH() +++{ +++ register struct iorec *next; +++ +++ next = _fchain.fchain; +++ while(next != FILNIL) { +++ if ((next->funit & (FDEF | FREAD)) == 0) { +++ fflush(next->fbuf); +++ } +++ next = next->fchain; +++ } +++} diff --cc usr/src/lib/libpc/PMFLUSH.c index 0000000000,0000000000,0000000000..d1edfeffc8 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PMFLUSH.c @@@@ -1,0 -1,0 -1,0 +1,29 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PMFLUSH.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++PMFLUSH(cntrs, rtns) +++ +++ long cntrs; /* total number of counters (stmt + routine) */ +++ long rtns; /* number of func and proc counters */ +++{ +++ register FILE *filep; +++ +++ _pcpcount[0] = 0426; +++ _pcpcount[1] = time(); +++ _pcpcount[2] = cntrs; +++ _pcpcount[3] = rtns; +++ filep = fopen(PXPFILE, "w"); +++ if (filep == NULL) +++ goto ioerr; +++ fwrite(&_pcpcount[0], cntrs + 1, sizeof(long), filep); +++ if (ferror(filep)) +++ goto ioerr; +++ fclose(filep); +++ if (!ferror(filep)) +++ return; +++ioerr: +++ perror(PXPFILE); +++} diff --cc usr/src/lib/libpc/PRED.c index 0000000000,0000000000,0000000000..002018c0ab new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PRED.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PRED.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++PRED(value, lower, upper) +++ +++ int value; +++ int lower; +++ int upper; +++{ +++ value--; +++ if (value < lower || value > upper) { +++ ERROR(ERANGE, value); +++ return; +++ } +++ return value; +++} diff --cc usr/src/lib/libpc/PUT.c index 0000000000,0000000000,0000000000..bff78474a6 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/PUT.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)PUT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++PUT(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->funit & FREAD) { +++ ERROR(EWRITEIT, curfile->pfname); +++ return; +++ } +++ fwrite(curfile->fileptr, curfile->fsize, 1, curfile->fbuf); +++ if (ferror(curfile->fbuf)) { +++ ERROR(EWRITE, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/RANDOM.c index 0000000000,0000000000,0000000000..fa79148dd6 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RANDOM.c @@@@ -1,0 -1,0 -1,0 +1,12 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RANDOM.c 1.1 10/29/80"; +++ +++double +++RANDOM() +++{ +++ /* +++ * div by maxint to get 0..1 +++ */ +++ return (rand() / 2.147483647e+09); +++} diff --cc usr/src/lib/libpc/RANG4.c index 0000000000,0000000000,0000000000..43b16b7a1f new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RANG4.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RANG4.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++RANG4(value, lower, upper) +++ +++ int value; +++ int lower; +++ int upper; +++{ +++ if (value < lower || value > upper) { +++ ERROR(ERANGE, value); +++ return; +++ } +++ return value; +++} diff --cc usr/src/lib/libpc/READ4.c index 0000000000,0000000000,0000000000..b9184db6f4 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/READ4.c @@@@ -1,0 -1,0 -1,0 +1,25 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)READ4.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++READ4(curfile) +++ +++ register struct iorec *curfile; +++{ +++ int data; +++ +++ if (curfile->funit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ UNSYNC(curfile); +++ if (fscanf(curfile->fbuf, "%ld", &data) == 0) { +++ ERROR(EBADINUM, curfile->pfname); +++ return; +++ } +++ curfile->funit |= SYNC; +++ return data; +++} diff --cc usr/src/lib/libpc/READ8.c index 0000000000,0000000000,0000000000..318dd2436a new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/READ8.c @@@@ -1,0 -1,0 -1,0 +1,26 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)READ8.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++double +++READ8(curfile) +++ +++ register struct iorec *curfile; +++{ +++ double data; +++ +++ if (curfile->funit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ UNSYNC(curfile); +++ if (fscanf(curfile->fbuf, "%lf", &data) == 0) { +++ ERROR(EBADFNUM, curfile->pfname); +++ return; +++ } +++ curfile->funit |= SYNC; +++ return data; +++} diff --cc usr/src/lib/libpc/READC.c index 0000000000,0000000000,0000000000..989f3ffe30 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/READC.c @@@@ -1,0 -1,0 -1,0 +1,26 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)READC.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++char +++READC(curfile) +++ +++ register struct iorec *curfile; +++{ +++ char data; +++ +++ if (curfile->funit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ IOSYNC(curfile); +++ if (curfile->funit & EOFF) { +++ ERROR(EPASTEOF, curfile->pfname); +++ return; +++ } +++ curfile->funit |= SYNC; +++ return *curfile->fileptr; +++} diff --cc usr/src/lib/libpc/READE.c index 0000000000,0000000000,0000000000..d9d70166b3 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/READE.c @@@@ -1,0 -1,0 -1,0 +1,49 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)READE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++READE(curfile, name) +++ +++ register struct iorec *curfile; +++ char *name; +++{ +++ long data; +++ +++ register short *sptr; +++ register int len; +++ register int nextlen; +++ register int cnt; +++ char *cp; +++ char namebuf[NAMSIZ]; +++ +++ if (curfile->funit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ UNSYNC(curfile); +++ if (fscanf(curfile->fbuf, +++ "%*[ \t\n]%74[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789]", +++ namebuf) == 0) { +++ ERROR(ENUMNTFD, namebuf); +++ return; +++ } +++ curfile->funit |= SYNC; +++ for (len = 0; len < NAMSIZ && namebuf[len]; len++) +++ /* void */; +++ len++; +++ sptr = (short *)name; +++ cnt = *sptr++; +++ cp = name + sizeof (short) + *sptr; +++ do { +++ nextlen = *sptr++; +++ nextlen = *sptr - nextlen; +++ if (nextlen == len && RELEQ(len, namebuf, cp)) { +++ return *((short *) name) - cnt; +++ } +++ cp += nextlen; +++ } while (--cnt); +++ ERROR(ENUMNTFD, namebuf); +++} diff --cc usr/src/lib/libpc/READLN.c index 0000000000,0000000000,0000000000..bc7b584f5a new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/READLN.c @@@@ -1,0 -1,0 -1,0 +1,25 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)READLN.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++READLN(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->funit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ IOSYNC(curfile); +++ if (curfile->funit & EOFF) { +++ ERROR(EPASTEOF, curfile->pfname); +++ return; +++ } +++ if ((curfile->funit & EOLN) == 0) { +++ fscanf(curfile->fbuf, "%*[^\n]%*c"); +++ } +++ curfile->funit |= SYNC; +++} diff --cc usr/src/lib/libpc/RELEQ.c index 0000000000,0000000000,0000000000..a977c105f5 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELEQ.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELEQ.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELEQ(size, str1, str2) +++ +++ register int size; +++ register char *str1; +++ register char *str2; +++{ +++ while (*str1++ == *str2++ && --size) +++ /* void */; +++ if (size == 0) +++ return TRUE; +++ return FALSE; +++} diff --cc usr/src/lib/libpc/RELNE.c index 0000000000,0000000000,0000000000..9538024ffa new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELNE.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELNE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELNE(size, str1, str2) +++ +++ register int size; +++ register char *str1; +++ register char *str2; +++{ +++ while (*str1++ == *str2++ && --size) +++ /* void */; +++ if (size == 0) +++ return FALSE; +++ return TRUE; +++} diff --cc usr/src/lib/libpc/RELSGE.c index 0000000000,0000000000,0000000000..738d8e56cd new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELSGE.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELSGE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELSGE(size, str1, str2) +++ +++ register int size; +++ register char *str1; +++ register char *str2; +++{ +++ while (*str1++ == *str2++ && --size) +++ /* void */; +++ if ((size == 0) || (*--str1 >= *--str2)) +++ return TRUE; +++ return FALSE; +++} diff --cc usr/src/lib/libpc/RELSGT.c index 0000000000,0000000000,0000000000..7baf410082 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELSGT.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELSGT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELSGT(size, str1, str2) +++ +++ register int size; +++ register char *str1; +++ register char *str2; +++{ +++ while (*str1++ == *str2++ && --size) +++ /* void */; +++ if ((size == 0) || (*--str1 <= *--str2)) +++ return FALSE; +++ return TRUE; +++} diff --cc usr/src/lib/libpc/RELSLE.c index 0000000000,0000000000,0000000000..525d407352 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELSLE.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELSLE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELSLE(size, str1, str2) +++ +++ register int size; +++ register char *str1; +++ register char *str2; +++{ +++ while (*str1++ == *str2++ && --size) +++ /* void */; +++ if ((size == 0) || (*--str1 <= *--str2)) +++ return TRUE; +++ return FALSE; +++} diff --cc usr/src/lib/libpc/RELSLT.c index 0000000000,0000000000,0000000000..b95203fb91 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELSLT.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELSLT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELSLT(size, str1, str2) +++ +++ register int size; +++ register char *str1; +++ register char *str2; +++{ +++ while (*str1++ == *str2++ && --size) +++ /* void */; +++ if ((size == 0) || (*--str1 >= *--str2)) +++ return FALSE; +++ return TRUE; +++} diff --cc usr/src/lib/libpc/RELTGE.c index 0000000000,0000000000,0000000000..30c5b5c222 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELTGE.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELTGE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELTGE(bytecnt, left, right) +++ +++ int bytecnt; +++ register long *left; +++ register long *right; +++{ +++ register int longcnt; +++ +++ longcnt = bytecnt >> 2; +++ do { +++ if ((*right++ & ~*left++) != 0) +++ return FALSE; +++ } while (--longcnt); +++ return TRUE; +++} diff --cc usr/src/lib/libpc/RELTGT.c index 0000000000,0000000000,0000000000..10ac01e21f new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELTGT.c @@@@ -1,0 -1,0 -1,0 +1,29 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELTGT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELTGT(bytecnt, left, right) +++ +++ int bytecnt; +++ register long *left; +++ register long *right; +++{ +++ register int longcnt; +++ +++ longcnt = bytecnt >> 2; +++ do { +++ if ((*right & ~*left) != 0) +++ return FALSE; +++ if ((*left++ & ~*right++) != 0) +++ goto geq; +++ } while (--longcnt); +++ return FALSE; +++geq: +++ while (--longcnt) { +++ if ((*right++ & ~*left++) != 0) +++ return FALSE; +++ } +++ return TRUE; +++} diff --cc usr/src/lib/libpc/RELTLE.c index 0000000000,0000000000,0000000000..faf6bf53ab new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELTLE.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELTLE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELTLE(bytecnt, left, right) +++ +++ int bytecnt; +++ register long *left; +++ register long *right; +++{ +++ register int longcnt; +++ +++ longcnt = bytecnt >> 2; +++ do { +++ if ((*left++ & ~*right++) != 0) +++ return FALSE; +++ } while (--longcnt); +++ return TRUE; +++} diff --cc usr/src/lib/libpc/RELTLT.c index 0000000000,0000000000,0000000000..507c4e885f new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RELTLT.c @@@@ -1,0 -1,0 -1,0 +1,29 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RELTLT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++ +++RELTLT(bytecnt, left, right) +++ +++ int bytecnt; +++ register long *left; +++ register long *right; +++{ +++ register int longcnt; +++ +++ longcnt = bytecnt >> 2; +++ do { +++ if ((*left & ~*right) != 0) +++ return FALSE; +++ if ((*right++ & ~*left++) != 0) +++ goto leq; +++ } while (--longcnt); +++ return FALSE; +++leq: +++ while (--longcnt) { +++ if ((*left++ & ~*right++) != 0) +++ return FALSE; +++ } +++ return TRUE; +++} diff --cc usr/src/lib/libpc/REMOVE.c index 0000000000,0000000000,0000000000..f5767132c1 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/REMOVE.c @@@@ -1,0 -1,0 -1,0 +1,41 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)REMOVE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++REMOVE(name, maxnamlen) +++ +++ char *name; +++ int maxnamlen; +++{ +++ register int cnt; +++ char namebuf[NAMSIZ]; +++ +++ /* +++ * trim trailing blanks, and insure that the name +++ * will fit into the file structure +++ */ +++ for (cnt = 0; cnt < maxnamlen; ) +++ if (name[cnt] == '\0' || name[cnt++] == ' ') +++ break; +++ if (cnt >= NAMSIZ) { +++ ERROR(ENAMESIZE, name); +++ return; +++ } +++ maxnamlen = cnt; +++ /* +++ * put the name into the buffer with null termination +++ */ +++ for (cnt = 0; cnt < maxnamlen; cnt++) +++ namebuf[cnt] = name[cnt]; +++ namebuf[cnt] = '\0'; +++ /* +++ * unlink the file +++ */ +++ if (unlink(namebuf)) { +++ ERROR(EREMOVE, namebuf); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/RESET.c index 0000000000,0000000000,0000000000..aae68475b4 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RESET.c @@@@ -1,0 -1,0 -1,0 +1,38 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RESET.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++RESET(filep, name, maxnamlen, datasize) +++ +++ register struct iorec *filep; +++ char *name; +++ int maxnamlen; +++ int datasize; +++{ +++ if (name == NULL && filep == INPUT && filep->fname[0] == '\0') { +++ if (rewind(filep->fbuf)) { +++ ERROR(ESEEK, filep->pfname); +++ return; +++ } +++ filep->funit &= ~(EOFF | EOLN); +++ filep->funit |= SYNC; +++ return; +++ } +++ filep = GETNAME(filep, name, maxnamlen, datasize); +++ filep->fbuf = fopen(filep->fname, "r"); +++ if (filep->fbuf == NULL) { +++ if (filep->funit & TEMP) { +++ filep->funit |= (EOFF | SYNC | FREAD); +++ return; +++ } +++ ERROR(EOPEN, filep->pfname); +++ return; +++ } +++ filep->funit |= (SYNC | FREAD); +++ if (filep->fblk > PREDEF) { +++ setbuf(filep->fbuf, &filep->buf[0]); +++ } +++} diff --cc usr/src/lib/libpc/REWRITE.c index 0000000000,0000000000,0000000000..c70c8ad9fb new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/REWRITE.c @@@@ -1,0 -1,0 -1,0 +1,25 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)REWRITE.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++REWRITE(filep, name, maxnamlen, datasize) +++ +++ register struct iorec *filep; +++ char *name; +++ int maxnamlen; +++ int datasize; +++{ +++ filep = GETNAME (filep, name, maxnamlen, datasize); +++ filep->fbuf = fopen(filep->fname, "w"); +++ if (filep->fbuf == NULL) { +++ ERROR(ECREATE, filep->pfname); +++ return; +++ } +++ filep->funit |= (EOFF | FWRITE); +++ if (filep->fblk > PREDEF) { +++ setbuf(filep->fbuf, &filep->buf[0]); +++ } +++} diff --cc usr/src/lib/libpc/ROUND.c index 0000000000,0000000000,0000000000..ab03663a21 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ROUND.c @@@@ -1,0 -1,0 -1,0 +1,10 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ROUND.c 1.1 10/29/80"; +++ +++ROUND(value) +++ +++ double value; +++{ +++ return (long)(value + 0.5); +++} diff --cc usr/src/lib/libpc/RSNG4.c index 0000000000,0000000000,0000000000..bf561a6692 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/RSNG4.c @@@@ -1,0 -1,0 -1,0 +1,18 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)RSNG4.c 1.1 10/29/80"; +++ +++ +++#include "h01errs.h" +++ +++RSNG4(value, upper) +++ +++ int value; +++ int upper; +++{ +++ if (value < 0 || value > upper) { +++ ERROR(ERANGE, value); +++ return; +++ } +++ return value; +++} diff --cc usr/src/lib/libpc/SCLCK.c index 0000000000,0000000000,0000000000..86653be6e0 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SCLCK.c @@@@ -1,0 -1,0 -1,0 +1,11 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SCLCK.c 1.1 10/29/80"; +++ +++SCLCK() +++{ +++ long tim[4]; +++ +++ times(tim); +++ return (tim[1] * 50) / 3; +++} diff --cc usr/src/lib/libpc/SEED.c index 0000000000,0000000000,0000000000..7bf1878fb4 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SEED.c @@@@ -1,0 -1,0 -1,0 +1,16 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SEED.c 1.1 10/29/80"; +++ +++SEED(value) +++ +++ long value; +++{ +++ static long seed; +++ long tmp; +++ +++ srand(value); +++ tmp = seed; +++ seed = value; +++ return tmp; +++} diff --cc usr/src/lib/libpc/SEEK.c index 0000000000,0000000000,0000000000..d5f787d005 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SEEK.c @@@@ -1,0 -1,0 -1,0 +1,21 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SEEK.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++/* +++ * Random access routine +++ */ +++SEEK(curfile, loc) +++ +++ register struct iorec *curfile; +++ long loc; +++{ +++ curfile->funit |= SYNC; +++ if (fseek(curfile->fbuf, loc, 0) == -1) { +++ ERROR(ESEEK, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/SETRACE.s index 0000000000,0000000000,0000000000..cdf22366bc new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SETRACE.s @@@@ -1,0 -1,0 -1,0 +1,15 @@@@ +++# Copyright (c) 1979 Regents of the University of California +++# +++# sccsid[] = "@(#)SETRACE.s 1.1 10/29/80"; +++# +++# set trace bit in return frame of calling routine +++# this will cause core dump at point of return +++# unless running a debugger, in which case a breakpoint +++# will occur at the error point +++# +++ .globl _SETRACE +++_SETRACE: +++ .word 0 +++ movl FP(fp),r0 #r0 has ptr to callers frame +++ bisl2 $0x10,PSW(r0) #set trace bit +++ ret diff --cc usr/src/lib/libpc/SQRT.c index 0000000000,0000000000,0000000000..09bfd0c4a0 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SQRT.c @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SQRT.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++double +++SQRT(value) +++ +++ double value; +++{ +++ if (value <= 0) { +++ ERROR(ESQRT, value); +++ return; +++ } +++ return sqrt(value); +++} diff --cc usr/src/lib/libpc/STLIM.c index 0000000000,0000000000,0000000000..2e909b3ac5 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/STLIM.c @@@@ -1,0 -1,0 -1,0 +1,17 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)STLIM.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++STLIM(limit) +++ +++ long limit; +++{ +++ if (_stcnt >= limit) { +++ ERROR(ESTLIM, _stcnt); +++ return; +++ } +++ _stlim = limit; +++} diff --cc usr/src/lib/libpc/SUBSC.c index 0000000000,0000000000,0000000000..f37ea2877c new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SUBSC.c @@@@ -1,0 -1,0 -1,0 +1,15 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SUBSC.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++SUBSC(i, lower, upper) +++ +++ long i, lower, upper; +++{ +++ if (i < lower || i > upper) { +++ ERROR(ESUBSC, i); +++ } +++ return i; +++} diff --cc usr/src/lib/libpc/SUBSCZ.c index 0000000000,0000000000,0000000000..2e516a1e76 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SUBSCZ.c @@@@ -1,0 -1,0 -1,0 +1,15 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SUBSCZ.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++SUBSCZ(i, upper) +++ +++ long i, upper; +++{ +++ if (i < 0 || i > upper) { +++ ERROR(ESUBSC, i); +++ } +++ return i; +++} diff --cc usr/src/lib/libpc/SUBT.c index 0000000000,0000000000,0000000000..6a6d9b3501 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SUBT.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SUBT.c 1.1 10/29/80"; +++ +++long * +++SUBT(result0, left, right, size) +++ +++ long *result0; +++ register long *left; +++ register long *right; +++ register int size; +++{ +++ register long *result = result0; +++ +++ do { +++ *result++ = *left++ & ~*right++; +++ } while (--size); +++ return result0; +++} diff --cc usr/src/lib/libpc/SUCC.c index 0000000000,0000000000,0000000000..e5e356e0a8 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/SUCC.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)SUCC.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++SUCC(value, lower, upper) +++ +++ int value; +++ int lower; +++ int upper; +++{ +++ value++; +++ if (value < lower || value > upper) { +++ ERROR(ERANGE, value); +++ return; +++ } +++ return value; +++} diff --cc usr/src/lib/libpc/TEOF.c index 0000000000,0000000000,0000000000..a1af5dabf1 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/TEOF.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)TEOF.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++TEOF(filep) +++ +++ register struct iorec *filep; +++{ +++ if (filep->fblk >= MAXFILES || _actfile[filep->fblk] != filep) { +++ ERROR(ENOFILE, 0); +++ return; +++ } +++ if (filep->funit & EOFF) +++ return TRUE; +++ IOSYNC(filep); +++ if (filep->funit & EOFF) +++ return TRUE; +++ return FALSE; +++} diff --cc usr/src/lib/libpc/TEOLN.c index 0000000000,0000000000,0000000000..f1d3613ccf new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/TEOLN.c @@@@ -1,0 -1,0 -1,0 +1,20 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)TEOLN.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++TEOLN(filep) +++ +++ register struct iorec *filep; +++{ +++ if (filep->fblk >= MAXFILES || _actfile[filep->fblk] != filep) { +++ ERROR(ENOFILE, 0); +++ return; +++ } +++ IOSYNC(filep); +++ if (filep->funit & EOLN) +++ return TRUE; +++ return FALSE; +++} diff --cc usr/src/lib/libpc/TIME.c index 0000000000,0000000000,0000000000..e5f3028c7f new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/TIME.c @@@@ -1,0 -1,0 -1,0 +1,19 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)TIME.c 1.1 10/29/80"; +++ +++extern char *ctime(); +++ +++TIME(alfap) +++ +++ register char *alfap; +++{ +++ register char *ap, *cp; +++ register int i; +++ long a; +++ +++ time(&a); +++ cp = ctime(&a); +++ ap = alfap; +++ for (cp = cp + 10, i = 10; i; *ap++ = *cp++, i--); +++} diff --cc usr/src/lib/libpc/TRUNC.c index 0000000000,0000000000,0000000000..844cda8716 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/TRUNC.c @@@@ -1,0 -1,0 -1,0 +1,10 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)TRUNC.c 1.1 10/29/80"; +++ +++TRUNC(value) +++ +++ double value; +++{ +++ return (long)(value); +++} diff --cc usr/src/lib/libpc/UNIT.c index 0000000000,0000000000,0000000000..e38ceaa704 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/UNIT.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)UNIT.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++struct iorec * +++UNIT(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->fblk >= MAXFILES || _actfile[curfile->fblk] != curfile) { +++ ERROR(ENOFILE, 0); +++ return; +++ } +++ if (curfile->funit & FDEF) { +++ ERROR(EREFINAF, curfile->pfname); +++ return; +++ } +++ return curfile; +++} diff --cc usr/src/lib/libpc/UNPACK.c index 0000000000,0000000000,0000000000..8ee2fe9760 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/UNPACK.c @@@@ -1,0 -1,0 -1,0 +1,41 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)UNPACK.c 1.1 10/29/80"; +++ +++#include "h01errs.h" +++ +++/* +++ * unpack(z,a,i) +++ * +++ * with: z and a as in pack +++ * +++ * semantics: for j := u to v do +++ * a[j-u+i] := z[j] +++ */ +++ +++UNPACK(i, a, z, size_a, lb_a, ub_a, size_z) +++ +++ int i; /* subscript into a to begin packing */ +++ char *a; /* pointer to structure a */ +++ char *z; /* pointer to structure z */ +++ int size_a; /* sizeof(a_type) */ +++ int lb_a; /* lower bound of structure a */ +++ int ub_a; /* (upper bound of a) - (lb_a + sizeof(z_type)) */ +++ int size_z; /* sizeof(z_type) */ +++{ +++ int subscr; +++ register char *cp; +++ register char *zp = z; +++ register char *limit; +++ +++ subscr = i - lb_a; +++ if (subscr < 0 || subscr > ub_a) { +++ ERROR(EPACK, i); +++ return; +++ } +++ cp = &a[subscr * size_a]; +++ limit = cp + size_z; +++ do { +++ *cp++ = *zp++; +++ } while (cp < limit); +++} diff --cc usr/src/lib/libpc/UNSYNC.c index 0000000000,0000000000,0000000000..255312f338 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/UNSYNC.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)UNSYNC.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++/* +++ * push back last char read to prepare for formatted read +++ */ +++UNSYNC(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->funit & FWRITE) { +++ ERROR(EREADIT, curfile->pfname); +++ return; +++ } +++ if ((curfile->funit & SYNC) == 0) { +++ ungetc(*curfile->fileptr, curfile->fbuf); +++ } +++} diff --cc usr/src/lib/libpc/UNWIND.c index 0000000000,0000000000,0000000000..c54ff7e42b new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/UNWIND.c @@@@ -1,0 -1,0 -1,0 +1,10 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)UNWIND.c 1.1 10/29/80"; +++ +++UNWIND(frame) +++ +++ int *frame; +++{ +++ PCLOSE(*frame); +++} diff --cc usr/src/lib/libpc/WRITEC.c index 0000000000,0000000000,0000000000..ae4e1de9fd new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/WRITEC.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)WRITEC.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++WRITEC(curfile, d1, d2) +++ +++ register struct iorec *curfile; +++ int d1, d2; +++{ +++ if (curfile->funit & FREAD) { +++ ERROR(EWRITEIT, curfile->pfname); +++ return; +++ } +++ fputc(d1, d2); +++ if (ferror(curfile->fbuf)) { +++ ERROR(EWRITE, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/WRITEF.c index 0000000000,0000000000,0000000000..6ffa5f3bdc new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/WRITEF.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)WRITEF.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++WRITEF(curfile, d1, d2, d3, d4, d5, d6) +++ +++ register struct iorec *curfile; +++ int d1, d2, d3, d4, d5, d6; +++{ +++ if (curfile->funit & FREAD) { +++ ERROR(EWRITEIT, curfile->pfname); +++ return; +++ } +++ fprintf(d1, d2, d3, d4, d5, d6); +++ if (ferror(curfile->fbuf)) { +++ ERROR(EWRITE, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/WRITES.c index 0000000000,0000000000,0000000000..6a80cd44bd new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/WRITES.c @@@@ -1,0 -1,0 -1,0 +1,22 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)WRITES.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++WRITES(curfile, d1, d2, d3, d4) +++ +++ register struct iorec *curfile; +++ int d1, d2, d3, d4; +++{ +++ if (curfile->funit & FREAD) { +++ ERROR(EWRITEIT, curfile->pfname); +++ return; +++ } +++ fwrite(d1, d2, d3, d4); +++ if (ferror(curfile->fbuf)) { +++ ERROR(EWRITE, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/WRITLN.c index 0000000000,0000000000,0000000000..f4d3e4b3e0 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/WRITLN.c @@@@ -1,0 -1,0 -1,0 +1,25 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)WRITLN.c 1.1 10/29/80"; +++ +++#include "h00vars.h" +++#include "h01errs.h" +++ +++WRITLN(curfile) +++ +++ register struct iorec *curfile; +++{ +++ if (curfile->funit & FREAD) { +++ ERROR(EWRITEIT, curfile->pfname); +++ return; +++ } +++ if (++curfile->lcount >= curfile->llimit) { +++ ERROR(ELLIMIT, curfile->pfname); +++ return; +++ } +++ fputc('\n', curfile->fbuf); +++ if (ferror(curfile->fbuf)) { +++ ERROR(EWRITE, curfile->pfname); +++ return; +++ } +++} diff --cc usr/src/lib/libpc/ZFRAME.c index 0000000000,0000000000,0000000000..dc9afee2df new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ZFRAME.c @@@@ -1,0 -1,0 -1,0 +1,20 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++static char sccsid[] = "@(#)ZFRAME.c 1.1 10/29/80"; +++ +++ZFRAME(size, ptr) +++ +++ int size; +++ register long *ptr; +++{ +++ register long *end; +++ short *sptr; +++ +++ end = ptr + (size / sizeof(long)); +++ for (; ptr < end; *ptr++ = 0) +++ /* void */; +++ if (size % sizeof(long)) { +++ sptr = (short *)ptr; +++ *sptr = 0; +++ } +++} diff --cc usr/src/lib/libpc/ashdr.s index 0000000000,0000000000,0000000000..fe445b7128 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/ashdr.s @@@@ -1,0 -1,0 -1,0 +1,56 @@@@ +++# Copyright (c) 1979 Regents of the University of California +++# +++# sccsid[] = "@(#)ashdr.s 1.1 10/29/80"; +++# +++# Global constants +++# +++ .set R6,0x040 +++ .set R7,0x080 +++ .set R8,0x100 +++ .set R9,0x200 +++ .set R10,0x400 +++ .set R11,0x800 +++ .set PSW,4 +++ .set AP,8 +++ .set FP,12 +++ .set PC,16 +++# +++# error codes +++# +++ .set EARGV,1 +++ .set EASRT,2 +++ .set EBADFNUM,3 +++ .set EBADINUM,4 +++ .set ECASE,5 +++ .set ECHR,6 +++ .set ECLOSE,7 +++ .set ECREATE,8 +++ .set ECTLWR,9 +++ .set ECTSNG,10 +++ .set ECTUPR,11 +++ .set EFMTSIZE,12 +++ .set EGOTO,13 +++ .set EHALT,14 +++ .set ELLIMIT,15 +++ .set ELN,16 +++ .set ENAMESIZE,17 +++ .set ENAMRNG,18 +++ .set ENARGS,19 +++ .set ENILPTR,20 +++ .set ENOFILE,21 +++ .set ENUMNTFD,22 +++ .set EOPEN,23 +++ .set EOUTOFMEM,24 +++ .set EPACK,25 +++ .set EPASTEOF,26 +++ .set ERANGE,27 +++ .set EREADIT,28 +++ .set EREFINAF,29 +++ .set EREMOVE,30 +++ .set ESEEK,31 +++ .set ESQRT,32 +++ .set ESTLIM,33 +++ .set ESUBSC,34 +++ .set EUNPACK,35 +++ .set EWRITE,36 +++ .set EWRITEIT,37 diff --cc usr/src/lib/libpc/errdata index 0000000000,0000000000,0000000000..196281574a new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/errdata @@@@ -1,0 -1,0 -1,0 +1,38 @@@@ +++sccsid[] = "@(#)errdata 1.1 10/29/80"; +++EARGV 1 +++EASRT 2 +++EBADFNUM 3 +++EBADINUM 4 +++ECASE 5 +++ECHR 6 +++ECLOSE 7 +++ECREATE 8 +++ECTLWR 9 +++ECTSNG 10 +++ECTUPR 11 +++EFMTSIZE 12 +++EGOTO 13 +++EHALT 14 +++ELLIMIT 15 +++ELN 16 +++ENAMESIZE 17 +++ENAMRNG 18 +++ENARGS 19 +++ENILPTR 20 +++ENOFILE 21 +++ENUMNTFD 22 +++EOPEN 23 +++EOUTOFMEM 24 +++EPACK 25 +++EPASTEOF 26 +++ERANGE 27 +++EREADIT 28 +++EREFINAF 29 +++EREMOVE 30 +++ESEEK 31 +++ESQRT 32 +++ESTLIM 33 +++ESUBSC 34 +++EUNPACK 35 +++EWRITE 36 +++EWRITEIT 37 diff --cc usr/src/lib/libpc/h00vars.h index 0000000000,0000000000,0000000000..295a9d02a2 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/h00vars.h @@@@ -1,0 -1,0 -1,0 +1,117 @@@@ +++/* Copyright (c) 1979 Regents of the University of California */ +++ +++/* sccsid[] = "@(#)h00vars.h 1.1 10/29/80"; */ +++ +++#include +++ +++#define PXPFILE "pmon.out" +++#define BITSPERBYTE 8 +++#define BITSPERLONG (BITSPERBYTE * sizeof(long)) +++#define HZ 60 +++#define TRUE 1 +++#define FALSE 0 +++#define MAXLVL 20 +++#define NAMSIZ 76 +++#define MAXFILES 32 +++#define PREDEF 2 +++#define STDLVL ((struct iorec *)(0x7ffffff1)) +++#define GLVL ((struct iorec *)(0x7ffffff0)) +++#define FILNIL ((struct iorec *)(0)) +++#define INPUT ((struct iorec *)(&input)) +++#define OUTPUT ((struct iorec *)(&output)) +++#define ERR ((struct iorec *)(&_err)) +++ +++/* +++ * runtime display structure +++ */ +++struct display { +++ char *ap; +++ char *fp; +++}; +++ +++/* +++ * formal routine structure +++ */ +++struct formalrtn { +++ long (*entryaddr)(); +++ long cbn; +++ struct display disp[2*MAXLVL]; +++}; +++ +++/* +++ * program variables +++ */ +++extern struct display _disply[MAXLVL];/* runtime display */ +++extern int _argc; /* number of passed args */ +++extern char **_argv; /* values of passed args */ +++extern long _stlim; /* statement limit */ +++extern long _stcnt; /* statement count */ +++extern char *_maxptr; /* maximum valid pointer */ +++extern char *_minptr; /* minimum valid pointer */ +++extern long _pcpcount[]; /* pxp buffer */ +++ +++/* +++ * file structures +++ */ +++struct iorechd { +++ char *fileptr; /* ptr to file window */ +++ long lcount; /* number of lines printed */ +++ long llimit; /* maximum number of text lines */ +++ FILE *fbuf; /* FILE ptr */ +++ struct iorec *fchain; /* chain to next file */ +++ struct iorec *flev; /* ptr to associated file variable */ +++ char *pfname; /* ptr to name of file */ +++ short funit; /* file status flags */ +++ short fblk; /* index into active file table */ +++ long fsize; /* size of elements in the file */ +++ char fname[NAMSIZ]; /* name of associated UNIX file */ +++}; +++ +++struct iorec { +++ char *fileptr; /* ptr to file window */ +++ long lcount; /* number of lines printed */ +++ long llimit; /* maximum number of text lines */ +++ FILE *fbuf; /* FILE ptr */ +++ struct iorec *fchain; /* chain to next file */ +++ struct iorec *flev; /* ptr to associated file variable */ +++ char *pfname; /* ptr to name of file */ +++ short funit; /* file status flags */ +++ short fblk; /* index into active file table */ +++ long fsize; /* size of elements in the file */ +++ char fname[NAMSIZ]; /* name of associated UNIX file */ +++ char buf[BUFSIZ]; /* I/O buffer */ +++ char window[1]; /* file window element */ +++}; +++ +++/* +++ * unit flags +++ */ +++#define FDEF 0x80 /* 1 => reserved file name */ +++#define FTEXT 0x40 /* 1 => text file, process EOLN */ +++#define FWRITE 0x20 /* 1 => open for writing */ +++#define FREAD 0x10 /* 1 => open for reading */ +++#define TEMP 0x08 /* 1 => temporary file */ +++#define SYNC 0x04 /* 1 => window is out of sync */ +++#define EOLN 0x02 /* 1 => at end of line */ +++#define EOFF 0x01 /* 1 => at end of file */ +++ +++/* +++ * file routines +++ */ +++extern struct iorec *GETNAME(); +++extern char *MKTEMP(); +++extern char *PALLOC(); +++ +++/* +++ * file record variables +++ */ +++extern struct iorechd _fchain; /* head of active file chain */ +++extern struct iorec *_actfile[]; /* table of active files */ +++extern long _filefre; /* last used entry in _actfile */ +++ +++/* +++ * standard files +++ */ +++extern struct iorechd input; +++extern struct iorechd output; +++extern struct iorechd _err; diff --cc usr/src/lib/libpc/make.ed1 index 0000000000,0000000000,0000000000..c73efddd47 new file mode 100644 --- /dev/null +++ b/usr/src/lib/libpc/make.ed1 @@@@ -1,0 -1,0 -1,0 +1,15 @@@@ +++g/"@(#)make.ed1 1.1 10/29/80"/s//&/ +++1d +++1,$s/^/#define / +++w h01errs.h +++e errdata +++1d +++1,$s/ [ ]*// +++1,$s/^/ .set / +++1,$s/[0-9]*$/,&/ +++w E.s +++e ashdr.s +++/error codes/+2,$d +++$r E.s +++w +++q diff --cc usr/src/sys/newdev/hk.c index 0000000000,0000000000,0000000000..6d6803bd9c new file mode 100644 --- /dev/null +++ b/usr/src/sys/newdev/hk.c @@@@ -1,0 -1,0 -1,0 +1,439 @@@@ +++static char *sccsid = "@(#)hk.c 1.1 (Berkeley) 10/10/80"; +++ +++/* +++ * RK07 disk driver with bad-sector forwarding +++ * +++ * This driver, revised from a UCSB RK07 driver, is modeled +++ * after the Stanford SI 9500 driver with bad-sector forwarding. +++ * The bad-sector information on the last track of each pack is +++ * used to patch up transfers by forwarding accesses to bad sectors +++ * to spares on the last cylinder. The last cylinder is otherwise +++ * write-protected. +++ * The bad-sector table is read when a minor device is first +++ * opened after a close. No Volume-Valid checking is done; +++ * hamfists beware. To be correct, the open routine needs a +++ * mechanism for reading drive status and for doing a PACKACK. +++ * A pack is 1 minor device; there is no pack mapping. +++ * No attempt at ECC logic is included. Be my guest. +++ * +++ * BUGS: The same bomb is planted here as in most UBA DMA drivers, +++ * to wit, ubasetup is called from the interrupt level. Ubasetup +++ * will sleep if it cannot allocate; ka-boom! +++ * +++ * Author: Rob Mathews, EE Information Systems Lab, Stanford 4/80 +++ */ +++ +++/* +++ * Debug control +++ * +++ * 1 - open/close +++ * 2 - strategy +++ * 4 - intr entry/exit +++ * 8 - intr detail +++ * 16 - intr sector mapping +++ * 32 - strat errors/lock-opens +++ * 64 - bst reading +++ *1024 - loop after errors +++ */ +++ +++#define debug(bit) if (rk7debug & (bit)) printf +++int rk7debug = (0); +++ +++#include "../h/param.h" +++#include "../h/systm.h" +++#include "../h/buf.h" +++#include "../h/conf.h" +++#include "../h/dir.h" +++#include "../h/user.h" +++#include "../h/map.h" +++#include "../h/pte.h" +++#include "../h/uba.h" +++ +++/* +++ * Disk parameters +++ */ +++ +++#define NRK7 8 +++#define NCYLS 815 +++#define NTRKS 3 +++#define NSECTS 22 +++#define NBYTES 512 +++#define NBLKS (NCYLS*NTRKS*NSECTS) +++#define BSCYL (NCYLS-1) /* bad-sector repair cylinder */ +++#define BSBASE (BSCYL*NTRKS*NSECTS) /* track 0,1 - repair pool */ +++#define BSTBLK (BSBASE + 2*NSECTS) /* track 2 - bad-sector table */ +++#define MAXBB 10 /* max tolerable bad sectors */ +++ +++/* +++ * Register definitions +++ */ +++ +++#define RK7ADDR ((struct rk7_regs *)(UBA0_DEV + 0177440)) +++ +++struct rk7_regs +++{ +++ short rkcs1, rkwc; +++ unsigned short rkba; +++ short rkda, rkcs2, rkds, rker, rkasof, rkdc, rknull, rkdb, rkmr1; +++ short rkecps, rkecpt, rkmr2, rkmr3; +++}; +++ +++/* +++ * Register bits, per RK07 manual +++ */ +++ +++#define GO 01 /* cs1 */ +++#define DRCLR 04 +++#define READ 020 +++#define WRITE 022 +++#define PACKACK 02 +++#define IE 0100 +++#define RDY 0200 +++#define BA1617 01400 +++#define CDT 02000 +++#define CERR 0100000 +++#define CCLR 0100000 +++#define SCLR 040 /* cs2 */ +++#define SVAL 0100000 /* ds */ +++#define DRDY 0200 +++#define VV 0100 +++#define DRA 01 +++#define DCK 0100000 /* er */ +++#define BSE 0200 +++#define NXF 04 +++ +++#define Error ((RK7ADDR->rkcs1 & CERR) != 0) +++ +++/* +++ * Driver parameters, data, and definitions +++ */ +++ +++#define RETRIES 10 +++ +++#define IDLE 0 +++#define NORMAL 1 +++#define MAPPED 2 +++#define RESTART 3 +++ +++struct buf rk7tab, rk7bsbuf, rrk7buf; +++ +++struct rk7 +++ { +++ long access; +++ short retries, errors, mapped, spurious; +++ int ubinfo, rwcommand; +++ short unsigned errer, errcs2, errds; +++ short cylnow, trksecnow; +++ unsigned short wcnow; +++ long manow; +++ } +++ rk7; +++ +++struct bb +++ { +++ short serial, zeros[2], alignpack; +++ struct bbtbl +++ { +++ short bbtcyl, bbtts; +++ } +++ bbt[MAXBB]; +++ } +++ rk7bb[NRK7]; +++#define OPENF bbt[MAXBB-1].bbtcyl +++#define LOCKF zeros[0] +++ +++#define b_trksec av_back +++#define b_cylin b_resid +++#define nsects(x) x/NBYTES +++ +++/* +++ */ +++ +++rk7open (dev, flag) +++ { +++ register struct bb *bbp; +++ register m; +++ +++ if ((m = minor (dev)) >= NRK7) +++ { +++ u.u_error = ENXIO; +++ return; +++ } +++ bbp = &rk7bb[m]; +++ debug (1) ("open\n"); +++ if (bbp->OPENF != -1) +++ { +++ bbp->OPENF = 1; +++ debug (1|64) ("bs read\n"); +++ +++ rk7bsbuf.b_flags = B_BUSY | B_READ; +++ rk7bsbuf.b_dev = minor (dev); /* major better not matter ! */ +++ rk7bsbuf.b_bcount = sizeof (struct bb); +++ rk7bsbuf.b_un.b_addr = (caddr_t) bbp; +++ rk7bsbuf.b_blkno = BSTBLK; +++ rk7bsbuf.b_error = 0; +++ rk7strategy (&rk7bsbuf); +++ iowait (&rk7bsbuf); +++ +++ if (rk7bsbuf.b_flags & B_ERROR) +++ { +++ printf ("rk7: error reading bad sector table!\n"); +++ } +++ else if (bbp->OPENF != -1) +++ { +++ printf ("rk7: too many bad sectors, drive %d\n", m); +++ bbp->OPENF = -1; +++ } +++ wakeup (&bbp->OPENF); +++ debug (1|64) ("bs read done\n"); +++ } +++ else +++ while (bbp->OPENF != -1) +++ sleep (&bbp->OPENF, PSWP); +++ } +++ +++rk7close (dev, flag) +++ { +++ debug (1) ("close\n"); +++ if (!rk7bb[minor (dev)].LOCKF) +++ rk7bb[minor (dev)].OPENF = 0; +++ } +++ +++rk7strategy (bp) +++register struct buf *bp; +++ { +++ debug (2) ("strat %s ", bp->b_flags & B_READ ? "r" : "w"); +++ if (rk7bb[minor (bp->b_dev)].OPENF == 0) +++ { +++ rk7open (bp->b_dev, 0); /* in case root or swap is here */ +++ rk7bb[minor (bp->b_dev)].LOCKF++; +++ debug (32) ("lock-open\n"); +++ } +++ +++ if (bp->b_blkno + nsects (bp->b_bcount) +++ > (bp->b_flags & B_READ ? NBLKS : BSBASE)) +++ { +++ debug (2|32) ("error, blk %d, dev %d\n", +++ bp->b_blkno, minor (bp->b_dev)); +++ bp->b_flags |= B_ERROR; +++ iodone(bp); +++ return; +++ } +++ +++ debug (2) ("queue "); +++ bp->b_cylin = bp->b_blkno / (NTRKS*NSECTS); +++ bp->b_trksec = (struct buf *) ((((bp->b_blkno / NSECTS) % NTRKS) << 8) +++ + (bp->b_blkno % NSECTS)); +++ +++ spl5(); +++ disksort (&rk7tab, bp); +++ +++ if(rk7tab.b_active == IDLE) +++ rk7intr(); +++ spl0(); +++ debug (2) ("end\n"); +++ } +++ +++/* +++disksort (tabp, bp) +++register struct buf *tabp, bp; +++ { +++ bp->av_forw = (struct buf *)NULL; +++ if(tabp->b_actf == NULL) +++ tabp->b_actf = bp; +++ else +++ tabp->b_actl->av_forw = bp; +++ tabp->b_actl = bp; +++ } +++ */ +++ +++/* +++ * Interrupt (co)routine +++ */ +++ +++#define iwait(x) rk7tab.b_active = x; return; case x: +++rk7intr() +++ { +++ register struct buf *bp; +++ +++ bp = rk7tab.b_actf; +++ switch (rk7tab.b_active) +++ { +++ case IDLE: +++ debug (4) ("intr "); +++ if (bp == NULL) +++ { +++ rk7.spurious++; +++ return; +++ } +++ +++ do { /* empty the queue */ +++ +++ rk7.access++; +++ rk7tab.b_errcnt = 0; +++ +++ do { /* transfer */ +++ register short s; +++ short rk7map (), ms; +++ +++ rk7.rwcommand = bp->b_flags & B_READ +++ ? (READ|IE|CDT|GO) +++ : (WRITE|IE|CDT|GO); +++ if (Error) +++ { +++ debug (8) ("clear "); +++ rk7clear (); +++ } +++ +++ RK7ADDR->rkcs2 = minor (bp->b_dev); +++ RK7ADDR->rkcs1 = PACKACK|CDT|GO; +++ while (RK7ADDR->rkcs1 & GO); +++ +++ debug (8) ("setup "); +++ rk7.ubinfo = ubasetup (bp, 1); +++ rk7start ( rk7.rwcommand, +++ (short) bp->b_cylin, (short)(long) bp->b_trksec, +++ (long) rk7.ubinfo, +++ (short) (-(bp->b_bcount>>1))); +++ debug (8) ("started "); +++ iwait (NORMAL); +++ +++ debug (8) ("NORMAL "); +++ while (RK7ADDR->rker == BSE && (ms = rk7map ()) != -1) +++ { /* forwarding */ +++ rk7.mapped++; +++ debug (8|16) ("mapping "); +++ +++ rk7clear (); +++ +++ rk7start (rk7.rwcommand, +++ (short) BSCYL, (short) ms, (long) rk7.manow, +++ (short) (-(rk7.wcnow > NBYTES/2 +++ ? NBYTES/2 : rk7.wcnow))); +++ iwait (MAPPED); +++ +++ debug (8|16) ("mapped\n"); +++ if (!Error && rk7.wcnow > NBYTES/2) +++ { +++ debug (8|16) ("restarting "); +++ rk7restart (); +++ iwait (RESTART); +++ debug (8|16) ("restarted\n"); +++ } +++ } /* forwarding */ +++ +++ if (Error) +++ { +++ rk7.errer = RK7ADDR->rker; +++ rk7.errcs2 = RK7ADDR->rkcs2; +++ rk7.errds = RK7ADDR->rkds; +++ } +++ debug (8) (Error ? "error\n" : "free "); +++ ubafree (rk7.ubinfo); +++ } /* transfer */ +++ while (Error && ++rk7tab.b_errcnt != RETRIES); +++ +++ if (rk7tab.b_errcnt != 0) +++ rk7errs (bp); +++ +++ debug (8) ("next\n"); +++ bp->b_resid = 0; +++ rk7tab.b_actf = bp->av_forw; +++ iodone (bp); +++ +++ } /* empty the queue */ +++ while ((bp = rk7tab.b_actf) != NULL); +++ +++ rk7tab.b_active = IDLE; +++ debug (4) ("exit\n"); +++ return; +++ } +++ } +++ +++rk7clear () +++ { +++ register drive; +++ +++ drive = RK7ADDR->rkcs2 & 07; +++ RK7ADDR->rkcs1 = CCLR; +++ RK7ADDR->rkcs2 = drive; +++ RK7ADDR->rkcs1 = DRCLR|CDT|GO; +++ while ((RK7ADDR->rkcs1 & RDY) == 0); +++ } +++ +++rk7start (rwcommand, cyl, tsect, mem, wc) +++short cyl, tsect, wc; +++long mem; +++ { +++ RK7ADDR->rkdc = cyl; +++ RK7ADDR->rkda = tsect; +++ RK7ADDR->rkba = mem; +++ RK7ADDR->rkwc = wc; +++ RK7ADDR->rkcs1 = ((mem >> 8) & BA1617) | rwcommand; +++ } +++ +++short rk7map () +++ { +++ register struct bbtbl *bbp; +++ register i; +++ +++ rk7.wcnow = -RK7ADDR->rkwc; +++ rk7.cylnow = RK7ADDR->rkdc; +++ rk7.trksecnow = RK7ADDR->rkda; +++ rk7.manow = (((long)(RK7ADDR->rkcs1 & BA1617)) << 8) + RK7ADDR->rkba; +++ +++ for (bbp = rk7bb[RK7ADDR->rkcs2 & 07].bbt, i = 0; +++ bbp->bbtcyl != -1 && +++ (bbp->bbtcyl != rk7.cylnow || bbp->bbtts != rk7.trksecnow); +++ bbp++, i++); +++ return (bbp->bbtcyl == -1 ? -1 : i /* trk & sec */); +++ } +++ +++rk7restart () +++ { +++ register short ts; +++ +++ ts = rk7.trksecnow; +++ if ((++ts & 0377) == NSECTS) +++ if (((ts += (1<<8) - NSECTS) >> 8) == NTRKS) +++ { +++ ts = 0; +++ rk7.cylnow++; +++ } +++ rk7start (rk7.rwcommand, (short) rk7.cylnow, (short) ts, +++ (long) rk7.manow + NBYTES, (short) (-(rk7.wcnow - NBYTES/2))); +++ } +++ +++rk7errs (bp) +++register struct buf *bp; +++ { +++ register nerr; +++ +++ nerr = rk7tab.b_errcnt; +++ rk7.retries += nerr; +++ if (nerr == RETRIES) +++ { +++ bp->b_flags |= B_ERROR; +++ rk7.errors++; +++ printf ("Hard rk7 "); +++ } +++ else +++ printf ("%d * rk7 ", nerr); +++ deverror (bp, rk7.errer, rk7.errcs2); +++ printf ("ds %X\n", rk7.errds); +++ while (nerr == RETRIES && (rk7debug & 1024)); +++ } +++ +++rk7read(dev) +++dev_t dev; +++{ +++ +++ physio(rk7strategy, &rrk7buf, dev, B_READ, minphys); +++} +++ +++rk7write(dev) +++dev_t dev; +++{ +++ +++ physio(rk7strategy, &rrk7buf, dev, B_WRITE, minphys); +++}