| (write "LPC closure parser ready...\n") |
| (write "LLisp Version 0.6 [") |
| ;;; |
| ;;; automagic quoting of hardcoded functions: |
| ;;; each function has 2 entries in 'memory' |
| ;;; 0 -- the function name or equivalent |
| ;;; 1 -- bits regarding autoquoting |
| ;;; each argument for the function has two bits |
| ;;; 0 -- normal quoting |
| ;;; 1 -- program code quoting (lamda requires it) |
| ;;; only bit 0 or bit 1 must be set, never both (no quoting at all) |
| ;;; lambda needs normal quote for the first argument and special quote for 2nd |
| ;;; 1 0 0 1 |
| ;;; |1| |2| -> 9 (if i have calculated it right) |
| ;;; |
| ;;; the function lambda has autoquote, @ is a non-autoquote version |
| (= ([ (memory) '@) lambda) |
| (= ([ (memory) lambda 1) 9) |
| ;;; |
| ;;; explicit quote of a symbol with quote |
| (= ([ (memory) quote 1) 1) |
| ;;; |
| ;;; one of the most important functions needed (microcoded): |
| ;;; now we define a set |
| (= ([ (memory) 'set) (lambda (n v) (, (= ([ (memory) n) v) n))) |
| ;;; and a autoquote version of set (setq) |
| (set 'setq set) (= ([ (memory) 'setq 1) 1) |
| ;;; |
| ;;; some people prefer define, it quotomatically quotes its first argument |
| (setq define (lambda (n v f) (, (= ([ (memory) n 1) f) (set n v) n))) |
| (= ([ (memory) 'define 1) 1) |
| ;;; |
| ;;; defun for easier definition of functions |
| (define defun (lambda (n a b f) (, (= ([ (memory) n 1) f) |
| (set n (@ a b)) n)) 37) |
| ;;; |
| ;;; if we like to destroy a value use undef |
| (defun undef (fun) (, (= memory (m_delete (memory) fun)) fun) 1) |
| ;;; |
| ;;; an error function (internal use), notify declares the function to use |
| ;;; when an error message has to be printed |
| (setq error raise_error) |
| ;;; |
| ;;; other important functions and function aliases |
| ;;; standard lisp functionality (car, cdr, cons) |
| (defun car (l) (? (pointerp l) |
| (? (sizeof l) ([ l 0) |
| (error "car: empty list\n")) |
| (error "car: not a list\n"))) |
| (defun cdr (l) (? (pointerp l) ([.. l 1) |
| (error "cdr: not a list\n"))) |
| (defun cons (_car _cdr) (+ (list _car) _cdr)) |
| ;;; |
| ;;; some special functionality |
| (defun addhistory (file) (write_file file (implode (history) "\n"))) |
| (defun savehistory (file) (, (rm file) (addhistory file))) |
| (defun showhistory () (, (printf "%s\n" (implode (history) "\n")) |
| "-- END OF HISTORY --")) |
| ;;; |
| (defun showfunc () (m_indices (memory))) |
| ;;; |
| ;;; Try to autodetect mudtype |
| ;;; |
| (set 'mudtype "") |
| (defun add (var val) (+= ([ (memory) var) val)) |
| (add 'mudtype (? (symbol_function "getuid") "NATIVE" "COMPAT")) |
| (add 'mudtype (? (function_exists "SetProp") |
| (? (== (function_exists "Set") "/std/thing/properties") "|MG" |
| "|NF") |
| (&& (== (file_size "/basic") -2) |
| (== (file_size "/complex") -2)) |
| (? (== (file_size "/kernel") -2) "|TUBNEW" "|TUB") |
| (== (function_exists "query_all_v_items") "/i/item/virtual") |
| (? (function_exists "query_bodylocation_pic" |
| (, (call_other "/obj/player" "?") |
| (find_object "/obj/player"))) |
| "|UNI/AVALON" "|UNI") |
| (? (function_exists "RCSId" (find_object "/obj/simul_efun"))) |
| "|TAPP" |
| "|UNKNOWN/2.4.5" |
| )) |
| (setq mudtype (explode mudtype "|")) |
| (defun mud? (str) (sizeof (regexp ([ (memory) 'mudtype) str))) |
| (printf "%s,%s" ([ ([ (memory) 'mudtype) 0) ([ ([ (memory) 'mudtype) 1)) |
| (write "]\n") |
| ;;; |
| ;;; load local user init |
| ;;; |
| (? (mud? "NF|MG") |
| (setq owner (getuid (this_player))) |
| (setq owner (call_other (this_player) "query_real_name"))) |
| (? (mud? "MG|NF|TUB") |
| (define localinit (+ (+ "/players/" owner) "/lisp.l")) |
| (define localinit (+ (+ "/w/" owner) "/lisp.l"))) |
| (? (> (file_size localinit) 0) |
| (? (mud? "TUB|UNI|UNKNOWN") |
| (call_out load 0 localinit) |
| (load localinit))) |
| (printf "Welcome %s, today is %s!\n" (capitalize owner) (ctime (time))) |