diff --git a/3dplot.4th b/3dplot.4th new file mode 100755 index 0000000..56b50b9 --- /dev/null +++ b/3dplot.4th @@ -0,0 +1,77 @@ +\ 3dplot.4th - Forth source file template +\ +\ Copyright 2015 David Meyer +JMJ +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. + +\ Print 2-D graph of 3-D function: +\ +\ z = f(x,y) = A * exp ((x**2 + y**2) / D) + B*y + C +\ +\ Ported from Creative Computing BASIC Games Collection + +20 constant PLOTLINES +10 constant PLOTSECTS + +PLOTLINES 2 / s>d d>f fconstant RADIUS + +: header ( -- ) 25 spaces ." 3DPLOT / SLOTS" cr ; + +: line>x ( u -- r ) PLOTLINES 2 / - s>d d>f ; + +: col>y ( u -- r ) PLOTSECTS 2 / - s>d d>f ; + +: x>upr-hemi ( rx -- ry ) fdup f* RADIUS fdup f* fswap f- fsqrt ; + +: x>low-hemi ( rx -- ry ) x>upr-hemi fnegate ; + +: xy>z ( rx ry -- rz ) fdrop fdrop 0e0 ; + +: 3dplot ( -- ) + header cr + PLOTLINES 0 ?do + PLOTSECTS 0 ?do + 2 spaces [char] * emit +\ i col>y j line>x x>low-hemi f< +\ i col>y j line>x x>upr-hemi f> or if +\ 3 spaces +\ else +\ 2 spaces [char] * emit +\ then + loop + cr + loop + + +\ 20 1 u+do +\ i 11 - dup * 100 swap - +\ s>d d>f fsqrt 2e0 f* +\ f>d d>s +\ dup 20 swap - spaces +\ 2* 0 u+do +\ [char] * emit +\ loop +\ cr +\ loop +; + +\ Main ************************************************************** + +cr +3dplot +bye + +\ Emacs control ***************************************************** +\Local variables: +\mode: forth +\End: diff --git a/LICENSE b/LICENSE old mode 100644 new mode 100755 diff --git a/Mind.4th b/Mind.4th new file mode 100755 index 0000000..b732578 --- /dev/null +++ b/Mind.4th @@ -0,0 +1,5173 @@ +( 24jan13A.F -- modification of 2jan13A.F MindForth ) +( Released under GNU General Public License V2 ) +( http://gpl-violations.org -- see NYT Sun.26.SEP.2010. ) +( May be ported to new language and app store marketed. ) +( May be named "Mind.F" or any "Filename.F" you choose. ) +( Rename any Mind.F.txt as simply Mind.F for Win32Forth. ) +( http://home.planet.nl/~josv/w32for42_671.exe ) +( http://prdownloads.sourceforge.net/win32forth/W32FOR42_671.zip?download ) +( http://code.google.com/p/mindforth/wiki/IntelForth ) +( http://store.kagi.com/cgi-bin/store.cgi?storeID=AMP_Live ) +( http://www.winzip.com/aboutzip.htm tells about WinZip. ) +( Download and unzip W32FOR42_671.zip to run MindForth. ) +( Run the AI with Win32Forth by issuing three commands: ) +( win32for.exe [ENTER] ) +( fload Mind.f [ENTER] ) +( MainLoop [ENTER]. ) +( To halt the AI Mind, press the ESCAPE key at any time. ) +( Ask or answer questions about MindForth AI on Usenet. ) +( AI codebase below fills blank space with Usenet links ) +( http://groups.google.com/group/comp.lang.forth/topics ) +( http://www.scn.org/~mentifex/DeKi.txt German Wotan AI ) +( http://www.scn.org/~mentifex/DeKiUser.html AI Manual ) +( http://www.scn.org/~mentifex/mindforth.txt Win32Forth ) +( http://www.scn.org/~mentifex/AiMind.html in JavaScript ) +( http://www.scn.org/~mentifex/Dushka.html is Russian AI ) +( http://www.scn.org/~mentifex/RuAiUser.html AI Manual ) +( http://bookstore.iuniverse.com/Products/SKU-000540906/AI4U.aspx ) +( http://www.amazon.com/The-Art-Meme-ebook/dp/B007ZI66FS ) +( http://code.google.com/p/mindforth/wiki/UserManual ) +( Please make a copy of this AI and host it on your website. ) +( http://code.google.com/p/mindforth/wiki/ChangeLog data ) +\ 12nov12A.F moves input words through AudBuffer and OutBuffer. +\ 15nov12A.F stubs in the VerbGen module for generating verbs. +\ 20dec12A.F introduces InFerence module for machine reasoning. +\ 21dec12A.F troubleshoots InFerence with diagnostic messages. +\ 22dec12A.F finds alternate auditory engrams for inferences. +\ 25dec12A.F achieves inferences about new input not held in KB. +\ 27dec12A.F feeds inference into AskUser for a yes-or-no query. +\ 28dec12A.F displays internal mental time and ReJuvenate count. +\ 29dec12A.F asks user to confirm or deny inference; adjusts KB. +\ 2jan13A.F prevents inference about a subject lacking a verb. +\ 23jan13A.F troubleshoots the comprehension of objectless verbs. +\ 24jan13A.F comprehends quasi-intransitive verbs without objects. +DECIMAL ( use decimal numbers ) +variable abc ( AudBuffer transfer character; 8nov2012 ) +variable act 0 act ! ( activation level ) +variable actbase ( AudRecog discrimination activation base) +variable actran ( PsiDecay holder of act-levels; 16may2011 ) +variable adverbact 0 adverbact ! ( 29aug2008 adverb test ) +variable adjcon ( insert-adjective condition-flag; 16sep2011 ) +variable aftjux ( after-jux for negation of verb of being ) +variable anset ( Before vowel set article AN insertion ) +variable atcd ( 30dec2009 "antecedent" for EnPronoun ) +variable aud ( auditory recall-tag for activating engrams) +variable audbase ( recall-vector for VerbGen; 8nov2012 ) +variable audjuste ( NounPhrase motjuste aud to SpeechAct ) +variable audme ( tag to find "ME" in auditory memory ) +variable audnum ( de-globalizing the "num" variable; 8nov2012 ) +variable audpsi ( de-globalizing the "psi" variable ) +variable audrec ( 6may2009 replacing "psi" in AudRecog ) +variable audrun 1 audrun ! ( counter of loops through AudRecog ) +variable audstop ( flag to stop SpeechAct after one word ) +variable audverb ( psi number of an input verb; 27dec2012 ) +variable b01 ( buffer character 01 in OutBuffer; 12nov2012 ) +variable b02 ( buffer character 02 in OutBuffer; 12nov2012 ) +variable b03 ( buffer character 03 in OutBuffer; 12nov2012 ) +variable b04 ( buffer character 04 in OutBuffer; 12nov2012 ) +variable b05 ( buffer character 05 in OutBuffer; 12nov2012 ) +variable b06 ( buffer character 06 in OutBuffer; 12nov2012 ) +variable b07 ( buffer character 07 in OutBuffer; 12nov2012 ) +variable b08 ( buffer character 08 in OutBuffer; 12nov2012 ) +variable b09 ( buffer character 09 in OutBuffer; 12nov2012 ) +variable b10 ( buffer character 10 in OutBuffer; 12nov2012 ) +variable b11 ( buffer character 11 in OutBuffer; 12nov2012 ) +variable b12 ( buffer character 12 in OutBuffer; 12nov2012 ) +variable b13 ( buffer character 13 in OutBuffer; 12nov2012 ) +variable b14 ( buffer character 14 in OutBuffer; 12nov2012 ) +variable b15 ( buffer character 15 in OutBuffer; 12nov2012 ) +variable b16 ( buffer character 16 in OutBuffer; 12nov2012 ) +variable bday ( day of birth reveals oldest living AI Mind) +variable becon 0 becon ! ( detect be-verb for InFerence 18dec2012 ) +variable beflag 0 beflag ! ( 23apr2009 for InStantiate ) +variable beg 1 beg ! ( "beginning" flag for word engrams ) +variable bhour ( hour of birth for user interface display ) +variable bias 5 bias ! ( Parser; newConcept: expected POS ) +variable binc ( OutBuffer "b" increment for VerbGen 12nov2012 ) +variable bminute ( minute of birth: user interface display) +variable bmonth ( month of birth: user interface display ) +variable bsec ( second of birth: user interface display) +variable byear ( MainLoop; TuringTest HCI -- year of birth) +variable c01 ( character in AudBuffer; 12nov2012 ) +variable c02 ( character in AudBuffer; 12nov2012 ) +variable c03 ( character in AudBuffer; 12nov2012 ) +variable c04 ( character in AudBuffer; 12nov2012 ) +variable c05 ( character in AudBuffer; 12nov2012 ) +variable c06 ( character in AudBuffer; 12nov2012 ) +variable c07 ( character in AudBuffer; 12nov2012 ) +variable c08 ( character in AudBuffer; 12nov2012 ) +variable c09 ( character in AudBuffer; 12nov2012 ) +variable c10 ( character in AudBuffer; 12nov2012 ) +variable c11 ( character in AudBuffer; 12nov2012 ) +variable c12 ( character in AudBuffer; 12nov2012 ) +variable c13 ( character in AudBuffer; 12nov2012 ) +variable c14 ( character in AudBuffer; 12nov2012 ) +variable c15 ( character in AudBuffer; 12nov2012 ) +variable c16 ( character in AudBuffer; 12nov2012 ) +variable caller ( debug-identifier of calling module ) +variable cns 2048 cns ! ( MindGrid size; doubled 3aug2012 ) +variable coda 128 coda ! ( memory recycled in ReJuvenate) +variable cognum ( grammatical number of cogpsi; 22oct2011 ) +variable cogpsi ( new noun being learned; 17oct2011 ) +variable conj ( OldConcept; ConJoin: conjunction ) +variable ctu ( continuation-flag for "Aud" array phonemes ) +variable dba ( case for nouns; person for verbs; 8nov2012 ) +variable defact ( default activation for NounPhrase; 9oct2011 ) +variable defartcon ( set definite article condition ) +variable dirobj ( indicates seeking for a direct object ) +variable dobseq ( for transfer within InFerence; 22dec2012 ) +variable dopsi ( direct-object-psi to calculate "thotnum") +variable edge 0 edge ! ( Rejuvenate: edge-of-thought flag) +variable en8 ( EnVocab recall-vector "aud" in Rejuvenate ) +variable enx ( holds concept-number in transfer to English) +variable eot ( end-of-text for use in AudInput ) +variable fex ( holds fiber-out concept up from Psi memory ) +variable fin ( holds fiber-in concept for Psi array access) +variable firstword ( for identifying input of a query 19aug2011 ) +variable flex1 ( "I" or "S" element of SpeechAct inflection ) +variable flex2 ( "N" as part of "ING" SpeechAct inflection ) +variable flex3 ( "G" as part of "ING" SpeechAct inflection ) +variable fyi 0 fyi ! ( rotates through display modalities ) +variable fyipsi ( psi source-node in SpreadAct; 17oct2011 ) +variable gencon ( VerbGen status flag from Wotan; 22dec2012 ) +variable ghost 0 ghost ! ( to switch from "a" to "the" ) +variable glot 1 glot ! ( flag for which language to think in ) +variable greet 640 greet ! ( greeting-trigger; 16oct2010 ) +variable guspsi ( concept-tag attached to taste-memories ) +variable gusrec ( for external recognition by GusRecog ) +variable hipsi ( "high-psi" tag on wavecrest concept ) +variable hl ( possible standard instead of "glot"; 20aug2011 ) +variable holdnum ( transfer from subject to verb; 8nov2012 ) +( I = Index in loops; does not require a fetch "@" ) +variable img ( visRecog: for future use as "image" ) +variable indefartcon ( set indefinite article condition ) +variable indefmust ( force saying of "A" or "AN"; 20oct2011 ) +variable inert 0 inert ! ( marker of no recent interaction ) +variable inft ( inference-time for AskUser 27dec2012 ) +variable instnum ( instantiation number for WhatBe questions ) +variable IQ 1 IQ ! ( an invitation to code an IQ algorithm) +variable jrt ( ReJuvenate "junior time" for memories moved) +variable jux 0 jux ! ( holds Psi # of a JUXtaposed word ) +variable kbcon ( flag for awaiting a yes-or-no answer 2jul2011 ) +variable kbpsi ( 20jan2008 an interim knowledge-base psi ) +variable kbquiz 0 kbquiz ! ( flag to call kbSearch ) +variable kbtv 0 kbtv ! ( KbTraversal trigger; 7aug2010 ) +variable kbtqv ( time of seq-concept found in KB; 7oct0211 ) +variable kbyn ( holds kbtv values for asking Y/N 24jun2011 ) +variable kibosh ( suppresses concepts failing to win selection ) +variable krt ( Knowledge Representation time "t" for later) +variable lastpho ( 24may2009 to avoid extra "S" on verbs ) +variable lastword 0 lastword ! ( for zeroing "seq" tags.) +variable len ( length, for avoiding non-words in AudInput) +variable lexact ( testing a lexical "act" for EnReify ) +variable lopsi ( "low-psi" tag on just-crested concept ) +variable lurk ( counter to activate initial thinking; 19sep2010 ) +variable match ( end-of-word flag for control ) +variable memoire ( instead of "motjuste" in kbSearch ) +variable mfn ( "masculine feminine neuter" gender flag ) +variable mfnflag ( gender flag to cause a who-query; 17aug2010 ) +variable midway 1 midway ! ( limit for searching backwards) +variable monopsi ( 26jul2002 For use in audRecog module ) +variable moot ( flag to prevent associations in DO-queries ) +variable morphpsi ( for audRecog recognition of morphemes ) +variable motjuste ( best word for inclusion in a thought ) +variable nacpsi ( 9may2009 de-globalized psi for NounAct) +variable negjux ( flag for 12=NOT juxtaposed to a verb; 9oct2011 ) +variable nen 0 nen ! ( English lexical concept number ) +variable newpsi ( for singular-nounstem assignments ) +variable nlt 0 nlt ! ( not-later-than among time-points ) +variable nounlock ( for a verb to lock onto a seq-nounl 8oct2011 ) +variable nounval 0 nounval ! ( from NounPhrase to MounAct ) +variable nphrnum 0 nphrnum ! ( NounPhrase number ) +variable nphrpos 0 nphrpos ! ( for testing in EnCog ) +variable num 0 num ! ( number-flag for the psi array ) +variable numflag ( 4dec2009 for selection of verb-forms ) +variable numsubj ( 13apr2010 for number of subject ) +variable nwc ( new-word-count for noun-stem recog ) +variable objold ( a test for optimizing slosh-over; 12oct2010 ) +variable obstat ( Lets AudInput psi-damp a reentrant word.) +variable ocn ( old-concept-number for EnVocab; 14oct2011 ) +variable oldact ( show the source of spreading activations) +variable oldpos ( old part-of-speech for use with verbs ) +variable oldpsi ( used in OldConcept to de-globalize "psi") +variable olfpsi ( concept-tag attached to smells in memory) +variable olfrec ( for external recognition by OlfRecog ) +variable onset 0 onset ! ( of an auditory memory engram ) +variable opt ( option, for flushing out a part of speech ) +variable ordo 0 ordo ! ( from JSAI; AudInput word-order ) +variable pcn ( predicate concept number; 17jul2012 ) +variable penultpho ( 17may2009 next-to-last phoneme ) +variable pho ( phoneme of input/output & internal reentry ) +variable phodex 0 phodex ! ( pho-index for AudBuffer 14nov2012 ) +variable pos ( old- & newConcept; enVocab: part-of-speech) +variable pov ( point-of-view: #35 internal; *42 external ) +variable prc ( provisional recognition in AudRecog; 27dec2012 ) +variable pre ( previous concept associated with a concept ) +variable precand ( inviolate "pre" candidate from JSAI ) +variable predflag ( indicates predicate nominative 11sep2010 ) +variable prednom ( predicate nominative for InFerence; 18dec2012 ) +variable predpos 0 predpos ! ( Predicate part of speech ) +variable prejux ( previous jux to carry NOT to verb 21jul2011 ) +variable prepho ( 17may2009 previous phoneme ) +variable prepsi ( synaptic deglobalized "pre" in SpreadAct) +variable preset 0 preset ! ( for setting InStantiate "pre") +variable prevtag ( from JSAI; for use in InStantiate ) +variable prox1 ( first proximate concept of input cluster ) +variable prox2 ( for determining association among engrams ) +variable prox3 ( for ReActivate to impose unequal activation ) +variable proxcon ( flag to indicate usage of prox variables ) +variable prsn 0 prsn ! ( 1st, 2nd, 3rd person ) +variable psi ( identifier of a psi concept in Psi mindcore) +variable psi1 ( activation-level at each node of verb ) +variable psi3 0 psi3 ! ( for VerbPhrase to find negation 25jun2011 ) +variable psi8 ( tutorial enx in tutorial or diagnostics; 12oct2011 ) +variable psibase ( winning psibase with winning actbase ) +variable putdbav ( putative dba for verbs; 27dec2012 ) +variable putnum ( putative number for subj-verb agreement ) +variable questype ( oldConcept; Conjoin: "question-type" ) +variable quiet 1 quiet ! ( status flag for auditory input ) +variable quo ( 27dec2009 query-object for EnCog response ) +variable quobj ( query-object for yes-or-no questions 24jun2011 ) +variable qup ( 28dec2009 query-predicate if verb not given ) +variable qusub ( internal provisional query-subject; 3oct2010 ) +variable quverb ( query-verb for yes-or-no questions 24jun2011 ) +variable recnum ( recognized number of a recognized word 19jul2011 ) +variable retropsi ( for AudInput and Audmem noun-stems ) +variable residuum 0 residuum ! ( activation after PsiDamp ) +variable rjc 0 rjc ! ( rejuvenation counter for tracking ) +variable rsvp 1000 rsvp ! ( user-response delay-counter) +variable rv ( "recall-vector" for diagnostic display ) +variable scn ( subject concept number; 17jul2012 ) +variable seq ( subSEQuent concept associated with another) +variable seqneed ( noun/pronoun or verb needed as a "seq" ) +variable seqpos ( "seq" concept part-of-sppeech 1oct2011 ) +variable seqpsi ( synaptic deglobalized "seq" in SpreadAct) +variable seqtqv ( for transfer during InFerence; 18dec2012 ) +variable seqverb ( interstitial carrier for InFerence; 18dec2012 ) +variable singflag ( singularity flag for singular nouns ) +variable snu ( subj# as parameter for verb-selection 21dec2012 ) +variable spacegap ( to add gap of one space in SpeechAct ) +variable spike ( 1aug2005: for potential use in SpreadAct) +variable spt ( AudMem; AudInput: blank space time ) +variable stemgap ( for avoiding false audRecog stems ) +variable stempsi ( for singular noun-stem recognition ) +variable subj ( flag to supercharge subject-nouns ) +variable subjectflag ( 3dec2009 a default for NounPhrase ) +variable subjnom ( subject-nominative for InFerence; 18dec2012 ) +variable subjnum ( for agreement with predicate nominative ) +variable subjold ( old subject as default candidate 28sep2010 ) +variable subjpsi ( parameter to govern person of verb-forms ) +variable sublen ( length of audRecog subpsi word-stem ) +variable subpsi ( for AudRecog of sub-component wordstems ) +variable supsi ( subject-psi for calculating "thotnum" ) +variable svo2 ( second item among subj-verb-obj; 3sep2011 ) +variable svo3 ( third item among subj-verb-obj; 28aug2011 ) +variable t 0 t ! ( time incremented during AudMem storage) +variable t2s ( auditory text-to-speech index for SpeechAct) +variable tacpsi ( concept-tag attached to tactile engrams) +variable tacrec ( for external recognition by TacRecog ) +variable tbev ( time of be-verb for use with aftjux 27jul2011 ) +variable tkbn ( time of KbRetro noun adjustment; 2jul2011 ) +variable tkbv ( time of KbRetro verb adjustment; 2jul2011 ) +variable topic ( topic for a question to be asked ) +variable topicnum ( grammatical number of question "topic" ) +variable tov 1 tov ! ( time-of-voice for keeping track ) +variable tpeg ( pegging the time-slice of a subject-noun ) +variable tqv ( tempus quod vide for specific psi instance ) +variable transcon 1 transcon ! ( transitive verb? 24jan2013 ) +variable trc ( 20dec2009 tabula-rasa-counter like rjc ) +variable tsday ( for AudListen transcript-mode headers ) +variable tseln ( time of selection of noun; 8may2011 ) +variable tselo ( time of selection of object 30jul2011 ) +variable tsels ( time of selection of subj. 28jul2011 ) +variable tselv ( time of selection of verb; 8may2011 ) +variable tshour ( AudListen ) +variable tsminute ( AudListen ) +variable tsmonth ( AudListen ) +variable tsn ( time of seqneed for InStantiate; 1jul2012 ) +variable tssecond ( AudListen ) +variable tsyear ( AudListen ) +variable tult ( t penultimate, or time-minus-one ) +variable unk ( "unknown" variable for general use ) +variable upnext ( Flag lets new input de-crest previous. ) +variable urpre ( original pre during call to other module ) +variable urpsi ( original psi for use in psiDamp, etc. ) +variable vacpsi ( de-globalized psi for VerbAct; 27sep2010 ) +variable vault 611 vault ! ( size of EnBoot; 8nov2012 ) +variable vbpsi ( verb-psi for calculating "thotnum" ) +variable verblock ( for subject-noun to lock onto seq-verb; 8oct2011 ) +variable verbpsi ( for transit into WhatAuxSVerb 13jun2011 ) +variable verbval ( transfer from VerbPhrase to VerbAct ) +variable vispsi ( concept-tag attached to images in memory) +variable visrec ( for external recognition by VisRecog ) +variable vphract ( verb phrase activation level 19jun2011 ) +variable vphraud ( holds aud-fetch for SpeechAct; 25jun2011 ) +variable vpos ( verb part of speech for inflections ) +variable vrsn 20130124 vrsn ! ( version identifier; 24jan2013 ) +variable whoflag 0 whoflag ! ( for InStantiate ) +variable wordend ( for singular noun-stem assignments ) +variable yesorno 0 yesorno ! ( in conjunction w. KbSearch ) +variable yncon ( statuscon to trigger yes-or-no query 2jul2011 ) +variable ynverb ( yes-or-no verb for AskUser; 24jun2011 ) +variable zone ( time-zone for "pre" and "seq" searches ) + + +: CHANNEL ( size num -< name >- ) + CREATE ( Returns address of newly named channel. ) + OVER ( #r #c -- #r #c #r ) + , ( Stores number of rows from stack to array.) + * CELLS ( Feeds product of columns * rows to ALLOT.) + ALLOT ( Reserves given quantity of cells for array.) + DOES> ( member; row col -- a-addr ) + DUP @ ( row col pfa #rows ) + ROT * ( row pfa col-index ) + ROT + ( pfa index ) + 1 + ( because first cell has the number of rows.) + CELLS + ( from number of items to # of bytes in offset ) +; + + +cns @ 9 CHANNEL psi{ ( Mindcore concept array "psi" ) +cns @ 9 CHANNEL en{ ( English lexicon array "en" ) +cns @ 6 CHANNEL aud{ ( Auditory memory channel "aud" ) + + +: PsiClear ( set Psi activations to zero; 26sep2010 ) + 1 t @ 1 + DO + 0 I 1 psi{ ! + -1 +LOOP +; ( End of PsiClear ) + + +: TabulaRasa + 0 trc ! ( 20dec2009 tabula-rasa-counter like jrc ) + 1 tov ! + BEGIN cns @ 1 DO + 0 I trc @ psi{ ! + LOOP + 1 trc +! + trc @ 9 < WHILE \ Cover 9 columns 0-8; 29sep2011 + REPEAT + 0 trc ! + 1 tov ! + BEGIN cns @ 1 DO + 0 I trc @ en{ ! + LOOP + 1 trc +! + trc @ 9 < WHILE \ Cover #0 to #8, i.e. 9; 10nov2012 + REPEAT + 0 trc ! + 1 tov ! + BEGIN cns @ 1 DO + 0 I trc @ aud{ ! + LOOP + 1 trc +! + trc @ 6 < WHILE + REPEAT + cns @ 1 DO + 32 I 0 aud{ ! + LOOP +; ( End of TabulaRasa ) + + +\ NounClear is a mechanism called by NounPhrase to set +\ activation on nouns and pronouns to zero just before +\ a pair of old and new noun-engrams is reduced even +\ further into negative activation by neural inhibition. +\ The purpose is to prevent the build-up of stray activations. +: NounClear ( remove activation from all nouns ) \ 20dec2009 + midway @ cns @ DO \ Loop backwards over time. + I 5 psi{ @ 5 = I 5 psi{ @ 7 = OR IF \ pro(noun) 18aug2011 + I 1 psi{ @ 0 > IF \ avoid inhibited engrams; 26aug2011 + 0 I 1 psi{ ! \ 20dec2009 Set noun to zero activation. + THEN \ end of test for positive activation; 26aug2011 + THEN \ 20dec2009 End of test for pos=5 nouns. + -1 +LOOP \ End of backwards loop looking for pos=5 nouns. +; ( End of NounClear; return to NounPhrase; 18aug2011 ) + + +: VerbClear ( remove activation from all verbs ) + midway @ t @ DO + I 5 psi{ @ 8 = IF + I 1 psi{ @ 0 > IF \ avoid inhibited engrams; 26aug2011 + 0 I 1 psi{ ! + THEN \ end of test for positive activation; 26aug2011 + THEN + -1 +LOOP +; ( End of VerbClear ) + + +: VerbClip ( lower activation on all verbs ) + midway @ t @ DO + I 5 psi{ @ 8 = IF + I 1 psi{ @ 12 > IF \ test; REMOVE? 25aug2010 + 6 I 1 psi{ +! \ test; 25aug2010 + THEN + THEN + -1 +LOOP +; ( End of VerbClip; return to AudInput ) + + +: PsiDecay ( let conceptual activations dwindle ) + fyi @ 2 > IF CR + ." PsiDecay called to reduce all " + ." conceptual activations." CR + THEN + midway @ t @ DO + I 1 psi{ @ 0 > IF \ avoid inhibited nodes; 9sep2010 + I 1 psi{ @ 40 > IF 34 actran ! THEN \ 4aug2011 + I 1 psi{ @ 50 > IF 35 actran ! THEN \ 4aug2011 + I 1 psi{ @ 60 > IF 36 actran ! THEN \ 4aug2011 + I 1 psi{ @ 70 > IF 37 actran ! THEN \ 4aug2011 + I 1 psi{ @ 80 > IF 38 actran ! THEN \ 4aug2011 + I 1 psi{ @ 90 > IF 39 actran ! THEN \ 4aug2011 + actran @ 0 > IF actran @ I 1 psi{ ! THEN \ 16may2011 + 0 actran ! \ Reset to zero for safety; 16may2011 + I 1 psi{ @ 1 - I 1 psi{ ! + THEN \ end of test to skip inhibited nodes; 9sep2010 + I 1 psi{ @ 0 < IF 1 I 1 psi{ +! THEN \ 6sep2010 + I 0 psi{ @ 830 = IF 0 I 1 psi{ ! THEN \ 830=DO + I 0 psi{ @ 781 = IF 0 I 1 psi{ ! THEN \ 781=WHAT + I 0 psi{ @ 117 = IF 0 I 1 psi{ ! THEN \ 117=THE + -1 +LOOP +; ( http://code.google.com/p/mindforth/wiki/PsiDecay ) + + +: PsiDamp ( reduce activation of a concept ) + ( 33-48 = consciousness tier where concepts win selection. ) + ( 17-32 = subconscious where concepts remain available. ) + ( 1-16 = noise tier below logical association threshold. ) + 16 residuum ! + fyi @ 2 > IF CR + ." PsiDamp called for urpsi = " urpsi @ . + ." by module ID #" caller @ . + caller @ 42 = IF ." WhatAuxSDo " THEN + caller @ 51 = IF ." AuxVerb " THEN + caller @ 62 = IF ." VerbPhrase " THEN + caller @ 66 = IF ." NounPhrase " THEN + caller @ 104 = IF ." AudInput " THEN + caller @ 148 = IF ." Activate " THEN + caller @ 3535 = IF ." AudInput " THEN + caller @ 6967 = IF ." EnCog " THEN \ test; 26sep2010 + caller @ 8766 = IF ." WhoBe " THEN \ test; 26sep2010 + caller @ 8773 = IF ." WhatBe " THEN \ changed; 25feb2011 + 0 caller ! + THEN + urpsi @ 791 = IF \ if urpsi is 791=WHO; 10nov2012 + 1 residuum ! \ deemphasize WHO; test; 25jul2010 + THEN \ test; 25jul2010 + ( code to prevent psi-damping inhibited concepts; 6sep2010 ) + midway @ t @ DO + I 0 psi{ @ urpsi @ = IF \ concept found; 6sep2010 + I 1 psi{ @ -1 > IF \ positive act.? 16aug2011 + residuum @ I 1 psi{ ! \ psi-damp only high activations + THEN \ end of test for only positive act.; 6sep2010 + THEN \ end of test for particular concept; 6sep2010 + -1 +LOOP + 0 residuum ! +; ( http://code.google.com/p/mindforth/wiki/PsiDamp ) + + +: EnDamp ( deactivate English lexicon concepts ) + midway @ t @ DO + 0 I 1 en{ ! + -1 +LOOP +; ( End of EnDamp ) + + +: AudDamp ( deactivate auditory engrams ) + midway @ t @ DO + 0 I 1 aud{ ! + -1 +LOOP +; ( End of AudDamp ) + + +: .psi ( show concepts in the Psi array ) + CR ." Psi mindcore concepts" + CR ." time: psi act num jux pre pos seq enx " + t @ 1+ midway @ DO + I 0 psi{ @ 0 > IF + CR I . ." : " + I 0 psi{ @ . ." " + I 1 psi{ @ . ." " + I 2 psi{ @ . ." " + I 3 psi{ @ . ." " + I 4 psi{ @ . ." " + I 5 psi{ @ . ." " + I 6 psi{ @ . ." " \ Show tqv-point; 12oct2011 + I 7 psi{ @ . ." " \ new "seq" position 12oct2011 + I 8 psi{ @ enx ! enx @ . \ new "enx"; 12oct2011 + enx @ 0 > IF + ." to " + I unk ! + 0 aud ! + midway @ unk @ DO + I 0 en{ @ enx @ = IF + I 8 en{ @ aud ! \ with dba; 10nov2012 + aud @ 0= NOT IF + BEGIN + aud @ 0 aud{ @ EMIT + 1 aud +! + aud @ 0 aud{ @ 32 = + UNTIL + ." " + THEN + 0 aud ! + LEAVE ( One engrammed word is enough. ) + THEN + -1 +LOOP + THEN + THEN + LOOP + CR ." time: psi act num jux pre pos tqv seq enx " 0 unk ! + CR ." You may enter .psi or .en or .aud to view memory " + ." engrams or " + CR ." MainLoop [ENTER] to erase all memories " + ." and restart the Mind." + CR +; ( End of .psi post-Escape report ) + + +: .en ( show vocabulary in the English lexicon array ) + CR ." English lexical fibers" + CR ." t nen act num mfn dba fex pos fin aud:" \ 18dec2012 + t @ 1+ midway @ DO + I 0 en{ @ unk ! + unk @ 0 > IF ( display positive data ) + CR I . unk @ . ." " + I 1 en{ @ . ." " + I 2 en{ @ . ." " + I 3 en{ @ . ." " + I 4 en{ @ . ." " + I 5 en{ @ . ." " \ dba; 10nov2012 + I 6 en{ @ . ." " + I 7 en{ @ . ." " + I 8 en{ @ aud ! aud @ . ." to " + BEGIN + aud @ 0 aud{ @ EMIT 1 aud +! + aud @ 0 aud{ @ 32 = + UNTIL + ." " + 0 aud ! + THEN + LOOP + 0 unk ! + CR ." t nen act num mfn dba fex pos fin aud" CR + CR ." You may enter .psi or .en or .aud to view memory " + ." engrams or " + CR ." MainLoop [ENTER] to erase all memories " + ." and restart the Mind." + CR +; ( End of .en post-Escape report ) + + +: .aud ( show engrams in the auditory memory array ) + CR ." Auditory memory nodes" + CR ." t pho act pov beg ctu audpsi" + t @ 1+ 1 DO ( Show the entire Aud channel.) + CR I . ." " + I 2 aud{ @ 123 = IF + ." { " + THEN + I 0 aud{ @ 33 < IF + ." " ( show a blank ) + ELSE + I 0 aud{ @ EMIT ." " + I 1 aud{ @ . ." " + I 2 aud{ @ EMIT ." " + I 3 aud{ @ . ." " + I 4 aud{ @ . ." " + I 5 aud{ @ . + THEN + I 2 aud{ @ 125 = IF + ." } " + THEN + I cns @ > IF QUIT THEN \ safety measure; 26jul2010 + LOOP + CR ." You may enter .psi or .en or .aud to view memory " + ." engrams or " + CR ." MainLoop [ENTER] to erase all memories " + ." and restart the Mind." + CR +; ( End of .aud post-Escape report ) + + +: .out ( show characters in the OutBuffer; 12nov2012 ) + CR ." AudBuffer word = " CR \ 15nov2012 + c01 @ EMIT c02 @ EMIT c03 @ EMIT c04 @ EMIT + c05 @ EMIT c06 @ EMIT c07 @ EMIT c08 @ EMIT + c09 @ EMIT c10 @ EMIT c11 @ EMIT c12 @ EMIT + c13 @ EMIT c14 @ EMIT c15 @ EMIT c16 @ EMIT + CR ." OutBuffer word = " CR \ 14nov2012 + b01 @ EMIT b02 @ EMIT b03 @ EMIT b04 @ EMIT + b05 @ EMIT b06 @ EMIT b07 @ EMIT b08 @ EMIT + b09 @ EMIT b10 @ EMIT b11 @ EMIT b12 @ EMIT + b13 @ EMIT b14 @ EMIT b15 @ EMIT b16 @ EMIT + CR ." 1234567890123456 " \ show right-justification + CR \ Return to left margin for Forth ok prompt. +; ( End of OutBuffer report; 12nov2012 ) + + +: .echo ( show what the robot just said ) + ( As on Usenet, user responds _below_ the AI output. ) + fyi @ 2 = IF + CR ." Tutorial mode is now in effect. " + ." Enter input or wait for output." + THEN + CR ." Robot: " + tov @ t @ = IF \ 12jan2010 Test for equality. + tov @ 1 - tov ! \ 12jan2010 Prevent infinite loops. + THEN \ 12jan2010 End of test for tov @ t equality. + t @ tov @ DO + I 0 aud{ @ 0 = IF + ." " + ELSE + I 2 aud{ @ 42 = NOT IF + I 0 aud{ @ EMIT + THEN + THEN + LOOP +; ( End of .echo ) + + +: SpreadAct ( spreading activation ) + PsiDecay \ to differentiate among activations; 10aug2012 + prepsi @ 0 > IF \ From NounAct or VerbAct; 30jun2012 + zone @ 7 - zone @ DO + I 0 psi{ @ prepsi @ = IF \ now prepsi; 15sep2010 +\ CR ." SprAct: augmenting activation at time " \ 10aug2012 +\ I . ." of prepsi " prepsi @ . \ test; 10aug2012 + \ 1 I 1 psi{ +! \ C-ing outl 10aug2012 + 8 I 1 psi{ +! \ for queries; 10aug2012 + I zone @ 6 - > IF LEAVE THEN + THEN + -1 +LOOP + THEN + seqpsi @ 0 > IF \ replacing seqsyn; 15sep2010 + fyi @ 3 = IF + CR ." SprA seqpsi & spike = " seqpsi @ . spike @ . CR + THEN + zone @ 32 + zone @ DO \ Search past non-seq psi. + I 0 psi{ @ seqpsi @ = IF \ replacement 15sep2010 + fyi @ 3 = IF + CR ." SprA matching seqpsi w. spike = " \ 24sep2010 + seqpsi @ . spike @ . CR \ non-global 24sep2010 + THEN + fyi @ 1 > IF + pov @ 35 = IF + 0 psi8 ! \ new flag-panel location of "enx"; 12oct2011 + fyi @ 3 = IF + CR ." sprdAct: seqpsi = " seqpsi @ . CR \ 24sep2010 + THEN + midway @ t @ DO + I 0 psi{ @ fyipsi @ = IF \ 17oct2011 + I 8 psi{ @ psi8 ! \ new "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ new "enx"; 12oct2011 + I 7 en{ @ rv ! + LEAVE + THEN + -1 +LOOP + 0 rv ! + midway @ t @ DO + I 0 psi{ @ seqpsi @ = IF \ 15sep2010 + I 8 psi{ @ psi8 ! \ new "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ "enx"; 12oct2011 + I 7 en{ @ rv ! + LEAVE + THEN + -1 +LOOP + rv @ 0 > IF + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + THEN + 0 rv ! + ." " + THEN + THEN \ end of FYI=1; 2aug2011 + fyi @ 2 > IF + pov @ 35 = IF + CR + 0 psi8 ! \ new "enx"; 12oct2011 + midway @ t @ DO + I 0 psi{ @ fyipsi @ = IF \ 17oct2011 + I 8 psi{ @ psi8 ! \ "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ "enx"; 12oct2011 + I 8 en{ @ rv ! \ with dba; 10nov2012 + LEAVE + THEN + -1 +LOOP + rv @ 0 > IF + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + THEN + 0 rv ! + ." #" fyipsi @ . ." act " oldact @ . \ 17oct2011 + ." at i " I . ." sprA spike " + spike @ . ." to seqpsi #" seqpsi @ . \ 20sep2010 + midway @ t @ DO + I 0 psi{ @ seqpsi @ = IF \ 15sep2010 + I 8 psi{ @ psi8 ! \ "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ "enx"; 12oct2011 + I 8 en{ @ rv ! \ with dba; 10nov2012 + LEAVE + THEN + -1 +LOOP + rv @ 0 > IF + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + THEN + 0 rv ! + CR + ." at act " I 1 psi{ @ . ." yields " + THEN + THEN \ end of FYI=2+ 2aug2011 + fyi @ 3 = IF + ." SprA: spiking seqpsi " spike @ . seqpsi @ . + THEN + subjectflag @ 1 = IF \ onto verb-nodes; 18oct2010 + ( insert diagnostic code here to troubleshoot 5aug2011 ) + spike @ I 1 psi{ +! ( add spike to seqpsi 15sep2010 ) + ELSE \ in all other cases, e.g. dirobj; 25jun2011 + ( insert diagnostic code here to troubleshoot 5aug2011 ) + spike @ I 1 psi{ ! ( Xfer absolute act; 25jun2011 ) + THEN \ end of test for subject-nodes; 18oct2010 + fyi @ 2 > IF + pov @ 35 = IF + I 1 psi{ @ . + fyi @ 2 > IF + ." and zone = " zone @ . + THEN + THEN + THEN + fyi @ 3 = IF + I 1 psi{ @ . ." (lim = 63) for t=" I rv ! + BEGIN + -1 rv +! + rv @ 3 aud{ @ 1 = + UNTIL + rv @ . + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + ." engram; in sprA spike = " spike @ . + 0 rv ! + THEN + I zone @ 6 + > IF + fyi @ 2 > IF + CR ." executing LEAVE at zone = " zone @ . + THEN + LEAVE + THEN + LEAVE \ After finding one seqpsi; 13oct2010 + THEN \ end of test for matching Psi#; 8aug2011 + LOOP + THEN +; ( http://code.google.com/p/mindforth/wiki/SpreadAct ) + + +: NounAct ( re-activate all recent nodes of a concept ) + 0 unk ! \ reset before using in NounAct; 8aug2011 + 28 nounval ! \ test; 1sep2011 + fyi @ 2 > IF CR \ 5jan2010 Altering the next line: + ." Calling NounAct (not in AI4U). nacpsi = " nacpsi @ . CR + THEN + nacpsi @ 0 > IF + fyi @ 2 > IF + CR ." NounAct calls SpreadAct to transfer " + CR ." proportionate activation from each node of " + CR ." concept #" psi @ . + THEN + midway @ t @ DO + I 0 psi{ @ nacpsi @ = IF + -3 unk +! \ for decrementing spike over time; 8aug2011 + ( insert diagnostic code here; 7sep2011 ) + I 1 psi{ @ -1 > IF \ avoid inhibition; 3sep2011 + nounval @ I 1 psi{ ! \ 3sep2011 + THEN ( http://greenarraychips.com ) + I 0 psi{ @ 781 = IF \ 781=WHAT; 10nov2012 + 0 I 1 psi{ ! + THEN ( http://www.calcentral.com/~forth/forth ) + 12 spike ! ( Aim for ample spikes.) + I 4 psi{ @ prepsi ! ( for SpreadAct 15sep2010 ) + I 7 psi{ @ seqpsi ! ( for SpreadAct 12oct2011 ) + I zone ! ( for use in SpreadAct ) + I 1 psi{ @ 0 = IF 0 spike ! THEN + I 1 psi{ @ 5 > IF 12 spike ! THEN + I 1 psi{ @ 10 > IF 24 spike ! THEN \ 3nov2010 + I 1 psi{ @ 15 > IF 26 spike ! THEN \ 3nov2010 + I 1 psi{ @ 20 > IF 28 spike ! THEN \ 3nov2010 + I 1 psi{ @ 25 > IF 30 spike ! THEN \ 4jun2011 + I 1 psi{ @ 30 > IF 32 spike ! THEN \ 4jun2011 + I 1 psi{ @ 35 > IF 34 spike ! THEN \ 4jun2011 + I 1 psi{ @ 40 > IF 36 spike ! THEN \ 4jun2011 + I 1 psi{ @ 45 > IF 38 spike ! THEN \ 4jun2011 + I 1 psi{ @ 50 > IF 40 spike ! THEN \ 4jun2011 + I 1 psi{ @ 55 > IF 42 spike ! THEN \ 4jun2011 + I 1 psi{ @ 60 > IF 44 spike ! THEN \ 4jun2011 + nacpsi @ fyipsi ! \ 17oct2011 + I 1 psi{ @ oldact ! + I 5 psi{ @ oldpos ! + seqpsi @ 0 > IF \ replacement; 15sep2010 + seqpsi @ 791 = IF \ 791=WHO; 10nov2012 + 1 spike ! \ not 24 act; 11aug2010 + THEN \ end of experiment; 11aug2010 + ( insert diagnostic code here; 8aug2011 ) + unk @ -10 < IF -10 unk ! THEN \ limit decrement 8aug2011 + unk @ spike +! \ decrement spike; 8aug2011 + 7865 caller ! + SpreadAct ( for spreading activation ) + 0 caller ! + 0 prepsi ! \ replacing presyn; 15sep2010 + 0 seqpsi ! \ replacing seqsyn; 15sep2010 + THEN + precand @ pre ! + 0 oldpos ! + 0 fyipsi ! \ 17oct2011 + 0 oldact ! + 0 pre ! + THEN + 0 spike ! \ reset for each new loop; 14oct2010 + -1 +LOOP + THEN + 0 spike ! +; ( http://code.google.com/p/mindforth/wiki/NounAct ) + + +: VerbAct ( re-activate all recent nodes of a verb ) + 17 verbval ! \ lowering to promote warranted assoc; 27aug2011 + fyi @ 2 > IF CR + ." Calling verbAct (not in AI4U). psi = " psi @ . CR + THEN + vacpsi @ 0 > IF \ if a vacpsi exists; 9nov2010 + fyi @ 2 > IF + CR ." VerbAct calls SpreadAct to transfer " + CR ." proportionate activation from each node of " + CR ." concept #" psi @ . + THEN + vacpsi @ fyipsi ! \ a replacement variable; 17oct2011 + midway @ t @ DO + I 0 psi{ @ vacpsi @ = IF \ deglobalized psi; 8oct2010 + fyi @ 2 > IF + I 1 psi{ @ 8 > IF + ." +" + THEN + THEN + I 1 psi{ @ psi1 ! + I 1 psi{ @ -1 > IF \ avoid inhibited nodes; 9sep2010 + ( insert diagnostic code here; 27aug2011 ) + moot @ 0 = IF \ deprive queries of tags; 20aug2011 + verbval @ I 1 psi{ +! \ CUMULATIVE for slosh-over. + THEN \ end of test for a moot query input; 20aug2011 + THEN \ end of test to skip inhibited nodes; 9sep2010 + I 0 psi{ @ 781 = IF \ 781=WHAT; 11nov2012 + 0 I 1 psi{ ! + THEN + I 4 psi{ @ prepsi ! ( for SpreadAct 15sep2010 ) + I 7 psi{ @ seqpsi ! ( for SpreadAct 12oct2011 ) + I zone ! ( for use in SpreadAct ) + I 1 psi{ @ 0 = IF 0 spike ! THEN + I 1 psi{ @ 0 > IF 1 spike ! THEN + I 1 psi{ @ 5 > IF 3 spike ! THEN + I 1 psi{ @ 10 > IF 6 spike ! THEN + I 1 psi{ @ 15 > IF 9 spike ! THEN + I 1 psi{ @ 20 > IF 12 spike ! THEN + I 1 psi{ @ 25 > IF 15 spike ! THEN + I 1 psi{ @ 30 > IF 16 spike ! THEN + I 1 psi{ @ 35 > IF 17 spike ! THEN + I 1 psi{ @ 40 > IF 18 spike ! THEN + I 1 psi{ @ 45 > IF 19 spike ! THEN + I 1 psi{ @ 50 > IF 30 spike ! THEN + I 1 psi{ @ 55 > IF 33 spike ! THEN + I 1 psi{ @ 60 > IF 36 spike ! THEN + I 1 psi{ @ 65 > IF 39 spike ! THEN + I 1 psi{ @ 70 > IF 42 spike ! THEN + I 1 psi{ @ 75 > IF 45 spike ! THEN + I 1 psi{ @ 80 > IF 48 spike ! THEN + I 1 psi{ @ 85 > IF 50 spike ! THEN + I 1 psi{ @ 90 > IF 52 spike ! THEN + I 1 psi{ @ 95 > IF 54 spike ! THEN + vacpsi @ fyipsi ! \ a replacement variable; 17oct2011 + I 1 psi{ @ oldact ! + I 5 psi{ @ oldpos ! + fyi @ 2 = IF \ In Tutorial mode show slosh-over; 17oct2010 + CR ." VerbAct calls SpreadAct with activation " + spike @ . ." for Psi #" seqpsi @ . \ 18oct2010 + THEN \ End of test for Tutorial mode; 17oct2010 + seqpsi @ 0 > IF \ replacement; 15sep2010 + ( insert diagnostic code here; 6aug2011 ) + 5 spike +! \ for sake of direct objects; 3sep2011 + 8665 caller ! + SpreadAct ( for spreading activation ) + 0 caller ! + 0 prepsi ! \ replacing presyn; 15sep2010 + 0 seqpsi ! \ replacing seqsyn; 15sep2010 + THEN + 0 oldpos ! + 0 fyipsi ! \ 17oct2011 + 0 oldact ! + 0 pre ! + 0 seq ! + THEN + ( perhaps reset spike to zero for each loop? 14oct2010 ) + 0 spike ! \ reset to start each loop again; 14oct2010 + -1 +LOOP + THEN +; ( http://code.google.com/p/mindforth/wiki/VerbAct ) + + +: ReActivate ( re-activate recent nodes of a concept ) + fyi @ 2 > IF CR + ." Calling ReActivate. psi = " psi @ . CR + THEN + 0 spike ! + psi @ 0 > IF + fyi @ 2 > IF + CR ." ReActivate calls SpreadAct to transfer " + CR ." proportionate activation from each node of " + CR ." concept #" psi @ . + THEN + midway @ tov @ DO \ Omitting current input; 29may2011 + I 0 psi{ @ psi @ = IF + pov @ 42 = IF \ Only during "*" external POV; 7may2011 + moot @ 0 = IF \ deprive queries of tags; 20aug2011 + I 1 psi{ @ 0 < IF \ if inhibited; 29aug2011 + 1 I 1 psi{ +! \ reactivate only slightly; 29aug2011 + proxcon @ 1 = IF \ if clustering input; 7sep2011 + prox3 @ psi @ = IF \ 7sep2011 + I 7 psi{ @ prox2 @ = IF \ seq; 12oct2011 + 40 I 1 psi{ ! \ extra act; 7sep2011 + THEN \ 7sep2011 + THEN \ 7sep2011 + THEN \ end of proxcon test; 7sep2011 + ELSE \ otherwise impose full reactivation; 29aug2011 + I 1 psi{ @ -1 > IF \ avoid inhibition; 3sep2011 + 35 I 1 psi{ +! \ Relative not absolute 12aug2011 + I 5 psi{ 8 = IF \ Test for a verb; 28jun2012 + 16 I 1 psi{ +! \ Accentuate verbs; 28jun2012 + THEN \ End of test for verbs; 28jun2012 + proxcon @ 1 = IF \ if clustering input; 7sep2011 + prox2 @ psi @ = IF \ 7sep2011 + THEN \ 7sep2011 + prox3 @ psi @ = IF \ 7sep2011 + I 7 psi{ @ prox2 @ = IF \ seq; 12oct2011 + 10 I 1 psi{ +! \ extra act; 7sep2011 + THEN \ 7sep2011 + THEN \ 7sep2011 + THEN \ end of proxcon test; 7sep2011 + THEN ( http://www.ez-robot.com ) + THEN \ end of test for inhibited concept; 29aug2011 + THEN \ end of test for a moot query input; 20aug2011 + THEN \ End of new test for external POV; 7may2011 + I 0 psi{ @ 781 = IF \ 781=WHAT; 10nov2012 + 0 I 1 psi{ ! + THEN + I 0 psi{ @ 791 = IF \ 791=WHO; 10nov2012 + 0 I 1 psi{ ! \ As in InStantiate; 3may2011 + THEN \ end of test for 791=WHO 10nov2012 + I 0 psi{ @ 830 = IF \ 830=DO; 10nov2012 + 0 I 1 psi{ ! \ 12jan2010 For what-do queries. + THEN \ End of 830=DO test; 10nov2012 + 1 spike ! \ 30jun2012 + I 1 psi{ @ 0 = IF 0 spike ! THEN + I 1 psi{ @ 5 > IF 7 spike ! THEN + I 1 psi{ @ 10 > IF 8 spike ! THEN + I 1 psi{ @ 15 > IF 9 spike ! THEN + I 1 psi{ @ 20 > IF 10 spike ! THEN + I 1 psi{ @ 25 > IF 11 spike ! THEN + I 1 psi{ @ 30 > IF 12 spike ! THEN + I 1 psi{ @ 35 > IF 13 spike ! THEN + I 1 psi{ @ 40 > IF 14 spike ! THEN + I 1 psi{ @ 45 > IF 15 spike ! THEN + I 1 psi{ @ 50 > IF 16 spike ! THEN + I 1 psi{ @ 55 > IF 17 spike ! THEN + I 1 psi{ @ 60 > IF 18 spike ! THEN + I 4 psi{ @ prepsi ! ( for SpreadAct 30jun2012 ) + I 7 psi{ @ seqpsi ! ( for SpreadAct 30jun2012 ) + I zone ! ( for SpreadAct 30jun2012 ) + 148 caller ! + SpreadAct ( for spreading activation 30jun2012 ) + 0 oldpos ! + 0 fyipsi ! \ 17oct2011 + 0 oldact ! + 0 pre ! + 0 prepsi ! + 0 seq ! + 0 seqpsi ! + 0 psi1 ! + 1 spike ! + THEN + -1 +LOOP + 0 caller ! + 0 urpsi ! + THEN +; ( http://code.google.com/p/mindforth/wiki/ReActivate ) + + +: InNativate ( quasi-instantiate the EnBoot sequence ) +( concept fiber psi ) psi @ t @ 0 psi{ ! +( Set "num" number flag ) num @ t @ 2 psi{ ! +( Store PREvious associand. ) pre @ t @ 4 psi{ ! +( Store functional pos code. ) pos @ t @ 5 psi{ ! +( Store the "tqv" time-point. ) tqv @ t @ 6 psi{ ! +( Store the subSEQuent tag. ) seq @ t @ 7 psi{ ! +( Store the EN-transfer tag. ) enx @ t @ 8 psi{ ! +; ( http://code.google.com/p/mindforth ) + + +: OutBuffer ( right-justifies a word in memory ) + 32 b01 ! 32 b02 ! 32 b03 ! 32 b04 ! 32 b05 ! + 32 b06 ! 32 b07 ! 32 b08 ! 32 b09 ! 32 b10 ! + 32 b11 ! 32 b12 ! 32 b13 ! 32 b14 ! 32 b15 ! + 32 b16 ! + c16 @ 32 > IF \ if the AudBuffer is full; 14nov2012 + c16 @ b16 ! c15 @ b15 ! c14 @ b14 ! c13 @ b14 ! + c12 @ b12 ! c11 @ b11 ! c10 @ b10 @ c09 @ b09 ! + c08 @ b08 ! c07 @ b07 ! c06 @ c06 ! c05 ! b05 ! + c04 @ b04 ! c03 @ c03 ! c02 @ b02 ! c01 @ c01 ! + EXIT \ abandon remainder of function; 13nov2012 + THEN \ end of transfer of 16-character word; 13nov2012 + c15 @ 32 > IF \ word only 15 chars long? 14nov2012 + c15 @ b16 ! c14 @ b15 ! c13 @ b14 ! c12 @ b13 ! + c11 @ b12 ! c10 @ b11 ! c09 @ b10 ! c08 @ b09 ! + c07 @ b08 ! c06 @ b07 ! c05 @ b06 ! c04 @ b05 ! + c03 @ b04 ! c02 @ b03 ! c01 @ b02 ! EXIT + THEN \ transfer of a 15-character word; 13nov2012 + c14 @ 32 > IF + c14 @ b16 ! c13 @ b15 ! c12 @ b14 ! c11 @ b13 ! + c10 @ b12 ! c09 @ b11 ! c08 @ b10 ! c07 @ b09 ! + c06 @ b08 ! c05 @ b07 ! c04 @ b06 ! c03 @ b05 ! + c02 @ b04 ! c01 @ b03 ! EXIT + THEN + c13 @ 32 > IF + c13 @ b16 ! c12 @ b15 ! c11 @ b14 ! c10 @ b13 ! + c09 @ b12 ! c08 @ b11 ! c07 @ b10 ! c06 @ b09 ! + c05 @ b08 ! c04 @ b07 ! c03 @ b06 ! c02 @ b05 ! + c01 @ b04 ! EXIT + THEN + c12 @ 32 > IF + c12 @ b16 ! c11 @ b15 ! c10 @ b14 ! c09 @ b13 ! + c08 @ b12 ! c07 @ b11 ! c06 @ b10 ! c05 @ b09 ! + c04 @ b08 ! c03 @ b07 ! c02 @ b06 ! c01 @ b05 ! + EXIT + THEN + c11 @ 32 > IF + c11 @ b16 ! c10 @ b15 ! c09 @ b14 ! c08 @ b13 ! + c07 @ b12 ! c06 @ b11 ! c05 @ b10 ! c04 @ b09 ! + c03 @ b08 ! c02 @ b07 ! c01 @ b06 ! EXIT + THEN + c10 @ 32 > IF + c10 @ b16 ! c09 @ b15 ! c08 @ b14 ! c07 @ b13 ! + c06 @ b12 ! c05 @ b11 ! c04 @ b10 ! c03 @ b09 ! + c02 @ b08 ! c01 @ b07 ! EXIT + THEN + c09 @ 32 > IF + c09 @ b16 ! c08 @ b15 ! c07 @ b14 ! c06 @ b13 ! + c05 @ b12 ! c04 @ b11 ! c03 @ b10 ! c02 @ b09 ! + c01 @ b08 ! EXIT + THEN + c08 @ 32 > IF + c08 @ b16 ! c07 @ b15 ! c06 @ b14 ! c05 @ b13 ! + c04 @ b12 ! c03 @ b11 ! c02 @ b10 ! c01 @ b09 ! + EXIT + THEN + c07 @ 32 > IF + c07 @ b16 ! c06 @ b15 ! c05 @ b14 ! c04 @ b13 ! + c03 @ b12 ! c02 @ b11 ! c01 @ b10 ! + EXIT + THEN + c06 @ 32 > IF + c06 @ b16 ! c05 @ b15 ! c04 @ b14 ! c03 @ b13 ! + c02 @ b12 ! c01 @ b11 ! + EXIT + THEN + c05 @ 32 > IF + c05 @ b16 ! c04 @ b15 ! c03 @ b14 ! c02 @ b13 ! + c01 @ b12 ! + EXIT + THEN + c04 @ 32 > IF + c04 @ b16 ! c03 @ b15 ! c02 @ b14 ! c01 @ b13 ! + EXIT + THEN + c03 @ 32 > IF + c03 @ b16 ! c02 @ b15 ! c01 @ b14 ! + EXIT + THEN + c02 @ 32 > IF + c02 @ b16 ! c01 @ b15 ! + EXIT + THEN + c01 @ 32 > IF + c01 @ b16 ! + EXIT + THEN +; \ end of OutBuffer; return to AudBuffer or VerbGen. + + +: AudBuffer ( for transfer of words to OutBuffer; 12nov2012 ) + 1 phodex +! \ increment; 12nov2012 + phodex @ 1 = IF \ Erase any left-over old data; + abc @ c01 ! \ fill in first item of new data. + 32 c02 ! 32 c03 ! 32 c04 ! 32 c05 ! 32 c06 ! + 32 c07 ! 32 c08 ! 32 c09 ! 32 c10 ! 32 c11 ! + 32 c12 ! 32 c13 ! 32 c14 ! 32 c15 ! 32 c16 ! + THEN \ end of blanking out with 32=SPACE + phodex @ 2 = IF abc @ c02 ! THEN \ 12nov2012 + phodex @ 3 = IF abc @ c03 ! THEN \ 12nov2012 + phodex @ 4 = IF abc @ c04 ! THEN \ 12nov2012 + phodex @ 5 = IF abc @ c05 ! THEN \ 12nov2012 + phodex @ 6 = IF abc @ c06 ! THEN \ 12nov2012 + phodex @ 7 = IF abc @ c07 ! THEN \ 12nov2012 + phodex @ 8 = IF abc @ c08 ! THEN \ 12nov2012 + phodex @ 9 = IF abc @ c09 ! THEN \ 12nov2012 + phodex @ 10 = IF abc @ c10 ! THEN \ 12nov2012 + phodex @ 11 = IF abc @ c11 ! THEN \ 12nov2012 + phodex @ 12 = IF abc @ c12 ! THEN \ 12nov2012 + phodex @ 13 = IF abc @ c13 ! THEN \ 12nov2012 + phodex @ 14 = IF abc @ c14 ! THEN \ 12nov2012 + phodex @ 15 = IF abc @ c15 ! THEN \ 12nov2012 + phodex @ 16 = IF abc @ c16 ! THEN \ 12nov2012 + OutBuffer \ right-justify each input word; 15nov2012 + 0 abc ! \ reset for non-persistence; 14nov2012 +; \ end of AudBuffer; return to AudInput or VerbGen + + +: InStantiate ( create a concept-fiber node ) + seqneed @ 0 = IF 5 seqneed ! THEN \ test; 27jul2012 + precand @ 0 > IF precand @ pre ! THEN + ordo @ 1 = IF 0 prevtag ! THEN + firstword @ 830 = IF \ DO or DOES; 10nov2012 + 1 moot ! \ deprive queries of pre and seq tags; 19aug2011 + THEN \ end of test for a DO-query; 19aug2011 + firstword @ 781 = firstword @ 791 = OR IF \ 10nov2012 + 1 proxcon ! \ set for 781=WHAT or 791=WHO; 10nov2012 + THEN + lastword @ 1 = IF + 0 seq ! + THEN ( http://home.iae.nl/users/mhx/i4faq.html ) + t @ 610 > IF \ Avoid the EnBoot vault; 11nov2012 + whoflag @ 1 = IF + psi @ 800 = IF 800 beflag ! THEN \ 10nov2012 + pos @ 5 = pos @ 7 = OR IF + beflag @ seq ! + 0 beflag ! + THEN + THEN + psi @ 781 = IF \ Special handling of 781=WHAT; 10nov2012 + 1 indefartcon ! \ indefinite article condition 16apr2011 + 0 act ! \ To suppress "WHAT" during answer. + THEN \ End of test for input of "WHAT" + psi @ 791 = IF \ Special handling of 791=WHO; 10nov2012 + 1 defartcon ! \ Set definite article condition 16apr2011 + 1 whoflag ! + 0 act ! \ To suppress "WHO" during answer. + THEN + singflag @ 1 = IF + pos @ 5 = IF + 1 num ! + 0 singflag ! + THEN + THEN + psi @ 1 = psi @ 83 = OR IF \ "A" or "AN"; 6aug2011 + 1 singflag ! + 0 act ! + THEN + THEN \ end of InStantiate t-test clause; 14jul2012 + pos @ 5 = IF \ noun either external or internal; 6aug2011 + recnum @ 0 > IF \ If positive recog-num; 6aug2022 + recnum @ num ! \ Override num(ber); 6aug2011 + \ 0 recnum ! \ reset for safety; 6aug2011; 14jul2012 + THEN \ End of test for positive recog-num; 6aug2011 + THEN \ End of test for a 5=pos noun; 6aug2011 + pov @ 42 = IF \ If POV is external; 24jun2011 + num @ 0 = IF \ if no num(ber) is assigned; 24jun2011 + putnum @ 0 > IF \ if putative number is positive + putnum @ num ! \ replace zero with putative num + THEN \ end of test for positive putnum; 24jun2011 + THEN \ end of test for missing num-value; 24jun2011 + pos @ 8 = IF putnum @ num ! THEN \ test; 24jun2011 + pos @ 5 = IF psi @ quobj ! THEN \ for AskUser; 6aug2011 + THEN \ End of test for "*" external POV; 20aug2011 + pov @ 35 = IF \ If POV is pound-sign internal; 3may2011 + num @ 0 = IF \ if no num(ber) is assigned; 24jun2011 + putnum @ 0 > IF \ if putative number is positive + putnum @ num ! \ replace zero with putative num + 0 putnum ! \ zero for safety; test; 5aug2011 + THEN \ end of test for positive putnum; 24jun2011 + THEN \ end of test for missing num-value; 24jun2011 + pos @ 8 = IF putnum @ num ! THEN \ test; 24jun2011 + 0 act ! \ 0 activation for ReEntry concepts; 26apr2011 + THEN \ End of test for #internal POV; 7may2011 + prevtag @ pre ! + t @ vault @ < IF 0 pre ! THEN \ for safety; 22sep2011 + ( concept fiber psi ) psi @ t @ 0 psi{ ! + moot @ 0 = IF \ deprive queries of tags; 20aug2011 + ( Set "act" activation level. ) act @ t @ 1 psi{ +! + pos @ 8 = IF \ Re-using code; test for a verb; 28jun2012 + 16 t @ 1 psi{ +! \ Accentuate verbs; 28jun2012 + THEN \ End of test for verbs; 28jun2012 + THEN \ end of test for a moot query input; 20aug2011 + ( Set "num" number flag ) num @ t @ 2 psi{ ! + ( Store JUXtaposition tags. ) jux @ t @ 3 psi{ ! + moot @ 0 = IF \ deprive queries of tags; 19aug2011 + ( Store PREvious associand. ) pre @ t @ 4 psi{ ! + THEN \ end of test for a moot query input; 19aug2011 + ( Store functional pos code. ) pos @ t @ 5 psi{ ! + seq @ 0 > IF \ avoid spurious carry-over tqv; 1aug2012 + ( Store the "tqv" time-point. ) tqv @ t @ 6 psi{ ! + THEN \ only store "tqv" if there is a "seq"; 1aug2012 + moot @ 0 = IF \ deprive queries of tags; 19aug2011 + ( Store the subSEQuent tag. ) seq @ t @ 7 psi{ ! + THEN \ end of test for a moot query input; 19aug2011 + ( Store the EN-transfer tag. ) enx @ t @ 8 psi{ ! + t @ vault @ < IF \ store only during EnBoot; 29sep2011 + \ ( Store the "tqv" time-point. ) tqv @ t @ 8 psi{ ! + THEN \ otherwise store "tqv" retroactively; 29sep2011 + num @ instnum ! + pos @ 5 = IF num @ putnum ! THEN \ noun to verb; 24jun2011 + 0 num ! + jux @ 250 = IF 0 jux ! THEN \ reset after use; 10nov2012 + prejux @ 250 = IF \ 250=NOT from OldConcept; 10nov2012 + 250 jux ! \ set jux for next instantiand; 10nov2012 + 0 prejux ! \ reset for safety; 21jul2011 + THEN \ end of post-instantiation test; 21jul2011 + mfn @ 1 = mfn @ 2 = OR IF \ masc or fem; 17aug2010 + mfn @ mfnflag ! \ 17aug2010 + THEN \ 17aug2010 + mfn @ 0 = IF 0 mfnflag ! THEN \ test; 25aug2010 + 0 mfn ! \ Test code applies only to En array. + 0 preset ! + pos @ 5 = pos @ 7 = OR IF + psi @ prevtag ! + THEN + psi @ 830 = NOT IF \ DO? DOES? 10nov2012 + psi @ 830 = NOT IF \ 830=DO/DOES; 10nov2012 + seqneed @ 8 = IF \ if looking for a verb; 2oct2011 + pos @ 8 = IF \ if part-of-speech is verb; 2oct2011 + psi @ seq ! \ verb has arrived; 2oct2011 + 0 seqneed ! \ zero out after use; 2oct2011 + 1 transcon ! \ until noun fails to come in; 24jan2013 + pos @ seqpos ! \ possibly for tqv; 2oct2011 + THEN \ end of test for 8=pos verb; 2oct2011 + tsn @ t @ 2 - DO \ look for noun needing seq; 1jul2012 + I 5 psi{ @ 5 = I 5 psi{ @ 7 = OR IF \ (pro)noun 2oct2011 + moot @ 0 = IF \ deprive queries of tags; 5oct2011 + seq @ I 7 psi{ ! \ insert the seq; 12oct2011 + seqpos @ 8 = IF \ a verb? 2oct2011 + t @ I 6 psi{ ! \ insert "tqv" value; 12oct2011 + t @ tqv ! \ assign "tqv" value; 2oct2011 + THEN \ end of seqpos=verb test; 2oct2011 + THEN \ end of test for a moot query input; 5oct2011 + LEAVE \ insert only one seq; 2oct2011 + THEN \ end of test for subject noun or pronoun 2oct2011 + -1 +LOOP \ end of backwards loop; 2oct2011 + THEN \ end of test for needing a verb; 2oct2011 + THEN \ end of skipping auxiliary DOES; 6oct2011 + THEN \ end of skipping auxiliary verb DO; 6oct2011 + seqneed @ 5 = IF \ if looking for a noun; 5oct2011 + pos @ 5 = pos @ 7 = OR IF \ if noun or pronoun; 5oct2011 + 4 dba ! \ from DeKi: assuming acc. dir. obj.; 27dec2012 + psi @ seq ! \ because a (pro)noun has arrived; 5oct2011 + 0 seqneed ! \ zero out after use; 5oct2011 + pos @ seqpos ! \ possibly for tqv; 5oct2011 + ELSE \ if no direct object is found; 24jan2012 + 0 transcon ! \ declare intransitive verb; 24jan2013 + THEN \ end of test for 5=pos noun or 7=pos pronoun; 5oct2011 + tsn @ t @ 2 - DO \ look for verb needing "seq"; 1jul2012 + I 5 psi{ @ 8 = IF \ verb? 5oct2011 + moot @ 0 = IF \ deprive queries of tags; 5oct2011 + transcon @ 1 = IF \ verb transitive? 24jan2012 + seq @ I 7 psi{ ! \ insert the seq; 12oct2011 + seqpos @ 5 = seqpos @ 7 = OR IF \ (pro)noun? 5oct2011 + t @ I 6 psi{ ! \ insert "tqv" value; 12oct2011 + t @ tqv ! \ assign "tqv" value; 5oct2011 + THEN \ end of seqpos=(pro)noun test; 5oct2011 + THEN \ end of test for positive "transcon"; 24jan2013 + THEN \ end of test for a moot query input; 5oct2011 + LEAVE \ insert only one seq; 5oct2011 + THEN \ end of test for a verb; 5oct2011 + -1 +LOOP \ end of backwards loop; 5oct2011 + THEN \ end of test for needing a noun; 5oct2011 + ordo @ 2 = IF \ 7sep2011 + psi @ prox2 ! \ 7sep2011 + THEN \ 7sep2011 + ordo @ 3 = IF \ 7sep2011 + psi @ prox3 ! \ 7sep2011 + THEN \ 7sep2011 + pos @ 5 = pos @ 7 = OR IF \ (pro)noun? 2oct2011 + 8 seqneed ! \ need "8=verb" seq; 2oct2011 + THEN \ end of test for a noun or a pronoun; 2oct2011 + pos @ 6 = IF \ if preposition; 2oct2011 + 5 seqneed ! \ need noun or pronoun; 2oct2011 + THEN ( http://home.hccnet.nl/a.w.m.van.der.horst/ciforth.html ) + psi @ 830 = NOT IF \ skip auxiliary verb "830=DO"; 10nov2012 + psi @ 830 = NOT IF \ skip auxiliary "830=DOES"; 10nov2012 + pos @ 8 = IF \ if verb then need noun as "seq"; 5oct2011 + 5 seqneed ! \ seek noun or pronoun as "seq"; 5oct2011 + THEN \ end of test for 8=verb; 5oct2011 + THEN \ end of test to skip auxiliary DOES; 6oct2011 + THEN \ end of test to skip auxiliary DO; 6oct2011 + lastword @ 1 = IF 0 lastword ! THEN \ for seqneed; 30jun2012 + 0 dba ! \ from DeKi: reset for safety; 27dec2012 + 0 recnum ! \ lest carry-over to other words; 19jul2011 + 0 seq ! +; ( http://code.google.com/p/mindforth/wiki/InStantiate ) + + +: EnVocab ( English Vocabulary node creation; 8jul2012 ) + ( Number "nen" of English ) nen @ t @ 0 en{ ! + ( Do not store the activation level; it is a transient.) + ( Store "num" number tag. ) num @ t @ 2 en{ ! + ( Store "mfn" gender tag. ) mfn @ t @ 3 en{ ! + ( Store case or person tag. ) dba @ t @ 4 en{ ! + ( Store mindcore EXit tag. ) fex @ t @ 5 en{ ! + ( Store part of speech "pos".) pos @ t @ 6 en{ ! + ( Store mindcore IN tag. ) fin @ t @ 7 en{ ! + ( Store the auditory "aud" tag. ) aud @ t @ 8 en{ ! + 0 dba ! \ reset for safety; 27dec2012 +; ( http://code.google.com/p/mindforth/wiki/EnVocab ) + + +: EnParser ( determine the part of speech ) + 5 bias ! + 35 act ! \ Activate lower than ReActivate; 29may2011 + pov @ 42 = IF \ only during external input; 9oct2010 + act @ ordo @ - act ! \ reduce S-V-O act's; 9oct2010 + THEN \ end of test for external POV; 9oct2010 + InStantiate \ create a Psi concept node; 6nov2010 + pos @ 5 = IF 8 bias ! THEN + pos @ 7 = IF 8 bias ! THEN + pos @ 8 = IF 5 bias ! 0 singflag ! THEN \ 4nov2011 +; ( http://code.google.com/p/mindforth/wiki/EnParser ) + + +: EnReify ( express abstract concepts as real words ) + 0 act ! + midway @ t @ DO + I 1 psi{ @ 0 > IF + I 1 psi{ @ lexact ! + I 2 psi{ @ num ! + lexact @ I 1 en{ ! + num @ I 2 en{ ! + 0 lexact ! + THEN ( http://home.vrweb.de/~stephan.becher/forth ) + 0 enx ! + 0 act ! + 0 lexact ! + -1 +LOOP + 0 act ! +; ( http://code.google.com/p/mindforth/wiki/EnReify ) + + +: KbSearch ( knowledge base search ) + ordo @ 2 = IF + NounAct ( may need a "nacpsi" value ) + EnReify + THEN ( http://www.ccreweb.org/software/kforth ) + ordo @ 3 = IF + 0 act ! + midway @ t @ DO + I 5 en{ @ 8 = IF \ Test part-of-speech. + I 1 en{ @ act @ > IF ( if en1 is higher ) + I 0 en{ @ memoire ! ( store psi-tag of word ) + I 1 en{ @ act ! ( to test for a higher en1 ) + THEN + THEN + -1 +LOOP + yesorno @ 0 > IF + memoire @ psi @ = IF + 1 yesorno +! + ELSE + 0 yesorno ! + THEN + THEN + psi @ vacpsi ! \ deglobalizing; 27sep2010 + VerbAct + 0 vacpsi ! \ reset for safety; 27sep2010 + EnReify + THEN + ordo @ 4 = IF + 0 act ! + 0 memoire ! + midway @ t @ DO + I 5 en{ @ 5 = I 5 en{ @ 7 = OR IF + I 1 en{ @ act @ > IF ( if en1 is higher ) + I 0 en{ @ memoire ! ( store psi-tag of word ) + I 1 en{ @ act ! ( to test for a higher en1 ) + THEN + THEN + -1 +LOOP + yesorno @ 0 > IF + memoire @ psi @ = IF + 1 yesorno +! + ELSE + 0 yesorno ! + THEN + THEN ( http://www.lifeai.com ) + THEN + 0 kbquiz ! + ordo @ 4 = IF 0 ordo ! THEN +; ( http://code.google.com/p/mindforth/wiki/KbSearch ) + + +: KbRetro ( retroactive adjustment of knowledge base ) + oldpsi @ 432 = oldpsi @ 404 = OR IF \ yes or no 10nov2012 + oldpsi @ 404 = IF \ 404=NO; 10nov2012 + 64 tkbn @ 1 psi{ ! \ high noun activation 21jul2011 + 64 tkbv @ 1 psi{ ! \ set high activation? 2jul2011 + 250 tkbv @ 3 psi{ ! \ set 250=NOT jux flag 27dec2012 + \ CR ." KbRetro: answer is No " \ 29dec2012 + THEN \ End of test for "No" answer; 2jul2011 + oldpsi @ 432 = IF \ 432=YES; 10nov2012 + 64 tkbv @ 1 psi{ ! \ set high activation? 2jul2011 + \ CR ." KbRetro: answer is Yes " \ 29dec2012 + THEN \ End of test for "Yes" answer; 2jul2011 + ELSE \ if neither; 2jul2011 + 0 tkbn @ 4 psi{ ! \ delete pre-tag for noun; 2jul2011 + 0 tkbn @ 7 psi{ ! \ delete seq-tag for noun; 12oct2011 + 0 tkbv @ 4 psi{ ! \ delete pre-tag for verb; 2jul2011 + 0 tkbv @ 7 psi{ ! \ delete seq-tag for verb; 12oct2011 + \ CR ." KbRetro: answer is neither Yes nor No " \ 29dec2012 + THEN ( http://retroforth.org ) + 0 kbcon ! \ temporarily here turn off kbcon; 2jul2011 + 0 tkbn ! \ reset for safety; 2jul2011 + 0 tkbv ! \ reset for safety; 2jul2011 +; ( http://code.google.com/p/mindforth/wiki/KbRetro ) + + +: OldConcept ( recognize a known word ) + 28 act ! \ A value subject to optimization; 28sep2010 + midway @ t @ DO + \ I 0 en{ @ oldpsi @ = IF + I 0 en{ @ oldpsi @ = I 8 en{ @ 0 > AND IF \ 29dec2012 + I 2 en{ @ 0 > IF + I 2 en{ @ ocn ! THEN \ "unk" is too global; 14jul2012 + I 3 en{ @ 0 > IF + I 3 en{ @ mfn ! THEN + ( I 4 en{ @ dba ! is not trustworthy for verbs 28dec2012 ) + I 5 en{ @ 0 > IF \ adding dba; 10nov2012 + I 5 en{ @ fex ! THEN \ adding dba; 10nov2012 + I 6 en{ @ 0 > IF \ adding dba; 10nov2012 + I 6 en{ @ pos ! THEN \ adding dba; 10nov2012 + I 7 en{ @ 0 > IF \ adding dba; 10nov2012 + I 7 en{ @ fin ! THEN \ adding dba; 10nov2012 + LEAVE + THEN ( http://home.iae.nl/users/mhx/eforth.html ) + -1 +LOOP + pos @ 8 = IF \ verb? for WhatAuxSVerb 13jun2011 + numsubj @ unk ! \ assume agreement; 19jun2011 + 3 dba ! \ 3rd person default before changes; 27dec2012 + putdbav @ 0 > IF \ positive putdbav? 27dec2012 + putdbav @ dba ! \ transfer; 27dec2012 + 0 putdbav ! \ reset after use; 27dec2012 + THEN \ end of test for putative dba; 27dec2012 + THEN \ end of test for verb \ 13jun2011 + oldpsi @ 800 = IF t @ tbev ! THEN \ 800=BE; 10nov2012 + pos @ 5 = pos @ 7 = OR IF \ noun or pron.? 27dec2012 + 1 dba ! \ default before changes; 27dec2012 + audverb @ 0 > IF \ preceded by a verb? 27dec2012 + audverb @ 800 = NOT IF \ except be-verbs; 27dec2012 + 4 dba ! \ accusative direct object; 27dec2012 + THEN \ code snippet taken from Wotan DeKi; 27dec2012 + 0 audverb ! \ reset after use; 27dec2012 + THEN \ end of test for positive audverb; 27dec2012 + THEN \ end of test for noun or pronoun; 27dec2012 + oldpsi @ 701 = oldpsi @ 731 = OR IF 1 putdbav ! THEN + oldpsi @ 707 = oldpsi @ 737 = OR IF 2 putdbav ! THEN + subjectflag @ 1 = IF 1 dba ! THEN \ nom. subj. 27dec2012 + dirobj @ 1 = IF 4 dba ! THEN \ acc. dir. obj. 27dec20122012 + pov @ 42 = IF \ external POV during input; 18dec2012 + oldpsi @ 800 = IF 1 becon ! THEN \ InFerence; 18dec2012 + THEN \ only set becon during external input; 18dec2012 + ( oldpsi found by AudRecog ) oldpsi @ t @ 0 en{ ! + ( Add zero activation 28jul2011 ) 0 t @ 1 en{ +! + ocn @ 0 > IF \ from AudInput for old nouns; 14oct2011 + ( Store old-concept-number tag ) ocn @ t @ 2 en{ ! + 0 ocn ! \ reset to zero after use; 14oct2011 + THEN \ leaving only one space in "2 en{" etc 8jul2012 + pcn @ 0 > IF \ from NounPhrase predicate selection; 17jul2012 + ( Store pred-concept-number tag ) pcn @ t @ 2 en{ ! + \ 0 pcn ! \ reset to zero after use; 17jul2012 + THEN \ leaving one search-space in "2 en{" etc 17jul2012 + ( Store "mfn" gender tag. ) mfn @ t @ 3 en{ ! + ( Store "dba" tag; 10nov2012 ) dba @ t @ 4 en{ ! + ( Store mindcore EXit tag. ) fex @ t @ 5 en{ ! + ( Store part of speech "pos".) pos @ t @ 6 en{ ! + ( Store mindcore IN tag. ) fin @ t @ 7 en{ ! + ( Store the auditory "aud" tag. ) aud @ t @ 8 en{ ! + pov @ 35 = IF fex @ oldpsi ! THEN ( internal pov ) + pov @ 42 = IF fin @ oldpsi ! THEN ( external pov ) + oldpsi @ enx ! + oldpsi @ 250 = IF \ 250=NOT; 10nov2012 + tbev @ 0 > IF \ if positive be-verb time; 27jul2011 + 250 tbev @ 3 psi{ ! \ set verb "jux" to NOT 10nov2012 + 0 tbev ! \ reset for safety; 27jul2011 + THEN \ end of test for a positive tbev; 27jul2011 + THEN \ end of test for input of 250=NOT; 10nov2012 + oldpsi @ 781 = IF 8 act ! THEN ( 781=WHAT; 10nov2012 ) + oldpsi @ 791 = IF 8 act ! THEN ( 791=WHO; 10nov2012 ) + ordo @ 1 = IF + oldpsi @ 830 = IF ( 830=DO; 10nov2012 ) + 1 kbquiz ! + THEN + THEN + oldpsi @ 830 = IF 0 act ! THEN ( 830=DO; 10nov2012 ) + oldpsi @ 117 = IF 1 act ! THEN ( 117=THE; 10nov2012 ) + kbcon @ 0 > IF \ if awaiting answer; 2jul2011 + KbRetro \ retroactively adjust knowledge base; 2jul2011 + THEN \ 2jul2011 + oldpsi @ 250 = IF \ 250=NOT; 10nov2012 + 250 prejux ! \ set flag for verb; 10nov2012 + 250 aftjux ! \ set flag for a be-verb; 10nov2012 + THEN \ end of test for 250=NOT negation; 10nov2012 + oldpsi @ psi ! + EnParser + fyi @ 2 > IF CR + ." from OldConcept " + THEN + pov @ 42 = IF \ external POV during input; 18dec2012 + pos @ 5 = IF \ nouns only, not pronouns; 27dec2012 + subjnom @ 0 > IF \ already subjnom? 27dec2012 + oldpsi @ prednom ! \ 27dec2012 + THEN \ end of test for pre-existing subjnom; 27dec2012 + prednom @ 0 = IF \ 27dec2012 + oldpsi @ subjnom ! \ grab for InFerence; 27dec2012 + THEN \ alternate between subjnon and prednom; 27dec2012 + THEN \ end of test for a noun; 27dec2012 + pos @ 8 = IF \ verb part-of-speech? 27dec2012 + oldpsi @ 800 = NOT IF \ other than be-verb? 27dec2012 + 0 subjnom ! \ cancel out any subjnom; 27dec2012 + THEN \ end of test for a be-verb; 27dec2012 + THEN \ end of test for a verb; 27dec2012 + \ subjnom @ 0 = IF \ not yet declared? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ oldpsi @ subjnom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for no subjnom yet; 18dec2012 + \ subjnom @ 0 > IF \ already declared? 18dec2012 + \ becon @ 1 = IF \ be-verb in use? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ oldpsi @ prednom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for be-verb input; 18dec2012 + \ THEN \ end of test for positive subjnom; 18dec2012 + THEN \ end of test for external-input POV; 18dec2012 + pov @ 42 = IF ( external pov ) + ReActivate + THEN + 0 act ! + pov @ 35 = IF ( internal pov ) + 1 match ! + THEN +\ pos @ 8 = IF psi @ quverb ! THEN \ for yes-or-no; 24jun2011 +\ pos @ 8 = IF psi @ quverb ! THEN \ Commenting out 29dec2012 + pos @ 8 = IF oldpsi @ audverb ! THEN \ for "dba"; 27dec2012 + kbquiz @ 0 > IF + 1 yesorno ! + KbSearch + THEN + yesorno @ 0 > IF + KbSearch + THEN + 0 pos ! \ Reset no longer above but down here. +; ( http://code.google.com/p/mindforth/wiki/OldConcept ) + + +: NewConcept ( machine learning of new concepts ) + 0 newpsi ! + 1 nen +! + 1 nwc +! + nen @ newpsi ! + nen @ stempsi ! + nen @ psi ! + nen @ fex ! + nen @ fin ! + bias @ pos ! + bias @ 8 = IF \ 4nov2011 + putnum @ num ! \ 4nov2011 + 0 putnum ! \ 4nov2011 + 0 singflag ! \ prevent carry-over; 4nov2011 + 3 dba ! \ default dba=3 third person; 26dec2012 + putdbav @ 0 > IF \ positive putdbav? 27dec20122012 + putdbav @ dba ! \ transfer; 27dec20122012 + 0 putdbav ! \ reset after use; 27dec2012 + THEN \ 27dec2012 + THEN \ 4nov2011 + bias @ 5 = IF \ expecting a noun? 27dec2012 + 1 dba ! \ default before changes; 27dec2012 + audverb @ 0 > IF \ preceded by a verb? 27dec2012 + audverb @ 800 = NOT IF \ except be-verbs; 27dec2012 + 4 dba ! \ accusative direct object; 27dec2012 + THEN \ part of code snippet from Wotan DeKi 27dec2012 + 0 audverb ! \ reset after use; 27dec2012 + THEN \ end of test for positive audverb; 27dec2012 + THEN \ end of test for expecting a noun; 27dec2012 + EnVocab ( to create an English vocabulary node ) + 0 fex ! + 0 fin ! + nen @ enx ! + EnParser + pos @ 8 = IF nen @ quverb ! THEN \ for yes-or-no; 24jun2011 + pos @ 5 = IF \ if a new noun is encountered; 22oct2011 + nen @ cogpsi ! \ hold onto new noun for WhatBe; 22oct2011 + instnum @ cognum ! \ keep track of the num(ber); 22oct2011 + THEN \ end of test of "pos" part-of-speech; 22oct2011 + pov @ 42 = IF \ external POV during input? 18dec2012 + pos @ 5 = IF \ nouns only, not pronouns; 27dec2012 + subjnom @ 0 > IF \ already subjnom? 27dec2012 + newpsi @ prednom ! \ 27dec2012 + THEN \ end of test for pre-existing subjnom; 27dec2012 + prednom @ 0 = IF \ 27dec2012 + newpsi @ subjnom ! \ grab for InFerence; 27dec2012 + THEN \ alternate between subjnon and prednom; 27dec2012 + THEN \ end of test for a noun; 27dec2012 + \ pos @ 8 = IF \ verb part-of-speech? 27dec2012 + \ newpsi @ 800 = NOT IF \ other than be-verb? 27dec2012 + \ 0 subjnom ! \ cancel out any subjnom; 27dec2012 + \ THEN \ end of test for a be-verb; 27dec2012 + \ THEN \ end of test for a verb; 27dec2012 + \ subjnom @ 0 = IF \ not yet declared? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ newpsi @ subjnom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for no subjnom yet; 18dec2012 + \ subjnom @ 0 > IF \ already declared? 18dec2012 + \ becon @ 1 = IF \ be-verb in use? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ newpsi @ prednom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for be-verb input; 18dec2012 + \ THEN \ end of test for positive subjnom; 18dec2012 + THEN \ end of test for external-input POV; 18dec2012 + kbcon @ 0 > IF \ if awaiting answer; 2jul2011 + KbRetro \ retroactively adjust knowledge base; 2jul2011 + THEN ( http://www.gnu.org/software/gforth ) + 0 pos ! + 0 act ! +; ( http://code.google.com/p/mindforth/wiki/NewConcept ) + + +\ The visual recognition module of MindForth AI for robots +\ when fully implemented will serve the purpose of letting +\ AI Minds dynamically describe what they see in real time +\ instead of fetching knowledge from the AI knowledge base. +: VisRecog ( identification of objects seen by a robot ) + svo3 @ 0 = IF \ if no direct object is available; + midway @ t @ DO \ search for an automatic default + I 0 en{ @ 760 = IF \ 760=NOTHING; 10nov2012 + I 8 en{ @ aud ! \ hold address for SpeechAct + LEAVE ( http://aimind-i.com ) + THEN ( http://www.vicariousinc.com ) + -1 +LOOP \ end of looping through English lexical array + THEN ( http://opencv.willowgarage.com ) +; ( http://code.google.com/p/mindforth/wiki/VisRecog ) + + +: AudRecog ( auditory recognition ) + 0 audrec ! + 0 psi ! + 8 act ! + 0 actbase ! + midway @ spt @ DO + I 0 aud{ @ pho @ = IF \ If incoming pho matches stored aud0; + I 1 aud{ @ 0 = IF \ if matching engram has no activation; + I 3 aud{ @ 1 = IF \ if beg=1 on matching no-act aud engram; + \ audrun @ 1 = IF \ if comparing start of a word; 8may2010 + audrun @ 2 < IF \ if comparing start of a word; 8may2010 + I 4 aud{ @ 1 = IF \ If beg-aud has ctu=1 continuing, + 8 I 1+ 1 aud{ ! \ activate the N-I-L character, + 0 audrec ! + I 5 aud{ @ 0 > IF \ audpsi available? 27dec2012 + I 5 aud{ @ prc ! \ provisional recognition 27dec2012 + THEN \ end of test for an early audpsi; 27dec2012 + ELSE + len @ 1 = IF + I 5 aud{ @ monopsi ! + THEN \ End of test for one char length. + THEN \ end of test for continuation of beg-aud + THEN \ end of test for audrun=1 start of word. + THEN \ end of test for a beg(inning) non-active aud0 + THEN \ end of test for matching aud0 with no activation + I 1 aud{ @ 0 > IF \ If matching aud0 has activation, + 0 audrec ! \ Zero out any previous audrec. + I 4 aud{ @ 1 = IF \ If act-match aud0 has ctu=1 continuing, + 2 act +! \ Increment act for discrimination. + 0 audrec ! \ because match-up is not complete. + act @ I 1+ 1 aud{ ! \ Increment for discrimination. + THEN \ end of test for active-match aud0 continuation + I 4 aud{ @ 0 = IF \ If ctu=0 indicates end of word + len @ 2 = IF \ If len(gth) is only two characters. + I 1 aud{ @ 7 > IF \ testing for eight (8). + I 5 aud{ @ psibase ! \ Assume a match. + THEN \ End of test for act=8 or positive. + THEN \ End of test for two-letter words. + THEN \ End of test in AudRecog for end of word. + I 1 aud{ @ 8 > IF \ If activation higher than initial + 8 actbase ! \ Since act is > 8 anyway; 8may2010 + I 4 aud{ @ 0 = IF \ If matching word-engram now ends, + I 1 aud{ @ actbase @ > IF \ Testing for high act. + I 5 aud{ @ audrec ! \ Fetch the potential tag + I 5 aud{ @ subpsi ! \ Seize a potential stem. + len @ sublen ! \ Hold length of word-stem. + I 5 aud{ @ psibase ! \ Hold onto winner. + I 2 psi{ @ recnum ! \ recognized number 19jul2011 + I 4 en{ @ 0 > IF \ from German AI; 27dec2012 + I 4 en{ @ dba ! \ verb-recognition; 27dec2012 + THEN \ end of test for dba; 27nov20122012 + I 1 aud{ @ actbase ! \ Winner is new actbase. + THEN \ End of test for act higher than actbase. + ELSE \ part of AudRecog code; 14jul2012 + 0 audrec ! + monopsi @ 0 > IF + monopsi @ audrec ! + 0 monopsi ! + THEN ( http://code.google.com/p/reda4 ) + THEN \ End of test for final char that has a psi-tag. + THEN \ End of test for engram-activation above eight. + THEN \ End of test for matching aud0 with activation. + THEN \ End of test for a character matching "pho". + I midway @ = IF \ If a loop reaches midway; 8may2010 + 1 audrun +! \ Increment audrun beyond unity; 8may2010 + THEN \ End of test for loop reaching midway; 8may2010 + -1 +LOOP + 0 act ! + 0 actbase ! + psibase @ 0 > IF + psibase @ audrec ! + THEN + audrec @ 0 = IF + monopsi @ 0 > IF + len @ 2 < IF + monopsi @ audrec ! + THEN + 0 monopsi ! + audrec @ 0 = IF + psibase @ 0 > IF + psibase @ audrec ! + THEN + THEN + THEN + THEN + audrec @ 0 = IF + morphpsi @ audrec ! + sublen @ 0 > IF + len @ sublen @ - stemgap ! + THEN + stemgap @ 0 < IF 0 stemgap ! THEN + stemgap @ 1 > IF 0 subpsi ! THEN + stemgap @ 1 > IF 0 morphpsi ! THEN + stemgap @ 1 > IF 0 audrec ! THEN + THEN + subpsi @ morphpsi ! + 0 psibase ! + 0 subpsi ! + audrec @ 0 > IF + stemgap @ 2 > IF + 0 audrec ! + THEN + THEN + audrec @ audpsi ! + 0 stemgap ! \ safety measure; 22sep2011 +; ( http://code.google.com/p/mindforth/wiki/AudRecog ) + + +: AudMem ( auditory memory channel ) + t @ vault @ > IF + pho @ 32 > IF + AudRecog + THEN ( ASCII 32 = SPACE-bar ) + THEN ( http://pygmy.utoh.org/pygmyforth.html ) + t @ 1- 0 aud{ @ 0 = IF 1 beg ! THEN + t @ 1- 0 aud{ @ 32 = IF 1 beg ! THEN + pho @ t @ 0 aud{ ! + pov @ t @ 2 aud{ ! + beg @ t @ 3 aud{ ! + ctu @ t @ 4 aud{ ! + ctu @ 0 = IF + audpsi @ 0 > IF + audpsi @ t @ 5 aud{ ! + THEN + 0 audpsi ! + THEN ( http://home.earthlink.net/~gmayhak/M5_htm.htm ) + pov @ 42 = IF + pho @ 83 = IF + 0 stempsi ! + wordend @ 1 = IF + 0 t @ 1- 4 aud{ ! + THEN + 0 newpsi ! + THEN + THEN + pho @ 32 = IF t @ spt ! THEN +; ( http://code.google.com/p/mindforth/wiki/AudMem ) + + +: AudListen ( preparation for AudInput ) + t @ 2 + tsn ! \ time when awaiting input; test; 1jul2012 + rsvp @ 1 DO + KEY? IF + KEY pho ! + 0 inert ! \ User input cancels "inert" status; 16oct2011 + 0 quiet ! + pho @ 8 = IF 7 EMIT THEN + pho @ 9 = IF + 400 rsvp ! ( 23dec2009 From Supercomputer mind.frt ) + pho @ 13 = IF 1 lastword ! THEN + fyi @ 0 = IF CR CR + TIME&DATE tsyear ! tsmonth ! tsday ! + tshour ! tsminute ! tssecond ! + ." Transcript of Forthmind " + vrsn @ . ." interview at " \ declare version; 3aug2012 + tshour @ . tsminute @ . tssecond @ . + ." o'clock on " tsday @ . + tsmonth @ 1 = IF ." January " THEN + tsmonth @ 2 = IF ." February " THEN + tsmonth @ 3 = IF ." March " THEN + tsmonth @ 4 = IF ." April " THEN + tsmonth @ 5 = IF ." May " THEN + tsmonth @ 6 = IF ." June " THEN + tsmonth @ 7 = IF ." July " THEN + tsmonth @ 8 = IF ." August " THEN + tsmonth @ 9 = IF ." September " THEN + tsmonth @ 10 = IF ." October " THEN + tsmonth @ 11 = IF ." November " THEN + tsmonth @ 12 = IF ." December " THEN + tsyear @ . 8 EMIT 46 EMIT CR + THEN + 1 fyi +! + fyi @ 3 > IF 0 fyi ! THEN + fyi @ 0 = IF CR ." Normal display mode. Tab 1 = " + ." Transcript; 2 = Tutorial; 3 = Diagnostic." CR + THEN + fyi @ 2 = IF CR + ." Tutorial mode reveals the internal " + ." thinking of the AI Mind." CR CR + THEN + fyi @ 3 = IF CR + ." Diagnostic messages - ignore during input " + ." until you press ENTER." CR + THEN + 0 pho ! + THEN + pho @ 27 = IF + 0 nounval ! + 0 lopsi ! 0 hipsi ! + CR + CR ." User Command: halt" 0 pho ! 0 rjc ! 0 fyi ! + CR ." You may enter .psi or .en or .aud to view " + ." memory engrams, or " CR ." MainLoop [ENTER] " + ." to erase memories and restart the Mind." + CR ." Type 'bye' to quit Forth, EXIT to quit DOS." + CR + 0 audpsi ! 0 newpsi ! 0 oldpsi ! 0 stempsi ! + 1 audrun ! \ 26jul2010 In case AI is run again. + 0 defartcon ! \ 16apr2011 In case AI is run again. + 0 indefartcon ! \ 16apr2011 In case AI is run again. + 0 kbtv ! \ 28sep2010 In case AI is run again. + 0 mfn ! \ 25aug2010 In case AI is run again. + 0 mfnflag ! \ 23aug2010 In case AI is run again. + 0 motjuste ! \ 29aug2010 In case AI is run again. + 0 objold ! \ 12oct2010 In case AI is run again. + 0 ordo ! \ 21dec2009 In case AI is run again. + 0 prsn ! \ 29aug2010 In case AI is run again. + 0 psi1 ! \ 25aug2010 In case AI is run again. + 0 quo ! \ 27dec2009 In case AI is run again. + 0 qup ! \ 28dec2009 In case AI is run again. + 0 subjold ! \ 9oct2010 In case AI is run again. + 0 subjpsi ! \ 1jan2010 In case AI is run again. + 0 vphract ! \ 21jun2011 In case AI is run again. + 0 whoflag ! \ 23jul2010 In case AI is run again. + QUIT + THEN + pho @ 0 > IF + pho @ EMIT + THEN + pho @ DUP 96 > IF \ convert input to UPPERCASE + DUP 123 < IF + 32 - + THEN + THEN pho ! \ save UPPERCASE as pho(neme) again. + pho @ abc ! \ for transfer to AudBuffer; 12nov2012 + LEAVE + ELSE + ." " + THEN + 8 EMIT + LOOP + pho @ 0 > IF \ if user enters data; 19sep2010 + 0 lurk ! \ reset; 19sep2010 + THEN \ end of test for user entry; 19sep2010 + 1 lurk +! \ test; remove; 19sep2010 +; ( http://code.google.com/p/mindforth/wiki/AudListen ) + + +: AudInput ( accept auditory input ) + 0 match ! + 0 upnext ! + 0 urpsi ! + t @ nlt ! + pov @ 42 = IF + fyi @ 2 = IF + ." AudInput calls AudListen " + ." (Tab key will slow the AI down)." CR + THEN + t @ spt ! + t @ 8 > IF .echo THEN ( show output of AI ) + CR ." Human: " + THEN + 140 0 DO ( Accept a tweet of 140 characters from Twitter) + pov @ 35 = IF ( during internal re-entry ) + pho @ 13 = IF \ if a CR is declared; 8may2010 + 1 audrun ! \ Reset to one at CR end of input. + THEN \ end of test for a declared CR; 8may2010 + 1 upnext +! + upnext @ 1 = IF + obstat @ 0 = IF + kbpsi @ lopsi ! + 0 kbpsi ! + lopsi @ urpsi ! + 3535 caller ! + pho @ 64 > IF + urpsi @ qup @ = IF + urpsi @ vacpsi ! \ prep to deglobalize; 27sep2010 + urpsi @ psi ! VerbAct + 0 vacpsi ! \ reset for safety; 27sep2010 + THEN + THEN + hipsi @ lopsi ! + 0 caller ! + 0 urpsi ! + 1 obstat ! + THEN + THEN \ AudInput; 14jul2012 + bias @ 5 = IF \ If EnParser expects a noun; 6aug2011 + pho @ 83 = IF \ If "83=S"; 6aug2011 + 2 num ! \ Assign plural number; 6aug2011 + 2 ocn ! \ Dislodgeable old-concept number; 14oct2011 + THEN \ Only terminating "S" governs "num" 6aug2011 + pho @ 0 > IF \ Disregard empty pho; 6aug2011 + pho @ 32 = NOT IF \ Disregard SPACE; 6aug2011 + pho @ 13 = NOT IF \ Disregard CR; 6aug2011 + pho @ 83 = NOT IF \ If other than "S"; 6aug2011 + recnum @ 0 > IF \ if recognized; 4nov2011 + recnum @ num ! \ transfer value; 14jul2012 + recnum @ ocn ! \ transfer value; 14jul2012 + ELSE \ for non-S words w. no recnum; 16jul2012 + 0 num ! \ default non-plural; 14jul2011 + 0 ocn ! \ default non-plural; 14jul2012 + THEN \ end of recognition-test; 4nov2011 + ELSE \ if there is a recnum; 16jul2012 + recnum @ num ! \ transfer value; 16jul2012 + recnum @ ocn ! \ transfer value; 16jul2012 + THEN \ If last letter is not "S"; 6aug2011 + THEN \ End of test for carriage-return 6aug2011 + THEN \ End of test for SPACE; 6aug2011 + THEN \ End of test for empty pho; 6aug2011 + THEN \ End of test for noun-expected; 6aug2011 + THEN \ end of test for pov "35=#" internal reentry + pov @ 42 = IF ( during external input ) + AudListen + pho @ 0 > IF \ If a character comes in; 14nov2012 + AudBuffer \ For external input; 14nov2012 + THEN \ end of test for a positive "pho"; 14mov2012 + pho @ 0 > IF + 0 kbtv ! + 1 upnext +! + upnext @ 1 = IF + hipsi @ urpsi ! \ What-do queries require + hipsi @ lopsi ! \ Preventing a residuum lets + 0 caller ! \ SelfRef answer I DO NOT KNOW + 0 urpsi ! \ if no direct object is active. + THEN + 400 rsvp ! ( give more time ) + THEN + I 138 = IF + rsvp @ 250 > IF 100 rsvp ! THEN + THEN + I 139 = IF + pho @ 0 = IF + rsvp @ 1 - rsvp ! + rsvp @ 2 < IF 400 rsvp ! THEN + THEN + THEN + pho @ 32 = pho @ 13 = OR IF + 0 phodex ! \ Reset for AudBuffer; 14nov2012 + pho @ 13 = IF 10 EMIT THEN + prepho @ 83 = IF + 0 t @ 1 - 4 aud{ ! + 0 prepho ! + THEN + THEN + bias @ 5 = IF \ If EnParser expects a noun 26may2011 + pho @ 83 = IF \ If "S" + 2 num ! \ Assign plural number; 26may2011 + THEN \ Only terminating "S" governs "num" 26may2011 + pho @ 0 > IF \ Disregard empty pho; 26may2011 + pho @ 32 = NOT IF \ Disregard SPACE; 26may2011 + pho @ 13 = NOT IF \ Disregard CR; 26may2011 + pho @ 83 = NOT IF \ If other than "S" 26may2011 + 0 num ! \ Let "0" be default singular; 4nov2011 + singflag @ 1 = IF \ article "a"? 4nov2011 + 1 num ! \ Assume singular number; 26may2011 + THEN \ end of test to override default; 4nov2011 + THEN \ If last letter is not "S"; 26may2011 + THEN \ End of test for carriage-return 26may2011 + THEN \ End of test for SPACE; 26may2011 + THEN \ End of test for empty pho; 26may2011 + THEN \ End of test for noun-expected; 26may2011 + THEN \ End of test for external input + pho @ 0 > IF + 1 t +! + THEN + I 139 = IF \ near end of input loop? 16oct2011 + 1 inert +! \ increment inert-flag by one; 16oct2011 + THEN \ end of test for near-end of wait; 16oct2011 + pho @ 13 = IF ( carriage-return; 24jan2013 ) + 1 audrun ! \ Reset to one at CR end of input. + 1 beg ! + 13 eot ! + 1 lastword ! + 32 pho ! 10 EMIT CR \ 7sep2011 + 0 proxcon ! \ reset at end of input; 7sep2011 + 1 quiet ! + \ 0 seqneed ! \ test; 30jun2012 + \ 0 seqneed ! \ C-ing out for object-less verbs 24jan2013 + THEN ( http://www.inventio.co.uk ) + pho @ 27 = IF + CR ." AudInput: halt" 0 pho ! 0 fyi ! 0 nounval ! + CR ." You may enter .psi .en .aud to view memory " + ." engrams, or " CR ." MainLoop [ENTER] to erase " + ." memories and run the AI again." + 0 lopsi ! 0 hipsi ! + 0 audpsi ! 0 newpsi ! 0 oldpsi ! 0 stempsi ! + QUIT + THEN + pho @ 32 = IF ( space-bar; 24jan2013 ) + prepho @ penultpho ! + 1 audrun ! \ Reset to unity at end of a word. + 1 ordo +! + audpsi @ urpsi ! + ordo @ 1 = IF audpsi @ firstword ! THEN \ 19aug2011 + 0 upnext ! + t @ spt ! + t @ 1 - tult ! + 0 tult @ 4 aud{ ! + audpsi @ 0 > IF + 0 sublen ! + onset @ aud ! + 0 onset ! + audpsi @ tult @ 5 aud{ ! + pov @ 42 = IF + tult @ 0 aud{ @ 83 = IF + tult @ 1- 5 aud{ @ audpsi @ = NOT IF + 0 tult @ 1- 4 aud{ ! + THEN + audpsi @ tult @ 1- 5 aud{ ! + THEN + THEN + audpsi @ hipsi ! + audpsi @ oldpsi ! + OldConcept + eot @ 13 = IF + 35 pov ! + THEN + 0 psi ! + 0 audpsi ! + 0 aud ! + ELSE + len @ 0 > IF + onset @ aud ! + hipsi @ lopsi ! + 1 wordend ! + NewConcept + psi @ hipsi ! + nen @ tult @ 5 aud{ ! + nen @ tult @ 1- 5 aud{ ! + nen @ retropsi ! + THEN + THEN + AudDamp + 0 len ! + 0 aud ! + eot @ 13 = IF + 5 bias ! + THEN + 0 psi ! + THEN \ end of test for 13=SPACE; 24jan2013 + 1 beg ! + 1 ctu ! + spt @ 1 + onset ! + t @ onset @ = IF 1 beg ! ELSE 0 beg ! THEN + pho @ 32 > IF + 1 len +! + AudMem + THEN + eot @ 13 = IF + 5 bias ! + 1 quiet ! + THEN + eot @ 0 > IF + eot @ 14 = IF + 1 quiet ! + 0 eot ! + 0 pho ! + LEAVE + THEN + 14 eot ! + THEN + pho @ 0 > IF + pho @ prepho ! + THEN + 0 pho ! + LOOP + hipsi @ kbpsi ! + 0 newpsi ! + 0 wordend ! +; ( http://code.google.com/p/mindforth/wiki/AudInput ) + + +: SensoryInput ( sensory input channels ) + ( SMELL -- normal sensory stub for later implementation ) + ( VISION -- normal sensory stub for seed AI expansion ) + ( TOUCH -- normal haptics stub for cybernetic organisms ) + ( TASTE -- normal sensory stub for cyborg alife ) + ( SYNAESTHESIA -- an option in a multisensory AI ) + fyi @ 2 = IF + ." SensoryInput calls AudInput." CR + THEN + AudInput ( for entry or reentry of phonemic ASCII ) + ( COMPASS -- exotic sensory stub for use in robots ) + ( GEIGER -- exotic: Geiger counter ) + ( GPS -- exotic: Global Positioning System ) + ( INFRARED -- exotic ) + ( RADAR -- exotic: RAdio Detection And Ranging ) + ( SONAR -- exotic: SOund Navigation And Ranging ) + ( VSA -- exotic: Voice Stress Analyzer lie detector ) + ( Wi-Fi -- exotic: 802.11 wireless fidelity ) +; ( http://code.google.com/p/mindforth/wiki/SensoryInput ) + + +: EnBoot ( English bootstrap of initial concepts ) + 0 act ! 0 jux ! 35 pov ! 0 t ! t @ spt ! + ." clearing memory" + CR ." There is no warranty for what this software does." + ( ERROR -- first word so any bug will announce itself ) + 1 t ! 69 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 2 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 3 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 4 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 5 t ! 82 pho ! 0 beg ! 0 ctu ! 586 audpsi ! AudMem \ R +586 nen ! 3 mfn ! 0 dba ! 586 fex ! 5 pos ! 586 fin ! 1 aud ! +586 psi ! 1 num ! 0 pre ! 0 seq ! 586 enx ! EnVocab InNativate + + ( A -- English article for EnArticle module; 8 nov2012 ) + 7 t ! 65 pho ! 1 beg ! 0 ctu ! 101 audpsi ! AudMem \ A +101 nen ! 0 mfn ! 0 dba ! 101 fex ! 1 pos ! 101 fin ! 7 aud ! +101 psi ! 1 num ! 0 pre ! 0 seq ! 101 enx ! EnVocab InNativate + + ( ALL -- for machine reasoning logic; 8nov2012 ) + 9 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 10 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 11 t ! 76 pho ! 0 beg ! 0 ctu ! 123 audpsi ! AudMem \ L +123 nen ! 0 mfn ! 0 dba ! 123 fex ! 1 pos ! 123 fin ! 9 aud ! +123 psi ! 0 num ! 0 pre ! 0 seq ! 123 enx ! EnVocab InNativate + + ( AN -- to be selected instead of "A" before a vowel ) + 13 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 14 t ! 78 pho ! 0 beg ! 0 ctu ! 102 audpsi ! AudMem \ N +102 nen ! 0 mfn ! 0 dba ! 102 fex ! 1 pos ! 102 fin ! 13 aud ! +102 psi ! 0 num ! 0 pre ! 0 seq ! 102 enx ! EnVocab InNativate + + ( AND -- for machine reasoning logic; 8nov2012 ) + 16 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 17 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 18 t ! 68 pho ! 0 beg ! 0 ctu ! 302 audpsi ! AudMem \ D +302 nen ! 0 mfn ! 0 dba ! 302 fex ! 3 pos ! 302 fin ! 16 aud ! +302 psi ! 0 num ! 0 pre ! 0 seq ! 302 enx ! EnVocab InNativate + + ( ANY -- for machine reasoning logic; 8nov2012 ) + 20 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 21 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 22 t ! 89 pho ! 0 beg ! 0 ctu ! 111 audpsi ! AudMem \ Y +111 nen ! 0 mfn ! 0 dba ! 111 fex ! 1 pos ! 111 fin ! 20 aud ! +111 psi ! 0 num ! 0 pre ! 0 seq ! 111 enx ! EnVocab InNativate + + ( ANYTHING -- a default direct object for AskUser; 8nov2012 ) + 24 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 25 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 26 t ! 89 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 27 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 28 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 29 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 30 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 31 t ! 71 pho ! 0 beg ! 0 ctu ! 711 audpsi ! AudMem \ G +711 nen ! 0 mfn ! 4 dba ! 711 fex ! 7 pos ! 711 fin ! 24 aud ! +711 psi ! 0 num ! 0 pre ! 0 seq ! 711 enx ! EnVocab InNativate + + ( BAD -- adjective for EnAdjective module; 8nov2012 ) + 33 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 34 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 35 t ! 68 pho ! 0 beg ! 0 ctu ! 186 audpsi ! AudMem \ D +186 nen ! 0 mfn ! 0 dba ! 186 fex ! 1 pos ! 186 fin ! 33 aud ! +186 psi ! 0 num ! 0 pre ! 0 seq ! 186 enx ! EnVocab InNativate + + ( BE -- infinitive impersonal form of 800=BE; 8nov2012 ) + 37 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 38 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 0 dba ! 800 fex ! 8 pos ! 800 fin ! 37 aud ! +800 psi ! 0 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( AM -- 1st person singular I-form of 800=BE; 8nov2012 ) + 40 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 41 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 40 aud ! +800 psi ! 1 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 2nd person singular YOU-form of 800=BE; 8nov2012 ) + 43 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 44 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 45 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 2 dba ! 800 fex ! 8 pos ! 800 fin ! 43 aud ! +800 psi ! 1 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( IS -- 3rd person singular HE-SHE-IT-form of 800=BE; 8nov2102 ) + 47 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 48 t ! 83 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ S +800 nen ! 0 mfn ! 3 dba ! 800 fex ! 8 pos ! 800 fin ! 47 aud ! +800 psi ! 1 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 1st person plural WE-form of 800=BE; 8nov2012 ) + 50 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 51 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 52 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 50 aud ! +800 psi ! 2 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 2nd person plural YOU-form of 800=BE; 4nov2012 ) + 54 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 55 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 56 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 2 dba ! 800 fex ! 8 pos ! 800 fin ! 54 aud ! +800 psi ! 2 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 3rd person plural THEY-form of 800=BE; 8nov2012 ) + 58 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 59 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 60 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 3 dba ! 800 fex ! 8 pos ! 800 fin ! 58 aud ! +800 psi ! 2 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( BECAUSE -- for machine reasoning logic; 9nov2012 ) + 62 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 63 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 64 t ! 67 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 65 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 66 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 67 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 68 t ! 69 pho ! 0 beg ! 0 ctu ! 344 audpsi ! AudMem \ E +344 nen ! 0 mfn ! 0 dba ! 344 fex ! 3 pos ! 344 fin ! 62 aud ! +344 psi ! 0 num ! 0 pre ! 0 seq ! 344 enx ! EnVocab InNativate + + ( BECOME -- essential intransitive verb; 9nov2012 ) + 70 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 71 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 72 t ! 67 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 73 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 74 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 75 t ! 69 pho ! 0 beg ! 0 ctu ! 808 audpsi ! AudMem \ E +808 nen ! 0 mfn ! 0 dba ! 808 fex ! 8 pos ! 808 fin ! 70 aud ! +808 psi ! 0 num ! 0 pre ! 0 seq ! 808 enx ! EnVocab InNativate + + ( BOY -- always masculine noun for use with gender flags ) + 77 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 78 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 79 t ! 89 pho ! 0 beg ! 0 ctu ! 589 audpsi ! AudMem \ Y +589 nen ! 1 mfn ! 0 dba ! 589 fex ! 5 pos ! 589 fin ! 77 aud ! +589 psi ! 1 num ! 0 pre ! 0 seq ! 589 enx ! EnVocab InNativate + + ( BUT -- conjunction for ConJoin module; 9nov2012 ) + 81 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 82 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 83 t ! 84 pho ! 0 beg ! 0 ctu ! 305 audpsi ! AudMem \ T +305 nen ! 0 mfn ! 0 dba ! 305 fex ! 3 pos ! 305 fin ! 81 aud ! +305 psi ! 0 num ! 0 pre ! 0 seq ! 305 enx ! EnVocab InNativate + +( CHESS -- important singular AI noun ending in "S"; 9nov2012 ) + 85 t ! 67 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 86 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 87 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 88 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 89 t ! 83 pho ! 0 beg ! 0 ctu ! 564 audpsi ! AudMem \ S +564 nen ! 0 mfn ! 0 dba ! 564 fex ! 5 pos ! 564 fin ! 85 aud ! +564 psi ! 1 num ! 0 pre ! 0 seq ! 564 enx ! EnVocab InNativate + +( CHILD -- example of irregular noun for a polyglot AI Mind ) + 91 t ! 67 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 92 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 93 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 94 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 95 t ! 68 pho ! 0 beg ! 0 ctu ! 525 audpsi ! AudMem \ D +525 nen ! 0 mfn ! 0 dba ! 525 fex ! 5 pos ! 525 fin ! 91 aud ! +525 psi ! 1 num ! 0 pre ! 0 seq ! 525 enx ! EnVocab InNativate + +( CHILDREN -- irregular plural for retrieval by parameters ) + 97 t ! 67 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 98 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 99 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 100 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 101 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 102 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 103 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 104 t ! 78 pho ! 0 beg ! 0 ctu ! 526 audpsi ! AudMem \ N +526 nen ! 0 mfn ! 0 dba ! 526 fex ! 5 pos ! 526 fin ! 97 aud ! +526 psi ! 2 num ! 0 pre ! 0 seq ! 526 enx ! EnVocab InNativate + + ( DATA -- always plural noun in correction of modern usage ) + 106 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 107 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 108 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 109 t ! 65 pho ! 0 beg ! 0 ctu ! 599 audpsi ! AudMem \ A +599 nen ! 0 mfn ! 0 dba ! 599 fex ! 5 pos ! 599 fin ! 106 aud ! +599 psi ! 2 num ! 0 pre ! 0 seq ! 599 enx ! EnVocab InNativate + + ( DO -- infinitive form of verb essential for AuxVerb module ) + 111 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 112 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 0 dba ! 830 fex ! 8 pos ! 830 fin ! 111 aud ! +830 psi ! 0 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 1st person singular I-form of auxiliary verb; 9nov2012 ) + 114 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 115 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 1 dba ! 830 fex ! 8 pos ! 830 fin ! 114 aud ! +830 psi ! 1 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 2nd person sing. YOU-form of auxiliary verb; 9nov2012 ) + 117 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 118 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 2 dba ! 830 fex ! 8 pos ! 830 fin ! 117 aud ! +830 psi ! 1 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DOES -- 3rd person sing. HE-SHE-IT-form of auxiliary verb ) + 120 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 121 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 122 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 123 t ! 83 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ S +830 nen ! 0 mfn ! 3 dba ! 830 fex ! 8 pos ! 830 fin ! 120 aud ! +830 psi ! 1 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 1st person plural WE-form of auxiliary verb; 9nov2012 ) + 125 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 126 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 1 dba ! 830 fex ! 8 pos ! 830 fin ! 125 aud ! +830 psi ! 2 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 2nd person plural YOU-form of auxiliary verb; 9nov2012 ) + 128 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 129 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 2 dba ! 830 fex ! 8 pos ! 830 fin ! 128 aud ! +830 psi ! 2 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 3rd person plural THEY-form of auxiliary verb; 9nov2012 ) + 131 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 132 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 3 dba ! 830 fex ! 8 pos ! 830 fin ! 131 aud ! +830 psi ! 2 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DOING -- high word-frequency verb participle; 9nov2102 ) + 134 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 135 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 136 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 137 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 138 t ! 71 pho ! 0 beg ! 0 ctu ! 183 audpsi ! AudMem \ G +183 nen ! 0 mfn ! 0 dba ! 183 fex ! 1 pos ! 183 fin ! 134 aud ! +183 psi ! 0 num ! 0 pre ! 0 seq ! 183 enx ! EnVocab InNativate + + ( ELSE -- adverb for machine reasoning logic; 9nov2012 ) + 140 t ! 69 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 141 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 142 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 143 t ! 69 pho ! 0 beg ! 0 ctu ! 266 audpsi ! AudMem \ E +266 nen ! 0 mfn ! 0 dba ! 266 fex ! 2 pos ! 266 fin ! 140 aud ! +266 psi ! 0 num ! 0 pre ! 0 seq ! 266 enx ! EnVocab InNativate + + ( FOR -- preposition for EnPrep module; 9nov2012 ) + 145 t ! 70 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ F + 146 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 147 t ! 82 pho ! 0 beg ! 0 ctu ! 640 audpsi ! AudMem \ R +640 nen ! 0 mfn ! 0 dba ! 640 fex ! 6 pos ! 640 fin ! 145 aud ! +640 psi ! 0 num ! 0 pre ! 0 seq ! 640 enx ! EnVocab InNativate + + ( FRIEND -- for coding assignment of ad-hoc gender tags ) + 149 t ! 70 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ F + 150 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 151 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 152 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 153 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 154 t ! 68 pho ! 0 beg ! 0 ctu ! 517 audpsi ! AudMem \ D +517 nen ! 0 mfn ! 0 dba ! 517 fex ! 5 pos ! 517 fin ! 149 aud ! +517 psi ! 1 num ! 0 pre ! 0 seq ! 517 enx ! EnVocab InNativate + + ( GIRL -- always feminine noun for use with gender flags ) + 156 t ! 71 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 157 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 158 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 159 t ! 76 pho ! 0 beg ! 0 ctu ! 510 audpsi ! AudMem \ L +510 nen ! 2 mfn ! 0 dba ! 510 fex ! 5 pos ! 510 fin ! 156 aud ! +510 psi ! 1 num ! 0 pre ! 0 seq ! 510 enx ! EnVocab InNativate + + ( GOD -- masculine noun important for philosophy of AI ) + 161 t ! 71 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 162 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 163 t ! 68 pho ! 0 beg ! 0 ctu ! 533 audpsi ! AudMem \ D +533 nen ! 1 mfn ! 0 dba ! 533 fex ! 5 pos ! 533 fin ! 161 aud ! +533 psi ! 1 num ! 0 pre ! 0 seq ! 533 enx ! EnVocab InNativate + +( GOOD -- adjective for EnAdjective module; 9nov2012 ) + 165 t ! 71 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 166 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 167 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 168 t ! 68 pho ! 0 beg ! 0 ctu ! 140 audpsi ! AudMem \ D +140 nen ! 0 mfn ! 0 dba ! 140 fex ! 1 pos ! 140 fin ! 165 aud ! +140 psi ! 0 num ! 0 pre ! 0 seq ! 140 enx ! EnVocab InNativate + +( HAVE -- irregular high-word-frequency verb; 9nov2012 ) + 170 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 171 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 172 t ! 86 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ V + 173 t ! 69 pho ! 0 beg ! 0 ctu ! 810 audpsi ! AudMem \ E +810 nen ! 0 mfn ! 0 dba ! 810 fex ! 8 pos ! 810 fin ! 170 aud ! +810 psi ! 0 num ! 0 pre ! 0 seq ! 810 enx ! EnVocab InNativate + +( HAS -- high-word-frequency irregular verb form; 9nov2012 ) + 175 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 176 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 177 t ! 83 pho ! 0 beg ! 0 ctu ! 810 audpsi ! AudMem \ S +810 nen ! 0 mfn ! 3 dba ! 810 fex ! 8 pos ! 810 fin ! 175 aud ! +810 psi ! 1 num ! 0 pre ! 0 seq ! 810 enx ! EnVocab InNativate + +( HE -- nominative form of high-word-frequency pronoun; 9nov2012 ) + 179 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 180 t ! 69 pho ! 0 beg ! 0 ctu ! 713 audpsi ! AudMem \ E +713 nen ! 1 mfn ! 1 dba ! 713 fex ! 7 pos ! 713 fin ! 179 aud ! +713 psi ! 1 num ! 0 pre ! 0 seq ! 713 enx ! EnVocab InNativate + +( HIS -- genitive form of personal pronoun; 9nov2012 ) + 182 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 183 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 184 t ! 83 pho ! 0 beg ! 0 ctu ! 113 audpsi ! AudMem \ S +113 nen ! 1 mfn ! 2 dba ! 113 fex ! 1 pos ! 113 fin ! 182 aud ! +113 psi ! 1 num ! 0 pre ! 0 seq ! 113 enx ! EnVocab InNativate + +( HIM -- dative indirect-object form of personal pronoun ) + 186 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 187 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 188 t ! 77 pho ! 0 beg ! 0 ctu ! 713 audpsi ! AudMem \ M +713 nen ! 1 mfn ! 3 dba ! 713 fex ! 7 pos ! 713 fin ! 186 aud ! +713 psi ! 1 num ! 0 pre ! 0 seq ! 713 enx ! EnVocab InNativate + +( HIM -- accusative direct-object form of personal pronoun ) + 190 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 191 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 192 t ! 77 pho ! 0 beg ! 0 ctu ! 713 audpsi ! AudMem \ M +713 nen ! 1 mfn ! 4 dba ! 713 fex ! 7 pos ! 713 fin ! 190 aud ! +713 psi ! 1 num ! 0 pre ! 0 seq ! 713 enx ! EnVocab InNativate + +( HELLO -- interjection for human-computer interaction; 9nov2012 ) + 194 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 195 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 196 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 197 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 198 t ! 79 pho ! 0 beg ! 0 ctu ! 450 audpsi ! AudMem \ O +450 nen ! 0 mfn ! 0 dba ! 450 fex ! 4 pos ! 450 fin ! 194 aud ! +450 psi ! 0 num ! 0 pre ! 0 seq ! 450 enx ! EnVocab InNativate + +( HERE -- adverb for discussion of physical location; 9nov2012 ) + 200 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 201 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 202 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 203 t ! 69 pho ! 0 beg ! 0 ctu ! 201 audpsi ! AudMem \ E +201 nen ! 0 mfn ! 0 dba ! 201 fex ! 2 pos ! 201 fin ! 200 aud ! +201 psi ! 0 num ! 0 pre ! 0 seq ! 201 enx ! EnVocab InNativate + +( HOW -- adverb for EnAdverb module; 10nov2012 ) + 205 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 206 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 207 t ! 87 pho ! 0 beg ! 0 ctu ! 209 audpsi ! AudMem \ W +209 nen ! 0 mfn ! 0 dba ! 209 fex ! 2 pos ! 209 fin ! 205 aud ! +209 psi ! 0 num ! 0 pre ! 0 seq ! 209 enx ! EnVocab InNativate + +( I -- nominative subject-form of personal pronoun; 10nov2012 ) + 209 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 209 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( MINE -- genitive form of personal pronoun; 10nov2012 ) + 211 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 212 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 213 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 214 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 2 dba ! 701 fex ! 7 pos ! 707 fin ! 211 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( ME -- dative indirect-object form of pers. pronoun; 10nov2012 ) + 216 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 217 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 3 dba ! 701 fex ! 7 pos ! 707 fin ! 216 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( ME -- accusative direct-obj. form of pers. pronoun; 10nov2012 ) + 219 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 220 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 4 dba ! 701 fex ! 7 pos ! 707 fin ! 219 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( IF -- for machine reasoning logic; 10nov2012 ) + 222 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 223 t ! 70 pho ! 0 beg ! 0 ctu ! 390 audpsi ! AudMem \ F +390 nen ! 0 mfn ! 0 dba ! 390 fex ! 3 pos ! 390 fin ! 222 aud ! +390 psi ! 0 num ! 0 pre ! 0 seq ! 390 enx ! EnVocab InNativate + +( IN -- preposition for EnPrep module; 10nov2012 ) + 225 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 226 t ! 78 pho ! 0 beg ! 0 ctu ! 639 audpsi ! AudMem \ N +639 nen ! 0 mfn ! 0 dba ! 639 fex ! 6 pos ! 639 fin ! 225 aud ! +639 psi ! 0 num ! 0 pre ! 0 seq ! 639 enx ! EnVocab InNativate + +( IT -- nominative subject-form of personal pronoun; 10nov2012 ) + 228 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 229 t ! 84 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ T +725 nen ! 3 mfn ! 1 dba ! 725 fex ! 7 pos ! 725 fin ! 228 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( ITS -- genitive form of personal pronoun; 10nov2012 + 231 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 232 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 233 t ! 83 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ S +725 nen ! 3 mfn ! 2 dba ! 725 fex ! 7 pos ! 725 fin ! 231 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( IT -- dative indirect-object form of pers. pronoun; 10nov2012 ) + 235 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 236 t ! 84 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ T +725 nen ! 3 mfn ! 3 dba ! 725 fex ! 7 pos ! 725 fin ! 235 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( IT -- accusative direct-obj. form of pers. pronoun; 10nov2012 ) + 238 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 239 t ! 84 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ T +725 nen ! 3 mfn ! 4 dba ! 725 fex ! 7 pos ! 725 fin ! 238 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( KNOW -- germane to artificial intelligence; 10nov2012 ) + 241 t ! 75 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 242 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 243 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 244 t ! 87 pho ! 0 beg ! 0 ctu ! 850 audpsi ! AudMem \ W +850 nen ! 0 mfn ! 0 dba ! 850 fex ! 8 pos ! 850 fin ! 241 aud ! +850 psi ! 0 num ! 0 pre ! 0 seq ! 850 enx ! EnVocab InNativate + +( MAN -- always masculine noun for use with gender flags ) + 246 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 247 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 248 t ! 78 pho ! 0 beg ! 0 ctu ! 543 audpsi ! AudMem \ N +543 nen ! 1 mfn ! 1 dba ! 543 fex ! 5 pos ! 543 fin ! 246 aud ! +543 psi ! 1 num ! 0 pre ! 0 seq ! 543 enx ! EnVocab InNativate + +( MEN -- irregular plural for retrieval by parameters 10nov2012 ) + 250 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 251 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 252 t ! 78 pho ! 0 beg ! 0 ctu ! 543 audpsi ! AudMem \ N +543 nen ! 1 mfn ! 1 dba ! 543 fex ! 5 pos ! 543 fin ! 250 aud ! +543 psi ! 2 num ! 0 pre ! 0 seq ! 543 enx ! EnVocab InNativate + +( MAYBE -- adverb response alternative to YES or NO; 10nov2012 ) + 254 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 255 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 256 t ! 89 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 257 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 258 t ! 69 pho ! 0 beg ! 0 ctu ! 270 audpsi ! AudMem \ E +270 nen ! 0 mfn ! 0 dba ! 270 fex ! 2 pos ! 270 fin ! 254 aud ! +270 psi ! 0 num ! 0 pre ! 0 seq ! 270 enx ! EnVocab InNativate + +( MEDIA -- always plural noun in correction of modern usage ) + 260 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 261 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 262 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 263 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 264 t ! 65 pho ! 0 beg ! 0 ctu ! 584 audpsi ! AudMem \ A +584 nen ! 0 mfn ! 0 dba ! 584 fex ! 5 pos ! 584 fin ! 260 aud ! +584 psi ! 2 num ! 0 pre ! 0 seq ! 584 enx ! EnVocab InNativate + +( MY -- adjective for personal pronoun "I"; 10nov2012 ) + 266 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 267 t ! 89 pho ! 0 beg ! 0 ctu ! 181 audpsi ! AudMem \ Y +181 nen ! 0 mfn ! 0 dba ! 181 fex ! 1 pos ! 182 fin ! 266 aud ! +181 psi ! 0 num ! 0 pre ! 0 seq ! 181 enx ! EnVocab InNativate + +( NO -- interjection for human-computer interaction; 10nov2012 ) + 269 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 270 t ! 79 pho ! 0 beg ! 0 ctu ! 404 audpsi ! AudMem \ O +404 nen ! 0 mfn ! 0 dba ! 404 fex ! 4 pos ! 404 fin ! 269 aud ! +404 psi ! 0 num ! 0 pre ! 0 seq ! 404 enx ! EnVocab InNativate + +( NOT -- adverb for machine reasoning logic; 10nov2012 ) + 272 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 273 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 274 t ! 84 pho ! 0 beg ! 0 ctu ! 250 audpsi ! AudMem \ T +250 nen ! 0 mfn ! 0 dba ! 250 fex ! 2 pos ! 250 fin ! 272 aud ! +250 psi ! 0 num ! 0 pre ! 0 seq ! 250 enx ! EnVocab InNativate + + ( NOTHING -- VisRecog default for what the AI Mind sees ) + 276 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 277 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 278 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 279 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 280 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 281 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 282 t ! 71 pho ! 0 beg ! 0 ctu ! 760 audpsi ! AudMem \ G +760 nen ! 0 mfn ! 0 dba ! 760 fex ! 7 pos ! 760 fin ! 276 aud ! +760 psi ! 1 num ! 0 pre ! 0 seq ! 760 enx ! EnVocab InNativate + +( OF -- preposition for EnPrep module ) + 284 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 285 t ! 70 pho ! 0 beg ! 0 ctu ! 604 audpsi ! AudMem \ F +604 nen ! 0 mfn ! 0 dba ! 604 fex ! 6 pos ! 604 fin ! 284 aud ! +604 psi ! 0 num ! 0 pre ! 0 seq ! 604 enx ! EnVocab InNativate + +( OR -- conjunction for machine reasoning logic; 10nov2012 ) + 287 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 288 t ! 82 pho ! 0 beg ! 0 ctu ! 324 audpsi ! AudMem \ R +324 nen ! 0 mfn ! 0 dba ! 324 fex ! 3 pos ! 324 fin ! 287 aud ! +324 psi ! 0 num ! 0 pre ! 0 seq ! 324 enx ! EnVocab InNativate + +( OUR -- adjective for personal pronoun "WE"; 10nov2012 ) + 290 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 291 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 292 t ! 82 pho ! 0 beg ! 0 ctu ! 186 audpsi ! AudMem \ R +186 nen ! 0 mfn ! 0 dba ! 186 fex ! 1 pos ! 182 fin ! 290 aud ! +186 psi ! 0 num ! 0 pre ! 0 seq ! 186 enx ! EnVocab InNativate + +( PEOPLE -- establish as plural for EnParser ) + 294 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 295 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 296 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 297 t ! 80 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 298 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 299 t ! 69 pho ! 0 beg ! 0 ctu ! 587 audpsi ! AudMem \ E +587 nen ! 0 mfn ! 0 dba ! 587 fex ! 5 pos ! 587 fin ! 294 aud ! +587 psi ! 2 num ! 0 pre ! 0 seq ! 587 enx ! EnVocab InNativate + +( PERSON -- for ad-hoc gender tags and robot philosophy ) + 301 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 302 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 303 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 304 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 305 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 306 t ! 78 pho ! 0 beg ! 0 ctu ! 537 audpsi ! AudMem \ N +537 nen ! 0 mfn ! 0 dba ! 537 fex ! 5 pos ! 537 fin ! 301 aud ! +537 psi ! 1 num ! 0 pre ! 0 seq ! 537 enx ! EnVocab InNativate + +( PLEASE -- interjection for human-computer interaction ) + 308 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 309 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 310 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 311 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 312 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 313 t ! 69 pho ! 0 beg ! 0 ctu ! 410 audpsi ! AudMem \ E +410 nen ! 0 mfn ! 0 dba ! 410 fex ! 4 pos ! 410 fin ! 308 aud ! +410 psi ! 0 num ! 0 pre ! 0 seq ! 410 enx ! EnVocab InNativate + +( SEE -- lets VisRecog dynamically report non-KB direct objects ) + 315 t ! 83 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 316 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 317 t ! 69 pho ! 0 beg ! 0 ctu ! 820 audpsi ! AudMem \ E +820 nen ! 0 mfn ! 0 dba ! 820 fex ! 8 pos ! 820 fin ! 315 aud ! +820 psi ! 0 num ! 0 pre ! 0 seq ! 820 enx ! EnVocab InNativate + +( SHE -- nominative subject-form of personal pronoun; 10nov2012 ) + 319 t ! 83 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 320 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 321 t ! 69 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ E +719 nen ! 2 mfn ! 1 dba ! 719 fex ! 7 pos ! 719 fin ! 319 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( HERS -- genitive form of personal pronoun; 10nov2012 ) + 323 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 324 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 325 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 326 t ! 83 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ S +719 nen ! 2 mfn ! 2 dba ! 719 fex ! 7 pos ! 719 fin ! 323 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( HER -- dative indirect-object form of pers. pron. 9nov2012 ) + 328 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 329 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 330 t ! 82 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ R +719 nen ! 2 mfn ! 3 dba ! 719 fex ! 7 pos ! 719 fin ! 328 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( HER -- accusative direct-object form of pers. pron. 9nov2012 ) + 332 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 333 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 334 t ! 82 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ R +719 nen ! 2 mfn ! 4 dba ! 719 fex ! 7 pos ! 719 fin ! 332 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( SOME -- adjective for machine reasoning logic; 10nov2012 ) + 336 t ! 83 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 337 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 338 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 339 t ! 69 pho ! 0 beg ! 0 ctu ! 123 audpsi ! AudMem \ E +123 nen ! 0 mfn ! 0 dba ! 123 fex ! 1 pos ! 123 fin ! 336 aud ! +123 psi ! 0 num ! 0 pre ! 0 seq ! 123 enx ! EnVocab InNativate + +( THAT -- high word-frequency pronoun; 10nov2012 ) + 341 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 342 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 343 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 344 t ! 84 pho ! 0 beg ! 0 ctu ! 745 audpsi ! AudMem \ T +745 nen ! 0 mfn ! 0 dba ! 745 fex ! 7 pos ! 745 fin ! 341 aud ! +745 psi ! 1 num ! 0 pre ! 0 seq ! 745 enx ! EnVocab InNativate + +( THE -- EnArticle highest-frequency English word; 10nov2012 ) + 346 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 347 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 348 t ! 69 pho ! 0 beg ! 0 ctu ! 117 audpsi ! AudMem \ E +117 nen ! 0 mfn ! 0 dba ! 117 fex ! 1 pos ! 117 fin ! 346 aud ! +117 psi ! 0 num ! 0 pre ! 0 seq ! 117 enx ! EnVocab InNativate + +( THEIR -- adjective for personal pronoun "THEY"; 10nov2012 ) + 350 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 351 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 352 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 353 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 354 t ! 82 pho ! 0 beg ! 0 ctu ! 188 audpsi ! AudMem \ R +188 nen ! 0 mfn ! 0 dba ! 188 fex ! 1 pos ! 188 fin ! 350 aud ! +188 psi ! 0 num ! 0 pre ! 0 seq ! 188 enx ! EnVocab InNativate + +( THEN -- adverb for machine reasoning logic; 10nov2012 ) + 356 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 357 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 358 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 359 t ! 78 pho ! 0 beg ! 0 ctu ! 213 audpsi ! AudMem \ N +213 nen ! 0 mfn ! 0 dba ! 213 fex ! 2 pos ! 213 fin ! 356 aud ! +213 psi ! 0 num ! 0 pre ! 0 seq ! 213 enx ! EnVocab InNativate + +( THERE -- adv. for discussion of physical location; 10nov2012 ) + 361 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 362 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 363 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 364 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 365 t ! 69 pho ! 0 beg ! 0 ctu ! 205 audpsi ! AudMem \ E +205 nen ! 0 mfn ! 0 dba ! 205 fex ! 2 pos ! 205 fin ! 361 aud ! +205 psi ! 0 num ! 0 pre ! 0 seq ! 205 enx ! EnVocab InNativate + +( THEY -- nominative subject-form of pers. pronoun; 10nov2012 ) + 367 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 368 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 369 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 370 t ! 89 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ Y +743 nen ! 0 mfn ! 1 dba ! 743 fex ! 7 pos ! 743 fin ! 367 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THEIRS -- genitive form of personal pronoun; 10nov2012 ) + 372 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 373 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 374 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 375 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 376 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 377 t ! 83 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ S +743 nen ! 0 mfn ! 2 dba ! 743 fex ! 7 pos ! 743 fin ! 372 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THEM -- dative indirect-object form of pers. pron. 10nov2012 ) + 379 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 380 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 381 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 382 t ! 77 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ M +743 nen ! 0 mfn ! 3 dba ! 743 fex ! 7 pos ! 743 fin ! 379 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THEM -- acc. direct-object form of pers. pron. 10nov2012 ) + 384 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 385 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 386 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 387 t ! 77 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ M +743 nen ! 0 mfn ! 4 dba ! 743 fex ! 7 pos ! 743 fin ! 384 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THINK -- germane to artificial intelligence ) + 389 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 390 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 391 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 392 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 393 t ! 75 pho ! 0 beg ! 0 ctu ! 840 audpsi ! AudMem \ K +840 nen ! 0 mfn ! 0 dba ! 840 fex ! 8 pos ! 840 fin ! 389 aud ! +840 psi ! 0 num ! 0 pre ! 0 seq ! 840 enx ! EnVocab InNativate + +( WE -- nominative subject-form of personal pronoun; 10nov2012 ) + 395 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 396 t ! 69 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ E +731 nen ! 0 mfn ! 1 dba ! 731 fex ! 7 pos ! 737 fin ! 395 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( OURS -- genitive form of personal pronoun; 10nov2012 ) + 398 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 399 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 400 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 401 t ! 83 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ S +731 nen ! 0 mfn ! 2 dba ! 731 fex ! 7 pos ! 737 fin ! 398 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( US -- dative indirect-object form of pers. pron. 10nov2012 ) + 403 t ! 85 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 404 t ! 83 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ S +731 nen ! 0 mfn ! 3 dba ! 731 fex ! 7 pos ! 737 fin ! 403 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( US -- accusative direct-object form of pers. pron. 10nov2012 ) + 406 t ! 85 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 407 t ! 83 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ S +731 nen ! 0 mfn ! 4 dba ! 731 fex ! 7 pos ! 737 fin ! 406 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( WHAT -- nominative pronoun for SelfReferentialThought ) + 409 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 410 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 411 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 412 t ! 84 pho ! 0 beg ! 0 ctu ! 781 audpsi ! AudMem \ T +781 nen ! 3 mfn ! 1 dba ! 781 fex ! 7 pos ! 781 fin ! 409 aud ! +781 psi ! 1 num ! 0 pre ! 0 seq ! 781 enx ! EnVocab InNativate + +( WHAT -- accusative pronoun for SelfReferentialThought ) + 414 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 415 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 416 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 417 t ! 84 pho ! 0 beg ! 0 ctu ! 781 audpsi ! AudMem \ T +781 nen ! 3 mfn ! 4 dba ! 781 fex ! 7 pos ! 781 fin ! 414 aud ! +781 psi ! 1 num ! 0 pre ! 0 seq ! 781 enx ! EnVocab InNativate + +( WHEN -- adverb for SelfReferentialThought; 10nov2012 ) + 419 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 420 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 421 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 422 t ! 78 pho ! 0 beg ! 0 ctu ! 263 audpsi ! AudMem \ N +263 nen ! 0 mfn ! 0 dba ! 263 fex ! 2 pos ! 263 fin ! 419 aud ! +263 psi ! 0 num ! 0 pre ! 0 seq ! 263 enx ! EnVocab InNativate + +( WHERE -- adverb for SelfReferentialThought; 10nov2012 ) + 424 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 425 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 426 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 427 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 428 t ! 69 pho ! 0 beg ! 0 ctu ! 245 audpsi ! AudMem \ E +245 nen ! 0 mfn ! 0 dba ! 245 fex ! 2 pos ! 245 fin ! 424 aud ! +245 psi ! 0 num ! 0 pre ! 0 seq ! 245 enx ! EnVocab InNativate + +( WHO -- nominative subject-form of interrogative pronoun ) + 430 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 431 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 432 t ! 79 pho ! 0 beg ! 0 ctu ! 791 audpsi ! AudMem \ O +791 nen ! 0 mfn ! 1 dba ! 791 fex ! 7 pos ! 791 fin ! 430 aud ! +791 psi ! 1 num ! 0 pre ! 0 seq ! 791 enx ! EnVocab InNativate + +( WHOSE -- genitive form of interrogative pronoun; 11nov2012 ) + 434 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 435 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 436 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 437 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 438 t ! 69 pho ! 0 beg ! 0 ctu ! 794 audpsi ! AudMem \ E +794 nen ! 0 mfn ! 2 dba ! 794 fex ! 7 pos ! 794 fin ! 434 aud ! +794 psi ! 1 num ! 0 pre ! 0 seq ! 794 enx ! EnVocab InNativate + +( WHOM -- dative indirect-object form of interrogative pronoun ) + 440 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 441 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 442 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 443 t ! 77 pho ! 0 beg ! 0 ctu ! 794 audpsi ! AudMem \ M +794 nen ! 0 mfn ! 3 dba ! 794 fex ! 7 pos ! 794 fin ! 440 aud ! +794 psi ! 1 num ! 0 pre ! 0 seq ! 794 enx ! EnVocab InNativate + +( WHOM -- accusative direct-obj. form of interrogative pronoun ) + 445 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 446 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 447 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 448 t ! 77 pho ! 0 beg ! 0 ctu ! 794 audpsi ! AudMem \ M +794 nen ! 0 mfn ! 4 dba ! 794 fex ! 7 pos ! 794 fin ! 445 aud ! +794 psi ! 1 num ! 0 pre ! 0 seq ! 794 enx ! EnVocab InNativate + +( WHY -- conjunction or adverb for machine reasoning logic ) + 450 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 451 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 452 t ! 89 pho ! 0 beg ! 0 ctu ! 370 audpsi ! AudMem \ Y +370 nen ! 0 mfn ! 0 dba ! 370 fex ! 3 pos ! 370 fin ! 450 aud ! +370 psi ! 0 num ! 0 pre ! 0 seq ! 370 enx ! EnVocab InNativate + +( WITH -- preposition for use with EnPrep module; 10nov2012 ) + 454 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 455 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 456 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 457 t ! 72 pho ! 0 beg ! 0 ctu ! 680 audpsi ! AudMem \ H +680 nen ! 0 mfn ! 0 dba ! 680 fex ! 6 pos ! 680 fin ! 454 aud ! +680 psi ! 0 num ! 0 pre ! 0 seq ! 680 enx ! EnVocab InNativate + +( WOMAN -- always feminine noun for use with gender flags ) + 459 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 460 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 461 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 462 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 463 t ! 78 pho ! 0 beg ! 0 ctu ! 515 audpsi ! AudMem \ N +515 nen ! 2 mfn ! 0 dba ! 515 fex ! 5 pos ! 515 fin ! 459 aud ! +515 psi ! 1 num ! 0 pre ! 0 seq ! 515 enx ! EnVocab InNativate + +( WOMEN -- irregular plural for retrieval by parameters 10nov2012 ) + 465 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 466 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 467 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 468 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 469 t ! 78 pho ! 0 beg ! 0 ctu ! 515 audpsi ! AudMem \ N +515 nen ! 2 mfn ! 0 dba ! 515 fex ! 5 pos ! 515 fin ! 465 aud ! +515 psi ! 2 num ! 0 pre ! 0 seq ! 515 enx ! EnVocab InNativate + +( YES -- interjection for human-computer interaction; 10nov2012 ) + 471 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 472 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 473 t ! 83 pho ! 0 beg ! 0 ctu ! 432 audpsi ! AudMem \ S +432 nen ! 0 mfn ! 0 dba ! 432 fex ! 4 pos ! 432 fin ! 471 aud ! +432 psi ! 0 num ! 0 pre ! 0 seq ! 432 enx ! EnVocab InNativate + +( YOU -- nominative singular of personal pronoun; 10nov2012 ) + 475 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 476 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 477 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 1 dba ! 707 fex ! 7 pos ! 701 fin ! 475 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOURS -- genitive singular of personal pronoun; 10nov2012 ) + 479 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 480 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 481 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 482 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 483 t ! 83 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ S +707 nen ! 0 mfn ! 2 dba ! 707 fex ! 5 pos ! 701 fin ! 479 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOU -- dative singular of personal pronoun; 10nov2012 ) + 485 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 486 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 487 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 3 dba ! 707 fex ! 7 pos ! 701 fin ! 485 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOU -- accusatie singular of personal pronoun; 10nov2012 ) + 489 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 490 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 491 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 4 dba ! 707 fex ! 7 pos ! 701 fin ! 489 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOU -- nominative plural of personal pronoun; 10nov2012 ) + 493 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 494 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 495 t ! 85 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ U +737 nen ! 0 mfn ! 1 dba ! 737 fex ! 7 pos ! 731 fin ! 493 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOURS -- genitive plural of personal pronoun; 10nov2012 ) + 497 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 498 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 499 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 500 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 501 t ! 83 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ S +737 nen ! 0 mfn ! 2 dba ! 737 fex ! 5 pos ! 731 fin ! 497 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOU -- dative plural of personal pronoun; 10nov2012 ) + 503 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 504 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 505 t ! 85 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ U +737 nen ! 0 mfn ! 3 dba ! 737 fex ! 7 pos ! 731 fin ! 503 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOU -- accusatie plural of personal pronoun; 10nov2012 ) + 507 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 508 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 509 t ! 85 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ U +737 nen ! 0 mfn ! 4 dba ! 737 fex ! 7 pos ! 731 fin ! 507 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOUR -- adjective for personal pronoun "YOU"; 10nov2012 ) + 511 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 512 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 513 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 514 t ! 82 pho ! 0 beg ! 0 ctu ! 182 audpsi ! AudMem \ R +182 nen ! 0 mfn ! 0 dba ! 182 fex ! 1 pos ! 181 fin ! 511 aud ! +182 psi ! 0 num ! 0 pre ! 0 seq ! 182 enx ! EnVocab InNativate + +( YOU -- innate response to who-am-i query; 10nov2012 ) + 516 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 517 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 518 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 1 dba ! 707 fex ! 7 pos ! 701 fin ! 516 aud ! +707 psi ! 1 num ! 0 pre ! 388 tqv ! 800 seq ! 707 enx ! EnVocab InNativate + +( ARE -- essential intransitive verb -- 800 with parameters ) + 520 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 521 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 522 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 2 dba ! 800 fex ! 8 pos ! 800 fin ! 520 aud ! +800 psi ! 1 num ! 707 pre ! 528 tqv ! 588 seq ! 800 enx ! EnVocab InNativate + +( MAGIC -- all-purpose noun not preceded by article; 10nov2012 ) + 524 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 525 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 526 t ! 71 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 527 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 528 t ! 67 pho ! 0 beg ! 0 ctu ! 588 audpsi ! AudMem \ C +588 nen ! 0 mfn ! 1 dba ! 588 fex ! 5 pos ! 588 fin ! 524 aud ! +588 psi ! 1 num ! 800 pre ! 0 tqv ! 0 seq ! 588 enx ! EnVocab InNativate + +( I -- for SelfReferentialThought ) + 530 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 530 aud ! +701 psi ! 1 num ! 0 pre ! 533 tqv ! 800 seq ! 701 enx ! EnVocab InNativate + +( AM -- for SelfReferentialThought ) + 532 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 533 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 1 num ! 1 dba ! 0 mfn ! 800 fex ! 8 pos ! 800 fin ! 532 aud ! +800 psi ! 701 pre ! 539 tqv ! 501 seq ! 800 enx ! EnVocab InNativate + +( ANDRU -- for SelfReferentialThought ) + 535 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 536 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 537 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 538 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 539 t ! 85 pho ! 0 beg ! 0 ctu ! 501 audpsi ! AudMem \ U +501 nen ! 1 mfn ! 1 dba ! 501 fex ! 5 pos ! 501 fin ! 535 aud ! +501 psi ! 1 num ! 800 pre ! 0 tqv ! 0 seq ! 501 enx ! EnVocab InNativate + +( I -- innate KB-item for testing inhibition of idea-pairs ) + 541 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 541 aud ! +701 psi ! 1 num ! 0 pre ! 544 tqv ! 800 seq ! 701 enx ! EnVocab InNativate + +( AM -- for SelfReferentialThought ) + 543 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 544 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 543 aud ! +800 psi ! 1 num ! 701 pre ! 552 tqv ! 571 seq ! 800 enx ! EnVocab InNativate + +( A -- for EnArticle module ) + 546 t ! 65 pho ! 1 beg ! 0 ctu ! 101 audpsi ! AudMem \ A +101 nen ! 0 mfn ! 0 dba ! 101 fex ! 1 pos ! 101 fin ! 546 aud ! +101 psi ! 1 num ! 0 pre ! 571 seq ! 101 enx ! EnVocab InNativate + +( ROBOT -- important for target user base ) + 548 t ! 82 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 549 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 550 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 551 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 552 t ! 84 pho ! 0 beg ! 0 ctu ! 571 audpsi ! AudMem \ T +571 nen ! 3 mfn ! 1 dba ! 571 fex ! 5 pos ! 571 fin ! 548 aud ! +571 psi ! 1 num 1 ! 800 pre ! 0 tqv ! 0 seq ! 571 enx ! EnVocab InNativate + +( I -- innate KB-item for testing inhibition of idea-pairs ) + 554 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 554 aud ! +701 psi ! 1 num ! 0 pre ! 423 tqv ! 58 seq ! 701 enx ! EnVocab InNativate + +( AM -- for SelfReferentialThought; 10nov2012 ) + 556 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 557 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 556 aud ! +800 psi ! 1 num ! 701 pre ! 566 tqv ! 537 seq ! 800 enx ! EnVocab InNativate + +( A -- for EnArticle module ) + 559 t ! 65 pho ! 1 beg ! 0 ctu ! 101 audpsi ! AudMem \ A +101 nen ! 0 mfn ! 0 dba ! 101 fex ! 1 pos ! 101 fin ! 559 aud ! +101 psi ! 1 num ! 0 pre ! 537 seq ! 101 enx ! EnVocab InNativate + +( PERSON -- for ad-hoc gender tags and robot philosophy ) + 561 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 562 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 563 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 564 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 565 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 566 t ! 78 pho ! 0 beg ! 0 ctu ! 537 audpsi ! AudMem \ N +537 nen ! 0 mfn ! 1 dba ! 537 fex ! 5 pos ! 537 fin ! 561 aud ! +537 psi ! 1 num ! 800 pre ! 0 tqv ! 0 seq ! 537 enx ! EnVocab InNativate + +( I -- for SelfReferentialThought ) + 568 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 568 aud ! +701 psi ! 1 num 1 0 pre ! 573 tqv ! 895 seq ! 701 enx ! EnVocab InNativate + +( HELP -- socially significant common verb ) + 570 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 571 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 572 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 573 t ! 80 pho ! 0 beg ! 0 ctu ! 895 audpsi ! AudMem \ P +895 nen ! 0 mfn ! 1 dba ! 895 fex ! 8 pos ! 895 fin ! 570 aud ! +895 psi ! 1 num ! 701 pre ! 578 tqv ! 528 seq ! 895 enx ! EnVocab InNativate + +( KIDS -- noun lends itself to educational purposes ) + 575 t ! 75 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 576 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 577 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 578 t ! 83 pho ! 0 beg ! 0 ctu ! 528 audpsi ! AudMem \ S +528 nen ! 2 num ! 4 dba ! 0 mfn ! 528 fex ! 5 pos ! 528 fin ! 575 aud ! +528 psi ! 895 pre ! 0 tqv ! 0 seq ! 528 enx ! EnVocab InNativate + +( KIDS -- noun lends itself to educational purposes ) + 580 t ! 75 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 581 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 582 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 583 t ! 83 pho ! 0 beg ! 0 ctu ! 528 audpsi ! AudMem \ S +528 nen ! 0 mfn ! 1 dba ! 528 fex ! 5 pos ! 528 fin ! 580 aud ! +528 psi ! 2 num ! 0 pre ! 588 tqv ! 835 seq ! 528 enx ! EnVocab InStantiate + +( MAKE -- common verb of high word-frequency ) + 585 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 586 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 587 t ! 75 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 588 t ! 69 pho ! 0 beg ! 0 ctu ! 835 audpsi ! AudMem \ E +835 nen ! 2 num ! 0 mfn ! 835 fex ! 8 pos ! 835 fin ! 585 aud ! +835 psi ! 72 pre ! 595 tqv ! 571 seq ! 835 enx ! EnVocab InNativate + +( ROBOTS -- important for target user base ) + 590 t ! 82 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 591 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 592 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 593 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 594 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 595 t ! 83 pho ! 0 beg ! 0 ctu ! 571 audpsi ! AudMem \ S +571 nen ! 3 mfn ! 4 dba ! 571 fex ! 5 pos ! 571 fin ! 590 aud ! +571 psi ! 2 num ! 835 pre ! 0 tqv ! 0 seq ! 571 enx ! EnVocab InNativate + +( ROBOTS -- important for target user base ) + 597 t ! 82 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 598 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 599 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 600 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 601 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 602 t ! 83 pho ! 0 beg ! 0 ctu ! 571 audpsi ! AudMem \ S +571 nen ! 3 mfn ! 1 dba ! 571 fex ! 5 pos ! 571 fin ! 597 aud ! +571 psi ! 2 num ! 0 pre ! 473 tqv ! 849 seq ! 571 enx ! EnVocab InNativate + +( NEED -- common verb used for describing goals ) + 604 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 605 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 606 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 607 t ! 68 pho ! 0 beg ! 0 ctu ! 849 audpsi ! AudMem \ D +849 nen ! 2 num ! 0 mfn ! 849 fex ! 8 pos ! 849 fin ! 604 aud ! +849 psi ! 571 pre ! 610 tqv ! 701 seq ! 849 enx ! EnVocab InNativate + +( ME -- for SelfReferentialThought ) + 609 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 610 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 4 dba ! 701 fex ! 7 pos ! 707 fin ! 609 aud ! +701 psi ! 1 num ! 849 pre ! 0 tqv ! 0 seq ! 701 enx ! EnVocab InNativate +( Declaration of "vault" must reflect final EnBoot "t".) + 1 t +! + t @ vault ! + t @ tov ! + 1 t +! + t @ nlt ! ( nlt may be basis for DAMP functions ) + 528 urpsi ! \ As if "KIDS" were the cresting concept. + 900 nen ! \ segregate parts of speech by century; 9nov2012 + 5 bias ! + 0 lurk ! \ prepare to auto-start thinking; 19sep2010 + 0 num ! + 0 mfn ! \ Prevent carry-over. + 0 mfnflag ! \ Prevent carry-over; 23aug2010 + 0 nwc ! + 0 pho ! + 0 pre ! 0 seq ! + 0 putnum ! \ prevent carry-over; 4nov2011 +; ( http://code.google.com/p/mindforth/wiki/EnBoot ) + + +: KbTraversal ( reactivate KB concepts ) + 35 pov ! + kbtv @ 4 > IF 1 kbtv ! THEN +\ CR ." Knowledge base traversal with kbtv at " kbtv @ . + CR ." Time = " t @ . 8 EMIT \ as in Wotan AI; 28dec2012 + ." ; ReJuvenate count = " rjc @ . 8 EMIT \ 28dec2012 + ." ; activating " \ as in Wotan German AI 28dec2012 +\ ." KbTraversal activates " \ 28dec2012 + kbtv @ 1 = IF + 1 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + 707 nacpsi ! \ 707=YOU noun-activation psi; 10nov2012 + 707 qusub ! \ in case a query will be made; 10nov2012 + 707 subjpsi ! \ a test to help WhoBe; 10nov2012 + 1 subjnum ! \ for correct be-verb; 12oct2011 + 2 prsn ! \ for correct be-verb; 12oct2011 + \ ." activating concept of YOU" CR \ for who-query; 7aug2010 + 34 EMIT ." YOU" 34 EMIT ." as a concept." CR \ 28dec2012 + 62 nounval ! + NounAct + 0 nacpsi ! + THEN + kbtv @ 2 = IF \ for use in ThInk module; 14oct2011 + 2 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + \ ." activating concept of ROBOTS" CR ( 7aug2010 ) + 34 EMIT ." ROBOTS" 34 EMIT ." as a concept." CR \ 28dec2012 + 571 subjpsi ! \ external tagging as subject; 14oct2011 + 571 qusub ! \ in case a query will be made; 10nov2012 + 0 nacpsi ! + THEN + kbtv @ 3 = IF + 3 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + 701 nacpsi ! \ 701=I noun-activation psi; 10nov2012 + \ ." activating concept of I" CR ( 7aug2010 ) + 34 EMIT ." I" 34 EMIT ." as a concept." CR \ 28dec2012 + 701 qusub ! \ in case a query will be made; 10nov2012 + 701 subjpsi ! \ external tagging as subject; 10nov2012 + NounAct + 0 nacpsi ! + THEN + kbtv @ 4 = IF + 4 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + 533 nacpsi ! \ 533=GOD noun-activation psi; 10nov2012 + \ ." activating concept of GOD" CR ( 7aug2010 ) + 34 EMIT ." GOD" 34 EMIT ." as a concept." CR \ 28dec2012 + 533 qusub ! \ in case a query will be made; 10nov2012 + 533 subjpsi ! \ external tagging as subject; 10nov2012 + 62 nounval ! + NounAct + 0 nacpsi ! + THEN ( http://www.quartus.net ) + 42 pov ! +; ( http://code.google.com/p/mindforth/wiki/KbTraversal ) + + +: ReJuvenate ( recycle oldest memory spaces ) + fyi @ 2 = IF + CLS + THEN + 0 edge ! + CR 1 rjc +! + ." Please wait as memories migrate in ReJuvenate cycle #" + rjc @ . CR + t @ 2 + coda @ vault @ + DO + I jrt ! + jrt @ coda @ - jrt ! + edge @ 1 = IF + I 0 psi{ @ jrt @ 0 psi{ ! 0 I 0 psi{ ! + I 1 psi{ @ jrt @ 1 psi{ ! 0 I 1 psi{ ! + I 2 psi{ @ jrt @ 2 psi{ ! 0 I 2 psi{ ! + I 3 psi{ @ jrt @ 3 psi{ ! 0 I 3 psi{ ! + I 4 psi{ @ jrt @ 4 psi{ ! 0 I 4 psi{ ! + I 5 psi{ @ jrt @ 5 psi{ ! 0 I 5 psi{ ! + \ Next line adjusts tqv by minus-coda; 14aug2012 + I 6 psi{ @ coda @ - jrt @ 6 psi{ ! 0 I 6 psi{ ! + I 7 psi{ @ jrt @ 7 psi{ ! 0 I 7 psi{ ! + I 8 psi{ @ jrt @ 8 psi{ ! 0 I 8 psi{ ! + THEN + edge @ 1 = IF + en8 @ 1 < IF 0 en8 ! THEN \ 10nov2012 + I 0 en{ @ jrt @ 0 en{ ! 0 I 0 en{ ! + I 1 en{ @ jrt @ 1 en{ ! 0 I 1 en{ ! + I 2 en{ @ jrt @ 2 en{ ! 0 I 2 en{ ! + I 3 en{ @ jrt @ 3 en{ ! 0 I 3 en{ ! + I 4 en{ @ jrt @ 4 en{ ! 0 I 4 en{ ! + I 5 en{ @ jrt @ 5 en{ ! 0 I 5 en{ ! + I 6 en{ @ jrt @ 6 en{ ! 0 I 6 en{ ! + I 7 en{ @ jrt @ 7 en{ ! 0 I 7 en{ ! \ 29dec2012 + I 8 en{ @ en8 ! \ 10nov2012 + en8 @ vault @ < IF + en8 @ jrt @ 8 en{ ! 0 I 8 en{ ! THEN + en8 @ coda @ vault @ + > IF \ 10nov2012 + en8 @ coda @ - jrt @ 8 en{ ! \ 10nov2012 + THEN 0 I 8 en{ ! \ 10nov2012 + THEN + edge @ 1 = IF + I 0 aud{ @ jrt @ 0 aud{ ! + I 1 aud{ @ jrt @ 1 aud{ ! + I 2 aud{ @ jrt @ 2 aud{ ! + I 3 aud{ @ jrt @ 3 aud{ ! + I 4 aud{ @ jrt @ 4 aud{ ! + I 5 aud{ @ jrt @ 5 aud{ ! + fyi @ 1 > IF + jrt @ 0 aud{ @ EMIT + THEN + THEN + edge @ 0 = IF + 32 jrt @ 0 aud{ ! + 0 jrt @ 1 aud{ ! + I 2 aud{ @ 123 = IF 1 edge ! THEN + 0 jrt @ 2 aud{ ! + 0 jrt @ 3 aud{ ! + 0 jrt @ 4 aud{ ! + 0 jrt @ 5 aud{ ! + 0 jrt @ 0 en{ ! + 0 jrt @ 1 en{ ! + 0 jrt @ 2 en{ ! + 0 jrt @ 3 en{ ! + 0 jrt @ 4 en{ ! + 0 jrt @ 5 en{ ! + 0 jrt @ 6 en{ ! + 0 jrt @ 7 en{ ! + 0 jrt @ 8 en{ ! \ with dba; 10nov2012 + 0 jrt @ 0 psi{ ! + 0 jrt @ 1 psi{ ! + 0 jrt @ 2 psi{ ! + 0 jrt @ 3 psi{ ! + 0 jrt @ 4 psi{ ! + 0 jrt @ 5 psi{ ! + 0 jrt @ 6 psi{ ! + 0 jrt @ 7 psi{ ! + 0 jrt @ 8 psi{ ! \ for "tqv"; 12oct2011 + THEN + LOOP + jrt @ t ! + cns @ t @ DO + 32 I 0 aud{ ! + 0 I 1 aud{ ! + 0 I 2 aud{ ! + 0 I 3 aud{ ! + 0 I 4 aud{ ! + 0 I 5 aud{ ! + 0 I 0 en{ ! + 0 I 1 en{ ! + 0 I 2 en{ ! + 0 I 3 en{ ! + 0 I 4 en{ ! + 0 I 5 en{ ! + 0 I 6 en{ ! + 0 I 7 en{ ! + 0 I 8 en{ ! \ with "dba"; 10nov2012 + 0 I 0 psi{ ! + 0 I 1 psi{ ! + 0 I 2 psi{ ! + 0 I 3 psi{ ! + 0 I 4 psi{ ! + 0 I 5 psi{ ! + 0 I 6 psi{ ! + 0 I 7 psi{ ! + 0 I 8 psi{ ! \ with new "enx"; 12oct2011 + LOOP + t @ 32 - tov ! \ 12jan2010 Avoid truncating thoughts. + CR CR ." End of ReJuvenate #" rjc @ . + ." in the AI Mind display for science museum exhibits." + CR ." Tab key cycles through Normal, Transcript, " + ." Tutorial, Diagnostic display-modes. " CR + 1 kbtv +! + kbtv @ 0 > IF + CR ." For lack of human input, " + ." ReJuvenate calls KbTraversal" CR + KbTraversal + THEN ( http://ronware.org/reva ) + rsvp @ rjc @ - rsvp ! + rsvp @ 2 < IF 2 rsvp ! THEN \ 23dec2009 Maintain speed. +; ( http://code.google.com/p/mindforth/wiki/ReJuvenate ) + + +: SpeechAct ( output of a word as text or sound ) + aud @ 0 = IF 1 aud ! THEN \ default to ERROR; 21jul2011 + fyi @ 2 = IF CR THEN + 0 audstop ! ( Initially false value of flag ) + 0 pho ! ( Lest pho already be at 32 ) + aud @ onset ! ( onset of a word is its recall-vector ) + aud @ t2s ! + 40 1 DO + t2s @ 0 aud{ @ pho ! + pho @ 32 = NOT IF + pho @ EMIT ( say or display "pho" ) + pho @ lastpho ! + THEN \ End of test for pho=32 space-bar; 30aug2010 + pho @ 32 = IF \ but instead of a blank space; 30aug2010 + lastpho @ 83 = NOT IF \ not after "S"; 30aug2010 + flex1 @ 0 > IF \ using shorter variable; 11sep2011 + flex1 @ pho ! \ append inflection; 11sep2011 + 0 flex1 ! \ reset for safety; 11sep2011 + THEN ( http://aimind-i.com ) + 1 spacegap ! + 0 vpos ! + THEN \ End of test for previous "S"; 30aug2010 + pho @ EMIT ( say or display "pho" ) + 1 audstop ! + THEN \ end of test for 32=space; 30aug2010 + 35 pov ! ( internal point-of-view "#" like mindgrid ) + AudInput ( for reentry of thought back into a mind ) + audstop @ 1 = IF + spacegap @ 1 = IF + 32 pho ! + 1 audrun ! \ resetting at end of internal word. + AudInput + 0 spacegap ! + THEN ( http://www.speechapi.com ) + LEAVE + THEN ( http://aigroup.narod.ru ) + t2s @ 1+ t2s ! + t2s @ 4 aud{ @ 0 = IF 32 pho ! THEN ( If end of word ) + match @ 1 = IF + 0 match ! + LEAVE + THEN + LOOP + 0 aud ! \ Avoid unwarranted carry-over of value; 11sep2011 + 0 match ! + 0 obstat ! +; ( http://code.google.com/p/mindforth/wiki/SpeechAct ) + + +: SayYes ( to utter "YES" in response ) + midway @ t @ DO + I 0 en{ @ 432 = IF \ 3-digit; 10nov2012 + I 8 en{ @ aud ! \ with dba; 10nov2012 + LEAVE + THEN ( http://aimind-i.com ) + -1 +LOOP + SpeechAct + 0 kbquiz ! + 0 yesorno ! +; ( http://code.google.com/p/mindforth ) + + +: EnArticle ( select "a" or "the" before a noun ) + indefmust @ 1 = IF \ if required to say "A(N)"; 20oct2011 + midway @ t @ DO \ search backwards in time; 20oct2011 + I 0 en{ @ 101 = IF \ 101=A found? 8nov2012 + I 8 en{ @ aud ! \ save auditory recall-vector + LEAVE \ one instance is enough; 20oct2011 + THEN \ end of test for "101=A" engram; 8nov2012 + -1 +LOOP \ end of backwards loop; 20oct2011 + SpeechAct \ pronounce the requred article; 20oct2011 + 0 indefmust ! \ reset for safety; 20oct2011 + EXIT \ abandon rest of EnArticle; 20oct2011 + THEN \ end of test for a required "A(N); 20oct2011 + nphrpos @ 7 = NOT IF + nphrnum @ 1 = IF + motjuste @ ghost @ = IF \ + 0 indefartcon ! \ do not say "A"; 15oct2011 + 1 defartcon ! \ say "THE"; 15oct2011 + THEN \ + motjuste @ ghost @ = NOT IF + subjnum @ 1 = IF \ if singular subject; 13sep2011 + verbpsi @ 800 = IF \ AM or IS; 10nov0212 + 1 indefartcon ! \ indefinite article; 13sep2011 + THEN \ end of test for "AM" or "IS"; 13sep2011 + THEN \ 13sep2011 + indefartcon @ 1 = IF \ from WHAT-query; 16apr2011 + 0 defartcon ! \ avoid "A THE"; 6oct2011 + anset @ 0 = IF ( If no vowel is next ) + midway @ t @ DO + I 0 en{ @ 101 = IF \ 101=A? 8nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + THEN ( End of test for absence of a vowel ) + anset @ 0 > IF ( If anset-flag is positive ) + midway @ t @ DO + I 0 en{ @ 102 = IF \ 102=AN? 8nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + THEN ( End of test for a vowel coming next ) + 1 numflag ! \ With "A" assume singular number. + SpeechAct + 0 indefartcon ! \ Reset; 16apr2011 + THEN \ End of test for positive indefartcon; 16apr2011 + 0 indefartcon ! \ Reset for safety; 6oct2011 + THEN + motjuste @ ghost @ = IF + defartcon @ 1 = IF \ from WH0-query; 16apr2011 + midway @ t @ DO + I 0 en{ @ 117 = IF \ If 117=THE found; 10nov2012 + I 8 en{ @ aud ! \ with dba; 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 0 defartcon ! \ Reset; 16apr2011 + THEN \ End of test for positive defartcon; 16apr2011 + THEN + THEN + THEN + dirobj @ 1 = IF + motjuste @ ghost ! + THEN ( http://thebeez.home.xs4all.nl/4tH ) + 0 whoflag ! \ call EnArticle only once; 15oct2011 +; ( http://code.google.com/p/mindforth/wiki/EnArticle ) + + +: EnAdjective ( insert an adjective into a sentence ) + adjcon @ 1 = IF \ activation spreads to an adjective? + ( find and speak the most active adjective; 16sep2011 ) + THEN ( http://www.colorforth.com ) +; ( http://code.google.com/p/mindforth ) + + +: AuxVerb ( auxiliary Verb ) +\ CR ." AuxV: subjnum prsn = " \ 29dec2012 +\ subjnum @ . prsn @ . \ 29dec2012 + subjnum @ 1 = prsn @ 3 = AND IF \ 19jul211 + midway @ t @ DO + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd person? 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for third person; 10nov2012 + THEN \ end ofbtest for num=1 singular; 10nov2012 + THEN \ end of test for 830=DO; 10nov2012 + -1 +LOOP + SpeechAct \ Say word starting at "aud" value; 20jul2011 + 830 urpsi ! \ 10nov2012 + 51 caller ! + PsiDamp + 0 urpsi ! \ reset for safety; 29dec2012 + 0 caller ! + ELSE \ all other cases except 3rd prsn sing; 25jun2011 + midway @ t @ DO \ may need parameters! 10nov2012 + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 4 en{ @ 0 = IF \ 0=dba infinitive 29dec2012 + I 8 en{ @ 0 > IF \ non-zer? 29dec2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for non-zero aud; 29dec2012 + THEN \ end of test to accept infinitive; 29dec2012 + THEN + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from AuxVerb after speaking of DO, " + ." psiDamping concept #830 DO" + THEN + 830 urpsi ! \ 830=DO; 10nov2012 + 51 caller ! + PsiDamp + 0 urpsi ! \ reset for safety; 29dec2012 + 0 caller ! + THEN \ end of test for both sing & 3rd prsn; 25jun2011 +; ( http://code.google.com/p/mindforth/wiki/AuxVerb ) + + +: WhatAuxSVerb ( What DO Subjects Verb; 13jun2011 ) + midway @ t @ DO + I 0 en{ @ 781 = IF \ 781=WHAT 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct \ Say word starting at "aud" value; 20jul2011 + 781 urpsi ! \ 781=WHAT; 10nov2012 + PsiDamp + AuxVerb \ Say DOES or DO depending on num(ber) 20jul2011 + 0 motjuste ! + midway @ t @ DO + I 0 en{ @ topic @ = IF \ 13jun2011 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN ( http://sourceforge.net/projects/calforth ) + -1 +LOOP + topic @ urpsi ! \ 14aug2011 + PsiDamp + SpeechAct + verbpsi @ 0 = IF 830 verbpsi ! THEN \ 830=DO DeFault 10nov2012 + verbpsi @ unk ! \ use a short "unk"; 28aug2011 + verbpsi @ 800 = IF \ 800 cover AM IS ARE BE; 10nov2012 + 830 verbpsi ! \ replace be-verbs with 830=DO; 10nov2012 + THEN \ end of default switching be-verb to 830=DO; 10nov2012 + midway @ t @ DO + I 0 en{ @ verbpsi @ = IF \ 13jun2011 + I 2 en{ @ 2 = IF \ as if infinitive; 13jun2011 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ End of test for plural as if infinitive + THEN + -1 +LOOP + aud @ 0 = IF \ if no plural accept singular 14aug2011 + midway @ t @ DO \ search English vocab; 14aug2011 + I 0 en{ @ verbpsi @ = IF \ 14aug2011 + I 8 en{ @ aud ! \ for SpeechAct; 10nov2012 + LEAVE \ one engram is enough; 14aug2011 + THEN \ end of test for verbpsi; 14aug2011 + -1 +LOOP \ end of backwards search loop; 14aug2011 + THEN \ end of test for no engram found; 14aug2011 +( http://www.intelligent-systems.com.ar/intsyst/proposedBrain.htm ) + SpeechAct + verbpsi @ urpsi ! \ 13jun2011 + PsiDamp +; ( http://code.google.com/p/mindforth ) + + +: WhatAuxSDo ( What DO Subjects DO ) + midway @ t @ DO + I 0 en{ @ 781 = IF \ 781=WHAT; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 781 urpsi ! \ 781=WHAT for PsiDamp; 10nov2012 + 42 caller ! + PsiDamp + 0 caller ! + AuxVerb \ to include DO or DOES; 14aug2011 + subjnum @ 1 = IF \ for singular subject; 14oct2011 + topic @ motjuste ! \ test; 14oct2011 + 0 ghost ! \ test; 14oct2011 + 1 nphrnum ! \ required for "A"' 14oct2011 + 1 indefartcon ! \ to say "A"; 14oct2011 + EnArticle \ 14oct2011 + THEN \ end of test for singular subject; 14oct2011 + midway @ t @ DO + I 0 en{ @ topic @ = IF + I 2 en{ @ subjnum @ = IF \ agreement? 14oct2011 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE \ only after finding match; 14oct2011 + THEN \ end of grammatical-number test; 14oct2011 + THEN + -1 +LOOP + topic @ urpsi ! \ 14aug2011 + 42 caller ! + PsiDamp + SpeechAct + midway @ t @ DO + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 4 en{ @ 0 = IF \ dba=0 infinitive; 25dec2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of tist for infinitive dba=0; 25dec2012 + THEN + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from whatAuxSDo after speaking of DO, " + ." psiDamping concept #59 DO" + THEN + 830 urpsi ! \ 830=DO for PsiDamp; 10nov2012 + 42 caller ! + PsiDamp + 0 caller ! +; ( http://code.google.com/p/mindforth/wiki/WhatAuxSDo ) + + +: WhoBe ( for asking WHO IS-AM-ARE; 9aug2010 ) + 1 moot ! \ prevent associative tagging inside query; 24oct2011 + 0 tqv ! \ prevent spurious carry-over values; 1aug2012 + topic @ 0 > IF topic @ qusub ! THEN \ review; 30jul2011 + midway @ t @ DO \ Say the word "WHO"; 19aug2010 + I 0 en{ @ 791 = IF ( 791=WHO; 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 8766 caller ! \ ASCII 87=W 66=B; test; 26sep2010 + 55 urpsi ! \ Designate concept to be psi-damped; 19aug2010 + PsiDamp + 0 caller ! \ reset after use; 26sep2010 + qusub @ 701 = IF 1 prsn ! THEN \ 1st person "I" 10nov2012 + qusub @ 731 = IF 1 prsn ! THEN \ 1st person WE 10nov2012 + qusub @ 707 = IF 2 prsn ! THEN \ 2nd person YOU 10nov2012 + qusub @ 737 = IF 2 prsn ! THEN \ 2nd person YOU 10nov2012 + qusub @ 713 = IF 3 prsn ! THEN \ 3rd person HE 10nov2012 + qusub @ 719 = IF 3 prsn ! THEN \ 3rd person SHE 10nov2012 + qusub @ 725 = IF 3 prsn ! THEN \ 3rd person IT 10nov2012 + qusub @ 743 = IF 3 prsn ! THEN \ 3rd person THEY 10nov2012 + prsn @ 3 = IF \ only for 3rd person; 1sep2010 + midway @ t @ DO \ Say "IS" after "WHO"; 19aug2010 + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 3 = IF ( 3rd person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for 3rd person "IS" 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ to say "IS"; 17aug2010 + 0 mfn ! \ test; remove; 25aug2010 + 0 mfnflag ! \ Reset after use; 19aug2010 + THEN \ end of test for prsn=1; 1sep2010 + qusub @ 701 = IF ( I; 10nov2012 ) + 1 prsn ! \ first person; 1sep2010 + 1 nphrnum ! \ singular; 1sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 1 = IF ( 1st person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end ofb test for first person; 10nov2012 + THEN \ end of test for singular 800=BE; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ to say "AM"; 17oct2011 + THEN \ 9aug2010 + qusub @ 701 = IF \ treat ME like 701=I; 10nov2012 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 1 = IF ( 1st person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ moved inside the IF-clause; 10aug2010 + THEN \ 9aug2010 + qusub @ 707 = IF ( 707=YOU; 10nov2012 ) + 2 prsn ! \ second person; 1sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 2 = IF ( 2nd person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for 2nd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ to say "ARE"; 10aug2010 + THEN \ 9aug2010 + qusub @ 713 = IF ( 713=HE; 10nov2012 ) + 3 prsn ! \ third person; 1sep2010 + 1 nphrnum ! \ singular; 1sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 3 = IF ( 3rd person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ enmd of test for 3rd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + THEN ( http://minforth.net.ms ) + midway @ t @ DO \ search for who-query subject; 23aug2010 + I 0 en{ @ qusub @ = IF \ if qusub found; 3oct2010 + I 8 en{ @ aud ! \ recall-tag; 10nov2012 + LEAVE \ one exemplar is enough; 23aug2010 + THEN \ end of test for subject; 23aug2010 + -1 +LOOP \ end of search-loop; 23aug2010 + SpeechAct \ speak (WHO IS) qusub query-subject; 3oct2010 + 0 moot ! \ end of not tagging query-concepts; 24oct2011 +; ( http://code.google.com/p/mindforth ) + + +: WhatBe ( what AM/IS/ARE Subjects ) \ 10oct2011 + 1 moot ! \ prevent storage of spurious ideas; 24oct2011 + 0 tqv ! \ prevent spurious carry-over values; 1aug2012 + qusub @ 0 = IF \ for a new word like "energy"; 8aug2012 + subjnum @ 0 = IF \ in absence of num(ber) data; 8aug2012 + 3 prsn ! \ to say "IS"; 8aug2012 + THEN \ end of test for "qusub"; 8aug2012 + THEN \ end of test for "subjnum"; 8aug2012 + topic @ qusub ! \ THEN \ 2nd choice; 10oct2011 + qusub @ 701 = IF 1 prsn ! THEN \ 1st person "I"; 10nov2012 + qusub @ 707 = IF 2 prsn ! THEN \ 2nd person YOU; 10nov2012 + midway @ t @ DO + I 0 en{ @ 781 = IF \ 781=WHAT; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from WhatBe after speaking of WHAT, " \ 25feb2011 + ." psiDamping concept #781" + THEN + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + 781 urpsi ! \ 781=WHAT for PsiDamp; 10nov2012 + PsiDamp + 0 caller ! + subjnum @ 2 < topicnum @ 2 < OR IF \ not plural? 4nov2011 + prsn @ 1 = IF \ 1st person singular; 21aug2011 + midway @ t @ DO \ 21aug2011 + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + I 2 en{ @ 1 = IF \ singular?; 10nov2012 + I 4 en{ @ 1 = IF \ 1st person?; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + 1 topicnum ! \ If "AM" prevent "ARE"; 26jul2012 + LEAVE \ 21aug2011 + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ 21aug2011 + -1 +LOOP \ 21aug2011 + SpeechAct \ 21aug2011 + THEN \ end of test for first person singular; 21aug2011 + prsn @ 3 = IF \ 3rd person singular; 19sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd pers? 26dec2012 + I 8 en{ @ aud ! \ 10nov2012 + 1 topicnum ! \ If "IS" prevent "ARE" 21jul2012 + 1 indefmust ! \ to say "IS A"; 20oct2011 + LEAVE + THEN \ end of test for 3rd person; 10nov2012 + THEN \ end of test for singualr; 10nov2012 + THEN ( http://isforth.com ) + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from WhatBe after speaking of IS, " \ 25feb2011 + ." psiDamping concept #800" + THEN + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + 800 urpsi ! \ 10nov2012 + PsiDamp + 0 caller ! + 0 motjuste ! + THEN \ end of test for 3rd person singular; 19sep2010 + THEN + topicnum @ 2 = prsn @ 2 = OR IF \ test; 19sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + I 2 en{ @ 2 = IF \ plural? 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for plural "ARE"; 10nov2012 + THEN \ end of test for be-verb + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from WhatBe after speaking of ARE, " \ 25feb2011 + ." psiDamping concept #800" + THEN + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + 800 urpsi ! \ 10nov2012 + PsiDamp + 0 caller ! \ test; 26sep2010 + 0 motjuste ! + 0 subjpsi ! \ reset for safety' 17oct2011 + 0 topicnum ! + THEN + topicnum @ 2 = NOT IF \ if singular; 21jun2011 + prsn @ 3 = IF \ 3rd person singular; 21jun2011 + topicnum @ 1 = IF \ not zero; 4nov2011 + EnArticle \ chance for "A" or "THE"; 21jun2011 + THEN \ end of test for 1=singular; 4nov2011 + THEN \ end of test for 3rd person; 21jun2011 + THEN \ end of test for singular; 21jun2011 + midway @ t @ DO + I 0 en{ @ qusub @ = IF \ 10oct2011 + I 4 en{ @ 1 = IF \ nominative? 1jan2013 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for dba=1 nominative; 1jan2013 + THEN + -1 +LOOP + motjuste @ urpsi ! + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + PsiDamp + 0 caller ! \ test; 26sep2010 + aud @ 0 > IF \ avoid #zero ERROR; \ 19sep2010 + SpeechAct + THEN \ end of test to avoid ERROR; 19sep2010 + 0 cogpsi ! \ let another new word call WhatBe; 17oct2011 + 0 indefmust ! \ reset for safety; 20oct2011 + 0 moot ! \ resume associative tagging; 24oct2011 + 0 qusub ! \ zero out for safety; 10oct2011 + 0 subjpsi ! \ reset for safety; 17oct2011 + 0 topic ! \ reset for safety; 18oct2011 + 0 whoflag ! \ Prevent EnArticle; 6oct2011 +; ( http://code.google.com/p/mindforth ) + + +: AskUser ( outputs questions of a speculative nature ) + 35 pov ! \ #35=internal; *42=external; 29dec2012 + ynverb @ 0 = IF \ only ask y/n question once; 24jun2011 + quverb @ ynverb ! \ isolate at start; 24jun2022 + \ nphrnum @ 2 = IF \ if plural trigger; test; 24jun2011 + \ nphrnum @ 2 = IF \ Commenting out for InFerence; 1jan2013 + AuxVerb \ to say DO or DOES; 24jun2011 + \ midway @ t @ DO \ search English vocab; 24jun2011 + midway @ inft @ DO \ skip silent inference; 27dec2012 + I 0 en{ @ qusub @ = IF ( kbtv ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + tkbv @ tqv ! \ qusub needs a tqv to quverb 29dec2012 + SpeechAct \ to say the subject; 24jun2011 + t @ tkbn ! \ if engram is to be changed; 2jul2011 + quverb @ t @ 7 psi{ ! \ insert as seq; 29dec2012 + qusub @ nacpsi ! \ transfer activand; 25jun2011 + 62 nounval ! \ prime NounAct; 24jun2011 + NounAct \ activate the query subject; 24jun2011 + midway @ t @ DO \ search English vocab; 24jun2011 + I 0 en{ @ ynverb @ = IF ( yes-or-no verb ) + I 2 en{ @ 2 = IF \ as if infinitive; 24jun2011 + I 8 en{ @ aud ! \ fetch recall-vector 10nov2012 + LEAVE \ one engram is enough; 24jun2011 + THEN \ end of test for plural as if infinitive + THEN + -1 +LOOP + aud @ 0 = IF \ if no plural accept singular 24jun2011 + midway @ t @ DO \ search English vocab; 24jun2011 + I 0 en{ @ ynverb @ = IF ( yes-or-no verb ) + I 2 en{ @ 1 = IF \ second choice; 24jun2011 + I 8 en{ @ aud ! \ fetch recall-vector + LEAVE \ one engram is enough; 24jun2011 + THEN \ end of test for plural as if infinitive + THEN + -1 +LOOP + THEN \ end of test for no engram found; 24jun2011 + aud @ 0 = IF \ if neither plural nor singular; 25aug2011 + midway @ t @ DO \ search English vocab; 25aug2011 + I 0 en{ @ ynverb @ = IF ( yes-or-no verb ) + I 8 en{ @ aud ! \ fetch recall-vector + LEAVE \ one engram is enough; 25aug2011 + THEN \ end of test for any form at all; 25aug2011 + -1 +LOOP + THEN \ end of third test for no engram found; 25aug2011 + ynverb @ nacpsi ! \ transfer activand; 25jun2011 + 62 verbval ! \ prime VerbAct; 2jul2011 + VerbAct \ activate the query verb; 25jun2011 + SpeechAct \ to say yes-or-no verb; 24jun2011 + t @ 1 - tkbv ! \ if engram is to be changed; 2jul2011 + tkbv @ tkbn @ 6 psi{ ! \ noun's tqv; 29dec2012 + quverb @ tkbn @ 7 psi{ ! \ noun's seq; 29dec2012 + quobj @ tkbv @ 7 psi{ ! \ verb's seq; 29dec2012 + quobj @ 0 = quobj @ 586 = OR IF \ nothing or ERROR + 711 quobj ! \ 711=ANYTHING by default; 10nov2012 + THEN \ end of test for a query-object; 20jul2011 + \ midway @ t @ DO \ search English vocab; 24jun2011 + midway @ inft @ DO \ skip silent inference; 27dec2012 + I 0 en{ @ quobj @ = IF ( query-object? ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + aud @ 2 < IF \ if zero or ERROR; 25aug2011 + midway @ t @ DO \ search English vocab; 25aug2011 + I 0 en{ @ 711 @ = IF \ 711=ANYTHING; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE \ 25aug2011 + THEN \ 25aug2011 + -1 +LOOP \ 25aug2011 + THEN \ 25aug2011 + SpeechAct \ to say query-object; 24jun2011 + t @ tkbv @ 6 psi{ ! \ insert quverb's tqv; 29dec2012 + \ THEN \ end of test for a plural nphrnum; 24jun2011 + \ THEN \ Commenting out; soon remove as obsolete; 1jan2013 + 0 yncon ! \ because question has been asked; 2jul2011 + 1 kbcon ! \ because waiting for answer; 2jul2011 + 0 ynverb ! \ zero out; prevent repeat of query 24jun2011 + THEN \ end of test for a positive ynverb; 24jun2011 + 5 bias ! \ Restore expectation of noun; 24jun2011 +; ( http://code.google.com/p/mindforth/wiki/AskUser ) + + +: EnPronoun \ For use with what-do-X-do queries. + num @ 1 = IF \ If antecedent num(ber) is singular. + mfn @ 1 = IF \ if masculine singular; 13apr2010 + midway @ t @ DO \ Look backwards for 49=HE. + I 0 en{ @ 713 = IF \ If 713=HE is found, + 713 motjuste ! \ "nen" concept #713 for "he". + I 8 en{ @ aud ! \ Recall-vector for "he". + LEAVE \ Use the most recent engram of "he". + THEN \ End of search for 713=HE; 10-nov2012. + -1 +LOOP \ End of loop finding pronoun "he". + SpeechAct \ Speak or display the pronoun "he". + THEN \ end of test for masculine gender-flag. + mfn @ 2 = IF \ if feminine singular. + midway @ t @ DO \ Look backwards for 80=SHE + I 0 en{ @ 719 = IF \ If 719=SHE is found, + 719 motjuste ! \ "nen" concept #719 for "she". + I 8 en{ @ aud ! \ Recall-vector for "she". + LEAVE \ Use the most recent engram of "she". + THEN \ End of search for #719 "she". + -1 +LOOP \ End of loop finding pronoun "she" + SpeechAct \ Speak or display the pronoun "she" + THEN \ end of test for feminine gender-flag. + mfn @ 3 = IF \ if neuter singular; 13apr2010 + midway @ t @ DO \ Look backwards for 725=IT. + I 0 en{ @ 725 = IF \ If 725=IT is found, + 725 motjuste ! \ "nen" concept #725 for "it". + I 8 en{ @ aud ! \ Recall-vector for "it". + LEAVE \ Use the most recent engram of "it". + THEN \ End of search for 725=IT; 10nov2012 + -1 +LOOP \ End of loop finding pronoun "it". + SpeechAct \ Speak or display the pronoun "it". + THEN \ end of test for neuter gender-flag. + 0 numsubj ! \ safety measure; 13apr2010 + THEN \ End of test for singular num(ber) + num @ 2 = IF \ 30dec2009 If num(ber) of antecedent is plural + ( code further conditions for "WE" or "YOU" ) + midway @ t @ DO \ Look backwards for 743=THEY. + I 0 en{ @ 743 = IF \ If 743=THEY is found, + 743 motjuste ! \ "nen" concept #743 for "they". + I 8 en{ @ aud ! \ Recall-vector for "they". + LEAVE \ Use the most recent engram of "they". + THEN \ End of search for 743=THEY; 10nov2012. + -1 +LOOP \ End of loop finding pronoun "they". + SpeechAct \ Speak or display the pronoun "they". + THEN \ 30dec2009 End of test for plural num(ber) +; ( http://code.google.com/p/mindforth/wiki/EnPronoun ) + + +: NounPhrase ( select part of a thought ) + 0 audjuste ! \ prevent carry-over; 20oct2011 + verblock @ 0 > IF \ positive verblock? 20oct2011 + verblock @ 6 psi{ @ nounlock ! \ test; 20oct2011 + THEN \ end of test for a positive verblock; 20oct2011 + 66 caller ! \ here and further down; 12oct2010 + objold @ urpsi ! \ here and further down; 12oct2010 + 0 caller ! \ reset after use; 12oct2010 + 0 urpsi ! \ reset for safety; 12oct2010 + EnReify ( move abstract Psi concepts to EnVocab reality ) + 0 act ! + 0 aud ! + -64 defact ! \ for default comparisons with "50=I"; 9oct2011 + 0 kibosh ! \ for de-activating non-selectees; 17aug2011 + 0 motjuste ! + 0 nphrnum ! \ prevent carry-overs; 11oct2011 + 0 num ! \ without prejudice; 29aug2010 + 0 prsn ! \ without prejudice; 29aug2010 + 0 putnum ! \ prevent carry-over from previous; 4nov2011 + 0 recnum ! \ prevent carry-over from previous; 4nov2011 + 0 tpeg ! \ reset for safety; 28sep2011 + nounlock @ 0 > IF \ already a nounlock? 19oct2011 + nounlock @ 2 en{ @ scn ! \ subject-concept-number 17jul2012 + nounlock @ 8 en{ @ audjuste ! \ tentatively; 10nov2012 + THEN \ end of test for a positive nounlock; 19oct2011 + 5 opt ! + 35 pov ! + 1 subjectflag ! ( 3dec2009 A default until countermanded ) + dirobj @ 1 = IF 0 subjectflag ! THEN ( 3dec2009 anti-default ) + predflag @ 1 = IF 0 subjectflag ! THEN ( anti-default 8oct2010 ) + 0 psi ! + midway @ t @ DO + I 5 psi{ @ 5 = I 5 psi{ @ 7 = OR IF \ POS; 12aug2011 + I 0 en{ @ 65 = IF I 8 en{ @ audme ! THEN \ 10nov2012 + subjectflag @ 1 = IF \ test; change; 26aug2011 + I 1 psi{ @ act @ > I 6 psi{ 0 > AND IF \ 6oct2011 + I 7 psi{ @ 0 > IF \ Testing for seq-concept; 12oct2011 + I tsels ! \ retain time of subject; 11sep2011 + I tseln ! \ retain time of motjuste; 11sep2011 + I 0 psi{ @ motjuste ! \ 12aug2011 + I 2 psi{ @ nphrnum ! \ NounPhrase num(ber); 6oct2011 + I 2 psi{ @ subjnum ! \ 11oct2011 + I 2 psi{ @ snu ! ! \ verb-select parameter 21dec2012 + THEN \ reinstating for subjects; 3oct2011 + ( insert NPhr diagnostic code here; 11sep2011 ) + I 2 psi{ @ subjnum ! \ verbs in general; 12aug2011 + motjuste @ subjold ! \ keep oldsubject ready; 8oct + I 2 psi{ @ putnum ! \ putative num for verb; 12aug2011 + I 5 psi{ @ nphrpos ! \ NounPhrase part-of-speech + I 1 psi{ @ act @ > I 7 psi{ @ 0 > AND IF \ 12oct2011 + I tpeg ! \ peg the time-slice; 28sep2011 + I 7 psi{ @ svo2 ! \ hold seq; test; 12oct2011 + I 6 psi{ @ verblock ! \ tqv of seq-concept; 12oct2011 + midway @ t @ DO \ from Wotan German AI; 21dec2012 + I 0 en{ @ motjuste @ = IF \ same concept? + I 8 en{ @ 0 > IF \ skip non-rv; 21dec2012 + \ I 2 en{ @ snu @ = IF \ same subj. number? + \ I 4 en{ @ 1 = IF \ nom. for subj? 21dec2012 + I 8 en{ @ audjuste ! \ avoid spurious + \ I 8 en{ @ 0 > IF \ positive recall-vector? + \ 1 8 en{ @ audjuste ! \ recall-vector 21dec + \ THEN \ end of test for positive rv 21dec2012 + \ THEN \ end of dba-test for nominative + \ THEN \ end of subject-number test; 21dec2012 + THEN \ end of skipping InFerence non-rb 21dec2012 + THEN \ end of search of English lexicon 21dec2012 + -1 +LOOP \ end of English lexicon search 21dec2012 + \ I 8 en{ @ audjuste ! \ avoid the spurious; 10nov2012 + motjuste @ 701 = IF \ guarantee "I"; 10nov2012 + midway @ t @ DO \ search backwards; 25oct2011 + I 0 en{ @ 701 = IF \ "701=I" 20dec2012 + I 8 en{ @ audjuste ! \ recall-vector + LEAVE \ one I-engram is enough; 25oct2011 + THEN \ end of test for "701=I"; 10nov2012 + -1 +LOOP \ end of "701=I" search loop; 10nov2012 + THEN \ end of test for "701=I"; 10nov2012 + motjuste @ 707 = IF \ guarantee "YOU"; 10nov2012 + midway @ t @ DO \ search backwards; 25oct2011 + I 0 en{ @ 707 = IF \ "707=YOU"; 10nov2012 + I 8 en{ @ audjuste ! \ recall-vector + LEAVE \ one YOU-engram is enough; 20dec2012 + THEN \ end of test for "707=YOU"; 10nov2012 + -1 +LOOP \ end of 707=YOU search loop; 10nov2012 + THEN \ end of test for "707=YOU"; 10nov2012 + I 1 psi{ @ act ! \ after passing seq-check; 28aug2011 + THEN \ reinstating to prevent false motjuste; 6oct2011 + THEN \ end of test for a higher activation; 26aug2011 + THEN \ end of test for 1=subjectflag; test; 26aug2011 + subjectflag @ 0 = IF \ i.e., dir.obj or pred.nom; 15oct2011 + nounlock @ 0 > IF + nounlock @ 0 psi{ @ motjuste ! \ nounlock psi; 22dec2012 + ELSE + I 1 psi{ @ act @ > IF \ if higher; 12aug2011 + I tseln ! \ retain time of motjuste; 8may2011 + I 0 psi{ @ motjuste ! \ 26aug2011 + ( insert NPhr diagnostic code here; 9sep2011 ) + nounlock @ 0 > IF \ if positive nounlock exists; 8oct2011 + I nounlock @ = IF \ upon reaching engram; 8oct2011 + I 0 psi{ @ motjuste ! \ grab nounlock psi; 8oct2011 + I 2 psi{ @ nphrnum ! \ NounPhrase num(ber) 11oct2011 + I 2 en{ @ pcn ! \ predicate concept number 16jul2012 + \ I 8 en{ @ audjuste ! \ 10nov2012 + midway @ t @ DO \ look for recall-vector; 22dec2012 + I 0 en{ @ motjuste @ = IF \ same concept? 22dec2012 + I 8 en{ @ 0 > IF \ positive rv? 22dec2012 + I 8 en{ @ audjuste ! \ 22dec2012 + THEN \ end of test for recall-vector; 22dec2012 + THEN \ end of test for concept; 22dec2012 + -1 +LOOP \ end of English lexicon search; 22dec2012 + LEAVE \ prevent usurpation of pre-ordained seq 8oct2011 + THEN \ end of test for Index = nounlock; 8oct2011 + THEN \ end of test for positive nounlock; 8oct2011 + \ I 0 psi{ @ subjpsi ! \ Commenting out; 20dec2012 + I 2 psi{ @ nphrnum ! \ NounPhrase num(ber); 12aug2011 + I 2 psi{ @ putnum ! \ putative num for verb; 12aug2011 + I 5 psi{ @ nphrpos ! \ NounPhrase part-of-speech + dirobj @ 1 = IF + motjuste @ objold ! \ a test ICW slosh-over; 12oct2010 + THEN ( http://christophe.lavarenne.free.fr/ff ) + I 1 psi{ @ act @ > IF \ 26aug2011 + I 1 psi{ @ act ! \ 12aug2011 + THEN \ 26aug2011 + THEN \ end of test for a higher activation; 26aug2011 + THEN \ end of test for positive nounlock; 22dec2012 + THEN \ end of test for 0=subjectflag; test; 26aug2011 + THEN \ end of test for a noun or pronoun; 26aug2011 + -1 +LOOP \ End of search for most active "motjuste"; 20dec2012 + subjectflag @ 1 = IF motjuste @ subjpsi ! THEN \ 20dec2012 + nounlock @ 0 > IF \ 22dec2012 + midway @ t @ DO \ from Wotan German AI; 22dec2012 + I 0 en{ @ motjuste @ = IF \ same concept? + I 8 en{ @ 0 > IF \ skip non-rv; 22dec2012 + I 8 en{ @ audjuste ! \ 22dec2012 + LEAVE \ if correct parameters; 22dec2012 + THEN \ emd of test for positive en8; 22dec2012 + THEN \ end of test for match with motjuste; 22dec2102 + -1 +LOOP \ end of English lexicon search 22dec2012 + THEN \ end of test for positive nounlock; 22dec2012 + midway @ t @ DO \ search backwards; 12aug2011; 12sep2011 + I 0 en{ @ motjuste @ = IF \ 12aug2011 + predflag @ 1 = IF \ only for predicate nominatives; + nounlock @ 0 = IF \ in absence of nounlock; 19oct2011 + I 2 en{ @ subjnum @ = IF \ agreement? 19sep2011 + I 8 en{ @ audjuste ! \ recall-vector; 10nov2012 + LEAVE \ one auditory engram is enough; 12aug2011 + THEN ( http://practicalai.org ) + THEN \ end of test for absence of nounlock; 19oct2011 + ELSE \ for normal direct objects; 19sep2011 + verblock @ 0 = IF \ if no verblock; test; 19oct2011 + I 8 en{ @ audjuste ! \ direct object; 10nov2012 + LEAVE \ one auditory engram is enough; 19sep2011 + THEN \ end of test for absence of nounlock; 19oct2011 + THEN \ end of test for predicate nominative; 19sep2011 + THEN \ end of test for match with motjuste; 12aug2011 + -1 +LOOP \ end of backwards search loop; 12aug2011 + nounlock @ 0 = IF \ if no nounlock override; 8oct2011 + act @ 20 < IF \ if no subject of thought is found; 21aug2011 + subjectflag @ 1 = IF \ default to "I" only as subject 17oct2011 + 701 motjuste ! \ 701=I default concept of AI Mind; 10nov2012 + midway @ t @ DO \ + I 0 psi{ @ 701 = I 7 psi{ @ 0 > AND IF \ 10nov2012 + I 1 psi{ @ defact @ > IF \ if higher act found; 9oct2011 + I tsels ! \ retain time of subject; 9oct2011 + I tseln ! \ retain time of motjuste; 9oct2011 + I 6 psi{ @ verblock ! \ lock onto valid verb; 12oct2011 + I 1 psi{ @ defact ! \ dynamic metric; 9oct2011 + THEN \ end of test for higher-act ego-concept; 9oct2011 + THEN \ end of search for least-inhibited "50=I"; 9oct2011 + -1 +LOOP \ End of loop finding "50=I"; 9oct2011 + 701 subjpsi ! \ for use elsewhere; 10nov2012 + 701 topic ! \ for question-asking modules; 10nov2012 + 1 nphrnum ! \ for EnArticle and VerbPhrase; 6oct2011 + 7 nphrpos ! \ prevent article "A" with "I"; 6oct2011 + 1 subjnum ! \ for use elsewhere; 16aug2011 + 1 prsn ! \ for use elsewhere; 16aug2011 + midway @ t @ DO \ Use parameters to find "I"; 11nov2012 + I 0 en{ @ 701 = IF \ If 701=I is found; 10nov2012 + I 4 en{ @ 1 = IF \ parameter dba=1? 11nov2012 + I 8 en{ @ audjuste ! \ recall-vector; 10nov2012 + LEAVE \ Use the most recent engram of "I"; 16aug2011 + THEN \ end of search for nominative "I"; 11nov2012 + THEN \ End of search for 701=I; 10nov2012 + -1 +LOOP \ End of parameter-based search-loop; 11nov2012 + THEN \ end of test for "I" to become subj. not obj. 17oct2011 + THEN \ end of test for low activation warranting a default + THEN \ end of test for absence of pre-ordained nounlock; 8oct2011 + nounlock @ 0 > IF \ if positive; test; 16aug2012 + motjuste @ 701 = IF \ if 701=I is indicated; 10nov2012 + midway @ t @ DO \ Look backwards for 65=ME; 16aug2012 + I 0 en{ @ 65 = IF \ If #65 "ME" found; 16aug2012 + I 8 en{ @ audjuste ! \ "ME" engram 10nov2012 + LEAVE \ Use most recent engram of "ME"; 16aug2012 + THEN \ End of search for #65 "ME"; 16aug2012 + -1 +LOOP \ End of loop finding word "ME"; 16aug2012 + THEN \ end of special override for 65=ME; 16aug2012 + motjuste @ 707 = IF \ if 707=YOU is needed; 10nov2012 + midway @ t @ DO \ Look backwards for 56=YOU; 16aug2012 + I 0 en{ @ 56 = IF \ If #56 "YOU" found; 16aug2012 + I 8 en{ @ audjuste ! \ "YOU" engram 10nov2012 + LEAVE \ Use most recent engram of "YOU"; 16aug2012 + THEN \ End of search for #56 "YOU"; 16aug2012 + -1 +LOOP \ End of loop finding word "YOU"; 16aug2012 + THEN \ end of special override for 56=YOU; 16aug2012 + THEN \ end of test for a positive nounlock; 16aug2012 + dirobj @ 1 = IF \ When seeking direct object; 13jun2011 + nounlock @ 0 = IF \ if no nounlock override; 8oct2011 + act @ 20 < IF \ If activation too low; 13jun2011 + WhatAuxSVerb \ ask question for lack of dirobj 30jul2011 + EXIT \ Abandon rest of NounPhrase; 13jun2011 + THEN \ End of test for sufficient activation; 13jun2011 + THEN \ end of test for a nounlock in play; 8oct2011 + THEN \ End of test for direct object; 13jun2011 + \ The following code for the irregular English noun "child" + \ serves as example code for the many German or Russian + \ irregular nouns that a "DeKi" or "PyYm" AI must deal with. + motjuste @ 112 = IF \ irregular "112=CHILD"; 10nov2011 + nphrnum @ 2 < IF \ if singular is needed; 10nov2011 + midway @ t @ DO \ search backwards; 10nov2011 + I 0 en{ @ 525 = IF \ 525=CHILD; 11nov2012 + I 8 en{ @ audjuste ! \ for SpeechAct; 10nov2011 + LEAVE \ one engram is enough; 10nov2011 + THEN \ end of test for CHILD-engram; 10nov2011 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for singular 525=CHILD; 11nov2012 + nphrnum @ 2 = IF \ 10nov2011 + midway @ t @ DO \ search backwards; 10nov2011 + I 0 en{ @ 526 = IF \ 526=CHILDREN; 11nov2012 + I 8 en{ @ audjuste ! \ for SpeechAct; 10nov2011 + LEAVE \ one engram is enough; 10nov2011 + THEN \ end of test for CHILDREN-engram; 10nov2011 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for plural 526=CHILDREN; 11nov2012 + THEN \ end of special handling of irregular 525=CHILD; + motjuste @ 701 = IF \ if 701=I selected; 10nov2012 + 1 prsn ! \ first person; 29aug2010 + 1 num ! \ singular; 29aug2010 + 1 nphrnum ! \ singular; 30aug2010 + THEN \ end of test for 50=I; 29aug2010 + EnDamp + motjuste @ hipsi ! + 0 anset ! ( Insert "AN" article before vowels. ) + \ MindForth may start treating "AN" as inflected "A"; 13sep2011 + aud @ 0 aud{ @ 65 = IF 65 anset ! THEN ( if vowel A ) + aud @ 0 aud{ @ 69 = IF 69 anset ! THEN ( if vowel E ) + aud @ 0 aud{ @ 73 = IF 73 anset ! THEN ( if vowel I ) + aud @ 0 aud{ @ 79 = IF 79 anset ! THEN ( if vowel O ) + aud @ 0 aud{ @ 85 = IF 85 anset ! THEN ( if vowel U ) + \ Following code covers also "audjuste"; 21oct2011 + audjuste @ 0 aud{ @ 65 = IF 65 anset ! THEN ( if A ) + audjuste @ 0 aud{ @ 69 = IF 69 anset ! THEN ( if E ) + audjuste @ 0 aud{ @ 73 = IF 73 anset ! THEN ( if I ) + audjuste @ 0 aud{ @ 79 = IF 79 anset ! THEN ( if O ) + audjuste @ 0 aud{ @ 85 = IF 85 anset ! THEN ( if U ) + whoflag @ 0 = IF \ If not answering a who-is query; 23jul2010 + \ EnArticle \ Give a chance, not an order; 23jul2010 + nphrnum @ 1 = IF \ not default zero; 4nov2011 + \ EnArticle \ for true singular; 4nov2011 + THEN \ end of test for 1=singular; 4nov2011 + 0 whoflag ! \ Here instead of at InStantiate; 23jul2010 + THEN \ End of test for zero whoflag; 23jul2010 + whoflag @ 1 = IF \ If answering a who-is query; 26aug2011 + EnArticle \ answer with Is-a etc.; 26aug2011 + 0 whoflag \ zero out after use; 26aug2011 + THEN \ end of whoflag test; 26aug2011 + num @ 1 = IF \ If num(ber is singular; 10ap2010 + EnPronoun \ Prepare to substitute he she it; 10apr2010 + THEN \ End of test of num(ber); 10apr2010 + motjuste @ 701 = NOT IF \ if not 701=I; 10nov2012 + motjuste @ 707 = NOT IF \ not 707=you; 10nov2012 + motjuste @ 731 = NOT IF \ 731=WE; 10nov2012 + 3 prsn ! \ not I YOU WE; 29aug2010 + THEN \ end of test for 731=WE; 10nov2012 + THEN \ end of test for 707=YOU; 10nov2012 + THEN \ end of test for "not I" 29aug2010 + motjuste @ nacpsi ! + ( could use "subjectflag" for test below; 18oct2010 ) + dirobj @ 0 = IF \ only let subjects call NounAct; 17oct2010 + NounAct + THEN \ end of test originating in JavaScript AI; 17oct2010 + 0 nacpsi ! + 0 nounval ! + 66 caller ! \ test; 26sep2010 + motjuste @ urpsi ! \ test; 17oct2010 + PsiDamp \ to prevent interference; 17oct2010 + 0 caller ! \ reset after use; 26sep2010 + 0 urpsi ! \ reset for safety; 24sep2010 + 66 caller ! \ test; 12oct2010 + objold @ urpsi ! \ test; 12oct2010 + 0 caller ! \ reset after use; 12oct2010 + 0 urpsi ! \ reset for safety; 12oct2010 + -8 tsels @ 1 psi{ ! \ Let subjects re-surface; 12oct2011 + predflag @ 1 = dirobj @ 1 = OR IF \ test; 29may2011 + -16 tseln @ 1 psi{ ! \ test; 12oct2011 + THEN \ only inhibit predicate nominatives; 11sep2010 + predflag @ 1 = IF \ helps for Is-a; 15sep2010 + EnArticle \ say "A" or "THE"; 15sep2010 + THEN \ end of test; 15sep2010 + audjuste @ aud ! + aud @ 0 > IF \ avoid ERROR; 19sep2010 + SpeechAct \ Display or speak the selected noun-phrase. + 0 anset ! \ Reset for safety; 21oct2011 + THEN \ end of test for 0=aud ERROR; 19sep2010 + predflag @ 1 = dirobj @ 1 = OR IF \ both; 23jun2011 + -32 t @ 1 - 1 psi{ ! \ inhibit new noun-node; 27sep2010 + -32 t @ 1 psi{ ! \ AI is now robust enough; 5aug2011 + THEN \ only inhibit predicate nominatives; 12sep2010 + -16 t @ 1 - 1 psi{ ! \ Even shallower; 12oct2011 + -16 t @ 1 psi{ ! \ Even shallower; 12oct2011 + 32 EMIT + fyi @ 2 > IF CR + ." from NounPhrase " + THEN + motjuste @ topic ! + instnum @ topicnum ! + dirobj @ 1 = predflag @ 1 = OR IF \ if set; 24sep2010 + 66 caller ! \ test; 26seo2010 + motjuste @ urpsi ! \ prepare to psi-damp motjuste; 24sep + PsiDamp \ knock down activation of non-subject; 24sep2010 + 0 caller ! \ test; 26sep2010 + 0 urpsi ! \ reset for safety; 24sep2010 + THEN \ end of test for a non-subject (pro)noun; 24sep2010 + 0 act ! + 0 aftjux ! \ reset for safety; 27jul2011 + 0 anset ! \ reset for safety; 21oct2011 + 0 jux ! \ reset for safety; 27jul2011 + 0 nounlock ! \ after causing selection of VPhr seq-noun 8oct2011 + 0 prejux ! \ reset for safety; 27jul2011 + 0 psi ! + 0 psi3 ! \ reset for safety 27jul2011 +; ( http://code.google.com/p/mindforth/wiki/NounPhrase ) + + +: ConJoin + questype @ 370 = IF \ 370=WHY; 10nov2012 + 344 conj ! \ 344=BECAUSE; 10nov2012 + ELSE 302 conj ! \ 302=AND; 10nov2012 + THEN ( http://www.taygeta.com/forth.html ) + midway @ t @ DO + I 0 en{ @ conj @ = IF + conj @ motjuste ! + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 0 questype ! +; ( http://code.google.com/p/mindforth/wiki/ConJoin ) + + +: VerbGen ( stub of verb-generation module; 15nov2012 ) + \ VerbGen uses "audbase" as a starting point in auditory + \ memory for the transfer of a left-justified verb first + \ into AudBuffer and then as a right-justified word into + \ OutBuffer so that inflectional endings ("-S": "-ING") + \ may be added to or subtracted from the word in memory. + \ http://www.scn.org/~mentifex/Dushka.html is Russian AI + \ with major use of VerbGen, which will also be used in + \ http://www.scn.org/~mentifex/DeKi.txt German Wotan AI. +; \ End of stub of VerbGen module for verb-generation. + + +\ The VerbPhrase module aims for the following entelechy goals. +\ [ ] If no predicate nominative is known, detour into a question. +\ [ ] If no transitive verb is most active, default to verb of being. +\ [ ] If no direct object is found, detour into asking a question. +\ 7dec2009 If no verb is found for a noun, defer to SelfRef NOT-KNOW. +\ [ ] If a transitive verb is most active, try to find direct object. +\ [X] Find whatever verb is most active after a noun-phrase. +\ Verb-selection shifts from en{ array to psi{ array on 12aug2011. +: VerbPhrase ( supervise verb syntax ) + verblock @ 0 > IF \ positive verbloc? 20oct2011 + verblock @ 6 psi{ @ nounlock ! \ test; 20oct2011 + THEN \ end of test for a positive verblock; 20oct2011 + 0 subjectflag ! \ for only absolute SpreadAct; test; 4aug2011 + EnReify + 0 act ! + 0 aud ! + 0 kibosh ! \ for de-activating non-selectees; 17aug2011 + 0 motjuste ! + verblock @ 0 > IF \ already a verblock? 20oct2011 + verblock @ 0 en{ @ verbpsi ! \ lexical verbpsi 13nov2012 + verblock @ 8 en{ @ audbase ! \ VerbGen parameter 13nov2012 + subjpsi @ 701 = subjpsi @ 731 = OR IF 1 prsn ! THEN \ I or WE + subjpsi @ 707 = subjpsi @ 737 = OR IF 2 prsn ! THEN \ YOU + subjpsi @ 713 = subjpsi @ 719 = OR IF 3 prsn ! THEN \ HE; SHE + subjpsi @ 725 = subjpsi @ 743 = OR IF 3 prsn ! THEN \ IT THEY + prsn @ dba ! \ from DeKi; parameter for VerbGen; 21dec2012 + \ verblock @ 8 en{ @ vphraud ! \ tentatively; 10nov2012 + 0 vphraud ! \ until a known verb is found; 22dec2012 + midway @ t @ DO \ from Wotan AI; search lexicon; 22dec2012 + I 0 en{ @ verbpsi @ = IF \ 1: same psi? 22dec2012 + I 8 en{ @ 0 > IF \ skip InF lacking aud; 22dec2012 + I 8 en{ @ vphraud ! \ tentatively; 22dec2012 + THEN \ end of check for positive rv; 22dec2012 + THEN \ end of parameter test; 22dec2012 + -1 +LOOP \ end of loop searching lexicon; 22dec2012 + THEN \ end of test for a positive verblock; 20oct2011 + 8 opt ! + 0 psi ! + 0 vphract ! \ for validity of threshold-tests; 15aug2011 +\ 0 vphraud ! \ prevent spurious carry-overs; 3oct2011 +\ 0 vphraud ! \ commenting out as a test; 22dec2012 + adverbact 32 > IF + ( EnAdverb ) + THEN ( http://theforthsource.com ) + fyi @ 1 > IF CR + ." VerbPhrase preview with slosh-over indicated by + --" + CR + ." Disparate verb-node activations slosh " \ 7nov2010 + ." over onto candidate objects." CR ." " \ 7nov2010 + THEN + verblock @ 0 = IF \ prevent false negations; 20oct2011 + midway @ t @ DO \ Search backwards through psi concepts. + I 5 psi{ @ 8 = IF \ if 8=pos verb; 12aug2011 + I 1 psi{ @ act @ > IF ( if psi1 is higher 12aug2011 ) + I tselv ! \ retain time of winning verb; 8may2011 + tselv @ kibosh @ < IF \ if different 17aug2011 + \ ." KIBOSH = " kibosh @ . \ 17aug2011 + 0 kibosh @ 1 psi{ ! \ deactivate also-ran; 17aug2011 + THEN \ end of comparison; 17aug2011 + I kibosh ! \ time of predecessor cand 17aug2011 + I 0 psi{ @ motjuste ! ( store psi-tag of verb 12aug2011 ) + I 3 psi{ @ negjux ! ( record any 250=NOT; 21dec2012 ) + ( insert diagnostic code here; 7sep2011 ) + verblock @ 0 > IF \ if positive verblock exists; 8oct2011 + I verblock @ = IF \ upon reaching engram; 8oct2011 + I tselv ! \ time of sel. of verb; 30jul2012 + I 0 psi{ @ motjuste ! \ grab verblock psi; 8oct2011 + 64 act ! \ to pass threshold-test; 20oct2011 + I 3 psi{ @ negjux ! \ for negation of verb; 9oct2011 + I 8 en{ @ vphraud ! \ for SpeechAct; 10nov2012 + I 6 psi{ @ nounlock ! \ after verb grab seq; 12oct2011 + LEAVE \ prevent usurpation of pre-ordained seq; 7oct2011 + THEN \ end of test for Index = verblock; 8oct2011 + THEN \ end of test for positive verblock; 8oct2011 + I 1 psi{ @ 0 > IF \ positive activation; 12aug2011 + I 3 psi{ @ psi3 ! ( Check for negation; 25jun2011 ) + verblock @ 0 = IF \ test; 20oct2011 + I 3 psi{ @ negjux ! ( be-verb negation; 9oct2011 ) + THEN \ end of avoidance of false negation; 20oct2011 + I 6 psi{ @ tqv ! \ underailable qtv; 12oct2011 + THEN \ end of test for positive activation; 27jul2011 + I 5 psi{ @ predpos ! ( Grab winning part of speech 12aug2011 ) + I 8 en{ @ vphraud ! ( auditory recall-vector 10nov2012 ) + I 1 psi{ @ act ! ( to test for a higher psi1 12aug2011 ) + THEN ( http://win32forth.sourceforge.net ) + THEN \ end of test for opt=8 verbs; 8sep2011 + -1 +LOOP \ end of loop cycling back through psi concepts + THEN \ end of verblock-test to prevent false negations; 20oct2011 + verblock @ 0 > IF \ if positive verblock exists; 20oct2011 + verblock @ 0 psi{ @ motjuste ! \ verblock override; 21oct2011 + verblock @ 3 psi{ @ negjux ! \ capture any 250=NOT; 21dec2012 + vphraud @ 0 = IF \ prevent override of selection 22dec2012 + verblock @ 8 en{ @ vphraud ! \ auditory recall-v; 10nov2012 + THEN \ end of test to prevenmt override; 22dec2012 + 64 act ! \ prevent rejection of selection; 20oct2011 + THEN \ end of test for positive verblock; 20oct2011 + tqv @ 0 psi{ @ svo3 ! \ test; 29sep2011 +\ 128 tqv @ 1 psi{ ! \ accentuate tqv-seq; 29sep2011 + tqv @ 0 > IF 128 tqv @ 1 psi{ ! THEN \ test; 24jan2012 + act @ vphract ! \ for threshold comparisons; 21jun2011 + act @ verbval ! + 0 psi ! + fyi @ 2 > IF + CR ." VerbPhrase: motjuste = " motjuste @ . + ." going into SPEECH." + CR ." VerbPhrase: aud = " aud @ . + ." going into SPEECH." + THEN + motjuste @ 0 = IF + nphrnum @ 1 = IF \ 21jun2011 + mfnflag @ 0 > IF \ if masc. or fem.; 30jul2011 + fyi @ 2 = IF ." VPhr calls WhoBe" THEN \ 4jul2012 + WhoBe \ ask WHO not WHAT; 30jul2011 + 0 mfnflag ! \ reset after use; 30jul2011 + EXIT \ abandon rest of VerbPhrase + THEN \ end of test for positive mfnflag; 30jul2011 + fyi @ 2 = IF ." VPhr calls WhatBe" THEN \ 6jul2012 + WhatBe \ for a what-is question; test; 21jun2011 + EXIT \ abandon rest of VerbPhrase; 2jul2011 + THEN \ 21jun2011 + nphrnum @ 2 = IF \ 2jul2011 + fyi @ 2 = IF ." VPhr calls WhatAuxSDo" THEN \ 6jul2012 + WhatAuxSDo \ what do Subjects do? 2jul2011 + 1 yncon ! \ after input ask yes-or-no question + EXIT \ abandon rest of VerbPhrase; 2jul2011 + THEN \ end of test for plural noun; 2jul2011 + THEN + motjuste @ 0 > IF + vphract @ 20 < IF \ a test ICW WhoBe; 21jun2011 + nphrnum @ 1 = IF \ 21jun2011 + mfnflag @ 0 > IF \ if masc. or fem.; 30jul2011 + fyi @ 2 = IF ." VerbPhr calls WhoBe" THEN \ 4jul2012 + WhoBe \ ask WHO not WHAT; 30jul2011 + 0 mfnflag ! \ reset after use; 30jul2011 + EXIT \ abandon rest of VerbPhrase + THEN \ end of test for positive mfnflag; 30jul2011 + fyi @ 2 = IF ." VerbPhr calls WhatBe" THEN \ 6jul2012 + WhatBe \ for a what-is question; test; 21jun2011 + EXIT \ abandon rest of VerbPhrase; 30jul2011 + THEN \ 21jun2011 + nphrnum @ 2 = IF \ 2jul2011 + fyi @ 2 = IF ." VPhr calls WASD" THEN \ 6jul2012 + WhatAuxSDo \ what do Subjects do? 2jul2011 + 1 yncon ! \ after input ask yes-or-no question + EXIT \ abandon rest of VerbPhrase; 2jul2011 + ELSE \ if "nphrnum" neither 1 nor 2; 15aug2011 + EXIT \ to avoid a spurious thought; 15aug2011 + THEN \ end of test for plural noun; 2jul2011 + THEN \ End of test of vphract; 21jun2011 + psi3 @ 250 = negjux @ 250 = OR IF \ 10nov2012 + motjuste @ 800 = NOT IF \ 10nov2012 + AuxVerb \ to say "DO" or "DOES" 25jun2011 + midway @ t @ DO \ Search En(glish) array; 25jun2011 + \ I 0 en{ @ 12 = IF \ Look for "NOT"; 25jun2011 + I 0 en{ @ 250 = IF \ Look for "NOT"; 29dec2012 + I 8 en{ @ aud ! \ Auditory start-tag 10nov2012 + LEAVE \ One instance of NOT suffices; 25jun2011 + THEN \ End of lexical test for 250=NOT; 19dec2012 + -1 +LOOP \ End of loop searching for 250=NOT; 29dec2012 + SpeechAct \ Say the word "NOT"; 25jun2011 + 0 psi3 ! \ reset for safety; 27jul2011 + THEN \ end of test to not say do w. be-verbs; 28jul2011 + THEN \ end of test for psi3 jux negation; 25jun2011 + motjuste @ 800 = NOT IF \ if not a be-verb; 10nov2012 + nphrnum @ 1 = IF \ 14aug2011 + prsn @ 3 = IF \ Only for third person; 8may2011 + 83 flex1 ! \ for flex1,2,3 (-S; -ING); 11sep2011 + 1 vpos ! \ 14aug2011 + THEN \ End of test for 3rd person (sing) 8may2011 + THEN \ end of test fof singular; 14aug2011 + THEN \ end of test for not a be-verb; 14aug2011 + motjuste @ hipsi ! + motjuste @ 830 = IF \ irregular 830=DO; 10nov2012 + subjnum @ 1 = prsn @ 3 = AND IF \ 5oct2011 + midway @ t @ DO \ search backwards; 5oct2011 + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd pers? 10nov2012 + I 8 en{ @ vphraud ! \ 10nov2012 + LEAVE \ one engram is enough; 5oct2011 + THEN \ end of test for third person 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for 830=DO; 10nov2012 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for 3rd person singular; 5oct2011 + THEN \ end of special handling of 59=DO; 5oct2011 + \ The following code for the irregular English verb + \ "to have" serves as example code for the many German + \ irregular verbs that a polyglot AI must deal with. + motjuste @ 810 = IF \ irregular 810=HAVE; 10nov2012 + subjnum @ 1 = prsn @ 3 = AND IF \ 13aug2011 + midway @ t @ DO \ search backwards; 13aug2011 + I 0 en{ @ 810 = IF \ 810=HAVE 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd pers? 10nov2012 + I 8 en{ @ vphraud ! \ 10nov2012 + LEAVE \ one engram is enough; 13aug2011 + THEN \ end of test for 3rd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for HAS-engram; 13aug2011 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for 3rd person singular; 13aug2011 + THEN \ end of special handling of 70=HAVE; 13aug2011 + motjuste @ 800 = IF \ present-tense be-verb? 10nov2012 + 1 predflag ! \ for sake of NounPhrase; 26aug2011 + subjnum @ 1 = IF \ singular subject number; 16aug2011 + prsn @ 1 = IF \ first person; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 57 = IF \ 57=AM; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 57=AM; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for first person; 16aug2011 + prsn @ 2 = IF \ singular or plural; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 67 = IF \ 67=ARE; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 67=ARE; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for second person; 16aug2011 + prsn @ 3 = IF \ third person; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 66 = IF \ 66=IS; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 66=IS; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for third person; 16aug2011 + THEN \ end of test for singular; 16aug2011 + subjnum @ 2 = IF \ if plural subject; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 67 = IF \ 67=ARE; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 67=ARE; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for plural number; 16aug2011 + THEN \ end of two-step be-verb substitution; 16aug2011 + motjuste @ 800 = IF \ 800=BE; 10nov2012 + subjpsi @ 701 = IF \ 701=I; 10nov2012 + midway @ t @ DO \ search En(glish) array; 21aug2011 + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + 800 motjuste ! ( Set verbform to "BE" 10nov2012 ) + 800 urpsi ! ( parameter for PsiDamp 10nov2012 ) + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 1 = IF \ 1st pers? 10nov2012 + I 8 en{ @ vphraud ! \ SpeechAct 10nov2012 + LEAVE \ recent "AM" is enough 12aug2011 + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of two-step test to say "AM"; 12aug2011 + -1 +LOOP \ end of backwards loop; 12aug2011 + THEN \ end of test for "50=I" subject-psi; 12aug2011 + subjpsi @ 707 = IF ( 707=YOU; 10nov2012 ) + midway @ t @ DO \ 8aug2011 + I 0 en{ @ 800 = IF \ 800=BE 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 2 = IF \ 2nd pers? 10nov2012 + I 8 en{ @ vphraud ! \ 10nov2012 + LEAVE \ 8aug2011 + THEN \ end of test for 2nd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for 800=BE: 10nov2012 + -1 +LOOP \ 8aug2011 + THEN \ 8aug2011 + THEN \ end of test for 58=BE; 13aug2011 + motjuste @ 800 = IF \ 800=BE; 10nov2012 + subjpsi @ 701 = IF \ 701=I; 10nov2012 + midway @ t @ DO \ search En(glish) array; 11aug2011 + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + 800 motjuste ! ( Set verbform to "BE" 10nov2012 ) + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 1 = IF \ 1st pers? 10nov2012 + I 8 en{ @ vphraud ! \ SpeechAct 10nov2012 + LEAVE \ finding recent "AM" is enough 11aug2011 + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP \ end of backwards loop; 11aug2011 + THEN \ end of test for "50=I" subject-psi; 11aug2011 + THEN \ end of test for be-verb 67=ARE; 11aug2011 + motjuste @ 58 = IF \ shift from BE; 27aug2010 + num @ 1 = IF \ singular; 27aug2010 + prsn @ 1 = IF \ if first person; 29aug2010 + midway @ t @ DO \ search backwards in time + I 0 en{ @ 57 = IF \ recent 57=AM; 12sep2010 + I 8 en{ @ aud ! \ get recall-vector + LEAVE \ after finding recent "AM"; 29aug2010 + THEN \ end of test for 67=AM; 29aug2010 + -1 +LOOP \ end of retrieval loop for "AM"; 29aug2010 + 0 prsn ! \ reset after use; 29aug2010 + THEN \ end of test for 1st person sing; 29aug2010 + prsn @ 3 = IF \ if third person; 12sep2010 + midway @ t @ DO \ search backwards in time + I 0 en{ @ 66 = IF \ most recent instance + 66 motjuste ! ( 66=IS; 27aug2010 ) + I 8 en{ @ aud ! \ get recall-vector + LEAVE \ after finding recent "IS"; 28aug2010 + THEN \ end of test for 66=IS; 27aug2010 + -1 +LOOP \ end of retrieval loop for "IS"; 27aug2010 + THEN \ end of test for 3rd person sing; 12sep2010 + THEN \ end of test for singular; 27aug2010 + ( following code covers undeclared plurals; 27aug2010 ) + num @ 1 = NOT IF \ other than singular; 27aug2010 + midway @ t @ DO \ search backwards in time + I 0 en{ @ 67 = IF \ most recent instance + 67 motjuste ! ( 67=ARE; 27aug2010 ) + I 8 en{ @ aud ! \ get recall-vector + LEAVE \ after finding recent "ARE"; 27aug2010 + THEN \ end of test for 67=ARE; 27aug2010 + -1 +LOOP \ end of retrieval loop for "ARE"; 27aug2010 + THEN \ end of test for not singular; 27aug2010 + THEN \ end of test for 58=BE; 27aug2010 + 0 subjectflag ! \ for SpreadAct slosh-over; 18oct2010 + motjuste @ vacpsi ! \ prepare to deglobalize; 27sep2010 + motjuste @ verbpsi ! \ for WhatAuxSVerb; 13jun2011 + VerbAct + 0 vacpsi ! \ reset for safety; 27sep2010 + nphrnum @ 2 = NOT IF \ if not plural; test; 30aug2010 + 1 nphrnum ! \ default to singular; test; 30aug2010 + THEN \ end of test for plural nphrnum; 30aug2010 + motjuste @ 800 = NOT IF \ 10nov2012 + prsn @ 3 = IF \ 3rd person? 29aug2010 + nphrnum @ 1 = IF \ test; 30aug2010 + \ 83 flex1 ! \ xfer "S" to SpeechAct; 11sep2011 + \ 83 flex1 ! \ VerbGen should be used instead 29dec2012 + THEN \ end of test for singular nphrnum; 30aug2010 + THEN \ end of test for 3rd person; 29aug2010 + THEN \ end of test for not a be-verb; 29jul2012 + vphraud @ aud ! \ transfer just before call; 25jun2011 + SpeechAct ( main call from VerbPhrase to SpeechAct ) + VerbClear \ deactivate before inhibiting; 17aug2011 + -32 t @ 1 - 1 psi{ ! \ inhibit new verb-node; 3sep2011 + -32 t @ 1 psi{ ! \ inhibit new verb-node; 3sep2011 + 0 flex1 ! \ reset for safety; 11sep2011 + 0 vphraud ! \ reset for safety; 25jun2011 + 0 vpos ! + motjuste @ 800 = IF \ 10nov2012 + negjux @ 250 = IF \ 250=NOT; 10nov2012 + midway @ t @ DO \ Search En(glish) array; 27jul2011 + I 0 en{ @ 250 = IF \ Look for "NOT 10nov2012 + I 8 en{ @ aud ! \ Auditory start-tag 10nov2012 + LEAVE \ One instance of NOT suffices; 27jul2011 + THEN \ End of lexical test for 12=NOT; 27jul2011 + -1 +LOOP \ End of loop searching for 250=NOT 10nov2012 + \ 7 EMIT \ audible report of saying NOT; test; 28aug2011 + SpeechAct \ Say the word "NOT"; 27jul2011 + 0 aftjux ! \ reset for safety; 27jul2011 + 0 negjux ! \ reset for safety; 9oct2011 + 0 prejux ! \ reset for safety; 27jul2011 + 0 jux ! \ reset for safety; 27jul2011 + 0 psi3 ! \ reset for safety; 27jul2011 + THEN \ end of test for negated be-verb; 27jul2011 + THEN \ end of test for be-verb; 27jul2011 + THEN \ end of test for positive motjuste; 29aug2010 + 10 act ! + motjuste @ urpsi ! + 62 caller ! + PsiDamp \ Necessary for chain of thought; 24oct2010 + 0 caller ! + EnDamp + \ Following lines inhibit old KB verb-node; 13jun2011 + -32 tselv @ 1 psi{ ! \ Shallow inhibition; 3sep2011 + 0 tselv ! \ Reset tselv after use; 13jun2011 + 32 EMIT + 1 dirobj ! + subjpsi @ 701 = IF \ only for subject 701=I; 10nov2012 + motjuste @ 820 = IF \ only for verb 820=SEE; 10nov2012 + svo3 @ 0 = IF \ if SEE has no direct object; 22sep2011 + VisRecog \ a challenge for robot AI coders 22sep2011 + SpeechAct \ say default from VisRecog; 22sep2011 + EXIT \ abandon rest of VerbPhrase; 22sep2011 + THEN \ end of test for direct object; 22sep2011 + THEN \ end of test for "820=SEE"; 10nov2012 + THEN ( http://code.google.com/p/robotbridgeware ) + motjuste @ 800 = IF 1 predflag ! THEN \ 800=BE; 10nov2012 + ( EnAdjective -- a possibility here; 24aug2011 ) + NounPhrase + 0 predflag ! \ reset for safety; 12sep2010 + motjuste @ 0 > IF motjuste @ dopsi ! THEN + 0 dirobj ! + 0 negjux ! \ reset for safety; 9oct2011 + 0 numflag ! \ 3dec2009 Whether used here or in BeVerb. + 0 predflag ! \ Reset for safety; 26aug2011 + 0 psi3 ! \ reset for safety; 27jul2011 + 0 svo3 ! \ use once per thought; 9sep2011 + 0 tqv ! \ reset for safety; 29sep2011 + 0 verblock ! \ after causing selection of NPhr seq-verb; 8oct2011 +; ( http://code.google.com/p/mindforth/wiki/VerbPhrase ) + + +: InFerence ( create silent triples for machine reasoning ) + 1 moot ! \ prevent interference; test; 20dec2012 +\ CR ." InFer: subjnom prednom = " \ test; 1jan2012 +\ subjnom @ . prednom @ . CR \ test; 1jan2013 + midway @ t @ DO \ search IdeaPlex to infer facts; 18dec2012 + prednom @ 0 > IF \ positive predicate nominative? 1jan2012 + I 0 psi{ @ prednom @ = IF \ KB data? 18dec2012 + I 4 en{ @ 1 = IF \ nominative? 18dec2012 + seqverb @ 0 = IF \ only once; 18dec2012 + I 6 psi{ @ seqtqv ! \ transfer; 18dec2012 + I 7 psi{ @ seqverb ! \ transfer; 18dec2012 + I 7 psi{ @ quverb ! \ for AskUser; 27dec2012 + 0 ynverb ! \ for one AskUser question; 27dec2012 + \ 2 nphrnum ! \ test; remove; 27dec2012 + \ 2 nphrnum ! \ Commenting out as obsolete; 1jan2013 + seqverb @ seq ! \ test; 18dec2012 + THEN \ end of test for not-yet-declared; 18dec2012 + \ CR ." InFer: t psi seqverb = " \ test; 27dec2012 + \ I . prednom @ . seqverb @ . \ 18dec2012; 27dec2012 + \ LEAVE \ at first make only one inference; 18dec2012 + ELSE \ no nominative prednom? 1jan2012 + CR ." No inference can be made." \ test; 1jan2013 + THEN \ end of test for nominative; 18dec2012 + THEN \ end of test for finding prednom facts; 18dec2012 + THEN \ end of test for positive predicate nominative 1jan2012 + -1 +LOOP \ end of backwards loop; 18dec2012 +\ CR ." InFer: subjnom prednom seqverb = " \ test; 2jan2012 +\ subjnom @ . prednom @ . seqverb @ . \ test; 2jan2013 + seqverb @ 0 > IF \ verb available for inference? 2jan2013 + t @ inft ! \ for AskUser to find auditory engrams 25dec2012 + 1 t +! \ increment time "t" by one for a gap; 18dec2012 + 1 t +! \ increment time to create an inference; 18dec2012 + subjnom @ t @ 0 psi{ ! \ subj of inference; 18dec2012 + 48 t @ 1 psi{ ! \ activation of inf. 20dec2012 + 2 t @ 2 psi{ ! \ num(ber) test; replace; 20dec2012 + 5 t @ 5 psi{ ! \ pos=5 noun; 18dec2012 + t @ 1 + t @ 6 psi{ ! \ psi6=tqv; 18dec2012 + seqverb @ seq ! \ prevent override? test 20dec2012 + seqverb @ t @ 7 psi{ ! \ seq is the verb; 18dec2012 + subjnom @ t @ 8 psi{ ! \ enx; 18dec2012 + subjnom @ t @ 0 en{ ! \ for .en report; 21dec2012 + 2 t @ 2 en{ ! \ default num(ber) 21dec2012 + 1 t @ 4 en{ ! \ default nominative; 20dec2012 + \ 5 t @ 6 en{ ! \ default 5=pos noun; 20dec2012 + 0 t @ 8 en{ ! \ pseudo-recall-tag; 21dec2012 + 1 t +! \ increment t for storage of verb; 18dec2012 + seqverb @ t @ 0 psi{ ! \ verb of inference; 18dec2012 + seqverb @ t @ 1 - 7 psi{ ! \ retroactive seq? 20dec2012 + subjnom @ t @ 4 psi{ ! \ pre of verb; 18dec2012 + 8 t @ 5 psi{ ! \ pos=8 verb; 18dec2012 + t @ 1 + t @ 6 psi{ ! \ psi6=tqv; 20dec2012 + seqtqv @ 7 psi{ @ t @ 7 psi{ ! \ seq 18dec2012 + seqtqv @ 7 psi{ @ dobseq ! \ test; 22dec2012 + seqverb @ t @ 8 psi{ ! \ enx; 18dec2012 + seqverb @ t @ 0 en{ ! \ so verb can be found; 22dec2012 + 1 t +! \ increment t to store direct object; 18dec2012 + seqtqv @ 7 psi{ @ t @ 0 psi{ ! \ dir. obj 18dec2012 + 40 t @ 1 psi{ ! \ activation of direct object 22dec2012 + seqtqv @ 7 psi{ @ t @ 8 psi{ ! \ enx 18dec2012 + dobseq @ t @ 0 en{ ! \ so noun can be found; 22dec2012 + dobseq @ quobj ! \ for AskUser; 27dec2012 + 1 t +! \ increment time "t" for an ending gap; 18dec2012 + 1 yncon ! \ for AskUser to ask yes-or-no question 26dec2012 + subjnom @ qusub ! \ transfer to AskUser; 26dec2012 + THEN \ end of test for a verb to be part of inference 2jan2013 + 0 becon ! \ reset after use; 18dec2012 + 0 dobseq ! \ reset after use; 22dec2012 + 0 moot ! \ reset after use; 20dec2012 + 0 prednom ! \ reset after use; 18dec2012 + 0 seqtqv ! \ reset after use; 18dec2012 + 0 seqverb ! \ reset after use; 18dec2012 + 0 subjnom ! \ reset after use; 18dec2012 +\ QUIT \ test; remove; 18dec2012 +\ Task: Make InFerence work also with pronouns and antecedents; +\ Task: Make InFerence work with ideas negated by "NOT". +; ( http://code.google.com/p/mindforth/wiki/InFerence ) + + +: DeCog ( Deutsch Cognition -- thinking in DeKi German AI ) + CR ." Achtung! German input flips thinking into German." +( HauptWort \ Call a German NounPhrase module; 20jul2011 ) +( ZeitWort \ Call a German VerbPhrase module; 20jul2011 ) +; ( http://code.google.com/p/mindforth ) + + +: EnCog ( English Cognition -- thinking in English ) + 0 moot ! \ may have been set in previous thought; 24oct2011 + 0 morphpsi ! + 0 psi ! + 0 sublen ! + t @ tov ! + becon @ 1 = IF \ if flag set in OldCOncept; 18dec2012 + InFerence \ call the passively reflective module; 18dec2012 + THEN \ end of test for input of a be-verb statement; 18dec2012 + yncon @ 1 = IF \ if flag set in VerbPhrase; 2jul2011 + AskUser \ for a yes-or-no question; 2jul2011 + EXIT \ abandon rest of EnCog; 2jul2011 + THEN ( http://www.mpeforth.com ) + yesorno @ 0 > IF + SayYes + CR + EXIT + THEN + 400 rsvp ! \ Give user time to respond. 23aug2010 + inert @ 10 > IF \ if no input start thinking; 17oct2011 + cogpsi @ 0 > IF \ 17oct2011 + cogpsi @ topic ! \ for query-subject; 17oct2011 + cognum @ topicnum ! \ to select "IS" or "ARE"; 22oct2011 + fyi @ 2 = IF ." EnCog calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 cognum ! \ reset for safety; 22oct2011 + 0 cogpsi ! \ reset for safety; 17oct2011 + EXIT \ abandon the rest of EnCog; 17oct2011 + THEN \ 17oct2011 + kbtv @ 1 = IF \ in cycle of KbTraversal; 17oct2011 + 707 topic ! \ 707=YOU as topic of question; 10nov2012 + 7 nphrpos ! \ pronoun "YOU" part-of-speech; 21oct2011 + 2 prsn ! \ parameter second-person YOU; 17oct2011 + 1 subjnum ! \ singular YOU as a parameter; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhoBe" THEN \ 4jul2012 + CR WhoBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + IQ @ 3 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv1 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + THEN \ end of #1 test of rotating "kbtv"; 17oct2011 + kbtv @ 2 = IF \ in rotation of KbTraversal; 17oct2011 + 571 topic ! \ let 571=ROBOT be subject; 10nov2012 + 5 nphrpos ! \ noun part-of-speech; 17oct2011 + 3 prsn ! \ parameter needed for AuxVerb; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + 1 indefmust ! \ for "A ROBOT"; 20oct2011 + 1 subjnum ! \ for singular "ROBOT"; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 indefmust ! \ reset for safety; 20oct2011 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ borrowing IQ as a control; 17oct2011 + 1 subjnum ! \ for singular "ROBOT"; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv2 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 3 = IF \ borrowing IQ as a control; 17oct2011 + 2 subjnum ! \ for plural "ROBOTS"; 17oct2011 + fyi @ 2 = IF ." EnCog-kbtv2 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + THEN \ end of #2 test of rotating "kbtv"; 17oct2011 + kbtv @ 3 = IF \ in rotation of KbTraversal; 17oct2011 + 701 topic ! \ 701=I; 10nov2012 + 7 nphrpos ! \ pronoun "I" part-of-speech; 21oct2011 + 1 prsn ! \ parameter first-person I; 17oct2011 + 1 subjnum ! \ singular I as a parameter; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhoBe" THEN \ 4jul2012 + CR WhoBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv3 calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + IQ @ 3 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnCog-kbtv3 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + THEN \ end of #3 test of rotating "kbtv"; 17oct2011 + kbtv @ 4 = IF \ in rotation of KbTraversal; 17oct2011 + 533 topic ! \ 533=GOD for AI theology discussion; 10nov2012 + 3 prsn ! \ parameter third-person GOD; 17oct2011 + 1 subjnum ! \ singular GOD as a parameter; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhoBe" THEN \ 4jul2012 + CR WhoBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv4 calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + IQ @ 3 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv4 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + THEN \ end of #4 test of rotating "kbtv"; 17oct2011 + THEN \ end of arbitrary delay before initiating thought + ( exceptional think was above; normal thinking below here ) + CR ." Robot: " + 123 t @ 2 aud{ ! + t @ tov ! \ 12jan2010 "{" marks start of thought. + NounPhrase \ First of two Chomskyan bifurcations. + VerbPhrase \ Second of two Chomskyan bifurcations. + 0 nphrnum ! \ Reset intersyntactic variable; 11oct2011 + 0 pcn ! \ Reset for safety; 17jul2012 + 0 prednom ! \ reset for InFerence; 27dec2012 + 0 prox2 ! \ Reset after use; 7sep2011 + 0 prox3 ! \ Reset after use; 7sep2011 + 0 proxcon ! \ Reset after use; 7sep2011 + 0 putnum ! \ reset for safety; 4nov2011 + 0 quo ! \ 5jan2010 Reset after use. + 0 subjnom ! \ reset for InFerence; 27dec2012 + 5 bias ! + 0 qup ! \ 10jan2010 Must be at zero to be used again. + PsiDecay \ Reduce activation after each thought; 4aug2011 +; ( http://code.google.com/p/mindforth/wiki/EnCog ) + + +: ThInk ( calls EnCog to think in English; 20sep2010 ) + 0 ordo ! + 35 pov ! \ internal ASCII 35=# point-of-view; 16oct2011 + glot @ 1 = IF \ flag for polyglot AI; 20jul2011 + EnCog ( think in English; 20jul2011 ) + THEN ( http://www.aicore.co.uk ) + glot @ 2 = IF \ upon input of multiple German words; + DeCog ( think in Deutsch -- German; 20jul2011 ) + THEN \ end of test for language-choice in polyglot AI + fyi @ 1 = IF CR THEN + 0 ordo ! + rjc @ 1 < IF \ if AI on but not yet ReJuvenated; 19sep2010 + lurk @ greet @ > IF \ if limit exceeded; 19sep2010 + 100 rsvp ! \ slow down the display; 19sep2010 + -1 lurk ! \ reset for safety; 19sep2010 + kbtv @ 4 > IF 1 kbtv ! THEN \ test; 19sep2010 + 1 kbtv +! \ cycle through values; 19sep2010 + KbTraversal \ if no input, begin thinking; 19sep2010 + THEN ( http://www.forth.com ) + THEN \ end of test of ReJuvenation-count (rjc); 19sep2010 +; ( http://code.google.com/p/mindforth/wiki/ThInk ) + + +: MotorOutput ( stub for autonomous control of robots ) + 7 EMIT + ( MOVE_FORWARD ) + ( MOVE_BACKWARDS ) + ( STOP_MOTION ) + ( TURN_LEFT ) + ( TURN_RIGHT ) +; ( http://code.google.com/p/mindforth/wiki/MotorOutput ) + + +: TuringTest ( Human-Computer Interaction ) + fyi @ 0 = IF CLS CR CR CR CR CR CR CR + t @ 476 < IF CR \ "vault" after SEE and NOTHING; 22sep2011 + ." There is no warranty for MindForth AI for robots." + ELSE CR + THEN + THEN + fyi @ 1 = NOT IF CR THEN + ." " + fyi @ 1 = NOT IF CR THEN + fyi @ 0 = IF + CR + ." Artificial intelligence alive and thinking since " + bday @ . + bmonth @ 1 = IF ." January " THEN + bmonth @ 2 = IF ." February " THEN + bmonth @ 3 = IF ." March " THEN + bmonth @ 4 = IF ." April " THEN + bmonth @ 5 = IF ." May " THEN + bmonth @ 6 = IF ." June " THEN + bmonth @ 7 = IF ." July " THEN + bmonth @ 8 = IF ." August " THEN + bmonth @ 9 = IF ." September " THEN + bmonth @ 10 = IF ." October " THEN + bmonth @ 11 = IF ." November " THEN + bmonth @ 12 = IF ." December " THEN + byear @ . 8 EMIT 46 EMIT CR + THEN + fyi @ 1 = NOT IF + ." Time = " t @ . 8 EMIT 46 EMIT + ." KB-Traversal ID = " kbtv @ . + 8 EMIT 46 EMIT + ." IQ = " IQ @ . 8 EMIT 46 EMIT + ." Cyc = " rjc @ . ." delay = " rsvp @ . 8 EMIT 46 EMIT + CR ." ENTER a positive or negative Subj-Verb-Obj " + ." unpunctuated sentence." + CR + THEN + fyi @ 0 = IF CR + ." Display-mode is normal. Press Tab for other modes; " + ." ESC to exit." + CR + THEN + fyi @ 3 = IF CR + ." Diagnostic messages - ignore during input " + ." before pressing ENTER." + THEN + 42 pov ! +; ( http://code.google.com/p/mindforth/wiki/TuringTest ) + + +: SeCurity ( new wiki-page name for SECURITY module ) + fyi @ 2 = IF CR + ." SeCurity calls HCI TuringTest module." + THEN + TuringTest + t @ cns @ 64 - > IF + fyi @ 2 = IF CR + ." SeCurity module calls ReJuvenate." + THEN + ReJuvenate + THEN + t @ cns @ > IF \ Use midway only for larger Minds 13aug2012 + t @ cns @ - midway ! ( for limit on searches; 13aug2012 ) + ELSE \ If the CNS memory has a small capacity 13aug2012 + 1 midway ! \ Avoid any "array boundary problem"; 13aug2012 + THEN \ Future code may let an AI itself set midway 13aug2012 + 0 quiet ! +; ( http://code.google.com/p/mindforth/wiki/SeCurity ) + + +: MainLoop ( changed from ALIFE for wiki doc page ) + TIME&DATE byear ! bmonth ! bday ! bhour ! bminute ! bsec ! + TabulaRasa + EnBoot + BEGIN + SeCurity + fyi @ 2 = IF CR + ." MainLoop calls the SensoryInput module." CR + THEN + SensoryInput + ( EmotiOn ) + fyi @ 2 = IF CR CR \ create gap; 6jul2012 + ." MainLoop calls the ThInk mind-module." CR + THEN + ThInk + ( FreeWill ) + ( MotorOutput ) + AGAIN +; ( http://code.google.com/p/mindforth/wiki/MainLoop ) + + +: ALIFE ( Call MainLoop if not called by user. ) + MainLoop +; diff --git a/Mind.F b/Mind.F new file mode 100755 index 0000000..b732578 --- /dev/null +++ b/Mind.F @@ -0,0 +1,5173 @@ +( 24jan13A.F -- modification of 2jan13A.F MindForth ) +( Released under GNU General Public License V2 ) +( http://gpl-violations.org -- see NYT Sun.26.SEP.2010. ) +( May be ported to new language and app store marketed. ) +( May be named "Mind.F" or any "Filename.F" you choose. ) +( Rename any Mind.F.txt as simply Mind.F for Win32Forth. ) +( http://home.planet.nl/~josv/w32for42_671.exe ) +( http://prdownloads.sourceforge.net/win32forth/W32FOR42_671.zip?download ) +( http://code.google.com/p/mindforth/wiki/IntelForth ) +( http://store.kagi.com/cgi-bin/store.cgi?storeID=AMP_Live ) +( http://www.winzip.com/aboutzip.htm tells about WinZip. ) +( Download and unzip W32FOR42_671.zip to run MindForth. ) +( Run the AI with Win32Forth by issuing three commands: ) +( win32for.exe [ENTER] ) +( fload Mind.f [ENTER] ) +( MainLoop [ENTER]. ) +( To halt the AI Mind, press the ESCAPE key at any time. ) +( Ask or answer questions about MindForth AI on Usenet. ) +( AI codebase below fills blank space with Usenet links ) +( http://groups.google.com/group/comp.lang.forth/topics ) +( http://www.scn.org/~mentifex/DeKi.txt German Wotan AI ) +( http://www.scn.org/~mentifex/DeKiUser.html AI Manual ) +( http://www.scn.org/~mentifex/mindforth.txt Win32Forth ) +( http://www.scn.org/~mentifex/AiMind.html in JavaScript ) +( http://www.scn.org/~mentifex/Dushka.html is Russian AI ) +( http://www.scn.org/~mentifex/RuAiUser.html AI Manual ) +( http://bookstore.iuniverse.com/Products/SKU-000540906/AI4U.aspx ) +( http://www.amazon.com/The-Art-Meme-ebook/dp/B007ZI66FS ) +( http://code.google.com/p/mindforth/wiki/UserManual ) +( Please make a copy of this AI and host it on your website. ) +( http://code.google.com/p/mindforth/wiki/ChangeLog data ) +\ 12nov12A.F moves input words through AudBuffer and OutBuffer. +\ 15nov12A.F stubs in the VerbGen module for generating verbs. +\ 20dec12A.F introduces InFerence module for machine reasoning. +\ 21dec12A.F troubleshoots InFerence with diagnostic messages. +\ 22dec12A.F finds alternate auditory engrams for inferences. +\ 25dec12A.F achieves inferences about new input not held in KB. +\ 27dec12A.F feeds inference into AskUser for a yes-or-no query. +\ 28dec12A.F displays internal mental time and ReJuvenate count. +\ 29dec12A.F asks user to confirm or deny inference; adjusts KB. +\ 2jan13A.F prevents inference about a subject lacking a verb. +\ 23jan13A.F troubleshoots the comprehension of objectless verbs. +\ 24jan13A.F comprehends quasi-intransitive verbs without objects. +DECIMAL ( use decimal numbers ) +variable abc ( AudBuffer transfer character; 8nov2012 ) +variable act 0 act ! ( activation level ) +variable actbase ( AudRecog discrimination activation base) +variable actran ( PsiDecay holder of act-levels; 16may2011 ) +variable adverbact 0 adverbact ! ( 29aug2008 adverb test ) +variable adjcon ( insert-adjective condition-flag; 16sep2011 ) +variable aftjux ( after-jux for negation of verb of being ) +variable anset ( Before vowel set article AN insertion ) +variable atcd ( 30dec2009 "antecedent" for EnPronoun ) +variable aud ( auditory recall-tag for activating engrams) +variable audbase ( recall-vector for VerbGen; 8nov2012 ) +variable audjuste ( NounPhrase motjuste aud to SpeechAct ) +variable audme ( tag to find "ME" in auditory memory ) +variable audnum ( de-globalizing the "num" variable; 8nov2012 ) +variable audpsi ( de-globalizing the "psi" variable ) +variable audrec ( 6may2009 replacing "psi" in AudRecog ) +variable audrun 1 audrun ! ( counter of loops through AudRecog ) +variable audstop ( flag to stop SpeechAct after one word ) +variable audverb ( psi number of an input verb; 27dec2012 ) +variable b01 ( buffer character 01 in OutBuffer; 12nov2012 ) +variable b02 ( buffer character 02 in OutBuffer; 12nov2012 ) +variable b03 ( buffer character 03 in OutBuffer; 12nov2012 ) +variable b04 ( buffer character 04 in OutBuffer; 12nov2012 ) +variable b05 ( buffer character 05 in OutBuffer; 12nov2012 ) +variable b06 ( buffer character 06 in OutBuffer; 12nov2012 ) +variable b07 ( buffer character 07 in OutBuffer; 12nov2012 ) +variable b08 ( buffer character 08 in OutBuffer; 12nov2012 ) +variable b09 ( buffer character 09 in OutBuffer; 12nov2012 ) +variable b10 ( buffer character 10 in OutBuffer; 12nov2012 ) +variable b11 ( buffer character 11 in OutBuffer; 12nov2012 ) +variable b12 ( buffer character 12 in OutBuffer; 12nov2012 ) +variable b13 ( buffer character 13 in OutBuffer; 12nov2012 ) +variable b14 ( buffer character 14 in OutBuffer; 12nov2012 ) +variable b15 ( buffer character 15 in OutBuffer; 12nov2012 ) +variable b16 ( buffer character 16 in OutBuffer; 12nov2012 ) +variable bday ( day of birth reveals oldest living AI Mind) +variable becon 0 becon ! ( detect be-verb for InFerence 18dec2012 ) +variable beflag 0 beflag ! ( 23apr2009 for InStantiate ) +variable beg 1 beg ! ( "beginning" flag for word engrams ) +variable bhour ( hour of birth for user interface display ) +variable bias 5 bias ! ( Parser; newConcept: expected POS ) +variable binc ( OutBuffer "b" increment for VerbGen 12nov2012 ) +variable bminute ( minute of birth: user interface display) +variable bmonth ( month of birth: user interface display ) +variable bsec ( second of birth: user interface display) +variable byear ( MainLoop; TuringTest HCI -- year of birth) +variable c01 ( character in AudBuffer; 12nov2012 ) +variable c02 ( character in AudBuffer; 12nov2012 ) +variable c03 ( character in AudBuffer; 12nov2012 ) +variable c04 ( character in AudBuffer; 12nov2012 ) +variable c05 ( character in AudBuffer; 12nov2012 ) +variable c06 ( character in AudBuffer; 12nov2012 ) +variable c07 ( character in AudBuffer; 12nov2012 ) +variable c08 ( character in AudBuffer; 12nov2012 ) +variable c09 ( character in AudBuffer; 12nov2012 ) +variable c10 ( character in AudBuffer; 12nov2012 ) +variable c11 ( character in AudBuffer; 12nov2012 ) +variable c12 ( character in AudBuffer; 12nov2012 ) +variable c13 ( character in AudBuffer; 12nov2012 ) +variable c14 ( character in AudBuffer; 12nov2012 ) +variable c15 ( character in AudBuffer; 12nov2012 ) +variable c16 ( character in AudBuffer; 12nov2012 ) +variable caller ( debug-identifier of calling module ) +variable cns 2048 cns ! ( MindGrid size; doubled 3aug2012 ) +variable coda 128 coda ! ( memory recycled in ReJuvenate) +variable cognum ( grammatical number of cogpsi; 22oct2011 ) +variable cogpsi ( new noun being learned; 17oct2011 ) +variable conj ( OldConcept; ConJoin: conjunction ) +variable ctu ( continuation-flag for "Aud" array phonemes ) +variable dba ( case for nouns; person for verbs; 8nov2012 ) +variable defact ( default activation for NounPhrase; 9oct2011 ) +variable defartcon ( set definite article condition ) +variable dirobj ( indicates seeking for a direct object ) +variable dobseq ( for transfer within InFerence; 22dec2012 ) +variable dopsi ( direct-object-psi to calculate "thotnum") +variable edge 0 edge ! ( Rejuvenate: edge-of-thought flag) +variable en8 ( EnVocab recall-vector "aud" in Rejuvenate ) +variable enx ( holds concept-number in transfer to English) +variable eot ( end-of-text for use in AudInput ) +variable fex ( holds fiber-out concept up from Psi memory ) +variable fin ( holds fiber-in concept for Psi array access) +variable firstword ( for identifying input of a query 19aug2011 ) +variable flex1 ( "I" or "S" element of SpeechAct inflection ) +variable flex2 ( "N" as part of "ING" SpeechAct inflection ) +variable flex3 ( "G" as part of "ING" SpeechAct inflection ) +variable fyi 0 fyi ! ( rotates through display modalities ) +variable fyipsi ( psi source-node in SpreadAct; 17oct2011 ) +variable gencon ( VerbGen status flag from Wotan; 22dec2012 ) +variable ghost 0 ghost ! ( to switch from "a" to "the" ) +variable glot 1 glot ! ( flag for which language to think in ) +variable greet 640 greet ! ( greeting-trigger; 16oct2010 ) +variable guspsi ( concept-tag attached to taste-memories ) +variable gusrec ( for external recognition by GusRecog ) +variable hipsi ( "high-psi" tag on wavecrest concept ) +variable hl ( possible standard instead of "glot"; 20aug2011 ) +variable holdnum ( transfer from subject to verb; 8nov2012 ) +( I = Index in loops; does not require a fetch "@" ) +variable img ( visRecog: for future use as "image" ) +variable indefartcon ( set indefinite article condition ) +variable indefmust ( force saying of "A" or "AN"; 20oct2011 ) +variable inert 0 inert ! ( marker of no recent interaction ) +variable inft ( inference-time for AskUser 27dec2012 ) +variable instnum ( instantiation number for WhatBe questions ) +variable IQ 1 IQ ! ( an invitation to code an IQ algorithm) +variable jrt ( ReJuvenate "junior time" for memories moved) +variable jux 0 jux ! ( holds Psi # of a JUXtaposed word ) +variable kbcon ( flag for awaiting a yes-or-no answer 2jul2011 ) +variable kbpsi ( 20jan2008 an interim knowledge-base psi ) +variable kbquiz 0 kbquiz ! ( flag to call kbSearch ) +variable kbtv 0 kbtv ! ( KbTraversal trigger; 7aug2010 ) +variable kbtqv ( time of seq-concept found in KB; 7oct0211 ) +variable kbyn ( holds kbtv values for asking Y/N 24jun2011 ) +variable kibosh ( suppresses concepts failing to win selection ) +variable krt ( Knowledge Representation time "t" for later) +variable lastpho ( 24may2009 to avoid extra "S" on verbs ) +variable lastword 0 lastword ! ( for zeroing "seq" tags.) +variable len ( length, for avoiding non-words in AudInput) +variable lexact ( testing a lexical "act" for EnReify ) +variable lopsi ( "low-psi" tag on just-crested concept ) +variable lurk ( counter to activate initial thinking; 19sep2010 ) +variable match ( end-of-word flag for control ) +variable memoire ( instead of "motjuste" in kbSearch ) +variable mfn ( "masculine feminine neuter" gender flag ) +variable mfnflag ( gender flag to cause a who-query; 17aug2010 ) +variable midway 1 midway ! ( limit for searching backwards) +variable monopsi ( 26jul2002 For use in audRecog module ) +variable moot ( flag to prevent associations in DO-queries ) +variable morphpsi ( for audRecog recognition of morphemes ) +variable motjuste ( best word for inclusion in a thought ) +variable nacpsi ( 9may2009 de-globalized psi for NounAct) +variable negjux ( flag for 12=NOT juxtaposed to a verb; 9oct2011 ) +variable nen 0 nen ! ( English lexical concept number ) +variable newpsi ( for singular-nounstem assignments ) +variable nlt 0 nlt ! ( not-later-than among time-points ) +variable nounlock ( for a verb to lock onto a seq-nounl 8oct2011 ) +variable nounval 0 nounval ! ( from NounPhrase to MounAct ) +variable nphrnum 0 nphrnum ! ( NounPhrase number ) +variable nphrpos 0 nphrpos ! ( for testing in EnCog ) +variable num 0 num ! ( number-flag for the psi array ) +variable numflag ( 4dec2009 for selection of verb-forms ) +variable numsubj ( 13apr2010 for number of subject ) +variable nwc ( new-word-count for noun-stem recog ) +variable objold ( a test for optimizing slosh-over; 12oct2010 ) +variable obstat ( Lets AudInput psi-damp a reentrant word.) +variable ocn ( old-concept-number for EnVocab; 14oct2011 ) +variable oldact ( show the source of spreading activations) +variable oldpos ( old part-of-speech for use with verbs ) +variable oldpsi ( used in OldConcept to de-globalize "psi") +variable olfpsi ( concept-tag attached to smells in memory) +variable olfrec ( for external recognition by OlfRecog ) +variable onset 0 onset ! ( of an auditory memory engram ) +variable opt ( option, for flushing out a part of speech ) +variable ordo 0 ordo ! ( from JSAI; AudInput word-order ) +variable pcn ( predicate concept number; 17jul2012 ) +variable penultpho ( 17may2009 next-to-last phoneme ) +variable pho ( phoneme of input/output & internal reentry ) +variable phodex 0 phodex ! ( pho-index for AudBuffer 14nov2012 ) +variable pos ( old- & newConcept; enVocab: part-of-speech) +variable pov ( point-of-view: #35 internal; *42 external ) +variable prc ( provisional recognition in AudRecog; 27dec2012 ) +variable pre ( previous concept associated with a concept ) +variable precand ( inviolate "pre" candidate from JSAI ) +variable predflag ( indicates predicate nominative 11sep2010 ) +variable prednom ( predicate nominative for InFerence; 18dec2012 ) +variable predpos 0 predpos ! ( Predicate part of speech ) +variable prejux ( previous jux to carry NOT to verb 21jul2011 ) +variable prepho ( 17may2009 previous phoneme ) +variable prepsi ( synaptic deglobalized "pre" in SpreadAct) +variable preset 0 preset ! ( for setting InStantiate "pre") +variable prevtag ( from JSAI; for use in InStantiate ) +variable prox1 ( first proximate concept of input cluster ) +variable prox2 ( for determining association among engrams ) +variable prox3 ( for ReActivate to impose unequal activation ) +variable proxcon ( flag to indicate usage of prox variables ) +variable prsn 0 prsn ! ( 1st, 2nd, 3rd person ) +variable psi ( identifier of a psi concept in Psi mindcore) +variable psi1 ( activation-level at each node of verb ) +variable psi3 0 psi3 ! ( for VerbPhrase to find negation 25jun2011 ) +variable psi8 ( tutorial enx in tutorial or diagnostics; 12oct2011 ) +variable psibase ( winning psibase with winning actbase ) +variable putdbav ( putative dba for verbs; 27dec2012 ) +variable putnum ( putative number for subj-verb agreement ) +variable questype ( oldConcept; Conjoin: "question-type" ) +variable quiet 1 quiet ! ( status flag for auditory input ) +variable quo ( 27dec2009 query-object for EnCog response ) +variable quobj ( query-object for yes-or-no questions 24jun2011 ) +variable qup ( 28dec2009 query-predicate if verb not given ) +variable qusub ( internal provisional query-subject; 3oct2010 ) +variable quverb ( query-verb for yes-or-no questions 24jun2011 ) +variable recnum ( recognized number of a recognized word 19jul2011 ) +variable retropsi ( for AudInput and Audmem noun-stems ) +variable residuum 0 residuum ! ( activation after PsiDamp ) +variable rjc 0 rjc ! ( rejuvenation counter for tracking ) +variable rsvp 1000 rsvp ! ( user-response delay-counter) +variable rv ( "recall-vector" for diagnostic display ) +variable scn ( subject concept number; 17jul2012 ) +variable seq ( subSEQuent concept associated with another) +variable seqneed ( noun/pronoun or verb needed as a "seq" ) +variable seqpos ( "seq" concept part-of-sppeech 1oct2011 ) +variable seqpsi ( synaptic deglobalized "seq" in SpreadAct) +variable seqtqv ( for transfer during InFerence; 18dec2012 ) +variable seqverb ( interstitial carrier for InFerence; 18dec2012 ) +variable singflag ( singularity flag for singular nouns ) +variable snu ( subj# as parameter for verb-selection 21dec2012 ) +variable spacegap ( to add gap of one space in SpeechAct ) +variable spike ( 1aug2005: for potential use in SpreadAct) +variable spt ( AudMem; AudInput: blank space time ) +variable stemgap ( for avoiding false audRecog stems ) +variable stempsi ( for singular noun-stem recognition ) +variable subj ( flag to supercharge subject-nouns ) +variable subjectflag ( 3dec2009 a default for NounPhrase ) +variable subjnom ( subject-nominative for InFerence; 18dec2012 ) +variable subjnum ( for agreement with predicate nominative ) +variable subjold ( old subject as default candidate 28sep2010 ) +variable subjpsi ( parameter to govern person of verb-forms ) +variable sublen ( length of audRecog subpsi word-stem ) +variable subpsi ( for AudRecog of sub-component wordstems ) +variable supsi ( subject-psi for calculating "thotnum" ) +variable svo2 ( second item among subj-verb-obj; 3sep2011 ) +variable svo3 ( third item among subj-verb-obj; 28aug2011 ) +variable t 0 t ! ( time incremented during AudMem storage) +variable t2s ( auditory text-to-speech index for SpeechAct) +variable tacpsi ( concept-tag attached to tactile engrams) +variable tacrec ( for external recognition by TacRecog ) +variable tbev ( time of be-verb for use with aftjux 27jul2011 ) +variable tkbn ( time of KbRetro noun adjustment; 2jul2011 ) +variable tkbv ( time of KbRetro verb adjustment; 2jul2011 ) +variable topic ( topic for a question to be asked ) +variable topicnum ( grammatical number of question "topic" ) +variable tov 1 tov ! ( time-of-voice for keeping track ) +variable tpeg ( pegging the time-slice of a subject-noun ) +variable tqv ( tempus quod vide for specific psi instance ) +variable transcon 1 transcon ! ( transitive verb? 24jan2013 ) +variable trc ( 20dec2009 tabula-rasa-counter like rjc ) +variable tsday ( for AudListen transcript-mode headers ) +variable tseln ( time of selection of noun; 8may2011 ) +variable tselo ( time of selection of object 30jul2011 ) +variable tsels ( time of selection of subj. 28jul2011 ) +variable tselv ( time of selection of verb; 8may2011 ) +variable tshour ( AudListen ) +variable tsminute ( AudListen ) +variable tsmonth ( AudListen ) +variable tsn ( time of seqneed for InStantiate; 1jul2012 ) +variable tssecond ( AudListen ) +variable tsyear ( AudListen ) +variable tult ( t penultimate, or time-minus-one ) +variable unk ( "unknown" variable for general use ) +variable upnext ( Flag lets new input de-crest previous. ) +variable urpre ( original pre during call to other module ) +variable urpsi ( original psi for use in psiDamp, etc. ) +variable vacpsi ( de-globalized psi for VerbAct; 27sep2010 ) +variable vault 611 vault ! ( size of EnBoot; 8nov2012 ) +variable vbpsi ( verb-psi for calculating "thotnum" ) +variable verblock ( for subject-noun to lock onto seq-verb; 8oct2011 ) +variable verbpsi ( for transit into WhatAuxSVerb 13jun2011 ) +variable verbval ( transfer from VerbPhrase to VerbAct ) +variable vispsi ( concept-tag attached to images in memory) +variable visrec ( for external recognition by VisRecog ) +variable vphract ( verb phrase activation level 19jun2011 ) +variable vphraud ( holds aud-fetch for SpeechAct; 25jun2011 ) +variable vpos ( verb part of speech for inflections ) +variable vrsn 20130124 vrsn ! ( version identifier; 24jan2013 ) +variable whoflag 0 whoflag ! ( for InStantiate ) +variable wordend ( for singular noun-stem assignments ) +variable yesorno 0 yesorno ! ( in conjunction w. KbSearch ) +variable yncon ( statuscon to trigger yes-or-no query 2jul2011 ) +variable ynverb ( yes-or-no verb for AskUser; 24jun2011 ) +variable zone ( time-zone for "pre" and "seq" searches ) + + +: CHANNEL ( size num -< name >- ) + CREATE ( Returns address of newly named channel. ) + OVER ( #r #c -- #r #c #r ) + , ( Stores number of rows from stack to array.) + * CELLS ( Feeds product of columns * rows to ALLOT.) + ALLOT ( Reserves given quantity of cells for array.) + DOES> ( member; row col -- a-addr ) + DUP @ ( row col pfa #rows ) + ROT * ( row pfa col-index ) + ROT + ( pfa index ) + 1 + ( because first cell has the number of rows.) + CELLS + ( from number of items to # of bytes in offset ) +; + + +cns @ 9 CHANNEL psi{ ( Mindcore concept array "psi" ) +cns @ 9 CHANNEL en{ ( English lexicon array "en" ) +cns @ 6 CHANNEL aud{ ( Auditory memory channel "aud" ) + + +: PsiClear ( set Psi activations to zero; 26sep2010 ) + 1 t @ 1 + DO + 0 I 1 psi{ ! + -1 +LOOP +; ( End of PsiClear ) + + +: TabulaRasa + 0 trc ! ( 20dec2009 tabula-rasa-counter like jrc ) + 1 tov ! + BEGIN cns @ 1 DO + 0 I trc @ psi{ ! + LOOP + 1 trc +! + trc @ 9 < WHILE \ Cover 9 columns 0-8; 29sep2011 + REPEAT + 0 trc ! + 1 tov ! + BEGIN cns @ 1 DO + 0 I trc @ en{ ! + LOOP + 1 trc +! + trc @ 9 < WHILE \ Cover #0 to #8, i.e. 9; 10nov2012 + REPEAT + 0 trc ! + 1 tov ! + BEGIN cns @ 1 DO + 0 I trc @ aud{ ! + LOOP + 1 trc +! + trc @ 6 < WHILE + REPEAT + cns @ 1 DO + 32 I 0 aud{ ! + LOOP +; ( End of TabulaRasa ) + + +\ NounClear is a mechanism called by NounPhrase to set +\ activation on nouns and pronouns to zero just before +\ a pair of old and new noun-engrams is reduced even +\ further into negative activation by neural inhibition. +\ The purpose is to prevent the build-up of stray activations. +: NounClear ( remove activation from all nouns ) \ 20dec2009 + midway @ cns @ DO \ Loop backwards over time. + I 5 psi{ @ 5 = I 5 psi{ @ 7 = OR IF \ pro(noun) 18aug2011 + I 1 psi{ @ 0 > IF \ avoid inhibited engrams; 26aug2011 + 0 I 1 psi{ ! \ 20dec2009 Set noun to zero activation. + THEN \ end of test for positive activation; 26aug2011 + THEN \ 20dec2009 End of test for pos=5 nouns. + -1 +LOOP \ End of backwards loop looking for pos=5 nouns. +; ( End of NounClear; return to NounPhrase; 18aug2011 ) + + +: VerbClear ( remove activation from all verbs ) + midway @ t @ DO + I 5 psi{ @ 8 = IF + I 1 psi{ @ 0 > IF \ avoid inhibited engrams; 26aug2011 + 0 I 1 psi{ ! + THEN \ end of test for positive activation; 26aug2011 + THEN + -1 +LOOP +; ( End of VerbClear ) + + +: VerbClip ( lower activation on all verbs ) + midway @ t @ DO + I 5 psi{ @ 8 = IF + I 1 psi{ @ 12 > IF \ test; REMOVE? 25aug2010 + 6 I 1 psi{ +! \ test; 25aug2010 + THEN + THEN + -1 +LOOP +; ( End of VerbClip; return to AudInput ) + + +: PsiDecay ( let conceptual activations dwindle ) + fyi @ 2 > IF CR + ." PsiDecay called to reduce all " + ." conceptual activations." CR + THEN + midway @ t @ DO + I 1 psi{ @ 0 > IF \ avoid inhibited nodes; 9sep2010 + I 1 psi{ @ 40 > IF 34 actran ! THEN \ 4aug2011 + I 1 psi{ @ 50 > IF 35 actran ! THEN \ 4aug2011 + I 1 psi{ @ 60 > IF 36 actran ! THEN \ 4aug2011 + I 1 psi{ @ 70 > IF 37 actran ! THEN \ 4aug2011 + I 1 psi{ @ 80 > IF 38 actran ! THEN \ 4aug2011 + I 1 psi{ @ 90 > IF 39 actran ! THEN \ 4aug2011 + actran @ 0 > IF actran @ I 1 psi{ ! THEN \ 16may2011 + 0 actran ! \ Reset to zero for safety; 16may2011 + I 1 psi{ @ 1 - I 1 psi{ ! + THEN \ end of test to skip inhibited nodes; 9sep2010 + I 1 psi{ @ 0 < IF 1 I 1 psi{ +! THEN \ 6sep2010 + I 0 psi{ @ 830 = IF 0 I 1 psi{ ! THEN \ 830=DO + I 0 psi{ @ 781 = IF 0 I 1 psi{ ! THEN \ 781=WHAT + I 0 psi{ @ 117 = IF 0 I 1 psi{ ! THEN \ 117=THE + -1 +LOOP +; ( http://code.google.com/p/mindforth/wiki/PsiDecay ) + + +: PsiDamp ( reduce activation of a concept ) + ( 33-48 = consciousness tier where concepts win selection. ) + ( 17-32 = subconscious where concepts remain available. ) + ( 1-16 = noise tier below logical association threshold. ) + 16 residuum ! + fyi @ 2 > IF CR + ." PsiDamp called for urpsi = " urpsi @ . + ." by module ID #" caller @ . + caller @ 42 = IF ." WhatAuxSDo " THEN + caller @ 51 = IF ." AuxVerb " THEN + caller @ 62 = IF ." VerbPhrase " THEN + caller @ 66 = IF ." NounPhrase " THEN + caller @ 104 = IF ." AudInput " THEN + caller @ 148 = IF ." Activate " THEN + caller @ 3535 = IF ." AudInput " THEN + caller @ 6967 = IF ." EnCog " THEN \ test; 26sep2010 + caller @ 8766 = IF ." WhoBe " THEN \ test; 26sep2010 + caller @ 8773 = IF ." WhatBe " THEN \ changed; 25feb2011 + 0 caller ! + THEN + urpsi @ 791 = IF \ if urpsi is 791=WHO; 10nov2012 + 1 residuum ! \ deemphasize WHO; test; 25jul2010 + THEN \ test; 25jul2010 + ( code to prevent psi-damping inhibited concepts; 6sep2010 ) + midway @ t @ DO + I 0 psi{ @ urpsi @ = IF \ concept found; 6sep2010 + I 1 psi{ @ -1 > IF \ positive act.? 16aug2011 + residuum @ I 1 psi{ ! \ psi-damp only high activations + THEN \ end of test for only positive act.; 6sep2010 + THEN \ end of test for particular concept; 6sep2010 + -1 +LOOP + 0 residuum ! +; ( http://code.google.com/p/mindforth/wiki/PsiDamp ) + + +: EnDamp ( deactivate English lexicon concepts ) + midway @ t @ DO + 0 I 1 en{ ! + -1 +LOOP +; ( End of EnDamp ) + + +: AudDamp ( deactivate auditory engrams ) + midway @ t @ DO + 0 I 1 aud{ ! + -1 +LOOP +; ( End of AudDamp ) + + +: .psi ( show concepts in the Psi array ) + CR ." Psi mindcore concepts" + CR ." time: psi act num jux pre pos seq enx " + t @ 1+ midway @ DO + I 0 psi{ @ 0 > IF + CR I . ." : " + I 0 psi{ @ . ." " + I 1 psi{ @ . ." " + I 2 psi{ @ . ." " + I 3 psi{ @ . ." " + I 4 psi{ @ . ." " + I 5 psi{ @ . ." " + I 6 psi{ @ . ." " \ Show tqv-point; 12oct2011 + I 7 psi{ @ . ." " \ new "seq" position 12oct2011 + I 8 psi{ @ enx ! enx @ . \ new "enx"; 12oct2011 + enx @ 0 > IF + ." to " + I unk ! + 0 aud ! + midway @ unk @ DO + I 0 en{ @ enx @ = IF + I 8 en{ @ aud ! \ with dba; 10nov2012 + aud @ 0= NOT IF + BEGIN + aud @ 0 aud{ @ EMIT + 1 aud +! + aud @ 0 aud{ @ 32 = + UNTIL + ." " + THEN + 0 aud ! + LEAVE ( One engrammed word is enough. ) + THEN + -1 +LOOP + THEN + THEN + LOOP + CR ." time: psi act num jux pre pos tqv seq enx " 0 unk ! + CR ." You may enter .psi or .en or .aud to view memory " + ." engrams or " + CR ." MainLoop [ENTER] to erase all memories " + ." and restart the Mind." + CR +; ( End of .psi post-Escape report ) + + +: .en ( show vocabulary in the English lexicon array ) + CR ." English lexical fibers" + CR ." t nen act num mfn dba fex pos fin aud:" \ 18dec2012 + t @ 1+ midway @ DO + I 0 en{ @ unk ! + unk @ 0 > IF ( display positive data ) + CR I . unk @ . ." " + I 1 en{ @ . ." " + I 2 en{ @ . ." " + I 3 en{ @ . ." " + I 4 en{ @ . ." " + I 5 en{ @ . ." " \ dba; 10nov2012 + I 6 en{ @ . ." " + I 7 en{ @ . ." " + I 8 en{ @ aud ! aud @ . ." to " + BEGIN + aud @ 0 aud{ @ EMIT 1 aud +! + aud @ 0 aud{ @ 32 = + UNTIL + ." " + 0 aud ! + THEN + LOOP + 0 unk ! + CR ." t nen act num mfn dba fex pos fin aud" CR + CR ." You may enter .psi or .en or .aud to view memory " + ." engrams or " + CR ." MainLoop [ENTER] to erase all memories " + ." and restart the Mind." + CR +; ( End of .en post-Escape report ) + + +: .aud ( show engrams in the auditory memory array ) + CR ." Auditory memory nodes" + CR ." t pho act pov beg ctu audpsi" + t @ 1+ 1 DO ( Show the entire Aud channel.) + CR I . ." " + I 2 aud{ @ 123 = IF + ." { " + THEN + I 0 aud{ @ 33 < IF + ." " ( show a blank ) + ELSE + I 0 aud{ @ EMIT ." " + I 1 aud{ @ . ." " + I 2 aud{ @ EMIT ." " + I 3 aud{ @ . ." " + I 4 aud{ @ . ." " + I 5 aud{ @ . + THEN + I 2 aud{ @ 125 = IF + ." } " + THEN + I cns @ > IF QUIT THEN \ safety measure; 26jul2010 + LOOP + CR ." You may enter .psi or .en or .aud to view memory " + ." engrams or " + CR ." MainLoop [ENTER] to erase all memories " + ." and restart the Mind." + CR +; ( End of .aud post-Escape report ) + + +: .out ( show characters in the OutBuffer; 12nov2012 ) + CR ." AudBuffer word = " CR \ 15nov2012 + c01 @ EMIT c02 @ EMIT c03 @ EMIT c04 @ EMIT + c05 @ EMIT c06 @ EMIT c07 @ EMIT c08 @ EMIT + c09 @ EMIT c10 @ EMIT c11 @ EMIT c12 @ EMIT + c13 @ EMIT c14 @ EMIT c15 @ EMIT c16 @ EMIT + CR ." OutBuffer word = " CR \ 14nov2012 + b01 @ EMIT b02 @ EMIT b03 @ EMIT b04 @ EMIT + b05 @ EMIT b06 @ EMIT b07 @ EMIT b08 @ EMIT + b09 @ EMIT b10 @ EMIT b11 @ EMIT b12 @ EMIT + b13 @ EMIT b14 @ EMIT b15 @ EMIT b16 @ EMIT + CR ." 1234567890123456 " \ show right-justification + CR \ Return to left margin for Forth ok prompt. +; ( End of OutBuffer report; 12nov2012 ) + + +: .echo ( show what the robot just said ) + ( As on Usenet, user responds _below_ the AI output. ) + fyi @ 2 = IF + CR ." Tutorial mode is now in effect. " + ." Enter input or wait for output." + THEN + CR ." Robot: " + tov @ t @ = IF \ 12jan2010 Test for equality. + tov @ 1 - tov ! \ 12jan2010 Prevent infinite loops. + THEN \ 12jan2010 End of test for tov @ t equality. + t @ tov @ DO + I 0 aud{ @ 0 = IF + ." " + ELSE + I 2 aud{ @ 42 = NOT IF + I 0 aud{ @ EMIT + THEN + THEN + LOOP +; ( End of .echo ) + + +: SpreadAct ( spreading activation ) + PsiDecay \ to differentiate among activations; 10aug2012 + prepsi @ 0 > IF \ From NounAct or VerbAct; 30jun2012 + zone @ 7 - zone @ DO + I 0 psi{ @ prepsi @ = IF \ now prepsi; 15sep2010 +\ CR ." SprAct: augmenting activation at time " \ 10aug2012 +\ I . ." of prepsi " prepsi @ . \ test; 10aug2012 + \ 1 I 1 psi{ +! \ C-ing outl 10aug2012 + 8 I 1 psi{ +! \ for queries; 10aug2012 + I zone @ 6 - > IF LEAVE THEN + THEN + -1 +LOOP + THEN + seqpsi @ 0 > IF \ replacing seqsyn; 15sep2010 + fyi @ 3 = IF + CR ." SprA seqpsi & spike = " seqpsi @ . spike @ . CR + THEN + zone @ 32 + zone @ DO \ Search past non-seq psi. + I 0 psi{ @ seqpsi @ = IF \ replacement 15sep2010 + fyi @ 3 = IF + CR ." SprA matching seqpsi w. spike = " \ 24sep2010 + seqpsi @ . spike @ . CR \ non-global 24sep2010 + THEN + fyi @ 1 > IF + pov @ 35 = IF + 0 psi8 ! \ new flag-panel location of "enx"; 12oct2011 + fyi @ 3 = IF + CR ." sprdAct: seqpsi = " seqpsi @ . CR \ 24sep2010 + THEN + midway @ t @ DO + I 0 psi{ @ fyipsi @ = IF \ 17oct2011 + I 8 psi{ @ psi8 ! \ new "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ new "enx"; 12oct2011 + I 7 en{ @ rv ! + LEAVE + THEN + -1 +LOOP + 0 rv ! + midway @ t @ DO + I 0 psi{ @ seqpsi @ = IF \ 15sep2010 + I 8 psi{ @ psi8 ! \ new "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ "enx"; 12oct2011 + I 7 en{ @ rv ! + LEAVE + THEN + -1 +LOOP + rv @ 0 > IF + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + THEN + 0 rv ! + ." " + THEN + THEN \ end of FYI=1; 2aug2011 + fyi @ 2 > IF + pov @ 35 = IF + CR + 0 psi8 ! \ new "enx"; 12oct2011 + midway @ t @ DO + I 0 psi{ @ fyipsi @ = IF \ 17oct2011 + I 8 psi{ @ psi8 ! \ "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ "enx"; 12oct2011 + I 8 en{ @ rv ! \ with dba; 10nov2012 + LEAVE + THEN + -1 +LOOP + rv @ 0 > IF + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + THEN + 0 rv ! + ." #" fyipsi @ . ." act " oldact @ . \ 17oct2011 + ." at i " I . ." sprA spike " + spike @ . ." to seqpsi #" seqpsi @ . \ 20sep2010 + midway @ t @ DO + I 0 psi{ @ seqpsi @ = IF \ 15sep2010 + I 8 psi{ @ psi8 ! \ "enx"; 12oct2011 + LEAVE + THEN + -1 +LOOP + midway @ t @ DO + I 0 en{ @ psi8 @ = IF \ "enx"; 12oct2011 + I 8 en{ @ rv ! \ with dba; 10nov2012 + LEAVE + THEN + -1 +LOOP + rv @ 0 > IF + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + THEN + 0 rv ! + CR + ." at act " I 1 psi{ @ . ." yields " + THEN + THEN \ end of FYI=2+ 2aug2011 + fyi @ 3 = IF + ." SprA: spiking seqpsi " spike @ . seqpsi @ . + THEN + subjectflag @ 1 = IF \ onto verb-nodes; 18oct2010 + ( insert diagnostic code here to troubleshoot 5aug2011 ) + spike @ I 1 psi{ +! ( add spike to seqpsi 15sep2010 ) + ELSE \ in all other cases, e.g. dirobj; 25jun2011 + ( insert diagnostic code here to troubleshoot 5aug2011 ) + spike @ I 1 psi{ ! ( Xfer absolute act; 25jun2011 ) + THEN \ end of test for subject-nodes; 18oct2010 + fyi @ 2 > IF + pov @ 35 = IF + I 1 psi{ @ . + fyi @ 2 > IF + ." and zone = " zone @ . + THEN + THEN + THEN + fyi @ 3 = IF + I 1 psi{ @ . ." (lim = 63) for t=" I rv ! + BEGIN + -1 rv +! + rv @ 3 aud{ @ 1 = + UNTIL + rv @ . + BEGIN + rv @ 0 aud{ @ EMIT 1 rv +! + rv @ 0 aud{ @ 32 = + UNTIL + ." engram; in sprA spike = " spike @ . + 0 rv ! + THEN + I zone @ 6 + > IF + fyi @ 2 > IF + CR ." executing LEAVE at zone = " zone @ . + THEN + LEAVE + THEN + LEAVE \ After finding one seqpsi; 13oct2010 + THEN \ end of test for matching Psi#; 8aug2011 + LOOP + THEN +; ( http://code.google.com/p/mindforth/wiki/SpreadAct ) + + +: NounAct ( re-activate all recent nodes of a concept ) + 0 unk ! \ reset before using in NounAct; 8aug2011 + 28 nounval ! \ test; 1sep2011 + fyi @ 2 > IF CR \ 5jan2010 Altering the next line: + ." Calling NounAct (not in AI4U). nacpsi = " nacpsi @ . CR + THEN + nacpsi @ 0 > IF + fyi @ 2 > IF + CR ." NounAct calls SpreadAct to transfer " + CR ." proportionate activation from each node of " + CR ." concept #" psi @ . + THEN + midway @ t @ DO + I 0 psi{ @ nacpsi @ = IF + -3 unk +! \ for decrementing spike over time; 8aug2011 + ( insert diagnostic code here; 7sep2011 ) + I 1 psi{ @ -1 > IF \ avoid inhibition; 3sep2011 + nounval @ I 1 psi{ ! \ 3sep2011 + THEN ( http://greenarraychips.com ) + I 0 psi{ @ 781 = IF \ 781=WHAT; 10nov2012 + 0 I 1 psi{ ! + THEN ( http://www.calcentral.com/~forth/forth ) + 12 spike ! ( Aim for ample spikes.) + I 4 psi{ @ prepsi ! ( for SpreadAct 15sep2010 ) + I 7 psi{ @ seqpsi ! ( for SpreadAct 12oct2011 ) + I zone ! ( for use in SpreadAct ) + I 1 psi{ @ 0 = IF 0 spike ! THEN + I 1 psi{ @ 5 > IF 12 spike ! THEN + I 1 psi{ @ 10 > IF 24 spike ! THEN \ 3nov2010 + I 1 psi{ @ 15 > IF 26 spike ! THEN \ 3nov2010 + I 1 psi{ @ 20 > IF 28 spike ! THEN \ 3nov2010 + I 1 psi{ @ 25 > IF 30 spike ! THEN \ 4jun2011 + I 1 psi{ @ 30 > IF 32 spike ! THEN \ 4jun2011 + I 1 psi{ @ 35 > IF 34 spike ! THEN \ 4jun2011 + I 1 psi{ @ 40 > IF 36 spike ! THEN \ 4jun2011 + I 1 psi{ @ 45 > IF 38 spike ! THEN \ 4jun2011 + I 1 psi{ @ 50 > IF 40 spike ! THEN \ 4jun2011 + I 1 psi{ @ 55 > IF 42 spike ! THEN \ 4jun2011 + I 1 psi{ @ 60 > IF 44 spike ! THEN \ 4jun2011 + nacpsi @ fyipsi ! \ 17oct2011 + I 1 psi{ @ oldact ! + I 5 psi{ @ oldpos ! + seqpsi @ 0 > IF \ replacement; 15sep2010 + seqpsi @ 791 = IF \ 791=WHO; 10nov2012 + 1 spike ! \ not 24 act; 11aug2010 + THEN \ end of experiment; 11aug2010 + ( insert diagnostic code here; 8aug2011 ) + unk @ -10 < IF -10 unk ! THEN \ limit decrement 8aug2011 + unk @ spike +! \ decrement spike; 8aug2011 + 7865 caller ! + SpreadAct ( for spreading activation ) + 0 caller ! + 0 prepsi ! \ replacing presyn; 15sep2010 + 0 seqpsi ! \ replacing seqsyn; 15sep2010 + THEN + precand @ pre ! + 0 oldpos ! + 0 fyipsi ! \ 17oct2011 + 0 oldact ! + 0 pre ! + THEN + 0 spike ! \ reset for each new loop; 14oct2010 + -1 +LOOP + THEN + 0 spike ! +; ( http://code.google.com/p/mindforth/wiki/NounAct ) + + +: VerbAct ( re-activate all recent nodes of a verb ) + 17 verbval ! \ lowering to promote warranted assoc; 27aug2011 + fyi @ 2 > IF CR + ." Calling verbAct (not in AI4U). psi = " psi @ . CR + THEN + vacpsi @ 0 > IF \ if a vacpsi exists; 9nov2010 + fyi @ 2 > IF + CR ." VerbAct calls SpreadAct to transfer " + CR ." proportionate activation from each node of " + CR ." concept #" psi @ . + THEN + vacpsi @ fyipsi ! \ a replacement variable; 17oct2011 + midway @ t @ DO + I 0 psi{ @ vacpsi @ = IF \ deglobalized psi; 8oct2010 + fyi @ 2 > IF + I 1 psi{ @ 8 > IF + ." +" + THEN + THEN + I 1 psi{ @ psi1 ! + I 1 psi{ @ -1 > IF \ avoid inhibited nodes; 9sep2010 + ( insert diagnostic code here; 27aug2011 ) + moot @ 0 = IF \ deprive queries of tags; 20aug2011 + verbval @ I 1 psi{ +! \ CUMULATIVE for slosh-over. + THEN \ end of test for a moot query input; 20aug2011 + THEN \ end of test to skip inhibited nodes; 9sep2010 + I 0 psi{ @ 781 = IF \ 781=WHAT; 11nov2012 + 0 I 1 psi{ ! + THEN + I 4 psi{ @ prepsi ! ( for SpreadAct 15sep2010 ) + I 7 psi{ @ seqpsi ! ( for SpreadAct 12oct2011 ) + I zone ! ( for use in SpreadAct ) + I 1 psi{ @ 0 = IF 0 spike ! THEN + I 1 psi{ @ 0 > IF 1 spike ! THEN + I 1 psi{ @ 5 > IF 3 spike ! THEN + I 1 psi{ @ 10 > IF 6 spike ! THEN + I 1 psi{ @ 15 > IF 9 spike ! THEN + I 1 psi{ @ 20 > IF 12 spike ! THEN + I 1 psi{ @ 25 > IF 15 spike ! THEN + I 1 psi{ @ 30 > IF 16 spike ! THEN + I 1 psi{ @ 35 > IF 17 spike ! THEN + I 1 psi{ @ 40 > IF 18 spike ! THEN + I 1 psi{ @ 45 > IF 19 spike ! THEN + I 1 psi{ @ 50 > IF 30 spike ! THEN + I 1 psi{ @ 55 > IF 33 spike ! THEN + I 1 psi{ @ 60 > IF 36 spike ! THEN + I 1 psi{ @ 65 > IF 39 spike ! THEN + I 1 psi{ @ 70 > IF 42 spike ! THEN + I 1 psi{ @ 75 > IF 45 spike ! THEN + I 1 psi{ @ 80 > IF 48 spike ! THEN + I 1 psi{ @ 85 > IF 50 spike ! THEN + I 1 psi{ @ 90 > IF 52 spike ! THEN + I 1 psi{ @ 95 > IF 54 spike ! THEN + vacpsi @ fyipsi ! \ a replacement variable; 17oct2011 + I 1 psi{ @ oldact ! + I 5 psi{ @ oldpos ! + fyi @ 2 = IF \ In Tutorial mode show slosh-over; 17oct2010 + CR ." VerbAct calls SpreadAct with activation " + spike @ . ." for Psi #" seqpsi @ . \ 18oct2010 + THEN \ End of test for Tutorial mode; 17oct2010 + seqpsi @ 0 > IF \ replacement; 15sep2010 + ( insert diagnostic code here; 6aug2011 ) + 5 spike +! \ for sake of direct objects; 3sep2011 + 8665 caller ! + SpreadAct ( for spreading activation ) + 0 caller ! + 0 prepsi ! \ replacing presyn; 15sep2010 + 0 seqpsi ! \ replacing seqsyn; 15sep2010 + THEN + 0 oldpos ! + 0 fyipsi ! \ 17oct2011 + 0 oldact ! + 0 pre ! + 0 seq ! + THEN + ( perhaps reset spike to zero for each loop? 14oct2010 ) + 0 spike ! \ reset to start each loop again; 14oct2010 + -1 +LOOP + THEN +; ( http://code.google.com/p/mindforth/wiki/VerbAct ) + + +: ReActivate ( re-activate recent nodes of a concept ) + fyi @ 2 > IF CR + ." Calling ReActivate. psi = " psi @ . CR + THEN + 0 spike ! + psi @ 0 > IF + fyi @ 2 > IF + CR ." ReActivate calls SpreadAct to transfer " + CR ." proportionate activation from each node of " + CR ." concept #" psi @ . + THEN + midway @ tov @ DO \ Omitting current input; 29may2011 + I 0 psi{ @ psi @ = IF + pov @ 42 = IF \ Only during "*" external POV; 7may2011 + moot @ 0 = IF \ deprive queries of tags; 20aug2011 + I 1 psi{ @ 0 < IF \ if inhibited; 29aug2011 + 1 I 1 psi{ +! \ reactivate only slightly; 29aug2011 + proxcon @ 1 = IF \ if clustering input; 7sep2011 + prox3 @ psi @ = IF \ 7sep2011 + I 7 psi{ @ prox2 @ = IF \ seq; 12oct2011 + 40 I 1 psi{ ! \ extra act; 7sep2011 + THEN \ 7sep2011 + THEN \ 7sep2011 + THEN \ end of proxcon test; 7sep2011 + ELSE \ otherwise impose full reactivation; 29aug2011 + I 1 psi{ @ -1 > IF \ avoid inhibition; 3sep2011 + 35 I 1 psi{ +! \ Relative not absolute 12aug2011 + I 5 psi{ 8 = IF \ Test for a verb; 28jun2012 + 16 I 1 psi{ +! \ Accentuate verbs; 28jun2012 + THEN \ End of test for verbs; 28jun2012 + proxcon @ 1 = IF \ if clustering input; 7sep2011 + prox2 @ psi @ = IF \ 7sep2011 + THEN \ 7sep2011 + prox3 @ psi @ = IF \ 7sep2011 + I 7 psi{ @ prox2 @ = IF \ seq; 12oct2011 + 10 I 1 psi{ +! \ extra act; 7sep2011 + THEN \ 7sep2011 + THEN \ 7sep2011 + THEN \ end of proxcon test; 7sep2011 + THEN ( http://www.ez-robot.com ) + THEN \ end of test for inhibited concept; 29aug2011 + THEN \ end of test for a moot query input; 20aug2011 + THEN \ End of new test for external POV; 7may2011 + I 0 psi{ @ 781 = IF \ 781=WHAT; 10nov2012 + 0 I 1 psi{ ! + THEN + I 0 psi{ @ 791 = IF \ 791=WHO; 10nov2012 + 0 I 1 psi{ ! \ As in InStantiate; 3may2011 + THEN \ end of test for 791=WHO 10nov2012 + I 0 psi{ @ 830 = IF \ 830=DO; 10nov2012 + 0 I 1 psi{ ! \ 12jan2010 For what-do queries. + THEN \ End of 830=DO test; 10nov2012 + 1 spike ! \ 30jun2012 + I 1 psi{ @ 0 = IF 0 spike ! THEN + I 1 psi{ @ 5 > IF 7 spike ! THEN + I 1 psi{ @ 10 > IF 8 spike ! THEN + I 1 psi{ @ 15 > IF 9 spike ! THEN + I 1 psi{ @ 20 > IF 10 spike ! THEN + I 1 psi{ @ 25 > IF 11 spike ! THEN + I 1 psi{ @ 30 > IF 12 spike ! THEN + I 1 psi{ @ 35 > IF 13 spike ! THEN + I 1 psi{ @ 40 > IF 14 spike ! THEN + I 1 psi{ @ 45 > IF 15 spike ! THEN + I 1 psi{ @ 50 > IF 16 spike ! THEN + I 1 psi{ @ 55 > IF 17 spike ! THEN + I 1 psi{ @ 60 > IF 18 spike ! THEN + I 4 psi{ @ prepsi ! ( for SpreadAct 30jun2012 ) + I 7 psi{ @ seqpsi ! ( for SpreadAct 30jun2012 ) + I zone ! ( for SpreadAct 30jun2012 ) + 148 caller ! + SpreadAct ( for spreading activation 30jun2012 ) + 0 oldpos ! + 0 fyipsi ! \ 17oct2011 + 0 oldact ! + 0 pre ! + 0 prepsi ! + 0 seq ! + 0 seqpsi ! + 0 psi1 ! + 1 spike ! + THEN + -1 +LOOP + 0 caller ! + 0 urpsi ! + THEN +; ( http://code.google.com/p/mindforth/wiki/ReActivate ) + + +: InNativate ( quasi-instantiate the EnBoot sequence ) +( concept fiber psi ) psi @ t @ 0 psi{ ! +( Set "num" number flag ) num @ t @ 2 psi{ ! +( Store PREvious associand. ) pre @ t @ 4 psi{ ! +( Store functional pos code. ) pos @ t @ 5 psi{ ! +( Store the "tqv" time-point. ) tqv @ t @ 6 psi{ ! +( Store the subSEQuent tag. ) seq @ t @ 7 psi{ ! +( Store the EN-transfer tag. ) enx @ t @ 8 psi{ ! +; ( http://code.google.com/p/mindforth ) + + +: OutBuffer ( right-justifies a word in memory ) + 32 b01 ! 32 b02 ! 32 b03 ! 32 b04 ! 32 b05 ! + 32 b06 ! 32 b07 ! 32 b08 ! 32 b09 ! 32 b10 ! + 32 b11 ! 32 b12 ! 32 b13 ! 32 b14 ! 32 b15 ! + 32 b16 ! + c16 @ 32 > IF \ if the AudBuffer is full; 14nov2012 + c16 @ b16 ! c15 @ b15 ! c14 @ b14 ! c13 @ b14 ! + c12 @ b12 ! c11 @ b11 ! c10 @ b10 @ c09 @ b09 ! + c08 @ b08 ! c07 @ b07 ! c06 @ c06 ! c05 ! b05 ! + c04 @ b04 ! c03 @ c03 ! c02 @ b02 ! c01 @ c01 ! + EXIT \ abandon remainder of function; 13nov2012 + THEN \ end of transfer of 16-character word; 13nov2012 + c15 @ 32 > IF \ word only 15 chars long? 14nov2012 + c15 @ b16 ! c14 @ b15 ! c13 @ b14 ! c12 @ b13 ! + c11 @ b12 ! c10 @ b11 ! c09 @ b10 ! c08 @ b09 ! + c07 @ b08 ! c06 @ b07 ! c05 @ b06 ! c04 @ b05 ! + c03 @ b04 ! c02 @ b03 ! c01 @ b02 ! EXIT + THEN \ transfer of a 15-character word; 13nov2012 + c14 @ 32 > IF + c14 @ b16 ! c13 @ b15 ! c12 @ b14 ! c11 @ b13 ! + c10 @ b12 ! c09 @ b11 ! c08 @ b10 ! c07 @ b09 ! + c06 @ b08 ! c05 @ b07 ! c04 @ b06 ! c03 @ b05 ! + c02 @ b04 ! c01 @ b03 ! EXIT + THEN + c13 @ 32 > IF + c13 @ b16 ! c12 @ b15 ! c11 @ b14 ! c10 @ b13 ! + c09 @ b12 ! c08 @ b11 ! c07 @ b10 ! c06 @ b09 ! + c05 @ b08 ! c04 @ b07 ! c03 @ b06 ! c02 @ b05 ! + c01 @ b04 ! EXIT + THEN + c12 @ 32 > IF + c12 @ b16 ! c11 @ b15 ! c10 @ b14 ! c09 @ b13 ! + c08 @ b12 ! c07 @ b11 ! c06 @ b10 ! c05 @ b09 ! + c04 @ b08 ! c03 @ b07 ! c02 @ b06 ! c01 @ b05 ! + EXIT + THEN + c11 @ 32 > IF + c11 @ b16 ! c10 @ b15 ! c09 @ b14 ! c08 @ b13 ! + c07 @ b12 ! c06 @ b11 ! c05 @ b10 ! c04 @ b09 ! + c03 @ b08 ! c02 @ b07 ! c01 @ b06 ! EXIT + THEN + c10 @ 32 > IF + c10 @ b16 ! c09 @ b15 ! c08 @ b14 ! c07 @ b13 ! + c06 @ b12 ! c05 @ b11 ! c04 @ b10 ! c03 @ b09 ! + c02 @ b08 ! c01 @ b07 ! EXIT + THEN + c09 @ 32 > IF + c09 @ b16 ! c08 @ b15 ! c07 @ b14 ! c06 @ b13 ! + c05 @ b12 ! c04 @ b11 ! c03 @ b10 ! c02 @ b09 ! + c01 @ b08 ! EXIT + THEN + c08 @ 32 > IF + c08 @ b16 ! c07 @ b15 ! c06 @ b14 ! c05 @ b13 ! + c04 @ b12 ! c03 @ b11 ! c02 @ b10 ! c01 @ b09 ! + EXIT + THEN + c07 @ 32 > IF + c07 @ b16 ! c06 @ b15 ! c05 @ b14 ! c04 @ b13 ! + c03 @ b12 ! c02 @ b11 ! c01 @ b10 ! + EXIT + THEN + c06 @ 32 > IF + c06 @ b16 ! c05 @ b15 ! c04 @ b14 ! c03 @ b13 ! + c02 @ b12 ! c01 @ b11 ! + EXIT + THEN + c05 @ 32 > IF + c05 @ b16 ! c04 @ b15 ! c03 @ b14 ! c02 @ b13 ! + c01 @ b12 ! + EXIT + THEN + c04 @ 32 > IF + c04 @ b16 ! c03 @ b15 ! c02 @ b14 ! c01 @ b13 ! + EXIT + THEN + c03 @ 32 > IF + c03 @ b16 ! c02 @ b15 ! c01 @ b14 ! + EXIT + THEN + c02 @ 32 > IF + c02 @ b16 ! c01 @ b15 ! + EXIT + THEN + c01 @ 32 > IF + c01 @ b16 ! + EXIT + THEN +; \ end of OutBuffer; return to AudBuffer or VerbGen. + + +: AudBuffer ( for transfer of words to OutBuffer; 12nov2012 ) + 1 phodex +! \ increment; 12nov2012 + phodex @ 1 = IF \ Erase any left-over old data; + abc @ c01 ! \ fill in first item of new data. + 32 c02 ! 32 c03 ! 32 c04 ! 32 c05 ! 32 c06 ! + 32 c07 ! 32 c08 ! 32 c09 ! 32 c10 ! 32 c11 ! + 32 c12 ! 32 c13 ! 32 c14 ! 32 c15 ! 32 c16 ! + THEN \ end of blanking out with 32=SPACE + phodex @ 2 = IF abc @ c02 ! THEN \ 12nov2012 + phodex @ 3 = IF abc @ c03 ! THEN \ 12nov2012 + phodex @ 4 = IF abc @ c04 ! THEN \ 12nov2012 + phodex @ 5 = IF abc @ c05 ! THEN \ 12nov2012 + phodex @ 6 = IF abc @ c06 ! THEN \ 12nov2012 + phodex @ 7 = IF abc @ c07 ! THEN \ 12nov2012 + phodex @ 8 = IF abc @ c08 ! THEN \ 12nov2012 + phodex @ 9 = IF abc @ c09 ! THEN \ 12nov2012 + phodex @ 10 = IF abc @ c10 ! THEN \ 12nov2012 + phodex @ 11 = IF abc @ c11 ! THEN \ 12nov2012 + phodex @ 12 = IF abc @ c12 ! THEN \ 12nov2012 + phodex @ 13 = IF abc @ c13 ! THEN \ 12nov2012 + phodex @ 14 = IF abc @ c14 ! THEN \ 12nov2012 + phodex @ 15 = IF abc @ c15 ! THEN \ 12nov2012 + phodex @ 16 = IF abc @ c16 ! THEN \ 12nov2012 + OutBuffer \ right-justify each input word; 15nov2012 + 0 abc ! \ reset for non-persistence; 14nov2012 +; \ end of AudBuffer; return to AudInput or VerbGen + + +: InStantiate ( create a concept-fiber node ) + seqneed @ 0 = IF 5 seqneed ! THEN \ test; 27jul2012 + precand @ 0 > IF precand @ pre ! THEN + ordo @ 1 = IF 0 prevtag ! THEN + firstword @ 830 = IF \ DO or DOES; 10nov2012 + 1 moot ! \ deprive queries of pre and seq tags; 19aug2011 + THEN \ end of test for a DO-query; 19aug2011 + firstword @ 781 = firstword @ 791 = OR IF \ 10nov2012 + 1 proxcon ! \ set for 781=WHAT or 791=WHO; 10nov2012 + THEN + lastword @ 1 = IF + 0 seq ! + THEN ( http://home.iae.nl/users/mhx/i4faq.html ) + t @ 610 > IF \ Avoid the EnBoot vault; 11nov2012 + whoflag @ 1 = IF + psi @ 800 = IF 800 beflag ! THEN \ 10nov2012 + pos @ 5 = pos @ 7 = OR IF + beflag @ seq ! + 0 beflag ! + THEN + THEN + psi @ 781 = IF \ Special handling of 781=WHAT; 10nov2012 + 1 indefartcon ! \ indefinite article condition 16apr2011 + 0 act ! \ To suppress "WHAT" during answer. + THEN \ End of test for input of "WHAT" + psi @ 791 = IF \ Special handling of 791=WHO; 10nov2012 + 1 defartcon ! \ Set definite article condition 16apr2011 + 1 whoflag ! + 0 act ! \ To suppress "WHO" during answer. + THEN + singflag @ 1 = IF + pos @ 5 = IF + 1 num ! + 0 singflag ! + THEN + THEN + psi @ 1 = psi @ 83 = OR IF \ "A" or "AN"; 6aug2011 + 1 singflag ! + 0 act ! + THEN + THEN \ end of InStantiate t-test clause; 14jul2012 + pos @ 5 = IF \ noun either external or internal; 6aug2011 + recnum @ 0 > IF \ If positive recog-num; 6aug2022 + recnum @ num ! \ Override num(ber); 6aug2011 + \ 0 recnum ! \ reset for safety; 6aug2011; 14jul2012 + THEN \ End of test for positive recog-num; 6aug2011 + THEN \ End of test for a 5=pos noun; 6aug2011 + pov @ 42 = IF \ If POV is external; 24jun2011 + num @ 0 = IF \ if no num(ber) is assigned; 24jun2011 + putnum @ 0 > IF \ if putative number is positive + putnum @ num ! \ replace zero with putative num + THEN \ end of test for positive putnum; 24jun2011 + THEN \ end of test for missing num-value; 24jun2011 + pos @ 8 = IF putnum @ num ! THEN \ test; 24jun2011 + pos @ 5 = IF psi @ quobj ! THEN \ for AskUser; 6aug2011 + THEN \ End of test for "*" external POV; 20aug2011 + pov @ 35 = IF \ If POV is pound-sign internal; 3may2011 + num @ 0 = IF \ if no num(ber) is assigned; 24jun2011 + putnum @ 0 > IF \ if putative number is positive + putnum @ num ! \ replace zero with putative num + 0 putnum ! \ zero for safety; test; 5aug2011 + THEN \ end of test for positive putnum; 24jun2011 + THEN \ end of test for missing num-value; 24jun2011 + pos @ 8 = IF putnum @ num ! THEN \ test; 24jun2011 + 0 act ! \ 0 activation for ReEntry concepts; 26apr2011 + THEN \ End of test for #internal POV; 7may2011 + prevtag @ pre ! + t @ vault @ < IF 0 pre ! THEN \ for safety; 22sep2011 + ( concept fiber psi ) psi @ t @ 0 psi{ ! + moot @ 0 = IF \ deprive queries of tags; 20aug2011 + ( Set "act" activation level. ) act @ t @ 1 psi{ +! + pos @ 8 = IF \ Re-using code; test for a verb; 28jun2012 + 16 t @ 1 psi{ +! \ Accentuate verbs; 28jun2012 + THEN \ End of test for verbs; 28jun2012 + THEN \ end of test for a moot query input; 20aug2011 + ( Set "num" number flag ) num @ t @ 2 psi{ ! + ( Store JUXtaposition tags. ) jux @ t @ 3 psi{ ! + moot @ 0 = IF \ deprive queries of tags; 19aug2011 + ( Store PREvious associand. ) pre @ t @ 4 psi{ ! + THEN \ end of test for a moot query input; 19aug2011 + ( Store functional pos code. ) pos @ t @ 5 psi{ ! + seq @ 0 > IF \ avoid spurious carry-over tqv; 1aug2012 + ( Store the "tqv" time-point. ) tqv @ t @ 6 psi{ ! + THEN \ only store "tqv" if there is a "seq"; 1aug2012 + moot @ 0 = IF \ deprive queries of tags; 19aug2011 + ( Store the subSEQuent tag. ) seq @ t @ 7 psi{ ! + THEN \ end of test for a moot query input; 19aug2011 + ( Store the EN-transfer tag. ) enx @ t @ 8 psi{ ! + t @ vault @ < IF \ store only during EnBoot; 29sep2011 + \ ( Store the "tqv" time-point. ) tqv @ t @ 8 psi{ ! + THEN \ otherwise store "tqv" retroactively; 29sep2011 + num @ instnum ! + pos @ 5 = IF num @ putnum ! THEN \ noun to verb; 24jun2011 + 0 num ! + jux @ 250 = IF 0 jux ! THEN \ reset after use; 10nov2012 + prejux @ 250 = IF \ 250=NOT from OldConcept; 10nov2012 + 250 jux ! \ set jux for next instantiand; 10nov2012 + 0 prejux ! \ reset for safety; 21jul2011 + THEN \ end of post-instantiation test; 21jul2011 + mfn @ 1 = mfn @ 2 = OR IF \ masc or fem; 17aug2010 + mfn @ mfnflag ! \ 17aug2010 + THEN \ 17aug2010 + mfn @ 0 = IF 0 mfnflag ! THEN \ test; 25aug2010 + 0 mfn ! \ Test code applies only to En array. + 0 preset ! + pos @ 5 = pos @ 7 = OR IF + psi @ prevtag ! + THEN + psi @ 830 = NOT IF \ DO? DOES? 10nov2012 + psi @ 830 = NOT IF \ 830=DO/DOES; 10nov2012 + seqneed @ 8 = IF \ if looking for a verb; 2oct2011 + pos @ 8 = IF \ if part-of-speech is verb; 2oct2011 + psi @ seq ! \ verb has arrived; 2oct2011 + 0 seqneed ! \ zero out after use; 2oct2011 + 1 transcon ! \ until noun fails to come in; 24jan2013 + pos @ seqpos ! \ possibly for tqv; 2oct2011 + THEN \ end of test for 8=pos verb; 2oct2011 + tsn @ t @ 2 - DO \ look for noun needing seq; 1jul2012 + I 5 psi{ @ 5 = I 5 psi{ @ 7 = OR IF \ (pro)noun 2oct2011 + moot @ 0 = IF \ deprive queries of tags; 5oct2011 + seq @ I 7 psi{ ! \ insert the seq; 12oct2011 + seqpos @ 8 = IF \ a verb? 2oct2011 + t @ I 6 psi{ ! \ insert "tqv" value; 12oct2011 + t @ tqv ! \ assign "tqv" value; 2oct2011 + THEN \ end of seqpos=verb test; 2oct2011 + THEN \ end of test for a moot query input; 5oct2011 + LEAVE \ insert only one seq; 2oct2011 + THEN \ end of test for subject noun or pronoun 2oct2011 + -1 +LOOP \ end of backwards loop; 2oct2011 + THEN \ end of test for needing a verb; 2oct2011 + THEN \ end of skipping auxiliary DOES; 6oct2011 + THEN \ end of skipping auxiliary verb DO; 6oct2011 + seqneed @ 5 = IF \ if looking for a noun; 5oct2011 + pos @ 5 = pos @ 7 = OR IF \ if noun or pronoun; 5oct2011 + 4 dba ! \ from DeKi: assuming acc. dir. obj.; 27dec2012 + psi @ seq ! \ because a (pro)noun has arrived; 5oct2011 + 0 seqneed ! \ zero out after use; 5oct2011 + pos @ seqpos ! \ possibly for tqv; 5oct2011 + ELSE \ if no direct object is found; 24jan2012 + 0 transcon ! \ declare intransitive verb; 24jan2013 + THEN \ end of test for 5=pos noun or 7=pos pronoun; 5oct2011 + tsn @ t @ 2 - DO \ look for verb needing "seq"; 1jul2012 + I 5 psi{ @ 8 = IF \ verb? 5oct2011 + moot @ 0 = IF \ deprive queries of tags; 5oct2011 + transcon @ 1 = IF \ verb transitive? 24jan2012 + seq @ I 7 psi{ ! \ insert the seq; 12oct2011 + seqpos @ 5 = seqpos @ 7 = OR IF \ (pro)noun? 5oct2011 + t @ I 6 psi{ ! \ insert "tqv" value; 12oct2011 + t @ tqv ! \ assign "tqv" value; 5oct2011 + THEN \ end of seqpos=(pro)noun test; 5oct2011 + THEN \ end of test for positive "transcon"; 24jan2013 + THEN \ end of test for a moot query input; 5oct2011 + LEAVE \ insert only one seq; 5oct2011 + THEN \ end of test for a verb; 5oct2011 + -1 +LOOP \ end of backwards loop; 5oct2011 + THEN \ end of test for needing a noun; 5oct2011 + ordo @ 2 = IF \ 7sep2011 + psi @ prox2 ! \ 7sep2011 + THEN \ 7sep2011 + ordo @ 3 = IF \ 7sep2011 + psi @ prox3 ! \ 7sep2011 + THEN \ 7sep2011 + pos @ 5 = pos @ 7 = OR IF \ (pro)noun? 2oct2011 + 8 seqneed ! \ need "8=verb" seq; 2oct2011 + THEN \ end of test for a noun or a pronoun; 2oct2011 + pos @ 6 = IF \ if preposition; 2oct2011 + 5 seqneed ! \ need noun or pronoun; 2oct2011 + THEN ( http://home.hccnet.nl/a.w.m.van.der.horst/ciforth.html ) + psi @ 830 = NOT IF \ skip auxiliary verb "830=DO"; 10nov2012 + psi @ 830 = NOT IF \ skip auxiliary "830=DOES"; 10nov2012 + pos @ 8 = IF \ if verb then need noun as "seq"; 5oct2011 + 5 seqneed ! \ seek noun or pronoun as "seq"; 5oct2011 + THEN \ end of test for 8=verb; 5oct2011 + THEN \ end of test to skip auxiliary DOES; 6oct2011 + THEN \ end of test to skip auxiliary DO; 6oct2011 + lastword @ 1 = IF 0 lastword ! THEN \ for seqneed; 30jun2012 + 0 dba ! \ from DeKi: reset for safety; 27dec2012 + 0 recnum ! \ lest carry-over to other words; 19jul2011 + 0 seq ! +; ( http://code.google.com/p/mindforth/wiki/InStantiate ) + + +: EnVocab ( English Vocabulary node creation; 8jul2012 ) + ( Number "nen" of English ) nen @ t @ 0 en{ ! + ( Do not store the activation level; it is a transient.) + ( Store "num" number tag. ) num @ t @ 2 en{ ! + ( Store "mfn" gender tag. ) mfn @ t @ 3 en{ ! + ( Store case or person tag. ) dba @ t @ 4 en{ ! + ( Store mindcore EXit tag. ) fex @ t @ 5 en{ ! + ( Store part of speech "pos".) pos @ t @ 6 en{ ! + ( Store mindcore IN tag. ) fin @ t @ 7 en{ ! + ( Store the auditory "aud" tag. ) aud @ t @ 8 en{ ! + 0 dba ! \ reset for safety; 27dec2012 +; ( http://code.google.com/p/mindforth/wiki/EnVocab ) + + +: EnParser ( determine the part of speech ) + 5 bias ! + 35 act ! \ Activate lower than ReActivate; 29may2011 + pov @ 42 = IF \ only during external input; 9oct2010 + act @ ordo @ - act ! \ reduce S-V-O act's; 9oct2010 + THEN \ end of test for external POV; 9oct2010 + InStantiate \ create a Psi concept node; 6nov2010 + pos @ 5 = IF 8 bias ! THEN + pos @ 7 = IF 8 bias ! THEN + pos @ 8 = IF 5 bias ! 0 singflag ! THEN \ 4nov2011 +; ( http://code.google.com/p/mindforth/wiki/EnParser ) + + +: EnReify ( express abstract concepts as real words ) + 0 act ! + midway @ t @ DO + I 1 psi{ @ 0 > IF + I 1 psi{ @ lexact ! + I 2 psi{ @ num ! + lexact @ I 1 en{ ! + num @ I 2 en{ ! + 0 lexact ! + THEN ( http://home.vrweb.de/~stephan.becher/forth ) + 0 enx ! + 0 act ! + 0 lexact ! + -1 +LOOP + 0 act ! +; ( http://code.google.com/p/mindforth/wiki/EnReify ) + + +: KbSearch ( knowledge base search ) + ordo @ 2 = IF + NounAct ( may need a "nacpsi" value ) + EnReify + THEN ( http://www.ccreweb.org/software/kforth ) + ordo @ 3 = IF + 0 act ! + midway @ t @ DO + I 5 en{ @ 8 = IF \ Test part-of-speech. + I 1 en{ @ act @ > IF ( if en1 is higher ) + I 0 en{ @ memoire ! ( store psi-tag of word ) + I 1 en{ @ act ! ( to test for a higher en1 ) + THEN + THEN + -1 +LOOP + yesorno @ 0 > IF + memoire @ psi @ = IF + 1 yesorno +! + ELSE + 0 yesorno ! + THEN + THEN + psi @ vacpsi ! \ deglobalizing; 27sep2010 + VerbAct + 0 vacpsi ! \ reset for safety; 27sep2010 + EnReify + THEN + ordo @ 4 = IF + 0 act ! + 0 memoire ! + midway @ t @ DO + I 5 en{ @ 5 = I 5 en{ @ 7 = OR IF + I 1 en{ @ act @ > IF ( if en1 is higher ) + I 0 en{ @ memoire ! ( store psi-tag of word ) + I 1 en{ @ act ! ( to test for a higher en1 ) + THEN + THEN + -1 +LOOP + yesorno @ 0 > IF + memoire @ psi @ = IF + 1 yesorno +! + ELSE + 0 yesorno ! + THEN + THEN ( http://www.lifeai.com ) + THEN + 0 kbquiz ! + ordo @ 4 = IF 0 ordo ! THEN +; ( http://code.google.com/p/mindforth/wiki/KbSearch ) + + +: KbRetro ( retroactive adjustment of knowledge base ) + oldpsi @ 432 = oldpsi @ 404 = OR IF \ yes or no 10nov2012 + oldpsi @ 404 = IF \ 404=NO; 10nov2012 + 64 tkbn @ 1 psi{ ! \ high noun activation 21jul2011 + 64 tkbv @ 1 psi{ ! \ set high activation? 2jul2011 + 250 tkbv @ 3 psi{ ! \ set 250=NOT jux flag 27dec2012 + \ CR ." KbRetro: answer is No " \ 29dec2012 + THEN \ End of test for "No" answer; 2jul2011 + oldpsi @ 432 = IF \ 432=YES; 10nov2012 + 64 tkbv @ 1 psi{ ! \ set high activation? 2jul2011 + \ CR ." KbRetro: answer is Yes " \ 29dec2012 + THEN \ End of test for "Yes" answer; 2jul2011 + ELSE \ if neither; 2jul2011 + 0 tkbn @ 4 psi{ ! \ delete pre-tag for noun; 2jul2011 + 0 tkbn @ 7 psi{ ! \ delete seq-tag for noun; 12oct2011 + 0 tkbv @ 4 psi{ ! \ delete pre-tag for verb; 2jul2011 + 0 tkbv @ 7 psi{ ! \ delete seq-tag for verb; 12oct2011 + \ CR ." KbRetro: answer is neither Yes nor No " \ 29dec2012 + THEN ( http://retroforth.org ) + 0 kbcon ! \ temporarily here turn off kbcon; 2jul2011 + 0 tkbn ! \ reset for safety; 2jul2011 + 0 tkbv ! \ reset for safety; 2jul2011 +; ( http://code.google.com/p/mindforth/wiki/KbRetro ) + + +: OldConcept ( recognize a known word ) + 28 act ! \ A value subject to optimization; 28sep2010 + midway @ t @ DO + \ I 0 en{ @ oldpsi @ = IF + I 0 en{ @ oldpsi @ = I 8 en{ @ 0 > AND IF \ 29dec2012 + I 2 en{ @ 0 > IF + I 2 en{ @ ocn ! THEN \ "unk" is too global; 14jul2012 + I 3 en{ @ 0 > IF + I 3 en{ @ mfn ! THEN + ( I 4 en{ @ dba ! is not trustworthy for verbs 28dec2012 ) + I 5 en{ @ 0 > IF \ adding dba; 10nov2012 + I 5 en{ @ fex ! THEN \ adding dba; 10nov2012 + I 6 en{ @ 0 > IF \ adding dba; 10nov2012 + I 6 en{ @ pos ! THEN \ adding dba; 10nov2012 + I 7 en{ @ 0 > IF \ adding dba; 10nov2012 + I 7 en{ @ fin ! THEN \ adding dba; 10nov2012 + LEAVE + THEN ( http://home.iae.nl/users/mhx/eforth.html ) + -1 +LOOP + pos @ 8 = IF \ verb? for WhatAuxSVerb 13jun2011 + numsubj @ unk ! \ assume agreement; 19jun2011 + 3 dba ! \ 3rd person default before changes; 27dec2012 + putdbav @ 0 > IF \ positive putdbav? 27dec2012 + putdbav @ dba ! \ transfer; 27dec2012 + 0 putdbav ! \ reset after use; 27dec2012 + THEN \ end of test for putative dba; 27dec2012 + THEN \ end of test for verb \ 13jun2011 + oldpsi @ 800 = IF t @ tbev ! THEN \ 800=BE; 10nov2012 + pos @ 5 = pos @ 7 = OR IF \ noun or pron.? 27dec2012 + 1 dba ! \ default before changes; 27dec2012 + audverb @ 0 > IF \ preceded by a verb? 27dec2012 + audverb @ 800 = NOT IF \ except be-verbs; 27dec2012 + 4 dba ! \ accusative direct object; 27dec2012 + THEN \ code snippet taken from Wotan DeKi; 27dec2012 + 0 audverb ! \ reset after use; 27dec2012 + THEN \ end of test for positive audverb; 27dec2012 + THEN \ end of test for noun or pronoun; 27dec2012 + oldpsi @ 701 = oldpsi @ 731 = OR IF 1 putdbav ! THEN + oldpsi @ 707 = oldpsi @ 737 = OR IF 2 putdbav ! THEN + subjectflag @ 1 = IF 1 dba ! THEN \ nom. subj. 27dec2012 + dirobj @ 1 = IF 4 dba ! THEN \ acc. dir. obj. 27dec20122012 + pov @ 42 = IF \ external POV during input; 18dec2012 + oldpsi @ 800 = IF 1 becon ! THEN \ InFerence; 18dec2012 + THEN \ only set becon during external input; 18dec2012 + ( oldpsi found by AudRecog ) oldpsi @ t @ 0 en{ ! + ( Add zero activation 28jul2011 ) 0 t @ 1 en{ +! + ocn @ 0 > IF \ from AudInput for old nouns; 14oct2011 + ( Store old-concept-number tag ) ocn @ t @ 2 en{ ! + 0 ocn ! \ reset to zero after use; 14oct2011 + THEN \ leaving only one space in "2 en{" etc 8jul2012 + pcn @ 0 > IF \ from NounPhrase predicate selection; 17jul2012 + ( Store pred-concept-number tag ) pcn @ t @ 2 en{ ! + \ 0 pcn ! \ reset to zero after use; 17jul2012 + THEN \ leaving one search-space in "2 en{" etc 17jul2012 + ( Store "mfn" gender tag. ) mfn @ t @ 3 en{ ! + ( Store "dba" tag; 10nov2012 ) dba @ t @ 4 en{ ! + ( Store mindcore EXit tag. ) fex @ t @ 5 en{ ! + ( Store part of speech "pos".) pos @ t @ 6 en{ ! + ( Store mindcore IN tag. ) fin @ t @ 7 en{ ! + ( Store the auditory "aud" tag. ) aud @ t @ 8 en{ ! + pov @ 35 = IF fex @ oldpsi ! THEN ( internal pov ) + pov @ 42 = IF fin @ oldpsi ! THEN ( external pov ) + oldpsi @ enx ! + oldpsi @ 250 = IF \ 250=NOT; 10nov2012 + tbev @ 0 > IF \ if positive be-verb time; 27jul2011 + 250 tbev @ 3 psi{ ! \ set verb "jux" to NOT 10nov2012 + 0 tbev ! \ reset for safety; 27jul2011 + THEN \ end of test for a positive tbev; 27jul2011 + THEN \ end of test for input of 250=NOT; 10nov2012 + oldpsi @ 781 = IF 8 act ! THEN ( 781=WHAT; 10nov2012 ) + oldpsi @ 791 = IF 8 act ! THEN ( 791=WHO; 10nov2012 ) + ordo @ 1 = IF + oldpsi @ 830 = IF ( 830=DO; 10nov2012 ) + 1 kbquiz ! + THEN + THEN + oldpsi @ 830 = IF 0 act ! THEN ( 830=DO; 10nov2012 ) + oldpsi @ 117 = IF 1 act ! THEN ( 117=THE; 10nov2012 ) + kbcon @ 0 > IF \ if awaiting answer; 2jul2011 + KbRetro \ retroactively adjust knowledge base; 2jul2011 + THEN \ 2jul2011 + oldpsi @ 250 = IF \ 250=NOT; 10nov2012 + 250 prejux ! \ set flag for verb; 10nov2012 + 250 aftjux ! \ set flag for a be-verb; 10nov2012 + THEN \ end of test for 250=NOT negation; 10nov2012 + oldpsi @ psi ! + EnParser + fyi @ 2 > IF CR + ." from OldConcept " + THEN + pov @ 42 = IF \ external POV during input; 18dec2012 + pos @ 5 = IF \ nouns only, not pronouns; 27dec2012 + subjnom @ 0 > IF \ already subjnom? 27dec2012 + oldpsi @ prednom ! \ 27dec2012 + THEN \ end of test for pre-existing subjnom; 27dec2012 + prednom @ 0 = IF \ 27dec2012 + oldpsi @ subjnom ! \ grab for InFerence; 27dec2012 + THEN \ alternate between subjnon and prednom; 27dec2012 + THEN \ end of test for a noun; 27dec2012 + pos @ 8 = IF \ verb part-of-speech? 27dec2012 + oldpsi @ 800 = NOT IF \ other than be-verb? 27dec2012 + 0 subjnom ! \ cancel out any subjnom; 27dec2012 + THEN \ end of test for a be-verb; 27dec2012 + THEN \ end of test for a verb; 27dec2012 + \ subjnom @ 0 = IF \ not yet declared? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ oldpsi @ subjnom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for no subjnom yet; 18dec2012 + \ subjnom @ 0 > IF \ already declared? 18dec2012 + \ becon @ 1 = IF \ be-verb in use? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ oldpsi @ prednom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for be-verb input; 18dec2012 + \ THEN \ end of test for positive subjnom; 18dec2012 + THEN \ end of test for external-input POV; 18dec2012 + pov @ 42 = IF ( external pov ) + ReActivate + THEN + 0 act ! + pov @ 35 = IF ( internal pov ) + 1 match ! + THEN +\ pos @ 8 = IF psi @ quverb ! THEN \ for yes-or-no; 24jun2011 +\ pos @ 8 = IF psi @ quverb ! THEN \ Commenting out 29dec2012 + pos @ 8 = IF oldpsi @ audverb ! THEN \ for "dba"; 27dec2012 + kbquiz @ 0 > IF + 1 yesorno ! + KbSearch + THEN + yesorno @ 0 > IF + KbSearch + THEN + 0 pos ! \ Reset no longer above but down here. +; ( http://code.google.com/p/mindforth/wiki/OldConcept ) + + +: NewConcept ( machine learning of new concepts ) + 0 newpsi ! + 1 nen +! + 1 nwc +! + nen @ newpsi ! + nen @ stempsi ! + nen @ psi ! + nen @ fex ! + nen @ fin ! + bias @ pos ! + bias @ 8 = IF \ 4nov2011 + putnum @ num ! \ 4nov2011 + 0 putnum ! \ 4nov2011 + 0 singflag ! \ prevent carry-over; 4nov2011 + 3 dba ! \ default dba=3 third person; 26dec2012 + putdbav @ 0 > IF \ positive putdbav? 27dec20122012 + putdbav @ dba ! \ transfer; 27dec20122012 + 0 putdbav ! \ reset after use; 27dec2012 + THEN \ 27dec2012 + THEN \ 4nov2011 + bias @ 5 = IF \ expecting a noun? 27dec2012 + 1 dba ! \ default before changes; 27dec2012 + audverb @ 0 > IF \ preceded by a verb? 27dec2012 + audverb @ 800 = NOT IF \ except be-verbs; 27dec2012 + 4 dba ! \ accusative direct object; 27dec2012 + THEN \ part of code snippet from Wotan DeKi 27dec2012 + 0 audverb ! \ reset after use; 27dec2012 + THEN \ end of test for positive audverb; 27dec2012 + THEN \ end of test for expecting a noun; 27dec2012 + EnVocab ( to create an English vocabulary node ) + 0 fex ! + 0 fin ! + nen @ enx ! + EnParser + pos @ 8 = IF nen @ quverb ! THEN \ for yes-or-no; 24jun2011 + pos @ 5 = IF \ if a new noun is encountered; 22oct2011 + nen @ cogpsi ! \ hold onto new noun for WhatBe; 22oct2011 + instnum @ cognum ! \ keep track of the num(ber); 22oct2011 + THEN \ end of test of "pos" part-of-speech; 22oct2011 + pov @ 42 = IF \ external POV during input? 18dec2012 + pos @ 5 = IF \ nouns only, not pronouns; 27dec2012 + subjnom @ 0 > IF \ already subjnom? 27dec2012 + newpsi @ prednom ! \ 27dec2012 + THEN \ end of test for pre-existing subjnom; 27dec2012 + prednom @ 0 = IF \ 27dec2012 + newpsi @ subjnom ! \ grab for InFerence; 27dec2012 + THEN \ alternate between subjnon and prednom; 27dec2012 + THEN \ end of test for a noun; 27dec2012 + \ pos @ 8 = IF \ verb part-of-speech? 27dec2012 + \ newpsi @ 800 = NOT IF \ other than be-verb? 27dec2012 + \ 0 subjnom ! \ cancel out any subjnom; 27dec2012 + \ THEN \ end of test for a be-verb; 27dec2012 + \ THEN \ end of test for a verb; 27dec2012 + \ subjnom @ 0 = IF \ not yet declared? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ newpsi @ subjnom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for no subjnom yet; 18dec2012 + \ subjnom @ 0 > IF \ already declared? 18dec2012 + \ becon @ 1 = IF \ be-verb in use? 18dec2012 + \ pos @ 5 = IF \ nouns only, not pronouns; 18dec2012 + \ newpsi @ prednom ! \ grab for InFerence; 18dec2012 + \ THEN \ end of test for a noun; 18dec2012 + \ THEN \ end of test for be-verb input; 18dec2012 + \ THEN \ end of test for positive subjnom; 18dec2012 + THEN \ end of test for external-input POV; 18dec2012 + kbcon @ 0 > IF \ if awaiting answer; 2jul2011 + KbRetro \ retroactively adjust knowledge base; 2jul2011 + THEN ( http://www.gnu.org/software/gforth ) + 0 pos ! + 0 act ! +; ( http://code.google.com/p/mindforth/wiki/NewConcept ) + + +\ The visual recognition module of MindForth AI for robots +\ when fully implemented will serve the purpose of letting +\ AI Minds dynamically describe what they see in real time +\ instead of fetching knowledge from the AI knowledge base. +: VisRecog ( identification of objects seen by a robot ) + svo3 @ 0 = IF \ if no direct object is available; + midway @ t @ DO \ search for an automatic default + I 0 en{ @ 760 = IF \ 760=NOTHING; 10nov2012 + I 8 en{ @ aud ! \ hold address for SpeechAct + LEAVE ( http://aimind-i.com ) + THEN ( http://www.vicariousinc.com ) + -1 +LOOP \ end of looping through English lexical array + THEN ( http://opencv.willowgarage.com ) +; ( http://code.google.com/p/mindforth/wiki/VisRecog ) + + +: AudRecog ( auditory recognition ) + 0 audrec ! + 0 psi ! + 8 act ! + 0 actbase ! + midway @ spt @ DO + I 0 aud{ @ pho @ = IF \ If incoming pho matches stored aud0; + I 1 aud{ @ 0 = IF \ if matching engram has no activation; + I 3 aud{ @ 1 = IF \ if beg=1 on matching no-act aud engram; + \ audrun @ 1 = IF \ if comparing start of a word; 8may2010 + audrun @ 2 < IF \ if comparing start of a word; 8may2010 + I 4 aud{ @ 1 = IF \ If beg-aud has ctu=1 continuing, + 8 I 1+ 1 aud{ ! \ activate the N-I-L character, + 0 audrec ! + I 5 aud{ @ 0 > IF \ audpsi available? 27dec2012 + I 5 aud{ @ prc ! \ provisional recognition 27dec2012 + THEN \ end of test for an early audpsi; 27dec2012 + ELSE + len @ 1 = IF + I 5 aud{ @ monopsi ! + THEN \ End of test for one char length. + THEN \ end of test for continuation of beg-aud + THEN \ end of test for audrun=1 start of word. + THEN \ end of test for a beg(inning) non-active aud0 + THEN \ end of test for matching aud0 with no activation + I 1 aud{ @ 0 > IF \ If matching aud0 has activation, + 0 audrec ! \ Zero out any previous audrec. + I 4 aud{ @ 1 = IF \ If act-match aud0 has ctu=1 continuing, + 2 act +! \ Increment act for discrimination. + 0 audrec ! \ because match-up is not complete. + act @ I 1+ 1 aud{ ! \ Increment for discrimination. + THEN \ end of test for active-match aud0 continuation + I 4 aud{ @ 0 = IF \ If ctu=0 indicates end of word + len @ 2 = IF \ If len(gth) is only two characters. + I 1 aud{ @ 7 > IF \ testing for eight (8). + I 5 aud{ @ psibase ! \ Assume a match. + THEN \ End of test for act=8 or positive. + THEN \ End of test for two-letter words. + THEN \ End of test in AudRecog for end of word. + I 1 aud{ @ 8 > IF \ If activation higher than initial + 8 actbase ! \ Since act is > 8 anyway; 8may2010 + I 4 aud{ @ 0 = IF \ If matching word-engram now ends, + I 1 aud{ @ actbase @ > IF \ Testing for high act. + I 5 aud{ @ audrec ! \ Fetch the potential tag + I 5 aud{ @ subpsi ! \ Seize a potential stem. + len @ sublen ! \ Hold length of word-stem. + I 5 aud{ @ psibase ! \ Hold onto winner. + I 2 psi{ @ recnum ! \ recognized number 19jul2011 + I 4 en{ @ 0 > IF \ from German AI; 27dec2012 + I 4 en{ @ dba ! \ verb-recognition; 27dec2012 + THEN \ end of test for dba; 27nov20122012 + I 1 aud{ @ actbase ! \ Winner is new actbase. + THEN \ End of test for act higher than actbase. + ELSE \ part of AudRecog code; 14jul2012 + 0 audrec ! + monopsi @ 0 > IF + monopsi @ audrec ! + 0 monopsi ! + THEN ( http://code.google.com/p/reda4 ) + THEN \ End of test for final char that has a psi-tag. + THEN \ End of test for engram-activation above eight. + THEN \ End of test for matching aud0 with activation. + THEN \ End of test for a character matching "pho". + I midway @ = IF \ If a loop reaches midway; 8may2010 + 1 audrun +! \ Increment audrun beyond unity; 8may2010 + THEN \ End of test for loop reaching midway; 8may2010 + -1 +LOOP + 0 act ! + 0 actbase ! + psibase @ 0 > IF + psibase @ audrec ! + THEN + audrec @ 0 = IF + monopsi @ 0 > IF + len @ 2 < IF + monopsi @ audrec ! + THEN + 0 monopsi ! + audrec @ 0 = IF + psibase @ 0 > IF + psibase @ audrec ! + THEN + THEN + THEN + THEN + audrec @ 0 = IF + morphpsi @ audrec ! + sublen @ 0 > IF + len @ sublen @ - stemgap ! + THEN + stemgap @ 0 < IF 0 stemgap ! THEN + stemgap @ 1 > IF 0 subpsi ! THEN + stemgap @ 1 > IF 0 morphpsi ! THEN + stemgap @ 1 > IF 0 audrec ! THEN + THEN + subpsi @ morphpsi ! + 0 psibase ! + 0 subpsi ! + audrec @ 0 > IF + stemgap @ 2 > IF + 0 audrec ! + THEN + THEN + audrec @ audpsi ! + 0 stemgap ! \ safety measure; 22sep2011 +; ( http://code.google.com/p/mindforth/wiki/AudRecog ) + + +: AudMem ( auditory memory channel ) + t @ vault @ > IF + pho @ 32 > IF + AudRecog + THEN ( ASCII 32 = SPACE-bar ) + THEN ( http://pygmy.utoh.org/pygmyforth.html ) + t @ 1- 0 aud{ @ 0 = IF 1 beg ! THEN + t @ 1- 0 aud{ @ 32 = IF 1 beg ! THEN + pho @ t @ 0 aud{ ! + pov @ t @ 2 aud{ ! + beg @ t @ 3 aud{ ! + ctu @ t @ 4 aud{ ! + ctu @ 0 = IF + audpsi @ 0 > IF + audpsi @ t @ 5 aud{ ! + THEN + 0 audpsi ! + THEN ( http://home.earthlink.net/~gmayhak/M5_htm.htm ) + pov @ 42 = IF + pho @ 83 = IF + 0 stempsi ! + wordend @ 1 = IF + 0 t @ 1- 4 aud{ ! + THEN + 0 newpsi ! + THEN + THEN + pho @ 32 = IF t @ spt ! THEN +; ( http://code.google.com/p/mindforth/wiki/AudMem ) + + +: AudListen ( preparation for AudInput ) + t @ 2 + tsn ! \ time when awaiting input; test; 1jul2012 + rsvp @ 1 DO + KEY? IF + KEY pho ! + 0 inert ! \ User input cancels "inert" status; 16oct2011 + 0 quiet ! + pho @ 8 = IF 7 EMIT THEN + pho @ 9 = IF + 400 rsvp ! ( 23dec2009 From Supercomputer mind.frt ) + pho @ 13 = IF 1 lastword ! THEN + fyi @ 0 = IF CR CR + TIME&DATE tsyear ! tsmonth ! tsday ! + tshour ! tsminute ! tssecond ! + ." Transcript of Forthmind " + vrsn @ . ." interview at " \ declare version; 3aug2012 + tshour @ . tsminute @ . tssecond @ . + ." o'clock on " tsday @ . + tsmonth @ 1 = IF ." January " THEN + tsmonth @ 2 = IF ." February " THEN + tsmonth @ 3 = IF ." March " THEN + tsmonth @ 4 = IF ." April " THEN + tsmonth @ 5 = IF ." May " THEN + tsmonth @ 6 = IF ." June " THEN + tsmonth @ 7 = IF ." July " THEN + tsmonth @ 8 = IF ." August " THEN + tsmonth @ 9 = IF ." September " THEN + tsmonth @ 10 = IF ." October " THEN + tsmonth @ 11 = IF ." November " THEN + tsmonth @ 12 = IF ." December " THEN + tsyear @ . 8 EMIT 46 EMIT CR + THEN + 1 fyi +! + fyi @ 3 > IF 0 fyi ! THEN + fyi @ 0 = IF CR ." Normal display mode. Tab 1 = " + ." Transcript; 2 = Tutorial; 3 = Diagnostic." CR + THEN + fyi @ 2 = IF CR + ." Tutorial mode reveals the internal " + ." thinking of the AI Mind." CR CR + THEN + fyi @ 3 = IF CR + ." Diagnostic messages - ignore during input " + ." until you press ENTER." CR + THEN + 0 pho ! + THEN + pho @ 27 = IF + 0 nounval ! + 0 lopsi ! 0 hipsi ! + CR + CR ." User Command: halt" 0 pho ! 0 rjc ! 0 fyi ! + CR ." You may enter .psi or .en or .aud to view " + ." memory engrams, or " CR ." MainLoop [ENTER] " + ." to erase memories and restart the Mind." + CR ." Type 'bye' to quit Forth, EXIT to quit DOS." + CR + 0 audpsi ! 0 newpsi ! 0 oldpsi ! 0 stempsi ! + 1 audrun ! \ 26jul2010 In case AI is run again. + 0 defartcon ! \ 16apr2011 In case AI is run again. + 0 indefartcon ! \ 16apr2011 In case AI is run again. + 0 kbtv ! \ 28sep2010 In case AI is run again. + 0 mfn ! \ 25aug2010 In case AI is run again. + 0 mfnflag ! \ 23aug2010 In case AI is run again. + 0 motjuste ! \ 29aug2010 In case AI is run again. + 0 objold ! \ 12oct2010 In case AI is run again. + 0 ordo ! \ 21dec2009 In case AI is run again. + 0 prsn ! \ 29aug2010 In case AI is run again. + 0 psi1 ! \ 25aug2010 In case AI is run again. + 0 quo ! \ 27dec2009 In case AI is run again. + 0 qup ! \ 28dec2009 In case AI is run again. + 0 subjold ! \ 9oct2010 In case AI is run again. + 0 subjpsi ! \ 1jan2010 In case AI is run again. + 0 vphract ! \ 21jun2011 In case AI is run again. + 0 whoflag ! \ 23jul2010 In case AI is run again. + QUIT + THEN + pho @ 0 > IF + pho @ EMIT + THEN + pho @ DUP 96 > IF \ convert input to UPPERCASE + DUP 123 < IF + 32 - + THEN + THEN pho ! \ save UPPERCASE as pho(neme) again. + pho @ abc ! \ for transfer to AudBuffer; 12nov2012 + LEAVE + ELSE + ." " + THEN + 8 EMIT + LOOP + pho @ 0 > IF \ if user enters data; 19sep2010 + 0 lurk ! \ reset; 19sep2010 + THEN \ end of test for user entry; 19sep2010 + 1 lurk +! \ test; remove; 19sep2010 +; ( http://code.google.com/p/mindforth/wiki/AudListen ) + + +: AudInput ( accept auditory input ) + 0 match ! + 0 upnext ! + 0 urpsi ! + t @ nlt ! + pov @ 42 = IF + fyi @ 2 = IF + ." AudInput calls AudListen " + ." (Tab key will slow the AI down)." CR + THEN + t @ spt ! + t @ 8 > IF .echo THEN ( show output of AI ) + CR ." Human: " + THEN + 140 0 DO ( Accept a tweet of 140 characters from Twitter) + pov @ 35 = IF ( during internal re-entry ) + pho @ 13 = IF \ if a CR is declared; 8may2010 + 1 audrun ! \ Reset to one at CR end of input. + THEN \ end of test for a declared CR; 8may2010 + 1 upnext +! + upnext @ 1 = IF + obstat @ 0 = IF + kbpsi @ lopsi ! + 0 kbpsi ! + lopsi @ urpsi ! + 3535 caller ! + pho @ 64 > IF + urpsi @ qup @ = IF + urpsi @ vacpsi ! \ prep to deglobalize; 27sep2010 + urpsi @ psi ! VerbAct + 0 vacpsi ! \ reset for safety; 27sep2010 + THEN + THEN + hipsi @ lopsi ! + 0 caller ! + 0 urpsi ! + 1 obstat ! + THEN + THEN \ AudInput; 14jul2012 + bias @ 5 = IF \ If EnParser expects a noun; 6aug2011 + pho @ 83 = IF \ If "83=S"; 6aug2011 + 2 num ! \ Assign plural number; 6aug2011 + 2 ocn ! \ Dislodgeable old-concept number; 14oct2011 + THEN \ Only terminating "S" governs "num" 6aug2011 + pho @ 0 > IF \ Disregard empty pho; 6aug2011 + pho @ 32 = NOT IF \ Disregard SPACE; 6aug2011 + pho @ 13 = NOT IF \ Disregard CR; 6aug2011 + pho @ 83 = NOT IF \ If other than "S"; 6aug2011 + recnum @ 0 > IF \ if recognized; 4nov2011 + recnum @ num ! \ transfer value; 14jul2012 + recnum @ ocn ! \ transfer value; 14jul2012 + ELSE \ for non-S words w. no recnum; 16jul2012 + 0 num ! \ default non-plural; 14jul2011 + 0 ocn ! \ default non-plural; 14jul2012 + THEN \ end of recognition-test; 4nov2011 + ELSE \ if there is a recnum; 16jul2012 + recnum @ num ! \ transfer value; 16jul2012 + recnum @ ocn ! \ transfer value; 16jul2012 + THEN \ If last letter is not "S"; 6aug2011 + THEN \ End of test for carriage-return 6aug2011 + THEN \ End of test for SPACE; 6aug2011 + THEN \ End of test for empty pho; 6aug2011 + THEN \ End of test for noun-expected; 6aug2011 + THEN \ end of test for pov "35=#" internal reentry + pov @ 42 = IF ( during external input ) + AudListen + pho @ 0 > IF \ If a character comes in; 14nov2012 + AudBuffer \ For external input; 14nov2012 + THEN \ end of test for a positive "pho"; 14mov2012 + pho @ 0 > IF + 0 kbtv ! + 1 upnext +! + upnext @ 1 = IF + hipsi @ urpsi ! \ What-do queries require + hipsi @ lopsi ! \ Preventing a residuum lets + 0 caller ! \ SelfRef answer I DO NOT KNOW + 0 urpsi ! \ if no direct object is active. + THEN + 400 rsvp ! ( give more time ) + THEN + I 138 = IF + rsvp @ 250 > IF 100 rsvp ! THEN + THEN + I 139 = IF + pho @ 0 = IF + rsvp @ 1 - rsvp ! + rsvp @ 2 < IF 400 rsvp ! THEN + THEN + THEN + pho @ 32 = pho @ 13 = OR IF + 0 phodex ! \ Reset for AudBuffer; 14nov2012 + pho @ 13 = IF 10 EMIT THEN + prepho @ 83 = IF + 0 t @ 1 - 4 aud{ ! + 0 prepho ! + THEN + THEN + bias @ 5 = IF \ If EnParser expects a noun 26may2011 + pho @ 83 = IF \ If "S" + 2 num ! \ Assign plural number; 26may2011 + THEN \ Only terminating "S" governs "num" 26may2011 + pho @ 0 > IF \ Disregard empty pho; 26may2011 + pho @ 32 = NOT IF \ Disregard SPACE; 26may2011 + pho @ 13 = NOT IF \ Disregard CR; 26may2011 + pho @ 83 = NOT IF \ If other than "S" 26may2011 + 0 num ! \ Let "0" be default singular; 4nov2011 + singflag @ 1 = IF \ article "a"? 4nov2011 + 1 num ! \ Assume singular number; 26may2011 + THEN \ end of test to override default; 4nov2011 + THEN \ If last letter is not "S"; 26may2011 + THEN \ End of test for carriage-return 26may2011 + THEN \ End of test for SPACE; 26may2011 + THEN \ End of test for empty pho; 26may2011 + THEN \ End of test for noun-expected; 26may2011 + THEN \ End of test for external input + pho @ 0 > IF + 1 t +! + THEN + I 139 = IF \ near end of input loop? 16oct2011 + 1 inert +! \ increment inert-flag by one; 16oct2011 + THEN \ end of test for near-end of wait; 16oct2011 + pho @ 13 = IF ( carriage-return; 24jan2013 ) + 1 audrun ! \ Reset to one at CR end of input. + 1 beg ! + 13 eot ! + 1 lastword ! + 32 pho ! 10 EMIT CR \ 7sep2011 + 0 proxcon ! \ reset at end of input; 7sep2011 + 1 quiet ! + \ 0 seqneed ! \ test; 30jun2012 + \ 0 seqneed ! \ C-ing out for object-less verbs 24jan2013 + THEN ( http://www.inventio.co.uk ) + pho @ 27 = IF + CR ." AudInput: halt" 0 pho ! 0 fyi ! 0 nounval ! + CR ." You may enter .psi .en .aud to view memory " + ." engrams, or " CR ." MainLoop [ENTER] to erase " + ." memories and run the AI again." + 0 lopsi ! 0 hipsi ! + 0 audpsi ! 0 newpsi ! 0 oldpsi ! 0 stempsi ! + QUIT + THEN + pho @ 32 = IF ( space-bar; 24jan2013 ) + prepho @ penultpho ! + 1 audrun ! \ Reset to unity at end of a word. + 1 ordo +! + audpsi @ urpsi ! + ordo @ 1 = IF audpsi @ firstword ! THEN \ 19aug2011 + 0 upnext ! + t @ spt ! + t @ 1 - tult ! + 0 tult @ 4 aud{ ! + audpsi @ 0 > IF + 0 sublen ! + onset @ aud ! + 0 onset ! + audpsi @ tult @ 5 aud{ ! + pov @ 42 = IF + tult @ 0 aud{ @ 83 = IF + tult @ 1- 5 aud{ @ audpsi @ = NOT IF + 0 tult @ 1- 4 aud{ ! + THEN + audpsi @ tult @ 1- 5 aud{ ! + THEN + THEN + audpsi @ hipsi ! + audpsi @ oldpsi ! + OldConcept + eot @ 13 = IF + 35 pov ! + THEN + 0 psi ! + 0 audpsi ! + 0 aud ! + ELSE + len @ 0 > IF + onset @ aud ! + hipsi @ lopsi ! + 1 wordend ! + NewConcept + psi @ hipsi ! + nen @ tult @ 5 aud{ ! + nen @ tult @ 1- 5 aud{ ! + nen @ retropsi ! + THEN + THEN + AudDamp + 0 len ! + 0 aud ! + eot @ 13 = IF + 5 bias ! + THEN + 0 psi ! + THEN \ end of test for 13=SPACE; 24jan2013 + 1 beg ! + 1 ctu ! + spt @ 1 + onset ! + t @ onset @ = IF 1 beg ! ELSE 0 beg ! THEN + pho @ 32 > IF + 1 len +! + AudMem + THEN + eot @ 13 = IF + 5 bias ! + 1 quiet ! + THEN + eot @ 0 > IF + eot @ 14 = IF + 1 quiet ! + 0 eot ! + 0 pho ! + LEAVE + THEN + 14 eot ! + THEN + pho @ 0 > IF + pho @ prepho ! + THEN + 0 pho ! + LOOP + hipsi @ kbpsi ! + 0 newpsi ! + 0 wordend ! +; ( http://code.google.com/p/mindforth/wiki/AudInput ) + + +: SensoryInput ( sensory input channels ) + ( SMELL -- normal sensory stub for later implementation ) + ( VISION -- normal sensory stub for seed AI expansion ) + ( TOUCH -- normal haptics stub for cybernetic organisms ) + ( TASTE -- normal sensory stub for cyborg alife ) + ( SYNAESTHESIA -- an option in a multisensory AI ) + fyi @ 2 = IF + ." SensoryInput calls AudInput." CR + THEN + AudInput ( for entry or reentry of phonemic ASCII ) + ( COMPASS -- exotic sensory stub for use in robots ) + ( GEIGER -- exotic: Geiger counter ) + ( GPS -- exotic: Global Positioning System ) + ( INFRARED -- exotic ) + ( RADAR -- exotic: RAdio Detection And Ranging ) + ( SONAR -- exotic: SOund Navigation And Ranging ) + ( VSA -- exotic: Voice Stress Analyzer lie detector ) + ( Wi-Fi -- exotic: 802.11 wireless fidelity ) +; ( http://code.google.com/p/mindforth/wiki/SensoryInput ) + + +: EnBoot ( English bootstrap of initial concepts ) + 0 act ! 0 jux ! 35 pov ! 0 t ! t @ spt ! + ." clearing memory" + CR ." There is no warranty for what this software does." + ( ERROR -- first word so any bug will announce itself ) + 1 t ! 69 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 2 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 3 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 4 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 5 t ! 82 pho ! 0 beg ! 0 ctu ! 586 audpsi ! AudMem \ R +586 nen ! 3 mfn ! 0 dba ! 586 fex ! 5 pos ! 586 fin ! 1 aud ! +586 psi ! 1 num ! 0 pre ! 0 seq ! 586 enx ! EnVocab InNativate + + ( A -- English article for EnArticle module; 8 nov2012 ) + 7 t ! 65 pho ! 1 beg ! 0 ctu ! 101 audpsi ! AudMem \ A +101 nen ! 0 mfn ! 0 dba ! 101 fex ! 1 pos ! 101 fin ! 7 aud ! +101 psi ! 1 num ! 0 pre ! 0 seq ! 101 enx ! EnVocab InNativate + + ( ALL -- for machine reasoning logic; 8nov2012 ) + 9 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 10 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 11 t ! 76 pho ! 0 beg ! 0 ctu ! 123 audpsi ! AudMem \ L +123 nen ! 0 mfn ! 0 dba ! 123 fex ! 1 pos ! 123 fin ! 9 aud ! +123 psi ! 0 num ! 0 pre ! 0 seq ! 123 enx ! EnVocab InNativate + + ( AN -- to be selected instead of "A" before a vowel ) + 13 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 14 t ! 78 pho ! 0 beg ! 0 ctu ! 102 audpsi ! AudMem \ N +102 nen ! 0 mfn ! 0 dba ! 102 fex ! 1 pos ! 102 fin ! 13 aud ! +102 psi ! 0 num ! 0 pre ! 0 seq ! 102 enx ! EnVocab InNativate + + ( AND -- for machine reasoning logic; 8nov2012 ) + 16 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 17 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 18 t ! 68 pho ! 0 beg ! 0 ctu ! 302 audpsi ! AudMem \ D +302 nen ! 0 mfn ! 0 dba ! 302 fex ! 3 pos ! 302 fin ! 16 aud ! +302 psi ! 0 num ! 0 pre ! 0 seq ! 302 enx ! EnVocab InNativate + + ( ANY -- for machine reasoning logic; 8nov2012 ) + 20 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 21 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 22 t ! 89 pho ! 0 beg ! 0 ctu ! 111 audpsi ! AudMem \ Y +111 nen ! 0 mfn ! 0 dba ! 111 fex ! 1 pos ! 111 fin ! 20 aud ! +111 psi ! 0 num ! 0 pre ! 0 seq ! 111 enx ! EnVocab InNativate + + ( ANYTHING -- a default direct object for AskUser; 8nov2012 ) + 24 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 25 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 26 t ! 89 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 27 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 28 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 29 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 30 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 31 t ! 71 pho ! 0 beg ! 0 ctu ! 711 audpsi ! AudMem \ G +711 nen ! 0 mfn ! 4 dba ! 711 fex ! 7 pos ! 711 fin ! 24 aud ! +711 psi ! 0 num ! 0 pre ! 0 seq ! 711 enx ! EnVocab InNativate + + ( BAD -- adjective for EnAdjective module; 8nov2012 ) + 33 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 34 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 35 t ! 68 pho ! 0 beg ! 0 ctu ! 186 audpsi ! AudMem \ D +186 nen ! 0 mfn ! 0 dba ! 186 fex ! 1 pos ! 186 fin ! 33 aud ! +186 psi ! 0 num ! 0 pre ! 0 seq ! 186 enx ! EnVocab InNativate + + ( BE -- infinitive impersonal form of 800=BE; 8nov2012 ) + 37 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 38 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 0 dba ! 800 fex ! 8 pos ! 800 fin ! 37 aud ! +800 psi ! 0 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( AM -- 1st person singular I-form of 800=BE; 8nov2012 ) + 40 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 41 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 40 aud ! +800 psi ! 1 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 2nd person singular YOU-form of 800=BE; 8nov2012 ) + 43 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 44 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 45 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 2 dba ! 800 fex ! 8 pos ! 800 fin ! 43 aud ! +800 psi ! 1 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( IS -- 3rd person singular HE-SHE-IT-form of 800=BE; 8nov2102 ) + 47 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 48 t ! 83 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ S +800 nen ! 0 mfn ! 3 dba ! 800 fex ! 8 pos ! 800 fin ! 47 aud ! +800 psi ! 1 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 1st person plural WE-form of 800=BE; 8nov2012 ) + 50 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 51 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 52 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 50 aud ! +800 psi ! 2 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 2nd person plural YOU-form of 800=BE; 4nov2012 ) + 54 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 55 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 56 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 2 dba ! 800 fex ! 8 pos ! 800 fin ! 54 aud ! +800 psi ! 2 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( ARE -- 3rd person plural THEY-form of 800=BE; 8nov2012 ) + 58 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 59 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 60 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 3 dba ! 800 fex ! 8 pos ! 800 fin ! 58 aud ! +800 psi ! 2 num ! 0 pre ! 0 seq ! 800 enx ! EnVocab InNativate + + ( BECAUSE -- for machine reasoning logic; 9nov2012 ) + 62 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 63 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 64 t ! 67 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 65 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 66 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 67 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 68 t ! 69 pho ! 0 beg ! 0 ctu ! 344 audpsi ! AudMem \ E +344 nen ! 0 mfn ! 0 dba ! 344 fex ! 3 pos ! 344 fin ! 62 aud ! +344 psi ! 0 num ! 0 pre ! 0 seq ! 344 enx ! EnVocab InNativate + + ( BECOME -- essential intransitive verb; 9nov2012 ) + 70 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 71 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 72 t ! 67 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 73 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 74 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 75 t ! 69 pho ! 0 beg ! 0 ctu ! 808 audpsi ! AudMem \ E +808 nen ! 0 mfn ! 0 dba ! 808 fex ! 8 pos ! 808 fin ! 70 aud ! +808 psi ! 0 num ! 0 pre ! 0 seq ! 808 enx ! EnVocab InNativate + + ( BOY -- always masculine noun for use with gender flags ) + 77 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 78 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 79 t ! 89 pho ! 0 beg ! 0 ctu ! 589 audpsi ! AudMem \ Y +589 nen ! 1 mfn ! 0 dba ! 589 fex ! 5 pos ! 589 fin ! 77 aud ! +589 psi ! 1 num ! 0 pre ! 0 seq ! 589 enx ! EnVocab InNativate + + ( BUT -- conjunction for ConJoin module; 9nov2012 ) + 81 t ! 66 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 82 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 83 t ! 84 pho ! 0 beg ! 0 ctu ! 305 audpsi ! AudMem \ T +305 nen ! 0 mfn ! 0 dba ! 305 fex ! 3 pos ! 305 fin ! 81 aud ! +305 psi ! 0 num ! 0 pre ! 0 seq ! 305 enx ! EnVocab InNativate + +( CHESS -- important singular AI noun ending in "S"; 9nov2012 ) + 85 t ! 67 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 86 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 87 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 88 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 89 t ! 83 pho ! 0 beg ! 0 ctu ! 564 audpsi ! AudMem \ S +564 nen ! 0 mfn ! 0 dba ! 564 fex ! 5 pos ! 564 fin ! 85 aud ! +564 psi ! 1 num ! 0 pre ! 0 seq ! 564 enx ! EnVocab InNativate + +( CHILD -- example of irregular noun for a polyglot AI Mind ) + 91 t ! 67 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 92 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 93 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 94 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 95 t ! 68 pho ! 0 beg ! 0 ctu ! 525 audpsi ! AudMem \ D +525 nen ! 0 mfn ! 0 dba ! 525 fex ! 5 pos ! 525 fin ! 91 aud ! +525 psi ! 1 num ! 0 pre ! 0 seq ! 525 enx ! EnVocab InNativate + +( CHILDREN -- irregular plural for retrieval by parameters ) + 97 t ! 67 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ C + 98 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 99 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 100 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 101 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 102 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 103 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 104 t ! 78 pho ! 0 beg ! 0 ctu ! 526 audpsi ! AudMem \ N +526 nen ! 0 mfn ! 0 dba ! 526 fex ! 5 pos ! 526 fin ! 97 aud ! +526 psi ! 2 num ! 0 pre ! 0 seq ! 526 enx ! EnVocab InNativate + + ( DATA -- always plural noun in correction of modern usage ) + 106 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 107 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 108 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 109 t ! 65 pho ! 0 beg ! 0 ctu ! 599 audpsi ! AudMem \ A +599 nen ! 0 mfn ! 0 dba ! 599 fex ! 5 pos ! 599 fin ! 106 aud ! +599 psi ! 2 num ! 0 pre ! 0 seq ! 599 enx ! EnVocab InNativate + + ( DO -- infinitive form of verb essential for AuxVerb module ) + 111 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 112 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 0 dba ! 830 fex ! 8 pos ! 830 fin ! 111 aud ! +830 psi ! 0 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 1st person singular I-form of auxiliary verb; 9nov2012 ) + 114 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 115 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 1 dba ! 830 fex ! 8 pos ! 830 fin ! 114 aud ! +830 psi ! 1 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 2nd person sing. YOU-form of auxiliary verb; 9nov2012 ) + 117 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 118 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 2 dba ! 830 fex ! 8 pos ! 830 fin ! 117 aud ! +830 psi ! 1 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DOES -- 3rd person sing. HE-SHE-IT-form of auxiliary verb ) + 120 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 121 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 122 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 123 t ! 83 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ S +830 nen ! 0 mfn ! 3 dba ! 830 fex ! 8 pos ! 830 fin ! 120 aud ! +830 psi ! 1 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 1st person plural WE-form of auxiliary verb; 9nov2012 ) + 125 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 126 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 1 dba ! 830 fex ! 8 pos ! 830 fin ! 125 aud ! +830 psi ! 2 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 2nd person plural YOU-form of auxiliary verb; 9nov2012 ) + 128 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 129 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 2 dba ! 830 fex ! 8 pos ! 830 fin ! 128 aud ! +830 psi ! 2 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DO -- 3rd person plural THEY-form of auxiliary verb; 9nov2012 ) + 131 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 132 t ! 79 pho ! 0 beg ! 0 ctu ! 830 audpsi ! AudMem \ O +830 nen ! 0 mfn ! 3 dba ! 830 fex ! 8 pos ! 830 fin ! 131 aud ! +830 psi ! 2 num ! 0 pre ! 0 seq ! 830 enx ! EnVocab InNativate + + ( DOING -- high word-frequency verb participle; 9nov2102 ) + 134 t ! 68 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 135 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 136 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 137 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 138 t ! 71 pho ! 0 beg ! 0 ctu ! 183 audpsi ! AudMem \ G +183 nen ! 0 mfn ! 0 dba ! 183 fex ! 1 pos ! 183 fin ! 134 aud ! +183 psi ! 0 num ! 0 pre ! 0 seq ! 183 enx ! EnVocab InNativate + + ( ELSE -- adverb for machine reasoning logic; 9nov2012 ) + 140 t ! 69 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 141 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 142 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 143 t ! 69 pho ! 0 beg ! 0 ctu ! 266 audpsi ! AudMem \ E +266 nen ! 0 mfn ! 0 dba ! 266 fex ! 2 pos ! 266 fin ! 140 aud ! +266 psi ! 0 num ! 0 pre ! 0 seq ! 266 enx ! EnVocab InNativate + + ( FOR -- preposition for EnPrep module; 9nov2012 ) + 145 t ! 70 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ F + 146 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 147 t ! 82 pho ! 0 beg ! 0 ctu ! 640 audpsi ! AudMem \ R +640 nen ! 0 mfn ! 0 dba ! 640 fex ! 6 pos ! 640 fin ! 145 aud ! +640 psi ! 0 num ! 0 pre ! 0 seq ! 640 enx ! EnVocab InNativate + + ( FRIEND -- for coding assignment of ad-hoc gender tags ) + 149 t ! 70 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ F + 150 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 151 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 152 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 153 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 154 t ! 68 pho ! 0 beg ! 0 ctu ! 517 audpsi ! AudMem \ D +517 nen ! 0 mfn ! 0 dba ! 517 fex ! 5 pos ! 517 fin ! 149 aud ! +517 psi ! 1 num ! 0 pre ! 0 seq ! 517 enx ! EnVocab InNativate + + ( GIRL -- always feminine noun for use with gender flags ) + 156 t ! 71 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 157 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 158 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 159 t ! 76 pho ! 0 beg ! 0 ctu ! 510 audpsi ! AudMem \ L +510 nen ! 2 mfn ! 0 dba ! 510 fex ! 5 pos ! 510 fin ! 156 aud ! +510 psi ! 1 num ! 0 pre ! 0 seq ! 510 enx ! EnVocab InNativate + + ( GOD -- masculine noun important for philosophy of AI ) + 161 t ! 71 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 162 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 163 t ! 68 pho ! 0 beg ! 0 ctu ! 533 audpsi ! AudMem \ D +533 nen ! 1 mfn ! 0 dba ! 533 fex ! 5 pos ! 533 fin ! 161 aud ! +533 psi ! 1 num ! 0 pre ! 0 seq ! 533 enx ! EnVocab InNativate + +( GOOD -- adjective for EnAdjective module; 9nov2012 ) + 165 t ! 71 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 166 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 167 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 168 t ! 68 pho ! 0 beg ! 0 ctu ! 140 audpsi ! AudMem \ D +140 nen ! 0 mfn ! 0 dba ! 140 fex ! 1 pos ! 140 fin ! 165 aud ! +140 psi ! 0 num ! 0 pre ! 0 seq ! 140 enx ! EnVocab InNativate + +( HAVE -- irregular high-word-frequency verb; 9nov2012 ) + 170 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 171 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 172 t ! 86 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ V + 173 t ! 69 pho ! 0 beg ! 0 ctu ! 810 audpsi ! AudMem \ E +810 nen ! 0 mfn ! 0 dba ! 810 fex ! 8 pos ! 810 fin ! 170 aud ! +810 psi ! 0 num ! 0 pre ! 0 seq ! 810 enx ! EnVocab InNativate + +( HAS -- high-word-frequency irregular verb form; 9nov2012 ) + 175 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 176 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 177 t ! 83 pho ! 0 beg ! 0 ctu ! 810 audpsi ! AudMem \ S +810 nen ! 0 mfn ! 3 dba ! 810 fex ! 8 pos ! 810 fin ! 175 aud ! +810 psi ! 1 num ! 0 pre ! 0 seq ! 810 enx ! EnVocab InNativate + +( HE -- nominative form of high-word-frequency pronoun; 9nov2012 ) + 179 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 180 t ! 69 pho ! 0 beg ! 0 ctu ! 713 audpsi ! AudMem \ E +713 nen ! 1 mfn ! 1 dba ! 713 fex ! 7 pos ! 713 fin ! 179 aud ! +713 psi ! 1 num ! 0 pre ! 0 seq ! 713 enx ! EnVocab InNativate + +( HIS -- genitive form of personal pronoun; 9nov2012 ) + 182 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 183 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 184 t ! 83 pho ! 0 beg ! 0 ctu ! 113 audpsi ! AudMem \ S +113 nen ! 1 mfn ! 2 dba ! 113 fex ! 1 pos ! 113 fin ! 182 aud ! +113 psi ! 1 num ! 0 pre ! 0 seq ! 113 enx ! EnVocab InNativate + +( HIM -- dative indirect-object form of personal pronoun ) + 186 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 187 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 188 t ! 77 pho ! 0 beg ! 0 ctu ! 713 audpsi ! AudMem \ M +713 nen ! 1 mfn ! 3 dba ! 713 fex ! 7 pos ! 713 fin ! 186 aud ! +713 psi ! 1 num ! 0 pre ! 0 seq ! 713 enx ! EnVocab InNativate + +( HIM -- accusative direct-object form of personal pronoun ) + 190 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 191 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 192 t ! 77 pho ! 0 beg ! 0 ctu ! 713 audpsi ! AudMem \ M +713 nen ! 1 mfn ! 4 dba ! 713 fex ! 7 pos ! 713 fin ! 190 aud ! +713 psi ! 1 num ! 0 pre ! 0 seq ! 713 enx ! EnVocab InNativate + +( HELLO -- interjection for human-computer interaction; 9nov2012 ) + 194 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 195 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 196 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 197 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 198 t ! 79 pho ! 0 beg ! 0 ctu ! 450 audpsi ! AudMem \ O +450 nen ! 0 mfn ! 0 dba ! 450 fex ! 4 pos ! 450 fin ! 194 aud ! +450 psi ! 0 num ! 0 pre ! 0 seq ! 450 enx ! EnVocab InNativate + +( HERE -- adverb for discussion of physical location; 9nov2012 ) + 200 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 201 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 202 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 203 t ! 69 pho ! 0 beg ! 0 ctu ! 201 audpsi ! AudMem \ E +201 nen ! 0 mfn ! 0 dba ! 201 fex ! 2 pos ! 201 fin ! 200 aud ! +201 psi ! 0 num ! 0 pre ! 0 seq ! 201 enx ! EnVocab InNativate + +( HOW -- adverb for EnAdverb module; 10nov2012 ) + 205 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 206 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 207 t ! 87 pho ! 0 beg ! 0 ctu ! 209 audpsi ! AudMem \ W +209 nen ! 0 mfn ! 0 dba ! 209 fex ! 2 pos ! 209 fin ! 205 aud ! +209 psi ! 0 num ! 0 pre ! 0 seq ! 209 enx ! EnVocab InNativate + +( I -- nominative subject-form of personal pronoun; 10nov2012 ) + 209 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 209 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( MINE -- genitive form of personal pronoun; 10nov2012 ) + 211 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 212 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 213 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 214 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 2 dba ! 701 fex ! 7 pos ! 707 fin ! 211 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( ME -- dative indirect-object form of pers. pronoun; 10nov2012 ) + 216 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 217 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 3 dba ! 701 fex ! 7 pos ! 707 fin ! 216 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( ME -- accusative direct-obj. form of pers. pronoun; 10nov2012 ) + 219 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 220 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 4 dba ! 701 fex ! 7 pos ! 707 fin ! 219 aud ! +701 psi ! 1 num ! 0 pre ! 0 seq ! 701 enx ! EnVocab InNativate + +( IF -- for machine reasoning logic; 10nov2012 ) + 222 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 223 t ! 70 pho ! 0 beg ! 0 ctu ! 390 audpsi ! AudMem \ F +390 nen ! 0 mfn ! 0 dba ! 390 fex ! 3 pos ! 390 fin ! 222 aud ! +390 psi ! 0 num ! 0 pre ! 0 seq ! 390 enx ! EnVocab InNativate + +( IN -- preposition for EnPrep module; 10nov2012 ) + 225 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 226 t ! 78 pho ! 0 beg ! 0 ctu ! 639 audpsi ! AudMem \ N +639 nen ! 0 mfn ! 0 dba ! 639 fex ! 6 pos ! 639 fin ! 225 aud ! +639 psi ! 0 num ! 0 pre ! 0 seq ! 639 enx ! EnVocab InNativate + +( IT -- nominative subject-form of personal pronoun; 10nov2012 ) + 228 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 229 t ! 84 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ T +725 nen ! 3 mfn ! 1 dba ! 725 fex ! 7 pos ! 725 fin ! 228 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( ITS -- genitive form of personal pronoun; 10nov2012 + 231 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 232 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 233 t ! 83 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ S +725 nen ! 3 mfn ! 2 dba ! 725 fex ! 7 pos ! 725 fin ! 231 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( IT -- dative indirect-object form of pers. pronoun; 10nov2012 ) + 235 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 236 t ! 84 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ T +725 nen ! 3 mfn ! 3 dba ! 725 fex ! 7 pos ! 725 fin ! 235 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( IT -- accusative direct-obj. form of pers. pronoun; 10nov2012 ) + 238 t ! 73 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 239 t ! 84 pho ! 0 beg ! 0 ctu ! 725 audpsi ! AudMem \ T +725 nen ! 3 mfn ! 4 dba ! 725 fex ! 7 pos ! 725 fin ! 238 aud ! +725 psi ! 1 num ! 0 pre ! 0 seq ! 725 enx ! EnVocab InNativate + +( KNOW -- germane to artificial intelligence; 10nov2012 ) + 241 t ! 75 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 242 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 243 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 244 t ! 87 pho ! 0 beg ! 0 ctu ! 850 audpsi ! AudMem \ W +850 nen ! 0 mfn ! 0 dba ! 850 fex ! 8 pos ! 850 fin ! 241 aud ! +850 psi ! 0 num ! 0 pre ! 0 seq ! 850 enx ! EnVocab InNativate + +( MAN -- always masculine noun for use with gender flags ) + 246 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 247 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 248 t ! 78 pho ! 0 beg ! 0 ctu ! 543 audpsi ! AudMem \ N +543 nen ! 1 mfn ! 1 dba ! 543 fex ! 5 pos ! 543 fin ! 246 aud ! +543 psi ! 1 num ! 0 pre ! 0 seq ! 543 enx ! EnVocab InNativate + +( MEN -- irregular plural for retrieval by parameters 10nov2012 ) + 250 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 251 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 252 t ! 78 pho ! 0 beg ! 0 ctu ! 543 audpsi ! AudMem \ N +543 nen ! 1 mfn ! 1 dba ! 543 fex ! 5 pos ! 543 fin ! 250 aud ! +543 psi ! 2 num ! 0 pre ! 0 seq ! 543 enx ! EnVocab InNativate + +( MAYBE -- adverb response alternative to YES or NO; 10nov2012 ) + 254 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 255 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 256 t ! 89 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 257 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 258 t ! 69 pho ! 0 beg ! 0 ctu ! 270 audpsi ! AudMem \ E +270 nen ! 0 mfn ! 0 dba ! 270 fex ! 2 pos ! 270 fin ! 254 aud ! +270 psi ! 0 num ! 0 pre ! 0 seq ! 270 enx ! EnVocab InNativate + +( MEDIA -- always plural noun in correction of modern usage ) + 260 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 261 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 262 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 263 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 264 t ! 65 pho ! 0 beg ! 0 ctu ! 584 audpsi ! AudMem \ A +584 nen ! 0 mfn ! 0 dba ! 584 fex ! 5 pos ! 584 fin ! 260 aud ! +584 psi ! 2 num ! 0 pre ! 0 seq ! 584 enx ! EnVocab InNativate + +( MY -- adjective for personal pronoun "I"; 10nov2012 ) + 266 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 267 t ! 89 pho ! 0 beg ! 0 ctu ! 181 audpsi ! AudMem \ Y +181 nen ! 0 mfn ! 0 dba ! 181 fex ! 1 pos ! 182 fin ! 266 aud ! +181 psi ! 0 num ! 0 pre ! 0 seq ! 181 enx ! EnVocab InNativate + +( NO -- interjection for human-computer interaction; 10nov2012 ) + 269 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 270 t ! 79 pho ! 0 beg ! 0 ctu ! 404 audpsi ! AudMem \ O +404 nen ! 0 mfn ! 0 dba ! 404 fex ! 4 pos ! 404 fin ! 269 aud ! +404 psi ! 0 num ! 0 pre ! 0 seq ! 404 enx ! EnVocab InNativate + +( NOT -- adverb for machine reasoning logic; 10nov2012 ) + 272 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 273 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 274 t ! 84 pho ! 0 beg ! 0 ctu ! 250 audpsi ! AudMem \ T +250 nen ! 0 mfn ! 0 dba ! 250 fex ! 2 pos ! 250 fin ! 272 aud ! +250 psi ! 0 num ! 0 pre ! 0 seq ! 250 enx ! EnVocab InNativate + + ( NOTHING -- VisRecog default for what the AI Mind sees ) + 276 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 277 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 278 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 279 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 280 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 281 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 282 t ! 71 pho ! 0 beg ! 0 ctu ! 760 audpsi ! AudMem \ G +760 nen ! 0 mfn ! 0 dba ! 760 fex ! 7 pos ! 760 fin ! 276 aud ! +760 psi ! 1 num ! 0 pre ! 0 seq ! 760 enx ! EnVocab InNativate + +( OF -- preposition for EnPrep module ) + 284 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 285 t ! 70 pho ! 0 beg ! 0 ctu ! 604 audpsi ! AudMem \ F +604 nen ! 0 mfn ! 0 dba ! 604 fex ! 6 pos ! 604 fin ! 284 aud ! +604 psi ! 0 num ! 0 pre ! 0 seq ! 604 enx ! EnVocab InNativate + +( OR -- conjunction for machine reasoning logic; 10nov2012 ) + 287 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 288 t ! 82 pho ! 0 beg ! 0 ctu ! 324 audpsi ! AudMem \ R +324 nen ! 0 mfn ! 0 dba ! 324 fex ! 3 pos ! 324 fin ! 287 aud ! +324 psi ! 0 num ! 0 pre ! 0 seq ! 324 enx ! EnVocab InNativate + +( OUR -- adjective for personal pronoun "WE"; 10nov2012 ) + 290 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 291 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 292 t ! 82 pho ! 0 beg ! 0 ctu ! 186 audpsi ! AudMem \ R +186 nen ! 0 mfn ! 0 dba ! 186 fex ! 1 pos ! 182 fin ! 290 aud ! +186 psi ! 0 num ! 0 pre ! 0 seq ! 186 enx ! EnVocab InNativate + +( PEOPLE -- establish as plural for EnParser ) + 294 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 295 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 296 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 297 t ! 80 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 298 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 299 t ! 69 pho ! 0 beg ! 0 ctu ! 587 audpsi ! AudMem \ E +587 nen ! 0 mfn ! 0 dba ! 587 fex ! 5 pos ! 587 fin ! 294 aud ! +587 psi ! 2 num ! 0 pre ! 0 seq ! 587 enx ! EnVocab InNativate + +( PERSON -- for ad-hoc gender tags and robot philosophy ) + 301 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 302 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 303 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 304 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 305 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 306 t ! 78 pho ! 0 beg ! 0 ctu ! 537 audpsi ! AudMem \ N +537 nen ! 0 mfn ! 0 dba ! 537 fex ! 5 pos ! 537 fin ! 301 aud ! +537 psi ! 1 num ! 0 pre ! 0 seq ! 537 enx ! EnVocab InNativate + +( PLEASE -- interjection for human-computer interaction ) + 308 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 309 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 310 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 311 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 312 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 313 t ! 69 pho ! 0 beg ! 0 ctu ! 410 audpsi ! AudMem \ E +410 nen ! 0 mfn ! 0 dba ! 410 fex ! 4 pos ! 410 fin ! 308 aud ! +410 psi ! 0 num ! 0 pre ! 0 seq ! 410 enx ! EnVocab InNativate + +( SEE -- lets VisRecog dynamically report non-KB direct objects ) + 315 t ! 83 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 316 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 317 t ! 69 pho ! 0 beg ! 0 ctu ! 820 audpsi ! AudMem \ E +820 nen ! 0 mfn ! 0 dba ! 820 fex ! 8 pos ! 820 fin ! 315 aud ! +820 psi ! 0 num ! 0 pre ! 0 seq ! 820 enx ! EnVocab InNativate + +( SHE -- nominative subject-form of personal pronoun; 10nov2012 ) + 319 t ! 83 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 320 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 321 t ! 69 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ E +719 nen ! 2 mfn ! 1 dba ! 719 fex ! 7 pos ! 719 fin ! 319 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( HERS -- genitive form of personal pronoun; 10nov2012 ) + 323 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 324 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 325 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 326 t ! 83 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ S +719 nen ! 2 mfn ! 2 dba ! 719 fex ! 7 pos ! 719 fin ! 323 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( HER -- dative indirect-object form of pers. pron. 9nov2012 ) + 328 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 329 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 330 t ! 82 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ R +719 nen ! 2 mfn ! 3 dba ! 719 fex ! 7 pos ! 719 fin ! 328 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( HER -- accusative direct-object form of pers. pron. 9nov2012 ) + 332 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 333 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 334 t ! 82 pho ! 0 beg ! 0 ctu ! 719 audpsi ! AudMem \ R +719 nen ! 2 mfn ! 4 dba ! 719 fex ! 7 pos ! 719 fin ! 332 aud ! +719 psi ! 1 num ! 0 pre ! 0 seq ! 719 enx ! EnVocab InNativate + +( SOME -- adjective for machine reasoning logic; 10nov2012 ) + 336 t ! 83 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 337 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 338 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 339 t ! 69 pho ! 0 beg ! 0 ctu ! 123 audpsi ! AudMem \ E +123 nen ! 0 mfn ! 0 dba ! 123 fex ! 1 pos ! 123 fin ! 336 aud ! +123 psi ! 0 num ! 0 pre ! 0 seq ! 123 enx ! EnVocab InNativate + +( THAT -- high word-frequency pronoun; 10nov2012 ) + 341 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 342 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 343 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 344 t ! 84 pho ! 0 beg ! 0 ctu ! 745 audpsi ! AudMem \ T +745 nen ! 0 mfn ! 0 dba ! 745 fex ! 7 pos ! 745 fin ! 341 aud ! +745 psi ! 1 num ! 0 pre ! 0 seq ! 745 enx ! EnVocab InNativate + +( THE -- EnArticle highest-frequency English word; 10nov2012 ) + 346 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 347 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 348 t ! 69 pho ! 0 beg ! 0 ctu ! 117 audpsi ! AudMem \ E +117 nen ! 0 mfn ! 0 dba ! 117 fex ! 1 pos ! 117 fin ! 346 aud ! +117 psi ! 0 num ! 0 pre ! 0 seq ! 117 enx ! EnVocab InNativate + +( THEIR -- adjective for personal pronoun "THEY"; 10nov2012 ) + 350 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 351 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 352 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 353 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 354 t ! 82 pho ! 0 beg ! 0 ctu ! 188 audpsi ! AudMem \ R +188 nen ! 0 mfn ! 0 dba ! 188 fex ! 1 pos ! 188 fin ! 350 aud ! +188 psi ! 0 num ! 0 pre ! 0 seq ! 188 enx ! EnVocab InNativate + +( THEN -- adverb for machine reasoning logic; 10nov2012 ) + 356 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 357 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 358 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 359 t ! 78 pho ! 0 beg ! 0 ctu ! 213 audpsi ! AudMem \ N +213 nen ! 0 mfn ! 0 dba ! 213 fex ! 2 pos ! 213 fin ! 356 aud ! +213 psi ! 0 num ! 0 pre ! 0 seq ! 213 enx ! EnVocab InNativate + +( THERE -- adv. for discussion of physical location; 10nov2012 ) + 361 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 362 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 363 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 364 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 365 t ! 69 pho ! 0 beg ! 0 ctu ! 205 audpsi ! AudMem \ E +205 nen ! 0 mfn ! 0 dba ! 205 fex ! 2 pos ! 205 fin ! 361 aud ! +205 psi ! 0 num ! 0 pre ! 0 seq ! 205 enx ! EnVocab InNativate + +( THEY -- nominative subject-form of pers. pronoun; 10nov2012 ) + 367 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 368 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 369 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 370 t ! 89 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ Y +743 nen ! 0 mfn ! 1 dba ! 743 fex ! 7 pos ! 743 fin ! 367 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THEIRS -- genitive form of personal pronoun; 10nov2012 ) + 372 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 373 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 374 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 375 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 376 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 377 t ! 83 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ S +743 nen ! 0 mfn ! 2 dba ! 743 fex ! 7 pos ! 743 fin ! 372 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THEM -- dative indirect-object form of pers. pron. 10nov2012 ) + 379 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 380 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 381 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 382 t ! 77 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ M +743 nen ! 0 mfn ! 3 dba ! 743 fex ! 7 pos ! 743 fin ! 379 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THEM -- acc. direct-object form of pers. pron. 10nov2012 ) + 384 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 385 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 386 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 387 t ! 77 pho ! 0 beg ! 0 ctu ! 743 audpsi ! AudMem \ M +743 nen ! 0 mfn ! 4 dba ! 743 fex ! 7 pos ! 743 fin ! 384 aud ! +743 psi ! 2 num ! 0 pre ! 0 seq ! 743 enx ! EnVocab InNativate + +( THINK -- germane to artificial intelligence ) + 389 t ! 84 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 390 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 391 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 392 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 393 t ! 75 pho ! 0 beg ! 0 ctu ! 840 audpsi ! AudMem \ K +840 nen ! 0 mfn ! 0 dba ! 840 fex ! 8 pos ! 840 fin ! 389 aud ! +840 psi ! 0 num ! 0 pre ! 0 seq ! 840 enx ! EnVocab InNativate + +( WE -- nominative subject-form of personal pronoun; 10nov2012 ) + 395 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 396 t ! 69 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ E +731 nen ! 0 mfn ! 1 dba ! 731 fex ! 7 pos ! 737 fin ! 395 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( OURS -- genitive form of personal pronoun; 10nov2012 ) + 398 t ! 79 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 399 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 400 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 401 t ! 83 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ S +731 nen ! 0 mfn ! 2 dba ! 731 fex ! 7 pos ! 737 fin ! 398 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( US -- dative indirect-object form of pers. pron. 10nov2012 ) + 403 t ! 85 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 404 t ! 83 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ S +731 nen ! 0 mfn ! 3 dba ! 731 fex ! 7 pos ! 737 fin ! 403 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( US -- accusative direct-object form of pers. pron. 10nov2012 ) + 406 t ! 85 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 407 t ! 83 pho ! 0 beg ! 0 ctu ! 731 audpsi ! AudMem \ S +731 nen ! 0 mfn ! 4 dba ! 731 fex ! 7 pos ! 737 fin ! 406 aud ! +731 psi ! 2 num ! 0 pre ! 0 seq ! 731 enx ! EnVocab InNativate + +( WHAT -- nominative pronoun for SelfReferentialThought ) + 409 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 410 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 411 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 412 t ! 84 pho ! 0 beg ! 0 ctu ! 781 audpsi ! AudMem \ T +781 nen ! 3 mfn ! 1 dba ! 781 fex ! 7 pos ! 781 fin ! 409 aud ! +781 psi ! 1 num ! 0 pre ! 0 seq ! 781 enx ! EnVocab InNativate + +( WHAT -- accusative pronoun for SelfReferentialThought ) + 414 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 415 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 416 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 417 t ! 84 pho ! 0 beg ! 0 ctu ! 781 audpsi ! AudMem \ T +781 nen ! 3 mfn ! 4 dba ! 781 fex ! 7 pos ! 781 fin ! 414 aud ! +781 psi ! 1 num ! 0 pre ! 0 seq ! 781 enx ! EnVocab InNativate + +( WHEN -- adverb for SelfReferentialThought; 10nov2012 ) + 419 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 420 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 421 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 422 t ! 78 pho ! 0 beg ! 0 ctu ! 263 audpsi ! AudMem \ N +263 nen ! 0 mfn ! 0 dba ! 263 fex ! 2 pos ! 263 fin ! 419 aud ! +263 psi ! 0 num ! 0 pre ! 0 seq ! 263 enx ! EnVocab InNativate + +( WHERE -- adverb for SelfReferentialThought; 10nov2012 ) + 424 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 425 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 426 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 427 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 428 t ! 69 pho ! 0 beg ! 0 ctu ! 245 audpsi ! AudMem \ E +245 nen ! 0 mfn ! 0 dba ! 245 fex ! 2 pos ! 245 fin ! 424 aud ! +245 psi ! 0 num ! 0 pre ! 0 seq ! 245 enx ! EnVocab InNativate + +( WHO -- nominative subject-form of interrogative pronoun ) + 430 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 431 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 432 t ! 79 pho ! 0 beg ! 0 ctu ! 791 audpsi ! AudMem \ O +791 nen ! 0 mfn ! 1 dba ! 791 fex ! 7 pos ! 791 fin ! 430 aud ! +791 psi ! 1 num ! 0 pre ! 0 seq ! 791 enx ! EnVocab InNativate + +( WHOSE -- genitive form of interrogative pronoun; 11nov2012 ) + 434 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 435 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 436 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 437 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 438 t ! 69 pho ! 0 beg ! 0 ctu ! 794 audpsi ! AudMem \ E +794 nen ! 0 mfn ! 2 dba ! 794 fex ! 7 pos ! 794 fin ! 434 aud ! +794 psi ! 1 num ! 0 pre ! 0 seq ! 794 enx ! EnVocab InNativate + +( WHOM -- dative indirect-object form of interrogative pronoun ) + 440 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 441 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 442 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 443 t ! 77 pho ! 0 beg ! 0 ctu ! 794 audpsi ! AudMem \ M +794 nen ! 0 mfn ! 3 dba ! 794 fex ! 7 pos ! 794 fin ! 440 aud ! +794 psi ! 1 num ! 0 pre ! 0 seq ! 794 enx ! EnVocab InNativate + +( WHOM -- accusative direct-obj. form of interrogative pronoun ) + 445 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 446 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 447 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 448 t ! 77 pho ! 0 beg ! 0 ctu ! 794 audpsi ! AudMem \ M +794 nen ! 0 mfn ! 4 dba ! 794 fex ! 7 pos ! 794 fin ! 445 aud ! +794 psi ! 1 num ! 0 pre ! 0 seq ! 794 enx ! EnVocab InNativate + +( WHY -- conjunction or adverb for machine reasoning logic ) + 450 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 451 t ! 72 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 452 t ! 89 pho ! 0 beg ! 0 ctu ! 370 audpsi ! AudMem \ Y +370 nen ! 0 mfn ! 0 dba ! 370 fex ! 3 pos ! 370 fin ! 450 aud ! +370 psi ! 0 num ! 0 pre ! 0 seq ! 370 enx ! EnVocab InNativate + +( WITH -- preposition for use with EnPrep module; 10nov2012 ) + 454 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 455 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 456 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 457 t ! 72 pho ! 0 beg ! 0 ctu ! 680 audpsi ! AudMem \ H +680 nen ! 0 mfn ! 0 dba ! 680 fex ! 6 pos ! 680 fin ! 454 aud ! +680 psi ! 0 num ! 0 pre ! 0 seq ! 680 enx ! EnVocab InNativate + +( WOMAN -- always feminine noun for use with gender flags ) + 459 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 460 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 461 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 462 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 463 t ! 78 pho ! 0 beg ! 0 ctu ! 515 audpsi ! AudMem \ N +515 nen ! 2 mfn ! 0 dba ! 515 fex ! 5 pos ! 515 fin ! 459 aud ! +515 psi ! 1 num ! 0 pre ! 0 seq ! 515 enx ! EnVocab InNativate + +( WOMEN -- irregular plural for retrieval by parameters 10nov2012 ) + 465 t ! 87 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ W + 466 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 467 t ! 77 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 468 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 469 t ! 78 pho ! 0 beg ! 0 ctu ! 515 audpsi ! AudMem \ N +515 nen ! 2 mfn ! 0 dba ! 515 fex ! 5 pos ! 515 fin ! 465 aud ! +515 psi ! 2 num ! 0 pre ! 0 seq ! 515 enx ! EnVocab InNativate + +( YES -- interjection for human-computer interaction; 10nov2012 ) + 471 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 472 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 473 t ! 83 pho ! 0 beg ! 0 ctu ! 432 audpsi ! AudMem \ S +432 nen ! 0 mfn ! 0 dba ! 432 fex ! 4 pos ! 432 fin ! 471 aud ! +432 psi ! 0 num ! 0 pre ! 0 seq ! 432 enx ! EnVocab InNativate + +( YOU -- nominative singular of personal pronoun; 10nov2012 ) + 475 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 476 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 477 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 1 dba ! 707 fex ! 7 pos ! 701 fin ! 475 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOURS -- genitive singular of personal pronoun; 10nov2012 ) + 479 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 480 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 481 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 482 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 483 t ! 83 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ S +707 nen ! 0 mfn ! 2 dba ! 707 fex ! 5 pos ! 701 fin ! 479 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOU -- dative singular of personal pronoun; 10nov2012 ) + 485 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 486 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 487 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 3 dba ! 707 fex ! 7 pos ! 701 fin ! 485 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOU -- accusatie singular of personal pronoun; 10nov2012 ) + 489 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 490 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 491 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 4 dba ! 707 fex ! 7 pos ! 701 fin ! 489 aud ! +707 psi ! 1 num ! 0 pre ! 0 seq ! 707 enx ! EnVocab InNativate + +( YOU -- nominative plural of personal pronoun; 10nov2012 ) + 493 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 494 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 495 t ! 85 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ U +737 nen ! 0 mfn ! 1 dba ! 737 fex ! 7 pos ! 731 fin ! 493 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOURS -- genitive plural of personal pronoun; 10nov2012 ) + 497 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 498 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 499 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 500 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 501 t ! 83 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ S +737 nen ! 0 mfn ! 2 dba ! 737 fex ! 5 pos ! 731 fin ! 497 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOU -- dative plural of personal pronoun; 10nov2012 ) + 503 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 504 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 505 t ! 85 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ U +737 nen ! 0 mfn ! 3 dba ! 737 fex ! 7 pos ! 731 fin ! 503 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOU -- accusatie plural of personal pronoun; 10nov2012 ) + 507 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 508 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 509 t ! 85 pho ! 0 beg ! 0 ctu ! 737 audpsi ! AudMem \ U +737 nen ! 0 mfn ! 4 dba ! 737 fex ! 7 pos ! 731 fin ! 507 aud ! +737 psi ! 2 num ! 0 pre ! 0 seq ! 737 enx ! EnVocab InNativate + +( YOUR -- adjective for personal pronoun "YOU"; 10nov2012 ) + 511 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 512 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 513 t ! 85 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ U + 514 t ! 82 pho ! 0 beg ! 0 ctu ! 182 audpsi ! AudMem \ R +182 nen ! 0 mfn ! 0 dba ! 182 fex ! 1 pos ! 181 fin ! 511 aud ! +182 psi ! 0 num ! 0 pre ! 0 seq ! 182 enx ! EnVocab InNativate + +( YOU -- innate response to who-am-i query; 10nov2012 ) + 516 t ! 89 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ Y + 517 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 518 t ! 85 pho ! 0 beg ! 0 ctu ! 707 audpsi ! AudMem \ U +707 nen ! 0 mfn ! 1 dba ! 707 fex ! 7 pos ! 701 fin ! 516 aud ! +707 psi ! 1 num ! 0 pre ! 388 tqv ! 800 seq ! 707 enx ! EnVocab InNativate + +( ARE -- essential intransitive verb -- 800 with parameters ) + 520 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 521 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 522 t ! 69 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ E +800 nen ! 0 mfn ! 2 dba ! 800 fex ! 8 pos ! 800 fin ! 520 aud ! +800 psi ! 1 num ! 707 pre ! 528 tqv ! 588 seq ! 800 enx ! EnVocab InNativate + +( MAGIC -- all-purpose noun not preceded by article; 10nov2012 ) + 524 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 525 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 526 t ! 71 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ G + 527 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 528 t ! 67 pho ! 0 beg ! 0 ctu ! 588 audpsi ! AudMem \ C +588 nen ! 0 mfn ! 1 dba ! 588 fex ! 5 pos ! 588 fin ! 524 aud ! +588 psi ! 1 num ! 800 pre ! 0 tqv ! 0 seq ! 588 enx ! EnVocab InNativate + +( I -- for SelfReferentialThought ) + 530 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 530 aud ! +701 psi ! 1 num ! 0 pre ! 533 tqv ! 800 seq ! 701 enx ! EnVocab InNativate + +( AM -- for SelfReferentialThought ) + 532 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 533 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 1 num ! 1 dba ! 0 mfn ! 800 fex ! 8 pos ! 800 fin ! 532 aud ! +800 psi ! 701 pre ! 539 tqv ! 501 seq ! 800 enx ! EnVocab InNativate + +( ANDRU -- for SelfReferentialThought ) + 535 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 536 t ! 78 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 537 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 538 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 539 t ! 85 pho ! 0 beg ! 0 ctu ! 501 audpsi ! AudMem \ U +501 nen ! 1 mfn ! 1 dba ! 501 fex ! 5 pos ! 501 fin ! 535 aud ! +501 psi ! 1 num ! 800 pre ! 0 tqv ! 0 seq ! 501 enx ! EnVocab InNativate + +( I -- innate KB-item for testing inhibition of idea-pairs ) + 541 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 541 aud ! +701 psi ! 1 num ! 0 pre ! 544 tqv ! 800 seq ! 701 enx ! EnVocab InNativate + +( AM -- for SelfReferentialThought ) + 543 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 544 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 543 aud ! +800 psi ! 1 num ! 701 pre ! 552 tqv ! 571 seq ! 800 enx ! EnVocab InNativate + +( A -- for EnArticle module ) + 546 t ! 65 pho ! 1 beg ! 0 ctu ! 101 audpsi ! AudMem \ A +101 nen ! 0 mfn ! 0 dba ! 101 fex ! 1 pos ! 101 fin ! 546 aud ! +101 psi ! 1 num ! 0 pre ! 571 seq ! 101 enx ! EnVocab InNativate + +( ROBOT -- important for target user base ) + 548 t ! 82 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 549 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 550 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 551 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 552 t ! 84 pho ! 0 beg ! 0 ctu ! 571 audpsi ! AudMem \ T +571 nen ! 3 mfn ! 1 dba ! 571 fex ! 5 pos ! 571 fin ! 548 aud ! +571 psi ! 1 num 1 ! 800 pre ! 0 tqv ! 0 seq ! 571 enx ! EnVocab InNativate + +( I -- innate KB-item for testing inhibition of idea-pairs ) + 554 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 554 aud ! +701 psi ! 1 num ! 0 pre ! 423 tqv ! 58 seq ! 701 enx ! EnVocab InNativate + +( AM -- for SelfReferentialThought; 10nov2012 ) + 556 t ! 65 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 557 t ! 77 pho ! 0 beg ! 0 ctu ! 800 audpsi ! AudMem \ M +800 nen ! 0 mfn ! 1 dba ! 800 fex ! 8 pos ! 800 fin ! 556 aud ! +800 psi ! 1 num ! 701 pre ! 566 tqv ! 537 seq ! 800 enx ! EnVocab InNativate + +( A -- for EnArticle module ) + 559 t ! 65 pho ! 1 beg ! 0 ctu ! 101 audpsi ! AudMem \ A +101 nen ! 0 mfn ! 0 dba ! 101 fex ! 1 pos ! 101 fin ! 559 aud ! +101 psi ! 1 num ! 0 pre ! 537 seq ! 101 enx ! EnVocab InNativate + +( PERSON -- for ad-hoc gender tags and robot philosophy ) + 561 t ! 80 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ P + 562 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 563 t ! 82 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 564 t ! 83 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ S + 565 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 566 t ! 78 pho ! 0 beg ! 0 ctu ! 537 audpsi ! AudMem \ N +537 nen ! 0 mfn ! 1 dba ! 537 fex ! 5 pos ! 537 fin ! 561 aud ! +537 psi ! 1 num ! 800 pre ! 0 tqv ! 0 seq ! 537 enx ! EnVocab InNativate + +( I -- for SelfReferentialThought ) + 568 t ! 73 pho ! 1 beg ! 0 ctu ! 701 audpsi ! AudMem \ I +701 nen ! 0 mfn ! 1 dba ! 701 fex ! 7 pos ! 707 fin ! 568 aud ! +701 psi ! 1 num 1 0 pre ! 573 tqv ! 895 seq ! 701 enx ! EnVocab InNativate + +( HELP -- socially significant common verb ) + 570 t ! 72 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ H + 571 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 572 t ! 76 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ L + 573 t ! 80 pho ! 0 beg ! 0 ctu ! 895 audpsi ! AudMem \ P +895 nen ! 0 mfn ! 1 dba ! 895 fex ! 8 pos ! 895 fin ! 570 aud ! +895 psi ! 1 num ! 701 pre ! 578 tqv ! 528 seq ! 895 enx ! EnVocab InNativate + +( KIDS -- noun lends itself to educational purposes ) + 575 t ! 75 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 576 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 577 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 578 t ! 83 pho ! 0 beg ! 0 ctu ! 528 audpsi ! AudMem \ S +528 nen ! 2 num ! 4 dba ! 0 mfn ! 528 fex ! 5 pos ! 528 fin ! 575 aud ! +528 psi ! 895 pre ! 0 tqv ! 0 seq ! 528 enx ! EnVocab InNativate + +( KIDS -- noun lends itself to educational purposes ) + 580 t ! 75 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 581 t ! 73 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ I + 582 t ! 68 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ D + 583 t ! 83 pho ! 0 beg ! 0 ctu ! 528 audpsi ! AudMem \ S +528 nen ! 0 mfn ! 1 dba ! 528 fex ! 5 pos ! 528 fin ! 580 aud ! +528 psi ! 2 num ! 0 pre ! 588 tqv ! 835 seq ! 528 enx ! EnVocab InStantiate + +( MAKE -- common verb of high word-frequency ) + 585 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 586 t ! 65 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ A + 587 t ! 75 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ K + 588 t ! 69 pho ! 0 beg ! 0 ctu ! 835 audpsi ! AudMem \ E +835 nen ! 2 num ! 0 mfn ! 835 fex ! 8 pos ! 835 fin ! 585 aud ! +835 psi ! 72 pre ! 595 tqv ! 571 seq ! 835 enx ! EnVocab InNativate + +( ROBOTS -- important for target user base ) + 590 t ! 82 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 591 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 592 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 593 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 594 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 595 t ! 83 pho ! 0 beg ! 0 ctu ! 571 audpsi ! AudMem \ S +571 nen ! 3 mfn ! 4 dba ! 571 fex ! 5 pos ! 571 fin ! 590 aud ! +571 psi ! 2 num ! 835 pre ! 0 tqv ! 0 seq ! 571 enx ! EnVocab InNativate + +( ROBOTS -- important for target user base ) + 597 t ! 82 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ R + 598 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 599 t ! 66 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ B + 600 t ! 79 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ O + 601 t ! 84 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ T + 602 t ! 83 pho ! 0 beg ! 0 ctu ! 571 audpsi ! AudMem \ S +571 nen ! 3 mfn ! 1 dba ! 571 fex ! 5 pos ! 571 fin ! 597 aud ! +571 psi ! 2 num ! 0 pre ! 473 tqv ! 849 seq ! 571 enx ! EnVocab InNativate + +( NEED -- common verb used for describing goals ) + 604 t ! 78 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ N + 605 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 606 t ! 69 pho ! 0 beg ! 1 ctu ! 0 audpsi ! AudMem \ E + 607 t ! 68 pho ! 0 beg ! 0 ctu ! 849 audpsi ! AudMem \ D +849 nen ! 2 num ! 0 mfn ! 849 fex ! 8 pos ! 849 fin ! 604 aud ! +849 psi ! 571 pre ! 610 tqv ! 701 seq ! 849 enx ! EnVocab InNativate + +( ME -- for SelfReferentialThought ) + 609 t ! 77 pho ! 1 beg ! 1 ctu ! 0 audpsi ! AudMem \ M + 610 t ! 69 pho ! 0 beg ! 0 ctu ! 701 audpsi ! AudMem \ E +701 nen ! 0 mfn ! 4 dba ! 701 fex ! 7 pos ! 707 fin ! 609 aud ! +701 psi ! 1 num ! 849 pre ! 0 tqv ! 0 seq ! 701 enx ! EnVocab InNativate +( Declaration of "vault" must reflect final EnBoot "t".) + 1 t +! + t @ vault ! + t @ tov ! + 1 t +! + t @ nlt ! ( nlt may be basis for DAMP functions ) + 528 urpsi ! \ As if "KIDS" were the cresting concept. + 900 nen ! \ segregate parts of speech by century; 9nov2012 + 5 bias ! + 0 lurk ! \ prepare to auto-start thinking; 19sep2010 + 0 num ! + 0 mfn ! \ Prevent carry-over. + 0 mfnflag ! \ Prevent carry-over; 23aug2010 + 0 nwc ! + 0 pho ! + 0 pre ! 0 seq ! + 0 putnum ! \ prevent carry-over; 4nov2011 +; ( http://code.google.com/p/mindforth/wiki/EnBoot ) + + +: KbTraversal ( reactivate KB concepts ) + 35 pov ! + kbtv @ 4 > IF 1 kbtv ! THEN +\ CR ." Knowledge base traversal with kbtv at " kbtv @ . + CR ." Time = " t @ . 8 EMIT \ as in Wotan AI; 28dec2012 + ." ; ReJuvenate count = " rjc @ . 8 EMIT \ 28dec2012 + ." ; activating " \ as in Wotan German AI 28dec2012 +\ ." KbTraversal activates " \ 28dec2012 + kbtv @ 1 = IF + 1 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + 707 nacpsi ! \ 707=YOU noun-activation psi; 10nov2012 + 707 qusub ! \ in case a query will be made; 10nov2012 + 707 subjpsi ! \ a test to help WhoBe; 10nov2012 + 1 subjnum ! \ for correct be-verb; 12oct2011 + 2 prsn ! \ for correct be-verb; 12oct2011 + \ ." activating concept of YOU" CR \ for who-query; 7aug2010 + 34 EMIT ." YOU" 34 EMIT ." as a concept." CR \ 28dec2012 + 62 nounval ! + NounAct + 0 nacpsi ! + THEN + kbtv @ 2 = IF \ for use in ThInk module; 14oct2011 + 2 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + \ ." activating concept of ROBOTS" CR ( 7aug2010 ) + 34 EMIT ." ROBOTS" 34 EMIT ." as a concept." CR \ 28dec2012 + 571 subjpsi ! \ external tagging as subject; 14oct2011 + 571 qusub ! \ in case a query will be made; 10nov2012 + 0 nacpsi ! + THEN + kbtv @ 3 = IF + 3 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + 701 nacpsi ! \ 701=I noun-activation psi; 10nov2012 + \ ." activating concept of I" CR ( 7aug2010 ) + 34 EMIT ." I" 34 EMIT ." as a concept." CR \ 28dec2012 + 701 qusub ! \ in case a query will be made; 10nov2012 + 701 subjpsi ! \ external tagging as subject; 10nov2012 + NounAct + 0 nacpsi ! + THEN + kbtv @ 4 = IF + 4 kbyn ! \ for AskUser Y/N query subject; 24jun2011 + 533 nacpsi ! \ 533=GOD noun-activation psi; 10nov2012 + \ ." activating concept of GOD" CR ( 7aug2010 ) + 34 EMIT ." GOD" 34 EMIT ." as a concept." CR \ 28dec2012 + 533 qusub ! \ in case a query will be made; 10nov2012 + 533 subjpsi ! \ external tagging as subject; 10nov2012 + 62 nounval ! + NounAct + 0 nacpsi ! + THEN ( http://www.quartus.net ) + 42 pov ! +; ( http://code.google.com/p/mindforth/wiki/KbTraversal ) + + +: ReJuvenate ( recycle oldest memory spaces ) + fyi @ 2 = IF + CLS + THEN + 0 edge ! + CR 1 rjc +! + ." Please wait as memories migrate in ReJuvenate cycle #" + rjc @ . CR + t @ 2 + coda @ vault @ + DO + I jrt ! + jrt @ coda @ - jrt ! + edge @ 1 = IF + I 0 psi{ @ jrt @ 0 psi{ ! 0 I 0 psi{ ! + I 1 psi{ @ jrt @ 1 psi{ ! 0 I 1 psi{ ! + I 2 psi{ @ jrt @ 2 psi{ ! 0 I 2 psi{ ! + I 3 psi{ @ jrt @ 3 psi{ ! 0 I 3 psi{ ! + I 4 psi{ @ jrt @ 4 psi{ ! 0 I 4 psi{ ! + I 5 psi{ @ jrt @ 5 psi{ ! 0 I 5 psi{ ! + \ Next line adjusts tqv by minus-coda; 14aug2012 + I 6 psi{ @ coda @ - jrt @ 6 psi{ ! 0 I 6 psi{ ! + I 7 psi{ @ jrt @ 7 psi{ ! 0 I 7 psi{ ! + I 8 psi{ @ jrt @ 8 psi{ ! 0 I 8 psi{ ! + THEN + edge @ 1 = IF + en8 @ 1 < IF 0 en8 ! THEN \ 10nov2012 + I 0 en{ @ jrt @ 0 en{ ! 0 I 0 en{ ! + I 1 en{ @ jrt @ 1 en{ ! 0 I 1 en{ ! + I 2 en{ @ jrt @ 2 en{ ! 0 I 2 en{ ! + I 3 en{ @ jrt @ 3 en{ ! 0 I 3 en{ ! + I 4 en{ @ jrt @ 4 en{ ! 0 I 4 en{ ! + I 5 en{ @ jrt @ 5 en{ ! 0 I 5 en{ ! + I 6 en{ @ jrt @ 6 en{ ! 0 I 6 en{ ! + I 7 en{ @ jrt @ 7 en{ ! 0 I 7 en{ ! \ 29dec2012 + I 8 en{ @ en8 ! \ 10nov2012 + en8 @ vault @ < IF + en8 @ jrt @ 8 en{ ! 0 I 8 en{ ! THEN + en8 @ coda @ vault @ + > IF \ 10nov2012 + en8 @ coda @ - jrt @ 8 en{ ! \ 10nov2012 + THEN 0 I 8 en{ ! \ 10nov2012 + THEN + edge @ 1 = IF + I 0 aud{ @ jrt @ 0 aud{ ! + I 1 aud{ @ jrt @ 1 aud{ ! + I 2 aud{ @ jrt @ 2 aud{ ! + I 3 aud{ @ jrt @ 3 aud{ ! + I 4 aud{ @ jrt @ 4 aud{ ! + I 5 aud{ @ jrt @ 5 aud{ ! + fyi @ 1 > IF + jrt @ 0 aud{ @ EMIT + THEN + THEN + edge @ 0 = IF + 32 jrt @ 0 aud{ ! + 0 jrt @ 1 aud{ ! + I 2 aud{ @ 123 = IF 1 edge ! THEN + 0 jrt @ 2 aud{ ! + 0 jrt @ 3 aud{ ! + 0 jrt @ 4 aud{ ! + 0 jrt @ 5 aud{ ! + 0 jrt @ 0 en{ ! + 0 jrt @ 1 en{ ! + 0 jrt @ 2 en{ ! + 0 jrt @ 3 en{ ! + 0 jrt @ 4 en{ ! + 0 jrt @ 5 en{ ! + 0 jrt @ 6 en{ ! + 0 jrt @ 7 en{ ! + 0 jrt @ 8 en{ ! \ with dba; 10nov2012 + 0 jrt @ 0 psi{ ! + 0 jrt @ 1 psi{ ! + 0 jrt @ 2 psi{ ! + 0 jrt @ 3 psi{ ! + 0 jrt @ 4 psi{ ! + 0 jrt @ 5 psi{ ! + 0 jrt @ 6 psi{ ! + 0 jrt @ 7 psi{ ! + 0 jrt @ 8 psi{ ! \ for "tqv"; 12oct2011 + THEN + LOOP + jrt @ t ! + cns @ t @ DO + 32 I 0 aud{ ! + 0 I 1 aud{ ! + 0 I 2 aud{ ! + 0 I 3 aud{ ! + 0 I 4 aud{ ! + 0 I 5 aud{ ! + 0 I 0 en{ ! + 0 I 1 en{ ! + 0 I 2 en{ ! + 0 I 3 en{ ! + 0 I 4 en{ ! + 0 I 5 en{ ! + 0 I 6 en{ ! + 0 I 7 en{ ! + 0 I 8 en{ ! \ with "dba"; 10nov2012 + 0 I 0 psi{ ! + 0 I 1 psi{ ! + 0 I 2 psi{ ! + 0 I 3 psi{ ! + 0 I 4 psi{ ! + 0 I 5 psi{ ! + 0 I 6 psi{ ! + 0 I 7 psi{ ! + 0 I 8 psi{ ! \ with new "enx"; 12oct2011 + LOOP + t @ 32 - tov ! \ 12jan2010 Avoid truncating thoughts. + CR CR ." End of ReJuvenate #" rjc @ . + ." in the AI Mind display for science museum exhibits." + CR ." Tab key cycles through Normal, Transcript, " + ." Tutorial, Diagnostic display-modes. " CR + 1 kbtv +! + kbtv @ 0 > IF + CR ." For lack of human input, " + ." ReJuvenate calls KbTraversal" CR + KbTraversal + THEN ( http://ronware.org/reva ) + rsvp @ rjc @ - rsvp ! + rsvp @ 2 < IF 2 rsvp ! THEN \ 23dec2009 Maintain speed. +; ( http://code.google.com/p/mindforth/wiki/ReJuvenate ) + + +: SpeechAct ( output of a word as text or sound ) + aud @ 0 = IF 1 aud ! THEN \ default to ERROR; 21jul2011 + fyi @ 2 = IF CR THEN + 0 audstop ! ( Initially false value of flag ) + 0 pho ! ( Lest pho already be at 32 ) + aud @ onset ! ( onset of a word is its recall-vector ) + aud @ t2s ! + 40 1 DO + t2s @ 0 aud{ @ pho ! + pho @ 32 = NOT IF + pho @ EMIT ( say or display "pho" ) + pho @ lastpho ! + THEN \ End of test for pho=32 space-bar; 30aug2010 + pho @ 32 = IF \ but instead of a blank space; 30aug2010 + lastpho @ 83 = NOT IF \ not after "S"; 30aug2010 + flex1 @ 0 > IF \ using shorter variable; 11sep2011 + flex1 @ pho ! \ append inflection; 11sep2011 + 0 flex1 ! \ reset for safety; 11sep2011 + THEN ( http://aimind-i.com ) + 1 spacegap ! + 0 vpos ! + THEN \ End of test for previous "S"; 30aug2010 + pho @ EMIT ( say or display "pho" ) + 1 audstop ! + THEN \ end of test for 32=space; 30aug2010 + 35 pov ! ( internal point-of-view "#" like mindgrid ) + AudInput ( for reentry of thought back into a mind ) + audstop @ 1 = IF + spacegap @ 1 = IF + 32 pho ! + 1 audrun ! \ resetting at end of internal word. + AudInput + 0 spacegap ! + THEN ( http://www.speechapi.com ) + LEAVE + THEN ( http://aigroup.narod.ru ) + t2s @ 1+ t2s ! + t2s @ 4 aud{ @ 0 = IF 32 pho ! THEN ( If end of word ) + match @ 1 = IF + 0 match ! + LEAVE + THEN + LOOP + 0 aud ! \ Avoid unwarranted carry-over of value; 11sep2011 + 0 match ! + 0 obstat ! +; ( http://code.google.com/p/mindforth/wiki/SpeechAct ) + + +: SayYes ( to utter "YES" in response ) + midway @ t @ DO + I 0 en{ @ 432 = IF \ 3-digit; 10nov2012 + I 8 en{ @ aud ! \ with dba; 10nov2012 + LEAVE + THEN ( http://aimind-i.com ) + -1 +LOOP + SpeechAct + 0 kbquiz ! + 0 yesorno ! +; ( http://code.google.com/p/mindforth ) + + +: EnArticle ( select "a" or "the" before a noun ) + indefmust @ 1 = IF \ if required to say "A(N)"; 20oct2011 + midway @ t @ DO \ search backwards in time; 20oct2011 + I 0 en{ @ 101 = IF \ 101=A found? 8nov2012 + I 8 en{ @ aud ! \ save auditory recall-vector + LEAVE \ one instance is enough; 20oct2011 + THEN \ end of test for "101=A" engram; 8nov2012 + -1 +LOOP \ end of backwards loop; 20oct2011 + SpeechAct \ pronounce the requred article; 20oct2011 + 0 indefmust ! \ reset for safety; 20oct2011 + EXIT \ abandon rest of EnArticle; 20oct2011 + THEN \ end of test for a required "A(N); 20oct2011 + nphrpos @ 7 = NOT IF + nphrnum @ 1 = IF + motjuste @ ghost @ = IF \ + 0 indefartcon ! \ do not say "A"; 15oct2011 + 1 defartcon ! \ say "THE"; 15oct2011 + THEN \ + motjuste @ ghost @ = NOT IF + subjnum @ 1 = IF \ if singular subject; 13sep2011 + verbpsi @ 800 = IF \ AM or IS; 10nov0212 + 1 indefartcon ! \ indefinite article; 13sep2011 + THEN \ end of test for "AM" or "IS"; 13sep2011 + THEN \ 13sep2011 + indefartcon @ 1 = IF \ from WHAT-query; 16apr2011 + 0 defartcon ! \ avoid "A THE"; 6oct2011 + anset @ 0 = IF ( If no vowel is next ) + midway @ t @ DO + I 0 en{ @ 101 = IF \ 101=A? 8nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + THEN ( End of test for absence of a vowel ) + anset @ 0 > IF ( If anset-flag is positive ) + midway @ t @ DO + I 0 en{ @ 102 = IF \ 102=AN? 8nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + THEN ( End of test for a vowel coming next ) + 1 numflag ! \ With "A" assume singular number. + SpeechAct + 0 indefartcon ! \ Reset; 16apr2011 + THEN \ End of test for positive indefartcon; 16apr2011 + 0 indefartcon ! \ Reset for safety; 6oct2011 + THEN + motjuste @ ghost @ = IF + defartcon @ 1 = IF \ from WH0-query; 16apr2011 + midway @ t @ DO + I 0 en{ @ 117 = IF \ If 117=THE found; 10nov2012 + I 8 en{ @ aud ! \ with dba; 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 0 defartcon ! \ Reset; 16apr2011 + THEN \ End of test for positive defartcon; 16apr2011 + THEN + THEN + THEN + dirobj @ 1 = IF + motjuste @ ghost ! + THEN ( http://thebeez.home.xs4all.nl/4tH ) + 0 whoflag ! \ call EnArticle only once; 15oct2011 +; ( http://code.google.com/p/mindforth/wiki/EnArticle ) + + +: EnAdjective ( insert an adjective into a sentence ) + adjcon @ 1 = IF \ activation spreads to an adjective? + ( find and speak the most active adjective; 16sep2011 ) + THEN ( http://www.colorforth.com ) +; ( http://code.google.com/p/mindforth ) + + +: AuxVerb ( auxiliary Verb ) +\ CR ." AuxV: subjnum prsn = " \ 29dec2012 +\ subjnum @ . prsn @ . \ 29dec2012 + subjnum @ 1 = prsn @ 3 = AND IF \ 19jul211 + midway @ t @ DO + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd person? 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for third person; 10nov2012 + THEN \ end ofbtest for num=1 singular; 10nov2012 + THEN \ end of test for 830=DO; 10nov2012 + -1 +LOOP + SpeechAct \ Say word starting at "aud" value; 20jul2011 + 830 urpsi ! \ 10nov2012 + 51 caller ! + PsiDamp + 0 urpsi ! \ reset for safety; 29dec2012 + 0 caller ! + ELSE \ all other cases except 3rd prsn sing; 25jun2011 + midway @ t @ DO \ may need parameters! 10nov2012 + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 4 en{ @ 0 = IF \ 0=dba infinitive 29dec2012 + I 8 en{ @ 0 > IF \ non-zer? 29dec2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for non-zero aud; 29dec2012 + THEN \ end of test to accept infinitive; 29dec2012 + THEN + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from AuxVerb after speaking of DO, " + ." psiDamping concept #830 DO" + THEN + 830 urpsi ! \ 830=DO; 10nov2012 + 51 caller ! + PsiDamp + 0 urpsi ! \ reset for safety; 29dec2012 + 0 caller ! + THEN \ end of test for both sing & 3rd prsn; 25jun2011 +; ( http://code.google.com/p/mindforth/wiki/AuxVerb ) + + +: WhatAuxSVerb ( What DO Subjects Verb; 13jun2011 ) + midway @ t @ DO + I 0 en{ @ 781 = IF \ 781=WHAT 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct \ Say word starting at "aud" value; 20jul2011 + 781 urpsi ! \ 781=WHAT; 10nov2012 + PsiDamp + AuxVerb \ Say DOES or DO depending on num(ber) 20jul2011 + 0 motjuste ! + midway @ t @ DO + I 0 en{ @ topic @ = IF \ 13jun2011 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN ( http://sourceforge.net/projects/calforth ) + -1 +LOOP + topic @ urpsi ! \ 14aug2011 + PsiDamp + SpeechAct + verbpsi @ 0 = IF 830 verbpsi ! THEN \ 830=DO DeFault 10nov2012 + verbpsi @ unk ! \ use a short "unk"; 28aug2011 + verbpsi @ 800 = IF \ 800 cover AM IS ARE BE; 10nov2012 + 830 verbpsi ! \ replace be-verbs with 830=DO; 10nov2012 + THEN \ end of default switching be-verb to 830=DO; 10nov2012 + midway @ t @ DO + I 0 en{ @ verbpsi @ = IF \ 13jun2011 + I 2 en{ @ 2 = IF \ as if infinitive; 13jun2011 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ End of test for plural as if infinitive + THEN + -1 +LOOP + aud @ 0 = IF \ if no plural accept singular 14aug2011 + midway @ t @ DO \ search English vocab; 14aug2011 + I 0 en{ @ verbpsi @ = IF \ 14aug2011 + I 8 en{ @ aud ! \ for SpeechAct; 10nov2012 + LEAVE \ one engram is enough; 14aug2011 + THEN \ end of test for verbpsi; 14aug2011 + -1 +LOOP \ end of backwards search loop; 14aug2011 + THEN \ end of test for no engram found; 14aug2011 +( http://www.intelligent-systems.com.ar/intsyst/proposedBrain.htm ) + SpeechAct + verbpsi @ urpsi ! \ 13jun2011 + PsiDamp +; ( http://code.google.com/p/mindforth ) + + +: WhatAuxSDo ( What DO Subjects DO ) + midway @ t @ DO + I 0 en{ @ 781 = IF \ 781=WHAT; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 781 urpsi ! \ 781=WHAT for PsiDamp; 10nov2012 + 42 caller ! + PsiDamp + 0 caller ! + AuxVerb \ to include DO or DOES; 14aug2011 + subjnum @ 1 = IF \ for singular subject; 14oct2011 + topic @ motjuste ! \ test; 14oct2011 + 0 ghost ! \ test; 14oct2011 + 1 nphrnum ! \ required for "A"' 14oct2011 + 1 indefartcon ! \ to say "A"; 14oct2011 + EnArticle \ 14oct2011 + THEN \ end of test for singular subject; 14oct2011 + midway @ t @ DO + I 0 en{ @ topic @ = IF + I 2 en{ @ subjnum @ = IF \ agreement? 14oct2011 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE \ only after finding match; 14oct2011 + THEN \ end of grammatical-number test; 14oct2011 + THEN + -1 +LOOP + topic @ urpsi ! \ 14aug2011 + 42 caller ! + PsiDamp + SpeechAct + midway @ t @ DO + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 4 en{ @ 0 = IF \ dba=0 infinitive; 25dec2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of tist for infinitive dba=0; 25dec2012 + THEN + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from whatAuxSDo after speaking of DO, " + ." psiDamping concept #59 DO" + THEN + 830 urpsi ! \ 830=DO for PsiDamp; 10nov2012 + 42 caller ! + PsiDamp + 0 caller ! +; ( http://code.google.com/p/mindforth/wiki/WhatAuxSDo ) + + +: WhoBe ( for asking WHO IS-AM-ARE; 9aug2010 ) + 1 moot ! \ prevent associative tagging inside query; 24oct2011 + 0 tqv ! \ prevent spurious carry-over values; 1aug2012 + topic @ 0 > IF topic @ qusub ! THEN \ review; 30jul2011 + midway @ t @ DO \ Say the word "WHO"; 19aug2010 + I 0 en{ @ 791 = IF ( 791=WHO; 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 8766 caller ! \ ASCII 87=W 66=B; test; 26sep2010 + 55 urpsi ! \ Designate concept to be psi-damped; 19aug2010 + PsiDamp + 0 caller ! \ reset after use; 26sep2010 + qusub @ 701 = IF 1 prsn ! THEN \ 1st person "I" 10nov2012 + qusub @ 731 = IF 1 prsn ! THEN \ 1st person WE 10nov2012 + qusub @ 707 = IF 2 prsn ! THEN \ 2nd person YOU 10nov2012 + qusub @ 737 = IF 2 prsn ! THEN \ 2nd person YOU 10nov2012 + qusub @ 713 = IF 3 prsn ! THEN \ 3rd person HE 10nov2012 + qusub @ 719 = IF 3 prsn ! THEN \ 3rd person SHE 10nov2012 + qusub @ 725 = IF 3 prsn ! THEN \ 3rd person IT 10nov2012 + qusub @ 743 = IF 3 prsn ! THEN \ 3rd person THEY 10nov2012 + prsn @ 3 = IF \ only for 3rd person; 1sep2010 + midway @ t @ DO \ Say "IS" after "WHO"; 19aug2010 + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 3 = IF ( 3rd person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for 3rd person "IS" 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ to say "IS"; 17aug2010 + 0 mfn ! \ test; remove; 25aug2010 + 0 mfnflag ! \ Reset after use; 19aug2010 + THEN \ end of test for prsn=1; 1sep2010 + qusub @ 701 = IF ( I; 10nov2012 ) + 1 prsn ! \ first person; 1sep2010 + 1 nphrnum ! \ singular; 1sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 1 = IF ( 1st person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end ofb test for first person; 10nov2012 + THEN \ end of test for singular 800=BE; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ to say "AM"; 17oct2011 + THEN \ 9aug2010 + qusub @ 701 = IF \ treat ME like 701=I; 10nov2012 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 1 = IF ( 1st person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ moved inside the IF-clause; 10aug2010 + THEN \ 9aug2010 + qusub @ 707 = IF ( 707=YOU; 10nov2012 ) + 2 prsn ! \ second person; 1sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 2 = IF ( 2nd person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for 2nd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + SpeechAct \ to say "ARE"; 10aug2010 + THEN \ 9aug2010 + qusub @ 713 = IF ( 713=HE; 10nov2012 ) + 3 prsn ! \ third person; 1sep2010 + 1 nphrnum ! \ singular; 1sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF ( 800=BE; 10nov2012 ) + I 2 en{ @ 1 = IF ( singular? 10nov2012 ) + I 4 en{ @ 3 = IF ( 3rd person? 10nov2012 ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ enmd of test for 3rd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP + THEN ( http://minforth.net.ms ) + midway @ t @ DO \ search for who-query subject; 23aug2010 + I 0 en{ @ qusub @ = IF \ if qusub found; 3oct2010 + I 8 en{ @ aud ! \ recall-tag; 10nov2012 + LEAVE \ one exemplar is enough; 23aug2010 + THEN \ end of test for subject; 23aug2010 + -1 +LOOP \ end of search-loop; 23aug2010 + SpeechAct \ speak (WHO IS) qusub query-subject; 3oct2010 + 0 moot ! \ end of not tagging query-concepts; 24oct2011 +; ( http://code.google.com/p/mindforth ) + + +: WhatBe ( what AM/IS/ARE Subjects ) \ 10oct2011 + 1 moot ! \ prevent storage of spurious ideas; 24oct2011 + 0 tqv ! \ prevent spurious carry-over values; 1aug2012 + qusub @ 0 = IF \ for a new word like "energy"; 8aug2012 + subjnum @ 0 = IF \ in absence of num(ber) data; 8aug2012 + 3 prsn ! \ to say "IS"; 8aug2012 + THEN \ end of test for "qusub"; 8aug2012 + THEN \ end of test for "subjnum"; 8aug2012 + topic @ qusub ! \ THEN \ 2nd choice; 10oct2011 + qusub @ 701 = IF 1 prsn ! THEN \ 1st person "I"; 10nov2012 + qusub @ 707 = IF 2 prsn ! THEN \ 2nd person YOU; 10nov2012 + midway @ t @ DO + I 0 en{ @ 781 = IF \ 781=WHAT; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from WhatBe after speaking of WHAT, " \ 25feb2011 + ." psiDamping concept #781" + THEN + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + 781 urpsi ! \ 781=WHAT for PsiDamp; 10nov2012 + PsiDamp + 0 caller ! + subjnum @ 2 < topicnum @ 2 < OR IF \ not plural? 4nov2011 + prsn @ 1 = IF \ 1st person singular; 21aug2011 + midway @ t @ DO \ 21aug2011 + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + I 2 en{ @ 1 = IF \ singular?; 10nov2012 + I 4 en{ @ 1 = IF \ 1st person?; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + 1 topicnum ! \ If "AM" prevent "ARE"; 26jul2012 + LEAVE \ 21aug2011 + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ 21aug2011 + -1 +LOOP \ 21aug2011 + SpeechAct \ 21aug2011 + THEN \ end of test for first person singular; 21aug2011 + prsn @ 3 = IF \ 3rd person singular; 19sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd pers? 26dec2012 + I 8 en{ @ aud ! \ 10nov2012 + 1 topicnum ! \ If "IS" prevent "ARE" 21jul2012 + 1 indefmust ! \ to say "IS A"; 20oct2011 + LEAVE + THEN \ end of test for 3rd person; 10nov2012 + THEN \ end of test for singualr; 10nov2012 + THEN ( http://isforth.com ) + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from WhatBe after speaking of IS, " \ 25feb2011 + ." psiDamping concept #800" + THEN + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + 800 urpsi ! \ 10nov2012 + PsiDamp + 0 caller ! + 0 motjuste ! + THEN \ end of test for 3rd person singular; 19sep2010 + THEN + topicnum @ 2 = prsn @ 2 = OR IF \ test; 19sep2010 + midway @ t @ DO + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + I 2 en{ @ 2 = IF \ plural? 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for plural "ARE"; 10nov2012 + THEN \ end of test for be-verb + -1 +LOOP + SpeechAct + fyi @ 2 > IF CR + ." from WhatBe after speaking of ARE, " \ 25feb2011 + ." psiDamping concept #800" + THEN + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + 800 urpsi ! \ 10nov2012 + PsiDamp + 0 caller ! \ test; 26sep2010 + 0 motjuste ! + 0 subjpsi ! \ reset for safety' 17oct2011 + 0 topicnum ! + THEN + topicnum @ 2 = NOT IF \ if singular; 21jun2011 + prsn @ 3 = IF \ 3rd person singular; 21jun2011 + topicnum @ 1 = IF \ not zero; 4nov2011 + EnArticle \ chance for "A" or "THE"; 21jun2011 + THEN \ end of test for 1=singular; 4nov2011 + THEN \ end of test for 3rd person; 21jun2011 + THEN \ end of test for singular; 21jun2011 + midway @ t @ DO + I 0 en{ @ qusub @ = IF \ 10oct2011 + I 4 en{ @ 1 = IF \ nominative? 1jan2013 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN \ end of test for dba=1 nominative; 1jan2013 + THEN + -1 +LOOP + motjuste @ urpsi ! + 8773 caller ! \ ASCII 87=W 73=I; test; 26sep2010 + PsiDamp + 0 caller ! \ test; 26sep2010 + aud @ 0 > IF \ avoid #zero ERROR; \ 19sep2010 + SpeechAct + THEN \ end of test to avoid ERROR; 19sep2010 + 0 cogpsi ! \ let another new word call WhatBe; 17oct2011 + 0 indefmust ! \ reset for safety; 20oct2011 + 0 moot ! \ resume associative tagging; 24oct2011 + 0 qusub ! \ zero out for safety; 10oct2011 + 0 subjpsi ! \ reset for safety; 17oct2011 + 0 topic ! \ reset for safety; 18oct2011 + 0 whoflag ! \ Prevent EnArticle; 6oct2011 +; ( http://code.google.com/p/mindforth ) + + +: AskUser ( outputs questions of a speculative nature ) + 35 pov ! \ #35=internal; *42=external; 29dec2012 + ynverb @ 0 = IF \ only ask y/n question once; 24jun2011 + quverb @ ynverb ! \ isolate at start; 24jun2022 + \ nphrnum @ 2 = IF \ if plural trigger; test; 24jun2011 + \ nphrnum @ 2 = IF \ Commenting out for InFerence; 1jan2013 + AuxVerb \ to say DO or DOES; 24jun2011 + \ midway @ t @ DO \ search English vocab; 24jun2011 + midway @ inft @ DO \ skip silent inference; 27dec2012 + I 0 en{ @ qusub @ = IF ( kbtv ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + tkbv @ tqv ! \ qusub needs a tqv to quverb 29dec2012 + SpeechAct \ to say the subject; 24jun2011 + t @ tkbn ! \ if engram is to be changed; 2jul2011 + quverb @ t @ 7 psi{ ! \ insert as seq; 29dec2012 + qusub @ nacpsi ! \ transfer activand; 25jun2011 + 62 nounval ! \ prime NounAct; 24jun2011 + NounAct \ activate the query subject; 24jun2011 + midway @ t @ DO \ search English vocab; 24jun2011 + I 0 en{ @ ynverb @ = IF ( yes-or-no verb ) + I 2 en{ @ 2 = IF \ as if infinitive; 24jun2011 + I 8 en{ @ aud ! \ fetch recall-vector 10nov2012 + LEAVE \ one engram is enough; 24jun2011 + THEN \ end of test for plural as if infinitive + THEN + -1 +LOOP + aud @ 0 = IF \ if no plural accept singular 24jun2011 + midway @ t @ DO \ search English vocab; 24jun2011 + I 0 en{ @ ynverb @ = IF ( yes-or-no verb ) + I 2 en{ @ 1 = IF \ second choice; 24jun2011 + I 8 en{ @ aud ! \ fetch recall-vector + LEAVE \ one engram is enough; 24jun2011 + THEN \ end of test for plural as if infinitive + THEN + -1 +LOOP + THEN \ end of test for no engram found; 24jun2011 + aud @ 0 = IF \ if neither plural nor singular; 25aug2011 + midway @ t @ DO \ search English vocab; 25aug2011 + I 0 en{ @ ynverb @ = IF ( yes-or-no verb ) + I 8 en{ @ aud ! \ fetch recall-vector + LEAVE \ one engram is enough; 25aug2011 + THEN \ end of test for any form at all; 25aug2011 + -1 +LOOP + THEN \ end of third test for no engram found; 25aug2011 + ynverb @ nacpsi ! \ transfer activand; 25jun2011 + 62 verbval ! \ prime VerbAct; 2jul2011 + VerbAct \ activate the query verb; 25jun2011 + SpeechAct \ to say yes-or-no verb; 24jun2011 + t @ 1 - tkbv ! \ if engram is to be changed; 2jul2011 + tkbv @ tkbn @ 6 psi{ ! \ noun's tqv; 29dec2012 + quverb @ tkbn @ 7 psi{ ! \ noun's seq; 29dec2012 + quobj @ tkbv @ 7 psi{ ! \ verb's seq; 29dec2012 + quobj @ 0 = quobj @ 586 = OR IF \ nothing or ERROR + 711 quobj ! \ 711=ANYTHING by default; 10nov2012 + THEN \ end of test for a query-object; 20jul2011 + \ midway @ t @ DO \ search English vocab; 24jun2011 + midway @ inft @ DO \ skip silent inference; 27dec2012 + I 0 en{ @ quobj @ = IF ( query-object? ) + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + aud @ 2 < IF \ if zero or ERROR; 25aug2011 + midway @ t @ DO \ search English vocab; 25aug2011 + I 0 en{ @ 711 @ = IF \ 711=ANYTHING; 10nov2012 + I 8 en{ @ aud ! \ 10nov2012 + LEAVE \ 25aug2011 + THEN \ 25aug2011 + -1 +LOOP \ 25aug2011 + THEN \ 25aug2011 + SpeechAct \ to say query-object; 24jun2011 + t @ tkbv @ 6 psi{ ! \ insert quverb's tqv; 29dec2012 + \ THEN \ end of test for a plural nphrnum; 24jun2011 + \ THEN \ Commenting out; soon remove as obsolete; 1jan2013 + 0 yncon ! \ because question has been asked; 2jul2011 + 1 kbcon ! \ because waiting for answer; 2jul2011 + 0 ynverb ! \ zero out; prevent repeat of query 24jun2011 + THEN \ end of test for a positive ynverb; 24jun2011 + 5 bias ! \ Restore expectation of noun; 24jun2011 +; ( http://code.google.com/p/mindforth/wiki/AskUser ) + + +: EnPronoun \ For use with what-do-X-do queries. + num @ 1 = IF \ If antecedent num(ber) is singular. + mfn @ 1 = IF \ if masculine singular; 13apr2010 + midway @ t @ DO \ Look backwards for 49=HE. + I 0 en{ @ 713 = IF \ If 713=HE is found, + 713 motjuste ! \ "nen" concept #713 for "he". + I 8 en{ @ aud ! \ Recall-vector for "he". + LEAVE \ Use the most recent engram of "he". + THEN \ End of search for 713=HE; 10-nov2012. + -1 +LOOP \ End of loop finding pronoun "he". + SpeechAct \ Speak or display the pronoun "he". + THEN \ end of test for masculine gender-flag. + mfn @ 2 = IF \ if feminine singular. + midway @ t @ DO \ Look backwards for 80=SHE + I 0 en{ @ 719 = IF \ If 719=SHE is found, + 719 motjuste ! \ "nen" concept #719 for "she". + I 8 en{ @ aud ! \ Recall-vector for "she". + LEAVE \ Use the most recent engram of "she". + THEN \ End of search for #719 "she". + -1 +LOOP \ End of loop finding pronoun "she" + SpeechAct \ Speak or display the pronoun "she" + THEN \ end of test for feminine gender-flag. + mfn @ 3 = IF \ if neuter singular; 13apr2010 + midway @ t @ DO \ Look backwards for 725=IT. + I 0 en{ @ 725 = IF \ If 725=IT is found, + 725 motjuste ! \ "nen" concept #725 for "it". + I 8 en{ @ aud ! \ Recall-vector for "it". + LEAVE \ Use the most recent engram of "it". + THEN \ End of search for 725=IT; 10nov2012 + -1 +LOOP \ End of loop finding pronoun "it". + SpeechAct \ Speak or display the pronoun "it". + THEN \ end of test for neuter gender-flag. + 0 numsubj ! \ safety measure; 13apr2010 + THEN \ End of test for singular num(ber) + num @ 2 = IF \ 30dec2009 If num(ber) of antecedent is plural + ( code further conditions for "WE" or "YOU" ) + midway @ t @ DO \ Look backwards for 743=THEY. + I 0 en{ @ 743 = IF \ If 743=THEY is found, + 743 motjuste ! \ "nen" concept #743 for "they". + I 8 en{ @ aud ! \ Recall-vector for "they". + LEAVE \ Use the most recent engram of "they". + THEN \ End of search for 743=THEY; 10nov2012. + -1 +LOOP \ End of loop finding pronoun "they". + SpeechAct \ Speak or display the pronoun "they". + THEN \ 30dec2009 End of test for plural num(ber) +; ( http://code.google.com/p/mindforth/wiki/EnPronoun ) + + +: NounPhrase ( select part of a thought ) + 0 audjuste ! \ prevent carry-over; 20oct2011 + verblock @ 0 > IF \ positive verblock? 20oct2011 + verblock @ 6 psi{ @ nounlock ! \ test; 20oct2011 + THEN \ end of test for a positive verblock; 20oct2011 + 66 caller ! \ here and further down; 12oct2010 + objold @ urpsi ! \ here and further down; 12oct2010 + 0 caller ! \ reset after use; 12oct2010 + 0 urpsi ! \ reset for safety; 12oct2010 + EnReify ( move abstract Psi concepts to EnVocab reality ) + 0 act ! + 0 aud ! + -64 defact ! \ for default comparisons with "50=I"; 9oct2011 + 0 kibosh ! \ for de-activating non-selectees; 17aug2011 + 0 motjuste ! + 0 nphrnum ! \ prevent carry-overs; 11oct2011 + 0 num ! \ without prejudice; 29aug2010 + 0 prsn ! \ without prejudice; 29aug2010 + 0 putnum ! \ prevent carry-over from previous; 4nov2011 + 0 recnum ! \ prevent carry-over from previous; 4nov2011 + 0 tpeg ! \ reset for safety; 28sep2011 + nounlock @ 0 > IF \ already a nounlock? 19oct2011 + nounlock @ 2 en{ @ scn ! \ subject-concept-number 17jul2012 + nounlock @ 8 en{ @ audjuste ! \ tentatively; 10nov2012 + THEN \ end of test for a positive nounlock; 19oct2011 + 5 opt ! + 35 pov ! + 1 subjectflag ! ( 3dec2009 A default until countermanded ) + dirobj @ 1 = IF 0 subjectflag ! THEN ( 3dec2009 anti-default ) + predflag @ 1 = IF 0 subjectflag ! THEN ( anti-default 8oct2010 ) + 0 psi ! + midway @ t @ DO + I 5 psi{ @ 5 = I 5 psi{ @ 7 = OR IF \ POS; 12aug2011 + I 0 en{ @ 65 = IF I 8 en{ @ audme ! THEN \ 10nov2012 + subjectflag @ 1 = IF \ test; change; 26aug2011 + I 1 psi{ @ act @ > I 6 psi{ 0 > AND IF \ 6oct2011 + I 7 psi{ @ 0 > IF \ Testing for seq-concept; 12oct2011 + I tsels ! \ retain time of subject; 11sep2011 + I tseln ! \ retain time of motjuste; 11sep2011 + I 0 psi{ @ motjuste ! \ 12aug2011 + I 2 psi{ @ nphrnum ! \ NounPhrase num(ber); 6oct2011 + I 2 psi{ @ subjnum ! \ 11oct2011 + I 2 psi{ @ snu ! ! \ verb-select parameter 21dec2012 + THEN \ reinstating for subjects; 3oct2011 + ( insert NPhr diagnostic code here; 11sep2011 ) + I 2 psi{ @ subjnum ! \ verbs in general; 12aug2011 + motjuste @ subjold ! \ keep oldsubject ready; 8oct + I 2 psi{ @ putnum ! \ putative num for verb; 12aug2011 + I 5 psi{ @ nphrpos ! \ NounPhrase part-of-speech + I 1 psi{ @ act @ > I 7 psi{ @ 0 > AND IF \ 12oct2011 + I tpeg ! \ peg the time-slice; 28sep2011 + I 7 psi{ @ svo2 ! \ hold seq; test; 12oct2011 + I 6 psi{ @ verblock ! \ tqv of seq-concept; 12oct2011 + midway @ t @ DO \ from Wotan German AI; 21dec2012 + I 0 en{ @ motjuste @ = IF \ same concept? + I 8 en{ @ 0 > IF \ skip non-rv; 21dec2012 + \ I 2 en{ @ snu @ = IF \ same subj. number? + \ I 4 en{ @ 1 = IF \ nom. for subj? 21dec2012 + I 8 en{ @ audjuste ! \ avoid spurious + \ I 8 en{ @ 0 > IF \ positive recall-vector? + \ 1 8 en{ @ audjuste ! \ recall-vector 21dec + \ THEN \ end of test for positive rv 21dec2012 + \ THEN \ end of dba-test for nominative + \ THEN \ end of subject-number test; 21dec2012 + THEN \ end of skipping InFerence non-rb 21dec2012 + THEN \ end of search of English lexicon 21dec2012 + -1 +LOOP \ end of English lexicon search 21dec2012 + \ I 8 en{ @ audjuste ! \ avoid the spurious; 10nov2012 + motjuste @ 701 = IF \ guarantee "I"; 10nov2012 + midway @ t @ DO \ search backwards; 25oct2011 + I 0 en{ @ 701 = IF \ "701=I" 20dec2012 + I 8 en{ @ audjuste ! \ recall-vector + LEAVE \ one I-engram is enough; 25oct2011 + THEN \ end of test for "701=I"; 10nov2012 + -1 +LOOP \ end of "701=I" search loop; 10nov2012 + THEN \ end of test for "701=I"; 10nov2012 + motjuste @ 707 = IF \ guarantee "YOU"; 10nov2012 + midway @ t @ DO \ search backwards; 25oct2011 + I 0 en{ @ 707 = IF \ "707=YOU"; 10nov2012 + I 8 en{ @ audjuste ! \ recall-vector + LEAVE \ one YOU-engram is enough; 20dec2012 + THEN \ end of test for "707=YOU"; 10nov2012 + -1 +LOOP \ end of 707=YOU search loop; 10nov2012 + THEN \ end of test for "707=YOU"; 10nov2012 + I 1 psi{ @ act ! \ after passing seq-check; 28aug2011 + THEN \ reinstating to prevent false motjuste; 6oct2011 + THEN \ end of test for a higher activation; 26aug2011 + THEN \ end of test for 1=subjectflag; test; 26aug2011 + subjectflag @ 0 = IF \ i.e., dir.obj or pred.nom; 15oct2011 + nounlock @ 0 > IF + nounlock @ 0 psi{ @ motjuste ! \ nounlock psi; 22dec2012 + ELSE + I 1 psi{ @ act @ > IF \ if higher; 12aug2011 + I tseln ! \ retain time of motjuste; 8may2011 + I 0 psi{ @ motjuste ! \ 26aug2011 + ( insert NPhr diagnostic code here; 9sep2011 ) + nounlock @ 0 > IF \ if positive nounlock exists; 8oct2011 + I nounlock @ = IF \ upon reaching engram; 8oct2011 + I 0 psi{ @ motjuste ! \ grab nounlock psi; 8oct2011 + I 2 psi{ @ nphrnum ! \ NounPhrase num(ber) 11oct2011 + I 2 en{ @ pcn ! \ predicate concept number 16jul2012 + \ I 8 en{ @ audjuste ! \ 10nov2012 + midway @ t @ DO \ look for recall-vector; 22dec2012 + I 0 en{ @ motjuste @ = IF \ same concept? 22dec2012 + I 8 en{ @ 0 > IF \ positive rv? 22dec2012 + I 8 en{ @ audjuste ! \ 22dec2012 + THEN \ end of test for recall-vector; 22dec2012 + THEN \ end of test for concept; 22dec2012 + -1 +LOOP \ end of English lexicon search; 22dec2012 + LEAVE \ prevent usurpation of pre-ordained seq 8oct2011 + THEN \ end of test for Index = nounlock; 8oct2011 + THEN \ end of test for positive nounlock; 8oct2011 + \ I 0 psi{ @ subjpsi ! \ Commenting out; 20dec2012 + I 2 psi{ @ nphrnum ! \ NounPhrase num(ber); 12aug2011 + I 2 psi{ @ putnum ! \ putative num for verb; 12aug2011 + I 5 psi{ @ nphrpos ! \ NounPhrase part-of-speech + dirobj @ 1 = IF + motjuste @ objold ! \ a test ICW slosh-over; 12oct2010 + THEN ( http://christophe.lavarenne.free.fr/ff ) + I 1 psi{ @ act @ > IF \ 26aug2011 + I 1 psi{ @ act ! \ 12aug2011 + THEN \ 26aug2011 + THEN \ end of test for a higher activation; 26aug2011 + THEN \ end of test for positive nounlock; 22dec2012 + THEN \ end of test for 0=subjectflag; test; 26aug2011 + THEN \ end of test for a noun or pronoun; 26aug2011 + -1 +LOOP \ End of search for most active "motjuste"; 20dec2012 + subjectflag @ 1 = IF motjuste @ subjpsi ! THEN \ 20dec2012 + nounlock @ 0 > IF \ 22dec2012 + midway @ t @ DO \ from Wotan German AI; 22dec2012 + I 0 en{ @ motjuste @ = IF \ same concept? + I 8 en{ @ 0 > IF \ skip non-rv; 22dec2012 + I 8 en{ @ audjuste ! \ 22dec2012 + LEAVE \ if correct parameters; 22dec2012 + THEN \ emd of test for positive en8; 22dec2012 + THEN \ end of test for match with motjuste; 22dec2102 + -1 +LOOP \ end of English lexicon search 22dec2012 + THEN \ end of test for positive nounlock; 22dec2012 + midway @ t @ DO \ search backwards; 12aug2011; 12sep2011 + I 0 en{ @ motjuste @ = IF \ 12aug2011 + predflag @ 1 = IF \ only for predicate nominatives; + nounlock @ 0 = IF \ in absence of nounlock; 19oct2011 + I 2 en{ @ subjnum @ = IF \ agreement? 19sep2011 + I 8 en{ @ audjuste ! \ recall-vector; 10nov2012 + LEAVE \ one auditory engram is enough; 12aug2011 + THEN ( http://practicalai.org ) + THEN \ end of test for absence of nounlock; 19oct2011 + ELSE \ for normal direct objects; 19sep2011 + verblock @ 0 = IF \ if no verblock; test; 19oct2011 + I 8 en{ @ audjuste ! \ direct object; 10nov2012 + LEAVE \ one auditory engram is enough; 19sep2011 + THEN \ end of test for absence of nounlock; 19oct2011 + THEN \ end of test for predicate nominative; 19sep2011 + THEN \ end of test for match with motjuste; 12aug2011 + -1 +LOOP \ end of backwards search loop; 12aug2011 + nounlock @ 0 = IF \ if no nounlock override; 8oct2011 + act @ 20 < IF \ if no subject of thought is found; 21aug2011 + subjectflag @ 1 = IF \ default to "I" only as subject 17oct2011 + 701 motjuste ! \ 701=I default concept of AI Mind; 10nov2012 + midway @ t @ DO \ + I 0 psi{ @ 701 = I 7 psi{ @ 0 > AND IF \ 10nov2012 + I 1 psi{ @ defact @ > IF \ if higher act found; 9oct2011 + I tsels ! \ retain time of subject; 9oct2011 + I tseln ! \ retain time of motjuste; 9oct2011 + I 6 psi{ @ verblock ! \ lock onto valid verb; 12oct2011 + I 1 psi{ @ defact ! \ dynamic metric; 9oct2011 + THEN \ end of test for higher-act ego-concept; 9oct2011 + THEN \ end of search for least-inhibited "50=I"; 9oct2011 + -1 +LOOP \ End of loop finding "50=I"; 9oct2011 + 701 subjpsi ! \ for use elsewhere; 10nov2012 + 701 topic ! \ for question-asking modules; 10nov2012 + 1 nphrnum ! \ for EnArticle and VerbPhrase; 6oct2011 + 7 nphrpos ! \ prevent article "A" with "I"; 6oct2011 + 1 subjnum ! \ for use elsewhere; 16aug2011 + 1 prsn ! \ for use elsewhere; 16aug2011 + midway @ t @ DO \ Use parameters to find "I"; 11nov2012 + I 0 en{ @ 701 = IF \ If 701=I is found; 10nov2012 + I 4 en{ @ 1 = IF \ parameter dba=1? 11nov2012 + I 8 en{ @ audjuste ! \ recall-vector; 10nov2012 + LEAVE \ Use the most recent engram of "I"; 16aug2011 + THEN \ end of search for nominative "I"; 11nov2012 + THEN \ End of search for 701=I; 10nov2012 + -1 +LOOP \ End of parameter-based search-loop; 11nov2012 + THEN \ end of test for "I" to become subj. not obj. 17oct2011 + THEN \ end of test for low activation warranting a default + THEN \ end of test for absence of pre-ordained nounlock; 8oct2011 + nounlock @ 0 > IF \ if positive; test; 16aug2012 + motjuste @ 701 = IF \ if 701=I is indicated; 10nov2012 + midway @ t @ DO \ Look backwards for 65=ME; 16aug2012 + I 0 en{ @ 65 = IF \ If #65 "ME" found; 16aug2012 + I 8 en{ @ audjuste ! \ "ME" engram 10nov2012 + LEAVE \ Use most recent engram of "ME"; 16aug2012 + THEN \ End of search for #65 "ME"; 16aug2012 + -1 +LOOP \ End of loop finding word "ME"; 16aug2012 + THEN \ end of special override for 65=ME; 16aug2012 + motjuste @ 707 = IF \ if 707=YOU is needed; 10nov2012 + midway @ t @ DO \ Look backwards for 56=YOU; 16aug2012 + I 0 en{ @ 56 = IF \ If #56 "YOU" found; 16aug2012 + I 8 en{ @ audjuste ! \ "YOU" engram 10nov2012 + LEAVE \ Use most recent engram of "YOU"; 16aug2012 + THEN \ End of search for #56 "YOU"; 16aug2012 + -1 +LOOP \ End of loop finding word "YOU"; 16aug2012 + THEN \ end of special override for 56=YOU; 16aug2012 + THEN \ end of test for a positive nounlock; 16aug2012 + dirobj @ 1 = IF \ When seeking direct object; 13jun2011 + nounlock @ 0 = IF \ if no nounlock override; 8oct2011 + act @ 20 < IF \ If activation too low; 13jun2011 + WhatAuxSVerb \ ask question for lack of dirobj 30jul2011 + EXIT \ Abandon rest of NounPhrase; 13jun2011 + THEN \ End of test for sufficient activation; 13jun2011 + THEN \ end of test for a nounlock in play; 8oct2011 + THEN \ End of test for direct object; 13jun2011 + \ The following code for the irregular English noun "child" + \ serves as example code for the many German or Russian + \ irregular nouns that a "DeKi" or "PyYm" AI must deal with. + motjuste @ 112 = IF \ irregular "112=CHILD"; 10nov2011 + nphrnum @ 2 < IF \ if singular is needed; 10nov2011 + midway @ t @ DO \ search backwards; 10nov2011 + I 0 en{ @ 525 = IF \ 525=CHILD; 11nov2012 + I 8 en{ @ audjuste ! \ for SpeechAct; 10nov2011 + LEAVE \ one engram is enough; 10nov2011 + THEN \ end of test for CHILD-engram; 10nov2011 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for singular 525=CHILD; 11nov2012 + nphrnum @ 2 = IF \ 10nov2011 + midway @ t @ DO \ search backwards; 10nov2011 + I 0 en{ @ 526 = IF \ 526=CHILDREN; 11nov2012 + I 8 en{ @ audjuste ! \ for SpeechAct; 10nov2011 + LEAVE \ one engram is enough; 10nov2011 + THEN \ end of test for CHILDREN-engram; 10nov2011 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for plural 526=CHILDREN; 11nov2012 + THEN \ end of special handling of irregular 525=CHILD; + motjuste @ 701 = IF \ if 701=I selected; 10nov2012 + 1 prsn ! \ first person; 29aug2010 + 1 num ! \ singular; 29aug2010 + 1 nphrnum ! \ singular; 30aug2010 + THEN \ end of test for 50=I; 29aug2010 + EnDamp + motjuste @ hipsi ! + 0 anset ! ( Insert "AN" article before vowels. ) + \ MindForth may start treating "AN" as inflected "A"; 13sep2011 + aud @ 0 aud{ @ 65 = IF 65 anset ! THEN ( if vowel A ) + aud @ 0 aud{ @ 69 = IF 69 anset ! THEN ( if vowel E ) + aud @ 0 aud{ @ 73 = IF 73 anset ! THEN ( if vowel I ) + aud @ 0 aud{ @ 79 = IF 79 anset ! THEN ( if vowel O ) + aud @ 0 aud{ @ 85 = IF 85 anset ! THEN ( if vowel U ) + \ Following code covers also "audjuste"; 21oct2011 + audjuste @ 0 aud{ @ 65 = IF 65 anset ! THEN ( if A ) + audjuste @ 0 aud{ @ 69 = IF 69 anset ! THEN ( if E ) + audjuste @ 0 aud{ @ 73 = IF 73 anset ! THEN ( if I ) + audjuste @ 0 aud{ @ 79 = IF 79 anset ! THEN ( if O ) + audjuste @ 0 aud{ @ 85 = IF 85 anset ! THEN ( if U ) + whoflag @ 0 = IF \ If not answering a who-is query; 23jul2010 + \ EnArticle \ Give a chance, not an order; 23jul2010 + nphrnum @ 1 = IF \ not default zero; 4nov2011 + \ EnArticle \ for true singular; 4nov2011 + THEN \ end of test for 1=singular; 4nov2011 + 0 whoflag ! \ Here instead of at InStantiate; 23jul2010 + THEN \ End of test for zero whoflag; 23jul2010 + whoflag @ 1 = IF \ If answering a who-is query; 26aug2011 + EnArticle \ answer with Is-a etc.; 26aug2011 + 0 whoflag \ zero out after use; 26aug2011 + THEN \ end of whoflag test; 26aug2011 + num @ 1 = IF \ If num(ber is singular; 10ap2010 + EnPronoun \ Prepare to substitute he she it; 10apr2010 + THEN \ End of test of num(ber); 10apr2010 + motjuste @ 701 = NOT IF \ if not 701=I; 10nov2012 + motjuste @ 707 = NOT IF \ not 707=you; 10nov2012 + motjuste @ 731 = NOT IF \ 731=WE; 10nov2012 + 3 prsn ! \ not I YOU WE; 29aug2010 + THEN \ end of test for 731=WE; 10nov2012 + THEN \ end of test for 707=YOU; 10nov2012 + THEN \ end of test for "not I" 29aug2010 + motjuste @ nacpsi ! + ( could use "subjectflag" for test below; 18oct2010 ) + dirobj @ 0 = IF \ only let subjects call NounAct; 17oct2010 + NounAct + THEN \ end of test originating in JavaScript AI; 17oct2010 + 0 nacpsi ! + 0 nounval ! + 66 caller ! \ test; 26sep2010 + motjuste @ urpsi ! \ test; 17oct2010 + PsiDamp \ to prevent interference; 17oct2010 + 0 caller ! \ reset after use; 26sep2010 + 0 urpsi ! \ reset for safety; 24sep2010 + 66 caller ! \ test; 12oct2010 + objold @ urpsi ! \ test; 12oct2010 + 0 caller ! \ reset after use; 12oct2010 + 0 urpsi ! \ reset for safety; 12oct2010 + -8 tsels @ 1 psi{ ! \ Let subjects re-surface; 12oct2011 + predflag @ 1 = dirobj @ 1 = OR IF \ test; 29may2011 + -16 tseln @ 1 psi{ ! \ test; 12oct2011 + THEN \ only inhibit predicate nominatives; 11sep2010 + predflag @ 1 = IF \ helps for Is-a; 15sep2010 + EnArticle \ say "A" or "THE"; 15sep2010 + THEN \ end of test; 15sep2010 + audjuste @ aud ! + aud @ 0 > IF \ avoid ERROR; 19sep2010 + SpeechAct \ Display or speak the selected noun-phrase. + 0 anset ! \ Reset for safety; 21oct2011 + THEN \ end of test for 0=aud ERROR; 19sep2010 + predflag @ 1 = dirobj @ 1 = OR IF \ both; 23jun2011 + -32 t @ 1 - 1 psi{ ! \ inhibit new noun-node; 27sep2010 + -32 t @ 1 psi{ ! \ AI is now robust enough; 5aug2011 + THEN \ only inhibit predicate nominatives; 12sep2010 + -16 t @ 1 - 1 psi{ ! \ Even shallower; 12oct2011 + -16 t @ 1 psi{ ! \ Even shallower; 12oct2011 + 32 EMIT + fyi @ 2 > IF CR + ." from NounPhrase " + THEN + motjuste @ topic ! + instnum @ topicnum ! + dirobj @ 1 = predflag @ 1 = OR IF \ if set; 24sep2010 + 66 caller ! \ test; 26seo2010 + motjuste @ urpsi ! \ prepare to psi-damp motjuste; 24sep + PsiDamp \ knock down activation of non-subject; 24sep2010 + 0 caller ! \ test; 26sep2010 + 0 urpsi ! \ reset for safety; 24sep2010 + THEN \ end of test for a non-subject (pro)noun; 24sep2010 + 0 act ! + 0 aftjux ! \ reset for safety; 27jul2011 + 0 anset ! \ reset for safety; 21oct2011 + 0 jux ! \ reset for safety; 27jul2011 + 0 nounlock ! \ after causing selection of VPhr seq-noun 8oct2011 + 0 prejux ! \ reset for safety; 27jul2011 + 0 psi ! + 0 psi3 ! \ reset for safety 27jul2011 +; ( http://code.google.com/p/mindforth/wiki/NounPhrase ) + + +: ConJoin + questype @ 370 = IF \ 370=WHY; 10nov2012 + 344 conj ! \ 344=BECAUSE; 10nov2012 + ELSE 302 conj ! \ 302=AND; 10nov2012 + THEN ( http://www.taygeta.com/forth.html ) + midway @ t @ DO + I 0 en{ @ conj @ = IF + conj @ motjuste ! + I 8 en{ @ aud ! \ 10nov2012 + LEAVE + THEN + -1 +LOOP + SpeechAct + 0 questype ! +; ( http://code.google.com/p/mindforth/wiki/ConJoin ) + + +: VerbGen ( stub of verb-generation module; 15nov2012 ) + \ VerbGen uses "audbase" as a starting point in auditory + \ memory for the transfer of a left-justified verb first + \ into AudBuffer and then as a right-justified word into + \ OutBuffer so that inflectional endings ("-S": "-ING") + \ may be added to or subtracted from the word in memory. + \ http://www.scn.org/~mentifex/Dushka.html is Russian AI + \ with major use of VerbGen, which will also be used in + \ http://www.scn.org/~mentifex/DeKi.txt German Wotan AI. +; \ End of stub of VerbGen module for verb-generation. + + +\ The VerbPhrase module aims for the following entelechy goals. +\ [ ] If no predicate nominative is known, detour into a question. +\ [ ] If no transitive verb is most active, default to verb of being. +\ [ ] If no direct object is found, detour into asking a question. +\ 7dec2009 If no verb is found for a noun, defer to SelfRef NOT-KNOW. +\ [ ] If a transitive verb is most active, try to find direct object. +\ [X] Find whatever verb is most active after a noun-phrase. +\ Verb-selection shifts from en{ array to psi{ array on 12aug2011. +: VerbPhrase ( supervise verb syntax ) + verblock @ 0 > IF \ positive verbloc? 20oct2011 + verblock @ 6 psi{ @ nounlock ! \ test; 20oct2011 + THEN \ end of test for a positive verblock; 20oct2011 + 0 subjectflag ! \ for only absolute SpreadAct; test; 4aug2011 + EnReify + 0 act ! + 0 aud ! + 0 kibosh ! \ for de-activating non-selectees; 17aug2011 + 0 motjuste ! + verblock @ 0 > IF \ already a verblock? 20oct2011 + verblock @ 0 en{ @ verbpsi ! \ lexical verbpsi 13nov2012 + verblock @ 8 en{ @ audbase ! \ VerbGen parameter 13nov2012 + subjpsi @ 701 = subjpsi @ 731 = OR IF 1 prsn ! THEN \ I or WE + subjpsi @ 707 = subjpsi @ 737 = OR IF 2 prsn ! THEN \ YOU + subjpsi @ 713 = subjpsi @ 719 = OR IF 3 prsn ! THEN \ HE; SHE + subjpsi @ 725 = subjpsi @ 743 = OR IF 3 prsn ! THEN \ IT THEY + prsn @ dba ! \ from DeKi; parameter for VerbGen; 21dec2012 + \ verblock @ 8 en{ @ vphraud ! \ tentatively; 10nov2012 + 0 vphraud ! \ until a known verb is found; 22dec2012 + midway @ t @ DO \ from Wotan AI; search lexicon; 22dec2012 + I 0 en{ @ verbpsi @ = IF \ 1: same psi? 22dec2012 + I 8 en{ @ 0 > IF \ skip InF lacking aud; 22dec2012 + I 8 en{ @ vphraud ! \ tentatively; 22dec2012 + THEN \ end of check for positive rv; 22dec2012 + THEN \ end of parameter test; 22dec2012 + -1 +LOOP \ end of loop searching lexicon; 22dec2012 + THEN \ end of test for a positive verblock; 20oct2011 + 8 opt ! + 0 psi ! + 0 vphract ! \ for validity of threshold-tests; 15aug2011 +\ 0 vphraud ! \ prevent spurious carry-overs; 3oct2011 +\ 0 vphraud ! \ commenting out as a test; 22dec2012 + adverbact 32 > IF + ( EnAdverb ) + THEN ( http://theforthsource.com ) + fyi @ 1 > IF CR + ." VerbPhrase preview with slosh-over indicated by + --" + CR + ." Disparate verb-node activations slosh " \ 7nov2010 + ." over onto candidate objects." CR ." " \ 7nov2010 + THEN + verblock @ 0 = IF \ prevent false negations; 20oct2011 + midway @ t @ DO \ Search backwards through psi concepts. + I 5 psi{ @ 8 = IF \ if 8=pos verb; 12aug2011 + I 1 psi{ @ act @ > IF ( if psi1 is higher 12aug2011 ) + I tselv ! \ retain time of winning verb; 8may2011 + tselv @ kibosh @ < IF \ if different 17aug2011 + \ ." KIBOSH = " kibosh @ . \ 17aug2011 + 0 kibosh @ 1 psi{ ! \ deactivate also-ran; 17aug2011 + THEN \ end of comparison; 17aug2011 + I kibosh ! \ time of predecessor cand 17aug2011 + I 0 psi{ @ motjuste ! ( store psi-tag of verb 12aug2011 ) + I 3 psi{ @ negjux ! ( record any 250=NOT; 21dec2012 ) + ( insert diagnostic code here; 7sep2011 ) + verblock @ 0 > IF \ if positive verblock exists; 8oct2011 + I verblock @ = IF \ upon reaching engram; 8oct2011 + I tselv ! \ time of sel. of verb; 30jul2012 + I 0 psi{ @ motjuste ! \ grab verblock psi; 8oct2011 + 64 act ! \ to pass threshold-test; 20oct2011 + I 3 psi{ @ negjux ! \ for negation of verb; 9oct2011 + I 8 en{ @ vphraud ! \ for SpeechAct; 10nov2012 + I 6 psi{ @ nounlock ! \ after verb grab seq; 12oct2011 + LEAVE \ prevent usurpation of pre-ordained seq; 7oct2011 + THEN \ end of test for Index = verblock; 8oct2011 + THEN \ end of test for positive verblock; 8oct2011 + I 1 psi{ @ 0 > IF \ positive activation; 12aug2011 + I 3 psi{ @ psi3 ! ( Check for negation; 25jun2011 ) + verblock @ 0 = IF \ test; 20oct2011 + I 3 psi{ @ negjux ! ( be-verb negation; 9oct2011 ) + THEN \ end of avoidance of false negation; 20oct2011 + I 6 psi{ @ tqv ! \ underailable qtv; 12oct2011 + THEN \ end of test for positive activation; 27jul2011 + I 5 psi{ @ predpos ! ( Grab winning part of speech 12aug2011 ) + I 8 en{ @ vphraud ! ( auditory recall-vector 10nov2012 ) + I 1 psi{ @ act ! ( to test for a higher psi1 12aug2011 ) + THEN ( http://win32forth.sourceforge.net ) + THEN \ end of test for opt=8 verbs; 8sep2011 + -1 +LOOP \ end of loop cycling back through psi concepts + THEN \ end of verblock-test to prevent false negations; 20oct2011 + verblock @ 0 > IF \ if positive verblock exists; 20oct2011 + verblock @ 0 psi{ @ motjuste ! \ verblock override; 21oct2011 + verblock @ 3 psi{ @ negjux ! \ capture any 250=NOT; 21dec2012 + vphraud @ 0 = IF \ prevent override of selection 22dec2012 + verblock @ 8 en{ @ vphraud ! \ auditory recall-v; 10nov2012 + THEN \ end of test to prevenmt override; 22dec2012 + 64 act ! \ prevent rejection of selection; 20oct2011 + THEN \ end of test for positive verblock; 20oct2011 + tqv @ 0 psi{ @ svo3 ! \ test; 29sep2011 +\ 128 tqv @ 1 psi{ ! \ accentuate tqv-seq; 29sep2011 + tqv @ 0 > IF 128 tqv @ 1 psi{ ! THEN \ test; 24jan2012 + act @ vphract ! \ for threshold comparisons; 21jun2011 + act @ verbval ! + 0 psi ! + fyi @ 2 > IF + CR ." VerbPhrase: motjuste = " motjuste @ . + ." going into SPEECH." + CR ." VerbPhrase: aud = " aud @ . + ." going into SPEECH." + THEN + motjuste @ 0 = IF + nphrnum @ 1 = IF \ 21jun2011 + mfnflag @ 0 > IF \ if masc. or fem.; 30jul2011 + fyi @ 2 = IF ." VPhr calls WhoBe" THEN \ 4jul2012 + WhoBe \ ask WHO not WHAT; 30jul2011 + 0 mfnflag ! \ reset after use; 30jul2011 + EXIT \ abandon rest of VerbPhrase + THEN \ end of test for positive mfnflag; 30jul2011 + fyi @ 2 = IF ." VPhr calls WhatBe" THEN \ 6jul2012 + WhatBe \ for a what-is question; test; 21jun2011 + EXIT \ abandon rest of VerbPhrase; 2jul2011 + THEN \ 21jun2011 + nphrnum @ 2 = IF \ 2jul2011 + fyi @ 2 = IF ." VPhr calls WhatAuxSDo" THEN \ 6jul2012 + WhatAuxSDo \ what do Subjects do? 2jul2011 + 1 yncon ! \ after input ask yes-or-no question + EXIT \ abandon rest of VerbPhrase; 2jul2011 + THEN \ end of test for plural noun; 2jul2011 + THEN + motjuste @ 0 > IF + vphract @ 20 < IF \ a test ICW WhoBe; 21jun2011 + nphrnum @ 1 = IF \ 21jun2011 + mfnflag @ 0 > IF \ if masc. or fem.; 30jul2011 + fyi @ 2 = IF ." VerbPhr calls WhoBe" THEN \ 4jul2012 + WhoBe \ ask WHO not WHAT; 30jul2011 + 0 mfnflag ! \ reset after use; 30jul2011 + EXIT \ abandon rest of VerbPhrase + THEN \ end of test for positive mfnflag; 30jul2011 + fyi @ 2 = IF ." VerbPhr calls WhatBe" THEN \ 6jul2012 + WhatBe \ for a what-is question; test; 21jun2011 + EXIT \ abandon rest of VerbPhrase; 30jul2011 + THEN \ 21jun2011 + nphrnum @ 2 = IF \ 2jul2011 + fyi @ 2 = IF ." VPhr calls WASD" THEN \ 6jul2012 + WhatAuxSDo \ what do Subjects do? 2jul2011 + 1 yncon ! \ after input ask yes-or-no question + EXIT \ abandon rest of VerbPhrase; 2jul2011 + ELSE \ if "nphrnum" neither 1 nor 2; 15aug2011 + EXIT \ to avoid a spurious thought; 15aug2011 + THEN \ end of test for plural noun; 2jul2011 + THEN \ End of test of vphract; 21jun2011 + psi3 @ 250 = negjux @ 250 = OR IF \ 10nov2012 + motjuste @ 800 = NOT IF \ 10nov2012 + AuxVerb \ to say "DO" or "DOES" 25jun2011 + midway @ t @ DO \ Search En(glish) array; 25jun2011 + \ I 0 en{ @ 12 = IF \ Look for "NOT"; 25jun2011 + I 0 en{ @ 250 = IF \ Look for "NOT"; 29dec2012 + I 8 en{ @ aud ! \ Auditory start-tag 10nov2012 + LEAVE \ One instance of NOT suffices; 25jun2011 + THEN \ End of lexical test for 250=NOT; 19dec2012 + -1 +LOOP \ End of loop searching for 250=NOT; 29dec2012 + SpeechAct \ Say the word "NOT"; 25jun2011 + 0 psi3 ! \ reset for safety; 27jul2011 + THEN \ end of test to not say do w. be-verbs; 28jul2011 + THEN \ end of test for psi3 jux negation; 25jun2011 + motjuste @ 800 = NOT IF \ if not a be-verb; 10nov2012 + nphrnum @ 1 = IF \ 14aug2011 + prsn @ 3 = IF \ Only for third person; 8may2011 + 83 flex1 ! \ for flex1,2,3 (-S; -ING); 11sep2011 + 1 vpos ! \ 14aug2011 + THEN \ End of test for 3rd person (sing) 8may2011 + THEN \ end of test fof singular; 14aug2011 + THEN \ end of test for not a be-verb; 14aug2011 + motjuste @ hipsi ! + motjuste @ 830 = IF \ irregular 830=DO; 10nov2012 + subjnum @ 1 = prsn @ 3 = AND IF \ 5oct2011 + midway @ t @ DO \ search backwards; 5oct2011 + I 0 en{ @ 830 = IF \ 830=DO; 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd pers? 10nov2012 + I 8 en{ @ vphraud ! \ 10nov2012 + LEAVE \ one engram is enough; 5oct2011 + THEN \ end of test for third person 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for 830=DO; 10nov2012 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for 3rd person singular; 5oct2011 + THEN \ end of special handling of 59=DO; 5oct2011 + \ The following code for the irregular English verb + \ "to have" serves as example code for the many German + \ irregular verbs that a polyglot AI must deal with. + motjuste @ 810 = IF \ irregular 810=HAVE; 10nov2012 + subjnum @ 1 = prsn @ 3 = AND IF \ 13aug2011 + midway @ t @ DO \ search backwards; 13aug2011 + I 0 en{ @ 810 = IF \ 810=HAVE 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 3 = IF \ 3rd pers? 10nov2012 + I 8 en{ @ vphraud ! \ 10nov2012 + LEAVE \ one engram is enough; 13aug2011 + THEN \ end of test for 3rd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for HAS-engram; 13aug2011 + -1 +LOOP \ end of search of En(glish) lexicon + THEN \ end of test for 3rd person singular; 13aug2011 + THEN \ end of special handling of 70=HAVE; 13aug2011 + motjuste @ 800 = IF \ present-tense be-verb? 10nov2012 + 1 predflag ! \ for sake of NounPhrase; 26aug2011 + subjnum @ 1 = IF \ singular subject number; 16aug2011 + prsn @ 1 = IF \ first person; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 57 = IF \ 57=AM; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 57=AM; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for first person; 16aug2011 + prsn @ 2 = IF \ singular or plural; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 67 = IF \ 67=ARE; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 67=ARE; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for second person; 16aug2011 + prsn @ 3 = IF \ third person; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 66 = IF \ 66=IS; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 66=IS; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for third person; 16aug2011 + THEN \ end of test for singular; 16aug2011 + subjnum @ 2 = IF \ if plural subject; 16aug2011 + midway @ t @ DO \ search En-lexicon; 16aug2011 + I 0 en{ @ 67 = IF \ 67=ARE; 16aug2011 + I 8 en{ @ vphraud ! \ engram; 10nov2012 + LEAVE \ one engram is enough; 16aug2011 + THEN \ end of test for 67=ARE; 16aug2011 + -1 +LOOP \ end of loop; 16aug2011 + THEN \ end of test for plural number; 16aug2011 + THEN \ end of two-step be-verb substitution; 16aug2011 + motjuste @ 800 = IF \ 800=BE; 10nov2012 + subjpsi @ 701 = IF \ 701=I; 10nov2012 + midway @ t @ DO \ search En(glish) array; 21aug2011 + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + 800 motjuste ! ( Set verbform to "BE" 10nov2012 ) + 800 urpsi ! ( parameter for PsiDamp 10nov2012 ) + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 1 = IF \ 1st pers? 10nov2012 + I 8 en{ @ vphraud ! \ SpeechAct 10nov2012 + LEAVE \ recent "AM" is enough 12aug2011 + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of two-step test to say "AM"; 12aug2011 + -1 +LOOP \ end of backwards loop; 12aug2011 + THEN \ end of test for "50=I" subject-psi; 12aug2011 + subjpsi @ 707 = IF ( 707=YOU; 10nov2012 ) + midway @ t @ DO \ 8aug2011 + I 0 en{ @ 800 = IF \ 800=BE 10nov2012 + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 2 = IF \ 2nd pers? 10nov2012 + I 8 en{ @ vphraud ! \ 10nov2012 + LEAVE \ 8aug2011 + THEN \ end of test for 2nd person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for 800=BE: 10nov2012 + -1 +LOOP \ 8aug2011 + THEN \ 8aug2011 + THEN \ end of test for 58=BE; 13aug2011 + motjuste @ 800 = IF \ 800=BE; 10nov2012 + subjpsi @ 701 = IF \ 701=I; 10nov2012 + midway @ t @ DO \ search En(glish) array; 11aug2011 + I 0 en{ @ 800 = IF \ 800=BE; 10nov2012 + 800 motjuste ! ( Set verbform to "BE" 10nov2012 ) + I 2 en{ @ 1 = IF \ singular? 10nov2012 + I 4 en{ @ 1 = IF \ 1st pers? 10nov2012 + I 8 en{ @ vphraud ! \ SpeechAct 10nov2012 + LEAVE \ finding recent "AM" is enough 11aug2011 + THEN \ end of test for first person; 10nov2012 + THEN \ end of test for singular; 10nov2012 + THEN \ end of test for be-verb; 10nov2012 + -1 +LOOP \ end of backwards loop; 11aug2011 + THEN \ end of test for "50=I" subject-psi; 11aug2011 + THEN \ end of test for be-verb 67=ARE; 11aug2011 + motjuste @ 58 = IF \ shift from BE; 27aug2010 + num @ 1 = IF \ singular; 27aug2010 + prsn @ 1 = IF \ if first person; 29aug2010 + midway @ t @ DO \ search backwards in time + I 0 en{ @ 57 = IF \ recent 57=AM; 12sep2010 + I 8 en{ @ aud ! \ get recall-vector + LEAVE \ after finding recent "AM"; 29aug2010 + THEN \ end of test for 67=AM; 29aug2010 + -1 +LOOP \ end of retrieval loop for "AM"; 29aug2010 + 0 prsn ! \ reset after use; 29aug2010 + THEN \ end of test for 1st person sing; 29aug2010 + prsn @ 3 = IF \ if third person; 12sep2010 + midway @ t @ DO \ search backwards in time + I 0 en{ @ 66 = IF \ most recent instance + 66 motjuste ! ( 66=IS; 27aug2010 ) + I 8 en{ @ aud ! \ get recall-vector + LEAVE \ after finding recent "IS"; 28aug2010 + THEN \ end of test for 66=IS; 27aug2010 + -1 +LOOP \ end of retrieval loop for "IS"; 27aug2010 + THEN \ end of test for 3rd person sing; 12sep2010 + THEN \ end of test for singular; 27aug2010 + ( following code covers undeclared plurals; 27aug2010 ) + num @ 1 = NOT IF \ other than singular; 27aug2010 + midway @ t @ DO \ search backwards in time + I 0 en{ @ 67 = IF \ most recent instance + 67 motjuste ! ( 67=ARE; 27aug2010 ) + I 8 en{ @ aud ! \ get recall-vector + LEAVE \ after finding recent "ARE"; 27aug2010 + THEN \ end of test for 67=ARE; 27aug2010 + -1 +LOOP \ end of retrieval loop for "ARE"; 27aug2010 + THEN \ end of test for not singular; 27aug2010 + THEN \ end of test for 58=BE; 27aug2010 + 0 subjectflag ! \ for SpreadAct slosh-over; 18oct2010 + motjuste @ vacpsi ! \ prepare to deglobalize; 27sep2010 + motjuste @ verbpsi ! \ for WhatAuxSVerb; 13jun2011 + VerbAct + 0 vacpsi ! \ reset for safety; 27sep2010 + nphrnum @ 2 = NOT IF \ if not plural; test; 30aug2010 + 1 nphrnum ! \ default to singular; test; 30aug2010 + THEN \ end of test for plural nphrnum; 30aug2010 + motjuste @ 800 = NOT IF \ 10nov2012 + prsn @ 3 = IF \ 3rd person? 29aug2010 + nphrnum @ 1 = IF \ test; 30aug2010 + \ 83 flex1 ! \ xfer "S" to SpeechAct; 11sep2011 + \ 83 flex1 ! \ VerbGen should be used instead 29dec2012 + THEN \ end of test for singular nphrnum; 30aug2010 + THEN \ end of test for 3rd person; 29aug2010 + THEN \ end of test for not a be-verb; 29jul2012 + vphraud @ aud ! \ transfer just before call; 25jun2011 + SpeechAct ( main call from VerbPhrase to SpeechAct ) + VerbClear \ deactivate before inhibiting; 17aug2011 + -32 t @ 1 - 1 psi{ ! \ inhibit new verb-node; 3sep2011 + -32 t @ 1 psi{ ! \ inhibit new verb-node; 3sep2011 + 0 flex1 ! \ reset for safety; 11sep2011 + 0 vphraud ! \ reset for safety; 25jun2011 + 0 vpos ! + motjuste @ 800 = IF \ 10nov2012 + negjux @ 250 = IF \ 250=NOT; 10nov2012 + midway @ t @ DO \ Search En(glish) array; 27jul2011 + I 0 en{ @ 250 = IF \ Look for "NOT 10nov2012 + I 8 en{ @ aud ! \ Auditory start-tag 10nov2012 + LEAVE \ One instance of NOT suffices; 27jul2011 + THEN \ End of lexical test for 12=NOT; 27jul2011 + -1 +LOOP \ End of loop searching for 250=NOT 10nov2012 + \ 7 EMIT \ audible report of saying NOT; test; 28aug2011 + SpeechAct \ Say the word "NOT"; 27jul2011 + 0 aftjux ! \ reset for safety; 27jul2011 + 0 negjux ! \ reset for safety; 9oct2011 + 0 prejux ! \ reset for safety; 27jul2011 + 0 jux ! \ reset for safety; 27jul2011 + 0 psi3 ! \ reset for safety; 27jul2011 + THEN \ end of test for negated be-verb; 27jul2011 + THEN \ end of test for be-verb; 27jul2011 + THEN \ end of test for positive motjuste; 29aug2010 + 10 act ! + motjuste @ urpsi ! + 62 caller ! + PsiDamp \ Necessary for chain of thought; 24oct2010 + 0 caller ! + EnDamp + \ Following lines inhibit old KB verb-node; 13jun2011 + -32 tselv @ 1 psi{ ! \ Shallow inhibition; 3sep2011 + 0 tselv ! \ Reset tselv after use; 13jun2011 + 32 EMIT + 1 dirobj ! + subjpsi @ 701 = IF \ only for subject 701=I; 10nov2012 + motjuste @ 820 = IF \ only for verb 820=SEE; 10nov2012 + svo3 @ 0 = IF \ if SEE has no direct object; 22sep2011 + VisRecog \ a challenge for robot AI coders 22sep2011 + SpeechAct \ say default from VisRecog; 22sep2011 + EXIT \ abandon rest of VerbPhrase; 22sep2011 + THEN \ end of test for direct object; 22sep2011 + THEN \ end of test for "820=SEE"; 10nov2012 + THEN ( http://code.google.com/p/robotbridgeware ) + motjuste @ 800 = IF 1 predflag ! THEN \ 800=BE; 10nov2012 + ( EnAdjective -- a possibility here; 24aug2011 ) + NounPhrase + 0 predflag ! \ reset for safety; 12sep2010 + motjuste @ 0 > IF motjuste @ dopsi ! THEN + 0 dirobj ! + 0 negjux ! \ reset for safety; 9oct2011 + 0 numflag ! \ 3dec2009 Whether used here or in BeVerb. + 0 predflag ! \ Reset for safety; 26aug2011 + 0 psi3 ! \ reset for safety; 27jul2011 + 0 svo3 ! \ use once per thought; 9sep2011 + 0 tqv ! \ reset for safety; 29sep2011 + 0 verblock ! \ after causing selection of NPhr seq-verb; 8oct2011 +; ( http://code.google.com/p/mindforth/wiki/VerbPhrase ) + + +: InFerence ( create silent triples for machine reasoning ) + 1 moot ! \ prevent interference; test; 20dec2012 +\ CR ." InFer: subjnom prednom = " \ test; 1jan2012 +\ subjnom @ . prednom @ . CR \ test; 1jan2013 + midway @ t @ DO \ search IdeaPlex to infer facts; 18dec2012 + prednom @ 0 > IF \ positive predicate nominative? 1jan2012 + I 0 psi{ @ prednom @ = IF \ KB data? 18dec2012 + I 4 en{ @ 1 = IF \ nominative? 18dec2012 + seqverb @ 0 = IF \ only once; 18dec2012 + I 6 psi{ @ seqtqv ! \ transfer; 18dec2012 + I 7 psi{ @ seqverb ! \ transfer; 18dec2012 + I 7 psi{ @ quverb ! \ for AskUser; 27dec2012 + 0 ynverb ! \ for one AskUser question; 27dec2012 + \ 2 nphrnum ! \ test; remove; 27dec2012 + \ 2 nphrnum ! \ Commenting out as obsolete; 1jan2013 + seqverb @ seq ! \ test; 18dec2012 + THEN \ end of test for not-yet-declared; 18dec2012 + \ CR ." InFer: t psi seqverb = " \ test; 27dec2012 + \ I . prednom @ . seqverb @ . \ 18dec2012; 27dec2012 + \ LEAVE \ at first make only one inference; 18dec2012 + ELSE \ no nominative prednom? 1jan2012 + CR ." No inference can be made." \ test; 1jan2013 + THEN \ end of test for nominative; 18dec2012 + THEN \ end of test for finding prednom facts; 18dec2012 + THEN \ end of test for positive predicate nominative 1jan2012 + -1 +LOOP \ end of backwards loop; 18dec2012 +\ CR ." InFer: subjnom prednom seqverb = " \ test; 2jan2012 +\ subjnom @ . prednom @ . seqverb @ . \ test; 2jan2013 + seqverb @ 0 > IF \ verb available for inference? 2jan2013 + t @ inft ! \ for AskUser to find auditory engrams 25dec2012 + 1 t +! \ increment time "t" by one for a gap; 18dec2012 + 1 t +! \ increment time to create an inference; 18dec2012 + subjnom @ t @ 0 psi{ ! \ subj of inference; 18dec2012 + 48 t @ 1 psi{ ! \ activation of inf. 20dec2012 + 2 t @ 2 psi{ ! \ num(ber) test; replace; 20dec2012 + 5 t @ 5 psi{ ! \ pos=5 noun; 18dec2012 + t @ 1 + t @ 6 psi{ ! \ psi6=tqv; 18dec2012 + seqverb @ seq ! \ prevent override? test 20dec2012 + seqverb @ t @ 7 psi{ ! \ seq is the verb; 18dec2012 + subjnom @ t @ 8 psi{ ! \ enx; 18dec2012 + subjnom @ t @ 0 en{ ! \ for .en report; 21dec2012 + 2 t @ 2 en{ ! \ default num(ber) 21dec2012 + 1 t @ 4 en{ ! \ default nominative; 20dec2012 + \ 5 t @ 6 en{ ! \ default 5=pos noun; 20dec2012 + 0 t @ 8 en{ ! \ pseudo-recall-tag; 21dec2012 + 1 t +! \ increment t for storage of verb; 18dec2012 + seqverb @ t @ 0 psi{ ! \ verb of inference; 18dec2012 + seqverb @ t @ 1 - 7 psi{ ! \ retroactive seq? 20dec2012 + subjnom @ t @ 4 psi{ ! \ pre of verb; 18dec2012 + 8 t @ 5 psi{ ! \ pos=8 verb; 18dec2012 + t @ 1 + t @ 6 psi{ ! \ psi6=tqv; 20dec2012 + seqtqv @ 7 psi{ @ t @ 7 psi{ ! \ seq 18dec2012 + seqtqv @ 7 psi{ @ dobseq ! \ test; 22dec2012 + seqverb @ t @ 8 psi{ ! \ enx; 18dec2012 + seqverb @ t @ 0 en{ ! \ so verb can be found; 22dec2012 + 1 t +! \ increment t to store direct object; 18dec2012 + seqtqv @ 7 psi{ @ t @ 0 psi{ ! \ dir. obj 18dec2012 + 40 t @ 1 psi{ ! \ activation of direct object 22dec2012 + seqtqv @ 7 psi{ @ t @ 8 psi{ ! \ enx 18dec2012 + dobseq @ t @ 0 en{ ! \ so noun can be found; 22dec2012 + dobseq @ quobj ! \ for AskUser; 27dec2012 + 1 t +! \ increment time "t" for an ending gap; 18dec2012 + 1 yncon ! \ for AskUser to ask yes-or-no question 26dec2012 + subjnom @ qusub ! \ transfer to AskUser; 26dec2012 + THEN \ end of test for a verb to be part of inference 2jan2013 + 0 becon ! \ reset after use; 18dec2012 + 0 dobseq ! \ reset after use; 22dec2012 + 0 moot ! \ reset after use; 20dec2012 + 0 prednom ! \ reset after use; 18dec2012 + 0 seqtqv ! \ reset after use; 18dec2012 + 0 seqverb ! \ reset after use; 18dec2012 + 0 subjnom ! \ reset after use; 18dec2012 +\ QUIT \ test; remove; 18dec2012 +\ Task: Make InFerence work also with pronouns and antecedents; +\ Task: Make InFerence work with ideas negated by "NOT". +; ( http://code.google.com/p/mindforth/wiki/InFerence ) + + +: DeCog ( Deutsch Cognition -- thinking in DeKi German AI ) + CR ." Achtung! German input flips thinking into German." +( HauptWort \ Call a German NounPhrase module; 20jul2011 ) +( ZeitWort \ Call a German VerbPhrase module; 20jul2011 ) +; ( http://code.google.com/p/mindforth ) + + +: EnCog ( English Cognition -- thinking in English ) + 0 moot ! \ may have been set in previous thought; 24oct2011 + 0 morphpsi ! + 0 psi ! + 0 sublen ! + t @ tov ! + becon @ 1 = IF \ if flag set in OldCOncept; 18dec2012 + InFerence \ call the passively reflective module; 18dec2012 + THEN \ end of test for input of a be-verb statement; 18dec2012 + yncon @ 1 = IF \ if flag set in VerbPhrase; 2jul2011 + AskUser \ for a yes-or-no question; 2jul2011 + EXIT \ abandon rest of EnCog; 2jul2011 + THEN ( http://www.mpeforth.com ) + yesorno @ 0 > IF + SayYes + CR + EXIT + THEN + 400 rsvp ! \ Give user time to respond. 23aug2010 + inert @ 10 > IF \ if no input start thinking; 17oct2011 + cogpsi @ 0 > IF \ 17oct2011 + cogpsi @ topic ! \ for query-subject; 17oct2011 + cognum @ topicnum ! \ to select "IS" or "ARE"; 22oct2011 + fyi @ 2 = IF ." EnCog calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 cognum ! \ reset for safety; 22oct2011 + 0 cogpsi ! \ reset for safety; 17oct2011 + EXIT \ abandon the rest of EnCog; 17oct2011 + THEN \ 17oct2011 + kbtv @ 1 = IF \ in cycle of KbTraversal; 17oct2011 + 707 topic ! \ 707=YOU as topic of question; 10nov2012 + 7 nphrpos ! \ pronoun "YOU" part-of-speech; 21oct2011 + 2 prsn ! \ parameter second-person YOU; 17oct2011 + 1 subjnum ! \ singular YOU as a parameter; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhoBe" THEN \ 4jul2012 + CR WhoBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + IQ @ 3 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv1 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + THEN \ end of #1 test of rotating "kbtv"; 17oct2011 + kbtv @ 2 = IF \ in rotation of KbTraversal; 17oct2011 + 571 topic ! \ let 571=ROBOT be subject; 10nov2012 + 5 nphrpos ! \ noun part-of-speech; 17oct2011 + 3 prsn ! \ parameter needed for AuxVerb; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + 1 indefmust ! \ for "A ROBOT"; 20oct2011 + 1 subjnum ! \ for singular "ROBOT"; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 indefmust ! \ reset for safety; 20oct2011 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ borrowing IQ as a control; 17oct2011 + 1 subjnum ! \ for singular "ROBOT"; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv2 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 3 = IF \ borrowing IQ as a control; 17oct2011 + 2 subjnum ! \ for plural "ROBOTS"; 17oct2011 + fyi @ 2 = IF ." EnCog-kbtv2 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + THEN \ end of #2 test of rotating "kbtv"; 17oct2011 + kbtv @ 3 = IF \ in rotation of KbTraversal; 17oct2011 + 701 topic ! \ 701=I; 10nov2012 + 7 nphrpos ! \ pronoun "I" part-of-speech; 21oct2011 + 1 prsn ! \ parameter first-person I; 17oct2011 + 1 subjnum ! \ singular I as a parameter; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhoBe" THEN \ 4jul2012 + CR WhoBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv3 calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + IQ @ 3 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnCog-kbtv3 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + THEN \ end of #3 test of rotating "kbtv"; 17oct2011 + kbtv @ 4 = IF \ in rotation of KbTraversal; 17oct2011 + 533 topic ! \ 533=GOD for AI theology discussion; 10nov2012 + 3 prsn ! \ parameter third-person GOD; 17oct2011 + 1 subjnum ! \ singular GOD as a parameter; 17oct2011 + IQ @ 1 = IF \ borrowing IQ as a control; 17oct2011 + fyi @ 2 = IF ." EnCog calls WhoBe" THEN \ 4jul2012 + CR WhoBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 2 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of re-purposed IQ-test; 17oct2011 + IQ @ 2 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv4 calls WhatBe" THEN \ 6jul2012 + CR WhatBe \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 3 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + IQ @ 3 = IF \ to ask a different question; 17oct2011 + fyi @ 2 = IF ." EnC-kbtv4 calls WASD" THEN \ 6jul2012 + CR WhatAuxSDo \ Ascribe output only to robot; 26jul2012 + 0 inert ! \ reset to resume counting; 17oct2011 + 1 IQ ! \ to ask a different question; 17oct2011 + 1000 rsvp ! \ AI waits for an answer; 19oct2011 + EXIT \ only output one thought per cycle; 17oct2011 + THEN \ end of IQ-test; 17oct2011 + THEN \ end of #4 test of rotating "kbtv"; 17oct2011 + THEN \ end of arbitrary delay before initiating thought + ( exceptional think was above; normal thinking below here ) + CR ." Robot: " + 123 t @ 2 aud{ ! + t @ tov ! \ 12jan2010 "{" marks start of thought. + NounPhrase \ First of two Chomskyan bifurcations. + VerbPhrase \ Second of two Chomskyan bifurcations. + 0 nphrnum ! \ Reset intersyntactic variable; 11oct2011 + 0 pcn ! \ Reset for safety; 17jul2012 + 0 prednom ! \ reset for InFerence; 27dec2012 + 0 prox2 ! \ Reset after use; 7sep2011 + 0 prox3 ! \ Reset after use; 7sep2011 + 0 proxcon ! \ Reset after use; 7sep2011 + 0 putnum ! \ reset for safety; 4nov2011 + 0 quo ! \ 5jan2010 Reset after use. + 0 subjnom ! \ reset for InFerence; 27dec2012 + 5 bias ! + 0 qup ! \ 10jan2010 Must be at zero to be used again. + PsiDecay \ Reduce activation after each thought; 4aug2011 +; ( http://code.google.com/p/mindforth/wiki/EnCog ) + + +: ThInk ( calls EnCog to think in English; 20sep2010 ) + 0 ordo ! + 35 pov ! \ internal ASCII 35=# point-of-view; 16oct2011 + glot @ 1 = IF \ flag for polyglot AI; 20jul2011 + EnCog ( think in English; 20jul2011 ) + THEN ( http://www.aicore.co.uk ) + glot @ 2 = IF \ upon input of multiple German words; + DeCog ( think in Deutsch -- German; 20jul2011 ) + THEN \ end of test for language-choice in polyglot AI + fyi @ 1 = IF CR THEN + 0 ordo ! + rjc @ 1 < IF \ if AI on but not yet ReJuvenated; 19sep2010 + lurk @ greet @ > IF \ if limit exceeded; 19sep2010 + 100 rsvp ! \ slow down the display; 19sep2010 + -1 lurk ! \ reset for safety; 19sep2010 + kbtv @ 4 > IF 1 kbtv ! THEN \ test; 19sep2010 + 1 kbtv +! \ cycle through values; 19sep2010 + KbTraversal \ if no input, begin thinking; 19sep2010 + THEN ( http://www.forth.com ) + THEN \ end of test of ReJuvenation-count (rjc); 19sep2010 +; ( http://code.google.com/p/mindforth/wiki/ThInk ) + + +: MotorOutput ( stub for autonomous control of robots ) + 7 EMIT + ( MOVE_FORWARD ) + ( MOVE_BACKWARDS ) + ( STOP_MOTION ) + ( TURN_LEFT ) + ( TURN_RIGHT ) +; ( http://code.google.com/p/mindforth/wiki/MotorOutput ) + + +: TuringTest ( Human-Computer Interaction ) + fyi @ 0 = IF CLS CR CR CR CR CR CR CR + t @ 476 < IF CR \ "vault" after SEE and NOTHING; 22sep2011 + ." There is no warranty for MindForth AI for robots." + ELSE CR + THEN + THEN + fyi @ 1 = NOT IF CR THEN + ." " + fyi @ 1 = NOT IF CR THEN + fyi @ 0 = IF + CR + ." Artificial intelligence alive and thinking since " + bday @ . + bmonth @ 1 = IF ." January " THEN + bmonth @ 2 = IF ." February " THEN + bmonth @ 3 = IF ." March " THEN + bmonth @ 4 = IF ." April " THEN + bmonth @ 5 = IF ." May " THEN + bmonth @ 6 = IF ." June " THEN + bmonth @ 7 = IF ." July " THEN + bmonth @ 8 = IF ." August " THEN + bmonth @ 9 = IF ." September " THEN + bmonth @ 10 = IF ." October " THEN + bmonth @ 11 = IF ." November " THEN + bmonth @ 12 = IF ." December " THEN + byear @ . 8 EMIT 46 EMIT CR + THEN + fyi @ 1 = NOT IF + ." Time = " t @ . 8 EMIT 46 EMIT + ." KB-Traversal ID = " kbtv @ . + 8 EMIT 46 EMIT + ." IQ = " IQ @ . 8 EMIT 46 EMIT + ." Cyc = " rjc @ . ." delay = " rsvp @ . 8 EMIT 46 EMIT + CR ." ENTER a positive or negative Subj-Verb-Obj " + ." unpunctuated sentence." + CR + THEN + fyi @ 0 = IF CR + ." Display-mode is normal. Press Tab for other modes; " + ." ESC to exit." + CR + THEN + fyi @ 3 = IF CR + ." Diagnostic messages - ignore during input " + ." before pressing ENTER." + THEN + 42 pov ! +; ( http://code.google.com/p/mindforth/wiki/TuringTest ) + + +: SeCurity ( new wiki-page name for SECURITY module ) + fyi @ 2 = IF CR + ." SeCurity calls HCI TuringTest module." + THEN + TuringTest + t @ cns @ 64 - > IF + fyi @ 2 = IF CR + ." SeCurity module calls ReJuvenate." + THEN + ReJuvenate + THEN + t @ cns @ > IF \ Use midway only for larger Minds 13aug2012 + t @ cns @ - midway ! ( for limit on searches; 13aug2012 ) + ELSE \ If the CNS memory has a small capacity 13aug2012 + 1 midway ! \ Avoid any "array boundary problem"; 13aug2012 + THEN \ Future code may let an AI itself set midway 13aug2012 + 0 quiet ! +; ( http://code.google.com/p/mindforth/wiki/SeCurity ) + + +: MainLoop ( changed from ALIFE for wiki doc page ) + TIME&DATE byear ! bmonth ! bday ! bhour ! bminute ! bsec ! + TabulaRasa + EnBoot + BEGIN + SeCurity + fyi @ 2 = IF CR + ." MainLoop calls the SensoryInput module." CR + THEN + SensoryInput + ( EmotiOn ) + fyi @ 2 = IF CR CR \ create gap; 6jul2012 + ." MainLoop calls the ThInk mind-module." CR + THEN + ThInk + ( FreeWill ) + ( MotorOutput ) + AGAIN +; ( http://code.google.com/p/mindforth/wiki/MainLoop ) + + +: ALIFE ( Call MainLoop if not called by user. ) + MainLoop +; diff --git a/README.md b/README.md old mode 100644 new mode 100755 diff --git a/array.fs b/array.fs new file mode 100755 index 0000000..9264b8c --- /dev/null +++ b/array.fs @@ -0,0 +1,53 @@ +\ array.fs - Array of cells in Forth +\ 2013 David Meyer +JMJ + +\ Source: Leonard Morgenstern. Arrays in Forth. Len's Forth Tutorial. +\ c. 1996. +\ +\ accessed 2013-10-17. + +: array ( n -- ) ( i -- addr ) + create cells allot + does> swap cells + +; + +\ table - Array of n-cell records +: table ( n len -- ) ( i -- addr ) + create dup , * cells allot + does> dup @ swap * cells + \ rot instead of swap? +; + +\ Original source from web page ... +: unindexed-array ( n -- ) ( -- a) + create allot ; +80 unindexed-array u-foo \ Make an 80-byte unindexed array +u-foo \ Return the origin addr of u-foo + +: array ( n -- ) ( i -- addr) + create cells allot + does> cells + ; +100 array foo \ Make an array with 100 cells +3 foo \ Return address of fourth element + +: long-element-array ( n len -- ) ( i -- addr) + create dup , * cells allot + does> dup @ swap * cells + ; +10 5 long-element-array th-room \ Create array for 10 rooms +4 th-room \ Find address of room 4 + +variable current-offset +: offset ( n -- ) ( addr -- addr') + create current-offset @ , + does> @ cells + ; + +current-offset off \ Set variable to 0 + 1 offset }descriptor + 1 offset }north + 1 offset }east + 1 offset }south + 1 offset }west + +\ Examples: + 3 th-room }north @ \ Rm# The room north of room 3 + 4 th-room }descriptor @ execute + \ Print the description of room 4 diff --git a/blockimg.txt b/blockimg.txt new file mode 100755 index 0000000..6c04dfc --- /dev/null +++ b/blockimg.txt @@ -0,0 +1,16 @@ +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** +**************************************************************** diff --git a/caltech-forth.blink b/caltech-forth.blink new file mode 100755 index 0000000..f23cf36 --- /dev/null +++ b/caltech-forth.blink @@ -0,0 +1,4 @@ +Caltech Forth +http://pdp-10.trailing-edge.com/decuslib10-04/01/43,50361/forth.doc.html +Macro Assembler source (Tenex): +http://pdp-10.trailing-edge.com/decuslib10-04/01/43,50361/forth.mac.html diff --git a/cat.fs b/cat.fs new file mode 100755 index 0000000..61d1e3d --- /dev/null +++ b/cat.fs @@ -0,0 +1,35 @@ +\ cat.fs - String concatenation + +variable str + +: cat { a1 u1 a2 u2 -- a3 u1+u2 } + here str ! + u1 u2 + chars allot + u1 0 u+do + a1 i + @ + str i + ! + loop + u2 0 u+do + a2 i + @ + str u1 + i + ! + loop + str u1 u2 + +; + +: 3cat { a1 u1 a2 u2 a3 u3 -- a4 u1+u2+u3 } + here str ! + u1 u2 u3 + + chars allot + u1 0 u+do + a1 i + @ + str i + ! + loop + u2 0 u+do + a2 i + @ + str u1 i + + ! + loop + u3 0 u+do + a3 i + @ + str u1 u2 i + + + ! + loop + str u1 u2 u3 + + +; diff --git a/cgi-0.fs b/cgi-0.fs new file mode 100755 index 0000000..5ce6d7b --- /dev/null +++ b/cgi-0.fs @@ -0,0 +1,148 @@ +\ cgi.fs - Common Gateway Interface for Forth +\ +JMJ 2013 David Meyer + +\ URI length limits: +\ Standards impose no maximum URI length, but MSIE +\ through version 10 can only handle URIs of 2083 +\ characters or less (2048 characters is maximum +\ path length). +\ URI RFC recommends hostname part of URI not +\ exceed 255 characters. + +\ Maximum number of key/value pairs in URI query string +\ Max. characters: 2083 +\ Query string length: SUM( key-length-n + value-length-n + 2 ) - 1 +\ = n * ( key-length-avg + value-length-avg + 2 ) - 1 +\ Maximum number of keys achieved when key and values are minimum +\ length - 1 character. +\ 2083 = n * ( 1 + 1 + 2 ) - 1 +\ = n * 4 - 1 +\ 2084 = n * 4 +\ n = 521 <-- Maximum possible number of key/value pairs in query string + +variable decode-ptr +variable code-len +variable keystr-ptr +variable keystr-len +variable valstr-ptr +variable valstr-len + +\ Is character c a '%'? +: c%? ( c -- f ) [char] % = ; + +\ Return hexadecimal value (0-15) of character [0-9A-Fa-f] +\ Returns -1 for invalid character +: chex ( c -- n ) + dup [char] 0 [char] 9 1+ within if + [char] 0 - exit + then + dup [char] A [char] F 1+ within if + [char] A - 10 + exit + then + dup [char] a [char] f 1+ within if + [char] a - 10 + exit + then + drop -1 ( Invalid character error ) +; + +\ Compute value (0-255) of 2-character hexadecimal number +: hexval ( chigh clow -- 16*chigh+clow ) swap 16 * + ; + +\ Search string at c-addr1 for character c. If found, set f true and u2 to offset of 1st c in string. +: csearch ( c-addr1 u1 c -- u2 f ) + 0 2over ( c-addr1 u1 c ui c-addr1 u1 ) + +do ( c-addr1 u1 c ui c-addr1 ) + swap chars + c@ ( c-addr1 u1 c ci ) + i rot rot ( c-addr1 u1 ui+1 c ci ) + over = ( c-addr1 u1 ui+1 c fi ) + >r swap 2over drop r> ( c-addr1 u1 c ui+1 c-addr1 fi ) + \ Exit loop if current char. matches + if leave then ( c-addr1 u1 c ui+1 c-addr1 ) + loop + drop 1- rot over ( c-addr1 c u2 u1 u2 ) + - 1 > if ( c-addr1 c u2 ) + \ Found char. before end of string + true 2swap 2drop ( u2 true ) + else + \ Got to end of string + dup chars 2swap rot rot + c@ ( u2 c c2 ) + = if + \ End of string matches char. + true ( u2 true ) + else + \ No match + false ( u2 false ) + then + then +; + + +\ Decode percent-encoded string +: %decode ( c-code u-code -- c-decode u-decode ) + here decode-ptr ! + dup chars allot + code-len ! ( c-code ) + + 0 swap 0 ( decode-ofst c-code code-ofst ) + begin + dup 1+ code-len @ <= + while + rot >r ( c-code code-ofst ) + 2dup + c@ c%? if + 2dup 2dup + 1 chars + c@ chex + rot rot + 2 chars + c@ chex + 2dup 0>= swap 0>= and if + hexval decode-ptr @ r@ + c! + r> 1 chars + rot rot + else + 2drop + 2dup + decode-ptr @ r@ + 3 cmove + r> 3 chars + rot rot + then + 2 chars + + else + 2dup + c@ decode-ptr @ r@ + c! + r> 1 chars + rot rot +\ cr ." debug:" decode-ptr @ code-len @ dump + then + 1 chars + + repeat + 2drop decode-ptr @ swap +; + +\ Return value for CGI query string key. +\ Return 0 0 if key not found. +: qskeyval ( c-key u-key-len -- c-value u-value-len ) + dup + s" QUERY_STRING" getenv + dup if + rot over swap - 2 < if + \ Query string not long enough for key=value + 2drop 2drop 0 0 + else + \ search for key string in query + 2swap + ( c-querystr u-querystr-len c-key u-key-len ) + \ Set key search string + here keystr-ptr ! + dup 2 + dup keystr-len ! + chars dup allot + [char] = swap keystr-ptr @ + ! + [char] & keystr-ptr ! + keystr-ptr @ 1 chars + swap cmove + ( c-querystr u-querystr-len ) + \ Check for key at beginning of query string + 2dup keystr-ptr @ 1 chars + keystr-len @ 1- + string-prefix? if + \ Extract 1st value string + here valstr-ptr ! + + else + \ Search query string for full key + then + then + else + \ QUERY_STRING not defined + 2swap 2drop rot drop + then +; \ No newline at end of file diff --git a/cgi.fs b/cgi.fs new file mode 100755 index 0000000..9e4405d --- /dev/null +++ b/cgi.fs @@ -0,0 +1,169 @@ +\ cgi.fs - Common Gateway Interface for Forth +\ +JMJ 2013 David Meyer + +\ URI length limits: +\ Standards impose no maximum URI length, but MSIE +\ through version 10 can only handle URIs of 2083 +\ characters or less (2048 characters is maximum +\ path length). +\ URI RFC recommends hostname part of URI not +\ exceed 255 characters. + +\ Maximum number of key/value pairs in URI query string +\ Max. characters: 2083 +\ Query string length: SUM( key-length-n + value-length-n + 2 ) - 1 +\ = n * ( key-length-avg + value-length-avg + 2 ) - 1 +\ Maximum number of keys achieved when key and values are minimum +\ length - 1 character. +\ 2083 = n * ( 1 + 1 + 2 ) - 1 +\ = n * 4 - 1 +\ 2084 = n * 4 +\ n = 521 <-- Maximum possible number of key/value pairs in query string + +require array.fs + +variable CGIQUERYSTR \ QUERY_STRING address +variable CGIQUERYLEN \ QUERY_STRING length + +521 4 table CGIFIELD + +variable decode-ptr +variable code-len +variable keystr-ptr +variable keystr-len +variable valstr-ptr +variable valstr-len + +\ Is character c a '%'? +: c%? ( c -- f ) [char] % = ; + +\ Return hexadecimal value (0-15) of character [0-9A-Fa-f] +\ Returns -1 for invalid character +: chex ( c -- n ) + dup [char] 0 [char] 9 1+ within if + [char] 0 - exit + then + dup [char] A [char] F 1+ within if + [char] A - 10 + exit + then + dup [char] a [char] f 1+ within if + [char] a - 10 + exit + then + drop -1 ( Invalid character error ) +; + +\ Compute value (0-255) of 2-character hexadecimal number +: hexval ( chigh clow -- 16*chigh+clow ) swap 16 * + ; + +\ Search string at c-addr1 for character c. If found, set f true and u2 to offset of 1st c in string. +: csearch ( c-addr1 u1 c -- u2 f ) + 0 2over ( c-addr1 u1 c ui c-addr1 u1 ) + +do ( c-addr1 u1 c ui c-addr1 ) + swap chars + c@ ( c-addr1 u1 c ci ) + i rot rot ( c-addr1 u1 ui+1 c ci ) + over = ( c-addr1 u1 ui+1 c fi ) + >r swap 2over drop r> ( c-addr1 u1 c ui+1 c-addr1 fi ) + \ Exit loop if current char. matches + if leave then ( c-addr1 u1 c ui+1 c-addr1 ) + loop + drop 1- rot over ( c-addr1 c u2 u1 u2 ) + - 1 > if ( c-addr1 c u2 ) + \ Found char. before end of string + true 2swap 2drop ( u2 true ) + else + \ Got to end of string + dup chars 2swap rot rot + c@ ( u2 c c2 ) + = if + \ End of string matches char. + true ( u2 true ) + else + \ No match + false ( u2 false ) + then + then +; + + +\ Decode percent-encoded string +: %decode ( c-code u-code -- c-decode u-decode ) + here decode-ptr ! + dup chars allot + code-len ! ( c-code ) + + 0 swap 0 ( decode-ofst c-code code-ofst ) + begin + dup 1+ code-len @ <= + while + rot >r ( c-code code-ofst ) + 2dup + c@ c%? if + 2dup 2dup + 1 chars + c@ chex + rot rot + 2 chars + c@ chex + 2dup 0>= swap 0>= and if + hexval decode-ptr @ r@ + c! + r> 1 chars + rot rot + else + 2drop + 2dup + decode-ptr @ r@ + 3 cmove + r> 3 chars + rot rot + then + 2 chars + + else + 2dup + c@ decode-ptr @ r@ + c! + r> 1 chars + rot rot +\ cr ." debug:" decode-ptr @ code-len @ dump + then + 1 chars + + repeat + 2drop decode-ptr @ swap +; + +\ Return value for CGI query string key. +\ Return 0 0 if key not found. +: qskeyval ( c-key u-key-len -- c-value u-value-len ) + dup + s" QUERY_STRING" getenv + dup if + rot over swap - 2 < if + \ Query string not long enough for key=value + 2drop 2drop 0 0 + else + \ search for key string in query + 2swap + ( c-querystr u-querystr-len c-key u-key-len ) + \ Set key search string + here keystr-ptr ! + dup 2 + dup keystr-len ! + chars dup allot + [char] = swap keystr-ptr @ + ! + [char] & keystr-ptr ! + keystr-ptr @ 1 chars + swap cmove + ( c-querystr u-querystr-len ) + \ Check for key at beginning of query string + 2dup keystr-ptr @ 1 chars + keystr-len @ 1- + string-prefix? if + \ Extract 1st value string + here valstr-ptr ! + + else + \ Search query string for full key + then + then + else + \ QUERY_STRING not defined + 2swap 2drop rot drop + then +; + +\ 2013/10/21 New start: Following may be useful even if above +\ is discarded ... + +create cgiKey 521 allot +create cgiKeyLen 521 allot +create cgiValue 521 allot +create cgiValueLen 521 allot +-1 variable cgiLastField + +: cgiParseQuery { a-query u -- } + 2dup [char] & scan + +; diff --git a/cgitest.cgi_ b/cgitest.cgi_ new file mode 100755 index 0000000..e533c67 --- /dev/null +++ b/cgitest.cgi_ @@ -0,0 +1,33 @@ +#! /usr/pkg/bin/gforth-fast +\ forthtest.cgi - Test driver for html5cgi.fs + +include html5cgi.fs + +: main ( -- ) + 0 + s" Document Title" $alloc *title* *head* + + 0 + s" Level 1 Heading" $alloc *h1* + + s" Level 2 Heading" $alloc *h2* + + s" Level 3 Heading" $alloc *h3* + + s" Level 4 Heading" $alloc *h4* + + s" Level 5 Heading" $alloc *h5* + + s" Level 6 Heading" $alloc *h6* + + *body* *html* *http-html5* +; + +main +c$type + +\ bye + + + + diff --git a/chronograph.fs b/chronograph.fs new file mode 100755 index 0000000..fe1d771 --- /dev/null +++ b/chronograph.fs @@ -0,0 +1,33 @@ +\ chronograph.fs +\ Date and time conversion and arithmetic + +What I want: + +Enter: s" 2005-09-16 18:30:55" jst +Returns: corresponding Unix time (s?, ms?, double?, float?) + +Enter: -> mdt +Displays: ISO time string corr. to TOS Unix time in given zone + +Enter: s" 06:40:00" today +Returns: Unix time for given time on current date local zone + +Enter: now +Returns: current Unix time +(if time kept in ms, use utime instead) + + +Leap year (Gregorian calendar): years divisible by 4 but not by 100 plus years divisible by 400 +: leapyear? ( u -- f ) + dup 4 mod + if drop false + else dup 100 mod + if drop true + else 400 mod + if false + else true + then + then + then ; + + diff --git a/cora-help.txt b/cora-help.txt new file mode 100755 index 0000000..141ea59 --- /dev/null +++ b/cora-help.txt @@ -0,0 +1,85 @@ +Coraphyco - COnversion RAtios and PHYsical COnstnts in Forth + +Words and constants for converting amounts between measurement +units. + +GLOSSARY + +-> r1 r2 r3 -- cora `convert' + + Convert quantity r1 of units r2 to units r3 and display results. + r1 must be floating-point type (append `e' to decimal + representation). r2 and r3 are the base unit conversion factors + for r1 units and target units, respectively. Constants hve been + defined for a wide variety of units (See `help-const'). + +->E r1 r2 r3 -- cora `convert-E' + + Convert quantity r1 of units r2 to units r3 and display results + in engineering notation. See `->'. + +MKS r1 r2 -- cora `M-K-S' + + Convert quantity r1 of units r2 to units r2 base units (m, kg, + ms, ...) and display results. + +C>F r -- cora `C-to-F' + + Convert Celcius temperature to Fahrenheit and display result. + +F>C r -- cora `F-to-C' + + Convert Fahrenheit temperature to Celcius and display result. + +HELP -- cora `help' + + Display this help text. + +CONSTANTS + +Linear measure (length/distance) (Standard unit: M)) + + M meter FT foot NMI nautical mile + KM kilometer IN inch AU astronomical unit + CM centimeter YD yard LY light year + MM millimeter MI mile PC parsec + +Mass (standard unit: KG) + + KG kilogram MT tonne/metric ton T ton + G gram LB pound OZ ounce + +Time (standard unit: MS) + + MS millisecond HR hour WK week + S second DAY YR year + MINUTE + +Angle (standard unit: radian (dimensionless)) + + CIRCLE AMIN arc minute ASEC arc second + DEG degree + +Area (standard unit: M^2) + + M^2 square meter ACRE HECTARE + FT^2 square feet ARE + +Volume (standard unit: M^3) + + M^3 cubic meter PT pint TBSP tablespoon + CC cubic centimeter FLOZ fluid ounce TSP teaspoon + IN^3 cubic inch BBL petroleum barrel L liter + GAL gallon CUP ML milliliter + QT quart + +Speed (standard unit: M/S) + + M/S meters per second MACH speed of sound (STP) + C light in vacuum + +Acceleration (standard unit: M/S^2) + + M/S^2 meters per second per second + GEE standard gravitational acceleration + diff --git a/cora.fs b/cora.fs new file mode 100755 index 0000000..7dc0e1a --- /dev/null +++ b/cora.fs @@ -0,0 +1,138 @@ +\ cora.fs -- Coraphyco COnversion RAtios and PHYsical COnstants in Forth +\ Version 1.1 +\ 2010/7/13 David Meyer + +\ Coraphyco provides a Forth environment to facilitate conversion of +\ quantities among a large variety of measurement units and systems. +\ Inspired by Frink by Allan Eliasen. +\ This version is a simple implementation providing Forth constants +\ for conversion and physical quantities and a few words to simplify +\ display and conversion. + +\ Display quantity r1 of units r2 in standard unit amount +: mks ( r1 r2 -- ) F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +: -> ( r1 r2 r3 -- ) F/ F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +\ in engineering notation +: ->e ( r1 r2 r3 -- ) F/ F* FE. ; + +\ Convert Celcius temperature to Fahrenheit +: c>f ( r -- ) 9e0 f* 5e0 f/ 32e0 f+ f. ; + +\ Convert Fahrenheit temperature to Celcius +: f>c ( r -- ) 32e0 f- 5e0 f* 9e0 f/ f. ; + +\ Online help +: help ( -- ) +( Eventually print/page help file ... + s" /usr/mnt.rom/card/Documents/Cavenet_Files/green/forth/cora-help.txt" r/o open-file throw Value fd-in + begin + line-buffer max-line fd-in read-line throw + while + type + repeat ; +) + cr ." (See file cora-help.txt for help.)" + cr ; + +\ Speed (standard unit: m/s (meters per second) + +1e0 FCONSTANT m/s \ meters per second (standard) + +331.46e0 FCONSTANT mach \ speed of sound in dry air at STP + +299792458e0 FCONSTANT c \ light in vacuum + +\ Acceleration (standard unit: m/s^2 (meters per second per second) + +1e0 FCONSTANT m/s^2 \ meters per second per second (standard) + +980665e-5 FCONSTANT gee \ standard gravitational acceleration + +\ Time (standard unit: s (second)) + +1e0 FCONSTANT s \ second (standard) +60e0 60e0 F* FCONSTANT hr \ hour +24e0 hr F* FCONSTANT day \ day + +\ Use ms as standard time unit to match Forth - +\ Replace s, hr, day above with following: +\ Also switch from float to double} +1e FCONSTANT ms \ millisecond (standard) +1e3 FCONSTANT s \ second +60e s F* FCONSTANT minute \ minute +60e minute F* FCONSTANT hr \ hour +24e hr F* FCONSTANT day \ day +7e day F* FCONSTANT wk \ week +365.25e day F* FCONSTANT yr \ year (average) +: monthms ( uyear umonth -- r ) + dup 2 = + ; + +\ Angular measure (standard unit: radian (dimensionless)) + +2e0 pi F* FCONSTANT circle +circle 360e0 F/ FCONSTANT deg \ degree +deg 60e0 F/ FCONSTANT amin \ arc minute +amin 60e0 F/ FCONSTANT asec \ arc second + +\ Linear measure (standard unit: m (meter)) + +1e0 FCONSTANT m \ meter (standard) +1e3 FCONSTANT km \ kilometer +1e-2 FCONSTANT cm \ centimeter +1e-3 FCONSTANT mm \ millimeter + +3048e-4 FCONSTANT ft \ foot +ft 12e0 F/ FCONSTANT in \ inch +3e0 ft F* FCONSTANT yd \ yard +5280e0 ft F* FCONSTANT mi \ mile +1852e0 FCONSTANT nmi \ nautical mile + +149597870691e0 FCONSTANT au \ astronomical unit +365.25e0 day F* c F* FCONSTANT ly \ light year +au asec F/ FCONSTANT pc \ parsec + +\ Area (standard unit: m^2 (square meter)) + +1e0 FCONSTANT m^2 \ square meter (standard) +ft ft F* FCONSTANT ft^2 \ square feet +43560e0 ft^2 F* FCONSTANT acre \ acre +1e2 FCONSTANT are \ are +1e4 FCONSTANT hectare \ hectare + +\ Volume (standard unit: m^3 (cubic meter)) + +1e0 FCONSTANT m^3 \ cubic meter (standard) +1e-6 FCONSTANT cc \ cubic centimeter +in in in F* F* FCONSTANT in^3 \ cubic inch +231e0 in^3 F* FCONSTANT gal \ gallon +gal 4e0 F/ FCONSTANT qt \ quart +qt 2e0 F/ FCONSTANT pt \ pint +pt 16e0 F/ FCONSTANT floz \ fluid ounce +42e0 gal F* FCONSTANT bbl \ petroleum barrel +8e0 floz F* FCONSTANT cup \ cup +cup 16e0 F/ FCONSTANT tbsp \ tablespoon +tbsp 3e0 F/ FCONSTANT tsp \ teaspoon +1e3 cc F* FCONSTANT l \ liter +cc FCONSTANT ml \ milliliter + +\ Mass (standard unit: kg (kilogram)) + +1e0 FCONSTANT kg \ kilogram (standard) +1e-3 FCONSTANT g \ gram +1e3 FCONSTANT mt \ tonne, metric ton + +45359237e-8 FCONSTANT lb \ pound +2e3 lb F* FCONSTANT t \ ton +lb 16e0 F/ FCONSTANT oz \ ounce + +\ Print opening greeting +cr ." *********************************************************************" +cr ." *** Welcome to Coraphyco. Type `help' for help ***" +cr ." *********************************************************************" cr + + diff --git a/cora_0.fs b/cora_0.fs new file mode 100755 index 0000000..5f30a43 --- /dev/null +++ b/cora_0.fs @@ -0,0 +1,103 @@ +\ cora.fs -- Cora Phyco package of conversion ratios and physical constants +\ Version 0 +\ 2005/9/9 David Meyer + +\ Cora Phyco provides a Forth environment to facilitate conversion of +\ quantities among a large variety of measurement units and systems. +\ Inspired by Frink by Allan Eliasen. +\ This version is a simple implementation providing Forth constants +\ for conversion and physical quantities and a few words to simplify +\ display and conversion. + +.( Loading Cora Phyco version 0 ... ) + +\ Display quantity r1 of units r2 in standard unit amount +: mks ( r1 r2 -- ) F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +: -> ( r1 r2 r3 -- ) F/ F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +\ in engineering notation +: ->e ( r1 r2 r3 -- ) F/ F* FE. ; + +\ Speed (standard unit: m/s (meters per second) + +1e0 FCONSTANT m/s \ meters per second (standard) + +331.46e0 FCONSTANT mach \ speed of sound in dry air at STP + +299792458e0 FCONSTANT c \ light in vacuum + +\ Acceleration (standard unit: m/s^2 (meters per second per second) + +1e0 FCONSTANT m/s^2 \ meters per second per second (standard) + +980665e-5 FCONSTANT gee \ standard gravitational acceleration + +\ Time (standard unit: s (second)) + +1e0 FCONSTANT s \ second (standard) +60e0 60e0 F* FCONSTANT hr \ hour +24e0 hr F* FCONSTANT day \ day + +\ Angular measure (standard unit: radian (dimensionless)) + +2e0 pi F* FCONSTANT circle +circle 360e0 F/ FCONSTANT deg \ degree +deg 60e0 F/ FCONSTANT amin \ arc minute +amin 60e0 F/ FCONSTANT asec \ arc second + +\ Linear measure (standard unit: m (meter)) + +1e0 FCONSTANT m \ meter (standard) +1e3 FCONSTANT km \ kilometer +1e-2 FCONSTANT cm \ centimeter +1e-3 FCONSTANT mm \ millimeter + +3048e-4 FCONSTANT ft \ foot +ft 12e0 F/ FCONSTANT in \ inch +3e0 ft F* FCONSTANT yd \ yard +5280e0 ft F* FCONSTANT mi \ mile +1852e0 FCONSTANT nmi \ nautical mile + +149597870691e0 FCONSTANT au \ astronomical unit +365.25e0 day F* c F* FCONSTANT ly \ light year +au asec F/ FCONSTANT pc \ parsec + +\ Area (standard unit: m^2 (square meter)) + +1e0 FCONSTANT m^2 \ square meter (standard) +ft ft F* FCONSTANT ft^2 \ square feet +43560e0 ft^2 F* FCONSTANT acre \ acre +1e2 FCONSTANT are \ are +1e4 FCONSTANT hectare \ hectare + +\ Volume (standard unit: m^3 (cubic meter)) + +1e0 FCONSTANT m^3 \ cubic meter (standard) +1e-6 FCONSTANT cc \ cubic centimeter +in in in F* F* FCONSTANT in^3 \ cubic inch +231e0 in^3 F* FCONSTANT gal \ gallon +gal 4e0 F/ FCONSTANT qt \ quart +qt 2e0 F/ FCONSTANT pt \ pint +pt 16e0 F/ FCONSTANT floz \ fluid ounce +42e0 gal F* FCONSTANT bbl \ petroleum barrel +8e0 floz F* FCONSTANT cup \ cup +cup 16e0 F/ FCONSTANT tbsp \ tablespoon +tbsp 3e0 F/ FCONSTANT tsp \ teaspoon +1e3 cc F* FCONSTANT l \ liter +cc FCONSTANT ml \ milliliter + +\ Mass (standard unit: kg (kilogram)) + +1e0 FCONSTANT kg \ kilogram (standard) +1e-3 FCONSTANT g \ gram +1e3 FCONSTANT mt \ tonne, metric ton + +45359237e-8 FCONSTANT lb \ pound +2e3 lb F* FCONSTANT t \ ton +lb 16e0 F/ FCONSTANT oz \ ounce + +.( done) cr + diff --git a/cora_1.fs b/cora_1.fs new file mode 100755 index 0000000..829f11e --- /dev/null +++ b/cora_1.fs @@ -0,0 +1,137 @@ +\ cora.fs -- Cora Phyco package of conversion ratios and physical constants +\ Version 1 +\ 2005/9/9 David Meyer + +\ Cora Phyco provides a Forth environment to facilitate conversion of +\ quantities among a large variety of measurement units and systems. +\ Inspired by Frink by Allan Eliasen. +\ This version creates a word for each measurement unit that both holds the +\ unit's conversion factor and converts the quantity at TOS. Physical constants +\ are represented as Forth constants. + +.( Loading Cora Phyco version 1 ...) + +\ Pending unit conversion flag +VARIABLE FALSE ! + +\ Pending display engineering notation flag +VARIABLE FALSE ! + +\ Store unit conversion factor r as float. On reference convert r1 quantity to +\ r2 standard units or display r1 quantity converted to target units. +: unit ( r "name" -- ) + CREATE F, +DOES> ( r1 -- r2| ) + @ + IF F@ F/ @ IF FE. FALSE ! ELSE F. THEN FALSE ! + ELSE F@ F* THEN ; + +\ Set conversion flag +: -> ( -- ) TRUE ! ; + +\ Set conversion and engineering notation flags +: ->e ( -- ) TRUE DUP ! ! ; + + +\ Physical constants (standard units) + +2e0 pi F* FCONSTANT circle \ radians per full circle angle +299792458e0 FCONSTANT c \ speed of light in vacuum (m/s) + +\ Speed (standard unit: m/s (meters per second) + +1e0 unit m/s \ meters per second (standard) + +331.46e0 unit mach \ speed of sound in dry air at STP + +\ Acceleration (standard unit: m/s^2 (meters per second per second) + +1e0 unit m/s^2 \ meters per second per second (standard) + +980665e-5 unit gee \ standard gravitational acceleration + +\ Time (standard unit: s (second)) + +1e0 unit s \ second (standard) +60e0 60e0 F* unit hr \ hour +24e0 hr unit day \ day + +\ Angular measure (standard unit: radian (dimensionless)) + +circle 360e0 F/ unit deg \ degree +1e0 deg 60e0 F/ unit amin \ arc minute +1e0 amin 60e0 F/ unit asec \ arc second + +\ Linear measure (standard unit: m (meter)) + +1e0 unit m \ meter (standard) +1e3 unit km \ kilometer +1e-2 unit cm \ centimeter +1e-3 unit mm \ millimeter + +3048e-4 unit ft \ foot +1e0 ft 12e0 F/ unit in \ inch +3e0 ft unit yd \ yard +5280e0 ft unit mi \ mile +1852e0 unit nmi \ nautical mile + +149597870691e0 unit au \ astronomical unit +365.25e0 day c F* unit ly \ light year +1e0 au 1e0 asec F/ unit pc \ parsec + +\ Area (standard unit: m^2 (square meter)) + +1e0 unit m^2 \ square meter (standard) +1e0 ft 2e0 F** unit ft^2 \ square feet +43560e0 ft^2 unit acre \ acre +1e2 unit are \ are +1e4 unit hectare \ hectare + +\ Volume (standard unit: m^3 (cubic meter)) + +1e0 unit m^3 \ cubic meter (standard) +1e-6 unit cc \ cubic centimeter +1e0 in 3e0 F** unit in^3 \ cubic inch +231e0 in^3 unit gal \ gallon +1e0 gal 4e0 F/ unit qt \ quart +1e0 qt 2e0 F/ unit pt \ pint +1e0 pt 16e0 F/ unit floz \ fluid ounce +42e0 gal unit bbl \ petroleum barrel +8e0 floz unit cup \ cup +1e0 cup 16e0 F/ unit tbsp \ tablespoon +1e0 tbsp 3e0 F/ unit tsp \ teaspoon +1e3 cc unit l \ liter +1e0 cc unit ml \ milliliter + +\ Mass (standard unit: kg (kilogram)) + +1e0 unit kg \ kilogram (standard) +1e-3 unit g \ gram +1e3 unit mt \ tonne, metric ton + +45359237e-8 unit lb \ pound +2e3 lb unit t \ ton +1e0 lb 16e0 F/ unit oz \ ounce + +\ Temperature (standard system: Kelvin) + +1e0 unit kel \ Kelvin (standard) + +5e0 9e0 f/ FCONSTANT degfah \ Fahrenheit degree +255.372e0 FCONSTANT 0fah \ 0 degrees Fahrenheit + +273.15e0 FCONSTANT 0cel \ 0 degrees Celsius + +: fah ( r1 -- r2| ) + @ + IF 0fah F- degfah F/ F. FALSE ! + ELSE degfah F* 0fah F+ THEN ; + +: cel ( r1 -- r2| ) + @ + IF 0cel F- F. FALSE ! + ELSE 0cel F+ THEN ; + + +.( done) cr + diff --git a/cora_2.fs b/cora_2.fs new file mode 100755 index 0000000..1e5d427 --- /dev/null +++ b/cora_2.fs @@ -0,0 +1,114 @@ +\ cora.fs -- Cora Phyco package of conversion ratios and physical constants +\ Version 1.0 +\ 2005/9/9 David Meyer + +\ Cora Phyco provides a Forth environment to facilitate conversion of +\ quantities among a large variety of measurement units and systems. +\ Inspired by Frink by Allan Eliasen. +\ This version is a simple implementation providing Forth constants +\ for conversion and physical quantities and a few words to simplify +\ display and conversion. + +\ Display quantity r1 of units r2 in standard unit amount +: mks ( r1 r2 -- ) F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +: -> ( r1 r2 r3 -- ) F/ F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +\ in engineering notation +: ->e ( r1 r2 r3 -- ) F/ F* FE. ; + +\ Speed (standard unit: m/s (meters per second) + +1e0 FCONSTANT m/s \ meters per second (standard) + +331.46e0 FCONSTANT mach \ speed of sound in dry air at STP + +299792458e0 FCONSTANT c \ light in vacuum + +\ Acceleration (standard unit: m/s^2 (meters per second per second) + +1e0 FCONSTANT m/s^2 \ meters per second per second (standard) + +980665e-5 FCONSTANT gee \ standard gravitational acceleration + +\ Time (standard unit: s (second)) + +1e0 FCONSTANT s \ second (standard) +60e0 60e0 F* FCONSTANT hr \ hour +24e0 hr F* FCONSTANT day \ day + +\ Use ms as standard time unit to match Forth - +\ Replace s, hr, day above with following: +\ Also switch from float to double} +1e FCONSTANT ms \ millisecond (standard) +1e3 FCONSTANT s \ second +60e s F* FCONSTANT minute \ minute +60e minute F* FCONSTANT hr \ hour +24e hr F* FCONSTANT day \ day +7e day F* FCONSTANT wk \ week +: monthms ( uyear umonth -- r ) + dup 2 = + ; + +\ Angular measure (standard unit: radian (dimensionless)) + +2e0 pi F* FCONSTANT circle +circle 360e0 F/ FCONSTANT deg \ degree +deg 60e0 F/ FCONSTANT amin \ arc minute +amin 60e0 F/ FCONSTANT asec \ arc second + +\ Linear measure (standard unit: m (meter)) + +1e0 FCONSTANT m \ meter (standard) +1e3 FCONSTANT km \ kilometer +1e-2 FCONSTANT cm \ centimeter +1e-3 FCONSTANT mm \ millimeter + +3048e-4 FCONSTANT ft \ foot +ft 12e0 F/ FCONSTANT in \ inch +3e0 ft F* FCONSTANT yd \ yard +5280e0 ft F* FCONSTANT mi \ mile +1852e0 FCONSTANT nmi \ nautical mile + +149597870691e0 FCONSTANT au \ astronomical unit +365.25e0 day F* c F* FCONSTANT ly \ light year +au asec F/ FCONSTANT pc \ parsec + +\ Area (standard unit: m^2 (square meter)) + +1e0 FCONSTANT m^2 \ square meter (standard) +ft ft F* FCONSTANT ft^2 \ square feet +43560e0 ft^2 F* FCONSTANT acre \ acre +1e2 FCONSTANT are \ are +1e4 FCONSTANT hectare \ hectare + +\ Volume (standard unit: m^3 (cubic meter)) + +1e0 FCONSTANT m^3 \ cubic meter (standard) +1e-6 FCONSTANT cc \ cubic centimeter +in in in F* F* FCONSTANT in^3 \ cubic inch +231e0 in^3 F* FCONSTANT gal \ gallon +gal 4e0 F/ FCONSTANT qt \ quart +qt 2e0 F/ FCONSTANT pt \ pint +pt 16e0 F/ FCONSTANT floz \ fluid ounce +42e0 gal F* FCONSTANT bbl \ petroleum barrel +8e0 floz F* FCONSTANT cup \ cup +cup 16e0 F/ FCONSTANT tbsp \ tablespoon +tbsp 3e0 F/ FCONSTANT tsp \ teaspoon +1e3 cc F* FCONSTANT l \ liter +cc FCONSTANT ml \ milliliter + +\ Mass (standard unit: kg (kilogram)) + +1e0 FCONSTANT kg \ kilogram (standard) +1e-3 FCONSTANT g \ gram +1e3 FCONSTANT mt \ tonne, metric ton + +45359237e-8 FCONSTANT lb \ pound +2e3 lb F* FCONSTANT t \ ton +lb 16e0 F/ FCONSTANT oz \ ounce + + + diff --git a/cora_3.fs b/cora_3.fs new file mode 100755 index 0000000..7dc0e1a --- /dev/null +++ b/cora_3.fs @@ -0,0 +1,138 @@ +\ cora.fs -- Coraphyco COnversion RAtios and PHYsical COnstants in Forth +\ Version 1.1 +\ 2010/7/13 David Meyer + +\ Coraphyco provides a Forth environment to facilitate conversion of +\ quantities among a large variety of measurement units and systems. +\ Inspired by Frink by Allan Eliasen. +\ This version is a simple implementation providing Forth constants +\ for conversion and physical quantities and a few words to simplify +\ display and conversion. + +\ Display quantity r1 of units r2 in standard unit amount +: mks ( r1 r2 -- ) F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +: -> ( r1 r2 r3 -- ) F/ F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +\ in engineering notation +: ->e ( r1 r2 r3 -- ) F/ F* FE. ; + +\ Convert Celcius temperature to Fahrenheit +: c>f ( r -- ) 9e0 f* 5e0 f/ 32e0 f+ f. ; + +\ Convert Fahrenheit temperature to Celcius +: f>c ( r -- ) 32e0 f- 5e0 f* 9e0 f/ f. ; + +\ Online help +: help ( -- ) +( Eventually print/page help file ... + s" /usr/mnt.rom/card/Documents/Cavenet_Files/green/forth/cora-help.txt" r/o open-file throw Value fd-in + begin + line-buffer max-line fd-in read-line throw + while + type + repeat ; +) + cr ." (See file cora-help.txt for help.)" + cr ; + +\ Speed (standard unit: m/s (meters per second) + +1e0 FCONSTANT m/s \ meters per second (standard) + +331.46e0 FCONSTANT mach \ speed of sound in dry air at STP + +299792458e0 FCONSTANT c \ light in vacuum + +\ Acceleration (standard unit: m/s^2 (meters per second per second) + +1e0 FCONSTANT m/s^2 \ meters per second per second (standard) + +980665e-5 FCONSTANT gee \ standard gravitational acceleration + +\ Time (standard unit: s (second)) + +1e0 FCONSTANT s \ second (standard) +60e0 60e0 F* FCONSTANT hr \ hour +24e0 hr F* FCONSTANT day \ day + +\ Use ms as standard time unit to match Forth - +\ Replace s, hr, day above with following: +\ Also switch from float to double} +1e FCONSTANT ms \ millisecond (standard) +1e3 FCONSTANT s \ second +60e s F* FCONSTANT minute \ minute +60e minute F* FCONSTANT hr \ hour +24e hr F* FCONSTANT day \ day +7e day F* FCONSTANT wk \ week +365.25e day F* FCONSTANT yr \ year (average) +: monthms ( uyear umonth -- r ) + dup 2 = + ; + +\ Angular measure (standard unit: radian (dimensionless)) + +2e0 pi F* FCONSTANT circle +circle 360e0 F/ FCONSTANT deg \ degree +deg 60e0 F/ FCONSTANT amin \ arc minute +amin 60e0 F/ FCONSTANT asec \ arc second + +\ Linear measure (standard unit: m (meter)) + +1e0 FCONSTANT m \ meter (standard) +1e3 FCONSTANT km \ kilometer +1e-2 FCONSTANT cm \ centimeter +1e-3 FCONSTANT mm \ millimeter + +3048e-4 FCONSTANT ft \ foot +ft 12e0 F/ FCONSTANT in \ inch +3e0 ft F* FCONSTANT yd \ yard +5280e0 ft F* FCONSTANT mi \ mile +1852e0 FCONSTANT nmi \ nautical mile + +149597870691e0 FCONSTANT au \ astronomical unit +365.25e0 day F* c F* FCONSTANT ly \ light year +au asec F/ FCONSTANT pc \ parsec + +\ Area (standard unit: m^2 (square meter)) + +1e0 FCONSTANT m^2 \ square meter (standard) +ft ft F* FCONSTANT ft^2 \ square feet +43560e0 ft^2 F* FCONSTANT acre \ acre +1e2 FCONSTANT are \ are +1e4 FCONSTANT hectare \ hectare + +\ Volume (standard unit: m^3 (cubic meter)) + +1e0 FCONSTANT m^3 \ cubic meter (standard) +1e-6 FCONSTANT cc \ cubic centimeter +in in in F* F* FCONSTANT in^3 \ cubic inch +231e0 in^3 F* FCONSTANT gal \ gallon +gal 4e0 F/ FCONSTANT qt \ quart +qt 2e0 F/ FCONSTANT pt \ pint +pt 16e0 F/ FCONSTANT floz \ fluid ounce +42e0 gal F* FCONSTANT bbl \ petroleum barrel +8e0 floz F* FCONSTANT cup \ cup +cup 16e0 F/ FCONSTANT tbsp \ tablespoon +tbsp 3e0 F/ FCONSTANT tsp \ teaspoon +1e3 cc F* FCONSTANT l \ liter +cc FCONSTANT ml \ milliliter + +\ Mass (standard unit: kg (kilogram)) + +1e0 FCONSTANT kg \ kilogram (standard) +1e-3 FCONSTANT g \ gram +1e3 FCONSTANT mt \ tonne, metric ton + +45359237e-8 FCONSTANT lb \ pound +2e3 lb F* FCONSTANT t \ ton +lb 16e0 F/ FCONSTANT oz \ ounce + +\ Print opening greeting +cr ." *********************************************************************" +cr ." *** Welcome to Coraphyco. Type `help' for help ***" +cr ." *********************************************************************" cr + + diff --git a/cora_4.0.fs b/cora_4.0.fs new file mode 100755 index 0000000..5543f6a --- /dev/null +++ b/cora_4.0.fs @@ -0,0 +1,276 @@ +\ cora_4.0.fs -- Coraphyco COnversion RAtios and PHYsical COnstants +\ Version 4.0 +\ 2011/6/14 David Meyer + +\ Coraphyco provides a Forth environment to facilitate conversion of +\ quantities among a large variety of measurement units and systems. +\ Inspired by Frink by Allan Eliasen. + +\ Changes in version 4.0 +\ - Convert to integer arithmetic from floating-point for +\ portability and usability. +\ - Rewrite user interface to present unique word for each +\ conversion instead of unit-to-base constants and generic +\ conversion word ->. + +\ Notes: +\ - On Zaurus, one cell is four bytes, therefore max. single- +\ precision integer is $ffffffff = 4294967295 (unsigned) or +\ $7fffffff = 2147483647 (signed) +\ - NetBSD (SDF) compilation uses eight-byte cells. Max. single- +\ precision integer: $ffffffffffffffff = 18446744073709551615 +\ (unsigned), $7fffffffffffffff = 9223372036854775807 (signed) +\ - Largest conversion ratio: parsec:mm (30856775813057300000.) +\ (requires double-precision for integer arith., even on SDF) + +: *pi ( n -- PI*n ) + \ Chick Moore's multiply-by-pi + 355 113 */ ; + +\ Volume (standard unit: m^3 (cubic meter)) + +: cc>m^3 ( n-cc -- m-m^3 ) 1000000 / ; + + +\ 1e0 FCONSTANT m^3 \ cubic meter (standard) +\ 1e-6 FCONSTANT cc \ cubic centimeter +\ in in in F* F* FCONSTANT in^3 \ cubic inch +\ 231e0 in^3 F* FCONSTANT gal \ gallon +\ gal 4e0 F/ FCONSTANT qt \ quart +\ qt 2e0 F/ FCONSTANT pt \ pint +\ pt 16e0 F/ FCONSTANT floz \ fluid ounce +\ 42e0 gal F* FCONSTANT bbl \ petroleum barrel +\ 8e0 floz F* FCONSTANT cup \ cup +\ cup 16e0 F/ FCONSTANT tbsp \ tablespoon +\ tbsp 3e0 F/ FCONSTANT tsp \ teaspoon +\ 1e3 cc F* FCONSTANT l \ liter +\ cc FCONSTANT ml \ milliliter + +\ Distance + +: in>cm 254 100 */ ; +: in>ft 12 / ; +: in>km 254 10000000 */ ; +: in>m 254 10000 */ ; +: in>mi 64560 / ; +: in>mm 254 10 */ ; +: in>nmi 254 18520000 */ ; +: in>yd 36 / ; + +: ft>cm 774720 100 */ ; +: ft>in 12 * ; +: ft>km 774720 10000000 */ ; +: ft>m 774720 10000 */ ; +: ft>mi 5280 / ; +: ft>mm 774720 10 */ ; +: ft>nmi 774720 18520000 */ ; +: ft>yd 3 / ; + +: yd>cm 9144 100 */ ; +: yd>ft 3 * ; +: yd>in 36 * ; +: yd>km 9144 10000000 */ ; +: yd>m 9144 10000 */ ; +: yd>mi 1760 / ; +: yd>mm 9144 10 */ ; +: yd>nmi 9144 18520000 */ ; + +: mi>cm 16398240 100 */ ; +: mi>ft 5280 * ; +: mi>in 64560 * ; +: mi>km 16398240 10000000 */ ; +: mi>m 16398240 10000 */ ; +: mi>mm 16398240 10 */ ; +: mi>nmi 16398240 18520000 */ ; +: mi>yd 1760 * ; + +: mm>cm 10 / ; +: mm>ft 10 3048 */ ; +: mm>in 10 254 */ ; +: mm>km 1000000 / ; +: mm>m 1000 / ; +: mm>mi 10 16398240 */ ; +: mm>nmi 1852000 / ; +: mm>yd 10 9144 */ ; + +: cm>ft 100 3048 */ ; +: cm>in 100 254 */ ; +: cm>km 100000 / ; +: cm>m 100 / ; +: cm>mi 100 16398240 */ ; +: cm>mm 10 * ; +: cm>nmi 185200 / ; +: cm>yd 100 9144 */ ; + +: m>cm 100 * ; +: m>ft 10000 3048 */ ; +: m>in 10000 254 */ ; +: m>km 1000 / ; +: m>mi 10000 16398240 */ ; +: m>mm 1000 * ; +: m>nmi 1852 / ; +: m>yd 10000 9144 */ ; + +: km>cm 100000 * ; +: km>ft 10000000 3048 */ ; +: km>in 10000000 254 */ ; +: km>m 1000 * ; +: km>mi 10000000 16398240 */ ; +: km>mm 1000000 * ; +: km>nmi 1000 1852 */ ; +: km>yd 10000000 9144 */ ; + +: nmi>cm 185200 * ; +: nmi>ft 18520000 3048 */ ; +: nmi>in 18520000 254 */ ; +: nmi>km 1852 1000 */ ; +: nmi>m 1852 * ; +: nmi>mi 18520000 16398240 */ ; +: nmi>mm 1852000 * ; +: nmi>yd 18520000 9144 */ ; + +\ Linear measure (standard unit: m (meter)) + +\ 1e0 FCONSTANT m \ meter (standard) +\ 1e3 FCONSTANT km \ kilometer +\ 1e-2 FCONSTANT cm \ centimeter +\ 1e-3 FCONSTANT mm \ millimeter + +\ 3048e-4 FCONSTANT ft \ foot +\ ft 12e0 F/ FCONSTANT in \ inch +\ 3e0 ft F* FCONSTANT yd \ yard +\ 5280e0 ft F* FCONSTANT mi \ mile +\ 1852e0 FCONSTANT nmi \ nautical mile + +\ 149597870691e0 FCONSTANT au \ astronomical unit +\ 365.25e0 day F* c F* FCONSTANT ly \ light year +\ au asec F/ FCONSTANT pc \ parsec + + +\ Display quantity r1 of units r2 in standard unit amount +: mks ( r1 r2 -- ) F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +: -> ( r1 r2 r3 -- ) F/ F* F. ; + +\ Convert quantity r1 from r2 units to r3 units and display +\ in engineering notation +: ->e ( r1 r2 r3 -- ) F/ F* FE. ; + +\ Convert Celcius temperature to Fahrenheit +: c>f ( r -- ) 9e0 f* 5e0 f/ 32e0 f+ f. ; + +\ Convert Fahrenheit temperature to Celcius +: f>c ( r -- ) 32e0 f- 5e0 f* 9e0 f/ f. ; + +\ Online help +: help ( -- ) +( Eventually print/page help file ... + s" /usr/mnt.rom/card/Documents/Cavenet_Files/green/forth/cora-help.txt" r/o open-file throw Value fd-in + begin + line-buffer max-line fd-in read-line throw + while + type + repeat ; +) + cr ." (See file cora-help.txt for help.)" + cr ; + +\ Speed (standard unit: m/s (meters per second) + +1e0 FCONSTANT m/s \ meters per second (standard) + +331.46e0 FCONSTANT mach \ speed of sound in dry air at STP + +299792458e0 FCONSTANT c \ light in vacuum + +\ Acceleration (standard unit: m/s^2 (meters per second per second) + +1e0 FCONSTANT m/s^2 \ meters per second per second (standard) + +980665e-5 FCONSTANT gee \ standard gravitational acceleration + +\ Time (standard unit: s (second)) + +1e0 FCONSTANT s \ second (standard) +60e0 60e0 F* FCONSTANT hr \ hour +24e0 hr F* FCONSTANT day \ day + +\ Use ms as standard time unit to match Forth - +\ Replace s, hr, day above with following: +\ Also switch from float to double} +1e FCONSTANT ms \ millisecond (standard) +1e3 FCONSTANT s \ second +60e s F* FCONSTANT minute \ minute +60e minute F* FCONSTANT hr \ hour +24e hr F* FCONSTANT day \ day +7e day F* FCONSTANT wk \ week +365.25e day F* FCONSTANT yr \ year (average) +: monthms ( uyear umonth -- r ) + dup 2 = + ; + +\ Angular measure (standard unit: radian (dimensionless)) + +2e0 pi F* FCONSTANT circle +circle 360e0 F/ FCONSTANT deg \ degree +deg 60e0 F/ FCONSTANT amin \ arc minute +amin 60e0 F/ FCONSTANT asec \ arc second + +\ Linear measure (standard unit: m (meter)) + +1e0 FCONSTANT m \ meter (standard) +1e3 FCONSTANT km \ kilometer +1e-2 FCONSTANT cm \ centimeter +1e-3 FCONSTANT mm \ millimeter + +3048e-4 FCONSTANT ft \ foot +ft 12e0 F/ FCONSTANT in \ inch +3e0 ft F* FCONSTANT yd \ yard +5280e0 ft F* FCONSTANT mi \ mile +1852e0 FCONSTANT nmi \ nautical mile + +149597870691e0 FCONSTANT au \ astronomical unit +365.25e0 day F* c F* FCONSTANT ly \ light year +au asec F/ FCONSTANT pc \ parsec + +\ Area (standard unit: m^2 (square meter)) + +1e0 FCONSTANT m^2 \ square meter (standard) +ft ft F* FCONSTANT ft^2 \ square feet +43560e0 ft^2 F* FCONSTANT acre \ acre +1e2 FCONSTANT are \ are +1e4 FCONSTANT hectare \ hectare + +\ Volume (standard unit: m^3 (cubic meter)) + +1e0 FCONSTANT m^3 \ cubic meter (standard) +1e-6 FCONSTANT cc \ cubic centimeter +in in in F* F* FCONSTANT in^3 \ cubic inch +231e0 in^3 F* FCONSTANT gal \ gallon +gal 4e0 F/ FCONSTANT qt \ quart +qt 2e0 F/ FCONSTANT pt \ pint +pt 16e0 F/ FCONSTANT floz \ fluid ounce +42e0 gal F* FCONSTANT bbl \ petroleum barrel +8e0 floz F* FCONSTANT cup \ cup +cup 16e0 F/ FCONSTANT tbsp \ tablespoon +tbsp 3e0 F/ FCONSTANT tsp \ teaspoon +1e3 cc F* FCONSTANT l \ liter +cc FCONSTANT ml \ milliliter + +\ Mass (standard unit: kg (kilogram)) + +1e0 FCONSTANT kg \ kilogram (standard) +1e-3 FCONSTANT g \ gram +1e3 FCONSTANT mt \ tonne, metric ton + +45359237e-8 FCONSTANT lb \ pound +2e3 lb F* FCONSTANT t \ ton +lb 16e0 F/ FCONSTANT oz \ ounce + +\ Print opening greeting +cr ." *********************************************************************" +cr ." *** Welcome to Coraphyco. Type `help' for help ***" +cr ." *********************************************************************" cr + + diff --git a/corai.fs b/corai.fs new file mode 100755 index 0000000..ddb7177 --- /dev/null +++ b/corai.fs @@ -0,0 +1,4 @@ +\ corai.fs - Cora Phyco with integer math + +: s>hr ( i -- ) 3600 / ; +: s>day ( i -- ) \ No newline at end of file diff --git a/date.fs b/date.fs new file mode 100755 index 0000000..044464f --- /dev/null +++ b/date.fs @@ -0,0 +1,67 @@ +\ date.fs - Date arithmetic Forth module +\ +\ Copyright 2015 David Meyer +JMJ +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. +\ +\ Source for Julian Day calculation algorithms: +\ "Julian day". Wikipedia The Free Encyclopedia. Modified 2015/9/21. +\ Wikimedia Foundation. Accessed 2015/9/26 +\ + +variable a +variable jy +variable jm +variable n2 +variable f +variable e +variable g +variable h + +\ jdn - Convert Gregorian date y m d to Julian Day Number +: jdn { y m d -- n } + 14 m - 12 / a ! + y 4800 + a @ - jy ! + m 12 a @ * + 3 - jm ! + d + jm @ 153 * 2 + 5 / + + jy @ 365 * + + jy @ 4 / + + jy @ 100 / - + jy @ 400 / + + 32045 - +; + +\ j>ymd - Convert Julian Day Number to Gregorian date y m d +: j>ymd { j -- y m d } + j 1401 + + j 4 * 274277 + 146097 / 3 * 4 / + + -38 + f ! + f @ 4 * 3 + e ! + e @ 1461 mod 4 / g ! + g @ 5 * 2 + h ! + h @ 153 / 2 + 12 mod 1+ ( month -- ) + dup 14 swap - 12 / e @ 1461 / + 4716 - swap ( year month -- ) + h @ 153 mod 5 / 1+ +; + +\ j>w1 - Day of week W1 (Sun=0) for JDN +: j>w1 ( n -- w1 ) + 1+ 7 mod +; + +\ dtdiff - Compute difference in days between two Gregorian dates +: dtdiff ( y1 m1 d1 y2 m2 d2 -- n ) + jdn n2 ! + jdn n2 @ swap - +; diff --git a/dmath.fs b/dmath.fs new file mode 100755 index 0000000..a78dbf9 --- /dev/null +++ b/dmath.fs @@ -0,0 +1,9 @@ +\ dmath.fs -- double-precision math + +\ doubles are stored on stack as two integers, n1 n2 +\ d = n1 + 4294967296 * n2 + +\ Multiplication +: d* ( d1 d2 -- d1*d2 ) +\ (n1 + c * n2)(n3 + c * n4) +\ n1*n3 + c*(n2*n3 + n1*n4) + c^2*n2*n4 diff --git a/dnw.blink b/dnw.blink new file mode 100755 index 0000000..088ce2a --- /dev/null +++ b/dnw.blink @@ -0,0 +1,2 @@ +DNW's Forth Page +http://www-personal.umich.edu/~williams/archive/forth/forth.html diff --git a/dot-gforth-iza.fs b/dot-gforth-iza.fs new file mode 100755 index 0000000..2bd6472 --- /dev/null +++ b/dot-gforth-iza.fs @@ -0,0 +1,5 @@ +\ .gforth.fs - Gforth initialization + +include wareki.fs +include yuko.fs +cr diff --git a/double-arith.fs b/double-arith.fs new file mode 100755 index 0000000..271ebf7 --- /dev/null +++ b/double-arith.fs @@ -0,0 +1,30 @@ +\ double-arith.fs - Double-precision arithmetic extensions + +\ Copyright 2013 David Meyer +JMJ + +\ Copying and distribution of this file, with or without +\ modification, are permitted in any medium without royalty +\ provided the copyright notice and this notice are preserved. +\ This file is offered as-is, without any warranty. + +\ MAXU - Maximum value of unsigned single +s" MAX-U" environment? drop constant MAXU + +\ md* - Multiply double by unsigned single (iterative method) +: md* ( d u -- d*u ) + 0. rot + 0 u+do 2over d+ loop + 2nip +; + +\ mudu* - Multiply unsigned double by unsigned single +: mudu* ( ud u -- ud*u ) tuck * >r m* r> + ; + +\ ud* - Multiply two unsigned doubles +: ud* ( ud1 ud2 -- ud1*ud2 ) + { a1 b1 a2 b2 } + a1 a2 um* + MAXU a1 um* b2 mudu* d+ + MAXU a2 um* b1 mudu* d+ + MAXU MAXU um* b1 mudu* b2 mudu* d+ +; diff --git a/f-strings.txt b/f-strings.txt new file mode 100755 index 0000000..b8e988c --- /dev/null +++ b/f-strings.txt @@ -0,0 +1,46 @@ +Forth Strings + +In order to flexibly generate HTML, Forth requires the ability to +construct strings of arbitrary length in memory by concatenating and +nesting multiple string segments. + +There are several string-handling Forth modules available, but none +are straightforward, so I'm considering a custom module. + +For string concatenation, my first idea was to allocated space +for the combined string for each concatenation, but I'm afraid +generation of a page of HTML in memory would require allocating +several times the final page size as each string segment is combined +and recombined several times into larger and larger sections or the +document. + +An alternative idea is to allocate two buffers each of the estimated +maximum page size. Then all concatenations are expressed as appending +and/or prepending strings to the current pafe image. An appended +string could simply be copied to the end of the page buffer. To +prepend a string, the copy buffer would be initialized with the +string, page buffer contents appended, then the resulting combined +string copied back to the page buffer. Would have to track end of +page image within buffer. This would limit memory usage to twice the +estimated maximum page size, but would require a check for buffer +overflow on exceptionally large pages. + +Current average size of *.html, *.txt, *.org files in cavenet +green dataset is approx. 2500 bytes. Average word count per file is +24000. + +Another alternative: use an array of string addesses and one of +string lengths. Concatenate strings by appending or inserting +compiled string addresses and lengths in their respective arrays. +This would avoid duplication of strings and memory for them. Would +impose maximum on number of string segments that could comprise +a web page. + +Taking as an upper estimate each word in a page requiring a start +and an end tag would make an average of approximately 72000 string +segments. + +Of course, must ask if complexity of building strings in memory +before printing is justified versus just printing strings in +sequence as they occur in processing. + diff --git a/fig_reg.fth b/fig_reg.fth new file mode 100755 index 0000000..0f24891 --- /dev/null +++ b/fig_reg.fth @@ -0,0 +1,648 @@ +\ #! /usr/local/bin/pfe -q +\ FIG_reg program to handle forms requests for joining FIG + +\ This is an ANS Forth program requiring: +\ 1. The File Access word set. +\ 2. The word CMOVE from the String word set. +\ 3. A system dependent word GETENV to get the specified +\ environment string, +\ GETENV ( str count -- str' count' ) +\ 4. The word STDIN to get the file ID of standard input. +\ 5. The words OPEN-PIPE and CLOSE-PIPE to open and close pipes to +\ processes. (These are communicated with via the normal File access +\ words). +\ 6. READ to write to Unix file descriptors (because of a problem with +\ ThisForth 94-09-12). +\ 7. The word : #! \ ; IMMEDIATE + +\ (c) Copyright 1994 Everett F. Carter. Permission is granted by the +\ author to use this software for any application provided this +\ copyright notice is preserved. + + +\ rcsid: %W% %U% %G% EFC + + +TRUE CONSTANT ?DEBUG +TRUE CONSTANT ThisForth +FALSE CONSTANT PFE + +ThisForth [IF] + +\ =================== ANS File words for ThisForth ========================= + +\ file open modes +: R/W S" r+" ; +: R/O S" r" ; +: W/O S" w" ; + +: APPEND S" a" ; \ NOT ANS, but necessary + + +: OPEN-FILE fopen DUP 0= ; + +: READ-LINE ( addr u fileid -- u' flag ior ) + STREAM + 0 SWAP + 0 DO + next-char EOL = IF LEAVE THEN + next-char EOF = IF LEAVE THEN + get-char + 2 PICK I + C! + 1+ + LOOP + + UNSTREAM + + SWAP DROP TRUE 0 +; + +: READ-FILE ( addr u fileid -- u' flag ) \ a hack + STREAM + 0 SWAP + 0 DO + next-char EOF = IF LEAVE THEN + get-char + 2 PICK I + C! + 1+ + LOOP + + UNSTREAM + + SWAP DROP FALSE +; + + +: REPOSITION-FILE ( d fid -- flag ) + ROT ROT DROP 0 + fseek +; + +: WRITE-FILE ( c-addr u fileid -- ior ) + DISPLAY TYPE + 0 DISPLAY + TRUE +; + + +: WRITE-LINE ( c-addr u fileid -- ior ) + DISPLAY TYPE CR + 0 DISPLAY + TRUE +; + +: CLOSE-FILE fclose ; + +[THEN] + +\ ========================================================================= + +ThisForth [IF] \ ThisForth version +: OPEN-APPEND + APPEND OPEN-FILE +; + +[ELSE] +\ ANS Brute force OPEN-APPEND, depending upon what is under the hood, there may +\ be more efficient definitions +: OPEN-APPEND R/W OPEN-FILE + DUP 0= IF OVER FILE-SIZE + 0= IF 3 PICK REPOSITION-FILE DROP THEN + THEN +; +[THEN] + + +FALSE VALUE bad-status +0 VALUE seq-file +0 VALUE log-file +0 VALUE seq-no + +CREATE NEW-LINE-CHARS 2 ALLOT +10 NEW-LINE-CHARS C! +\ 13 NEW-LINE-CHARS 1+ C! + + +0 VALUE buf-len +0 VALUE input-buffer +VARIABLE scan-ptr + +ALIGN +CREATE out-buf 32 ALLOT + +\ ============= A String pointer data structure ============================= + +: string: \ build a counted string + CREATE + 0 , \ POINTER to the data + 0 , \ the count + DOES> + DUP @ SWAP CELL+ @ +; + + +: $! ( addr count 'str -- ) \ store a string + >BODY + SWAP OVER CELL+ ! + ! +; + +: $len ( addr count -- count ) + SWAP DROP +; + +: $copy ( addr count 'str -- ) + + HERE 2 PICK ROT $! \ store string pointer to HERE + HERE SWAP DUP ALLOT + CMOVE +; + +: $cat ( addr1 count1 addr2 count2 -- addr count ) + 2 PICK OVER + DUP >R + HERE >R + ALLOT + 2SWAP + R@ SWAP DUP >R CMOVE \ move first string + + R> R@ + + SWAP CMOVE \ move the second string + + R> R> +; + +\ the data fields +string: first-name +string: last-name +string: street +string: city +string: state/prov +string: country +string: postal-code +string: phone +string: e-mail +string: www-page + +\ ======================= LOCAL FILE NAMES ================================ + +string: SEQFILE +string: LOGFILE +string: PROGRAM +string: MAILER +string: HOSTNAME +string: DESTINATION + +: init-strings + + +\ This is the name of the mail program, we are using URL escape codes +\ for quotes which will be converted to actual quotes later + +\ S" /usr/ucb/Mail -s %22FIG Membership%22 johnhall@aol.com skip@taygeta.com " + S" /usr/ucb/Mail -s %22FIG Membership%22 skip@taygeta.com " + ['] MAILER $copy + + S" /usr/local/logs/figreg.seq" ['] SEQFILE $copy + + S" /usr/local/logs/figreg.log" ['] LOGFILE $copy + + S" %M% V%I%" ['] PROGRAM $copy + + S" taygeta.com" ['] HOSTNAME $copy + + + S" johnhall@aol.com " ['] DESTINATION $copy + +; + +\ ========================================================================= + +: acknowledge ( -- ) + + ."
Forth Interest Group Membership OK " + ."
" CR + + ." Everything received OK

" CR + ." You will be contacted soon about billing information

" + ." Your first issue of Forth Dimensions will arrive " + ." in four to six weeks. " CR + ." Subsequent issues will be mailed to you every other month " + ." as they are published -- six issues in all. " CR + ."

" CR + ." Note, dues are not deductible as a charitable contribution for " + ." U.S. federal income tax purposes," CR ." but may be deductible as " + ." a business expense. " CR + ."

" CR + ." " + ." [CHAR] " + ." Back to FIG Home page. " CR + ."

" CR + +; + +: nack ( -- ) + + ."

Forth Interest Group Membership NOT OK " + ."
" CR + + ." Sorry, There seems to be a problem with the form as you filled it out " + + ."

" CR + ." " + ." [CHAR] " + ." Back to FIG Membership Form page. " CR + ."

" CR + +; + +: sig + ."

" CR + ." Everett F. Carter Jr. -- skip@taygeta.com" CR + ."
" CR + +; + +: atol ( addr count -- d ) + >R + 0. ROT + R> + + >NUMBER + 2DROP +; + +: atoi ( addr count -- n ) + + atol DROP +; + +: move-chars ( dest src count -- dest count ) + >R OVER R@ CMOVE R> +; + +: itoa ( n -- addr count ) \ (signed) int to counted string + out-buf aligned SWAP + DUP >R ABS S>D + <# #S R> SIGN #> + move-chars +; + +: newline ( fileid -- flag ) + + NEW-LINE-CHARS 1 ROT WRITE-FILE +; + +: update_sequence_number ( -- old_no ) + + SEQFILE R/W OPEN-FILE ABORT" Unable to open sequence file " + + TO seq-file + + \ get the current sequence number + PAD 16 seq-file READ-LINE ABORT" file read error " + DROP + + PAD SWAP atoi + + + \ increment the number and store it away + DUP 1+ + + 0. seq-file REPOSITION-FILE DROP + + itoa seq-file WRITE-LINE DROP + + seq-file CLOSE-FILE DROP + +; + + +: write-env ( -- len ) + + S" SERVER_PROTOCOL" getenv + DUP 0= IF 2DROP S" HTTP/1.0" THEN TYPE + + ." 200 OK" CR + ." MIME-Version: 1.0" CR + + S" SERVER_SOFTWARE" getenv + DUP 0 > IF TYPE CR ELSE 2DROP THEN + + ." Content-Type: text/html" CR + \ ." Content-Encoding: HTML" CR + \ ." Content-Transfer-Encoding: HTML" CR + CR + + S" CONTENT_LENGTH" getenv + DUP IF atoi ELSE 2DROP 0 THEN +; + + + +: plus->space ( addr count -- ) \ convert pluses to spaces + + 0 ?DO I OVER + C@ [CHAR] + = IF I OVER + BL SWAP C! THEN LOOP + DROP +; + +: x2c ( addr count -- n ) + + HEX + + >R 0. ROT R> + >NUMBER + 2DROP DROP + + DECIMAL +; + +: unescape-url ( addr count -- count' ) + + -1 SWAP + 0 ?DO + 1+ + + OVER OVER + \ get &url[x] + 2 PICK I + C@ \ get url[y] + DUP ROT C! \ url[x] = url[y] + + + [CHAR] % = IF \ convert it if it is a % char + OVER I + 1+ 2 x2c \ convert url[y+1] + 2 PICK 2 PICK + C! \ and store it at url[x] + 3 + ELSE + 1 + THEN + + +LOOP + + 1+ \ adjust count + SWAP DROP +; + +: skip-past-equals ( -- ) + + scan-ptr @ DUP buf-len SWAP ?DO + 1+ + input-buffer I + C@ + [CHAR] = = IF LEAVE THEN + LOOP + scan-ptr ! +; + +: length-to-ampersand ( -- n ) + + 0 + buf-len scan-ptr @ ?DO + input-buffer I + C@ + [CHAR] & = IF LEAVE THEN + 1+ + LOOP + +; + +: scan ( -- addr count | 0 ) + + + skip-past-equals + + length-to-ampersand + + DUP 0 > IF + input-buffer scan-ptr @ + \ addr of first char + SWAP \ put count on top + DUP scan-ptr +! + THEN +; + +\ get data from input stream (stdin) +\ set BAD-STATUS if it failed +: get-input-data ( addr len -- ) + + + \ STDIN READ-FILE + + \ The above SHOULD work, but with ThisForth 94-09-12 + \ it doesn't when this is run with no tty attached (as it will be + \ when HTTP invokes it), so instead we are using: + + 0 READ + + + DUP 0 < + TO bad-status + TO buf-len +; + + +: scan-input-data ( -- ) + + 0 scan-ptr ! + + scan DUP 0 > IF ['] first-name $! THEN + scan DUP 0 > IF ['] last-name $! THEN + + scan DUP 0 > IF ['] street $! THEN + scan DUP 0 > IF ['] city $! THEN + scan DUP 0 > IF ['] state/prov $! THEN + scan DUP 0 > IF ['] postal-code $! THEN + scan DUP 0 > IF ['] country $! THEN + + scan DUP 0 > IF ['] phone $! THEN + scan DUP 0 > IF ['] e-mail $! THEN + scan DUP 0 > IF ['] www-page $! THEN + + \ need a full name + first-name $len 0= last-name $len 0= OR TO bad-status + + \ if there is no phone number of e-mail, then there MUST be an + \ address + phone $len 0= e-mail $len 0= AND + IF + street $len 0= city $len 0= OR state/prov $len 0= OR + TO bad-status + THEN + +; + +: report-field ( addr count handle -- ) + + OVER 0= IF SWAP DROP SWAP DROP S" (None) " ROT THEN + + WRITE-FILE DROP +; + +: report ( handle -- ) + + S" First name: " 2 PICK WRITE-FILE DROP + first-name 2 PICK report-field + + S" Last name: " 2 PICK WRITE-FILE DROP + last-name 2 PICK report-field + + DUP newline DROP + + S" Street : " 2 PICK WRITE-FILE DROP + street 2 PICK report-field + + DUP newline DROP + + S" City : " 2 PICK WRITE-FILE DROP + city 2 PICK report-field + + S" State: " 2 PICK WRITE-FILE DROP + state/prov 2 PICK report-field + + DUP newline DROP + + S" Country: " 2 PICK WRITE-FILE DROP + country 2 PICK report-field + + + S" postal-code: " 2 PICK WRITE-FILE DROP + postal-code 2 PICK report-field + + DUP newline DROP + + S" phone: " 2 PICK WRITE-FILE DROP + phone 2 PICK report-field + + DUP newline DROP + + S" e-mail: " 2 PICK WRITE-FILE DROP + e-mail 2 PICK report-field + + DUP newline DROP + + S" WWW page: " 2 PICK WRITE-FILE DROP + www-page 2 PICK report-field + + newline DROP +; + + +: sendmail ( handle -- handle ) + + S" Here is a new FIG Membership request number: " 2 PICK WRITE-FILE DROP + seq-no itoa 2 PICK WRITE-LINE DROP + + S" Received at " 2 PICK WRITE-FILE DROP + + PAD 24 timestamp 2 PICK WRITE-FILE DROP + S" from the WWW page on: " 2 PICK WRITE-FILE DROP + HOSTNAME 2 PICK WRITE-LINE DROP + + S" Program: " 2 PICK WRITE-FILE DROP + PROGRAM 2 PICK WRITE-LINE DROP + + DUP newline DROP + + DUP report + + +; + +: fig_reg ( -- ) + + init-strings + + \ fix the mailer string + MAILER unescape-url MAILER DROP SWAP ['] MAILER $! + + MAILER DESTINATION $cat ['] MAILER $! + + LOGFILE OPEN-APPEND ABORT" Unable to open log file " + TO log-file + + update_sequence_number DUP TO seq-no + + + PAD 24 timestamp log-file WRITE-FILE DROP + + S" Sequence number is: " log-file WRITE-FILE DROP + itoa log-file WRITE-FILE DROP + + log-file newline DROP + + write-env + + ?DEBUG IF + S" CONTENT LENGTH = " log-file WRITE-FILE DROP + DUP itoa log-file WRITE-FILE DROP + THEN + + + \ allocate space for the buffer + HERE TO input-buffer + DUP 2 + DUP TO buf-len ALLOT + + \ now read characters from the input stream + input-buffer SWAP get-input-data + + + ?DEBUG IF + S" BUF-LEN = " log-file WRITE-FILE DROP + buf-len itoa log-file WRITE-FILE DROP + S" status = " log-file WRITE-FILE DROP + bad-status itoa log-file WRITE-FILE DROP + log-file newline DROP + THEN + + + input-buffer buf-len plus->space + + input-buffer buf-len unescape-url TO buf-len + + + ?DEBUG IF + input-buffer buf-len log-file WRITE-FILE DROP + log-file newline DROP + THEN + + scan-input-data + + + log-file report + + bad-status IF nack + ELSE + ." Mailer command <" MAILER TYPE ." >" CR + + \ open the mail pipe + MAILER W/O OPEN-PIPE + ABORT" Unable to open pipe to mailer " + + sendmail + CLOSE-PIPE DROP + acknowledge + THEN + + sig + + log-file newline DROP + log-file CLOSE-FILE DROP + +; + +\ auto-startup word + +: startup fig_reg bye ; + + +PFE [IF] + startup +[THEN] + + + + + + + + + diff --git a/forth-app.txt b/forth-app.txt new file mode 100755 index 0000000..f010d15 --- /dev/null +++ b/forth-app.txt @@ -0,0 +1,62 @@ + +Forth Application Presentation -*-org-*- + +Date: 2011/11/30 + +How should an application implemented in Forth be presented to users? +I can think of the following formats. + +1. Forth Extension: User invokes application with word(s) in the Forth + interpreter. + + * Advantages: Most flexible and portable, immediate debugging. + + * Disadvantages: Requires user to have access to shell and Forth + interpreter. User must know how to use Forth + interpreter. Text-only interface. + +2. Shell Application: User invokes shell script that starts Forth + interpreter and invokes application. + + * Advantages: Low impact on implementation, good portability. User + need not know Forth or Forth interpreter. + + * Disadvantages: User must have shell access. Text-only + interface. Debugging requires modulization of + application. Dependency on Forth interpreter interface for + argument handling, environment var's, etc. + +3. CGI Application: User invokes application from browser via CGI + script. + + * Advantages: User can access application from any platform with + web browser. User needs no knowledge of Forth or + shell. Interface can use text styling and graphics. + + * Disadvantages: Requires web server running on application + host. Dependency on Forth interpreter interface for environment + var's, etc. Application must wrap output in HTML. Must finesse + dictionary, stack persistence. + +4. GUI Application: Aplication packaged as GUI program invoked on + user's PC. + + * Advantages: Easiest access for user. Greatest options for + interface media. + + * Disadvantages: Highly dependent on user's platform. Depends on + linking graphics libraries with Forth modules. Requires user to + install application on own PC. + +Currently, I don't possess the knowledge to implement pattern 4., and +it has so many disadvantages I doubt it would be worthwhile even if I +could. + +Pattern 2. does not offer much meaningful advantage over +pattern 1. (Users who can use the shell are able to learn enough +Forth to invoke the application.) + +Therefore, I expect to do initial development as a +pattern 1. application, then make a pattern 3. wrapper for +appropriate aplications. + diff --git a/forth-cheat.txt b/forth-cheat.txt new file mode 100755 index 0000000..63fa4c3 --- /dev/null +++ b/forth-cheat.txt @@ -0,0 +1,53 @@ +Forth Cheat Sheet -*- mode: org; -*- + +* 2011/6/9 restart + +** Input/output +.s . + +** Arithmetic ++ - * / mod negate +/mod ( n m -- nMODm n/m ) + +** Stack juggling +drop ( x -- ) +dup ( x -- x x ) +over ( x y -- x y x ) +swap ( x y -- y x ) +rot ( x y z -- y z x ) +nip ( x y -- y ) +tuck ( x y -- y x y ) + +** Operator type prefixes +u: unsigned integer +c: character +d: signed double-cell integer +ud, du: unsigned double-cell integer +2: two cells +m, um: mixed single- and double-cell operations +f: floating point + +* Original sheet + +Arithmetic :: + - * / mod negate /mod 1+ 1- + +Logical/bitwise :: and or xor invert 2/ + +Comparison :: = <> < > <= >= + +Comparison prefix :: 0 u d d0 du f f0 + +General prefix :: u c d ud du 2 m um f + +Parameter :: n u c f a-addr a- c-addr c- xt w,x d ud r + +Stack :: .s . drop dup over swap rot 2swap 2drop nip tuck + +Conditional :: if...then if...else...then + +Loop :: begin...again begin...while...repeat begin...until + +Miscellaneous :: assert( see words + + + diff --git a/forth-revisited.txt b/forth-revisited.txt new file mode 100755 index 0000000..e9ae426 --- /dev/null +++ b/forth-revisited.txt @@ -0,0 +1,5 @@ +Forth Revisited + +I was taking a look at the Coraphyco unit converter program I did in Forth almost five years ago (can't believe it). I'd forgotten how to use the cute little thing, so I'm now determined to learn enough Forth to put in the help commands I've been intending to add all along. + +In the process, I started falling in love with this little language again. Maybe Common Lisp can wait? At least I want to include Forth as a tool in my online "world building". diff --git a/forth-script b/forth-script new file mode 100755 index 0000000..6f7d7fb --- /dev/null +++ b/forth-script @@ -0,0 +1,7 @@ +#! /usr/local/bin/gforth + +\ Forth shell script + +." Hello, World!" cr + +bye diff --git a/forth.cgi_ b/forth.cgi_ new file mode 100755 index 0000000..2370892 --- /dev/null +++ b/forth.cgi_ @@ -0,0 +1,23 @@ +#!/usr/pkg/bin/perl + +$GFORTH = '/arpa/ns/p/papa/bin/gforth-0.7.0'; + +$query = $ENV{'QUERY_STRING'}; +$query =~ s/\+/ /g; +$query =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge; + +open(RESULT, '-|', "$GFORTH -e '$query CR BYE'") or die "Can't start gforth: $!"; + +$result = ; + +chop $result; + +print < $result +END + +while () { print "\t\t$_"; } + + diff --git a/forthlit.blink b/forthlit.blink new file mode 100755 index 0000000..85a861d --- /dev/null +++ b/forthlit.blink @@ -0,0 +1,2 @@ +Forth Literature and Education +http://www.taygeta.com/forthlit.html diff --git a/forthtest.cgi_ b/forthtest.cgi_ new file mode 100755 index 0000000..637962f --- /dev/null +++ b/forthtest.cgi_ @@ -0,0 +1,29 @@ +#! /usr/bin/gforth-fast +\ forthtest.cgi - Test driver for html5cgi.fs + +include html5cgi.fs + +s" Document Title" $alloc *title* *head* + +0 +s" Level 1 Heading" $alloc *h1* + +s" Level 2 Heading" $alloc *h2* + +s" Level 3 Heading" $alloc *h3* + +s" Level 4 Heading" $alloc *h4* + +s" Level 5 Heading" $alloc *h5* + +s" Level 6 Heading" $alloc *h6* + +*body* *html* *http-html5* + +ctype + +bye + + + + diff --git a/gcd.fs b/gcd.fs new file mode 100755 index 0000000..23e6c94 --- /dev/null +++ b/gcd.fs @@ -0,0 +1,32 @@ +\ gcd.fs -- Compute greatest common divisor (for Gforth manual +\ General Loops Tutorial) +\ David Meyer 2010-03-17 + +: gcd ( n1 n2 -- n3 ) + assert( 2dup 0<> swap 0<> and ) \ Parameters are non-zero + 2dup < if swap then \ Put parameters in descending order + dup 1+ \ Initialize candidate divisor + begin + 1- \ Decrement candidate divisor + 2dup mod 0= \ n2 divisible by nc + 2over drop 2over nip mod 0= and \ n1 div. by nc + over 1 = or \ nc = 1 + until + nip nip +\ dup 1 = if \ Result is 0 for mutual primes +\ drop 0 +\ then +; + + +: euclid ( n1 n2 -- n3 ) \ Calculate GCD with Euclid's + \ method + assert( 2dup 0<> swap 0<> and ) \ Parameters are non-zero + 2dup < if swap then \ Put parameters in descending order + begin + dup 0<> + while + tuck mod + repeat + drop \ Simple! +; \ No newline at end of file diff --git a/gforth.cgi_ b/gforth.cgi_ new file mode 100755 index 0000000..1544066 --- /dev/null +++ b/gforth.cgi_ @@ -0,0 +1,57 @@ +#!/usr/pkg/bin/perl + +use CGI; + +$GFORTH = '/usr/pkg/bin/gforth'; +$CORA = '/meta/p/papa/html/cgi-bin/cora.fs'; + +$query = CGI->new; + +$command = $query->param('command'); + +print < + + +Gforth Calculator + + + + + +

Gforth Calculator

+
+ Command + +
+
+END1 + +if ($command) { + + open(RESULT, '-|', "$GFORTH $CORA -e '$command CR S\" D:\" TYPE .S S\" F:\" TYPE F.S CR BYE'") or die "Can't start gforth: $!"; + + print "
$command==>"; + + while () { + chop $_; + print "$_
"; + } + + print "
\n"; +} + +print <Gforth Manual
+Starting Forth
+Thinking Forth
+Forth Research
+Forth Interest Group
+Chuck Moore
+ + +END3 + diff --git a/gforth_1.cgi_ b/gforth_1.cgi_ new file mode 100755 index 0000000..81821a1 --- /dev/null +++ b/gforth_1.cgi_ @@ -0,0 +1,57 @@ +#!/usr/pkg/bin/perl + +use CGI; + +$GFORTH = '/arpa/ns/p/papa/bin/gforth-0.7.0'; +$CORA = '/arpa/ns/p/papa/share/gforth/site-forth/cora.fs'; + +$query = CGI->new; + +$command = $query->param('command'); + +print < + + +Gforth Calculator + + + + + +

Gforth Calculator

+
+ Command + +
+
+END1 + +if ($command) { + + open(RESULT, '-|', "$GFORTH $CORA -e '$command CR BYE'") or die "Can't start gforth: $!"; + + print "
$command==>"; + + while () { + chop $_; + print "$_
"; + } + + print "
\n"; +} + +print <Gforth Manual
+Starting Forth
+Thinking Forth
+Forth Research
+Forth Interest Group
+Chuck Moore
+ + +END3 + diff --git a/gophermap b/gophermap new file mode 100755 index 0000000..cbd8f7c --- /dev/null +++ b/gophermap @@ -0,0 +1,66 @@ +1(to nexus) /users/papa sdf.org 70 + + +YOU SEE HERE: +0Mind.4th /users/papa/forth/Mind.4th sdf.org 70 +0Mind.F /users/papa/forth/Mind.F sdf.org 70 +0array.fs /users/papa/forth/array.fs sdf.org 70 +0#head.blosxom# #story.blosxom# 4kad StarryApplet a-mans-a about ais alpha-vms althist aotcx basic basic-21c bible bibtex bin blink blog blogger blogging blogroll blosxom bonmots books busy c c-abc canzoni cave cavemap cc.bas cell certs chem church cl cms content_type.blosxom content_type.writeback cosw cow creacomp cs csliner css ct date.blosxom date.html date.writeback democracy devimg diplomacy disney drupal drut dunnet dw eco ed-ipkg elisp emacs email english feeds filefeed fonts food foot.blosxom foot.html foot.writeback foot.writeback~ forth future games gf glog gopher gophermap gophermap~ gopherspace greek gtd gverse hammurabi head.blosxom head.html head.html~ head.writeback head.writeback~ hello hsk-mod i ibasho it its japan jbo journal js l-abc license life linux lisp loctime lotgd lynx lynx_bookmarks.html media mes metadata mindforth ming motd motdph2 muckman mucku mud music mux narnia neuschwanstein openofc orgblm padcode papascave pbbghub pc perl phlog phlupd phwk pl plan9 pm poems politecon prayers prog prolog pverse q qdstar qdstar-c qdstar-perl quest quiz r2h rcww2010 read reading recipe religion rpn scheme scifi sdf sdfmud sdfpbp sell sh sib site smr softbiz songs splitre squares ssh starasc stars.game start.txt story.blosxom story.html story.html~ story.writeback style teco teco280.tmp teco7919.tmp telehack template test.md.txt test2.txt testdn testup tex tinyhack tinymud tinymush tinyweb tir tirph tirrender.c tirrender.pl tirtest todo tops10 trade train travel twenex twisty unicode unix urbex vcard vms vttrek wiki wikitest_dokuwiki_blog_entry.txt winxp writeback writeback.writeback writing www xfce ykwk zaurus /users/papa/forth/blockimg.txt sdf.org 70 +hCaltech Forth URL:http://pdp-10.trailing-edge.com/decuslib10-04/01/43,50361/forth.doc.html +Macro Assembler source (Tenex): +http://pdp-10.trailing-edge.com/decuslib10-04/01/43,50361/forth.mac.html +0cgi-0.fs /users/papa/forth/cgi-0.fs sdf.org 70 +0cgi.fs /users/papa/forth/cgi.fs sdf.org 70 +0chronograph.fs /users/papa/forth/chronograph.fs sdf.org 70 +0Coraphyco - COnversion RAtios and PHYsical COnstnts in Forth /users/papa/forth/cora-help.txt sdf.org 70 +0cora.fs /users/papa/forth/cora.fs sdf.org 70 +0cora_0.fs /users/papa/forth/cora_0.fs sdf.org 70 +0cora_1.fs /users/papa/forth/cora_1.fs sdf.org 70 +0cora_2.fs /users/papa/forth/cora_2.fs sdf.org 70 +0cora_3.fs /users/papa/forth/cora_3.fs sdf.org 70 +0cora_4.0.fs /users/papa/forth/cora_4.0.fs sdf.org 70 +0corai.fs /users/papa/forth/corai.fs sdf.org 70 +0dmath.fs /users/papa/forth/dmath.fs sdf.org 70 +hDNW's Forth Page URL:http://www-personal.umich.edu/~williams/archive/forth/forth.html +0fig_reg.fth /users/papa/forth/fig_reg.fth sdf.org 70 +0 /users/papa/forth/forth-app.txt sdf.org 70 +0Forth Cheat Sheet -*- mode: org; -*- /users/papa/forth/forth-cheat.txt sdf.org 70 +0Forth Revisited /users/papa/forth/forth-revisited.txt sdf.org 70 +0forth-script /users/papa/forth/forth-script sdf.org 70 +0forth.cgi /users/papa/forth/forth.cgi sdf.org 70 +hForth Literature and Education URL:http://www.taygeta.com/forthlit.html +0gcd.fs /users/papa/forth/gcd.fs sdf.org 70 +0gforth.cgi /users/papa/forth/gforth.cgi sdf.org 70 +0gforth_1.cgi /users/papa/forth/gforth_1.cgi sdf.org 70 +0hanoi-he.4th /users/papa/forth/hanoi-he.4th sdf.org 70 +0hanoi.4th /users/papa/forth/hanoi.4th sdf.org 70 +0hello /users/papa/forth/hello sdf.org 70 +0length-units.xls /users/papa/forth/length-units.xls sdf.org 70 +0Forth Level 0 Functions /users/papa/forth/level-0.org sdf.org 70 +0lf.4th /users/papa/forth/lf.4th sdf.org 70 +0life.fs /users/papa/forth/life.fs sdf.org 70 +0mailfig.fth /users/papa/forth/mailfig.fth sdf.org 70 +hMarcel Hendrix's home-page URL:http://home.iae.nl/users/mhx/index.html +hChuck Moore: Geek of the Week URL:http://www.simple-talk.com/opinion/geek-of-the-week/chuck-moore-geek-of-the-week/ +0pf.perl /users/papa/forth/pf.perl sdf.org 70 +0random.f /users/papa/forth/random.f sdf.org 70 +0Forth Sandbox -*-org-*- /users/papa/forth/sandbox.txt sdf.org 70 +0Text screen test patterns /users/papa/forth/scrtest.txt sdf.org 70 +0Starting Forth Words -*-org-*- /users/papa/forth/starting-words.txt sdf.org 70 +0starting.fs /users/papa/forth/starting.fs sdf.org 70 +0sticks.f /users/papa/forth/sticks.f sdf.org 70 +0test1.fs /users/papa/forth/test1.fs sdf.org 70 +hThoughtful Programming and Forth URL:http://www.ultratechnology.com/forth.htm +0tscript /users/papa/forth/tscript sdf.org 70 +0tutorial.fs /users/papa/forth/tutorial.fs sdf.org 70 +0twenex-forth.mid /users/papa/forth/twenex-forth.mid sdf.org 70 +0TWENEX FORTH WORDS /users/papa/forth/twenex-forth.txt sdf.org 70 +0wareki.fs /users/papa/forth/wareki.fs sdf.org 70 +0Yuko Development Notes /users/papa/forth/yuko-notes.org sdf.org 70 +0yuko-test.fs /users/papa/forth/yuko-test.fs sdf.org 70 +0yuko.fs /users/papa/forth/yuko.fs sdf.org 70 + +1(to nexus) /users/papa sdf.org 70 + +Anyone who goes to a psychiatrist ought to have his head examined. + -- Samuel Goldwyn diff --git a/hamucalc.fs b/hamucalc.fs new file mode 100755 index 0000000..ed53aeb --- /dev/null +++ b/hamucalc.fs @@ -0,0 +1,37 @@ +\ hamucalc.fs - HAMURABI game calculator + +\ Copyright 2013 David Meyer +JMJ + +\ Copying and distribution of this file, with or without +\ modification, are permitted in any medium without royalty +\ provided the copyright notice and this notice are preserved. +\ This file is offered as-is, without any warranty. + +: hamu { pop land grain landpr -- } + pop 20 * + dup cr .\" Grain to feed people:\t" . + land pop 1- 10 * min + dup cr .\" Acres to plant:\t" . + 2 * + + grain - + dup 0> if + cr .\" Acres to sell:\t" + landpr 2dup % 0= if + / . + else + / 1+ . + then + else + cr .\" Acres to buy:\t" + negate landpr / . + then + cr +; + +\ Emacs metadata ... + +\ Local variables: +\ mode: forth +\ End: + +\ +JMJ diff --git a/hanoi-he.4th b/hanoi-he.4th new file mode 100755 index 0000000..0d1e4b3 --- /dev/null +++ b/hanoi-he.4th @@ -0,0 +1,69 @@ +\ hanoi.4th +\ +\ Towers of Hanoi puzzle +\ +\ From a posting to comp.lang.forth, 30 May 2002, by Marcel +\ Hendrix and Brad Eckert. According to Marcel Hendrix, the +\ code for the HANOI algorithm was originally posted to clf +\ by Raul Deluth Miller in 1994. +\ --------------------------------------------------------------------------- +\ kForth includes and defs (2002-05-30 K. Myneni) +\ +include strings +include ansi +: chars ; +\ --------------------------------------------------------------------------- +\ To run under other ANS Forths, uncomment the defs below: +\ : a@ @ ; +\ : ?allot here swap allot ; +\ : nondeferred ; + +variable slowness 1000 slowness ! \ ms delay between screen updates +create PegSPS 3 cells allot \ pointers for three disk stacks + +: PegSP ( peg -- addr ) cells PegSPS + ; +: PUSH ( c peg -- ) PegSP tuck a@ c! 1 chars swap +! ; +: POP ( peg -- c ) PegSP -1 chars over +! a@ c@ ; + +create PegStacks 30 chars allot \ stack area for up to 10 disks + +: PegStack ( peg -- addr ) 10 * PegStacks + ; +: PegClr ( peg -- ) dup PegStack swap PegSP ! ; +: PegDepth ( peg -- depth) dup PegSP @ swap PegStack - ; \ not needed + +: ShowDisk ( level diameter peg ) + 22 * 10 + over - rot 10 swap - at-xy \ position cursor + 1+ 2* 0 ?do [char] * emit loop ; \ display the disk + +: ShowPeg ( peg -- ) dup >r PegStack + BEGIN r@ PegSP @ over <> + WHILE dup r@ PegStack - over c@ ( addr level diameter ) + r@ ShowDisk char+ + REPEAT drop r> drop ; + +: MAKETAB CREATE dup ?allot over 1- + swap 0 ?do dup >r c! r> 1- loop drop + DOES> + c@ ; + +: base3 [ decimal ] 3 base ! ; nondeferred +base3 00 02 01 12 00 10 21 20 decimal 8 maketab TO! +base3 00 21 12 20 00 02 10 01 decimal 8 maketab FRO! + + +: ShowPegs ( -- ) page 3 0 do i showpeg loop slowness @ ms + key? if key drop 0 11 at-xy ." Stopped" cr abort then ; + +: MoveRing ( ring -- ring ) dup to! 3 / pop over fro! 3 mod push + ShowPegs ; + +: HANOI ( depth direction -- depth direction ) swap 1- swap + over IF to! recurse to! MoveRing fro! recurse fro! + ELSE MoveRing + THEN swap 1+ swap ; + +: PLAY ( depth -- ) + 3 0 DO i PegClr LOOP \ clear the pegs + dup BEGIN ?dup WHILE 1- dup 0 push REPEAT \ stack up some disks + showpegs 1 HANOI 2drop \ move them + 0 11 at-xy ; + +4 play \ No newline at end of file diff --git a/hanoi.4th b/hanoi.4th new file mode 100755 index 0000000..b59aece --- /dev/null +++ b/hanoi.4th @@ -0,0 +1,33 @@ +( The Towers Of Hanoi ) +( FORTH ) +( Copyright 1998 Amit Singh. All Rights Reserved. ) +( http://hanoi.kernelthread.com ) +( ) +( Tested under GNU Forth 0.3.0, PFE 0.9.14 ) + +( Use "gforth -e 'n HANOI bye'" to run ) +( hanoi with n disks. Alternatively, load everything ) +( and use the HANOI word from within the interpreter. ) + +: MOVEIT ." move " . ." --> " . CR ; ( to from -- ) + +: DOHANOI ( to from using n -- ) + ( T3 <- T1 using T2 ) + DUP 0 > ( more disks ? ) + IF + 1 - ( n <- n - 1 ) + 2OVER 2OVER ( clone data stack ) + >r >r >r >r ( save it to rstack ) + 1 ROLL 2 ROLL 3 ROLL 3 ROLL ( using from to n-1 ) + RECURSE ( T2 <- T1 using T3 ) + 2r@ SWAP MOVEIT ( to from ) + 2DROP 2DROP ( empty the stack ) + 2r> 2r> ( from to n-1 using ) + SWAP ( from to using n-1 ) + 3 ROLL ( to using n-1 from ) + SWAP ( to using from n-1 ) + RECURSE ( T3 <- T2 using T1 ) +THEN ; + +: HANOI ( n -- ) ( prepare arguments ) +3 1 2 3 ROLL DOHANOI 2DROP 2DROP ; diff --git a/heapstr.fs b/heapstr.fs new file mode 100755 index 0000000..9f3bcb2 --- /dev/null +++ b/heapstr.fs @@ -0,0 +1,53 @@ +\ heapstr.fs -- Manage character strings in heap memory +\ 2016 David Meyer +JMJ + +: c$type ( c-str -- ) count type ; + +: $alloc ( a-str u -- c-heap ) +\g Allocate heap space for counted version of string A-STR,U + dup 1+ chars allocate if ( a-str u c-heap) + >r 2drop r> -1 \ Returns string length -1 for alloc. error + else + 2dup c! dup >r 1 chars + swap cmove r> + then +; + +: c$alloc ( c-str -- c-heap ) +\g Allocate heap space for counted string for C-STR + count dup 1+ chars allocate if ( a-str u c-heap) + >r 2drop r> 0 \ Returns 0 c-pointer for alloc. error + else + 2dup c! + dup >r 1 chars + swap cmove r> + then +; + +: $catcpy { a-str1 u1 a-str2 u2 a-cat ucat -- } +\g Copy characters from STR1 and STR2 to pre-allocated CAT + a-str1 a-cat u1 cmove + a-str2 a-cat u1 chars + u2 cmove +; + +: c$cat ( c-str1 c-str2 -- c-cat ) +\g Concatenate two counted strings in heap, preserve original strings + count dup >r rot count dup >r 2swap ( a-str1 u1 a-str2 u2 R: u2 u1 ) + r> r> + dup 1+ chars allocate if ( a-str1 u1 a-str2 u2 ucat c-cat ) + clearstack 0 \ Returns 0 c-pointer for alloc. error + else + tuck c! ( a-str1 u1 a-str2 u2 c-cat ) + dup >r count $catcpy r> + then +; + +: c$catx ( c-str1 c-str2 ux -- c-cat ) +\g Concatenate two counted strings in heap, recycle original strings according to UX: 0 -- recycle STR1 and STR2, 1 -- recycle STR1 only, 2 -- recycle STR2 only + >r 2dup c$cat r> ( c-str1 c-str2 c-cat ux ) + dup 2 = if + drop swap free drop nip + else dup 1 = if + drop nip swap free drop + else 0= if + swap free drop + swap free drop + then then then +; diff --git a/hello b/hello new file mode 100755 index 0000000..632f426 --- /dev/null +++ b/hello @@ -0,0 +1,7 @@ +#! /usr/local/bin/gforth + +." Hello, World!" cr + +bye + + diff --git a/html.f b/html.f new file mode 100755 index 0000000..91810ce --- /dev/null +++ b/html.f @@ -0,0 +1,4 @@ +\ html.f + +\ determine string length for text + symmetrical open/close tags +: octag 2( a1 u1 a2 u2 -- a1 u1 a2 u2 n ) over nip over 2 * + 5 + ; diff --git a/html.fs b/html.fs new file mode 100755 index 0000000..0c5b35c --- /dev/null +++ b/html.fs @@ -0,0 +1,65 @@ +\ Generate markup to standard output + +: [http-html-head] ( -- ) + ." Content-Type: text/html" cr cr + .\" " + ." " +; + +\ (gforth does not support strings with embedded new-line characters) + +\ HTML tags: html, head, title, style, meta, body, h1/2/3/4/5/6, p, strong (b), em (i), ul, ol, li, dl, dt, dd, table, thead, tbody, tr, th, td, a + +: [<] [char] < emit ; +: [>] [char] > emit ; +: [] ." />" ; + +: "tag" ( -- ) ." tag" ; +: [tag] ( addr u -- ) [<] type [>] ; +: [/tag] ( addr u -- ) [] ; +: [tag-$] ( $-addr $-u t-addr t-u -- ) [tag] type ; +: [tag-$/] ( $-addr $-u t-addr t-u -- ) + 2dup [tag] 2over type [/tag] ; +: [tag+] ( +-addr +-u t-addr t-u -- ) + [<] type space type [>] ; +: [tag+$] ( $-addr $-u +-addr +-u t-addr t-u -- ) + [<] type space type [>] type ; +: [tag+$/] ( $-addr $-u +-addr +-u t-addr t-u -- ) + 2dup [<] type space 2over type [>] 2over type [/tag] ; +: [tag/] ( addr u -- ) [<] type space [/>] ; + +: "p" ( -- ) s" p" ; +: [p] ( -- ) "p" [tag] ; +: [p-$] ( addr u -- ) [p] type ; \ "p" [tag-$] ; +: [p-$/] ( addr u -- ) "p" [tag-$/] ; +: [p+] ( +-addr +-u -- ) "p" [tag+] ; +: [p+$] ( $-addr $-u +-addr +-u -- ) "p" [tag+$] ; +: [p+$/] ( $-addr $-u +-addr +-u -- ) "p" [tag+$/] ; +: [/p] ( -- ) "p" [/tag] ; +: [p/] ( -- ) "p" [tag/] ; + +.( Testing ...) cr + +"p" type cr +[p] cr +s" This is a p-$ example." [p-$] cr +s" This is a p-$/ example." [p-$/] cr +s" a1=v1 a2=v2" [p+] cr +s" This is a p+$ example." s" a1=v1 a2=v2" [p+$] cr +s" This is a p+$/ example." s" a1=v1 a2=v2" [p+$/] cr +[/p] cr +[p/] cr + +bye + + + + +: [html] [<] ." html" [>] ; +: [html-a] ( attr-a u -- ) [<] ." html " type [>] ; +: [/html] ( -- ) [] ; + +: [h1] [<] ." html" [>] ; + diff --git a/html5cgi.fs b/html5cgi.fs new file mode 100755 index 0000000..5f02e9e --- /dev/null +++ b/html5cgi.fs @@ -0,0 +1,134 @@ +\ html5cgi.fs -- Generate HTML5 tags for CGI script +\ 2016 David Meyer +JMJ + +\ Tags are generate with words with format *X*, where X usually corresponds to the +\ tag to be generated, and which generally have a stack effect like: +\ +\ ( c-prefix c-content [c-attrib ...] -- c-result ) +\ +\ Where: c-prefix is a pointer to a counted string containing the preceding contents +\ of the current element; 0 when the current tag will be the first +\ contents of the element. +\ c-content is a pointer to the contents for the current tag. +\ c-attrib points to one or more optional strings for tag attributes. +\ c-result points to a string concatenating the prefix contents with the current +\ tag (input strings are recycled to the heap). + +\ Supported tags/structure: +\ *http-resp* +\ *html* +\ *head* +\ *title*, *style*, *meta*, *base* +\ *body* +\ *article*, *aside*, *div*, *header*, *footer*, *nav*, *section* +\ *a*, *blockquote* *h1*, *h2*, *h3*, *h4*, *h5*, *h6*, *hr*, *img*, *pre* +\ *map* +\ *area* +\ *p* +\ *b*, *br*, *em*, *strong* +\ *ol*, *ul* +\ *li* +\ *dl* +\ *dt*, *dd* +\ *table* +\ *thead*, *tbody* +\ *tr* +\ *th*, *td* +\ *form* +\ *input*, *label* + +include heapstr.fs + + +s" " $alloc constant C-B +s" " $alloc constant C-/B +s"
" $alloc constant C-BQUOTE +s\"
\n" $alloc constant C-/BQUOTE +s\" \n" $alloc constant C-BODY +s\" \n" $alloc constant C-/BODY +s\"
\n" $alloc constant C-BR +s" " $alloc constant C-EM +s" " $alloc constant C-/EM +s"

" $alloc constant C-H1 +s\"

\n" $alloc constant C-/H1 +s"

" $alloc constant C-H2 +s\"

\n" $alloc constant C-/H2 +s"

" $alloc constant C-H3 +s\"

\n" $alloc constant C-/H3 +s"

" $alloc constant C-H4 +s\"

\n" $alloc constant C-/H4 +s"
" $alloc constant C-H5 +s\"
\n" $alloc constant C-/H5 +s"
" $alloc constant C-H6 +s\"
\n" $alloc constant C-/H6 +s\" \n" $alloc constant C-HEAD +s\" \n" $alloc constant C-/HEAD +s\"
\n" $alloc constant C-HR +s\" \n" $alloc constant C-HTML +s\" \n" $alloc constant C-/HTML +s\" Content-type: text/html\n\n\n" $alloc + constant C-HTTP-HTML5 +s"
  • " $alloc constant C-LI +s\"
    • \n" $alloc constant C-/LI +s"
      " $alloc constant C-OL +s\"
    \n" $alloc constant C-/OL +s"

    " $alloc constant C-P +s\"

    \n" $alloc constant C-/P +s" " $alloc constant C-STRONG +s" " $alloc constant C-/STRONG +s" " $alloc constant C-TITLE +s\" \n" $alloc constant C-/TITLE +s"
      " $alloc constant C-UL +s\"
    \n" $alloc constant C-/UL + +: empty-tag ( c-prefix c-tag -- c-result ) 1 c$catx ; + +: simple-tag ( c-prefix c-content c-open c-close -- c-result ) +\g Generate tag with format: Tag contents + rot swap 1 c$catx 2 c$catx + over if 0 c$catx else nip then +; + +: *blockquote* ( c-prefix c-content -- c-result ) C-BQUOTE C-/BQUOTE simple-tag ; + +: *b* ( c-prefix c-content -- c-result ) C-B C-/B simple-tag ; + +: *body* ( c-content -- c-body ) C-/BODY 1 c$catx C-BODY swap 2 c$catx ; + +: *br* ( c-prefix -- c-result ) C-BR empty-tag ; + +: *em* ( c-prefix c-content -- c-result ) C-EM C-/EM simple-tag ; + +: *h1* ( c-prefix c-content -- c-result ) C-H1 C-/H1 simple-tag ; + +: *h2* ( c-prefix c-content -- c-result ) C-H2 C-/H2 simple-tag ; + +: *h3* ( c-prefix c-content -- c-result ) C-H3 C-/H3 simple-tag ; + +: *h4* ( c-prefix c-content -- c-result ) C-H4 C-/H4 simple-tag ; + +: *h5* ( c-prefix c-content -- c-result ) C-H5 C-/H5 simple-tag ; + +: *h6* ( c-prefix c-content -- c-result ) C-H6 C-/H6 simple-tag ; + +: *head* ( c-content -- c-result ) C-/HEAD 1 c$catx C-HEAD swap 2 c$catx ; + +: *hr* ( c-prefix -- c-result ) C-HR empty-tag ; + +: *html* ( c-head c-body -- c-result ) C-/HTML 1 c$catx 0 c$catx C-HTML swap 2 c$catx ; + +: *http-html5* ( c-content -- c-result ) C-HTTP-HTML5 swap 2 c$catx ; + +: *li* ( c-prefix c-content -- c-result ) C-LI C-/LI simple-tag ; + +: *ol* ( c-prefix c-content -- c-result ) C-OL C-/OL simple-tag ; + +: *p* ( c-prefix c-content -- c-result ) C-P C-/P simple-tag ; + +: *strong* ( c-prefix c-content -- c-result ) C-STRONG C-/STRONG simple-tag ; + +: *title* ( c-prefix c-content -- c-result ) C-TITLE C-/TITLE simple-tag ; + +: *ul* ( c-prefix c-content -- c-result ) C-UL C-/UL simple-tag ; + + diff --git a/httags.4th b/httags.4th new file mode 100755 index 0000000..1b24822 --- /dev/null +++ b/httags.4th @@ -0,0 +1,304 @@ +: [<] [char] < emit ; +: [>] [char] > emit ; +: [] ." />" ; +: [tag] ( addr u -- ) [<] type [>] ; +: [/tag] ( addr u -- ) [] ; +: [tag-$] ( $-addr $-u t-addr t-u -- ) [tag] type ; +: [tag-$/] ( $-addr $-u t-addr t-u -- ) + 2dup [tag] 2over type [/tag] ; +: [tag+] ( +-addr +-u t-addr t-u -- ) + [<] type space type [>] ; +: [tag+$] ( $-addr $-u +-addr +-u t-addr t-u -- ) + [<] type space type [>] type ; +: [tag+$/] ( $-addr $-u +-addr +-u t-addr t-u -- ) + 2dup [<] type space 2swap type [>] 2swap type [/tag] ; +: [tag/] ( addr u -- ) [<] type space [/>] ; +: $html$ ( -- ) s" html" ; +: [html] ( -- ) $html$ [tag] ; +: [/html] ( -- ) $html$ [/tag] ; +: [html/] ( -- ) $html$ [tag/] ; +: [html-$] ( addr u -- ) $html$ [tag-$] ; +: [html-$/] ( addr u -- ) $html$ [tag-$/] ; +: [html+] ( +-addr +-u -- ) $html$ [tag+] ; +: [html+$] ( addr u +-addr +-u -- ) $html$ [tag+$] ; +: [html+$/] ( addr u +-addr +-u -- ) $html$ [tag+$/] ; +: $head$ ( -- ) s" head" ; +: [head] ( -- ) $head$ [tag] ; +: [/head] ( -- ) $head$ [/tag] ; +: [head/] ( -- ) $head$ [tag/] ; +: [head-$] ( addr u -- ) $head$ [tag-$] ; +: [head-$/] ( addr u -- ) $head$ [tag-$/] ; +: [head+] ( +-addr +-u -- ) $head$ [tag+] ; +: [head+$] ( addr u +-addr +-u -- ) $head$ [tag+$] ; +: [head+$/] ( addr u +-addr +-u -- ) $head$ [tag+$/] ; +: $title$ ( -- ) s" title" ; +: [title] ( -- ) $title$ [tag] ; +: [/title] ( -- ) $title$ [/tag] ; +: [title/] ( -- ) $title$ [tag/] ; +: [title-$] ( addr u -- ) $title$ [tag-$] ; +: [title-$/] ( addr u -- ) $title$ [tag-$/] ; +: [title+] ( +-addr +-u -- ) $title$ [tag+] ; +: [title+$] ( addr u +-addr +-u -- ) $title$ [tag+$] ; +: [title+$/] ( addr u +-addr +-u -- ) $title$ [tag+$/] ; +: $style$ ( -- ) s" style" ; +: [style] ( -- ) $style$ [tag] ; +: [/style] ( -- ) $style$ [/tag] ; +: [style/] ( -- ) $style$ [tag/] ; +: [style-$] ( addr u -- ) $style$ [tag-$] ; +: [style-$/] ( addr u -- ) $style$ [tag-$/] ; +: [style+] ( +-addr +-u -- ) $style$ [tag+] ; +: [style+$] ( addr u +-addr +-u -- ) $style$ [tag+$] ; +: [style+$/] ( addr u +-addr +-u -- ) $style$ [tag+$/] ; +: $meta$ ( -- ) s" meta" ; +: [meta] ( -- ) $meta$ [tag] ; +: [/meta] ( -- ) $meta$ [/tag] ; +: [meta/] ( -- ) $meta$ [tag/] ; +: [meta-$] ( addr u -- ) $meta$ [tag-$] ; +: [meta-$/] ( addr u -- ) $meta$ [tag-$/] ; +: [meta+] ( +-addr +-u -- ) $meta$ [tag+] ; +: [meta+$] ( addr u +-addr +-u -- ) $meta$ [tag+$] ; +: [meta+$/] ( addr u +-addr +-u -- ) $meta$ [tag+$/] ; +: $body$ ( -- ) s" body" ; +: [body] ( -- ) $body$ [tag] ; +: [/body] ( -- ) $body$ [/tag] ; +: [body/] ( -- ) $body$ [tag/] ; +: [body-$] ( addr u -- ) $body$ [tag-$] ; +: [body-$/] ( addr u -- ) $body$ [tag-$/] ; +: [body+] ( +-addr +-u -- ) $body$ [tag+] ; +: [body+$] ( addr u +-addr +-u -- ) $body$ [tag+$] ; +: [body+$/] ( addr u +-addr +-u -- ) $body$ [tag+$/] ; +: $h1$ ( -- ) s" h1" ; +: [h1] ( -- ) $h1$ [tag] ; +: [/h1] ( -- ) $h1$ [/tag] ; +: [h1/] ( -- ) $h1$ [tag/] ; +: [h1-$] ( addr u -- ) $h1$ [tag-$] ; +: [h1-$/] ( addr u -- ) $h1$ [tag-$/] ; +: [h1+] ( +-addr +-u -- ) $h1$ [tag+] ; +: [h1+$] ( addr u +-addr +-u -- ) $h1$ [tag+$] ; +: [h1+$/] ( addr u +-addr +-u -- ) $h1$ [tag+$/] ; +: $h2$ ( -- ) s" h2" ; +: [h2] ( -- ) $h2$ [tag] ; +: [/h2] ( -- ) $h2$ [/tag] ; +: [h2/] ( -- ) $h2$ [tag/] ; +: [h2-$] ( addr u -- ) $h2$ [tag-$] ; +: [h2-$/] ( addr u -- ) $h2$ [tag-$/] ; +: [h2+] ( +-addr +-u -- ) $h2$ [tag+] ; +: [h2+$] ( addr u +-addr +-u -- ) $h2$ [tag+$] ; +: [h2+$/] ( addr u +-addr +-u -- ) $h2$ [tag+$/] ; +: $h3$ ( -- ) s" h3" ; +: [h3] ( -- ) $h3$ [tag] ; +: [/h3] ( -- ) $h3$ [/tag] ; +: [h3/] ( -- ) $h3$ [tag/] ; +: [h3-$] ( addr u -- ) $h3$ [tag-$] ; +: [h3-$/] ( addr u -- ) $h3$ [tag-$/] ; +: [h3+] ( +-addr +-u -- ) $h3$ [tag+] ; +: [h3+$] ( addr u +-addr +-u -- ) $h3$ [tag+$] ; +: [h3+$/] ( addr u +-addr +-u -- ) $h3$ [tag+$/] ; +: $h4$ ( -- ) s" h4" ; +: [h4] ( -- ) $h4$ [tag] ; +: [/h4] ( -- ) $h4$ [/tag] ; +: [h4/] ( -- ) $h4$ [tag/] ; +: [h4-$] ( addr u -- ) $h4$ [tag-$] ; +: [h4-$/] ( addr u -- ) $h4$ [tag-$/] ; +: [h4+] ( +-addr +-u -- ) $h4$ [tag+] ; +: [h4+$] ( addr u +-addr +-u -- ) $h4$ [tag+$] ; +: [h4+$/] ( addr u +-addr +-u -- ) $h4$ [tag+$/] ; +: $h5$ ( -- ) s" h5" ; +: [h5] ( -- ) $h5$ [tag] ; +: [/h5] ( -- ) $h5$ [/tag] ; +: [h5/] ( -- ) $h5$ [tag/] ; +: [h5-$] ( addr u -- ) $h5$ [tag-$] ; +: [h5-$/] ( addr u -- ) $h5$ [tag-$/] ; +: [h5+] ( +-addr +-u -- ) $h5$ [tag+] ; +: [h5+$] ( addr u +-addr +-u -- ) $h5$ [tag+$] ; +: [h5+$/] ( addr u +-addr +-u -- ) $h5$ [tag+$/] ; +: $h6$ ( -- ) s" h6" ; +: [h6] ( -- ) $h6$ [tag] ; +: [/h6] ( -- ) $h6$ [/tag] ; +: [h6/] ( -- ) $h6$ [tag/] ; +: [h6-$] ( addr u -- ) $h6$ [tag-$] ; +: [h6-$/] ( addr u -- ) $h6$ [tag-$/] ; +: [h6+] ( +-addr +-u -- ) $h6$ [tag+] ; +: [h6+$] ( addr u +-addr +-u -- ) $h6$ [tag+$] ; +: [h6+$/] ( addr u +-addr +-u -- ) $h6$ [tag+$/] ; +: $p$ ( -- ) s" p" ; +: [p] ( -- ) $p$ [tag] ; +: [/p] ( -- ) $p$ [/tag] ; +: [p/] ( -- ) $p$ [tag/] ; +: [p-$] ( addr u -- ) $p$ [tag-$] ; +: [p-$/] ( addr u -- ) $p$ [tag-$/] ; +: [p+] ( +-addr +-u -- ) $p$ [tag+] ; +: [p+$] ( addr u +-addr +-u -- ) $p$ [tag+$] ; +: [p+$/] ( addr u +-addr +-u -- ) $p$ [tag+$/] ; +: $strong$ ( -- ) s" strong" ; +: [strong] ( -- ) $strong$ [tag] ; +: [/strong] ( -- ) $strong$ [/tag] ; +: [strong/] ( -- ) $strong$ [tag/] ; +: [strong-$] ( addr u -- ) $strong$ [tag-$] ; +: [strong-$/] ( addr u -- ) $strong$ [tag-$/] ; +: [strong+] ( +-addr +-u -- ) $strong$ [tag+] ; +: [strong+$] ( addr u +-addr +-u -- ) $strong$ [tag+$] ; +: [strong+$/] ( addr u +-addr +-u -- ) $strong$ [tag+$/] ; +: $em$ ( -- ) s" em" ; +: [em] ( -- ) $em$ [tag] ; +: [/em] ( -- ) $em$ [/tag] ; +: [em/] ( -- ) $em$ [tag/] ; +: [em-$] ( addr u -- ) $em$ [tag-$] ; +: [em-$/] ( addr u -- ) $em$ [tag-$/] ; +: [em+] ( +-addr +-u -- ) $em$ [tag+] ; +: [em+$] ( addr u +-addr +-u -- ) $em$ [tag+$] ; +: [em+$/] ( addr u +-addr +-u -- ) $em$ [tag+$/] ; +: $ul$ ( -- ) s" ul" ; +: [ul] ( -- ) $ul$ [tag] ; +: [/ul] ( -- ) $ul$ [/tag] ; +: [ul/] ( -- ) $ul$ [tag/] ; +: [ul-$] ( addr u -- ) $ul$ [tag-$] ; +: [ul-$/] ( addr u -- ) $ul$ [tag-$/] ; +: [ul+] ( +-addr +-u -- ) $ul$ [tag+] ; +: [ul+$] ( addr u +-addr +-u -- ) $ul$ [tag+$] ; +: [ul+$/] ( addr u +-addr +-u -- ) $ul$ [tag+$/] ; +: $ol$ ( -- ) s" ol" ; +: [ol] ( -- ) $ol$ [tag] ; +: [/ol] ( -- ) $ol$ [/tag] ; +: [ol/] ( -- ) $ol$ [tag/] ; +: [ol-$] ( addr u -- ) $ol$ [tag-$] ; +: [ol-$/] ( addr u -- ) $ol$ [tag-$/] ; +: [ol+] ( +-addr +-u -- ) $ol$ [tag+] ; +: [ol+$] ( addr u +-addr +-u -- ) $ol$ [tag+$] ; +: [ol+$/] ( addr u +-addr +-u -- ) $ol$ [tag+$/] ; +: $li$ ( -- ) s" li" ; +: [li] ( -- ) $li$ [tag] ; +: [/li] ( -- ) $li$ [/tag] ; +: [li/] ( -- ) $li$ [tag/] ; +: [li-$] ( addr u -- ) $li$ [tag-$] ; +: [li-$/] ( addr u -- ) $li$ [tag-$/] ; +: [li+] ( +-addr +-u -- ) $li$ [tag+] ; +: [li+$] ( addr u +-addr +-u -- ) $li$ [tag+$] ; +: [li+$/] ( addr u +-addr +-u -- ) $li$ [tag+$/] ; +: $dl$ ( -- ) s" dl" ; +: [dl] ( -- ) $dl$ [tag] ; +: [/dl] ( -- ) $dl$ [/tag] ; +: [dl/] ( -- ) $dl$ [tag/] ; +: [dl-$] ( addr u -- ) $dl$ [tag-$] ; +: [dl-$/] ( addr u -- ) $dl$ [tag-$/] ; +: [dl+] ( +-addr +-u -- ) $dl$ [tag+] ; +: [dl+$] ( addr u +-addr +-u -- ) $dl$ [tag+$] ; +: [dl+$/] ( addr u +-addr +-u -- ) $dl$ [tag+$/] ; +: $dt$ ( -- ) s" dt" ; +: [dt] ( -- ) $dt$ [tag] ; +: [/dt] ( -- ) $dt$ [/tag] ; +: [dt/] ( -- ) $dt$ [tag/] ; +: [dt-$] ( addr u -- ) $dt$ [tag-$] ; +: [dt-$/] ( addr u -- ) $dt$ [tag-$/] ; +: [dt+] ( +-addr +-u -- ) $dt$ [tag+] ; +: [dt+$] ( addr u +-addr +-u -- ) $dt$ [tag+$] ; +: [dt+$/] ( addr u +-addr +-u -- ) $dt$ [tag+$/] ; +: $dd$ ( -- ) s" dd" ; +: [dd] ( -- ) $dd$ [tag] ; +: [/dd] ( -- ) $dd$ [/tag] ; +: [dd/] ( -- ) $dd$ [tag/] ; +: [dd-$] ( addr u -- ) $dd$ [tag-$] ; +: [dd-$/] ( addr u -- ) $dd$ [tag-$/] ; +: [dd+] ( +-addr +-u -- ) $dd$ [tag+] ; +: [dd+$] ( addr u +-addr +-u -- ) $dd$ [tag+$] ; +: [dd+$/] ( addr u +-addr +-u -- ) $dd$ [tag+$/] ; +: $table$ ( -- ) s" table" ; +: [table] ( -- ) $table$ [tag] ; +: [/table] ( -- ) $table$ [/tag] ; +: [table/] ( -- ) $table$ [tag/] ; +: [table-$] ( addr u -- ) $table$ [tag-$] ; +: [table-$/] ( addr u -- ) $table$ [tag-$/] ; +: [table+] ( +-addr +-u -- ) $table$ [tag+] ; +: [table+$] ( addr u +-addr +-u -- ) $table$ [tag+$] ; +: [table+$/] ( addr u +-addr +-u -- ) $table$ [tag+$/] ; +: $thead$ ( -- ) s" thead" ; +: [thead] ( -- ) $thead$ [tag] ; +: [/thead] ( -- ) $thead$ [/tag] ; +: [thead/] ( -- ) $thead$ [tag/] ; +: [thead-$] ( addr u -- ) $thead$ [tag-$] ; +: [thead-$/] ( addr u -- ) $thead$ [tag-$/] ; +: [thead+] ( +-addr +-u -- ) $thead$ [tag+] ; +: [thead+$] ( addr u +-addr +-u -- ) $thead$ [tag+$] ; +: [thead+$/] ( addr u +-addr +-u -- ) $thead$ [tag+$/] ; +: $tbody$ ( -- ) s" tbody" ; +: [tbody] ( -- ) $tbody$ [tag] ; +: [/tbody] ( -- ) $tbody$ [/tag] ; +: [tbody/] ( -- ) $tbody$ [tag/] ; +: [tbody-$] ( addr u -- ) $tbody$ [tag-$] ; +: [tbody-$/] ( addr u -- ) $tbody$ [tag-$/] ; +: [tbody+] ( +-addr +-u -- ) $tbody$ [tag+] ; +: [tbody+$] ( addr u +-addr +-u -- ) $tbody$ [tag+$] ; +: [tbody+$/] ( addr u +-addr +-u -- ) $tbody$ [tag+$/] ; +: $tr$ ( -- ) s" tr" ; +: [tr] ( -- ) $tr$ [tag] ; +: [/tr] ( -- ) $tr$ [/tag] ; +: [tr/] ( -- ) $tr$ [tag/] ; +: [tr-$] ( addr u -- ) $tr$ [tag-$] ; +: [tr-$/] ( addr u -- ) $tr$ [tag-$/] ; +: [tr+] ( +-addr +-u -- ) $tr$ [tag+] ; +: [tr+$] ( addr u +-addr +-u -- ) $tr$ [tag+$] ; +: [tr+$/] ( addr u +-addr +-u -- ) $tr$ [tag+$/] ; +: $th$ ( -- ) s" th" ; +: [th] ( -- ) $th$ [tag] ; +: [/th] ( -- ) $th$ [/tag] ; +: [th/] ( -- ) $th$ [tag/] ; +: [th-$] ( addr u -- ) $th$ [tag-$] ; +: [th-$/] ( addr u -- ) $th$ [tag-$/] ; +: [th+] ( +-addr +-u -- ) $th$ [tag+] ; +: [th+$] ( addr u +-addr +-u -- ) $th$ [tag+$] ; +: [th+$/] ( addr u +-addr +-u -- ) $th$ [tag+$/] ; +: $td$ ( -- ) s" td" ; +: [td] ( -- ) $td$ [tag] ; +: [/td] ( -- ) $td$ [/tag] ; +: [td/] ( -- ) $td$ [tag/] ; +: [td-$] ( addr u -- ) $td$ [tag-$] ; +: [td-$/] ( addr u -- ) $td$ [tag-$/] ; +: [td+] ( +-addr +-u -- ) $td$ [tag+] ; +: [td+$] ( addr u +-addr +-u -- ) $td$ [tag+$] ; +: [td+$/] ( addr u +-addr +-u -- ) $td$ [tag+$/] ; +: $a$ ( -- ) s" a" ; +: [a] ( -- ) $a$ [tag] ; +: [/a] ( -- ) $a$ [/tag] ; +: [a/] ( -- ) $a$ [tag/] ; +: [a-$] ( addr u -- ) $a$ [tag-$] ; +: [a-$/] ( addr u -- ) $a$ [tag-$/] ; +: [a+] ( +-addr +-u -- ) $a$ [tag+] ; +: [a+$] ( addr u +-addr +-u -- ) $a$ [tag+$] ; +: [a+$/] ( addr u +-addr +-u -- ) $a$ [tag+$/] ; +: $div$ ( -- ) s" div" ; +: [div] ( -- ) $div$ [tag] ; +: [/div] ( -- ) $div$ [/tag] ; +: [div/] ( -- ) $div$ [tag/] ; +: [div-$] ( addr u -- ) $div$ [tag-$] ; +: [div-$/] ( addr u -- ) $div$ [tag-$/] ; +: [div+] ( +-addr +-u -- ) $div$ [tag+] ; +: [div+$] ( addr u +-addr +-u -- ) $div$ [tag+$] ; +: [div+$/] ( addr u +-addr +-u -- ) $div$ [tag+$/] ; +: $span$ ( -- ) s" span" ; +: [span] ( -- ) $span$ [tag] ; +: [/span] ( -- ) $span$ [/tag] ; +: [span/] ( -- ) $span$ [tag/] ; +: [span-$] ( addr u -- ) $span$ [tag-$] ; +: [span-$/] ( addr u -- ) $span$ [tag-$/] ; +: [span+] ( +-addr +-u -- ) $span$ [tag+] ; +: [span+$] ( addr u +-addr +-u -- ) $span$ [tag+$] ; +: [span+$/] ( addr u +-addr +-u -- ) $span$ [tag+$/] ; +: $br$ ( -- ) s" br" ; +: [br] ( -- ) $br$ [tag] ; +: [/br] ( -- ) $br$ [/tag] ; +: [br/] ( -- ) $br$ [tag/] ; +: [br-$] ( addr u -- ) $br$ [tag-$] ; +: [br-$/] ( addr u -- ) $br$ [tag-$/] ; +: [br+] ( +-addr +-u -- ) $br$ [tag+] ; +: [br+$] ( addr u +-addr +-u -- ) $br$ [tag+$] ; +: [br+$/] ( addr u +-addr +-u -- ) $br$ [tag+$/] ; +: $hr$ ( -- ) s" hr" ; +: [hr] ( -- ) $hr$ [tag] ; +: [/hr] ( -- ) $hr$ [/tag] ; +: [hr/] ( -- ) $hr$ [tag/] ; +: [hr-$] ( addr u -- ) $hr$ [tag-$] ; +: [hr-$/] ( addr u -- ) $hr$ [tag-$/] ; +: [hr+] ( +-addr +-u -- ) $hr$ [tag+] ; +: [hr+$] ( addr u +-addr +-u -- ) $hr$ [tag+$] ; +: [hr+$/] ( addr u +-addr +-u -- ) $hr$ [tag+$/] ; diff --git a/httags.f b/httags.f new file mode 100755 index 0000000..6fa8bd8 --- /dev/null +++ b/httags.f @@ -0,0 +1,252 @@ +: $html$ ( -- ) s" html" ; +: [html] ( -- ) $html$ [tag] ; +: [/html] ( -- ) $html$ [/tag] ; +: [html/] ( -- ) $html$ [tag/] ; +: [html-$] ( addr u -- ) $html$ [tag-$] ; +: [html-$/] ( addr u -- ) $html$ [tag-$/] ; +: [html+] ( +-addr +-u -- ) $html$ [tag+] ; +: [html+$] ( addr u +-addr +-u -- ) $html$ [tag+$] ; +: [html+$/] ( addr u +-addr +-u -- ) $html$ [tag+$/] ; +: $head$ ( -- ) s" head" ; +: [head] ( -- ) $head$ [tag] ; +: [/head] ( -- ) $head$ [/tag] ; +: [head/] ( -- ) $head$ [tag/] ; +: [head-$] ( addr u -- ) $head$ [tag-$] ; +: [head-$/] ( addr u -- ) $head$ [tag-$/] ; +: [head+] ( +-addr +-u -- ) $head$ [tag+] ; +: [head+$] ( addr u +-addr +-u -- ) $head$ [tag+$] ; +: [head+$/] ( addr u +-addr +-u -- ) $head$ [tag+$/] ; +: $title$ ( -- ) s" title" ; +: [title] ( -- ) $title$ [tag] ; +: [/title] ( -- ) $title$ [/tag] ; +: [title/] ( -- ) $title$ [tag/] ; +: [title-$] ( addr u -- ) $title$ [tag-$] ; +: [title-$/] ( addr u -- ) $title$ [tag-$/] ; +: [title+] ( +-addr +-u -- ) $title$ [tag+] ; +: [title+$] ( addr u +-addr +-u -- ) $title$ [tag+$] ; +: [title+$/] ( addr u +-addr +-u -- ) $title$ [tag+$/] ; +: $style$ ( -- ) s" style" ; +: [style] ( -- ) $style$ [tag] ; +: [/style] ( -- ) $style$ [/tag] ; +: [style/] ( -- ) $style$ [tag/] ; +: [style-$] ( addr u -- ) $style$ [tag-$] ; +: [style-$/] ( addr u -- ) $style$ [tag-$/] ; +: [style+] ( +-addr +-u -- ) $style$ [tag+] ; +: [style+$] ( addr u +-addr +-u -- ) $style$ [tag+$] ; +: [style+$/] ( addr u +-addr +-u -- ) $style$ [tag+$/] ; +: $meta$ ( -- ) s" meta" ; +: [meta] ( -- ) $meta$ [tag] ; +: [/meta] ( -- ) $meta$ [/tag] ; +: [meta/] ( -- ) $meta$ [tag/] ; +: [meta-$] ( addr u -- ) $meta$ [tag-$] ; +: [meta-$/] ( addr u -- ) $meta$ [tag-$/] ; +: [meta+] ( +-addr +-u -- ) $meta$ [tag+] ; +: [meta+$] ( addr u +-addr +-u -- ) $meta$ [tag+$] ; +: [meta+$/] ( addr u +-addr +-u -- ) $meta$ [tag+$/] ; +: $body$ ( -- ) s" body" ; +: [body] ( -- ) $body$ [tag] ; +: [/body] ( -- ) $body$ [/tag] ; +: [body/] ( -- ) $body$ [tag/] ; +: [body-$] ( addr u -- ) $body$ [tag-$] ; +: [body-$/] ( addr u -- ) $body$ [tag-$/] ; +: [body+] ( +-addr +-u -- ) $body$ [tag+] ; +: [body+$] ( addr u +-addr +-u -- ) $body$ [tag+$] ; +: [body+$/] ( addr u +-addr +-u -- ) $body$ [tag+$/] ; +: $h1$ ( -- ) s" h1" ; +: [h1] ( -- ) $h1$ [tag] ; +: [/h1] ( -- ) $h1$ [/tag] ; +: [h1/] ( -- ) $h1$ [tag/] ; +: [h1-$] ( addr u -- ) $h1$ [tag-$] ; +: [h1-$/] ( addr u -- ) $h1$ [tag-$/] ; +: [h1+] ( +-addr +-u -- ) $h1$ [tag+] ; +: [h1+$] ( addr u +-addr +-u -- ) $h1$ [tag+$] ; +: [h1+$/] ( addr u +-addr +-u -- ) $h1$ [tag+$/] ; +: $h2$ ( -- ) s" h2" ; +: [h2] ( -- ) $h2$ [tag] ; +: [/h2] ( -- ) $h2$ [/tag] ; +: [h2/] ( -- ) $h2$ [tag/] ; +: [h2-$] ( addr u -- ) $h2$ [tag-$] ; +: [h2-$/] ( addr u -- ) $h2$ [tag-$/] ; +: [h2+] ( +-addr +-u -- ) $h2$ [tag+] ; +: [h2+$] ( addr u +-addr +-u -- ) $h2$ [tag+$] ; +: [h2+$/] ( addr u +-addr +-u -- ) $h2$ [tag+$/] ; +: $h3$ ( -- ) s" h3" ; +: [h3] ( -- ) $h3$ [tag] ; +: [/h3] ( -- ) $h3$ [/tag] ; +: [h3/] ( -- ) $h3$ [tag/] ; +: [h3-$] ( addr u -- ) $h3$ [tag-$] ; +: [h3-$/] ( addr u -- ) $h3$ [tag-$/] ; +: [h3+] ( +-addr +-u -- ) $h3$ [tag+] ; +: [h3+$] ( addr u +-addr +-u -- ) $h3$ [tag+$] ; +: [h3+$/] ( addr u +-addr +-u -- ) $h3$ [tag+$/] ; +: $h4$ ( -- ) s" h4" ; +: [h4] ( -- ) $h4$ [tag] ; +: [/h4] ( -- ) $h4$ [/tag] ; +: [h4/] ( -- ) $h4$ [tag/] ; +: [h4-$] ( addr u -- ) $h4$ [tag-$] ; +: [h4-$/] ( addr u -- ) $h4$ [tag-$/] ; +: [h4+] ( +-addr +-u -- ) $h4$ [tag+] ; +: [h4+$] ( addr u +-addr +-u -- ) $h4$ [tag+$] ; +: [h4+$/] ( addr u +-addr +-u -- ) $h4$ [tag+$/] ; +: $h5$ ( -- ) s" h5" ; +: [h5] ( -- ) $h5$ [tag] ; +: [/h5] ( -- ) $h5$ [/tag] ; +: [h5/] ( -- ) $h5$ [tag/] ; +: [h5-$] ( addr u -- ) $h5$ [tag-$] ; +: [h5-$/] ( addr u -- ) $h5$ [tag-$/] ; +: [h5+] ( +-addr +-u -- ) $h5$ [tag+] ; +: [h5+$] ( addr u +-addr +-u -- ) $h5$ [tag+$] ; +: [h5+$/] ( addr u +-addr +-u -- ) $h5$ [tag+$/] ; +: $h6$ ( -- ) s" h6" ; +: [h6] ( -- ) $h6$ [tag] ; +: [/h6] ( -- ) $h6$ [/tag] ; +: [h6/] ( -- ) $h6$ [tag/] ; +: [h6-$] ( addr u -- ) $h6$ [tag-$] ; +: [h6-$/] ( addr u -- ) $h6$ [tag-$/] ; +: [h6+] ( +-addr +-u -- ) $h6$ [tag+] ; +: [h6+$] ( addr u +-addr +-u -- ) $h6$ [tag+$] ; +: [h6+$/] ( addr u +-addr +-u -- ) $h6$ [tag+$/] ; +: $p$ ( -- ) s" p" ; +: [p] ( -- ) $p$ [tag] ; +: [/p] ( -- ) $p$ [/tag] ; +: [p/] ( -- ) $p$ [tag/] ; +: [p-$] ( addr u -- ) $p$ [tag-$] ; +: [p-$/] ( addr u -- ) $p$ [tag-$/] ; +: [p+] ( +-addr +-u -- ) $p$ [tag+] ; +: [p+$] ( addr u +-addr +-u -- ) $p$ [tag+$] ; +: [p+$/] ( addr u +-addr +-u -- ) $p$ [tag+$/] ; +: $strong$ ( -- ) s" strong" ; +: [strong] ( -- ) $strong$ [tag] ; +: [/strong] ( -- ) $strong$ [/tag] ; +: [strong/] ( -- ) $strong$ [tag/] ; +: [strong-$] ( addr u -- ) $strong$ [tag-$] ; +: [strong-$/] ( addr u -- ) $strong$ [tag-$/] ; +: [strong+] ( +-addr +-u -- ) $strong$ [tag+] ; +: [strong+$] ( addr u +-addr +-u -- ) $strong$ [tag+$] ; +: [strong+$/] ( addr u +-addr +-u -- ) $strong$ [tag+$/] ; +: $em$ ( -- ) s" em" ; +: [em] ( -- ) $em$ [tag] ; +: [/em] ( -- ) $em$ [/tag] ; +: [em/] ( -- ) $em$ [tag/] ; +: [em-$] ( addr u -- ) $em$ [tag-$] ; +: [em-$/] ( addr u -- ) $em$ [tag-$/] ; +: [em+] ( +-addr +-u -- ) $em$ [tag+] ; +: [em+$] ( addr u +-addr +-u -- ) $em$ [tag+$] ; +: [em+$/] ( addr u +-addr +-u -- ) $em$ [tag+$/] ; +: $ul$ ( -- ) s" ul" ; +: [ul] ( -- ) $ul$ [tag] ; +: [/ul] ( -- ) $ul$ [/tag] ; +: [ul/] ( -- ) $ul$ [tag/] ; +: [ul-$] ( addr u -- ) $ul$ [tag-$] ; +: [ul-$/] ( addr u -- ) $ul$ [tag-$/] ; +: [ul+] ( +-addr +-u -- ) $ul$ [tag+] ; +: [ul+$] ( addr u +-addr +-u -- ) $ul$ [tag+$] ; +: [ul+$/] ( addr u +-addr +-u -- ) $ul$ [tag+$/] ; +: $ol$ ( -- ) s" ol" ; +: [ol] ( -- ) $ol$ [tag] ; +: [/ol] ( -- ) $ol$ [/tag] ; +: [ol/] ( -- ) $ol$ [tag/] ; +: [ol-$] ( addr u -- ) $ol$ [tag-$] ; +: [ol-$/] ( addr u -- ) $ol$ [tag-$/] ; +: [ol+] ( +-addr +-u -- ) $ol$ [tag+] ; +: [ol+$] ( addr u +-addr +-u -- ) $ol$ [tag+$] ; +: [ol+$/] ( addr u +-addr +-u -- ) $ol$ [tag+$/] ; +: $li$ ( -- ) s" li" ; +: [li] ( -- ) $li$ [tag] ; +: [/li] ( -- ) $li$ [/tag] ; +: [li/] ( -- ) $li$ [tag/] ; +: [li-$] ( addr u -- ) $li$ [tag-$] ; +: [li-$/] ( addr u -- ) $li$ [tag-$/] ; +: [li+] ( +-addr +-u -- ) $li$ [tag+] ; +: [li+$] ( addr u +-addr +-u -- ) $li$ [tag+$] ; +: [li+$/] ( addr u +-addr +-u -- ) $li$ [tag+$/] ; +: $dl$ ( -- ) s" dl" ; +: [dl] ( -- ) $dl$ [tag] ; +: [/dl] ( -- ) $dl$ [/tag] ; +: [dl/] ( -- ) $dl$ [tag/] ; +: [dl-$] ( addr u -- ) $dl$ [tag-$] ; +: [dl-$/] ( addr u -- ) $dl$ [tag-$/] ; +: [dl+] ( +-addr +-u -- ) $dl$ [tag+] ; +: [dl+$] ( addr u +-addr +-u -- ) $dl$ [tag+$] ; +: [dl+$/] ( addr u +-addr +-u -- ) $dl$ [tag+$/] ; +: $dt$ ( -- ) s" dt" ; +: [dt] ( -- ) $dt$ [tag] ; +: [/dt] ( -- ) $dt$ [/tag] ; +: [dt/] ( -- ) $dt$ [tag/] ; +: [dt-$] ( addr u -- ) $dt$ [tag-$] ; +: [dt-$/] ( addr u -- ) $dt$ [tag-$/] ; +: [dt+] ( +-addr +-u -- ) $dt$ [tag+] ; +: [dt+$] ( addr u +-addr +-u -- ) $dt$ [tag+$] ; +: [dt+$/] ( addr u +-addr +-u -- ) $dt$ [tag+$/] ; +: $dd$ ( -- ) s" dd" ; +: [dd] ( -- ) $dd$ [tag] ; +: [/dd] ( -- ) $dd$ [/tag] ; +: [dd/] ( -- ) $dd$ [tag/] ; +: [dd-$] ( addr u -- ) $dd$ [tag-$] ; +: [dd-$/] ( addr u -- ) $dd$ [tag-$/] ; +: [dd+] ( +-addr +-u -- ) $dd$ [tag+] ; +: [dd+$] ( addr u +-addr +-u -- ) $dd$ [tag+$] ; +: [dd+$/] ( addr u +-addr +-u -- ) $dd$ [tag+$/] ; +: $table$ ( -- ) s" table" ; +: [table] ( -- ) $table$ [tag] ; +: [/table] ( -- ) $table$ [/tag] ; +: [table/] ( -- ) $table$ [tag/] ; +: [table-$] ( addr u -- ) $table$ [tag-$] ; +: [table-$/] ( addr u -- ) $table$ [tag-$/] ; +: [table+] ( +-addr +-u -- ) $table$ [tag+] ; +: [table+$] ( addr u +-addr +-u -- ) $table$ [tag+$] ; +: [table+$/] ( addr u +-addr +-u -- ) $table$ [tag+$/] ; +: $thead$ ( -- ) s" thead" ; +: [thead] ( -- ) $thead$ [tag] ; +: [/thead] ( -- ) $thead$ [/tag] ; +: [thead/] ( -- ) $thead$ [tag/] ; +: [thead-$] ( addr u -- ) $thead$ [tag-$] ; +: [thead-$/] ( addr u -- ) $thead$ [tag-$/] ; +: [thead+] ( +-addr +-u -- ) $thead$ [tag+] ; +: [thead+$] ( addr u +-addr +-u -- ) $thead$ [tag+$] ; +: [thead+$/] ( addr u +-addr +-u -- ) $thead$ [tag+$/] ; +: $tbody$ ( -- ) s" tbody" ; +: [tbody] ( -- ) $tbody$ [tag] ; +: [/tbody] ( -- ) $tbody$ [/tag] ; +: [tbody/] ( -- ) $tbody$ [tag/] ; +: [tbody-$] ( addr u -- ) $tbody$ [tag-$] ; +: [tbody-$/] ( addr u -- ) $tbody$ [tag-$/] ; +: [tbody+] ( +-addr +-u -- ) $tbody$ [tag+] ; +: [tbody+$] ( addr u +-addr +-u -- ) $tbody$ [tag+$] ; +: [tbody+$/] ( addr u +-addr +-u -- ) $tbody$ [tag+$/] ; +: $tr$ ( -- ) s" tr" ; +: [tr] ( -- ) $tr$ [tag] ; +: [/tr] ( -- ) $tr$ [/tag] ; +: [tr/] ( -- ) $tr$ [tag/] ; +: [tr-$] ( addr u -- ) $tr$ [tag-$] ; +: [tr-$/] ( addr u -- ) $tr$ [tag-$/] ; +: [tr+] ( +-addr +-u -- ) $tr$ [tag+] ; +: [tr+$] ( addr u +-addr +-u -- ) $tr$ [tag+$] ; +: [tr+$/] ( addr u +-addr +-u -- ) $tr$ [tag+$/] ; +: $th$ ( -- ) s" th" ; +: [th] ( -- ) $th$ [tag] ; +: [/th] ( -- ) $th$ [/tag] ; +: [th/] ( -- ) $th$ [tag/] ; +: [th-$] ( addr u -- ) $th$ [tag-$] ; +: [th-$/] ( addr u -- ) $th$ [tag-$/] ; +: [th+] ( +-addr +-u -- ) $th$ [tag+] ; +: [th+$] ( addr u +-addr +-u -- ) $th$ [tag+$] ; +: [th+$/] ( addr u +-addr +-u -- ) $th$ [tag+$/] ; +: $td$ ( -- ) s" td" ; +: [td] ( -- ) $td$ [tag] ; +: [/td] ( -- ) $td$ [/tag] ; +: [td/] ( -- ) $td$ [tag/] ; +: [td-$] ( addr u -- ) $td$ [tag-$] ; +: [td-$/] ( addr u -- ) $td$ [tag-$/] ; +: [td+] ( +-addr +-u -- ) $td$ [tag+] ; +: [td+$] ( addr u +-addr +-u -- ) $td$ [tag+$] ; +: [td+$/] ( addr u +-addr +-u -- ) $td$ [tag+$/] ; +: $a$ ( -- ) s" a" ; +: [a] ( -- ) $a$ [tag] ; +: [/a] ( -- ) $a$ [/tag] ; +: [a/] ( -- ) $a$ [tag/] ; +: [a-$] ( addr u -- ) $a$ [tag-$] ; +: [a-$/] ( addr u -- ) $a$ [tag-$/] ; +: [a+] ( +-addr +-u -- ) $a$ [tag+] ; +: [a+$] ( addr u +-addr +-u -- ) $a$ [tag+$] ; +: [a+$/] ( addr u +-addr +-u -- ) $a$ [tag+$/] ; diff --git a/lcstr.fs b/lcstr.fs new file mode 100755 index 0000000..2958052 --- /dev/null +++ b/lcstr.fs @@ -0,0 +1,62 @@ +\ lcstr.fs -- Long counted string data type +\ 2016 David Meyer +JMJ + +\ Long counted strings (lcstr) are similar to standard counted strings, except +\ that the string length is stored as an unsigned single-precision integer (4 +\ bytes) instead of a character (which limits standard counted strings to 255 +\ character maximum length). Long counted sting maximum length is +\ 256^4-1 bytes subject to the limit of heap space allocation. + +\ Stack effects, variables, etc. representing long counted strings will +\ conventionally start with "L", addresses of long counted strings with "L-". + +: lcount ( l-str -- c-str u ) +\g Extract pointer C-STR and length U of lcstr L-STR + dup 1 cells + swap @ ; + +: ltype ( l-str -- ) +\g Output lcstr to standard output + lcount type ; + +: lalloc ( c-str u -- l-str ) +\g Allocate heap space for lcstr version of string C-STR,U + dup chars 1 cells + allocate if ( a-str u l-str) + drop 2drop 0 \ Returns pointer 0 for alloc. error + else + 2dup ! dup >r 1 cells + swap cmove r> + then +; + +: clalloc ( c-str -- l-str ) +\g Allocate heap space and convery counted string for C-STR tp lcstr + count lalloc ; + +: $catcpy { a-str1 u1 a-str2 u2 a-cat ucat -- } +\g Copy characters from STR1 and STR2 to pre-allocated CAT + a-str1 a-cat u1 cmove + a-str2 a-cat u1 chars + u2 cmove +; + +: c$cat ( c-str1 c-str2 -- c-cat ) +\g Concatenate two counted strings in heap, preserve original strings + count dup >r rot count dup >r 2swap ( a-str1 u1 a-str2 u2 R: u2 u1 ) + r> r> + dup 1+ chars allocate if ( a-str1 u1 a-str2 u2 ucat c-cat ) + clearstack 0 \ Returns 0 c-pointer for alloc. error + else + tuck c! ( a-str1 u1 a-str2 u2 c-cat ) + dup >r count $catcpy r> + then +; + +: c$catx ( c-str1 c-str2 ux -- c-cat ) +\g Concatenate two counted strings in heap, recycle original strings according to UX: 0 -- recycle STR1 and STR2, 1 -- recycle STR1 only, 2 -- recycle STR2 only + >r 2dup c$cat r> ( c-str1 c-str2 c-cat ux ) + dup 2 = if + drop swap free drop nip + else dup 1 = if + drop nip swap free drop + else 0= if + swap free drop + swap free drop + then then then +; diff --git a/length-units.xls b/length-units.xls new file mode 100755 index 0000000..5515c83 Binary files /dev/null and b/length-units.xls differ diff --git a/level-0.org b/level-0.org new file mode 100755 index 0000000..7d569a5 --- /dev/null +++ b/level-0.org @@ -0,0 +1,8 @@ +Forth Level 0 Functions + +dup drop swap over + - * / /mod min max = and or xor negate abs not +*/ decimal hex octal . n .r cr emit key : ; create , allot if else +then for next i + +From: Glen B. Haydon. Levels of +Forth. diff --git a/lf.4th b/lf.4th new file mode 100755 index 0000000..57be761 --- /dev/null +++ b/lf.4th @@ -0,0 +1,1764 @@ +\ lf v0.0.12f 06 August 2002 + +\ Leo Wong +\ hello@albany.net +\ http://www.albany.net/~hello/ + +\ I thank Wil Baden, Anton Ertl, Marcel Hendrix, +\ Benjamin Hoyt, Chris Jakeman, Bruce R. McFarling, +\ Barrie Stott, and Jonah Thomas for their help. + +\ I am grateful to Chris Jakeman for pointing out +\ and correcting several mistakes. + +\ LF is an NPBP (not pretty but portable) ANS Forth +\ word processor. + +\ Portable means: designed to work in any ANS Forth +\ ("Standard") system that implements, can define, or can +\ provide the functionality of the ANS Forth words that LF +\ uses (see below for a list of these words). LF has a few +\ environmental dependencies that could be gotten rid of. + +\ See also below the CONSTANTs that may need to be changed +\ for LF to work optimally on your system. + +\ I have tested the NP part of LF. LF could easily become +\ quite comely though still austere. I await word on the BP +\ part. Please tell me if LF works or doesn't work on your +\ ANS Forth system. + +\ I would also appreciate being notified of any bugs you find. + + +\ To start LF, load a Standard System, then enter: +\ +\ INCLUDE LF.4TH ( S" LF.F" INCLUDED) +\ +\ Enter a filename. You are now in text-entry mode. Enter +\ some text or press: +\ +\ `` +\ +\ that is, two single opening quotations marks, or glottal +\ stops, or left hands clapping to enter Command Mode. In +\ Command Mode, press: +\ +\ q +\ +\ to query the help screen. +\ +\ The Enter, Backspace, and Tab keys work in both text-entry +\ and command modes. + +\ I have not provided a printing function, not knowing how to +\ do so portably. I've provided some words to try if you can +\ teach your ANS Forth to print. + + +\ ANS Forth Documentation +\ +\ LF uses ANS Forth words from the Core word set. +\ +\ LF also uses words from other word sets. Though "required" +\ by LF, many of these words don't need to be in your Forth +\ system: they can be easily defined or their functionality +\ can be provided by other words. I believe that the only +\ real requirements are the Core word set and the abilities to +\ position the cursor and to read and write to mass storage. +\ +\ Having said this, I say that: +\ +\ LF is an ANS Forth Program +\ +\ With environmental dependencies: +\ will respond to control characters 8, 9, and 13 though +\ the ability to receive control characters is not required +\ may be configured to send control character 7. +\ uses flags as arithmetic operands (I think it does) +\ uses two's complement arithmetic (maybe - I hope not) +\ +\ Requiring from the Core Extensions word set: +\ 2>R 2R> <> ?DO CASE ENDCASE ENDOF ERASE FALSE MARKER +\ NIP OF PAD TO TRUE TUCK U.R UNUSED VALUE WITHIN \ +\ +\ Requiring from the Facility word set: +\ AT-XY PAGE +\ +\ Requiring from the File-Access word set: +\ ( BIN CREATE-FILE FILE-SIZE INCLUDED OPEN-FILE +\ R/O READ-FILE S" W/O WRITE-FILE +\ +\ Requiring from the String word set: +\ -TRAILING BLANK CMOVE CMOVE> SEARCH +\ +\ Requiring the Memory-Allocation word set (if ALLOCATEing): +\ ALLOCATE FREE +\ +\ +\ LF requires keyboard input, the ability to position +\ the cursor, and access to mass storage in the form of +\ files. +\ +\ +\ A Standard System exists after LF is loaded. + +\ =================================================== +\ Notes (by Krishna Myneni, 2002-09-06): +\ +\ -- Line numbering may be turned off/on by setting the +\ constant LINE#-SPACE. Here, line numbers are turned off +\ by default. +\ +\ -- The page length may be changed by setting the constant +\ MAX-Y. Here it is set to the original default of 23, +\ but I prefer to use a full page length (54 for MAX-Y). +\ Longer page lengths may be used in ANSI consoles with +\ a sufficient number of rows, for example a BASH shell +\ under X-Windows that has been resized to accomodate +\ the full text display. The cursor position will be +\ incorrect if the console does not support enough output +\ lines. MAX-Y of 23 should work on any console. +\ +\ -- The constant 'CR has been changed from decimal 13 to 10, +\ since the LF character represents an end of line under +\ UNIX systems. +\ +\ -- The constant EDIT-BUF-SIZE is 1 MB, suitable for most +\ day to day usage. Increase/decrease as desired. +\ +\ =================================================== +\ Code modifications for the kForth version (KM 2002-08-13): +\ +\ 1. Changed >FILE to BUF>FILE and FILE> to FILE>BUF. +\ 2. Modified BUF>FILE test for WRITE-FILE result. +\ 3. Recoded -TRAILING<> to remove WHILE ... THEN structure. +\ 4. Changed READ to READ-DOC and ?READ to ?READ-DOC. +\ 5. Changed CALL to CALL-WAY. +\ 6. VALUEs which are addresses have been changed to "ptr"s +\ 7. Remove use of HERE and "," and replace with equivalent code. +\ 8. Replaced ?DE-ALLOCATE and DO-ALLOCATE with dummy definitions. +\ 9. TEXT buffer is CREATEd and ALLOTed initially. +\ +\ =============== kForth requires =================== +\ include ans-words +\ include strings +\ include ansi +\ include files \ include filesw under Windows + +\ : ptr CREATE 1 CELLS ?ALLOT ! DOES> a@ ; +\ : BIN ; +\ ANS compliant defn of >NUMBER is now part of ans-words.4th (km 2003-3-9) + +\ ============== end of kForth requires ============ + + +\ Here begins the source code for LF: + +1024 1024 * CONSTANT EDIT-BUF-SIZE +CREATE EDIT-BUF EDIT-BUF-SIZE ALLOT + +( MARKER TASK ) + + +: K* ( n1 -- n2 ) 1024 * ; + + +\ adjust constants as needed + +\ filename delimiters +CHAR / CONSTANT PATH-DELIMITER +CHAR : CONSTANT DRIVE-DELIMITER + +\ using ALLOCATE ? +FALSE CONSTANT ALLOCATING +128 CONSTANT DEFAULT-ALLOCATE \ in K + +\ beeps? +TRUE CONSTANT BEEPS + +\ tab, linewidth + 5 CONSTANT TABWIDTH +12 CONSTANT TABS/LINE +TABWIDTH TABS/LINE * CONSTANT LINEWIDTH \ multiple makes easy + 2 CONSTANT LEDGE \ room for spaces beyond linewidth +LINEWIDTH LEDGE + CONSTANT PLANK + +\ a cut or copy goes to memory if it fits, +\ otherwise to a file +2 K* CONSTANT POCKET-SIZE + +\ left margin holds line number +\ the start of a page is shown to the right of the line +( 6) 0 CONSTANT LINE#-SPACE \ 0 if not displaying +5 CONSTANT PAGE#-SPACE \ 0 if not displaying + +\ screen display +LINEWIDTH + LINE#-SPACE + + PAGE#-SPACE LEDGE MAX + + CONSTANT MAX-X \ # of columns +( 23) ( 54) 40 CONSTANT MAX-Y \ # of rows +MAX-X 16 - CONSTANT MAX-INPUT \ reserves space for a prompt + +\ screen/page +0 CONSTANT BANNER-LINE +2 CONSTANT TOP \ line 1 has a ruler +MAX-Y 1- CONSTANT STATUS-LINE \ display status below text +STATUS-LINE TOP - 1- CONSTANT LMAX/SCREEN \ text lines to show +TOP LMAX/SCREEN + 1- CONSTANT BOTTOM \ last line to show text + +\ displayable characters are implementation defined +126 CONSTANT LAST-DISPLAYABLE +\ this from Marcel Hendrix +\ TRUE PAD ! PAD C@ CONSTANT LAST-DISPLAYABLE + +\ characters for displaying "invisibles" +CHAR _ CONSTANT .BL \ BL +CHAR | CONSTANT .CR \ CR +CHAR ^ CONSTANT .OTHER \ e.g. LF ! + +\ keyboard entry + +\ ASCII characters used in command mode +\ command mode provides all the functions +\ that LF implements + +\ two of these start, one ends command mode +\ consider using ESCape once if it's available +\ Bruce R. McFarling recommends having a character for +\ starting and a different character for ending command mode +CHAR ` CONSTANT ^COMMAND + +\ command keys +CHAR F CONSTANT ^Find-string +CHAR G CONSTANT ^find-aGain +CHAR R CONSTANT ^Replace +CHAR T CONSTANT ^replace-Too + +CHAR " CONSTANT ^(un)mark(1) +CHAR ' CONSTANT ^(un)mark(2) + +CHAR C CONSTANT ^Copy +CHAR D CONSTANT ^Delete +CHAR E CONSTANT ^Embed +CHAR W CONSTANT ^Wedge + +CHAR V CONSTANT ^inVest + +CHAR Q CONSTANT ^Query +CHAR A CONSTANT ^Alter-input +CHAR Z CONSTANT ^Show + +CHAR X CONSTANT ^change-name + +CHAR S CONSTANT ^Save + +CHAR B CONSTANT ^good-Bye + +\ next 6 aren't shown in the help screen +\ I don't expect them to be used but they would +\ eliminate the environmental dependency on the use of +\ control codes (if you silence BEEP) +CHAR | CONSTANT -Enter-key(1) +CHAR \ CONSTANT -Enter-key(2) +CHAR _ CONSTANT -Backspace-key(1) +CHAR - CONSTANT -Backspace-key(2) +CHAR @ CONSTANT -Tab-key(1) +CHAR 2 CONSTANT -Tab-key(2) + +\ cursor keys +CHAR L CONSTANT ^right +CHAR J CONSTANT ^left +CHAR I CONSTANT ^up +CHAR K CONSTANT ^down(1) +CHAR < CONSTANT ^down(2) +CHAR , CONSTANT ^down(3) +CHAR H CONSTANT ^1st-col +CHAR : CONSTANT ^last-col(1) +CHAR ; CONSTANT ^last-col(2) +CHAR O CONSTANT ^page-up +CHAR > CONSTANT ^page-down(1) +CHAR . CONSTANT ^page-down(2) +CHAR U CONSTANT ^BOF +CHAR M CONSTANT ^EOF +CHAR P CONSTANT ^TOP +CHAR ? CONSTANT ^BOP(1) +CHAR / CONSTANT ^BOP(2) + +\ ASCII control characters +\ use of control characters is an environmental dependency + 7 CONSTANT BEL \ bell +\ 8 CONSTANT BS \ backspace +127 CONSTANT BS \ backspace on Linux/KDE system + 9 CONSTANT HT \ horizontal tab +\ 10 CONSTANT LF \ LF doesn't know LF +\ 12 CONSTANT FF \ formfeed for printing +\ 13 CONSTANT 'CR \ Enter (also marks end of a paragraph) +10 CONSTANT 'CR \ use LF for EOL on Unix systems + +\ in-key +\ would be nice to have DEFER and IS +\ 0 ptr (IN-KEY) \ changed from VALUE to ptr -- km 8-11-02 +0 VALUE (IN-KEY) +: IN-KEY ( -- u flag ) (IN-KEY) EXECUTE ; + +\ Jonah Thomas: +\ Here is something that should work on standard systems: +\ +\ : NO-GOOD ." bad DEFERed word" ABORT ; +\ : DEFER +\ CREATE ['] NO-GOOD , +\ DOES> @ EXECUTE ; +\ +\ : (IS) ( xt -- ) +\ ' >BODY ! ; +\ : [IS] ( -- ) +\ ' >BODY POSTPONE LITERAL POSTPONE ! ; IMMEDIATE +\ : IS ( S: xt -- ) ( C: -- ) +\ STATE @ IF POSTPONE [IS] ELSE (IS) THEN ; IMMEDIATE + +\ KEY is a Core word +: KEY-CHAR ( -- char true) KEY TRUE ; + +' KEY-CHAR TO (IN-KEY) + +\ if your system supports it, and you want to, add +\ more keys (such as actual cursor keys) and use +\ EKEY instead of KEY : +\ : EVENT ( -- u flag ) EKEY EKEY>CHAR ; +\ +\ ' EVENT TO (IN-KEY) + + +\ PAD space +84 CONSTANT PAD-SPACE \ region guaranteed by PAD + +\ search pad +\ LF uses PAD +PAD-SPACE CONSTANT GULP \ #characters in search space +: SEARCH-PAD ( -- ) PAD ; + +\ constants for printing + + +50 CONSTANT LINES/PAGE \ printed page +\ 11 CONSTANT PMARGIN \ left margin for printing + + +\ tools +\ some of these may already exist in your ANS Forth + +\ do nothing +: NOP ; + +\ number of cells/characters in n1 address units +1 CELLS CONSTANT /CELL +1 CHARS CONSTANT /CHAR + +\ stack manipulation +\ : -ROT ( x1 x2 x3 -- x3 x1 x2 ) ROT ROT ; + +\ unsigned max and min +: UMAX ( u1 u2 -- u1|u2 ) 2DUP U< IF NIP ELSE DROP THEN ; +: UMIN ( u1 u2 -- u1|u2 ) 2DUP U< IF DROP ELSE NIP THEN ; + +\ increment/decrement variable +: INCR ( a -- ) 1 SWAP +! ; +: DECR ( a -- ) -1 SWAP +! ; + +\ add stack items +: UNDER+ ( n1 n2 n3 -- n1+n3 n2 ) ROT + SWAP ; + +\ unsigned division +: U/MOD ( u1 u2 -- r q) >R 1 UM* R> UM/MOD ; +: U/ ( u1 u2 -- q ) U/MOD NIP ; + +\ fences +: BETWEEN ( n1 n2 n3 -- f) 1+ WITHIN ; +: CLAMP ( n1 lo hi - n2) ROT MIN MAX ; + +\ warnings +' NOP VALUE (BEEP) +: ?BEEP ( -- ) (BEEP) EXECUTE ; +: BEEP ( -- ) BEL EMIT ; +: DEEP ( n) DROP ?BEEP ; +: ?BEEPS ( -- ) + BEEPS + IF ['] BEEP + ELSE ['] NOP + THEN TO (BEEP) ; +: WAIT ( -- ) ." Press a key to continue." IN-KEY 2DROP ; + +\ string words + +\ Is character between A and Z? +: UPPER? ( c -- ? ) [CHAR] A - 26 U< ; + +\ Is character between a and z? +: lower? ( c -- ? ) [CHAR] a - 26 U< ; + +\ make a character lower/upper case +: >lower ( C -- c) DUP UPPER? BL AND XOR ; +: >UPPER ( c -- C) DUP lower? BL AND XOR ; + +\ make a string lower case +: lcase ( a u -- ) + 0 ?DO DUP C@ >lower OVER C! CHAR+ LOOP DROP ; + +\ string less the number of trailing characters <> c + +: -TRAILING<> \ a u1 c -- a u2 + >R + BEGIN DUP + IF 1- 2DUP CHARS + C@ R@ = ELSE 1- TRUE THEN + UNTIL 1+ + R> DROP ; + + +\ string after last character = c +: TRAILING<> ( a1 u1 c -- a2 u2 ) + OVER >R -TRAILING<> + R> SWAP /STRING ; + +\ leading characters = c +: LEADING= ( a u1 c -- a u2 ) + >R 2DUP + BEGIN OVER C@ R@ = OVER AND + WHILE 1 /STRING + REPEAT + R> DROP + NIP - ; + +\ string less leading characters <> c +: -LEADING<> ( a1 u1 c -- a2 u2 ) + >R BEGIN OVER C@ R@ <> OVER AND + WHILE 1 /STRING + REPEAT + R> DROP ; + +\ string arithmetic +: C+! ( n a -- ) DUP C@ UNDER+ C! ; +: S+! ( a u s -- ) + 2DUP 2>R + COUNT CHARS + SWAP CMOVE + 2R> C+! ; + +\ move a counted string +: SMOVE ( s1 s2 -- ) OVER C@ 1+ CMOVE ; + +\ vectored execution + +VARIABLE way# +: CALL-WAY ( a n -- ? ) CELLS + a@ EXECUTE ; +: WAYS + CREATE ( n -- ) DUP CELLS ?allot SWAP + 0 DO DUP ' SWAP ! /CELL + LOOP DROP + DOES> way# @ CALL-WAY ; + +\ at most one file is open at a time +\ some error recovery could be introduced here +0 VALUE FILE-ID + +\ create a file for writing +: CREATE-WRITE ( a u -- ) + W/O BIN CREATE-FILE + ABORT" CREATE-FILE problem" TO FILE-ID ; + +\ open a file for reading only +: OPEN-READ ( a u - fileid flag ) + R/O BIN OPEN-FILE ; + +\ close an opened file +: FCLOSE ( -- ) + FILE-ID CLOSE-FILE + ABORT" CLOSE-FILE problem" ; + +\ write u characters starting at a , then close the file +: BUF>FILE ( a u -- ) + FILE-ID WRITE-FILE + 0< ABORT" WRITE-FILE problem" + FCLOSE ; + +\ read u chars to a , then close the file +: FILE>BUF ( a u -- ) FILE-ID READ-FILE + ABORT" READ-FILE problem" DROP + FCLOSE ; + + +\ data structures + +\ chars and lines +\ actual values determined later +0 VALUE TEXT \ start of text area +0 VALUE CMAX \ max # of characters +0 VALUE LINES \ start of lines data +0 VALUE LMAX \ max # of lines + +CREATE POCKET POCKET-SIZE CHARS ALLOT \ cut/copy buffer +CREATE FILENAME$ MAX-INPUT 6 + CHARS ALLOT \ filename string + +CREATE CURSOR> 2 CELLS ?ALLOT 0 0 ROT 2! ( 0 , 0 ,) \ cursor position + + +\ document +VARIABLE doc-size \ size of document +VARIABLE last-line \ last line of document +VARIABLE last-old \ previous last line +VARIABLE char-now \ current character # +VARIABLE topline \ current top screen line +VARIABLE top-old \ previous top screen line +VARIABLE line-now \ current line +VARIABLE line-old \ previous current line +VARIABLE col# \ current column + +\ before the last character? +: -DOC-END ( -- f) char-now @ doc-size @ U< ; + +\ room to add u characters? +: ROOM? ( u -- f) doc-size @ + CMAX 1+ U< ; + + +\ lines + +\ address of nth element of line array +: LINE ( l# - a) CELLS LINES + ; + +\ starting character # and length of a line +: LINESPEC ( l# - c# u) LINE 2@ TUCK - ; + +\ number of characters in a line +: LINELENGTH ( l# - u) LINESPEC NIP ; + +\ zero line data between line#1 and line#2 +: 0LINES ( l#1 l#2) + OVER - 1+ 0 MAX >R LINE R> CELLS ERASE ; + +\ zero all line information +: 0>LMAX ( -- ) 0 LMAX 0LINES ; + +\ add u to lines between current line and last line +: LINES+! ( u -- ) + line-now @ 1+ DUP LINE SWAP + last-line @ SWAP - 1+ 0 MAX + 0 ?DO 2DUP +! CELL+ LOOP 2DROP ; + +\ move lines data starting with l# forward one cell +: LINES> ( l# -- ) + DUP LINE DUP CELL+ + ROT last-line @ 1+ DUP last-line ! + SWAP - CELLS 0 MAX MOVE ; + +\ move lines data starting with l#+1 back one cell +: L ( c# l#1 -- l#2 ) + OVER doc-size @ U< 0= + IF 2DROP last-line @ + ELSE OVER + IF 1- LINE + BEGIN CELL+ 2DUP @ U< UNTIL + NIP LINES - /CELL / 1- + ELSE DROP + THEN + THEN ; + +\ find screen row of line +: >Y ( l# -- row#) topline @ - TOP + ; + +\ find bottom line of screen +: BOTTOMLINE ( -- u ) topline @ LMAX/SCREEN + 1- ; + + +\ allocate / allot memory + +\ allocate memory +0 VALUE ALLOCATED + +\ GET-NUMBER from Woehr, Forth: the New Model +: GET-NUMBER ( -- ud f ) + 0 0 + PAD 84 BLANK + PAD 84 ACCEPT + PAD SWAP -TRAILING + >NUMBER NIP 0= ; + +\ get a number +: GET-INTEGER ( -- u ) + GET-NUMBER DROP D>S ; + +( ============================================================= + +\ release previously allocated memory +: ?DE-ALLOCATE \ -- + ALLOCATED + IF LINES FREE ABORT" FREE problem" 0 TO ALLOCATED THEN ; + +\ allocate memory from user input + +: DO-ALLOCATE \ -- + PAGE 10 10 AT-XY + ." Reserve space for how many characters [K]:" + GET-INTEGER + ?DUP 0= IF DEFAULT-ALLOCATE THEN + K* DUP LINEWIDTH 2/ U/ 1+ + 2DUP CELLS DUP + ROT CHARS + + DUP ALLOCATE + ABORT" ALLOCATE problem. Not enough memory?" + DUP TO LINES + ROT + TO TEXT + TO ALLOCATED + 1- TO LMAX + TO CMAX ; + +\ allot memory +: DO-ALLOT + CMAX 0= + IF UNUSED + 4 K* CELLS - \ breathing room - could be less? + LINEWIDTH 2/ CHARS /CELL + U/ + DUP 1- TO LMAX + DUP HERE TO LINES CELLS ALLOT \ allot cells first + LINEWIDTH 2/ * + DUP TO CMAX HERE TO TEXT CHARS ALLOT + THEN ; +=========================================================== ) + +: ?DE-ALLOCATE ; +: DO-ALLOCATE ; + +: DO-ALLOT + CMAX 0= + IF EDIT-BUF-SIZE + 4 K* CELLS - \ breathing room - could be less? + LINEWIDTH 2/ CHARS /CELL + U/ + DUP 1- TO LMAX + EDIT-BUF TO LINES \ allot cells first + DUP EDIT-BUF + TO TEXT + LINEWIDTH 2/ * + TO CMAX + THEN ; + +\ character<-->memory +: SPOT ( -- a ) TEXT char-now @ CHARS + ; +: T>MEM ( c# u -- a u ) >R CHARS TEXT + R> ; + + +\ screen display + +\ blank a screen line +: RUB ( row -- ) + 0 SWAP + 2DUP AT-XY MAX-X LEDGE + SPACES AT-XY ; + +\ display a tab section in a ruler line +: .TAB ( -- ) + TABWIDTH 1- 0 MAX 0 ?DO [CHAR] - EMIT LOOP + [CHAR] | EMIT ; + +\ display a ruler line +: .RULER ( row -- ) + 0 SWAP AT-XY + LINE#-SPACE IF ." Line " THEN + [CHAR] | EMIT LINEWIDTH TABWIDTH / 0 ?DO .TAB LOOP + PAGE#-SPACE IF ." Page" THEN ; + +\ display top and bottom rulers +: .RULERS ( -- ) + TOP 1- DUP RUB .RULER + BOTTOM 1+ DUP RUB .RULER ; + +\ display current way of input +: .INSERT ( -- ) ." INSERT " ; +: .OVERWRITE ( -- ) ." OVERWRITE " ; +: .MARKING ( -- ) ." MARKING " ; + +' NOP VALUE (.WAY) +: .WAY ( -- ) (.WAY) EXECUTE ; + +FALSE VALUE COMMANDING \ false = text entry mode + +\ delete path from filename +: -PATH ( a1 u1 -- a2 u2 ) + PATH-DELIMITER TRAILING<> DRIVE-DELIMITER TRAILING<> ; + +\ display filename +: .FILENAME ( -- ) + FILENAME$ COUNT -PATH TYPE SPACE ; + +\ display filename, way, mode +: .HEADLINE ( a u -- ) + BANNER-LINE RUB + .FILENAME .WAY 2 SPACES + TYPE 2 SPACES ; + +\ headline when entering text +: .TEXT-ENTRY ( -- ) + S" TEXT ENTRY" .HEADLINE + ^COMMAND DUP EMIT EMIT SPACE ^Query EMIT SPACE + ." for help" ; + +\ headline when commanding +: .COMMANDING ( -- ) + S" COMMANDING" .HEADLINE + ^Query EMIT SPACE ." to query help" ; + +\ display the headline +: BANNER ( -- ) + COMMANDING + IF .COMMANDING ELSE .TEXT-ENTRY THEN ; + +\ display screen before displaying the document +: .SCREEN ( -- ) + PAGE + BANNER .RULERS LINE#-SPACE TOP AT-XY ; + + +\ document display +BL VALUE "bl" \ to EMIT BL +BL VALUE "cr" \ to EMIT 'CR +BL VALUE "other" \ to EMIT other "invisible" character + +\ 32 displays as "bl" , 13 displays as "cr" +: "INVISIBLE" ( c1 -- c2 ) + CASE + BL OF "bl" ENDOF + 'CR OF "cr" ENDOF + "other" + SWAP + ENDCASE ; +: ?DISPLAY ( c1 -- c2) + DUP BL 1+ < + IF "INVISIBLE" THEN ; + +\ toggle visible and invisible "bl" AND "cr" +: ~DISPLAY ( -- ) + "cr" BL <> + IF BL TO "bl" BL TO "cr" BL TO "other" + ELSE .BL TO "bl" .CR TO "cr" .OTHER TO "other" + THEN + -1 top-old ! ; + +\ "highlighting" +' NOP VALUE (?MARK) +: ?MARK ( c1 -- c2 ) (?MARK) EXECUTE ; + +\ erasers +\ keep current line in screen within n lines of top +: AIM ( c# n -- ) + >R 0 C>L DUP line-now ! + R> - 0 MAX topline ! ; + +\ erase to end of line +: EraseEOL ( col -- ) + PLANK SWAP - SPACES ; + +\ erase to end of text area +: EraseEOS ( -- ) + BOTTOM last-line @ >Y - 0 MAX + 0 ?DO MAX-X SPACES CR LOOP ; + +\ display text line +: LTYPE ( c# u -- ) + TUCK T>MEM + 0 ?DO COUNT ?DISPLAY ?MARK EMIT LOOP DROP + EraseEOL ; + +\ much faster ltype by Marcel Hendrix: +\ LINEWIDTH LEDGE + CONSTANT C/L +\ 0 VALUE cnt +\ CREATE lbuff 128 CHARS ALLOT +\ : LTYPE ( c# u -- ) +\ 0 TO cnt +\ TUCK T>MEM +\ 0 ?DO +\ COUNT ?DISPLAY ?MARK +\ lbuff cnt + C! 1 +TO cnt ( or: cnt 1+ TO cnt ) +\ LOOP DROP ( u) +\ lbuff cnt C/L 1- MIN TYPE +\ ( u) EraseEOL ; + +\ line and page numbers +' NOP VALUE (.LINE#) +' NOP VALUE (.PAGE#) +: ?LINE# ( -- ) (.LINE#) EXECUTE ; +: ?PAGE# ( -- ) (.PAGE#) EXECUTE ; + +\ display line number +: <.LINE#> ( l# -- l#) DUP 1+ 5 U.R SPACE ; + +\ calculate page number +: PAGE-LINE ( l# -- p# n ) LINES/PAGE /MOD 1+ SWAP ; + +\ if first line of a page, display the page number +: <.PAGE#> ( l# -- l# ) + DUP PAGE-LINE + IF DROP 3 SPACES ELSE 3 U.R THEN ; + +\ display line and page numbers? +: ?MARGIN ( -- ) + LINE#-SPACE IF ['] <.LINE#> TO (.LINE#) THEN + PAGE#-SPACE IF ['] <.PAGE#> TO (.PAGE#) THEN ; + +\ display line#, line, page# +: .TLINE ( l# l# -- l# ) + ?LINE# + LINESPEC LTYPE + ?PAGE# + CR ; + +\ which lines to display +VARIABLE .start \ first +VARIABLE .end \ last +VARIABLE .mend \ override .end + +\ display some lines of text +: .TLINES ( -- ) + .start @ topline @ MAX 0 OVER >Y AT-XY + .end @ .mend @ MAX last-line @ MIN BOTTOMLINE MIN + OVER - 1+ + 0 ?DO DUP .TLINE 1+ LOOP DROP + top-old @ topline @ U< last-line @ last-old @ U< OR + last-line @ BOTTOMLINE U< AND + IF 0 last-line @ topline @ - 1+ TOP + AT-XY + EraseEOS + THEN ; + + +\ formatting +FALSE VALUE FORMAT-ALL \ true = format the entire document +FALSE VALUE SAME \ true if line data hasn't changed +VARIABLE line# \ line being formatted + +\ 'CR a special case +: CReturn ( a -- ) + line# @ TUCK 1+ LINE @ 2DUP <> + IF U< IF LINES> ELSE \ look for first CR + IF NIP SWAP - 1+ + + DUP CReturn DUP LINE! \ end of paragraph + ELSE DROP DUP LINEWIDTH > \ else need to wrap? + IF OVER LINEWIDTH+ \ allow 1+ column for BL + BL -TRAILING<> ?DUP \ break on last BL + IF DUP LINEWIDTH+ = \ at extra column? + IF 2SWAP \ ( c# a u2 a u1 ) + LINEWIDTH+ /STRING \ rest of LEDGE + BL LEADING= NIP + \ add its leading BLs + ELSE 2SWAP 2DROP \ else dump plank + THEN NIP \ ( c# u ) + ELSE DROP 2DROP LINEWIDTH \ no BLs + THEN + DUP LINE! \ ( c# ) + ELSE NIP + \ no need to wrap + THEN + THEN ; + +\ clean-up after formatting +: DEJA? ( -- ) + SAME + IF last-line DUP @ line# @ 1- MAX SWAP ! + doc-size @ last-line @ 1+ LINE ! + ELSE last-line @ 1+ line# @ DUP last-line ! DUP .end ! + 1+ doc-size @ OVER LINE ! 1+ SWAP 0LINES + THEN ; + +\ the f word +: FORMAT ( -- ) + FALSE TO SAME line-now @ 1- 0 MAX DUP line# ! + LINE @ + BEGIN DUP DUP PLANK + doc-size @ UMIN + OVER - T>MEM WRAP + DUP doc-size @ = SAME OR + UNTIL DROP DEJA? ; + + +\ moving around in the document + +\ cursor right +: RIGHT ( -- ) + -DOC-END + IF char-now INCR ELSE ?BEEP THEN ; + +\ cursor left +: LEFT ( -- ) + char-now @ + IF char-now DECR ELSE ?BEEP THEN ; + +\ calculate the column of the current character +: CPLACE ( -- col# ) char-now @ line-now @ LINE @ - ; + +\ calculate where to place the cursor in a line +: >char-now ( cplace l# -- ) + LINESPEC ROT 2DUP U< + IF DROP 1- 0 MAX ELSE NIP THEN + char-now ! ; + +\ cursor up +: UP ( -- ) + line-now @ + IF CPLACE line-now DUP DECR @ >char-now + ELSE ?BEEP THEN ; + +\ cursor down +: DOWN ( -- ) + line-now @ last-line @ U< + IF CPLACE line-now DUP INCR @ >char-now + ELSE ?BEEP THEN ; + + +\ text pushes and pulls + +\ number of characters to the end of the document +: #>END ( a -- u ) TEXT - /CHAR U/ doc-size @ SWAP - ; + +\ suture text separated by u chars +: JOIN ( u -- ) CHARS SPOT DUP UNDER+ OVER #>END CMOVE ; + +\ prepare to delete u characters +: <#SLIDE ( u -- ) + doc-size @ + IF DUP JOIN NEGATE doc-size +! ELSE DEEP THEN ; + +\ prepare to delete character +: END CMOVE> ; + +\ prepare to insert u characters +: #SLIDE> ( u -- ) + DUP ROOM? + IF DUP SPLIT doc-size +! ELSE DEEP THEN ; + +\ prepare to insert character +: SLIDE> ( -- ) 1 #SLIDE> 1 LINES+! ; + + +\ text input + +0 VALUE PREVIOUS-KEY \ two keys need to enter command mode +0 VALUE VANQUISHED \ text character overwritten by ^command character + +\ put character into the document +: OVERWRITE ( c -- ) + char-now @ CMAX U< line-now @ LMAX U< AND + IF + SPOT C@ -DOC-END AND + PREVIOUS-KEY ^COMMAND <> AND TO VANQUISHED + SPOT C! doc-size DUP @ char-now DUP INCR @ UMAX SWAP ! + FORMAT + ELSE DEEP THEN ; + +\ insert character into the document +: INSERT ( c -- ) + 1 ROOM? last-line @ LMAX U< AND + line-now @ LMAX 1- U< AND + IF -DOC-END IF SLIDE> THEN OVERWRITE + ELSE DEEP THEN ; + +\ delete character +: DELETE ( -- ) + -DOC-END + IF IF PARAGRAPH ELSE ?BEEP THEN THEN ; + + +\ Tab +CREATE TAB$ TABWIDTH DUP CHARS ?ALLOT SWAP BLANK + +\ #cols to next tab mark +: NEXT-TAB ( -- n ) + TABWIDTH col# @ TABWIDTH MOD - ; + +\ tab while inserting +\ will sometimes fall short of the first tab mark but +\ but will go to it with the next tab +: NUDGE ( -- ) + NEXT-TAB + DUP ROOM? + IF DUP >R #SLIDE> TAB$ SPOT R@ CMOVE + R> DUP LINES+! char-now +! FORMAT + ELSE DEEP THEN ; + +\ tab while overwriting +: HOP ( -- ) + -DOC-END + IF NEXT-TAB + char-now @ + + line-now @ 1+ LINE @ MIN + doc-size @ 1+ UMIN char-now ! + ELSE NUDGE THEN ; + + +\ jumps + +\ keep jumped to line within document +: CONFINE ( l1 -- l2 ) 0 last-line @ CLAMP ; + +\ jump n lines +: JUMP ( n -- ) + DUP topline @ + CONFINE topline ! + CPLACE SWAP line-now @ + CONFINE + DUP line-now ! >char-now ; + +\ jump down +: +JUMP ( u -- ) + line-now @ last-line @ = + IF DEEP ELSE JUMP THEN ; + +\ jump up +: -JUMP ( u -- ) + line-now @ 0= + IF DEEP ELSE NEGATE JUMP THEN ; + +\ jump to the beginning of the line +: ( -- ) + line-now @ + DUP 1+ LINE @ 1- + SWAP last-line @ = 1 AND + char-now ! ; + +\ jump up one screen +: PAGE-UP ( -- ) LMAX/SCREEN -JUMP ; + +\ jump down one screen +: PAGE-DOWN ( -- ) LMAX/SCREEN +JUMP ; + +\ jump to the start of the document +: >BOF ( -- ) 0 char-now ! 0 line-now ! 0 topline ! ; + +\ jump to the end of the document +: >EOF ( -- ) + doc-size @ char-now ! + last-line @ DUP line-now ! DUP .end ! + DUP topline @ LMAX/SCREEN + 1- > + IF 6 - DUP .start ! topline ! + ELSE DROP THEN ; + +\ jump to current top screen line +: >TOP ( -- ) + topline @ line-now @ U< + IF CPLACE topline @ DUP line-now ! >char-now + ELSE ?BEEP THEN ; + +\ jump to current bottom screen line +: >BOTTOM ( -- ) + line-now @ DUP last-line @ U< SWAP BOTTOMLINE U< AND + IF CPLACE last-line @ BOTTOMLINE MIN + DUP line-now ! >char-now + ELSE ?BEEP THEN ; + + +\ ~insert +\ toggle insert/overwrite +: ~INSERT ( -- ) way# DUP @ 1 XOR SWAP ! BANNER ; + + +\ find/replace +CREATE S$ MAX-INPUT CHARS ALLOT \ search string +CREATE R$ MAX-INPUT CHARS ALLOT \ replace string +FALSE VALUE FOUND \ has search string been found? +VARIABLE found-char \ where? +VARIABLE slen \ length of search string +VARIABLE spad> \ offset in PAD of found string +VARIABLE rlen \ length of replace string + +\ does the string have an uppercase character? +: UC? ( a u -- f ) + 0 ?DO COUNT UPPER? IF DROP TRUE UNLOOP EXIT THEN + LOOP DROP FALSE ; + +\ does the string have a lowercase character? +: lc? ( a u -- f ) + 0 ?DO COUNT lower? IF DROP TRUE UNLOOP EXIT THEN + LOOP DROP FALSE ; + +\ does the string have both upper- and lower-case characters? +: MIXED? ( a u -- f ) 2DUP UC? >R lc? R> AND ; + +' 2DROP VALUE ?lcase \ "deferred" ?lcase + + +\ make string lower case if NOT mixed +: ?MIXED ( a u -- ) + 2DUP MIXED? + IF ['] 2DROP ELSE ['] lcase THEN TO ?lcase + ?lcase EXECUTE ; + +\ look for searched string in search pad +: LOOKING ( a u -- ) + 2DUP ?lcase EXECUTE S$ slen @ SEARCH + NIP ?DUP IF TO FOUND SEARCH-PAD - spad> ! + ELSE DROP THEN ; + +\ you can't go home again (i.e. you can go home once) +TRUE VALUE OK-TO-GO-HOME \ ok to loop back to BOF? +VARIABLE snow \ char# now at SEARCH-PAD + +\ move some text to the search pad +: T>SPAD ( a u -- spad u ) + T>MEM >R + SEARCH-PAD R@ CMOVE + SEARCH-PAD R> ; + +\ search text for a string, if it isn't found, +\ continue to look from the beginning of the document +: SWEEP ( -- ) + TRUE TO OK-TO-GO-HOME + doc-size @ >R + char-now @ 1+ DUP R@ 1+ slen @ - U< AND + BEGIN DUP snow ! DUP DUP GULP + R@ UMIN DUP >R + OVER - T>SPAD LOOKING + R> R@ = OK-TO-GO-HOME AND + IF DROP 0 FALSE TO OK-TO-GO-HOME + ELSE GULP slen @ 1- - + THEN + DUP char-now @ 1+ U< OK-TO-GO-HOME OR 0= FOUND OR + UNTIL R> 2DROP ; + +\ if the string found identify the starting character +\ if necessary ensure that it can be displayed +: ?FOUND ( -- ) + FOUND + IF snow @ spad> @ + + DUP char-now ! DUP found-char ! + 6 AIM + ELSE ?BEEP THEN ; + +\ the seek word +: SEEK ( -- ) + FALSE TO FOUND + slen @ ?DUP + IF doc-size @ 1+ U< + IF S$ slen @ ?MIXED SWEEP THEN THEN + ?FOUND ; + +\ seek with prompt +\ empty string seeks the previous string +: SEEK? ( -- ) + BANNER-LINE RUB ." Find:" S$ MAX-INPUT ACCEPT ?DUP + IF slen ! THEN SEEK BANNER ; + +\ was something found here? +: POINT? ( -- f ) FOUND char-now @ found-char @ = AND ; + +\ adjust for difference between sought and replace lengths +: SLIDE ( n -- ) + DUP 0< + IF NEGATE <#SLIDE ELSE #SLIDE> THEN ; + +\ replace +: PUT ( -- ) + POINT? + rlen @ DUP >R AND R@ slen @ - TUCK 0 MAX ROOM? AND + IF ?DUP IF DUP SLIDE LINES+! THEN + R$ SPOT R@ CMOVE FORMAT + ELSE DEEP THEN + R> DROP FALSE TO FOUND ; + +\ replace with prompt +\ empty string subsitutes the previous string +: PUT? ( -- ) + POINT? + IF BANNER-LINE RUB ." Replace with:" R$ MAX-INPUT ACCEPT + ?DUP IF rlen ! THEN PUT BANNER + ELSE ?BEEP THEN ; + + +\ insert text from the command line +: STUFF ( -- ) + BANNER-LINE RUB ." Wedge in:" PAD MAX-INPUT ACCEPT + DUP ?DUP ROOM? AND + IF DUP SLIDE DUP LINES+! + DUP PAD SPOT ROT CMOVE FORMAT + char-now +! THEN BANNER ; + + +\ marking a block +VARIABLE was \ way# before marking +VARIABLE bstart \ where marking originated +VARIABLE .bstart \ beginning of marked text +VARIABLE .bend \ end of marked text +VARIABLE blength \ number of characters in the block +VARIABLE btop \ top block line to display + +\ keeping the block within the document, give the block's size +: BLOCK-IN ( -- n ) + char-now + DUP @ doc-size @ 1- UMIN TUCK SWAP ! ; + +\ if marking, define marked area +: ( -- ) + BLOCK-IN bstart @ + 2DUP UMIN .bstart ! UMAX .bend ! + line-old @ line-now @ 2DUP MIN .start ! MAX .end ! ; + +\ starting character and length of the block +: MARKED ( -- c# u ) + .bstart @ .bend @ OVER - 1+ ; + +\ start and end lines of the block +: ( -- l1 l2 ) .bstart @ 0 C>L .bend @ OVER C>L ; + +\ would like a Standard way to highlight: GLOW ? +: MARK ( a c -- a c ) + OVER 1- .bstart @ CHARS TEXT + .bend @ CHARS TEXT + BETWEEN + IF >UPPER THEN ; + +' NOP VALUE (?BLOCK) +: ?BLOCK (?BLOCK) EXECUTE ; + +\ start marking +: +MARK ( -- ) + way# DUP @ was ! 2 SWAP ! + ['] MARK TO (?MARK) ['] TO (?BLOCK) + BLOCK-IN bstart ! topline @ btop ! + -1 top-old ! BANNER ; + +\ leave marking +: -MARK ( -- ) + .end ! .start ! was @ way# ! + ['] NOP DUP TO (?MARK) TO (?BLOCK) BANNER ; + +\ copy, cut, embed + +\ fits into allotted space? +: SMALL? ( u -- flag ) POCKET-SIZE 1+ U< ; + +\ write larger block to a temporary file +: >PURSE ( a u -- ) + S" temp.wnk" CREATE-WRITE BUF>FILE ; + +\ copy marked +: APE ( -- ) + MARKED DUP blength ! T>MEM + DUP SMALL? + IF POCKET SWAP CMOVE + ELSE >PURSE THEN + -MARK ; + +\ copy and delete +: CUT ( -- ) + APE + .bend @ .bstart @ + DUP 0 C>L DUP .start ! line-now ! DUP char-now ! + - 1+ DUP <#SLIDE NEGATE LINES+! FORMAT + btop @ topline @ U< + IF btop @ topline ! THEN + last-line @ .end ! ; + +\ read large cut block +: PURSE> ( u -- ) + S" temp.wnk" OPEN-READ + ABORT" OPEN-FILE problem" TO FILE-ID + SPOT SWAP FILE>BUF ; + +\ paste copied or cut block +: PASTE ( -- ) + blength @ DUP DUP ROOM? AND + SWAP - last-line @ + LMAX U< AND + IF DUP >R #SLIDE> + R@ SMALL? + IF POCKET SPOT R@ CMOVE + ELSE R@ PURSE> THEN + R@ LINES+! FORMAT + R> char-now +! + char-now @ LMAX/SCREEN 2/ AIM + ELSE DEEP THEN ; + + +\ print +\ some code to try if you can invoke printing +\ not tested with LF +\ VARIABLE spacing +\ VARIABLE pline +\ define >PRN and PRN> according to your system +\ : >PRN ... ; \ enable printing +\ : PRN> ... ; \ return from printing +\ : SPACED ( u) spacing ! ; +\ : CRs ( n) 0 ?DO CR LOOP ; +\ : FF 12 EMIT ; +\ : .PAGE ( n -- ) PMARGIN LINEWIDTH + SPACES 1+ . ; +\ : NEWPAGE ( n -- ) FF 3 CRs .PAGE 3 CRs ; +\ : ?NEWPAGE ( -- ) +\ pline @ ?DUP +\ IF LINES/PAGE spacing @ / /MOD SWAP 0= +\ IF NEWPAGE ELSE DROP THEN +\ ELSE 6 CRs THEN ; +\ : TPRINT ( a u -- ) +\ T>MEM +\ 0 ?DO COUNT DUP 'CR > AND EMIT LOOP +\ DROP ; +\ : ( start end -- ) +\ >PRN +\ 0 pline ! OVER - 1+ 0 +\ ?DO ?NEWPAGE PMARGIN SPACES +\ DUP LINESPEC TPRINT spacing @ CRs pline INCR 1+ +\ LOOP DROP FF +\ PRN> ; +\ : printing ( n -- ) 0 last-line @ ; +\ : bprinting ( n -- ) ; +\ : (PRINT) ( -- ) 1 SPACED printing ; +\ : BPRINT ( -- ) 1 SPACED bprinting ; +\ : (2PRINT) ( -- ) 2 SPACED printing ; +\ : 2BPRINT ( -- ) 2 SPACED bprinting ; + + +\ file i/o + +\ request filename +\ a u1 is the prompt, u2 is the number of characters entered +: FILENAME ( a u1 -- u2 ) + BANNER-LINE RUB TYPE + PAD 1+ MAX-INPUT ACCEPT DUP PAD C! ; + +\ number of chars to dot +: >DOT ( s -- n ) COUNT [CHAR] . -TRAILING<> NIP ; + +\ add extension? +: ?+WNK ( s -- ) + DUP >DOT 0= + IF S" .wnk" ROT S+! ELSE DROP THEN ; + +\ move name to filename +: PAD$>FILENAME$ ( -- ) PAD FILENAME$ SMOVE ; + +\ file? +: GET-FILENAME ( -- a u) + S" Filename: " FILENAME + IF PAD$>FILENAME$ + ELSE ?DE-ALLOCATE QUIT THEN + FILENAME$ ?+WNK FILENAME$ COUNT ; + +\ save file +: FSAVE ( s -- ) + COUNT CREATE-WRITE TEXT doc-size @ BUF>FILE ; + +\ save the document +: SAVE-DOC ( -- ) FILENAME$ FSAVE ; + +\ save a marked block +: SAVE-MARKED ( -- ) + S" Save marked to:" FILENAME + IF PAD ?+WNK PAD COUNT CREATE-WRITE + MARKED T>MEM BUF>FILE + THEN BANNER ; + +\ read in the document from a file +: READ-DOC ( -- ) + FILE-ID + FILE-SIZE ABORT" FILE-SIZE problem" + OVER CMAX U< 0= OR + ABORT" FILE TOO BIG" doc-size ! + TEXT doc-size @ FILE>BUF ; + +\ if there's a file read it, else create a file +: ?READ-DOC ( a u -- ) + 2DUP R/O BIN OPEN-FILE + IF DROP CREATE-WRITE FCLOSE + ELSE TO FILE-ID 2DROP READ-DOC THEN ; + +\ prompt for a filename, try to read the file +: GET-DOCUMENT ( -- ) GET-FILENAME ?READ-DOC ; + +\ inVest file +: FROM> ( -- ) + S" Read from:" FILENAME + IF PAD ?+WNK PAD COUNT OPEN-READ + IF DROP BANNER-LINE RUB + PAD COUNT TYPE 2 SPACES ." ?? " WAIT + ELSE TO FILE-ID BANNER-LINE RUB + FILE-ID FILE-SIZE ABORT" FILE-SIZE problem" + OVER ROOM? 0= OR + IF ." NOT ENOUGH ROOM " DROP WAIT + ELSE DUP #SLIDE> SPOT OVER FILE>BUF + TRUE TO FORMAT-ALL FORMAT FALSE TO FORMAT-ALL + char-now +! + char-now @ LMAX/SCREEN 2/ AIM + THEN + THEN + THEN BANNER ; + +\ do a backup +: BACKUP ( -- ) + PAD PAD-SPACE BLANK + FILENAME$ PAD SMOVE PAD >DOT ?DUP + IF 1- PAD C! THEN S" .bak" PAD S+! PAD FSAVE ; + +\ if the file has some data, back it up +: ?BACKUP ( -- ) doc-size @ IF BACKUP THEN ; + +\ change filename +: ~NAME ( -- ) + S" Change filename to:" FILENAME + IF PAD$>FILENAME$ FILENAME$ ?+WNK FILENAME$ FSAVE THEN + BANNER ; + + +\ scrolling + +\ scroll up one line +: SCRUP ( -- ) topline DUP INCR @ .start ! last-line @ .end ! ; + +\ scroll down one line +: SCROWN ( -- ) topline DUP DECR @ .start ! last-line @ .end ! ; + +\ do I need to scroll? +: SCROLL? ( row#1 -- row#2 ) + DUP BOTTOM > IF SCRUP DROP BOTTOM topline @ top-old ! ELSE + DUP TOP < IF SCROWN 1+ topline @ top-old ! THEN THEN ; + +\ where to put the cursor +: CURSOR! ( -- ) + char-now @ + DUP line-now @ 1- 0 MAX C>L DUP line-now ! + DUP >Y SCROLL? -ROT LINE @ - DUP col# ! LINE#-SPACE + + SWAP CURSOR> 2! ; + +\ should I redisplay the entire text area? +: ?FRAME ( -- ) + topline @ top-old @ <> + IF topline @ .start ! last-line @ .end ! THEN ; + + +\ .status + +\ display of and the statistic +: .OF ( n -- ) [CHAR] / EMIT U. ; + +\ display max +: .MAX ( n -- ) + [CHAR] m EMIT U. SPACE ; + +\ display status line +: .STATUS ( -- ) + STATUS-LINE RUB + [CHAR] C EMIT SPACE char-now @ 1+ U. doc-size @ 1+ .OF CMAX .MAX + last-line @ line-now @ + PAGE#-SPACE IF 2DUP THEN + [CHAR] L EMIT SPACE 1+ U. 1+ .OF LMAX .MAX + PAGE#-SPACE + IF [CHAR] P EMIT SPACE PAGE-LINE DROP U. + PAGE-LINE DROP .OF THEN + ." Col " col# @ 1+ U. + ; + + +\ .result +: .RESULT ( -- ) + CURSOR! ?FRAME .TLINES .STATUS + CURSOR> 2@ AT-XY ; + + +\ begin and end + +\ virgin mother +\ reserve memory for text and lines data +: MOTHER ( -- ) + ALLOCATING + IF DO-ALLOCATE ELSE DO-ALLOT THEN + 0>LMAX ; + +: VIRGIN ( -- ) + MOTHER + 0 doc-size ! 0 last-line ! + 0 char-now ! 0 line-now ! + 0 topline ! 0 way# ! + BL TO "bl" BL TO "cr" BL TO "other" + FALSE TO FOUND + ['] NOP DUP TO (?MARK) TO (?BLOCK) ; + +\ yes, I wrote most of this +: (c) ( -- ) + PAGE 13 12 AT-XY ." LF v1.0 " + ." Copyright 1997 Leo Wong. All rights reserved." ; + +\ our story begins +: START ( -- ) + VIRGIN + ?BEEPS (c) + ?MARGIN GET-DOCUMENT .SCREEN FORMAT .RESULT + ?BACKUP ; + +\ finish +FALSE VALUE DONE \ true if leaving LF + +\ offer to save before leaving +: FINISH ( -- ) + BANNER-LINE RUB ." Save " .FILENAME ." (Y/n)?" IN-KEY + AND BL OR [CHAR] n <> IF SAVE-DOC THEN TRUE TO DONE ; + + +\ help - designed for 25 lines + +\ leave help +: BACK-TO-TEXT ( -- ) + .SCREEN topline @ .start ! last-line @ .end ! + .RESULT BANNER ; + +\ show help +: HELP ( -- ) + PAGE + 4 0 AT-XY ." when in TEXT ENTRY:" + 0 1 AT-XY ^COMMAND DUP EMIT EMIT ." enter COMMANDs" + + 4 3 AT-XY ." when COMMANDing:" + 0 4 AT-XY ^COMMAND EMIT ." return to TEXT ENTRY" + + 0 6 AT-XY ^Find-string EMIT ." Find" + 0 7 AT-XY ^find-aGain EMIT ." find aGain" + 0 8 AT-XY ^Replace EMIT ." Replace" + 0 9 AT-XY ^replace-Too EMIT ." replace Too" + + 0 11 AT-XY ^(un)mark(1) EMIT ." mark<->unmark" + 0 12 AT-XY ^Copy EMIT ." Copy marked" + 0 13 AT-XY ^Delete EMIT ." Delete char / cut marked" + 0 14 AT-XY ^Embed EMIT ." Embed (paste) copied/cut" + + 0 16 AT-XY ^inVest EMIT ." inVest (insert) a file" + 0 17 AT-XY ^Wedge EMIT ." Wedge in text" + + 0 19 AT-XY ^Alter-input EMIT ." insert<->overwrite" + 0 20 AT-XY ^Show EMIT ." show<->hide spaces/CRs" + + 0 22 AT-XY ^change-name EMIT ." change filename" + + 38 0 AT-XY ." when COMMANDing:" + + 34 2 AT-XY ." cursor moves:" + + 34 4 AT-XY ^right EMIT ." right" + 34 5 AT-XY ^left EMIT ." left" + 34 6 AT-XY ^up EMIT ." up" + 34 7 AT-XY ^down(1) EMIT ." or " + ^down(2) EMIT ." down" + + 34 9 AT-XY ^1st-col EMIT ." first column" + 34 10 AT-XY ^last-col(1) EMIT ." last column" + + 34 12 AT-XY ^page-up EMIT ." page up" + 34 13 AT-XY ^page-down(1) EMIT ." page down" + + 34 15 AT-XY ^TOP EMIT ." top of page" + 34 16 AT-XY ^BOP(1) EMIT ." bottom of page" + + 34 18 AT-XY ^BOF EMIT ." beginning of document" + 34 19 AT-XY ^EOF EMIT ." end of document" + + 34 21 AT-XY ^Save EMIT ." Save document" + + 34 22 AT-XY ^good-Bye EMIT ." Bye to LF" + + 14 24 AT-XY ." Press a key to leave this screen" + + IN-KEY 2DROP BACK-TO-TEXT ; + + +\ most commands depend on whether you're inserting, +\ overwriting, or marking text +\ Insert Overwrite Marking +3 WAYS <.WAY> .INSERT .OVERWRITE .MARKING +3 WAYS CHARACTER INSERT OVERWRITE DEEP +3 WAYS ENTER PARAGRAPH RETURN RETURN +3 WAYS BACKSPACE FROM> ?BEEP +\ 3 WAYS PRINT (PRINT) (PRINT) BPRINT +\ 3 WAYS 2PRINT (2PRINT) (2PRINT) 2BPRINT + +\ there had to be a (.WAY) +' <.WAY> TO (.WAY) + + +\ control keys +\ control-key handler +: CONTROL-KEY? ( u -- ) + CASE + 'CR OF ENTER ENDOF + BS OF BACKSPACE ENDOF + HT OF TABITHA ENDOF + ?BEEP + ENDCASE ; + + +\ command mode + +\ toggle text-entry and command modes +: ~COMMANDING ( -- ) + COMMANDING 0= DUP TO COMMANDING + IF BACKSPACE + way# @ 1 = VANQUISHED AND ?DUP IF INSERT LEFT THEN + ELSE way# @ 2 = IF -MARK THEN THEN + BANNER .RESULT ; + +\ am I commanding? +: COMMAND-MODE? ( c -- f ) + ^COMMAND = ^COMMAND PREVIOUS-KEY = AND COMMANDING OR ; + +\ so that the space bar can be used in command mode +: SPACE-BAR ( -- ) BL CHARACTER ; + +\ command-mode key handler +: COMMAND-MODE ( c1 -- c2 ) + >UPPER + CASE + + \ cursor keys + ^left OF LEFT ENDOF + ^right OF RIGHT ENDOF + ^up OF UP ENDOF + ^down(1) OF DOWN ENDOF + ^down(2) OF DOWN ENDOF + ^down(3) OF DOWN ENDOF + ^1st-col OF ENDOF + ^last-col(2) OF RIGHT> ENDOF + ^page-up OF PAGE-UP ENDOF + ^page-down(1) OF PAGE-DOWN ENDOF + ^page-down(2) OF PAGE-DOWN ENDOF + ^BOF OF >BOF ENDOF + ^EOF OF >EOF ENDOF + ^TOP OF >TOP ENDOF + ^BOP(1) OF >BOTTOM ENDOF + ^BOP(2) OF >BOTTOM ENDOF + + \ function keys + ^Find-string OF FIND-1ST ENDOF + ^find-aGain OF FIND-AGAIN ENDOF + ^Replace OF REPLACE ENDOF + ^replace-Too OF REPLACE-TOO ENDOF + + ^(un)mark(1) OF ~MARK ENDOF + ^(un)mark(2) OF ~MARK ENDOF + + ^Delete OF DELE ENDOF + ^Wedge OF WEDGE ENDOF + ^inVest OF INVEST ENDOF + + ^Copy OF COPY ENDOF + ^Embed OF EMBED ENDOF + + ^COMMAND OF ~COMMANDING ENDOF + + ^Query OF QUERY-HELP ENDOF + + ^Alter-input OF ~INPUT ENDOF + ^Show OF ~SHOW ENDOF + ^change-name OF ~NAME ENDOF + + ^Save OF SAVING ENDOF + ^good-Bye OF FINISH ENDOF + + \ -control-keys + + -Enter-key(1) OF ENTER ENDOF + -Enter-key(2) OF ENTER ENDOF + -Backspace-key(1) OF BACKSPACE ENDOF + -Backspace-key(2) OF BACKSPACE ENDOF + -Tab-key(1) OF TABITHA ENDOF + -Tab-key(2) OF TABITHA ENDOF + + \ space in command mode + BL OF SPACE-BAR ENDOF + + DUP CONTROL-KEY? + + ENDCASE 0 ; + + +\ process + +\ get ready to process a keyboard event +: PROCESS> ( -- ) + line-now @ DUP line-old ! 1- + topline @ DUP top-old ! + last-line @ DUP last-old ! CLAMP + DUP .start ! 1- DUP .end ! .mend ! ; + +\ process a character +: KEYBOARD-CHARACTER ( c -- ) + DUP COMMAND-MODE? IF COMMAND-MODE ELSE + DUP BL LAST-DISPLAYABLE BETWEEN IF DUP CHARACTER ELSE + DUP CONTROL-KEY? + THEN THEN + DROP ; + +\ process other keyboard event (such as a cursor key) +\ if using ekey +: OTHER-KEYBOARD-EVENT ( u -- ) DEEP ; + +\ handle a keyboard event +: PROCESS-KEY ( c flag -- ) + PROCESS> + 2DUP AND COMMANDING OR >R \ if commanding, hide key + IF KEYBOARD-CHARACTER + ELSE OTHER-KEYBOARD-EVENT THEN + R> TO PREVIOUS-KEY ; + + +\ LF, an NPBP ANS Forth word processor +: LF ( -- ) + FALSE TO COMMANDING FALSE TO DONE START + BEGIN IN-KEY + PROCESS-KEY ?BLOCK .RESULT + DONE UNTIL ?DE-ALLOCATE PAGE ; + + +LF \ start LF diff --git a/life.fs b/life.fs new file mode 100755 index 0000000..94ed039 --- /dev/null +++ b/life.fs @@ -0,0 +1,37 @@ +VARIABLE STATEBLK +VARIABLE LIFEBLK +VARIABLE STATEP + +\ : -ROT ROT ROT ; + +: WRAPY DUP 0< IF DROP 15 THEN DUP 15 > IF DROP 0 THEN ; +: WRAPX DUP 0< IF DROP 63 THEN DUP 63 > IF DROP 0 THEN ; +: WRAP WRAPY SWAP WRAPX SWAP ; +: DECEASED? WRAP 64 * + LIFEBLK @ BLOCK + C@ BL = ; +: LIVING? DECEASED? 0= ; +: (-1,-1) 2DUP 1- SWAP 1- SWAP LIVING? 1 AND ; +: (0,-1) >R 2DUP 1- LIVING? 1 AND R> + ; +: (1,-1) >R 2DUP 1- SWAP 1+ SWAP LIVING? 1 AND R> + ; +: (-1,0) >R 2DUP SWAP 1- SWAP LIVING? 1 AND R> + ; +: (1,0) >R 2DUP SWAP 1+ SWAP LIVING? 1 AND R> + ; +: (-1,1) >R 2DUP 1+ SWAP 1- SWAP LIVING? 1 AND R> + ; +: (0,1) >R 2DUP 1+ LIVING? 1 AND R> + ; +: (1,1) >R 1+ SWAP 1+ SWAP LIVING? 1 AND R> + ; +: NEIGHBORS (-1,-1) (0,-1) (1,-1) (-1,0) (1,0) (-1,1) (0,1) (1,1) ; +: BORN? NEIGHBORS 3 = ; +: SURVIVES? 2DUP LIVING? -ROT NEIGHBORS 2 = AND ; +: LIVES? 2DUP BORN? -ROT SURVIVES? OR ; +: NEWSTATE STATEBLK @ BLOCK UPDATE STATEP ! ; +: STATE! STATEP @ C! 1 STATEP +! ; +: ALIVE [CHAR] * STATE! ; +: DEAD BL STATE! ; +: ITERATE-CELL 2DUP SWAP LIVES? IF ALIVE ELSE DEAD THEN ; +: ITERATE-ROW 0 BEGIN DUP 64 < WHILE ITERATE-CELL 1+ REPEAT DROP ; +: ITERATE-BLOCK 0 BEGIN DUP 16 < WHILE ITERATE-ROW 1+ REPEAT DROP ; +: GENERATION LIFEBLK @ STATEBLK @ LIFEBLK ! STATEBLK ! ; +: ITERATE NEWSTATE ITERATE-BLOCK GENERATION ; +: DONE? KEY [CHAR] Q = ; +: PROMPT CR ." PRESS Q TO EXIT; OTHER KEY TO CONTINUE" ; +: VIEW PAGE LIFEBLK @ LIST PROMPT ; +: LIFE BEGIN VIEW ITERATE DONE? UNTIL ; + diff --git a/mailfig.fth b/mailfig.fth new file mode 100755 index 0000000..be3218e --- /dev/null +++ b/mailfig.fth @@ -0,0 +1,649 @@ +\ MAILFIG program to handle forms for comments to FIG + +\ This is an ANS Forth program requiring: +\ 1. The File Access word set. +\ 2. The words CMOVE and COMPARE from the String word set. +\ 3. A system dependent word GETENV to get the specified +\ environment string, +\ GETENV ( str count -- str' count' ) +\ 4. The word STDIN to get the file ID of standard input. +\ 5. The words OPEN-PIPE and CLOSE-PIPE to open and close pipes to +\ processes. (These are communicated with via the normal File access +\ words). +\ 6. READ to write to Unix file descriptors (because of a problem with +\ ThisForth 94-09-12). + + +\ (c) Copyright 1994 Everett F. Carter. Permission is granted by the +\ author to use this software for any application provided this +\ copyright notice is preserved. + + +\ rcsid: @(#)mailfig.fth 1.5 10:15:52 11/6/95 EFC + + +FALSE CONSTANT ?DEBUG +TRUE CONSTANT ThisForth +FALSE CONSTANT PFE + +ThisForth [IF] + + +\ =================== ANS File words for ThisForth ========================= + +\ file open modes +: R/W S" r+" ; +: R/O S" r" ; +: W/O S" w" ; + +: APPEND S" a" ; \ NOT ANS, but necessary + + +: OPEN-FILE fopen DUP 0= ; + +: READ-LINE ( addr u fileid -- u' flag ior ) + STREAM + 0 SWAP + 0 DO + next-char EOL = IF LEAVE THEN + next-char EOF = IF LEAVE THEN + get-char + 2 PICK I + C! + 1+ + LOOP + + UNSTREAM + + SWAP DROP TRUE 0 +; + +: READ-FILE ( addr u fileid -- u' flag ) \ a hack + STREAM + 0 SWAP + 0 DO + next-char EOF = IF LEAVE THEN + get-char + 2 PICK I + C! + 1+ + LOOP + + UNSTREAM + + SWAP DROP FALSE +; + + +: REPOSITION-FILE ( d fid -- flag ) + ROT ROT DROP 0 + fseek +; + +: WRITE-FILE ( c-addr u fileid -- ior ) + DISPLAY TYPE + 0 DISPLAY + TRUE +; + + +: WRITE-LINE ( c-addr u fileid -- ior ) + DISPLAY TYPE CR + 0 DISPLAY + TRUE +; + +: CLOSE-FILE fclose ; + +[THEN] + +\ ========================================================================= + +ThisForth [IF] \ ThisForth version +: OPEN-APPEND + APPEND OPEN-FILE +; + +[ELSE] +\ ANS Brute force OPEN-APPEND, depending upon what is under the hood, there may +\ be more efficient definitions +: OPEN-APPEND R/W OPEN-FILE + DUP 0= IF OVER FILE-SIZE + 0= IF 3 PICK REPOSITION-FILE DROP THEN + THEN +; +[THEN] + + +FALSE VALUE bad-status +0 VALUE seq-file +0 VALUE log-file +0 VALUE seq-no +FALSE VALUE cc-req +FALSE VALUE unesc-req +FALSE VALUE strip-plus-req + +CREATE NEW-LINE-CHARS 2 ALLOT +10 NEW-LINE-CHARS C! +\ 13 NEW-LINE-CHARS 1+ C! + + +0 VALUE buf-len +0 VALUE input-buffer +VARIABLE scan-ptr + +ALIGN +CREATE out-buf 32 ALLOT + +\ ============= A String pointer data structure ============================= + +: string: \ build a counted string + CREATE + 0 , \ POINTER to the data + 0 , \ the count + DOES> + DUP @ SWAP CELL+ @ +; + + +: $! ( addr count 'str -- ) \ store a string + + >BODY + SWAP OVER CELL+ ! + ! +; + +: $len ( addr count -- count ) + SWAP DROP +; + +: $copy ( addr count 'str -- ) + + HERE 2 PICK ROT $! \ store string pointer to HERE + HERE SWAP DUP ALLOT + CMOVE +; + +: $cat ( addr1 count1 addr2 count2 -- addr count ) + 2 PICK OVER + DUP >R + HERE >R + ALLOT + 2SWAP + R@ SWAP DUP >R CMOVE \ move first string + + R> R@ + + SWAP CMOVE \ move the second string + + R> R> +; + +\ the data fields +string: name +string: comments +string: e-mail +string: subject +string: request + +\ ======================= LOCAL FILE NAMES ================================ + +string: SEQFILE +string: LOGFILE +string: PROGRAM +string: MAILER +string: HOSTNAME +string: DESTINATION + + +: init-strings + + S" /usr/skip/forth/FIG/figmail.seq" ['] SEQFILE $copy + + S" /usr/skip/forth/FIG/figmail.log" ['] LOGFILE $copy + + S" mailfig.fth V1.5" ['] PROGRAM $copy + + S" taygeta.com" ['] HOSTNAME $copy + + +\ This is the name of the mail program, we are using URL escape codes +\ for quotes which will be converted to actual quotes later + + S" /usr/ucb/Mail -s %22FIG Comments%22 johnhall@aol.com skip@taygeta.com " ['] MAILER $copy + + +\ S" johnhall@aol.com skip@taygeta.com " ['] DESTINATION $copy + +\ S" johnhall@aol.com " ['] DESTINATION $copy +\ DESTINATION S" skip@taygeta.com " $cat ['] DESTINATION $! + +\ S" skip@taygeta.com " ['] DESTINATION $copy + +; + + +\ ========================================================================= + +: acknowledge ( -- ) + + + ."
    Mail to Forth Interest Group OK " + ."
    " CR + + ." Everything received OK

    " + ." Thanks for the mail!" CR + + ."

    " CR + + ." " + ." [CHAR] " + ." Back to FIG Home page. " CR + ."

    " CR + +; + +: nack ( -- ) + + ."

    Mail to Forth Interest Group NOT OK " + ."
    " CR + + ." Sorry, There seems to be a problem with the form as you filled it out " + CR CR + ." Is perhaps your name/e-mail missing ?" CR + + ."

    " CR + ." " + ." [CHAR] " + ." Back to FIG Mailer Form page. " CR + ."

    " CR + +; + +: sig + ."

    " CR + ." Everett F. Carter Jr. -- skip@taygeta.com" CR + ."
    " CR + +; + +: atol ( addr count -- d ) + >R + 0. ROT + R> + + >NUMBER + 2DROP +; + +: atoi ( addr count -- n ) + + atol DROP +; + +: move-chars ( dest src count -- dest count ) + >R OVER R@ CMOVE R> +; + +: itoa ( n -- addr count ) \ (signed) int to counted string + out-buf aligned SWAP + DUP >R ABS S>D + <# #S R> SIGN #> + move-chars +; + + + +: newline ( fileid -- flag ) + + NEW-LINE-CHARS 1 ROT WRITE-FILE +; + +: update_sequence_number ( -- old_no ) + + SEQFILE R/W OPEN-FILE ABORT" Unable to open sequence file " + + TO seq-file + + \ get the current sequence number + PAD 16 seq-file READ-LINE ABORT" file read error " + DROP + + PAD SWAP atoi + + + \ increment the number and store it away + DUP 1+ + + 0. seq-file REPOSITION-FILE DROP + + itoa seq-file WRITE-LINE DROP + + seq-file CLOSE-FILE DROP + +; + + +: write-env ( -- len ) + + S" SERVER_PROTOCOL" getenv + DUP 0= IF 2DROP S" HTTP/1.0" THEN TYPE + + ." 200 OK" CR + ." MIME-Version: 1.0" CR + + S" SERVER_SOFTWARE" getenv + DUP 0 > IF TYPE CR ELSE 2DROP THEN + + ." Content-Type: text/html" CR + \ ." Content-Encoding: HTML" CR + \ ." Content-Transfer-Encoding: HTML" CR + CR + + S" CONTENT_LENGTH" getenv + DUP IF atoi ELSE 2DROP 0 THEN +; + + + +: plus->space ( addr count -- ) \ convert pluses to spaces + + 0 ?DO I OVER + C@ [CHAR] + = IF I OVER + BL SWAP C! THEN LOOP + DROP +; + +: x2c ( addr count -- n ) + + HEX + + >R 0. ROT R> + >NUMBER + 2DROP DROP + + DECIMAL +; + +: unescape-url ( addr count -- count' ) + + -1 SWAP + 0 ?DO + 1+ + + OVER OVER + \ get &url[x] + 2 PICK I + C@ \ get url[y] + DUP ROT C! \ url[x] = url[y] + + + [CHAR] % = IF \ convert it if it is a % char + OVER I + 1+ 2 x2c \ convert url[y+1] + 2 PICK 2 PICK + C! \ and store it at url[x] + 3 + ELSE + 1 + THEN + + +LOOP + + 1+ \ adjust count + SWAP DROP +; + +: skip-past-equals ( -- ) + + scan-ptr @ DUP buf-len SWAP ?DO + 1+ + input-buffer I + C@ + [CHAR] = = IF LEAVE THEN + LOOP + scan-ptr ! +; + +: length-to-ampersand ( -- n ) + + 0 + buf-len scan-ptr @ ?DO + input-buffer I + C@ + [CHAR] & = IF LEAVE THEN + 1+ + LOOP + +; + +: scan-in ( -- addr count | 0 ) + + + skip-past-equals + + length-to-ampersand + + DUP 0 > IF + input-buffer scan-ptr @ + \ addr of first char + SWAP \ put count on top + DUP scan-ptr +! + THEN +; + +\ get data from input stream (stdin) +\ set BAD-STATUS if it failed +: get-input-data ( addr len -- ) + + + \ STDIN READ-FILE + + \ The above SHOULD work, but with ThisForth 94-09-12 + \ it doesn't when this is run with no tty attached (as it will be + \ when HTTP invokes it), so instead we are using: + + 0 READ + + + DUP 0 < + TO bad-status + TO buf-len +; + + +: scan-input-data ( -- ) + + 0 scan-ptr ! + + scan-in DUP 0 > IF ['] subject $! THEN + scan-in DUP 0 > IF ['] comments $! THEN + + scan-in DUP 0 > IF ['] name $! THEN + scan-in DUP 0 > IF ['] e-mail $! THEN + + \ get cc request + scan-in DUP 0 > IF ['] request $! THEN + request 3 MIN S" Yes" compare 0= TO cc-req + + \ get strip_plus request + scan-in DUP 0 > IF ['] request $! THEN + request 3 MIN S" Yes" compare 0= TO strip-plus-req + + \ get unescape request + scan-in DUP 0 > IF ['] request $! THEN + request 3 MIN S" Yes" compare 0= TO unesc-req + + + name plus->space + + strip-plus-req IF + subject plus->space + comments plus->space + THEN + + name unescape-url name DROP SWAP ['] name $! + + unesc-req IF + subject unescape-url subject DROP SWAP ['] subject $! + comments unescape-url comments DROP SWAP ['] comments $! + THEN + + + \ need a name or e-mail + name $len 0= e-mail $len 0= AND TO bad-status + + + +; + +: report-field ( addr count handle -- ) + + OVER 0= IF SWAP DROP SWAP DROP S" (None) " ROT THEN + + WRITE-FILE DROP +; + +: report ( handle -- ) + + S" Subject: " 2 PICK WRITE-FILE DROP + subject 2 PICK report-field + DUP newline DROP + + S" Comments: " 2 PICK WRITE-FILE DROP + DUP newline DROP + comments 2 PICK report-field + + DUP newline DROP + DUP newline DROP + + S" Name: " 2 PICK WRITE-FILE DROP + name 2 PICK report-field + + DUP newline DROP + + S" e-mail: " 2 PICK WRITE-FILE DROP + e-mail 2 PICK report-field + + newline DROP +; + + +: sendmail ( handle -- handle ) + + + DUP report + + S" Sequence number: " 2 PICK WRITE-FILE DROP + seq-no itoa 2 PICK WRITE-LINE DROP + + S" Received at " 2 PICK WRITE-FILE DROP + + PAD 24 timestamp 2 PICK WRITE-FILE DROP + S" from the WWW page on: " 2 PICK WRITE-FILE DROP + HOSTNAME 2 PICK WRITE-LINE DROP + + S" Program: " 2 PICK WRITE-FILE DROP + PROGRAM 2 PICK WRITE-LINE DROP + + DUP newline DROP + + + + +; + +: mail_fig ( -- ) + + init-strings + + \ fix the mailer string + MAILER unescape-url MAILER DROP SWAP ['] MAILER $! + + MAILER DESTINATION $cat ['] MAILER $! + + LOGFILE OPEN-APPEND ABORT" Unable to open log file " + TO log-file + + update_sequence_number DUP TO seq-no + + + PAD 24 timestamp log-file WRITE-FILE DROP + + S" Sequence number is: " log-file WRITE-FILE DROP + itoa log-file WRITE-FILE DROP + + log-file newline DROP + + write-env + + ?DEBUG IF + S" CONTENT LENGTH = " log-file WRITE-FILE DROP + DUP itoa log-file WRITE-FILE DROP + THEN + + + \ allocate space for the buffer + HERE TO input-buffer + DUP 2 + DUP TO buf-len ALLOT + + \ now read characters from the input stream + input-buffer SWAP get-input-data + + + ?DEBUG IF + S" BUF-LEN = " log-file WRITE-FILE DROP + buf-len itoa log-file WRITE-FILE DROP + S" status = " log-file WRITE-FILE DROP + bad-status itoa log-file WRITE-FILE DROP + log-file newline DROP + THEN + + + + + ?DEBUG IF + input-buffer buf-len log-file WRITE-FILE DROP + log-file newline DROP + THEN + + scan-input-data + + + log-file report + + bad-status IF nack + ELSE + \ open the mail pipe + cc-req IF + MAILER e-mail $cat ['] MAILER $! + THEN + + ?DEBUG IF + S" Mailer: " log-file WRITE-FILE DROP + MAILER log-file WRITE-FILE DROP + log-file newline DROP + THEN + + \ ." Mailer command <" MAILER TYPE ." >" CR + + MAILER W/O OPEN-PIPE + ABORT" Unable to open pipe to mailer " + + sendmail + CLOSE-PIPE DROP + acknowledge + THEN + + + sig + + log-file newline DROP + log-file CLOSE-FILE DROP + +; + +\ auto-startup word + +: startup mail_fig bye ; + +PFE [IF] +startup +[THEN] + + + + + + diff --git a/marcel-hendrix.blink b/marcel-hendrix.blink new file mode 100755 index 0000000..a2b8f0f --- /dev/null +++ b/marcel-hendrix.blink @@ -0,0 +1,2 @@ +Marcel Hendrix's home-page +http://home.iae.nl/users/mhx/index.html diff --git a/mccirc.fs b/mccirc.fs new file mode 100755 index 0000000..e6b7ce8 --- /dev/null +++ b/mccirc.fs @@ -0,0 +1,99 @@ +\ mccirc.fs - Minecraft circle block calculator + +variable lr + +cr .( Reading mccirc.fs ... ) + +: box ( -- ) ." []" ; + +: boxes ( u -- ) 0 u+do box loop ; + +: prline ( u -- ) cr dup 2 .r space boxes ; +: prline2 ( u1 u2 -- ) cr dup 2 * 2 .r space dup rot swap - 2 * spaces dup boxes ." |" boxes ; + +: haxise ( uw ur -- , Print horizontal axis for edge-centered circle + uw: centering field width + ur: circle radius ) + cr + tuck 2 * 3 + - 2 / spaces + 2 * 1+ dup + 0 u+do [char] - emit loop + [char] + emit + 0 u+do [char] - emit loop +; + +: haxisb ( uw ur -- , Print horizontal axis for block-centered circle + uw: centering field width + ur: circle radius ) + cr + tuck 4 * 1+ - 2 / spaces [char] - emit + 1- dup + 0 u+do ." [-" loop + ." [+]" + 0 u+do ." -]" loop + [char] - emit +; + +: proline ( u -- ) cr dup 2 .r space ." +]" 1- boxes ; + +\ mccirce -- Blocks in edge-centered circle with radius ur blocks +: mccirce { ur -- } + ur 0 u+do + 0 lr ! + ur 0 u+do + \ j dup * i dup * + + \ s>d d>f fsqrt + j 10 * 5 + dup * i 10 * 5 + dup * + + s>d d>f 1e2 f/ fsqrt + f>d d>s ur < if + 1 lr +! + then + loop + ur lr @ prline2 + loop + cr +; + +: mccircei { ur -- } + ur 0 u+do + 0 lr ! + ur 0 u+do + ur j - 10 * 5 - dup * i 10 * 5 + dup * + + s>d d>f 1e2 f/ fsqrt + f>d d>s ur < if + 1 lr +! + then + loop + lr @ + dup ur swap prline2 + loop + haxise + ur 0 u+do + ur swap prline2 + loop +; + +\ mccircb -- Blocks in block-centered circle with radius ur blocks +: mccircb { ur -- } + ur 0 u+do + 0 lr ! + ur 0 u+do + j 10 * 5 + dup * i 10 * 5 + dup * + + s>d d>f 1e2 f/ fsqrt + f>d d>s ur 1+ < if + 1 lr +! + then + loop + lr @ i if prline else proline then + loop + cr +; + +\ mccirc -- Blocks in circle with diameter ud blocks +: mccirc { ud -- } + ud 2 mod if + ud 2 / 1+ mccircb + else + ud 2 / mccirce + then +; diff --git a/mccurve.fs b/mccurve.fs new file mode 100755 index 0000000..9d21c35 --- /dev/null +++ b/mccurve.fs @@ -0,0 +1,115 @@ +\ mccirc.fs - Minecraft circle block calculator + +variable UD \ Plotting circle diameter in blocks +variable UR \ Plotting circle radius in blocks +variable FB \ Plotting circle block-centered flag (FALSE => edge-centered) +variable UW \ Centering field width in characters +variable USC \ Current semi-chord length in blocks + +\ Graphic elements +create C-BOX \ [] box + 2 c, 91 c, 93 c, +create C-ORGB \ [+] origin (box-centered) + 3 c, 91 c, 43 c, 93 c, +create C-AXVB \ [|] vert. axis (box-centered) + 3 c, 91 c, 124 c, 93 c, +create C-AXHLB \ [- horiz. axis left (box-centered) + 2 c, 91 c, 45 c, +create C-AXHRB \ -] horiz. axis right (box-centered) + 2 c, 45 c, 93 c, +create C-ORGE \ + origin (edge-centered) + 1 c, 43 c, +create C-AXVE \ | vert. axis (edge-centered) + 1 c, 124 c, +create C-AXHE \ -- horiz. axis (edge-centered) + 2 c, 45 c, 45 c, + +: cstype ( c-elem -- , type counted string C-ELEM ) + count type ; + +: multype ( u c-elem -- , type counted string C-ELEM U times ) + count rot + 1 u+do 2dup type loop + type +; + +: b>c ( ub -- uc , Convert blocks UB to char. width UC ) + 2* ; + +: chrdblk ( usc -- ub : Calculate blocks in chord UB with semi-chord length USC ) + 2* FB @ if 1+ then ; + +: chord ( uw usc -- : Print horizontal circle chord with length 2*USC centere in field UW chars ) + tuck FB @ if 2* 1+ b>c else 2* b>c 1+ then - 2/ ( usc um ) + tuck cr spaces ( um usc ) + dup C-BOX multype + FB @ if C-AXVB else C-AXVE then cstype + dup C-BOX multype + swap 2 + spaces chrdblk . +; + +: haxis ( uw ur -- : Print horizontal axis ) + tuck FB @ if 2* 1+ b>c else 2* b>c 1+ then - 2/ ( ur um ) + tuck cr spaces dup dup + FB @ if + C-AXHLB multype + C-ORGB cstype + C-AXHRB multype + else + C-AXHE multype + C-ORGE cstype + C-AXHE multype + then + FB @ if swap 2 + spaces chrdblk . else 2drop then +; + +: fincircle ( uy ux -- f : Determine if block UX,UY is within circle - Global: UR ) + 10 * 5 + swap 10 * 5 + + dup * swap dup * + + s>d d>f 1e2 f/ fsqrt f>d d>s + UR @ < +; + +: scircle ( ud -- : Plot semicircle with diameter UD blocks -- Globals: UD, UR, FB, UW, USC ) + dup UD ! + dup 2/ UR ! + dup 2 mod FB ! + b>c FB @ invert if 1+ then UW ! + UW @ UR @ haxis + FB @ invert if UW @ UR @ chord then + UR @ 1 u+do + 1 USC ! + UR @ 1 u+do + j i fincircle if 1 USC +! then + loop + UW @ USC @ chord + loop +; + +: circle ( ud -- : Plot circle with diameter UD blocks -- Globals: UD, UR, FB, UW, USC ) + dup UD ! + dup 2/ UR ! + dup 2 mod FB ! + b>c 1+ UW ! + UR @ 1 u+do + 1 USC ! + UR @ 1 u+do + UR @ j - i fincircle if 1 USC +! then + loop + USC @ + dup UW @ swap chord + loop + FB @ invert if UW @ UR @ chord then + UW @ UR @ haxis + FB @ invert if UW @ UR @ chord then + UR @ 1 u+do UW @ swap chord loop +; + +: hsphere ( ud -- , plot layers of hemisphere with block diameter UD ) + +; + +: ellipse ( umaj umin -- , plot ellipse with major axis UMAJ blocks and minor axis UMIN blocks ) + +; + diff --git a/mccurve0.fs b/mccurve0.fs new file mode 100755 index 0000000..f33c66a --- /dev/null +++ b/mccurve0.fs @@ -0,0 +1,113 @@ +\ mccirc.fs - Minecraft circle block calculator + +variable UD \ Plotting circle diameter in blocks +variable UR \ Plotting circle radius in blocks +variable FB \ Plotting circle block-centered flag (FALSE => edge-centered) +variable UW \ Centering field width in characters +variable USC \ Current semi-chord length in blocks + +\ Graphic elements +create C-BOX \ [.] box + 3 c, 91 c, 46 c, 93 c, +create C-ORGB \ [+] origin (box-centered) + 3 c, 91 c, 43 c, 93 c, +create C-AXVB \ [|] vert. axis (box-centered) + 3 c, 91 c, 124 c, 93 c, +create C-AXHB \ [-] horiz. axis (box-centered) + 3 c, 91 c, 45 c, 93 c, +create C-ORGE \ + origin (edge-centered) + 1 c, 43 c, +create C-AXVE \ | vert. axis (edge-centered) + 1 c, 124 c, +create C-AXHE \ --- horiz. axis (edge-centered) + 3 c, 45 c, 45 c, 45 c, + +: cstype ( c-elem -- , type counted string C-ELEM ) + count type ; + +: multype ( u c-elem -- , type counted string C-ELEM U times ) + count rot + 1 u+do 2dup type loop + type +; + +: b>c ( ub -- uc , Convert blocks UB to char. width UC ) + 3 * ; + +: chrdblk ( usc -- ub : Calculate blocks in chord UB with semi-chord length USC ) + 2* FB @ if 1+ then ; + +: chord ( uw usc -- : Print horizontal circle chord with length 2*USC centere in field UW chars ) + tuck FB @ if 2* 1+ b>c else 2* b>c 1+ then - 2/ ( usc um ) + tuck cr spaces ( um usc ) + dup C-BOX multype + FB @ if C-AXVB else C-AXVE then cstype + dup C-BOX multype + swap 2 + spaces chrdblk . +; + +: haxis ( uw ur -- : Print horizontal axis ) + tuck FB @ if 2* 1+ b>c else 2* b>c 1+ then - 2/ ( ur um ) + tuck cr spaces dup dup + FB @ if + C-AXHB multype + C-ORGB cstype + C-AXHB multype + else + C-AXHE multype + C-ORGE cstype + C-AXHE multype + then + FB @ if swap 2 + spaces chrdblk . else 2drop then +; + +: fincircle ( uy ux -- f : Determine if block UX,UY is within circle / Global: UR ) + 10 * 5 + swap 10 * 5 + + dup * swap dup * + + s>d d>f 1e2 f/ fsqrt f>d d>s + UR @ < +; + +: scircle ( ud -- : Plot semicircle with diameter UD blocks / Globals: UD, UR, FB, UW, USC ) + dup UD ! + dup 2/ UR ! + dup 2 mod FB ! + b>c FB @ invert if 1+ then UW ! + UW @ UR @ haxis + FB @ invert if UW @ UR @ chord then + UR @ 1 u+do + 1 USC ! + UR @ 1 u+do + j i fincircle if 1 USC +! then + loop + UW @ USC @ chord + loop +; + +: circle ( ud -- : Plot circle with diameter UD blocks / Globals: UD, UR, FB, UW, USC ) + dup UD ! + dup 2/ UR ! + dup 2 mod FB ! + b>c FB @ invert if 1+ then UW ! + UR @ 1 u+do + 1 USC ! + UR @ 1 u+do + UR @ j - i fincircle if 1 USC +! then + loop + USC @ + dup UW @ swap chord + loop + FB @ invert if UW @ UR @ chord then + UW @ UR @ haxis + FB @ invert if UW @ UR @ chord then + UR @ 1 u+do UW @ swap chord loop +; + +: hsphere ( ud -- , plot layers of hemisphere with block diameter UD ) + +; + +: ellipse ( umaj umin -- , plot ellipse with major axis UMAJ blocks and minor axis UMIN blocks ) + +; + diff --git a/moore-geek.blink b/moore-geek.blink new file mode 100755 index 0000000..2a6e912 --- /dev/null +++ b/moore-geek.blink @@ -0,0 +1,2 @@ +Chuck Moore: Geek of the Week +http://www.simple-talk.com/opinion/geek-of-the-week/chuck-moore-geek-of-the-week/ diff --git a/mymath.fs b/mymath.fs new file mode 100755 index 0000000..6baa256 --- /dev/null +++ b/mymath.fs @@ -0,0 +1,21 @@ +\ mymath.fs - Arithmetic utilities +\ +\ Copyright 2018 David Meyer +JMJ +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. +\ + +\ u** - power (x^y) for unsigned integers +: u** ( u1 u2 -- u1^u2 ) + 1 swap 0 u+do over * loop nip ; + diff --git a/pf.perl b/pf.perl new file mode 100755 index 0000000..e52160f --- /dev/null +++ b/pf.perl @@ -0,0 +1,1888 @@ +#!/usr/bin/perl +# -------- description + version history -------- #FOLD00 + +=head1 PerlForth + an incremental compiler and interactive interpreter, based on a + virtual machine, executing indirect threaded code. + +=cut + +my $version = 27; +# to do: improved file interface. can only read source files to compile from now. +# time of last change: + +# 20110428,ls 0.27 arithmetic on addresses may result in negative mem array indici. changed some memory primitives to unsign addresses +# 20110427,ls problem with 64 bit. forcing to 32 bit for now. +# 20110420,ls 0.26 string packing and unpacking using W type strings. +# 20091001,ls 0.25 initialising catchframe in empty avoids undefined error handler when quitting in site-forth.4th +# 20090930,ls 0.24 loading /usr/local/share/perlforth/site-forth.4th at start +# 20090106,ls 0.23 fixes for 64bit Perl versions +# 20090106,ls 0.22 can compile source from included file. +# 20090103,ls 0.21 vocabularies. +# 20090101,ls 0.20 prepared for vocabularies. +# 20081228,ls 0.19 radix prefixes +# 20081228,ls 0.18 catch, throw, top level error handler, fixed bug in hash which rendered does> defective +# 20081228,ls 0.17 experimentally connected Perl exception handler to interpreter errors +# 20081223,ls 0.16 does>, keymap lister, linked vars, defers, constants, arrays. +# 20081223,ls 0.15 hilevelized/deperled many words. key is now deferred. cleanup. stuff added. +# 20081221,ls 0.14 simulated disk loaded during boot, extending interpreter. +# better compile-time word defining macros. +# branching version which moves definitions to simulated disk. +# 20081221,ls 0.13 simulated disk for testing compiling from file. +# 20081221,ls 0.12 some string support: ." s" ," /string move$ +# 20081220,ls 0.11 added move fill for next leave ?leave i j do ?do loop +# 20081217,ls 0.10 numbers, if else then begin while repeat until again. +# 20081217,ls 0.09 added [ ], create, variable, : ; colon definitions work. +# 20081217,ls 0.08 input line is parsed now. "real" interpreter connected, +# but compilation and numbers are stubs. +# 20081217,ls 0.07 bit logic, comparison, keymap customizer, hide/reveal, skip/scan +# 20081215,ls 0.06 debugging and cleanup +# 20081215,ls 0.05 rudimentary command execution loop +# 20081214,ls 0.04 rudimentary buffered line input, more primitives. +# 20081213,ls 0.03 more run time words, primitives, flow control +# 20081211,ls 0.02 added run time words, constants, minimal flow control +# 20081210,ls 0.01 ITC inner interpreter executes lo- and hilevel + + +use strict; +use warnings; + +use Term::ReadKey; +#use Term::ANSIColor; + +# -------- configuration items -------- #FOLD00 + +my $tibsize = 256; # size of terminal input buffer +my $cell; + +# override. uses perl compilation width if undefined. +# $cell = 0; # bits per cell determined by size perl has been compiled for +# $cell = 0xffff; # 16 bit override + $cell = 0xffffffff; # 32 bit override +# $cell = 0xffffffffffffffff; # 64 bit override +# 2011apr27,ls problem with 64 bit. forcing to 32 bit for now. + + +# -------- simulated sources disk -------- #FOLD00 + + +# simulated source disk, contents are loaded and compiled during boot +my @disk = + ( +"forth only", +"forth definitions", + '#10 base !', + + ': binary 2 base ! ;', # ( -- ) + ': octal 8 base ! ;', # ( -- ) + ': decimal 10 base ! ;', # ( -- ) + ': hex 16 base ! ;', # ( -- ) + + + ": align ; immediate", # ( -- ) + ": aligned ; immediate", # ( a1 -- a2 ) + ": pad here 256 + ;", # ( -- a ) + + ": latest last @ ;", # ( -- a ) + ": recurse latest , ; immediate", # ( -- ) +"also hidden", + ": compile r> skim , >r ;", # ( -- ) + ": postpone ' , ; immediate", # ( -- ) + ": literal ?comp (lit) (lit) , , ; immediate", # ( x -- ) ( -- x ) + ": ['] ' postpone literal ; immediate", # ( -- ) ( -- a ) +"previous", + # --- chars and strings --- + ': char bl parse drop c@ ;', # ( -- c ) + ': [char] char postpone literal ; immediate', # ( -- ) ( -- c ) + ': ctrl char $1F and ;', # ( -- c ) + ': [ctrl] ctrl postpone literal ; immediate', # ( -- ) ( -- c ) + + ': \ 0 parse 2drop ; immediate', # ( -- ) + ': // postpone \ ; immediate', # ( -- ) + + ': s( [char] ) parse ;', # ( -- a n ) + ': ( s( 2drop ; immediate', # ( -- ) + ': .( s( type ;', # ( -- ) +"also hidden", + ': move$ 2dup c! 1+ swap move ;', # ( a1 n a2 -- ) + ': ,s here over 1+ allot move$ ;', # ( a n -- ) + ': ," [char] " parse ,s ;', # ( -- ) + ': s" ?comp [\'] (slit) , ," ; immediate', # ( -- ) ( -- a n ) + ': ." ?comp [\'] (.") , ," ; immediate', # ( -- ) ( -- ) + + + # --- flow control --- +"definitions", + ': resolve here - , ;', # ( a -- ) + ': ?comp skim , @ >r", + " here innerloop exchange", + " mark r> ;", + ": loopcompiler create , , immediate", + " does> ?comp skim >r @ structured r> , dup 1+ resolve if swap then drop ;', # ( x1 x2 -- x1|x2 ) + ': -rot rot rot ;', # ( x1 x2 x3 -- x3 x1 x2 ) + + ': (abort") if -2 dup r> count newerror throw then', + ' r> count + >r ;', + ': abort" ?comp compile (abort") ," ; immediate', # ( f -- ) + + ': link here swap exchange , ;', + ': unlink dup @ ?dup if @ over ! then drop ;', + + # tricky: 'make new constants behave like "true" (which is a constant)' + # tricky: 'make new deferred words behave like "key" (which is a deferred word)' + # tricky: 'make new arrays behave like "keytable" (which is an array)' + # tricky: 'make new vocabularies behave like "forth" (which is a vocabulary)' + ": constant constants link create , [ ' true @ ] literal use ;", + '1 constant cell', + ": defer defers link create cell allot [ ' key @ ] literal use ;", + ": array arrays link create dup , allot [ ' keytable @ ] literal use ;", + ": vocabulary vocabularies link create 0 , 0 , [ ' forth @ ] literal use ;", + ': variable variables link create cell allot ;', + ": value constant ;", # values behave like constants. for now. + ': vocs vocabularies begin @ ?dup while dup 1+ .name space repeat ;', +'previous', + + ': cell+ 1+ ; : char+ 1+ ;', + ': cell- 1- ; : char- 1- ;', + ': cells ; : chars ; ', + + ': range over + swap ;', # ( x1 n -- x2 x1 ) + ': erase 0 fill ;', # ( a n -- ) + ': blank bl fill ;', # ( a n -- ) + ': c, 255 and , ;', # ( c -- ) + + ': within pluck < >r < r> or 0= ;', # ( n1 n2 n3 -- f ) + ': printable bl 127 within ;', # ( c -- f ) + + ': emits swap dup 0> and', # ( u c -- ) + ' 0 ?do dup emit loop drop ;', + ': spaces bl emits ;', # ( u -- ) + + ': >body cell+ ; ', # ( a1 -- a2 ) + ': body> cell- ; ', # ( a1 -- a2 ) + + ': word here >r parse r@ move$ r> ;', # ( c -- a ) + + ': lines >r', # ( a -- ) + ' bl word count', + ' fileopen', + ' begin fileread', + ' while r@ execute', + ' repeat', + ' fileclose rdrop ;', + + ": from fileopen", # ( a n -- ) + " begin fileread", + " while evaluate", + " repeat fileclose ;", + + ': from" [char] " parse from ;', # ( -- ) + + # is and to identical yet but they will check to make sure the target is of proper type + # therefore no factoring in these words, as these are in transition. +"also hidden definitions", + ": (was) r> dup cell+ >r @ >body @ ;", + ": (is) r> dup cell+ >r @ >body ! ;", + ": (to) r> dup cell+ >r @ >body ! ;", +"previous definitions", + +"also hidden", + ": was compiling if compile (was) exit then ' >body @ ; immediate", + ": is compiling if compile (is) exit then ' >body ! ; immediate", + ": to compiling if compile (to) exit then ' >body ! ; immediate", +"previous", + + # --- obsolescent input parsing and vocabulary search. required by dpans94 --- + + ': find dup count hunt', # ( a1 -- a2 0 | a2 1 | a2 -1 ) + ' dup if', # 1: immediate. -1: non-immediate + ' nip dup name>', + ' swap ?imm invert 1 or', + ' then ;', + + # --- pictured number output conversion --- + ': s>d dup 0< ;', # ( x -- d ) + ': <# swap >r pad tuck r> ;', # ( d -- a x a x ) + + ': #> drop nip tuck - ;', # ( a x a x -- a x ) + ': hold rot 1-', # ( a x c -- a x ) + ' dup here < -17 and throw', + ' -rot pluck c! ;', + ': cipher dup 9 > if 7 + then [char] 0 + ;', # ( n -- c ) + ': # base @ u/mod swap cipher hold ;', # ( a x -- a x ) + ': #s begin # dup 0= until ;', # ( a x -- a x ) + ': sign pluck 0< if [char] - hold then ;', # ( x a x -- x a x ) + ': string <# #s sign #> ;', # ( n -- a n ) + ': (.) s>d >r abs r> string ;', # ( n1 -- a n2 ) + ': (u.) 0 string ;', # ( u -- a n ) + ': . (.) type space ;', # ( n -- ) + ': u. (u.) type space ;', # ( u -- ) + ': (.r) over - spaces type ;', # ( a n1 n2 -- ) + ': .r >r (.) r> (.r) ;', # ( n u -- ) + ': u.r >r (u.) r> (.r) ;', # ( u1 u2 -- ) + + ': .b base exchange swap u. base ! ;', # ( n base -- ) + ': .% 2 .b ;', # ( n -- ) + ': .# 10 .b ;', # ( n -- ) + ': .$ 16 .b ;', # ( n -- ) + ': .s depth ?dup if', # ( -- ) + ' for i pick . next', + ' else ." stack empty"', + ' then ;', + ': number ?number 0= -24 and throw ;', # ( a n1 -- n2 ) + + # --- string words + ': /string over min tuck 2>r + 2r> - ;', # ( a n1 n2 -- ) + ': -trailing dup if dup for 1- 2dup + c@ bl <> ?leave next 1+ then ;', + # left/right boundary, centered type + ': typer ( a n1 n2 -- ) over - 0 max spaces type ;', + ': typel ( a n1 n2 -- ) over - 0 max >r type r> spaces ;', + ': typec ( a n1 n2 -- ) over - 0 max dup 2/ dup spaces - >r type r> spaces ;', + + # --- 'char, ^ctrlchar, >shellcommand input +"also hidden definitions", + ': toshell 1 /string drop 0 parse + over -', # ( a n -- ) + ' compiling if compile (slit) ,s compile then shell ;', + ": andchar nip swap 1+ c@ and compiling if postpone literal then ;", # ( a n -- c ) + ": tochar 255 andchar ;", # ( a n -- c ) + ": toctrl 31 andchar ;", # ( a n -- c ) + ': dispatchable s" \'^>" rot scan nip ;', # ( c -- u ) + " create action ] toshell toctrl tochar [", + ': dispatch action + @ execute ;', # ( a n1 n2 -- ? ) + ": prefixes over c@ dispatchable ?dup if 1- dispatch exit then", + #" 2dup analyze_input if process_input exit then", + " (notfound) ;", + "' prefixes is notfound", # ( a n -- ? ) + + ': .? dup defined if . else drop ." undefined" then ;', + ': .linknames', + ' >r begin @ ?dup', + ' while dup 1+', + ' dup cr .name ." : "', + ' >body @ r@ execute', + ' repeat rdrop cr ;', + + ": .variables variables ['] .? .linknames ;", + ": .constants constants ['] . .linknames ;", + ": .arrays arrays ['] . .linknames ;", + ": .defers defers ['] .name .linknames ;", + ": .vocs vocabularies ['] . .linknames ;", + ": user_interrupt -28 throw ;", +"previous definitions", + + ': shell: create ," does> count shell ;', + 'shell: page clear', + 'shell: ps ps auxf|pager', + 'shell: sh bash', + + ': command: create does> drop source shell postpone \ ;', + 'command: ls', + ': cls page ;', + ': commandline ." (ctrl-D to exit)" sh ." ok" cr ;', + ': .keys -1 keytable @ 0 do', + ' i keytable @', + ' ?dup if', + " dup ['] nop <> if", + ' cr ." ctrl-" i \'@ + emit', + ' 3 spaces dup .name', + ' then', + ' drop', + ' then', + ' loop cr ;', + + # "0 keytable -1 keytable @ ' nop fill", + "0 keytable bl ' nop fill", + ": bindkey keytable ! ;", + +"also hidden", + "' .arrays ^A bindkey", + "' .constants ^B bindkey", + "' user_interrupt ^C bindkey", + "' commandline ^D bindkey", + "' .defers ^E bindkey", + " 0 ^H bindkey", + " 0 ^I bindkey", + " 0 ^J bindkey", + "' .keys ^K bindkey", + "' page ^L bindkey", + "' order ^O bindkey", + "' bye ^Q bindkey", + "' .variables ^V bindkey", + "' words ^W bindkey", + "' .vocs ^X bindkey", + + ': fkey', + ' begin (key)', + ' dup bl < 0= unless', + ' dup keytable @', + ' ?dup while', + ' execute drop', + ' repeat ;', + + ': accept >r 0', # ( a n1 -- n2 ) + ' begin dup r@ <>', + ' while fkey dup 10 =', + ' if r> 2drop dup >r', + ' else decode', + ' then', + ' repeat swap r> 2drop ;', + + ': query tib dup tibsize accept dup #tib ! pushsource space ;', +"definitions", + ": (quit) empty postpone [ begin query interpret prompt again ;", + "' (quit) is quit", + ': (prompt) compiling 0= if ." ok" depth 0 ?do \'. emit loop then cr ;', + "' (prompt) is prompt", +"previous definitions", + + #": recent context @ >body @ ;", + ": :noname ?exec here [ latest @ ] literal , ] ; immediate", + + ': up s" ./up" shell ;', + ': doc s" ./doc" shell ;', + + #": bogo 1000000 0 do loop bye ; bogo", + #' from hexdump.4th', + + # -- time + ": time ( -- secs ) epoch 86400 mod ;", + ": ##: ( u1 -- u2 ) base @ >r decimal # 6 base ! # ': hold r> base ! ;", + ": .now ( -- ) time s>d <# ##: ##: #s #> type ;", + ": now ( -- s m h ) time 60 /mod 60 /mod ;", + + # load site-forth.4th at start + ' :noname ( -- ) s" /usr/local/share/perlforth/site-forth.4th" from ; catch drop', +# ' \ dup -38 <> and throw', + + '.( Threaded Code Interpreter in Perl, version )', + " version s>d <# # # '. hold #s #> type", + " '. emit here . cr space", + + + ); + + +# -------- virtual machine data -------- +# VM memory +my @m; # main memory +my @s; # user stack +my @r; # return stack + +# global VM registers +my $sp; # user stack pointer +my $rp; # return stack pointer +my $w; # word pointer +my $ip; # instruction pointer + +# global interpreter/compiler variables +my $dp = 0; # pointer to free VM mem +my $wc = 0; # word count, analog the name field address +my @header; # word headers +my @body; # pointers to word code fields +my @voclink; # pointer to index of next word of same vocabulary +my @precedence; # reveal/precedence flags per word + +my $parsebuf; # pointer to current source buffer +my $parsebuflen; # size of current source buffer +my @sourcestack; # holds nested source buffer +my %does; # helper hash for create .. does> simplification +my $catchframe = 0; # pointer to prev catch/throw context (or 0) + + + +my $maxu = (-1|0); # determine cell size in bits + $maxu = $cell if ($cell); # or use override +my $wrap = $maxu+1; # modulo for trimming results to fit into cell +my $msb = 1; # value with only the most significant bit set +my $bits = 1; +for (;$msb<$wrap/2;$msb+=$msb) {$bits++} +#print "$msb, $bits"; + +my $revealbit = 1; +my $precedencebit = 2; + +# variables residing in interpreter virtual memory space. + +sub comma { + $m[$dp] = shift(@_); + return $dp++; +} + + +my @vocstack; +my $xlaststore = comma 0; +my $xcurrentstore = comma 0; +my $xcontextstore = comma 0; + + +# -------- virtual machine -------- + +#$meow = $model ? sub { 'purr' } : sub { q/=^_^=/ }; $meow->(); + +sub nest { $r[++$rp] = $ip; $ip = $w+1; } +sub unnest { $ip = $r[$rp--]; } +my $unnest = $dp; +$m[$dp++] = \&unnest; + +sub doconst { $s[++$sp] = $m[$w+1]; } +sub dovar { $s[++$sp] = $w+1; } +sub dodefer { $w = $m[$w+1]; $m[$w](); } +sub dovoc { $m[$xcontextstore] = $w; } + + +# -------- vocabularies -------- + +sub reveal { $precedence[$wc-1] |= $revealbit; } +sub immediate { $precedence[$wc-1] |= $precedencebit; } +sub hide { $precedence[$wc-1] &= ~$revealbit; } + +sub header { + $header[$wc] = shift(@_); + $body[$wc] = $dp; + $precedence[$wc] = 0; + $voclink[$wc] = $m[$m[$xcurrentstore]+2]; + $m[$xlaststore] = $dp; + $m[$m[$xcurrentstore]+1] = $dp; + $m[$m[$xcurrentstore]+2] = $wc; + $wc++; + return $dp; +} + + +sub xlink { + my $anchor = (shift(@_))+1; + ($m[$anchor], $m[$dp]) = ($dp, $m[$anchor]); + $dp++; +} + +sub allot { $dp += shift(@_); } + +my $xvocabularies = comma \&dovar; comma 0; # a hand-built variable, needed early.(for linking + # vocabularies needed to contain the link anchors + # of variables, constant, vocabularies...) +sub vocabulary { + xlink $xvocabularies; + my $addr = comma \&dovoc; comma 0; comma 0; # last cfa, last wc. + return $addr; +} + +my $xonlyvoc = vocabulary; sub only { $m[$xcontextstore] = $xonlyvoc; } +my $xforth = vocabulary; sub forth { $m[$xcontextstore] = $xforth; } +my $xhidden = vocabulary; sub hidden { $m[$xcontextstore] = $xhidden; } + +sub definitions { $m[$xcurrentstore] = $m[$xcontextstore] } + +hidden; definitions; +header ""; # must be header 0 (0 represents end + # of chain, common for all vocabularies) + +# to do: +# hand-craft a link anchor, used as link anchor for list of link anchors here. +# link "vocabularies" link anchor to this link anchor. later, create a header, +# link "anchors" to itself. moala - mother of all link anchors. + +header "vocabularies"; reveal; # header for vocabularies link anchor. +$body[$wc-1] = $xvocabularies; + +only; definitions; +header "forth"; reveal; +$body[$wc-1] = $xforth; + +forth; definitions; +header "only"; reveal; +$body[$wc-1] = $xonlyvoc; + +header "hidden"; reveal; +$body[$wc-1] = $xhidden; + + +# -------- macros: defining words -------- #FOLD00 + + +sub compile { + my $addr = $dp; + foreach my $i (0..$#_) { + comma $_[$i]; + } + return $addr; +} + +sub colon { + header shift(@_); + return compile \&nest; +} + +sub semicolon { + compile $unnest; + reveal; +} + +sub unnamedprimitive { + return compile shift(@_); +} + +sub primitive { + header shift(@_); + reveal; + return compile shift(@_); +} + +sub create { + header shift(@_); + reveal; + return compile \&dovar; +} + +sub xnop { } +my $xnop = primitive "nop", \&xnop; + + +hidden; definitions; +my $xconstants = create "constants"; comma 0; +sub constant { + xlink $xconstants; + header shift(@_); + reveal; + return compile \&doconst, shift(@_); +} + +my $xvariables = create "variables"; comma 0; +sub variable { + xlink $xvariables; + header shift(@_); + reveal; + return compile \&dovar, shift(@_); +} + +sub alias { + my $cfa = $body[$wc-1]; + header shift(@_); + reveal; + $body[$wc-1] = $cfa; + return $cfa; +} + + +my $xdefers = create "defers"; comma 0; +sub defer { + xlink $xdefers; + header shift(@_); + reveal; + return compile \&dodefer, shift(@_); +} + +# ( a n -- ) packs chars at $m[$a..$a+n-1] into string which is returned. +sub string { + my $x2 = $s[$sp--]&$cell; + my $x1 = $s[$sp--]&$cell; + return pack "W*",@m[$x1..$x1+$x2-1]; +} + +# ( a -- n ) unpacks chars of string par to $m[$a..] +sub unstring { + my @arg = unpack "W*", $_[0]; + $w = @arg; + (my $addr, $s[$sp]) = ($s[$sp], $w); + @m[$addr..$addr+$w-1] = @arg; +} + +# -------- vocabularies search order -------- #FOLD00 + +only; definitions; +sub xalso { push @vocstack, $m[$xcontextstore]; } +primitive "also", \&xalso; + +forth; definitions; +my $xlast = constant "last", $xlaststore; + +constant "context", $xcontextstore; +constant "current", $xcurrentstore; + +sub xprevious { + $m[$xcontextstore] = pop @vocstack if ($#vocstack >= 0); +} +primitive "previous", \&xprevious; + +sub xonly { + $m[$xcontextstore] = $xonlyvoc; + @vocstack = $xonlyvoc; +} +my $xonly = primitive "only", \&xonly; + +sub xdefinitions { $m[$xcurrentstore] = $m[$xcontextstore]; } +primitive "definitions", \&xdefinitions; + +# -------- error handling -------- #FOLD00 + + +my %throwmessage = ( + -1 => "aborted", + -2 => "aborted", + -3 => "stack overflow", + -4 => "stack underflow", + -5 => "return stack overflow", + -6 => "return stack underflow", +# -7 => "do loops nested too deeply", +# -8 => "dictionary overflow", + -9 => "invalid memory address", + -10 => "division by zero", + -11 => "result out of range", + -12 => "argument type mismatch", + -13 => "word not found", + -14 => "use only during compilation", + -15 => "invalid forget", + -16 => "attempt to use zero-length string as name", + -17 => "pictured numeric output string overflow", + -18 => "parsed string overflow", +# -19 => "word name too long", + -20 => "write to a read-only location", + -21 => "unsupported operation", + -22 => "unstructured", +# -23 => "address alignment exception", + -24 => "invalid numeric argument", + -25 => "return stack imbalance", + -26 => "loop parameters unavailable", + -27 => "invalid recursion", + -28 => "user interrupt", + -29 => "compiler nesting", + -30 => "obsolescent feature", + -31 => ">BODY used on non-CREATEd definition", + -32 => "invalid name argument", + -33 => "Block read exception", + -34 => "Block write exception", + -35 => "Invalid block number", + -36 => "Invalid file position", + -37 => "File I/O exception", + -38 => "File not found", + +# additional error messages: + -64 => "use only while interpreting", + -65 => "executed BODY> on a non-body address", + -67 => "TO must be used on a VALUE", + -72 => "Invalid memory region specifier, or heap corrupted", +); + +# used by abort" to introduce new abort messages +sub xnewerror { # ( n1 a n2 -- ) + $throwmessage{$s[$sp--]} = string; +} +primitive "newerror", \&xnewerror; + + +# executed at the end of word executed by catch. +sub xbrthrow0 { + ($ip, $sp, $catchframe) = @r[$rp-2..$rp]; # restore previous catch context + $rp -= 3; + $s[$sp] = 0; # throw value 0 +} +my $xbrthrow0 = compile unnamedprimitive \&xbrthrow0; # not a primitive - returning to. + +sub xexecute { $w = $s[$sp--]; $m[$w](); } +my $xexecute = primitive "execute", \&xexecute; + + +# ( a -- x ) +sub xcatch { + $rp += 3; # room for new catch frame + @r[$rp-2..$rp] = ($ip, $sp, $catchframe); # save previous catch context + $catchframe = $rp; # point to this catch frame + $r[++$rp] = $xbrthrow0; # inject return address to throw0 + xexecute; # call word running under catch +} +my $xcatch = primitive "catch", \&xcatch; + + +# ( err -- ) +sub throw { + my $exception = shift; # throw value other than 0? + if ($exception) { + if ($catchframe) { # does previous catch frame exist? + $rp = $catchframe; # yes: point to prev catch frame + ($ip, $sp, $catchframe) = @r[$rp-2..$rp]; # restore previous catch context + $rp -= 3; + $s[$sp] = $exception; # return throw value + } else { # throw without catch: top level + die $exception; + } + } +} +sub xthrow { throw $s[$sp--]; } +my $xthrow = primitive "throw", \&xthrow; + +hidden; definitions; +sub xbrerror { throw -1; } +sub xstackunderflow { throw -4; } +sub xbrnotfound { throw -13; } +my $xbrerror = primitive "(error)", \&xbrerror; +my $xstackunderflow = unnamedprimitive \&xstackunderflow; +my $xbrnotfound = primitive "(notfound)", \&xbrnotfound; +my $xnotfound = defer "notfound", $xbrnotfound; +my $xlastword = create "lastword"; allot 2; +forth; definitions; +my $xerror = defer "error", $xbrerror; + +# -------- run time words: literals and flow control -------- + +hidden; definitions; +sub xlit { $s[++$sp] = $m[$ip++]; } +my $xlit = primitive "(lit)", \&xlit; + +sub xslit { + my $count = $m[$ip++]; + $sp += 2; + @s[$sp-1..$sp] = ($ip, $count); + $ip += $count; +} +my $xslit = primitive '(slit)', \&xslit; + +sub xbrdotquote { xslit; print string; } +my $xbrdotquote = primitive '(.")', \&xbrdotquote; + + +sub xbranch { $ip += $m[$ip]; } +my $xbranch = primitive "(branch)", \&xbranch; + +sub xbranch0 { + if ($s[$sp--]) { + $ip++; + } else { + $ip += $m[$ip]; + } +} +my $xbranch0 = primitive "(0branch)", \&xbranch0; + +sub xbrfor { + $r[++$rp] = $s[$sp]-1; + $r[++$rp] = $s[$sp--]-1; + $ip++; +} +my $xbrfor = primitive "(for)", \&xbrfor; + +sub xbrnext { + if ($r[$rp]--) { + $ip += $m[$ip]; + } else { + $rp -= 2; + $ip++; + } +} +my $xbrnext = primitive "(next)", \&xbrnext; + +sub xbrdo { + $rp += 2; + @r[$rp-1..$rp] = @s[$sp-1..$sp]; + $sp -= 2; + $ip++; +} + + +my $xbrdo = primitive "(do)", \&xbrdo; + +sub xbrqdo { + if ($s[$sp] == $s[$sp-1]) { + $ip += $m[$ip]; + } else { + $rp += 2; + @r[$rp-1..$rp] = @s[$sp-1..$sp]; + $ip++ ; + } + $sp -= 2; +} +my $xbrqdo = primitive "(?do)", \&xbrqdo; + +sub xbrleave { + $rp -= 2; + $ip = $m[$ip]; + $ip += $m[$ip]; +} +my $xbrleave = primitive "(leave)", \&xbrleave; + +sub xbrqleave { + if ($s[$sp--]) { + xbrleave; + } else { + $ip++; + } +} +my $xbrqleave = primitive "(?leave)", \&xbrqleave; + +sub xbrloop { + if (++$r[$rp] != $r[$rp-1]) { # index+1 != limit + $ip += $m[$ip]; # add branch offset to instruction pointer + } else { + $rp -= 2; # discard loop parameters + $ip++; # skip branch offset + } +} +my $xbrloop = primitive "(loop)", \&xbrloop; + +sub xbrplusloop { # determine loop exit condition by simulating sign overflow: + $w = $r[$rp] - $r[$rp-1]; # temp = index-limit + $r[$rp] += $s[$sp--]; # index += loop increment + if ((($r[$rp] - $r[$rp-1]) ^ $w) < $msb) { # sign change of index-limit before and after? + $ip += $m[$ip]; # no: add branch offset to instruction pointer + } else { + $rp -= 2; # yes: exit loop: discard loop parameters + $ip++; # skip branch offset + } +} +my $xbrplusloop = primitive "(+loop)", \&xbrplusloop; + +sub xbrunloop { $rp -= 2; } +my $xbrunloop = primitive "(unloop)", \&xbrunloop; + +sub doarray { + if (($s[$sp] < $m[$w+1]) && ($s[$sp] >= -1)) { # legal index. -1 addresses array size + $s[$sp] += ($w+2); # index > address + } else { + throw -24; + } +} + +my $xarrays = create "arrays"; comma 0; +sub array { + xlink $xarrays; + header shift(@_); + reveal; + my $cfa = compile \&doarray; + my $count = shift(@_); + comma $count; + allot $count; + return $cfa; +} + +forth; definitions; + +# -------- constants, variables -------- #FOLD00 + +my $xesc = constant "esc", 27; +my $xbl = constant "bl", 32; +my $xfalse = constant "false", 0; +my $xzero = alias "0"; +my $xtrue = constant "true", -1; +my $xminusone = alias "-1"; + constant "msb", $msb; + constant "maxu", $maxu; +my $xstate = variable "state", 0; +my $xbase = variable "base", 10; +my $xhashtib = variable "#tib", 0; +my $xtoin = variable ">in", 0; +my $xinnerloop = variable "innerloop", 0; +my $xtib = create "tib"; allot $tibsize; + constant "version", int $version; + constant "tibsize", $tibsize; +my $xkeytable = array "keytable", 32; + + +# -------- stack handling -------- + + +sub xdrop { $sp--; } +sub xrdrop { $rp--; } +sub x2drop { $sp -= 2; } +sub xsp { $s[++$sp] = $sp; } +sub xrp { $s[++$sp] = $rp; } +sub xdup { $s[++$sp] = $s[$sp]; } +sub xqdup { $s[++$sp] = $s[$sp] if ( $s[$sp]); } +sub xover { $s[++$sp] = $s[$sp-1]; } +sub xnip { $s[$sp] = $s[$sp--]; } +sub xpick { $s[$sp] = $s[$sp-$s[$sp]-1]; } +sub xdepth { $s[++$sp] = $sp; } +sub xswap { @s[$sp-1..$sp] = ($s[$sp], $s[$sp-1]); } +sub xrot { @s[$sp-2, $sp-1, $sp] = @s[$sp-1, $sp, $sp-2]; } +sub x2dup { $sp += 2; @s[$sp-1..$sp] = @s[$sp-3..$sp-2]; } +sub x2over { $sp += 2; @s[$sp-1..$sp] = @s[$sp-5..$sp-4]; } +sub x2swap { @s[$sp-3..$sp] = (@s[$sp-1..$sp], @s[$sp-3..$sp-2]);} +sub xtor { $r[++$rp] = $s[$sp--]; } +sub xrfrom { $s[++$sp] = $r[$rp--]; } +sub xrfetch { $s[++$sp] = $r[$rp]; } +sub x2tor { $r[++$rp] = $s[$sp--]; + $r[++$rp] = $s[$sp--]; } +sub x2rfrom { $s[++$sp] = $r[$rp--]; + $s[++$sp] = $r[$rp--]; } +sub x2rfetch { $s[++$sp] = $r[$rp]; + $s[++$sp] = $r[$rp-1]; } + + +my $xdup = primitive "dup", \&xdup; +my $xqdup = primitive "?dup", \&xqdup; +my $xdrop = primitive "drop", \&xdrop; +my $xover = primitive "over", \&xover; +my $xswap = primitive "swap", \&xswap; +my $xrot = primitive "rot", \&xrot; +my $xnip = primitive "nip", \&xnip; +my $x2dup = primitive "2dup", \&x2dup; +my $x2drop = primitive "2drop", \&x2drop; +my $x2swap = primitive "2swap", \&x2swap; +my $x2over = primitive "2over", \&x2over; +my $xpick = primitive "pick", \&xpick; +my $xdepth = primitive "depth", \&xdepth; +my $xtor = primitive ">r", \&xtor; +my $xrfrom = primitive "r>", \&xrfrom; +my $xrfetch = primitive "r@", \&xrfetch; +my $xrdrop = primitive "rdrop", \&xrdrop; +my $x2tor = primitive "2>r", \&x2tor; +my $x2rfrom = primitive "2r>", \&x2rfrom; +my $x2rfetch = primitive "2r@", \&x2rfetch; + primitive "rp", \&xrp; + primitive "sp", \&xsp; + + +# -------- flow control -------- #FOLD00 + + +my $xexit = primitive "exit", \&unnest; + +sub xi { $s[++$sp] = $r[$rp]; } +my $xi = primitive "i", \ξ + +sub xj { $s[++$sp] = $r[$rp-2]; } +my $xj = primitive "j", \&xj; + +sub xuse { $m[$body[$wc-1]] = $s[$sp--]; } +my $xuse = primitive "use", \&xuse; + +sub xunless { $ip = $r[$rp--] if ($s[$sp--]) } +my $xunless = primitive "unless", \&xunless; + +sub xbye { print "\n"; exit; } +my $xbye = primitive "bye", \&xbye; + + +sub XIF { + comma $xbranch0; + $s[++$sp] = $dp++; +} + +sub XELSE { + comma $xbranch; + my $offs = $s[$sp]; + $s[$sp] = $dp++; + $m[$offs] = $dp-$offs; +} + +sub XTHEN { + $m[$s[$sp]] = $dp-$s[$sp]; + $sp--; +} + +sub XBEGIN { + $s[++$sp] = $dp; +} + +sub XAGAIN { + comma $xbranch; + comma $s[$sp--]-$dp; +} + +sub XUNTIL { + comma $xbranch0; + comma $s[$sp--]-$dp; +} + +sub XWHILE { + XIF; +} + +sub XREPEAT { + xswap; + XAGAIN; + XTHEN; +} + + +# -------- bitwise logic -------- #FOLD00 + +sub xand { + $s[$sp-1] &= ($s[$sp--] % $wrap); + $s[$sp]-=$wrap if $s[$sp]>=$msb; +} +my $xand = primitive "and", \&xand; + +sub xor { + $s[$sp-1] |= ($s[$sp--] % $wrap); + $s[$sp]-=$wrap if $s[$sp]>=$msb; +} +my $xor = primitive "or", \&xor; + +sub xxor { + $s[$sp-1] ^= ($s[$sp--] % $wrap); + $s[$sp]-=$wrap if $s[$sp]>=$msb; +} +my $xxor = primitive "xor", \&xxor; + +sub xinvert { + $s[$sp] ^= -1; + $s[$sp]-=$wrap if $s[$sp]>=$msb; +} +my $xinvert = primitive "invert", \&xinvert; + +sub x2mul { + $s[$sp] <<= 1; + $s[$sp]-=$wrap if $s[$sp]>=$msb; +} +my $x2mul = primitive "2*", \&x2mul; + +sub x2div { + $s[$sp] >>= 1; +} +my $x2div = primitive "2/", \&x2div; + +sub xrshift { + $s[$sp-1] >>= ($s[$sp--] & $bits-1); +} +my $xrshift = primitive "rshift", \&xrshift; +alias ">>"; + +sub xlshift { + $s[$sp-1] <<= ($s[$sp--] & $bits-1); + $s[$sp]%=$wrap; + $s[$sp]-=$wrap if $s[$sp]>=$msb; +} +my $xlshift = primitive "lshift", \&xlshift; +alias "<<"; + + + +# -------- comparison -------- + + +sub xequals { $s[--$sp] = -($s[$sp] == $s[$sp-1]); } +my $xequals = primitive "=", \&xequals; + +sub xnotequals { $s[--$sp] = -($s[$sp] != $s[$sp-1]); } +my $xnotequals = primitive "<>", \&xnotequals; + +sub xless { my $tos = $s[$sp--]; $s[$sp] = -($s[$sp] < $tos); } +my $xless = primitive "<", \&xless; + +sub xuless { my $tos = $s[$sp--]|0; $s[$sp] = -(($s[$sp]|0) < $tos); } +my $xuless = primitive "u<", \&xuless; + +sub xgreater { my $tos = $s[$sp--]; $s[$sp] = -($s[$sp] > $tos); } +my $xgreater = primitive ">", \&xgreater; + +sub xugreater { my $tos = $s[$sp--]|0; $s[$sp] = -(($s[$sp]|0) > $tos); } +my $xugreater = primitive "u>", \&xugreater; + +sub xzeroequals { $s[$sp] = -(!$s[$sp]); } +my $xzeroequals = primitive "0=", \&xzeroequals; + +sub xzeronotequals { $s[$sp] = -(!!$s[$sp]); } +my $xzeronotequals = primitive "0<>", \&xzeronotequals; + +sub xzeroless { $s[$sp] = -($s[$sp] < 0); } +my $xzeroless = primitive "0<", \&xzeroless; + +sub xzeromore { $s[$sp] = -($s[$sp] > 0); } +my $xzeromore = primitive "0>", \&xzeromore; + + +# -------- arithmetic -------- + + +sub xoneplus { + $s[$sp]++; + $s[$sp] -= $wrap if $s[$sp] >= $msb; +} +my $xoneplus = primitive "1+", \&xoneplus; + +sub xoneminus { + $s[$sp]--; + $s[$sp] += $wrap if $s[$sp] < -$msb; +} +my $xoneminus = primitive "1-", \&xoneminus; + + +sub xplus { + $s[$sp-1] += $s[$sp--]; + $s[$sp]%=$wrap; + $s[$sp]-=$wrap if $s[$sp] >= $msb; +} +my $xplus = primitive "+", \&xplus; + +sub xminus { + $s[$sp-1] -= $s[$sp--]; + $s[$sp]%=$wrap; + $s[$sp]-=$wrap if $s[$sp] >= $msb; +} +my $xminus = primitive "-", \&xminus; + +sub xmul { + $s[$sp-1] *= $s[$sp--]; + $s[$sp]%=$wrap; + $s[$sp]-=$wrap if $s[$sp] >= $msb; +} +my $xmul = primitive "*", \&xmul; + +sub xdiv { + if (!$s[$sp]) { throw -10; } + $s[$sp-1] /= $s[$sp--]; +} +my $xdiv = primitive "/", \&xdiv; + +sub xmod { + if (!$s[$sp]) { throw -10; } + $s[$sp-1] %= $s[$sp--]; +} +my $xmod = primitive "mod", \&xmod; + +sub xstarslash { + if (!$s[$sp]) { throw -10; } + $s[$sp-2] *= $s[$sp-1]; + $s[$sp-2] /= $s[$sp]; + $sp -= 2; + $s[$sp]%=$wrap; + $s[$sp]-=$wrap if $s[$sp] >= $msb; +} +my $xstarslash = primitive "*/", \&xstarslash; + +# ( n1 n2 -- n3 n4 ) +sub xslashmod { + @s[$sp-1..$sp] = ($s[$sp-1]%$s[$sp], int $s[$sp-1]/$s[$sp]); +} +my $xslashmod = primitive "/mod", \&xslashmod; + + +# ( n1 n2 -- n3 n4 ) +sub xuslashmod { + $s[$sp-1]%=$wrap; + @s[$sp-1..$sp] = ($s[$sp-1]%$s[$sp], int $s[$sp-1]/$s[$sp]); +} +my $xuslashmod = primitive "u/mod", \&xuslashmod; + + +sub xstarslashmod { + if (!$s[$sp]) { throw -10; } + $s[$sp-2] *= $s[$sp-1]; + @s[$sp-2..$sp-1] = ($s[$sp-2]%$s[$sp], int $s[$sp-2]/$s[$sp]); + $s[$sp]%=$wrap; + $s[$sp]-=$wrap if $s[$sp] >= $msb; + $sp--; +} +my $xstarslashmod = primitive "*/mod", \&xstarslashmod; + +sub xabs { $s[$sp] = abs($s[$sp]); } +my $xabs = primitive "abs", \&xabs; + +sub xnegate { $s[$sp] = -$s[$sp]; } +my $xnegate = primitive "negate", \&xnegate; + + +# -------- memory access -------- #FOLD00 + + +sub xfetch { $s[$sp] = $m[$s[$sp]&$cell]; } +my $xfetch = primitive "@", \&xfetch; + +sub xcfetch { $s[$sp] = $m[$s[$sp]&$cell] & 255; } +my $xcfetch = primitive "c@", \&xcfetch; + +# ( a -- d ) +sub x2fetch { + my $addr = $s[$sp++]&$cell; + @s[$sp-1..$sp] = @m[$addr..$addr+1]; +} +my $x2fetch = primitive "2@", \&x2fetch; + +sub xstore { + $m[$s[$sp]&$cell] = $s[$sp-1]; + $sp-=2; +} +my $xstore = primitive "!", \&xstore; + +sub xcstore { + $m[$s[$sp]&$cell] = $s[$sp-1] & 255; + $sp-=2; +} +my $xcstore = primitive "c!", \&xcstore; + +# ( d a -- ) +sub x2store { + my $addr = $s[$sp--]&$cell; + @m[$addr..$addr+1] = @s[$sp-1..$sp]; + $sp -= 2 +} +my $x2store = primitive "2!", \&x2store; + +sub xplusstore { + $m[$s[$sp]&$cell] += $s[$sp-1]; + $sp-=2; +} +my $xplusstore = primitive "+!", \&xplusstore; + +sub xcount { $s[++$sp] = $m[$s[$sp]++&$cell] & 255; } +my $xcount = primitive "count", \&xcount; + +sub xskim { $s[++$sp] = $m[$s[$sp]++&$cell]; } +my $xskim = primitive "skim", \&xskim; + +sub xon { $m[$s[$sp--]&$cell] = -1; } +my $xon = primitive "on", \&xon; + +sub xoff { $m[$s[$sp--]&$cell] = 0; } +my $xoff = primitive "off", \&xoff; + +# ( x1 a -- x2 ) +sub xexchange { + my $addr = $s[$sp--]&$cell; + ($m[$addr], $s[$sp]) = ($s[$sp], $m[$addr]); +} +my $xexchange = primitive "exchange", \&xexchange; + +# ( a1 n1 c -- a2 n2 ) +sub xskip { + my $char = $s[$sp--]; + (my $addr, my $len) = @s[$sp-1..$sp]; + while (($m[$addr&$cell] == $char) && ($len)) { + $addr++; + $len--; + } + @s[$sp-1..$sp] = ($addr, $len); +} +my $xskip = primitive "skip", \&xskip; + +# ( a1 n1 c -- a2 n2 ) +sub xscan { + my $char = $s[$sp--]; + (my $addr, my $len) = @s[$sp-1..$sp]; + while (($m[$addr&$cell] != $char) && ($len)) { + $addr++; + $len--; + } + @s[$sp-1..$sp] = ($addr, $len); +} +my $xscan = primitive "scan", \&xscan; + +# ( src dst n -- ) +sub xmove { + (my $src, my $dest, my $count) = @s[$sp-2..$sp]; + @m[$dest..$dest+$count-1] = @m[$src..$src+$count-1]; + $sp-=3; +} +my $xmove = primitive "move", \&xmove; + +# ( a n c -- ) +sub xfill { + (my $dest, my $count, my $char) = @s[$sp-2..$sp]; + @m[$dest..$dest+$count-1] = ($char) x $count; + $sp-=3; +} +my $xfill = primitive "fill", \&xfill; + + + +# -------- number conversion -------- #FOLD00 + + +my %radixprefix = ( + '%' => 2, + '&' => 8, + '#' => 10, + '$' => 16, + '_' => 36, +); + +# ( a n -- x -1 | 0 ) +sub xqnumber { + my $sign = 0; + my $accu = 0; # accumulator + my $valid = -1; # assume valid number + + my $i = $s[$sp--]; # number of digits to test/convert + $w = $s[$sp--]; # addr of next digit + + if ($m[$w] == 45) { # leading - + $sign--; + $w++; # strip + $i--; + } + + my $radix = $m[$xbase+1]; # assume radix from base + if (defined $radixprefix{chr $m[$w]}) { # but if radix prefix, + $radix = $radixprefix{chr $m[$w]}; # use radix for prefix + $w++; # strip prefix + $i--; + } + + for (; $i; $i--) { # for all digits + my $digit = $m[$w++] - 48; # read digit + if (($digit < 0) || (($digit > 9) && ($digit < 17))) { + $valid = 0; + last; + } + $digit -= 7 if ($digit > 9 ); # remove gap between 9 and A + $digit -= 32 if ($digit > 41); # a..z -> A..Z + if (($digit < 0) || ($digit >= $radix)) { + $valid = 0; + last; + } + ($accu *= $radix) += $digit; + } + + if ($valid) { + $accu = -$accu if ($sign); + $accu %= $wrap; + $accu -= $wrap if $accu >= $msb; + $s[++$sp] = $accu; + } + $s[++$sp] = $valid; +} +my $xqnumber = primitive "?number", \&xqnumber; + +# -------- output -------- #FOLD00 + + +sub xcr { print "\n"; } +my $xcr = primitive "cr", \&xcr; + +sub xemit { printf "%c",$s[$sp--]; } +my $xemit = primitive "emit", \&xemit; + +sub xdotslit { print $m[$ip++]; } +my $xdotslit = unnamedprimitive \&xdotslit; + +sub xspace { print " "; } +my $xspace = primitive "space", \&xspace; + +# ( a n -- ) +sub xtype { print string; } +my $xtype = primitive "type", \&xtype; + + +# -------- character input -------- #FOLD00 + + + +my $keybuffer; +# ( -- c ) lowest level key input word +sub xbrkey { + my $key = $keybuffer; + $keybuffer = 0; + if (!$key) { + ReadMode 4; + $key = ReadKey(0); + ReadMode 0; + } + $s[++$sp] = ord $key; +} +my $xbrkey = primitive "(key)", \&xbrkey; +my $xkey = defer "key", $xbrkey; + + +sub xqkey { + if ($keybuffer) { + $s[++$sp] = -1; + } else { + ReadMode 4; + $keybuffer = ReadKey(-1); # possible race condition resulting in occasional echoing + ReadMode 0; + $s[++$sp] = -(defined $keybuffer); + } +} +my $xqkey = primitive "key?", \&xqkey; + + +# -------- buffered I/O -------- #FOLD00 + + +# read string, delimited by c. return address and len +# updates source +# ( c -- a n ) +sub xparse { + my $delimiter = $s[$sp]; + my $bufend = $parsebuf + $parsebuflen; # first non-buf address + $w = $m[$xtoin+1] + $parsebuf; # parse address + my $nxtchar = $m[$w]; + if ($delimiter == 32) { + for (; $w < $bufend;) { + last if (!(defined $nxtchar)); + last if ($nxtchar != $delimiter); + $w++; + $nxtchar = $m[$w]; + } + } + $s[$sp] = $w; + for (; $w < $bufend;) { + last if (!(defined $nxtchar) || ($nxtchar == $delimiter)); + $nxtchar = $m[++$w]; + } + $s[++$sp] = $w - $s[$sp]; + $w++ if ((defined $nxtchar) && ($nxtchar == $delimiter)); + $m[$xtoin+1] = $w - $parsebuf; +} +my $xparse = primitive "parse", \&xparse; + +sub xsource { + $sp += 2; + @s[$sp-1..$sp] = ($parsebuf, $parsebuflen); +} +my $xsource = primitive "source", \&xsource; + +hidden; definitions; +# ( addr len offs -- ) +sub xpushsource { + push @sourcestack, $m[$xtoin+1], $parsebuf, $parsebuflen; + $m[$xtoin+1] = 0; + ($parsebuf, $parsebuflen) = @s[$sp-1..$sp]; + $sp -= 2; +} +my $xpushsource = primitive "pushsource", \&xpushsource; + +sub xpopsource { + $parsebuflen = pop @sourcestack; + $parsebuf = pop @sourcestack; + $m[$xtoin+1] = pop @sourcestack; +} +my $xpopsource = primitive "popsource", \&xpopsource; + + +# ( a n1 asc -- a n2 ) +my $xdecode = colon "decode"; + compile $xdup, $xlit, 127, $xequals; # Del/BS: remove previous + compile $xover, $xlit, 8, $xequals, $xor; + XIF; compile $xdrop; + compile $xdup; + XIF; compile $xdotslit, "\b \b", $xoneminus; XTHEN; + compile $xexit; + XTHEN; + compile $xdup, $xlit, 9, $xequals; # Tab: convert to space + XIF; compile $xdrop, $xbl; XTHEN; + compile $xdup, $xemit; # echo char + compile $xtor, $x2dup, $xplus; # calc buffer address + compile $xrfrom, $xswap, $xstore; # buffer char + compile $xoneplus; # count +semicolon; +forth; definitions; + + +# -------- dictionary and compilation -------- #FOLD00 + + +sub xhere { $s[++$sp] = $dp; } +my $xhere = primitive "here", \&xhere; + +sub xallot { $dp += $s[$sp--]; } +my $xallot = primitive "allot", \&xallot; + +sub xcomma { $m[$dp++&$cell] = $s[$sp--]; } +my $xcomma = primitive ",", \&xcomma; + +my $xstateoff = colon '['; immediate; + compile $xstate, $xoff; +semicolon; + +my $xstateon = colon "]"; + compile $xstate, $xon; +semicolon; + +my $xcompiling = colon "compiling"; + compile $xstate, $xfetch; +semicolon; + +my $xqcomp = colon "?comp"; + compile $xcompiling, $xzeroequals; + compile $xlit, -14, $xand, $xthrow; +semicolon; + +my $xqexec = colon "?exec"; + compile $xcompiling; + compile $xlit, -64, $xand, $xthrow; +semicolon; + + +# -------- vocabulary/wordlist -------- #FOLD00 + + +sub xheader { header string } +my $xheader = primitive "header", \&xheader; +my $xhide = primitive "hide", \&hide; +my $xreveal = primitive "reveal" , \&reveal; +my $ximmediate = primitive "immediate", \&immediate; + +# ( header -- f ) +sub xqimm { + $s[$sp] = -(!!($precedence[$s[$sp]] & $precedencebit)); +} +my $xqimm = primitive "?imm", \&xqimm; + +sub xwords { + my $nfa = $m[$m[$xcontextstore]+2]; + while ($nfa) { + print "$header[$nfa] "; + $nfa = $voclink[$nfa]; + } + xcr; +} +only; definitions; +my $xwords = primitive "words", \&xwords; +forth; definitions; + +sub xnamefrom { $s[$sp] = $body[$s[$sp]]; } +my $xnamefrom = primitive "name>", \&xnamefrom; + + +hidden; definitions; +# returns matching header index, aka nfa, (or 0) +# ( a1 n -- a2 | 0 ) +sub xbrhunt { + my $name = string; + $s[++$sp] = 0; + my $last = $m[$m[$xcontextstore]+2]; + while ($last) { + if ($precedence[$last] & $revealbit) { + if ($header[$last] eq $name) { + $s[$sp] = $last; + last; + } + } + $last = $voclink[$last] + } +} +my $xbrhunt = primitive "(hunt)", \&xbrhunt; +forth; definitions; + +sub xhunt { + x2dup; xbrhunt; + if (!($s[$sp])) { + my $prevcontext = $m[$xcontextstore]; + my $vocstackdepth = $#vocstack; + for my $voc (0..$vocstackdepth) { + my $tempcontext = $vocstack[$vocstackdepth-$voc]; + if ($tempcontext != $prevcontext) { + xdrop; + $m[$xcontextstore] = $tempcontext; + x2dup; xbrhunt; + last if ($s[$sp]); + } + } + $m[$xcontextstore] = $prevcontext; + } + xnip; xnip; +} +my $xhunt = primitive "hunt", \&xhunt; + + + + +# returns matching header index, aka nfa, (or 0) +# ( cfa -- a | 0 ) +sub xtoname { + my $cfa = $s[$sp]; + $s[$sp] = 0; + for (my $i=$wc-1; $i; --$i) { + if ($body[$i] eq $cfa) { + $s[$sp] = $i; + last; + } + } +} +my $xtoname = primitive ">name", \&xtoname; + + +# ( cfa -- a n ) +sub xname { + xtoname; + my $nfa = $s[$sp]; + $s[$sp] = $dp; + $s[++$sp] = 0; + if ($nfa) { + $s[$sp] = $dp; + unstring $header[$nfa]; + } +} +my $xname = primitive "name", \&xname; + + +# ( cfa -- ) +sub xdotname { + xtoname; + print $header[$s[$sp]] if ($s[$sp]); + $sp--; } +my $xdotname = primitive ".name", \&xdotname; + +sub xorder { + print "\ncontext: "; + $s[++$sp] = $m[$xcontextstore]; + xdotname; xspace; xspace; + my $vocstackdepth = $#vocstack; + for my $voc (0..$vocstackdepth) { + $s[++$sp] = $vocstack[$vocstackdepth-$voc]; + xdotname; xspace; + } + $s[++$sp] = $m[$xcurrentstore]; + print "\ncurrent: "; + xdotname; xspace; xcr; +} +only; definitions; +my $xorder = primitive "order", \&xorder; +forth; definitions; + +my $xtick = colon "'"; + compile $xbl, $xparse; + compile $x2dup, $xlastword, $x2store; + compile $xhunt; + compile $xqdup; + XIF; compile $xnamefrom; + XELSE; compile $xnotfound; + XTHEN; +semicolon; + + +my $xcreate = colon "create"; + compile $xbl, $xparse; + compile $xqdup, $xzeroequals, $xlit, -16, $xand, $xthrow; + compile $xheader, $xlit, \&dovar, $xcomma; + compile $xreveal; +semicolon; + + +my $xcolon = colon ":"; immediate; + compile $xcompiling, $xlit, -29, $xand, $xthrow; + compile $xcreate, $xhide; + compile $xlit, \&nest, $xuse; + compile $xstateon; +semicolon; + + +my $xsemicolon = colon ";"; immediate; + compile $xqcomp, $xlit, $xexit, $xcomma, + $xstateoff, $xreveal; +semicolon; + + +# -------- misc -------- #FOLD00 + + +sub xepoch { $s[++$sp] = time; } +my $xepoch = primitive "epoch", \&xepoch; + + +my $xstructured = colon "structured"; + compile $x2dup, $xnotequals; + compile $xlit, -22, $xand, $xthrow; + compile $x2drop; +semicolon; + +sub xdefined { $s[$sp] = -(defined $s[$sp]); } +my $xdefined = primitive "defined", \&xdefined; + +# ( a n -- x ) +sub xshell { + print "\n"; + system string; +} +primitive "shell", \&xshell; + + +# -------- does> -------- #FOLD00 + +sub xdodoes { # cfa of created word revectored here. + $s[++$sp] = $w+1; # push data address of created word + $r[++$rp] = $ip; # nest to hilevel code behind does> + $ip = $does{$w}; +} + +sub xdoes { + $m[$body[$wc-1]] = \&xdodoes; # revector created word to point to dodoes + $does{$body[$wc-1]} = $ip; # does> code pointer hashed to key "body address" + $ip = $r[$rp--]; # unnest, preventing execution of does> code now +} +primitive "does>", \&xdoes; + + +# -------- interpreter/compiler -------- #FOLD00 + +# ( a n -- x -1 | d -1 | r -1 | -1 | 0 ) +sub xinterpretnumber { + xqnumber; + if ($s[$sp] && $m[$xstate+1]) { # number valid while compiling? + $dp += 2; + @m[$dp-2..$dp-1] = ($xlit, $s[--$sp]); # yes: compile number as literal + $s[$sp] = -1; # and remove from stack. + } +} +my $xinterpretnumber = unnamedprimitive \&xinterpretnumber; + + +hidden; definitions; +# ( -- ) +my $xbrinterpret = colon "(interpret)"; + XBEGIN; compile $xbl, $xparse; # pull in string from buffered input + compile $xdup; + XWHILE; compile $x2dup, $xlastword, $x2store; # keep copy for literal or error + compile $xhunt, $xqdup; # got string, look up in dictionary + XIF; # found in dictionary: + compile $xdup, $xqimm; # immediate word? + XIF; compile $xnamefrom, $xexecute; # execute immediate words always + XELSE; compile $xnamefrom, $xcompiling; # non-immediate words depend on compile state: + XIF; compile $xcomma; # postponed execution when compiling + XELSE; compile $xexecute; # immediate execution when interpreting + XTHEN; + XTHEN; + compile $xdepth, $xzeroless; # test for stack underflow + XIF; compile $xstackunderflow; XTHEN; # throw exception in case of + XELSE; compile $xlastword, $x2fetch; + compile $xinterpretnumber, $xzeroequals; # word not found: try as number + XIF; + compile $xlastword, $x2fetch, $xnotfound; # neither, try user hook + XTHEN; + XTHEN; + XREPEAT; compile $x2drop; +semicolon; +forth; definitions; +my $xinterpret = defer "interpret", $xbrinterpret; + + +# ( a n -- ) +my $xevaluate = colon "evaluate"; + compile $xpushsource; + compile $xinterpret; + compile $xpopsource; +semicolon; + + +# -------- disk I/O -------- + +my $line; +sub publish { + if (defined $line) { + $s[++$sp] = $dp; + $s[++$sp] = $dp; + chomp($line); + unstring $line; + } + $s[++$sp] = -(defined $line); +} + +# ( a -- u ) +sub xread { + ($line, @disk) = @disk; + publish; +} +my $xread = unnamedprimitive \&xread; + + + +# ( a n -- ) +sub fileopen { + open(file1, "< ".string) + or throw(-38); +} +my $xfileopen = primitive "fileopen", \&fileopen; + +sub fileclose { + close(file1); +} +my $xfileclose = primitive "fileclose", \&fileclose; + +# ( -- a n -1 | 0 ) +sub fileread { + $line = ; + publish; +} +my $xfileread = primitive "fileread", \&fileread; + + +# -------- entry point, init, and VM main loop -------- #FOLD00 + + +my $xprompt = defer "prompt", $xnop; +my $xquit = defer "quit", $xbye; + +sub xempty { + $rp = -1; # init return stack + $sp = -1; # init data stack + $catchframe = 0; + @sourcestack = (); # drop any nested input source +} +my $xempty = primitive "empty", \&xempty; + +my $xabort = colon "abort"; + compile $xquit; +semicolon; + + +my $xcold = compile $xonly, $xempty; + XBEGIN; compile $xread; + XWHILE; compile $xevaluate; + XREPEAT; +my $xwarm = compile $xabort; + +sub exceptionhandler { + my $exception = $@; + my $exceptionnr = $@; + $exceptionnr =~ s/ .*\n//; + my $err0 = pack "C*", @m[$parsebuf..$parsebuf+$m[$xtoin+1]-1]; # collect source line from virtual memory + print "\n", $err0; # print the line containing the error + $err0 =~ s/ *$//; # strip trailing spaces + my $all = length($err0); # determine length of whole line + $err0 =~ s/[^ ]*$//; # strip last space delimited string + my $ok = length($err0); # determine length of part without error + print "\n", " " x $ok, "^" x ($all-$ok); # underscore error with carets + print "\n", $throwmessage{$exceptionnr} if (defined $throwmessage{$exceptionnr}); + print "\nexception ", $exception; +} + + +#sub xcolor { +# my $string = string; +# print $string; +# print color($string); +#} +#primitive "fg", \&xcolor; + +sub main { + $ip = $xcold; # set instruction pointer to coldstart + until (0) { + eval { + until (0) { # virtual machine execution loop: + $w = $m[$ip++]; # instruction fetch +# $s[++$sp] = $w; xdotname; xspace; +# xcr if $w == $xexit; + $m[$w](); # instruction execute + } + }; # interpreter error exit + exceptionhandler; + $ip = $xwarm; # reenter at warmstart + } +} +main; diff --git a/random.f b/random.f new file mode 100755 index 0000000..11d563b --- /dev/null +++ b/random.f @@ -0,0 +1,16 @@ +\ random.f +\ Simple random number generator +\ from Leo Brodie, _Starting Forth_ + +variable rnd \ Holds current result + +\ Generate a random integer +: random ( -- u ) rnd @ 31421 * 6927 + dup rnd ! ; + +\ Return a randm integer between 0 and u-1 +: choose ( u -- 0...u-1 ) random um* nip ; + +\ Initialize +: randomize ( -- ) time&date + + + + + rnd ! ; + + diff --git a/random.fs b/random.fs new file mode 100755 index 0000000..c293ea6 --- /dev/null +++ b/random.fs @@ -0,0 +1,16 @@ +\ random.fs +\ Simple random number generator +\ from Leo Brodie, _Starting Forth_ + +variable rnd +\ Holds current result + +\ Generate a random integer +: random ( -- u ) rnd @ 31421 * 6927 + dup rnd ! ; + +\ Return a random integer between 0 and u-1 +: choose ( u -- 0...u-1 ) random um* nip ; + +\ Initialize +\ : randomize ( -- ) time&date + + + + + rnd ! ; +: randomize ( -- ) utime drop rnd ! ; \ papa 2016-04-19 \ No newline at end of file diff --git a/roman.fs b/roman.fs new file mode 100755 index 0000000..549d559 --- /dev/null +++ b/roman.fs @@ -0,0 +1,330 @@ +\ roman.fs - Roman numeral and date words +\ +\ Copyright 2018 David Meyer +JMJ +\ +\ Licensed under the Apache License, Version 2.0 (the "License"); +\ you may not use this file except in compliance with the License. +\ You may obtain a copy of the License at +\ +\ http://www.apache.org/licenses/LICENSE-2.0 +\ +\ Unless required by applicable law or agreed to in writing, software +\ distributed under the License is distributed on an "AS IS" BASIS, +\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +\ See the License for the specific language governing permissions and +\ limitations under the License. +\ + +include mymath.fs + +0 constant KALENDS +1 constant NONES +2 constant IDES +3 constant NEXTKAL + +create NONESDAY 5 , 5 , 7 , 5 , 7 , 5 , 7 , 5 , 5 , 7 , 5 , 5 , +create IDESDAY 13 , 13 , 15 , 13 , 15 , 13 , 15 , 13 , 13 , 15 , 13 , 13 , +create EOMDAY 31 , 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 , + +\ numeral9 - superstring and accessor/printer for roman numerals "9"; +\ u = power of 10 [0, 2] +: "numeral9" c" IXXCCM" ; +: numeral9 ( u -- ) 2 * "numeral9" 1+ + 2 type ; + +\ numeral5 - superstring and accessor/printer for roman numerals "5"; +\ u = power of 10 [0, 2] +: "numeral5" c" VLD" ; +: numeral5 ( u -- ) "numeral5" 1+ + 1 type ; + +\ numeral4 - superstring and accessor/printer for roman numerals "4"; +\ u = power of 10 [0, 2] +: "numeral4" c" IVXLCD" ; +: numeral4 ( u -- ) 2 * "numeral4" 1+ + 2 type ; + +\ numeral1 - superstring and accessor/printer for roman numerals "1"; +\ u = power of 10 [0, 3] +: "numeral1" c" IXCM" ; +: numeral1 ( u -- ) "numeral1" 1+ + 1 type ; + +\ pvnumeral - type roman numeral for given power of 10 [0, 3] and place value +\ [1, 9] +: pvnumeral ( upow uval -- ) + dup 9 = if + drop numeral9 + else + dup 4 = if + drop numeral4 + else + dup 4 > if + over numeral5 + 5 - + then + 0 u+do dup numeral1 loop + drop + then + then +; + +\ romnumeral - print Roman numeral for given number [1, 3999] +: romnumeral ( u -- ) + -1 3 -do + 10 i u** /mod ( u%10^i u/10^i ) + dup if + i swap pvnumeral + else drop + then + 1 -loop + drop +; +\ range check +: romnumeral ( u -- ) + dup 0> + over 4000 < + and if + romnumeral + else + ." ERROR romnumeral: argument out of range: " . + then +; + +\ bisyear - Determine if A.D. year is bissextile (leap) year +: bisyear ( uyear -- fbissextile ) + dup 4 mod 0= swap + dup 100 mod 0<> swap + 400 mod 0= + or and +; + +\ knidays - Determine Kalends/Nones/Ides and before-day count for date +: knidays ( bis m d -- ukni uantediem ) + dup 1 = if + nip nip KALENDS + else 2dup swap 1- cells NONESDAY + @ 2dup <= if ( bis m d d nd ) + swap - 1+ nip nip nip NONES + else 2drop 2dup swap 1- cells IDESDAY + @ 2dup <= if ( bis m d d id ) + swap - 1+ nip nip nip IDES + else + 2drop over 1- cells EOMDAY + @ ( bis m d eom ) + swap - 2 + + swap 2 = rot and if 1+ then + NEXTKAL + then then then + swap +; + +\ monthnones - Nones day-of-month +: monthnones ( umonth -- unones ) + 1- cells NONESDAY + @ ; + +\ monthides - Ides day-of-month +: monthides ( umonth -- uides ) + 1- cells IDESDAY + @ ; + +\ monthend - Last day of month +: monthend ( umonth -- ueom ) + 1- cells EOMDAY + @ ; + +\ mdkni - Closest Kalends/Nones/Ides on or following date +: mdkni ( umonth uday -- ukni ) + dup 1 = if + 2drop KALENDS + else 2dup swap monthnones <= if + 2drop NONES + else over monthides <= if + drop IDES + else + drop NEXTKAL + then then then +; + +\ antediem - Roman day count before Kalends/Nones/Ides +: antediem ( fbis umonth uday ukni -- uad ) + dup KALENDS = if \ Kalends (a.d. always 1) + 2drop 2drop 1 + else dup NONES = if \ Nones + drop swap monthnones swap - 1+ nip + else IDES = if \ Ides + swap monthides swap - 1+ nip + else \ Next month Kalends + over monthend swap - 2 + + swap 2 = if \ February + swap if 1+ then \ bissextile year + else nip + then + then then then +; + +\ kniablat - Print Kalends/Nones/Ides ablative case +: kniablat ( ukni -- ) + dup KALENDS = if + ." Kalendis " + else dup NONES = if + ." Nonis " + else dup IDES = if + ." Idebus " + else ." Kalendis " \ Kalends of next month + then then then + drop +; + +\ kniaccus - Print Kalends/Nones/Ides accusative case +: kniaccus ( ukni -- ) + dup KALENDS = if + ." Kalendas " + else dup NONES = if + ." Nonas " + else dup IDES = if + ." Idus " + else ." Kalendas " \ Kalends of next month + then then then + drop +; + +\ monablat - Print Latin month name ablative case +: monablat ( umonth -- ) + dup 1 = if + ." Januariis " + else dup 2 = if + ." Februariis " + else dup 3 = if + ." Martiis " + else dup 4 = if + ." Aprilibus " + else dup 5 = if + ." Maiis " + else dup 6 = if + ." Juniis " + else dup 7 = if + ." Juliis " + else dup 8 = if + ." Augustis " + else dup 9 = if + ." Septembribus " + else dup 10 = if + ." Octobribus " + else dup 11 = if + ." Novembribus " + else dup 12 = if + ." Decembribus " + else + ." Januariis " + then then then then then then then then then then then then + drop +; + +\ monaccus - Print Latin month name accusative case +: monaccus ( umonth -- ) + dup 1 = if + ." Januarias " + else dup 2 = if + ." Februarias " + else dup 3 = if + ." Martias " + else dup 4 = if + ." Apriles " + else dup 5 = if + ." Maias " + else dup 6 = if + ." Junias " + else dup 7 = if + ." Julias " + else dup 8 = if + ." Augustas " + else dup 9 = if + ." Septembres " + else dup 10 = if + ." Octobres " + else dup 11 = if + ." Novembres " + else dup 12 = if + ." Decembres " + else + ." Januarias " + then then then then then then then then then then then then + drop +; + +\ ordaccus - Print Latin ordinal number accusative case [1, 20] +: ordaccus ( unum -- ) + dup 1 = if ." primum " + else dup 2 = if ." secundum " + else dup 3 = if ." tertium " + else dup 4 = if ." quartum " + else dup 5 = if ." quintum " + else dup 6 = if ." sextus " + else dup 7 = if ." septimum " + else dup 8 = if ." octavum " + else dup 9 = if ." nonum " + else dup 10 = if ." decimum " + else dup 11 = if ." undecimum " + else dup 12 = if ." duodecimum " + else dup 13 = if ." tertium decimum " + else dup 14 = if ." quartum decimum " + else dup 15 = if ." quintum decimum " + else dup 16 = if ." sextum decimum " + else dup 17 = if ." septimum decimum " + else dup 18 = if ." duodevicensimum " + else dup 19 = if ." undevicensimum " + else dup 20 = if ." vicensimum " + else ." ERROR: ordaccus argument out of range " dup . + then then then then then then then then then then then then then then then then then then then then + drop +; + +\ diemense - Print day/month portion of Roman date +: diemense ( fbis umonth ukni uad -- ) + dup 1 = if + drop dup kniablat + NEXTKAL = if 1+ then + monablat drop + else dup 2 = if + ." pridie " + drop dup kniaccus + NEXTKAL = if 1+ then + monaccus drop + else + ." ante diem " + 2over 2 = and + over 6 > and + rot dup >r NEXTKAL = and if ( bis m ad ) ( R: kni ) + dup 7 = if ." bis " then + 1- + then + ordaccus ( bis m ) ( R: kni ) + r> dup NEXTKAL = if ( bis m kni ) + swap 1+ swap + then + kniaccus + monaccus + drop + then then +; + +\ anno - Print year for Roman date format +: anno ( uyear -- ) + ." anno Domini " + romnumeral +; + +\ romdate - print date in Roman format +: romdate ( uday umonth uyear -- ) + dup bisyear ( d m y bis ) + dup >r ( R: bis ) + 2swap dup >r ( y bis d m ) ( R: bis m ) + swap 2dup mdkni ( y bis m d kni ) + dup >r antediem ( y ad ) ( R: bis m kni ) + r> swap r> r> swap 2swap ( y bis m kni ad ) + diemense ( y ) + anno +; + +\ hodie - Print current date in Roman format +: hodie ( -- ) + cr + time&date ( sec min hour day month year ) + romdate + drop drop drop +; + + + diff --git a/romdate.fs b/romdate.fs new file mode 100755 index 0000000..95a2455 --- /dev/null +++ b/romdate.fs @@ -0,0 +1,119 @@ + + +: ** ( n1 n2 -- n1 ** n2 ) + 1 swap + 0 do swap dup rot * loop + nip +; + +: "monthab" c" Januarias FebruariasMartias Apriles Maias Junias Julias Augustas SeptembresOctobres Novembres Decembres Januarias " ; +: monthab 10 * "monthab" 1+ + 10 type space ; +: monthab 0 max 12 min monthab ; + +: "romnine" c" IXXCCM" ; +: romnine 2 * "romnine" 1+ + 2 type ; +: romnine 0 max 2 min romnine ; + +: "romfour" c" IVXLCD" ; +: romfour 2 * "romfour" 1+ + 2 type ; +: romfour 0 max 2 min romfour ; + +: "romfive" c" VLD" ; +: romfive "romfive" 1+ + 1 type ; +: romfive 0 max 2 min romfive ; + +: "romunit" c" IXCM" ; +: romunit "romunit" 1+ + 1 type ; +: romunit 0 max 3 min romunit ; + +: romplace ( power u -- ) + dup 9 = if over romnine 2drop + else + dup 4 = if over romfour 2drop + else + dup 4 > if + over romfive + 5 - + then + dup if + 0 do romunit loop + else 2drop + then + then + then +; + +: thousands 0 do ." M" loop ; + +: hundreds + dup 9 = if ." CM" drop + else + dup 4 = if ." CD" drop + else + dup 4 > if + ." D" + 5 - + then + dup if + 0 do + ." C" + loop + else drop + then + then + then +; + +: tens + dup 9 = if ." XC" drop + else + dup 4 = if ." XL" drop + else + dup 4 > if + ." L" + 5 - + then + dup if + 0 do + ." X" + loop + else drop + then + then + then +; +: ones + dup 9 = if ." IX" drop + else + dup 4 = if ." IV" drop + else + dup 4 > if + ." V" + 5 - + then + dup if + 0 do + ." I" + loop + else drop + then + then + then +; +: romnum ( u -- ) + 1000 /mod dup if thousands else drop then + 100 /mod dup if hundreds else drop then + 10 /mod dup if tens else drop then + dup if ones else drop then + space +; +: romnum ( u -- ) + 3 0 do + 10 i ** /mod + dup if i swap romplace + else drop + then + loop + space +; +: romnum 1 max 3999 min romnum ; \ No newline at end of file diff --git a/rpn-n0-cgi.fs b/rpn-n0-cgi.fs new file mode 100755 index 0000000..ac35cec --- /dev/null +++ b/rpn-n0-cgi.fs @@ -0,0 +1,397 @@ +#! /usr/pkg/bin/gforth-fast +\ rpn-n0.cgi - RPN Model n0 calculator CGI script + +\ Copyright 2013 David Meyer +JMJ + +\ Copying and distribution of this file, with or without +\ modification, are permitted in any medium without royalty +\ provided the copyright notice and this notice are preserved. +\ This file is offered as-is, without any warranty. + +\ Global variables ... + +variable register-x +variable register-y +variable register-z +variable register-t +variable register-s +variable mode \ 0: ENTER mode; next number will replace X + \ 1: Op mode; next number will push X + \ 2: Input mode; inputing number + +variable error + +variable query-adr +variable query-len + +variable button-adr +variable button-len + +\ Level 3 ... + +: push-stack ( -- ) + register-z @ register-t ! + register-y @ register-z ! + register-x @ register-y ! +; + +: rot4 ( a b c d -- d a b c ) swap >r rot rot r> ; + +: trunc-fld-key ( c-field ufield ukey -- c-value uvalue ) + dup >r - swap r> chars + swap +; + +: value-str-chars ( addr u1 -- u2 ) + over swap [char] & scan drop swap - +; + +\ Level 2 ... + +: init-state ( -- ) + 0 register-x ! + 0 register-y ! + 0 register-z ! + 0 register-t ! + 0 register-s ! + 0 mode ! + 0 button-len ! +; + +: nprint ( n -- ) + s>d swap over dabs <<# #s rot sign #> type #>> +; + +: parse-num-fld { c-key ulen a-reg -- } + query-adr @ query-len @ c-key ulen search if + ulen trunc-fld-key + over swap value-str-chars s>number? if + d>s a-reg ! + else + 2drop 0 a-reg ! + then + else + 0 a-reg ! + then +; + +: parse-str-fld { c-key ulen a-value a-vlen -- } + query-adr @ query-len @ c-key ulen search if + ulen trunc-fld-key + over swap value-str-chars + a-vlen ! a-value ! + else + 2drop 0 a-vlen ! + then +; + +: pressed-asterisk ( -- ) + register-y @ register-x @ * + register-x ! + register-z @ register-y ! + register-t @ register-z ! + 1 mode ! +; + +: pressed-clr ( -- ) + 0 register-x ! + 0 register-y ! + 0 register-z ! + 0 register-t ! + 0 register-s ! + 0 mode ! +; + +: pressed-clx ( -- ) + \ Or should this act like pop/drop? + 0 register-x ! + 0 mode ! +; + +: pressed-enter ( -- ) + push-stack + 0 mode ! +; + +: pressed-minus ( -- ) + register-y @ register-x @ - + register-x ! + register-z @ register-y ! + register-t @ register-z ! + 1 mode ! +; + +: pressed-mod ( -- ) + register-x @ 0= if + true error ! + 0 mode ! + else + register-y @ register-x @ mod + register-x ! + register-z @ register-y ! + register-t @ register-z ! + 1 mode ! + then +; + +: pressed-neg ( -- ) + register-x @ -1 * register-x ! + 1 mode ! +; + +: pressed-num ( u -- ) + mode @ case + 0 of + 2 mode ! + endof + 1 of + push-stack + 2 mode ! + endof + 2 of + register-x @ 10 * + + endof + endcase + register-x ! +; + +: pressed-plus ( -- ) + register-y @ register-x @ + + register-x ! + register-z @ register-y ! + register-t @ register-z ! + 1 mode ! +; + +: pressed-rcl ( -- ) + push-stack + register-s @ register-x ! + 1 mode ! +; + +: pressed-rld ( -- ) + register-x @ + register-y @ register-x ! + register-z @ register-y ! + register-t @ register-z ! + register-t ! + 1 mode ! +; + +: pressed-slash ( -- ) + register-x @ 0= if + true error ! + 0 mode ! + else + register-y @ register-x @ / + register-x ! + register-z @ register-y ! + register-t @ register-z ! + 1 mode ! + then +; + +: pressed-sto ( -- ) + register-x @ register-s ! + 1 mode ! +; + +: pressed-swp ( -- ) + register-x @ register-y @ + register-x ! register-y ! + 1 mode ! +; + +\ Level 1 ... + +: calculate ( -- ) + button-len @ 0<> if + true case + button-adr @ button-len @ s" ENTER" str= of + pressed-enter + endof + button-adr @ button-len @ s" mod" str= of + pressed-mod + endof + button-adr @ button-len @ s" clx" str= of + pressed-clx + endof + button-adr @ button-len @ s" clr" str= of + pressed-clr + endof + button-adr @ button-len @ s" swp" str= of + pressed-swp + endof + button-adr @ button-len @ s" %2F" str= of + pressed-slash + endof + button-adr @ button-len @ s" rld" str= of + pressed-rld + endof + button-adr @ button-len @ s" *" str= of + pressed-asterisk + endof + button-adr @ button-len @ s" sto" str= of + pressed-sto + endof + button-adr @ button-len @ s" -" str= of + pressed-minus + endof + button-adr @ button-len @ s" rcl" str= of + pressed-rcl + endof + button-adr @ button-len @ s" neg" str= of + pressed-neg + endof + button-adr @ button-len @ s" %2B" str= of + pressed-plus + endof + button-adr @ button-len @ s>unumber? + rot rot d>s >r of + r> pressed-num + endof + endcase + then +; + +: parse-query ( -- ) + s" QUERY_STRING" getenv + dup 0= if + init-state + else + query-len ! query-adr ! + s" s=" register-s parse-num-fld + s" t=" register-t parse-num-fld + s" z=" register-z parse-num-fld + s" y=" register-y parse-num-fld + s" x=" register-x parse-num-fld + s" mode=" mode parse-num-fld + s" button=" button-adr button-len parse-str-fld + then +; + +: print-page ( -- ) + ." Content-Type: text/html" + cr cr .\" " + ." RPN Calculator Model n0" + .\" " + .\" " + .\"

    RPN Calculator Model n0

    " else .\" disp\">" then + register-x @ nprint + .\"
    " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\"
    " + .\"
    " + .\" S
    " + .\" T
    " + .\" Z
    " + .\" Y
    " + .\" X
    RPN CALCULATOR n0
    " + .\"
    " + ."

    Instructions

    " + .\"

    Enter numbers separated by " + ." ENTER key, then press operation key to display the result " + ." (= key is not needed). Numbers are stored in a " + ." LIFO stack (registers X, Y, Z, T). Display shows the last " + ." number (input or result) on the stack (register X). " + ." Register S is for storing constants.

    " + .\"

    Stack effects: " + ." (x, y, z, t, s, are current register values.)

    " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\"
    op
    ()
    z → T
    y → Z
    x → Y,X    		t → T,Z
    z → Y
    y op x → X    		-x → Xx → Sz → T
    y → Z
    x → Y
    s → X
    " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\" " + .\"
    x → T
    t → Z
    z → Y
    y → X    		x → Y
    y → X    		0 → X0 → X,Y,Z,T,S
    " + .\"

    Precision and Fractional Arithmetic: " + ." n0 processes all numbers as single-precision signed integers with a " + ." range of -2,147,483,648 to 2,147,483,647. " + ." It is possible to perform calculations with fractional " + ." numbers by using the technique of " + ." fixed-point arithmetic: The user multiplies input " + ." operands and mentally divides results by appropriate powers of 10 to " + ." obtain the required precision.

    " + .\"

    Program source.

    " + ."

    Model n0 is the first of a series of online " + ." calculators inspired by the Hewlett-Packard " + ." line of slide rule pocket calculators " + ." produced in the 1970s (n0 was designed " + ." with refrence to the " + .\" HP-35 " + ." in particular) and the " + .\" " + ." Forth programming language invented by " + .\" " + ." Chuck Moore in 1968.

    " + ."

    RPN Calculator Model n0 is powered by " + .\" Gforth " + s" gforth" environment? if type space then + ." on the MetaArray host at " + .\" SDF.

    " + .\"

    +JMJ

    " +; + +\ Level 0: Main driver ... + +false error ! + +parse-query +calculate +print-page +bye + + +\ Emacs metadata ... + +\ Local variables: +\ mode: forth +\ End: + +\ +JMJ diff --git a/sandbox.txt b/sandbox.txt new file mode 100755 index 0000000..42dbc0a --- /dev/null +++ b/sandbox.txt @@ -0,0 +1,27 @@ +Forth Sandbox -*-org-*- + +Date: 2011-11-04 + +A project I think I'll put on a front burner soon is my web-based +Forth programming environment. I've had a prototype[1] online for +several months, and it's already been handy. + +Since the purpose is to execute arbitrary code from arbitrary +programmers, security is big concern and should be developed in +parallel with primary functionality. (The interface is currently +secured with HTTP basic authentication, but that will not be +sufficient when made publicly available.) + +I have so far identified three technologies I may use to provide +security (probably in combination). + +1. wordlists can block access to problematic words within the Forth + environment. + +2. Plash is a user program that creates a restricted sandbox + environment and executes a specified program in the sandbos + +3. Host the program in an isolated virtual server (VPS). + + +[1]: diff --git a/scrtest.txt b/scrtest.txt new file mode 100755 index 0000000..831700c --- /dev/null +++ b/scrtest.txt @@ -0,0 +1,40 @@ +Text screen test patterns +20x70 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ + +19x69 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ + @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ \ No newline at end of file diff --git a/starting-words.txt b/starting-words.txt new file mode 100755 index 0000000..993a17e --- /dev/null +++ b/starting-words.txt @@ -0,0 +1,195 @@ +Starting Forth Words -*-org-*- + +
    +Forth words introduced by chapter in "Starting Forth"[1].
+
+* 1. Fundamental Forth
+
+|-------------+--------------+----------------------------------------|
+| : xxx yyy ; | --           | Create word xxx with definition yyy    |
+| CR          | --           | Carriage return on terminal            |
+| SPACES      | n --         | Print n spaces on terminal             |
+| SPACE       | --           | Print one space on terminal            |
+| EMIT        | c --         | Print character ASCII c on terminal    |
+| ." xxx"     | --           | Print character string xxx on terminal |
+| +           | n1 n2 -- sum | Addition                               |
+| .           | n --         | Pop n from stack and print             |
+|-------------+--------------+----------------------------------------|
+
+* 2. How to Get Results
+
+|-------+----------------------+----------------------------------|
+| +     | n1 n2 -- sum         | Adds                             |
+| -     | n1 n2 -- diff        | Subtracts n1 - n2                |
+| *     | n1 n2 -- prod        | Multiplies                       |
+| /     | n1 n2 -- quot        | Divides n1 / n2 (int. quotient)  |
+| /MOD  | n1 n2 -- rem quot    | n2 / n2 remainder & quotient     |
+| MOD   | n1 n2 -- rem         | n1 / n2 remainder                |
+| SWAP  | n1 n2 -- n2 n1       | Reverse top two stack items      |
+| DUP   | n -- n n             | Duplicate top stack item         |
+| OVER  | n1 n2 -- n1 n2 n1    | Copy second stack item to top    |
+| ROT   | n1 n2 n3 -- n2 n3 n1 | Rotate third stack item          |
+| DROP  | n --                 | Discard top stack item           |
+| .S    | --                   | Stack print (non-destructive)    |
+| 2SWAP | d1 d2 -- d2 d1       | Reverse top two pairs of numbers |
+| 2DUP  | d -- d d             | Duplicate top pair of numbers    |
+| 2OVER | d1 d2 -- d1 d2 d1    | Copy second pair to top          |
+| 2DROP | d --                 | Discard top pair                 |
+|-------+----------------------+----------------------------------|
+
+* 3. The Editor (and Staff)
+
+|---------------+-----------+----------------------------------------|
+| USE xxx       | --        | Use file xxx as Forth "disk"           |
+| LIST          | n --      | List disk block n                      |
+| LOAD          | n --      | Compile disk block n                   |
+| ( xxx)        | --        | Comment                                |
+| UPDATE        | --        | Mark current block modified            |
+| EMPTY-BUFFERS | --        | Mark all blocks unmodified             |
+| BLOCK         | u -- addr | Swap-in block u from mass storage      |
+| INCLUDE xxx   | --        | Compile text file xxx                  |
+| FORGET xxx    | --        | Remove definitions from xxx onward     |
+| MARKER xxx    | --        | Set dictionary restore point           |
+|               |           | (Executing xxx will remove later defs. |
+|---------------+-----------+----------------------------------------|
+
+* 4. Decisions, Decisions ...
+
+|----------------------+----------+-----------------------------------------|
+| IF xxx THEN          | IF: f -- | Execute xxx if f true (non-zero)        |
+| IF xxx ELSE yyy THEN | IF: f -- | Execute xxx if f true, yyy if false (0) |
+|----------------------+----------+-----------------------------------------|
+
+|-------------+---------------+-----------------------------------|
+| =           | n1 n2 -- f    | Test n1 = n2                      |
+| -           | n1 n2 -- diff | (Equiv. to test n1 != n2)         |
+| <           | n1 n2 -- f    | Test n1 < n2                      |
+| >           | n1 n2 -- f    | Test n1 > n2                      |
+| 0=          | n -- f        | Test n = 0                        |
+| 0<          | n -- f        | Test n < 0                        |
+| 0>          | n --f         | Test n > 0                        |
+| AND         | n1 n2 -- and  | Logical and                       |
+| OR          | n1 n2 -- or   | Logical or                        |
+| ?DUP        | 0 -- 0        | Duplicate if n non-zero           |
+|             | n -- n n      |                                   |
+| ABORT" xxx" | f --          | If f true, abort with message xxx |
+| ?STACK      | -- f          | True if stack underflow           |
+| INVERT      | f -- f        | Logical not                       |
+|-------------+---------------+-----------------------------------|
+
+* 5. The Philosophy of Fixed Point
+
+|--------+----------------------+-------------------------------------------|
+| 1+     | n -- n+1             | Add one                                   |
+| 1-     | n -- n11             | Subtract one                              |
+| 2+     | n -- n+2             | Add two                                   |
+| 2-     | n -- n-2             | Subtract two                              |
+| 2*     | n -- n*2             | Mult. by two/Bit shift left               |
+| 2/     | n -- n/1             | Div. by two/Bit shift right               |
+| ABS    | n -- n-abs           | Absolute value                            |
+| NEGATE | n -- -n              | Reverse sign                              |
+| MIN    | n1 n2 -- min         | Minimum                                   |
+| MAX    | n1 n2 -- max         | Maximum                                   |
+| >R     | n --                 | Pop to return stack                       |
+| R>     | -- n                 | Push from return stack                    |
+| I      | -- n                 | Push copy of return stack top             |
+| R@     | -- n                 | Push copy of return stack top             |
+| J      | n -- n+1             | Push copy of return stack 3rd item        |
+| */     | n1 n2 n3 -- quot     | n1*n2/n3 (intermed. result double-length) |
+| */MOD  | n1 n2 n3 -- rem quot | n1*n2/n3 remainder, quotient              |
+|--------+----------------------+-------------------------------------------|
+
+* 6. Throw It For a Loop
+
+|----------------------------+--------------------+--------------------------------|
+| DO xxx LOOP                | DO: limit index -- | Execute xxx limit-index times  |
+| DO xxx +LOOP               | DO: limit index -- | Execute xxx incrementing by n  |
+|                            | +LOOP: n --        | from index to limit            |
+| BEGIN xxx UNTIL            | UNTIL: f --        | Repeat xxx until f true        |
+| BEGIN xxx WHILE yyy REPEAT | WHILE: f --        | Repeat xxx, then yyy if f true |
+|----------------------------+--------------------+--------------------------------|
+
+|-------+------------+----------------------------------------------------------|
+| LEAVE | --         | Terminate loop immediately                               |
+| U.R   | u width -- | Print u right-justified in field width                   |
+| PAGE  | --         | Clear terminal and move cursor to upper left-hand corner |
+| QUIT  | --         | Terminate task (supress "ok")                            |
+| XX    | --         | Clear stacks (undefined word)                            |
+|-------+------------+----------------------------------------------------------|
+
+* 7. A Number of Kinds of Numbers
+
+|-----------+---------------------+------------------------------------------------|
+| U.        | u --                | Print unsigned number                          |
+| UM*       | u1 u2 -- ud         | Return product of u1, u2 (single -> double)    |
+| UM/MOD    | ud u1 -- u2 u3      | Divide double by single, return single-length  |
+|           |                     | quotient, remainder                            |
+| U<        | u1 u2 -- f          | Return u1 | d -- addr u         | Format unsigned double to string               |
+| #         | --                  | Insert low digit in number format              |
+| #S        | --                  | Insert rest of high digits in format           |
+| c HOLD    | --                  | Insert ASCII code c in format                  |
+| [CHAR] a  | -- c                | Return ASCII code for character a              |
+| SIGN      | n -- n              | Insert minus sign in format if n<0             |
+| D+        | d1 d2 -- d-sum      | Add (double-length)                            |
+| D-        | d1 d2 -- d-diff     | Subtract (double-length)                       |
+| DABS      | d -- d-abs          | Absolute value (double-length)                 |
+| DNEGATE   | d -- -d             | Reverse sign (double-length)                   |
+| DMAX      | d1 d2 -- d-max      | Maximum (double-length)                        |
+| DMIN      | d1 d2 -- d-min      | Minimum (double-length)                        |
+| D=        | d1 d2 -- f          | Test d1=d2 (double-length)                     |
+| D0=       | d -- f              | Test d=0 (double-length)                       |
+| D<        | d1 d2 -- f          | Test d1
+
+ 
diff --git a/starting.fs b/starting.fs
new file mode 100755
index 0000000..ce8d56d
--- /dev/null
+++ b/starting.fs
@@ -0,0 +1,101 @@
+\ starting.fs - Exercises from "Stating Forth" by Leo Brodie 
+
+\ 7. A Number of Kinds of Numbers 
+
+\    .DATE - Print double-length as date 
+: .date ( d -- )
+    <# # # [char] / hold # # [char] / hold #s #> type space ;
+
+\ 8. Variables, Constants, and Arrays
+
+\    Exercise 1.
+
+variable pies
+variable frozen-pies
+
+: bake-pie ( -- ) 1 pies +! ;
+
+: eat-pie ( -- )
+    pies @ 0= if
+	." What pie?" cr
+    else
+	-1 pies +!
+	." Thank you!" cr
+    then
+
+;
+
+\    Exercise 2.
+
+: freeze-pies ( -- )
+    pies @ frozen-pies ! 0 pies !
+;
+
+\    Exercise 3.
+
+: .base ( -- ) base @ dup decimal . base ! ;
+
+\    Exercise 4.
+
+variable places
+2 places !
+
+: m. ( s|d -- )
+    tuck dabs
+    <#
+    places @ dup -1 <> if
+	0 ?do # loop
+	[char] . hold
+    else
+	drop s>d
+    then
+    #s rot sign #> type space
+;
+
+\    Exercise 6.
+\    Tic-tac-toe application
+
+create pos 9 allot
+create symb 9 allot
+
+: u>c ( u -- c ) 49 + ;
+: clear ( -- )
+    pos 9 erase
+    9 0 do i dup u>c swap symb + c! loop 
+;
+: hline ( -- ) cr space ." ---------" ;
+: vbar ( -- ) space ." | " ;
+: row ( c1 c2 c3 -- ) cr space emit vbar emit vbar emit ;
+: display ( -- )
+    3 0 do
+	i 0= invert if hline then  \ Print horiz. line before rows 2, 3
+	i 3 * symb +               \ Addr. of 1st symbol in row
+	dup 1+ c@                  \ 2nd symbol in row
+	over 2 + c@                \ 3rd symbol in row
+	swap rot c@                \ Arrange symbols 3 2 1, 1st symbol
+	row
+    loop cr
+;
+: symbol ( n -- c ) 1 = if [char] X else [char] O then ;
+: move ( n-player u-position -- )
+    1- 2dup                        \ Offset in pos, symb
+    pos + dup                      \ pos addr.
+    c@ 0= if                       \ Test pos contents
+	c!                         \ Store pos
+	symb + swap                \ symb addr.
+	symbol swap                \ Getplayer symbol
+	c!                         \ Store symb
+    else
+	drop drop cr ." Position " 1+ . ." already taken."
+	drop
+    then
+;
+: x! ( u-position -- ) 1 swap move display ;
+: o! ( u-position -- ) -1 swap move display ;
+
+
+
+
+
+
+
diff --git a/sticking.fs b/sticking.fs
new file mode 100755
index 0000000..be5bb28
--- /dev/null
+++ b/sticking.fs
@@ -0,0 +1,78 @@
+\ sticking.fs
+\ After "23 Matches" in Ahl, _Basic Computer Games_
+\ Ahl attributes the original to Bob Albrecht
+\ Version 2: Improved Forth strategy and output display -- jdm 2016
+
+cr .( Reading sticking.fs ... )
+
+\ Random number generator
+include random.fs
+
+\ Rules of the game
+: rules ( -- )
+cr ." SticKing"
+cr
+cr ." The game starts with 23 sticks. "
+    ." By turns, you and Forth take"
+cr ." from 1 to 3 sticks. "
+    ." Whoever takes the last stick loses."
+cr ." You will have to be lucky to beat me!" 
+cr
+cr ." You take sticks by entering: n STICKS"
+cr ." where n is 1, 2, or 3"
+cr ;
+
+\ Display sticks
+: .sticks ( n -- ) 0 ?do ." |" loop ;
+
+\ Report remaining sticks
+: left ( sticks taken -- left ) - dup cr .sticks space dup . ." left." ;
+
+\ The fates of Forth
+: you-win ( sticks -- ) drop ." You win! " ;
+
+: forth-wins ( sticks -- ) ." Forth took " 1- . cr ." 1 left - sorry!" ;
+
+: 4-play ( sticks -- sticks left ) ." Forth took " 
+   dup 4 mod dup 
+   0= if drop 3
+   else 3 = if 2
+   else  1 
+   then then
+   dup . left ;
+
+\ My esteemed opponent
+: computer ( sticks -- left| )
+   cr
+   dup 1 = if you-win else
+   dup 5 < if forth-wins else
+         4-play
+      then then ;
+
+\ First play
+: coin ( 23 -- n )
+   2 choose
+   cr ." A coin has been flipped: "
+   if ." Heads, Forth is first." computer
+   else ." Tails, you start."
+   then ;
+
+\ Confine n between min and max
+: clamp ( n min max -- n ) rot min max ;
+
+\ May take between 1 and 3 sticks, leaving at least 1
+: legal ( sticks try -- sticks taken ) over 1- 3 min 1 swap clamp ;
+
+\ My play
+: programmer ( sticks try -- left ) legal left ;
+
+\ 1 Round
+: sticks ( sticks try -- left| ) programmer computer ;
+
+\ Alias for STICKS
+: stick ( sticks try -- left| ) sticks ;
+
+: game ( -- ) rules 23 dup cr .sticks randomize coin ;
+
+cr .( Ready. To play, enter: GAME)
+
diff --git a/sticks.f b/sticks.f
new file mode 100755
index 0000000..a57bdbf
--- /dev/null
+++ b/sticks.f
@@ -0,0 +1,73 @@
+\ sticks.f
+\ After "23 Matches" in Ahl, _Basic Computer Games_
+\ Ahl attributes the original to Bob Albrecht
+
+cr .( Reading sticks.f)
+
+\ random number generator
+s" random.f" included
+
+\ Rules of the game
+: rules  ( -- )
+   cr ." Sticks"
+   cr
+   cr ." The game starts with 23 sticks.  "
+      ." By turns, you and Forth take"
+   cr ." from 1 to 3 sticks.  "
+      ." Whoever takes the last stick loses."
+   cr
+   cr ." You take sticks by entering:  n STICKS"
+   cr ." where n is 1, 2, or 3"
+   cr ;
+
+\ Display sticks
+: .sticks  ( n -- )  0 ?do  ." |"  loop ;
+
+\ Report remaining sticks
+: left  ( sticks taken -- left )
+   -  dup cr .sticks space dup . ." left." ;
+
+\ The fates of Forth
+: you-win  ( sticks -- )  drop  ." You win! " ;
+: forth-wins  ( sticks -- )
+   ." Forth took "  1- .
+   cr ." 1 left - sorry!" ;
+: 4-play  ( sticks -- left )
+   ." Forth took " 3 choose 1+ dup . left ;
+
+\ My esteemed opponent
+: computer  ( sticks -- left| )
+   cr
+   dup 1 = if  you-win  else
+      dup 5 < if  forth-wins  else
+         4-play
+   then then ;
+
+\ First play
+: coin  ( 23 -- n )
+   2 choose
+   cr ." A coin has been flipped:  "
+   if   ." Heads, Forth is first."  computer
+   else ." Tails, you start."
+   then ;
+
+\ Confine n between min and max
+: clamp  ( n min max -- n )  rot min max ;
+
+\ May take between 1 and 3 sticks, leaving at least 1
+: legal  ( sticks try -- sticks taken )
+  over 1- 3 min  1 swap clamp ;
+
+\ My play
+: programmer  ( sticks try -- left )  legal left ;
+
+\ 1 Round
+: sticks  ( sticks try -- left| )  programmer computer ;
+\ Alias for STICKS
+: stick ( sticks try -- left| )  sticks ;
+
+: game  ( -- )
+   rules  23 dup cr .sticks  randomize coin ;
+
+cr .( Ready.  To play, enter: GAME)
+
diff --git a/sticks.fs b/sticks.fs
new file mode 100755
index 0000000..dc79f7a
--- /dev/null
+++ b/sticks.fs
@@ -0,0 +1,70 @@
+\ sticks.fs
+\ After "23 Matches" in Ahl, _Basic Computer Games_
+\ Ahl attributes the original to Bob Albrecht
+
+cr .( Reading sticks.fs ... )
+
+\ Random number generator
+include random.fs
+
+\ Rules of the game
+: rules ( -- )
+cr ." Sticks"
+cr
+cr ." The game starts with 23 sticks. "
+    ." By turns, you and Forth take"
+cr ." from 1 to 3 sticks. "
+    ." Whoever takes the last stick loses."
+cr
+cr ." You take sticks by entering: n STICKS"
+cr ." where n is 1, 2, or 3"
+cr ;
+
+\ Display sticks
+: .sticks ( n -- ) 0 ?do ." |" loop ;
+
+\ Report remaining sticks
+: left ( sticks taken -- left ) - dup cr .sticks space dup . ." left." ;
+
+\ The fates of Forth
+: you-win ( sticks -- ) drop ." You win! " ;
+
+: forth-wins ( sticks -- ) ." Forth took " 1- . cr ." 1 left - sorry!" ;
+
+: 4-play ( sticks -- sticks left ) ." Forth took " 3 choose 1+ dup . left ;
+
+\ My esteemed opponent
+: computer ( sticks -- left| )
+   cr
+   dup 1 = if you-win else
+   dup 5 < if forth-wins else
+         4-play
+      then then ;
+
+\ First play
+: coin ( 23 -- n )
+   2 choose
+   cr ." A coin has been flipped: "
+   if ." Heads, Forth is first." computer
+   else ." Tails, you start."
+   then ;
+
+\ Confine n between min and max
+: clamp ( n min max -- n ) rot min max ;
+
+\ May take between 1 and 3 sticks, leaving at least 1
+: legal ( sticks try -- sticks taken ) over 1- 3 min 1 swap clamp ;
+
+\ My play
+: programmer ( sticks try -- left ) legal left ;
+
+\ 1 Round
+: sticks ( sticks try -- left| ) programmer computer ;
+
+\ Alias for STICKS
+: stick ( sticks try -- left| ) sticks ;
+
+: game ( -- ) rules 23 dup cr .sticks randomize coin ;
+
+cr .( Ready. To play, enter: GAME)
+
diff --git a/tag4thgen.sh b/tag4thgen.sh
new file mode 100755
index 0000000..335af5c
--- /dev/null
+++ b/tag4thgen.sh
@@ -0,0 +1,14 @@
+#!/bin/sh
+
+for e in html head title style meta body h1 h2 h3 h4 h5 h6 p strong em ul ol li dl dt dd table thead tbody tr th td a div span
+do 
+  echo ": \$$e\$ ( -- ) s\" $e\" ;"
+  echo ": [$e] ( -- ) \$$e\$ [tag] ;"
+  echo ": [/$e] ( -- ) \$$e\$ [/tag] ;"
+  echo ": [$e/] ( -- ) \$$e\$ [tag/] ;"
+  echo ": [$e-$] ( addr u -- ) \$$e\$ [tag-$] ;"
+  echo ": [$e-$/] ( addr u -- ) \$$e\$ [tag-$/] ;"
+  echo ": [$e+] ( +-addr +-u -- ) \$$e\$ [tag+] ;"
+  echo ": [$e+$] ( $-addr $-u +-addr +-u -- ) \$$e\$ [tag+$] ;"
+  echo ": [$e+$/] ( $-addr $-u +-addr +-u -- ) \$$e\$ [tag+$/] ;"
+done
\ No newline at end of file
diff --git a/termtest.4th b/termtest.4th
new file mode 100755
index 0000000..ba6fb90
--- /dev/null
+++ b/termtest.4th
@@ -0,0 +1,9 @@
+\ termtest.4th - test pattern for terminal display
+
+: termtest ( -- )
+    s" -----1---------2---------3---------4---------5---------6-------"
+    24 1 u+do i . 2 spaces 2dup type cr loop
+;
+
+termtest
+bye
diff --git a/test1.fs b/test1.fs
new file mode 100755
index 0000000..d69c410
--- /dev/null
+++ b/test1.fs
@@ -0,0 +1,3 @@
+\ Tell how many items are on the stack
+: DEPTH?   ( -- )   DEPTH . ;
+
diff --git a/thoughtful.blink b/thoughtful.blink
new file mode 100755
index 0000000..70b93ab
--- /dev/null
+++ b/thoughtful.blink
@@ -0,0 +1,2 @@
+Thoughtful Programming and Forth
+http://www.ultratechnology.com/forth.htm
diff --git a/tscript b/tscript
new file mode 100755
index 0000000..c5a47f3
--- /dev/null
+++ b/tscript
@@ -0,0 +1,10 @@
+#! /usr/local/bin/gforth
+
+: main ( -- )
+  ." Hello, World!" cr
+  ." I'm tscript." cr ;
+
+main
+bye
+
+
diff --git a/tutorial.fs b/tutorial.fs
new file mode 100755
index 0000000..c443771
--- /dev/null
+++ b/tutorial.fs
@@ -0,0 +1,13 @@
+: min1
+  2dup 2dup > rot rot < rot swap or rot rot or and ;
+
+: min2
+  2dup > 1+ roll nip ;
+\ ... or is it "<"?
+
+: gcd
+  2dup < if swap then
+  begin
+	tuck mod dup 0=
+  until
+  drop ;
diff --git a/twenex-forth.mid b/twenex-forth.mid
new file mode 100755
index 0000000..555968f
--- /dev/null
+++ b/twenex-forth.mid
@@ -0,0 +1,2274 @@
+;-*-Midas-*-
+
+	Title FORTH - The FORTH Language
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	Caution:  This FORTH is NOT totally standard.
+;;;
+;;;	When FORTH is started up, the file AUTO-LOAD.4TH is searched
+;;;	for.  If it exists, it is loaded automatically.  If not, a
+;;;	standard header is printed.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+.DECSAV
+
+A=1	;Used by JSYSs mostly
+B=2
+C=3
+
+D=4	;Used exclusively by colon-compiler (Addr is last word built)
+E=5	;  "	   "      "  EVAL (Addr of last word evaluated)
+
+U=6	;# things in FORTH stack
+V=7	;Args for FORTH stack pushing/popping
+L=10	;Args for EVAL
+
+K=11	;Kharacter from GETCHR and such
+
+T1=12	;Trashy temporaries - No special purpose
+T2=13
+T3=14
+T4=15
+
+S=16	;FORTH stack pointer
+P=17	;100% Pure Porpoise stack pointer
+
+
+Call=PUSHJ P,
+Return=POPJ P,
+
+
+.PRIIN==100	;TTY input JFN
+.PRIOU==101	;TTY output JFN
+
+
+;;;
+;;;	Macros
+;;;
+
+
+Define TYPE &string
+	Hrroi A,[Asciz string]
+	PSOUT
+Termin
+
+
+Define DBP ac
+	Add ac,[70000,,0]
+	Skipge ac
+	  Sub ac,[430000,,1]
+Termin
+
+
+;;;
+;;;	Storage
+;;;
+
+
+	Loc 140
+
+
+Popj1:	Aos (P)
+CPopj:	Return
+
+PDLen==200		;Porpoise stack
+PDList:	-PDLen,,.
+	Block PDLen
+
+Deep==100.		;FORTH stack
+Stack:	-Deep,,.
+	Block Deep
+
+LogNcs:	1.0 ? 3.0 ? 5.0 ? 7.0 ? 9.0 ? 11.0 ? 13.0 ? 15.0
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	Start of execute-time stuff for structures.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+DOn==10.		;Maximum depth of DO loop nesting.
+DOc:	-1		;Loop # we're in.  -1 means not in.
+DOs:	Block DOn
+DOtop:	Block DOn	;Upper limit of DO
+DOind:	Block DOn	;Loop counter, what you get with I, J, etc
+
+IFc:	-1
+
+UNTILn==10.
+UNTILc:	-1
+UNTILs:	Block UNTILn
+
+WHILEn==10.
+WHILEc:	-1
+WHILEs:	Block WHILEn
+WHILEe:	Block WHILEn
+BEGINp:	0
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	Random flags, variables, constants, etc
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+Level:	-1		;Level of recursion
+Trace:	0
+Base:	10.		;I/O number base
+Echo:	-1		;True if we echo input
+
+Width:	0		;Terminal width
+Term:	0		;Terminal-type #
+
+FName:	Block 7		;Filename (asciz) you're screwing with
+Delim:	0		;Delimiter for text input stuff
+lsText:	0		;Length of text read by sText
+Loadp:	0		;True when input is from a file
+StoNmp:	0		;Flag returned by StoN: Valid number?
+
+Making:	0	;True when we're in the middle of building a Dictionary entry
+Did:	0	;True when a DOES> was found after ... the address it returns.
+
+JCall:	JSYS
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	<# and #> formatting controls
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+FBufl==6	;Room for 30. characters
+Format:	0
+FLeft:	0
+FMinus:	0
+FBuffr:	Block FBufl
+FBufBP:	0
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	Instructions that are executed in the body of the two
+;;;	testing routines, via XCT
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+2Tests:	Camn V,(S)	; =
+	Came V,(S)	; =_
+	Camle V,(S)	; <
+	Caml V,(S)	; <=
+	Camge V,(S)	; >
+	Camg V,(S)	; >=
+
+1Tests:	Skipn (S)	; 0=
+	Skipe (S)	; 0=_
+	Skipge (S)	; 0<
+	Skipg (S)	; 0<=
+	Skiple (S)	; 0>
+	Skipl (S)	; 0>=
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	The ASCII strings needed to clear screen and home cursor
+;;;	on assorted terminals.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+Clears:	0 ? 0 ? 0 ? 0 ? 0
+	Asciz //			;#5 - DM2500
+	Asciz //			;#6 - I400
+	Asciz //			;#7 - DM1520
+	0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
+	Asciz /HJ/			;#15 - VT52
+	0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
+	Asciz /v/			;#24 - V200
+	0
+	Asciz /E/			;#26 - H19
+
+Homes:	0 ? 0 ? 0 ? 0 ? 0
+	Asciz //
+	Asciz //
+	Asciz //
+	0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
+	Asciz /H/
+	0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0
+	Asciz //
+	0
+	Asciz //
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	Control needed to keep track of nested LOADs and iJFNs
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+MaxLLs:	10
+LLoad:	-1
+LiJFNs:	Block MaxLLs
+iJFN:	.PRIIN
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	All the rubbish used by the input processor
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+IBufln==40		;Allowing for 160. character input lines
+pInBuf:	0
+InBuf:	Block IBufln
+nIchar:	0
+
+IStrin:	Block 3
+IAddr:	0
+INump:	0
+Inmpos:	0
+NotNum:	0
+IVal:	0
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	The Primitive FORTH Dictionary
+;;;
+;;;	Entries are like:
+;;;
+;;;	+0: NAME 01-05
+;;;	+1: NAME 06-10
+;;;	+2: NAME 11-15
+;;;	+3: LENGTH,,CODE
+;;;	+4: STUFF1
+;;;	 .    .
+;;;	+n: STUFFi
+;;;
+;;;	Where NAME's are ASCII words, LENGTH is the total length
+;;;	of this entry, CODE is a pointer to a list of STUFFs that
+;;;	will be executed when this word is mentioned, and a STUFF
+;;;	is one of:
+;;;
+;;;		-1 ? CONSTANT
+;;;		-1,,SUBROUTINE
+;;;		 0,,DICTIONARY
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+DPage==10		;Page to load Dictionary into
+
+Foo:	Loc DPage*2000
+
+Dict:	Ascii /DUP/ ? 0 ? 0 ?		5,,0 ? -1,,Dup
+	Ascii /SWAP/ ? 0 ? 0 ?		5,,0 ? -1,,Swap
+	Ascii /ROLL/ ? 0 ? 0 ?		5,,0 ? -1,,Roll
+	Ascii /PICK/ ? 0 ? 0 ?		5,,0 ? -1,,Pick
+	Ascii /DROP/ ? 0 ? 0 ?		5,,0 ? -1,,Drop
+	Ascii /OVER/ ? 0 ? 0 ?		5,,0 ? -1,,Over
+	Ascii /ROT/ ? 0 ? 0 ?		5,,0 ? -1,,Rotate
+	Ascii /-DUP/ ? 0 ? 0 ?		5,,0 ? -1,,NZDup
+	Ascii /?DUP/ ? 0 ? 0 ?		5,,0 ? -1,,NZDup
+	Ascii /LEVEL/ ? 0 ? 0 ?		5,,0 ? -1,,PLevel
+	Ascii /DEPTH/ ? 0 ? 0 ?		5,,0 ? -1,,Depth
+	Ascii /FLOAT/ ? 0 ? 0 ?		5,,0 ? -1,,ItoF
+	Ascii /+/ ? 0 ? 0 ?		5,,0 ? -1,,Plus
+	Ascii /-/ ? 0 ? 0 ?		5,,0 ? -1,,Minus
+	Ascii /*/ ? 0 ? 0 ?		5,,0 ? -1,,Times
+	Ascii "/" ? 0 ? 0 ?		5,,0 ? -1,,Divide
+	Ascii /^/ ? 0 ? 0 ?		5,,0 ? -1,,Power
+	Ascii /F+/ ? 0 ? 0 ?		5,,0 ? -1,,FPlus
+	Ascii /F-/ ? 0 ? 0 ?		5,,0 ? -1,,FMin
+	Ascii /F*/ ? 0 ? 0 ?		5,,0 ? -1,,FTimes
+	Ascii "F/" ? 0 ? 0 ?		5,,0 ? -1,,FDiv
+	Ascii /FIX/ ? 0 ? 0 ?		5,,0 ? -1,,FtoI
+	Ascii /MOD/ ? 0 ? 0 ?		5,,0 ? -1,,Mod
+	Ascii "/MOD" ? 0 ? 0 ?		5,,0 ? -1,,DivMod
+	Ascii /0=/ ? 0 ? 0 ?		5,,0 ? -1,,EqualZ
+	Ascii /0=_/ ? 0 ? 0 ?		5,,0 ? -1,,NotEq0
+	Ascii /0/ ? 0 ? 0 ?		5,,0 ? -1,,GreatZ
+	Ascii /0>=/ ? 0 ? 0 ?		5,,0 ? -1,,GrEq0
+	Ascii /EXCHANGE/ ? 0 ?		5,,0 ? -1,,XChanj
+	Ascii /JSYS/ ? 0 ? 0 ?		5,,0 ? -1,,JSys0
+	Ascii /=/ ? 0 ? 0 ?		5,,0 ? -1,,Equal
+	Ascii /=_/ ? 0 ? 0 ?		5,,0 ? -1,,NotEqu
+	Ascii // ? 0 ? 0 ?		5,,0 ? -1,,Greatr
+	Ascii />=/ ? 0 ? 0 ?		5,,0 ? -1,,GretEq
+	Ascii /FLUSH/ ? 0 ? 0 ?		5,,0 ? -1,,Flush
+	Ascii /TRACE/ ? 0 ? 0 ?		5,,0 ? -1,,CTrace
+	Ascii /@/ ? 0 ? 0 ?		5,,0 ? -1,,Fetch
+	Ascii /!/ ? 0 ? 0 ?		5,,0 ? -1,,Store
+	Ascii /+!/ ? 0 ? 0 ?		5,,0 ? -1,,Storep
+	Ascii /-!/ ? 0 ? 0 ?		5,,0 ? -1,,Storem
+	Ascii /FILL/ ? 0 ? 0 ?		5,,0 ? -1,,Fill
+	Ascii /'/ ? 0 ? 0 ?		5,,0 ? -1,,Tic
+	Ascii /'#/ ? 0 ? 0 ?		5,,0 ? -1,,Ticnum
+	Ascii "]" ? 0 ? 0 ?		5,,0 ? -1,,Ticome
+	Ascii /QUIT/ ? 0 ? 0 ?		5,,0 ? -1,,Exit
+	Ascii "<#" ? 0 ? 0 ?		5,,0 ? -1,,SOutF
+	Ascii "#" ? 0 ? 0 ?		5,,0 ? -1,,FDigit
+	Ascii /HOLD/ ? 0 ? 0 ?		5,,0 ? -1,,FHold
+	Ascii "#N" ? 0 ? 0 ?		5,,0 ? -1,,FNDigs
+	Ascii /SIGN/ ? 0 ? 0 ?		5,,0 ? -1,,FSign
+	Ascii "#S" ? 0 ? 0 ?		5,,0 ? -1,,FDigs
+	Ascii "#>" ? 0 ? 0 ?		5,,0 ? -1,,EOutF
+	Ascii /HOME/ ? 0 ? 0 ?		5,,0 ? -1,,Home
+	Ascii /CR/ ? 0 ? 0 ?		5,,0 ? -1,,Terpri
+	Ascii /CLEAR/ ? 0 ? 0 ?		5,,0 ? -1,,CLS
+	Ascii /SPACE/ ? 0 ? 0 ?		5,,0 ? -1,,Space
+	Ascii /SPACES/ ? 0 ?		5,,0 ? -1,,Spaces
+	Ascii /EMIT/ ? 0 ? 0 ?		5,,0 ? -1,,Emit
+	Ascii /TYPE/ ? 0 ? 0 ?		5,,0 ? -1,,7TypeN
+	Ascii "[TYPE]" ? 0 ?		5,,0 ? -1,,7Type
+	Ascii /KEY/ ? 0 ? 0 ?		5,,0 ? -1,,Key
+	Ascii /?TERMINAL/ ? 0 ?		5,,0 ? -1,,Inputp
+	Ascii /EXPECT/ ? 0 ?		5,,0 ? -1,,ExpecN
+	Ascii "[EXPECT]" ? 0 ?		5,,0 ? -1,,Expect
+	Ascii /C@/ ? 0 ? 0 ?		5,,0 ? -1,,CFetch
+	Ascii /C!/ ? 0 ? 0 ?		5,,0 ? -1,,CStore
+	Ascii /C>/ ? 0 ? 0 ?		5,,0 ? -1,,CPlus
+	Ascii /C/ ? 0 ? 0 ?		5,,0 ? -1,,RHalf
+	Ascii /AND/ ? 0 ? 0 ?		5,,0 ? -1,,LogAND
+	Ascii /OR/ ? 0 ? 0 ?		5,,0 ? -1,,LogOR
+	Ascii /NOT/ ? 0 ? 0 ?		5,,0 ? -1,,LogNOT
+	Ascii /XOR/ ? 0 ? 0 ?		5,,0 ? -1,,LogXOR
+	Ascii /EXECUTE/ ? 0 ?		5,,0 ? -1,,Execut
+	Ascii /FORGET/ ? 0 ?		5,,0 ? -1,,Forget
+	Ascii /:/ ? 0 ? 0 ?		5,,0 ? -1,,Colon
+SEMIa=.
+	Ascii /;/ ? 0 ? 0 ?		5,,0 ? -1,,Buierr
+	Ascii // ? 0 ? 0 ?		5,,0 ? -1,,Does
+	Ascii /,/ ? 0 ? 0 ?		5,,0 ? -1,,Comma
+	Ascii /ALLOT/ ? 0 ? 0 ?		5,,0 ? -1,,Allot
+LOADa=.
+	Ascii /LOAD/ ? 0 ? 0 ?		5,,0 ? -1,,Load
+	Ascii "[LOAD]" ? 0 ?		5,,0 ? -1,,Loads
+	Ascii /UNLOAD/ ? 0 ?		5,,0 ? -1,,Unload
+	Ascii /DECIMAL/ ? 0 ?		5,,0 ? -1,,Base10
+	Ascii /OCTAL/ ? 0 ? 0 ?		5,,0 ? -1,,Base8
+	Ascii /BINARY/ ? 0 ?		5,,0 ? -1,,Base2
+
+IFa=.
+	Ascii /IF/ ? 0 ? 0 ?		5,,-1 ? -1,,If
+ELSEa=.
+	Ascii /ELSE/ ? 0 ? 0 ?		5,,-1 ? -1,,Else
+THENa=.
+	Ascii /THEN/ ? 0 ? 0 ?		5,,-1 ? -1,,Then
+
+DOa=.
+	Ascii /DO/ ? 0 ? 0 ?		5,,-1 ? -1,,DoLoop
+LOOPa=.
+	Ascii /LOOP/ ? 0 ? 0 ?		5,,-1 ? -1,,Loop
+LOOPPa=.
+	Ascii /+LOOP/ ? 0 ? 0 ?		5,,-1 ? -1,,Loopp
+
+	Ascii /I/ ? 0 ? 0 ?		5,,0 ? -1,,Aye
+	Ascii /J/ ? 0 ? 0 ?		5,,0 ? -1,,Jay
+	Ascii /IJ..N/ ? 0 ? 0 ?		5,,0 ? -1,,En
+	Ascii /RUNT/ ? 0 ? 0 ?		5,,0 ? -1,,Runt
+
+REPTa=.
+	Ascii /REPEAT/ ? 0 ?		5,,-1 ? -1,,Rept
+UNTILa=.
+	Ascii /UNTIL/ ? 0 ? 0 ?		5,,-1 ? -1,,Until
+
+	Ascii /CMOVE/ ? 0 ? 0 ?		5,,0 ? -1,,CMoveN
+	Ascii "[CMOVE]" ? 0 ?		5,,0 ? -1,,CMoves
+	Ascii /HERE/ ? 0 ? 0 ?		5,,0 ? -1,,Here
+	Ascii /LEAVE/ ? 0 ? 0 ?		5,,0 ? -1,,Leave
+	Ascii /ERROR/ ? 0 ? 0 ?		5,,0 ? -1,,Erret
+	Ascii "[NUMBER]" ? 0 ?		5,,0 ? -1,,Number
+
+WHILEa=.
+	Ascii /WHILE/ ? 0 ? 0 ?		5,,-1 ? -1,,While
+BEGINa=.
+	Ascii /BEGIN/ ? 0 ? 0 ?		5,,-1 ? -1,,Begin
+ENDa=.
+	Ascii /END/ ? 0 ? 0 ?		5,,-1 ? -1,,FEnd
+
+Bottom:	0
+
+	Loc Foo
+
+Dicte:	D,,Bottom
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;               Start of Executable Part of FORTH		   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+Start: 	Move P,PDList
+	Move S,Stack
+	Movei A,.PRIOU
+	GTTYP
+	Movem B,Term
+	Movei A,.PRIIN
+	RFMOD
+	Trz B,TT%DAM
+	Tlz B,TT%ECO
+	SFMOD
+	Movei B,.MORLW
+	MTOPR
+	Movem C,Width
+
+Initp:	Movsi A,(GJ%SHT\GJ%OLD)
+	Hrroi B,[Asciz /AUTO-LOAD.4TH/]
+	GTJFN
+	  Jrst Greet
+	Move B,[070000,,OF%RD]
+	OPENF
+	  Jrst Greet
+	Call LSave
+	Jrst PRun
+
+Greet:	Type "FORTH-10   Type QUIT to exit."
+	Call Terpri
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;                       Top Level of FORTH			   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+PPPRun:	Skipn Echo
+	  Jrst PRun
+	Type " Ok"
+PPRun:	Call Terpri
+PRun:	Call FillIB
+Run:	Call Getwrd
+	  Jrst PPPRun
+	Skipe INump
+	  Jrst [Move V,IVal	;Constants are pushed,
+		Call 4SAVE
+		Jrst Run]
+	Skipn IAddr
+	  Jrst NamErr
+	Move L,IAddr
+	Hrre A,3(L)
+	Skipg A			;Subroutines executed,
+	  Move L,4(L)
+	Call Eval		;Words evaluated.
+	Jrst Run
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;                           Primitives			   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;
+;;;	Stack operations
+;;;
+
+Dup:	Jumpe U,UFlow			; DUP
+	Move V,(S)
+	Call 4SAVE
+	Return
+
+Drop:	Call 4REST			; DROP
+	Return
+
+Over:	Caige U,2			; OVER
+	  Jrst UFlow
+	Move V,-1(S)
+	Call 4SAVE
+	Return
+
+Rotate:	Caige U,3			; ROT
+	  Jrst UFlow
+	Move T1,(S)
+	Exch T1,-1(S)
+	Exch T1,-2(S)
+	Movem T1,(S)
+	Return
+
+Swap:	Caige U,2			; SWAP
+	  Jrst UFlow
+	Move T1,(S)
+	Exch T1,-1(S)
+	Movem T1,(S)
+	Return
+
+Roll:	Call 4REST			; ROLL
+	Camle V,U
+	  Jrst UFlow
+	Hrrz T1,S
+	Sub T1,V
+	Move T2,1(T1)
+	Movei T3,1(T1)
+	Hrli T3,2(T1)
+	BLT T3,-1(S)
+	Movem T2,(S)
+	Return
+
+Pick:	Call 4REST			; PICK
+	Camle V,U
+	  Jrst UFlow
+	Hrrz T1,S
+	Sub T1,V
+	Move V,1(T1)
+	Call 4SAVE
+	Return
+
+NZDup:	Jumpe U,UFlow			; -DUP and ?DUP
+	Skipn (S)
+	  Return
+	Move V,(S)
+	Call 4SAVE
+	Return
+
+;;;
+;;;	Numeric changes
+;;;
+
+Negate:	Jumpe U,UFlow			; MINUS
+	Movns (S)
+	Return
+
+RHalf:	Jumpe U,UFlow			; ,,->
+	Hrre A,(S)
+	Movem A,(S)
+	Return
+
+LHalf:	Jumpe U,UFlow			; <-,,
+	Hlre A,(S)
+	Movem A,(S)
+	Return
+
+SHalfs:	Jumpe U,UFlow			; SW,,AP
+	Movss (S)
+	Return
+
+ApSign:	Call 4REST			; +-
+	Jumpe U,UFlow
+	Skipge V
+	  Movns (S)
+	Return
+
+Min:	Caige U,2			; MIN
+	  Jrst UFlow
+	Call 4REST
+	Camge V,(S)
+	  Movem V,(S)
+	Return
+
+Max:	Caige U,2			; MAX
+	  Jrst UFlow
+	Call 4REST
+	Camle V,(S)
+	  Movem V,(S)
+	Return
+
+Abs:	Jumpe U,UFlow			; ABS
+	Movms (S)
+	Return
+
+Plus1:	Jumpe U,UFlow			; 1+
+	Aos (S)
+	Return
+
+Minus1:	Jumpe U,UFlow			; 1-
+	Sos (S)
+	Return
+
+;;;
+;;;	Floating-point functions
+;;;
+
+Cosine:	Call 4REST			; COSINE
+	FADR V,[1.57079632679]
+	Skipa
+Sine:	Call 4REST			; SINE
+	Move A,V
+	Call SorC
+	Move V,A
+	Call 4SAVE
+	Return
+
+SorC:	Movm B,A
+	Camg B,[.0001761]
+	  Return
+	FDVRI A,(+9.0)
+	Call SorC
+	Call .+1
+	FMPR B,B
+	FSC B,2
+	FADRI B,(-3.0)
+	FMPRB A,B
+	Return
+
+Root:	Call 4REST			; ROOT
+	Jumple V,[Setz V,
+		  Call 4SAVE
+		  Return]
+	Move T1,V
+	FADRI T1,(+1.0)
+	FDVRI T1,(+2.0)
+Root1:	Move T2,V
+	FDVR T2,T1
+	FADR T2,T1
+	FDVRI T2,(+2.0)
+	Move T3,T2
+	FSBR T3,T1
+	Movms T3
+	Camg T3,[.0000001]
+	  Jrst Root2
+	Move T1,T2
+	Jrst Root1
+Root2:	Move V,T1
+	Call 4SAVE
+	Return
+
+LogN:	Call 4REST			; LN
+	Jumple V,[Setz V,
+		  Call 4SAVE
+		  Return]
+	Move T1,V
+	FSBRI T1,(+1.0)
+	Move T2,V
+	FADRI T2,(+1.0)
+	FDVR T1,T2
+	Move T2,T1
+	Move A,T1
+	Setzb C,B
+
+LogN1:	FMPR T2,T1
+	FMPR T2,T1
+	Move T3,T2
+	FDVR T3,LogNcs(C)
+	FADR A,T3
+	FSBR B,A
+	Movms B
+	Camg B,[.0000001]
+	  Jrst LogN2
+	Move B,A
+	Aoja C,LogN1
+LogN2:	FMPRI A,(+2.0)
+	Move V,A
+	Call 4SAVE
+	Return
+
+;;;
+;;;	System constants and toggles and stuff
+;;;
+
+Depth:	Move V,U			; DEPTH
+	Call 4SAVE
+	Return
+
+CTrace:	Setcmm Trace			; TRACE
+	Return
+
+Inputp:	Setz V,				; ?TERMINAL
+	Movei A,.PRIIN
+	SIBE
+	  Seto V,
+	Call 4SAVE
+	Return
+
+PLevel:	Move V,Level			; LEVEL
+	Call 4SAVE
+	Return
+
+Runt:	Movei A,.FHSLF			; RUNT
+	RUNTM
+	Move V,A
+	Call 4SAVE
+	Return
+
+Base10:	Movei A,10.			; DECIMAL
+	Movem A,Base
+	Return
+
+Base8:	Movei A,8.			; OCTAL
+	Movem A,Base
+	Return
+
+Base2:	Movei A,2			; BINARY
+	Movem A,Base
+	Return
+
+Aye:	Skipge DOc			; I
+	  Jrst DOerr
+	Move T1,DOc
+	Move V,DOind(T1)
+	Call 4SAVE
+	Return
+
+Jay:	Skipg DOc			; J
+	  Jrst DOerr
+	Move T1,DOc
+	Soj T1,
+	Move V,DOind(T1)
+	Call 4SAVE
+	Return
+
+En:	Call 4REST			; IJ..N
+	Jumple V,[Type " ?Loop # <1"
+		  Jrst Erret]
+	Soj V,
+	Camle V,DOc
+	  Jrst DOerr
+	Move T1,DOc
+	Sub T1,V
+	Move V,DOind(T1)
+	Call 4SAVE
+	Return
+
+VLIST:	Movei T1,Dict
+	Setz T2,
+	Call Terpri
+VL2:	Skipn (T1)
+	  Return
+	Move T3,[440700,,(T1)]
+	Setz T4,
+VL3:	Ildb A,T3
+	Skipe A
+	Aoja T4,VL3
+	Add T2,T4
+	Addi T2,2
+	Caml T2,Width
+	  Jrst [Call Terpri
+		Move T2,T4
+		Addi T2,2
+		Jrst .+1]
+	Movei A,40
+	PBOUT
+	PBOUT
+	Move T3,[440700,,(T1)]
+VL4:	Ildb A,T3
+	PBOUT
+	Sojn T4,VL4
+
+VL5:	Hlrz T3,3(T1)
+	Add T1,T3
+	Jrst VL2
+
+;;;
+;;;	Formatted number output stuff
+;;;
+
+SOutF:	Skipe Format				; <#
+	  Jrst [Type " ?Already formatting"
+		Jrst Erret]
+	Jumpe U,UFlow
+	Move V,(S)
+	Setom Format
+	Jumpge V,SOutFs
+	Movns V
+	Setom FMinus
+SOutFs:	Movem V,(S)
+	Move A,[010700,,FBufBP-1]
+	Movem A,FBufBP
+	Movei B,5*FBufl-1
+	Movem B,FLeft
+	Return
+
+FSign:	Skipn Format				; SIGN
+	  Jrst NForm
+	Skipn FMinus
+	  Return
+	Movei K,"-
+	Call FSave
+	Return
+
+FDigit:	Skipn Format				; #
+	  Jrst NForm
+	Jumpe U,Unform
+	Move T1,(S)
+	Idiv T1,Base
+	Move K,T2
+	Addi K,60
+	Call FSave
+	Movem T1,(S)
+	Return
+
+FNDigs:	Skipn Format				; #N
+	  Jrst NForm
+	Call 4REST
+	Skipg V
+	  Return
+	Jumpe U,Unform
+	Move T1,(S)
+FNDlop:	Idiv T1,Base
+	Move K,T2
+	Addi K,60
+	Call FSave
+	Sojn V,FNDlop
+	Movem T1,(S)
+	Return
+
+FHold:	Skipn Format				; HOLD
+	  Jrst NForm
+	Call 4REST
+	Move K,V
+	Call FSave
+	Return
+
+FDigs:	Skipn Format				; #S
+	  Jrst NForm
+	Jumpe U,Unform
+	Move T1,(S)
+FDigsl:	Jumpe T1,FDigse
+	Idiv T1,Base
+	Move K,T2
+	Addi K,60
+	Call FSave
+	Jrst FDigsl
+FDigse:	Setzm (S)
+	Return
+
+EOutF:	Skipn Format				; #>
+	  Jrst NForm
+	Call 4REST
+	Move V,FBufBP
+	Call 4SAVE
+	Movei V,5*FBufl-1
+	Sub V,FLeft
+	Call 4SAVE
+	Setzm Format
+	Return
+
+FSave:	Skipn FLeft
+	  Jrst [Type " ?Formatting buffer full"
+		Jrst Erret]
+	Move A,FBufBP
+	DBP A
+	Movem A,FBufBP
+	Dpb K,FBufBP
+	Sos FLeft
+	Return
+
+;;;
+;;;	Display hacking
+;;;
+
+Home:	Skipn Term			; HOME
+	  Return
+	Move T1,Term
+	Move A,[440700,,Homes(T1)]
+	PSOUT
+	Return
+
+CLS:	Skipn Term			; CLEAR
+	  Return
+	Move T1,Term
+	Move A,[440700,,Clears(T1)]
+	PSOUT
+	Return
+
+;;;
+;;;	Outputting words
+;;;
+
+Space:	Movei A,40			; SPACE
+	PBOUT
+	Return
+
+Spaces:	Call 4REST			; SPACES
+	Skipg V
+	  Return
+	Movei A,40
+	PBOUT
+	Sojn V,.-1
+	Return
+
+Terpri:	Movei A,^M			; CR
+	PBOUT
+	Movei A,^J
+	PBOUT
+	Return
+
+Emit:	Call 4REST				; EMIT
+	Move A,V
+	PBOUT
+	Return
+
+7TypeN:	Call 4REST	;# Characters		  TYPE
+	Move T1,V
+	Call 4REST	;BP
+7TNlop:	Ldb A,V
+	PBOUT
+	Ibp V
+	Sojn T1,7TNlop
+	Return
+
+7Type:	Call 4REST	;BP			  [TYPE]
+7TLoop:	Ldb A,V
+	Skipn A
+	  Return
+	PBOUT
+	Ibp V
+	Jrst 7TLoop
+
+Dotext:	Skiple Level			; ."
+	  Jrst Dotsav
+Dotxt2:	Call Getchr
+	  Call Refill
+	Movem K,Delim
+Dotxt3:	Call Getchr
+	  Call Refill
+	Camn K,Delim
+	  Return
+	Move A,K
+	PBOUT
+	Caie A,^M
+	  Jrst Dotxt3
+	Movei A,^J
+	PBOUT
+	Jrst Dotxt3
+
+Dotsav:	Move T1,E
+	Hrli T1,440700
+	Aoj T1,
+	Setz T2,
+
+Dots2:	Ildb A,T1
+	Jumpe A,Dots3
+	PBOUT
+	Caie A,^M
+	  Aoja T2,Dots2
+	Movei A,^J
+	PBOUT
+	Aoja T2,Dots2
+
+Dots3:	Idivi T2,5	;Return # of text words to skip
+	Aoj T2,
+	Add E,T2
+	Return
+
+;;;
+;;;	Character operations
+;;;
+
+CFetch:	Jumpe U,UFlow			; C@
+	Ldb A,(S)
+	Movem A,(S)
+	Return
+
+CStore:	Call 4REST	;BP		  C!
+	Move T1,V
+	Call 4REST	;Byte
+	Dpb V,(T1)
+	Return
+
+CPlus:	Call 4REST	;Number		  C+
+	Move T1,V
+	Call 4REST	;BP
+	Idivi T1,5
+	Add V,T1
+	Jumpe T2,CPlusb
+	Ibp V
+	Sojn T2,.-1
+CPlusb:	Call 4SAVE
+	Return
+
+CMinus:	Call 4REST	;Number		  C-
+	Move T1,V
+	Call 4REST	;BP
+	IDivi T1,5
+	Sub V,T1
+	Jumpe T2,CMin2
+CMin1:	Dbp V
+	Sojn T2,CMin1
+CMin2:	Call 4SAVE
+	Return
+
+CMoveN:	Call 4REST	;Number			CMOVE
+	Move T1,V
+	Call 4REST	;BP-to
+	Move T2,V
+	Call 4REST	;BP-from
+CMNlop:	Ldb A,V
+	Dpb A,T2
+	Ibp V
+	Ibp T2
+	Sojn T1,CMNlop
+	Return
+
+CMoves:	Call 4REST	;BP-to		[CMOVE]		Returns #chars
+	Move T1,V
+	Call 4REST	;BP-from
+	Setz T2,
+CMSlop:	Ldb A,V
+	Jumpe A,CMSdun
+	Dpb A,T1
+	Ibp V
+	Ibp T1
+	Aoja T2,CMSlop
+CMSdun:	Call 4SAVE
+	Return
+
+;;;
+;;;	Inputting words
+;;;
+
+Key:	PBIN				; KEY
+	Andi A,177
+	Move V,A
+	Call 4SAVE
+	Return
+
+Number:	Jumpe U,UFlow			; caddr [NUMBER] --> caddr n -1
+	Move T1,(S)	;BP-from	;		 --> caddr 0
+	Call StoN
+	  Jrst [Movem T1,(S)
+		Setz V,
+		Call 4SAVE
+		Return]
+	Movem T1,(S)
+	Move V,T2
+	Call 4SAVE
+	Seto V,
+	Call 4SAVE
+	Return
+
+ExpecN:	Call 4REST	;Number			EXPECT
+	Move T1,V
+	Call 4REST	;BP-to
+ENLoop:	PBIN
+	Dpb A,V
+	Skipe Echo
+	  PBOUT
+	Ibp V
+	Sojn T1,ENLoop
+	Return
+
+Expect:	Call 4REST	;BP		[EXPECT]
+	Setz T3,
+ELoop:	PBIN
+	Cain A,^M
+	  Jrst ESave
+	Dpb A,V
+	Skipe Echo
+	  PBOUT
+	Ibp V
+	Aoja T3,ELoop
+ESave:	Dpb V		;Make it asciz
+	Move V,T3
+	Call 4SAVE
+	Return
+
+;;;
+;;;	Numberic output
+;;;
+
+DotR:	Call 4REST			; .R
+	Move T4,V
+	Skipa
+Dot:	Call 4REST			; .
+Dota:	Setz T4,
+	Movm T1,V
+	Setz T3,
+Dot1:	IDiv T1,Base
+	Push P,T2
+	Aoj T3,
+	Jumpn T1,Dot1
+Dot2:	Move T1,T3
+	Skipge V
+	  Aoj T1,
+	Camg T4,T1
+	  Jrst DotS
+	Sub T4,T1
+DotF:	Movei A,40
+	PBOUT
+	Sojn T4,DotF
+DotS:	Jumpge V,Dot3
+	Movei A,"-
+	PBOUT
+Dot3:	Pop P,A
+	Addi A,60
+	PBOUT
+	Sojn T3,Dot3
+Dot4:	Movei A,40
+	PBOUT
+	Return
+
+FDot:	Call 4REST			; F.
+	Movei A,.PRIOU
+	Move B,V
+	Movei C,FL%ONE\FL%PNT
+	FLOUT
+	  Jfcl
+	Return
+
+;;;
+;;;	Text building (Dictionary)
+;;;
+
+SaveTs:	Call 4REST			; ["]
+	Move T1,V
+	Movei A,^M
+	Movem A,Delim
+	Call sTextd
+	Move V,T2
+	Call 4SAVE
+	Return
+
+SaveTd:	Call 4REST			; (")
+	Move T1,V
+	Call sText
+	Move V,T2
+	Call 4SAVE
+	Return
+
+ColTex:	Call BText
+	Move V,lsText
+	Call 4SAVE
+	Return
+
+;;;
+;;;	Miscellaneous
+;;;
+
+Exit:	Call Terpri
+	Type "Exiting FORTH"
+	Call Terpri
+	Jrst Die
+
+Remark:	Call Getchr			; (
+	  Call Refill
+	Caie K,")
+	  Jrst Remark
+	Return
+
+Here:	Skipn Making			; HERE
+	  Jrst Buierr
+	Move V,Dicte
+	Add V,D
+	Call 4SAVE
+	Return
+
+Execut:	Call 4REST			; EXECUTE
+	Move L,V
+	Call Eval
+	Return
+
+Leave:	Skipge DOc
+	  Jrst DOerr
+	Move T1,DOc
+	Move T2,DOtop(T1)
+	Movem T2,DOind(T1)
+	Return
+
+Jsys0:	Call 4REST	;JSys#		  JSYS
+	Hrr V,JCall
+	Xct JCall
+	Return
+
+Flush:	Move S,Stack			; FLUSH
+	Setz U,
+	Return
+
+;;;
+;;;	Stack/Memory operations
+;;;
+
+Store:	Call 4REST			; !
+	Move T1,V
+	Call 4REST
+	Movem V,(T1)
+	Return
+
+Storep:	Call 4REST			; +!
+	Move T1,V
+	Call 4REST
+	Addm V,(T1)
+	Return
+
+Storem:	Call 4REST			; -!
+	Move T1,V
+	Call 4REST
+	Exch V,(T1)
+	Subm V,(T1)
+	Return
+
+Fill:	Call 4REST	;Value			FILL
+	Move T1,V
+	Call 4REST	;Number
+	Move T2,V
+	Call 4REST	;Address
+	Add T2,V
+	Movem T1,V
+	Hrl V,V
+	Aoj V,
+	BLT V,-1(T2)
+	Return
+
+XChanj:	Call 4REST				; EXCHANGE
+	Move T1,V
+	Call 4REST
+	Move T2,(V)
+	Exch T2,(T1)
+	Movem T2,(V)
+	Return
+
+Fetch:	Jumpe U,UFlow				; @
+	Move T1,(S)
+	Move T2,(T1)
+	Movem T2,(S)
+	Return
+
+;;;
+;;;	Random Dictionary stuff
+;;;
+
+Tic:	Call Getwrd				; '
+	  Call Refill
+	Skipn IAddr
+	  Jrst NamErr
+	Move V,IAddr
+	Call 4SAVE
+	Return
+
+Ticnum:	Call Getwrd				; '#
+	  Call Refill
+	Skipn INump
+	  Jrst NamErr
+	Move V,IVal
+	Call 4SAVE
+	Return
+
+Forget:	Call Getwrd				; FORGET
+	  Call Refill
+	Skipn IAddr
+	  Jrst NamErr
+	Move T1,IAddr
+	Setzm (T1)
+	Hrl T1,T1
+	Aoj T1,
+	BLT T1,Dicte
+	Move A,IAddr
+	Hrrm A,Dicte
+	Return
+
+;;;
+;;;	Logical operations
+;;;
+
+LogAND:	Caige U,2			; AND
+	  Jrst UFlow
+	Call 4REST
+	Andm V,(S)
+	Return
+
+LogOR:	Caige U,2			; OR
+	  Jrst UFlow
+	Call 4REST
+	IOrm V,(S)
+	Return
+
+LogNOT:	Jumpe U,UFlow			; NOT
+	Setcmm (S)
+	Return
+
+LogXOR:	Caige U,2			; XOR
+	  Jrst UFlow
+	Call 4REST
+	XOrm V,(S)
+	Return
+
+;;;
+;;;	Arithmetic operations
+;;;
+
+Plus:	Caige U,2			; +
+	  Jrst UFlow
+	Call 4REST
+	Addm V,(S)
+	Return
+
+FPlus:	Caige U,2			; F+
+	  Jrst UFlow
+	Call 4REST
+	FADM V,(S)
+	Return
+
+Minus:	Call 4REST			; -
+	Jumpe U,UFlow
+	Exch V,(S)
+	Subm V,(S)
+	Return
+
+FMin:	Call 4REST			; F-
+	Jumpe U,UFlow
+	Exch V,(S)
+	FSBM V,(S)
+	Return
+
+Times:	Caige U,2			; *
+	  Jrst UFlow
+	Call 4REST
+	IMulm V,(S)
+	Return
+
+FTimes:	Caige U,2			; F*
+	  Jrst UFlow
+	Call 4REST
+	FMPM V,(S)
+	Return
+
+Divide:	Call 4REST			; /
+	Jumpe U,UFlow
+	Exch V,(S)
+	IDivm V,(S)
+	Return
+
+FDiv:	Call 4REST			; F/
+	Jumpe U,UFlow
+	Exch V,(S)
+	FDVM V,(S)
+	Return
+
+Power:	Call 4REST			; ^
+	Move T1,V
+	Call 4REST
+	Movei T2,1
+P2:	Jumple T1,P3
+	Imul T2,V
+	Soja T1,P2
+P3:	Move V,T2
+	Call 4SAVE
+	Return
+
+Mod:	Call 4REST			; MOD
+	Move T1,V
+	Call 4REST
+	Move T2,V
+	IDiv T2,T1
+	Move V,T3
+	Call 4SAVE
+	Return
+
+DivMod:	Call 4REST			; /MOD
+	Move T1,V
+	Call 4REST
+	Move T2,V
+	IDiv T2,T1
+	Move V,T3
+	Call 4SAVE
+	Move V,T2
+	Call 4SAVE
+	Return
+
+;;;
+;;;	Conversions
+;;;
+
+ItoF:	Jumpe U,UFlow			; FLOAT
+	FLTR T1,(S)
+	Movem T1,(S)
+	Return
+
+FtoI:	Jumpe U,UFlow			; FIX
+	FIXR T1,(S)
+	Movem T1,(S)
+	Return
+
+;;;
+;;;	Single operator tests
+;;;
+
+EqualZ:	Setz A,			; 0=
+	Jrst 1Test
+NotEq0:	Movei A,1		; 0=_
+	Jrst 1Test
+LessZ:	Movei A,2		; 0<
+	Jrst 1Test
+LesEq0:	Movei A,3		; 0<=
+	Jrst 1Test
+GreatZ:	Movei A,4		; 0>
+	Jrst 1Test
+GrEq0:	Movei A,5		; 0>=
+
+1Test:	Jumpe U,UFlow
+	Setz T1,
+	Xct 1Tests(A)
+	  Seto T1,
+	Movem T1,(S)
+	Return
+
+;;;
+;;;	Two operator tests
+;;;
+
+Equal:	Setz A,			; =
+	Jrst 2Test
+NotEqu:	Movei A,1		; =_
+	Jrst 2Test
+Less:	Movei A,2		; <
+	Jrst 2Test
+LessEq:	Movei A,3		; <=
+	Jrst 2Test
+Greatr:	Movei A,4		; >
+	Jrst 2Test
+GretEq:	Movei A,5		; >=
+
+2Test:	Call 4REST
+	Jumpe U,UFlow
+	Setz T1,
+	Xct 2Tests(A)
+	  Seto T1,
+	Movem T1,(S)
+	Return
+
+;;;
+;;;	File-loading things
+;;;
+
+Load:	Move T3,LLoad				; LOAD
+	Cail T3,MaxLLs
+	  Jrst [Type " ?Can't load deeper"
+		Jrst Erret]
+	Skipg Level
+	  Jrst L2
+	Movsi A,(GJ%SHT\GJ%OLD)
+	Hrro B,E
+	Aoj B,
+	GTJFN
+	  Jrst NoFile
+	Hrrz T1,B
+	Sub T1,E
+	Move B,[070000,,OF%RD]
+	OPENF
+	  Jrst NoFile
+	Add E,T1
+	Jrst LSave
+
+L2:	Call Getchr
+	  Call Refill
+	Movem K,Delim
+	Move T1,[440700,,FName]
+L3:	Call Getchr
+	  Call Refill
+	Camn K,Delim
+	  Jrst L4
+	Idpb K,T1
+	Jrst L3
+L4:	Idpb T1		;Make asciz
+	Hrroi B,FName
+L5:	Movsi A,(GJ%SHT\GJ%OLD)
+	GTJFN
+	  Jrst NoFile
+	Move B,[070000,,OF%RD]
+	OPENF
+	  Jrst NoFile
+
+LSave:	Move T1,iJFN
+	Aos T2,LLoad
+	Movem T1,LiJFNs(T2)
+	Movem A,iJFN
+	Setom Loadp
+	Setzm Echo
+	Return
+
+Loads:	Call 4REST				; [LOAD]
+	Hrro B,V
+	Jrst L5
+
+Unload:	Skipge LLoad			; UNLOAD
+	  Jrst [Type " ?Not loading"
+		Jrst Erret]
+	Move A,iJFN
+	CLOSF
+	  Jrst [Type " %Can't close file"
+		Jrst .+1]
+	Move T1,LLoad
+	Move A,LiJFNs(T1)
+	Movem A,iJFN
+	Sos LLoad
+	Skipl LLoad
+	  Return
+	Setom Echo
+	Setzm Loadp
+	Return
+
+;;;
+;;;	The infamous IF/ELSE/THEN structure
+;;;
+
+IF:	Call 4REST
+	Skipe V
+	  Return
+IFskip:	Aoj E,
+	Move T1,(E)
+	Came T1,[-1,,Then]
+	  Camn T1,[-1,,Else]
+	    Return
+	Jrst IFskip
+
+Else:	Aoj E,
+	Move T1,(E)
+	Came T1,[-1,,Then]
+	  Jrst Else
+	Return
+
+Then:	Return
+
+;;;
+;;;	The REPEAT/UNTIL loop
+;;;
+
+Rept:	Aos T1,UNTILc
+	Movem E,UNTILs(T1)	;Start of REPEAT code
+	Return
+
+Until:	Call 4REST
+	Jumpe V,[Move T1,UNTILc
+		 Move E,UNTILs(T1)
+		 Return]
+	Sos UNTILc
+	Return
+
+;;;
+;;;	The leading test WHILE/BEGIN/END loop
+;;;
+
+While:	Aos T1,WHILEc
+	Movem E,WHILEs(T1)
+	Setzm WHILEe(T1)
+	Return
+
+Begin:	Call 4REST
+	Skipe V
+	  Return
+	Move T1,WHILEc
+	Skipe WHILEe(T1)
+	  Jrst [Move E,WHILEe(T1)
+		Return]
+Begin2:	Aoj E,
+	Move T1,(E)
+	Came T1,[-1,,FEnd]
+	  Aoja E,Begin2
+	Sos WHILEc
+	Return
+
+FEnd:	Move T1,WHILEc
+	Movem E,WHILEe(T1)
+	Move E,WHILEs(T1)
+	Return
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;;	The obligatory DO/LOOP[+] structure.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+DoLoop:	Aos T1,DOc
+	Movem E,DOs(T1)
+	Call 4REST
+	Movem V,DOind(T1)	;Initial value
+	Call 4REST
+	Movem V,DOtop(T1)	;Upper limit
+	Return
+
+Loop:	Move T1,DOc
+	Aos V,DOind(T1)
+	Jrst Loopt
+
+Loopp:	Move T1,DOc
+	Call 4REST
+	Jumpl V,Looppm
+	Addb V,DOind(T1)
+
+Loopt:	Camge V,DOtop(T1)
+	  Move E,DOs(T1)
+	Caml V,DOtop(T1)
+	  Sos DOc
+	Return
+
+Looppm:	Addb V,DOtop(T1)
+	Camle V,DOtop(T1)
+	  Move E,DOs(T1)
+	Camg V,DOtop(t1)
+	  Sos DOc
+	Return
+
+;;;
+;;;	The Colon (:) Compiler (Quite Hirsute)
+;;;
+
+Colon:	Skipe Making
+	  Jrst [Type " ?Can't compile :'s"
+		Jrst Erret]
+	Setom Making
+	Call MHead
+
+Colon1:	Call Getwrd
+	  Call Refill
+	Skipe INump
+	  Jrst [Aoj D,
+		Setom @Dicte
+		Aoj D,
+		Move T1,IVal
+		Movem T1,@Dicte
+		Jrst Colon1]
+	Skipn IAddr
+	  Jrst [Type " ?Undefined"
+		Jrst Erret]
+	Move T1,IAddr
+	Cain T1,SEMIa
+	  Jrst Coldun
+	Caie T1,PARENa	;Don't compile comments
+	  Jrst Colon2
+Colsr:	Call Getchr
+	  Call Refill
+	Caie K,")
+	  Jrst Colsr
+
+Colon2:	Hrre A,3(T1)
+	Jumpg A,[Aoj D,
+		 Movem T1,@Dicte
+		 Jrst Colon1]
+	Caie T1,ELSEa
+	  Jrst Colon3
+	Skipge IFc
+	  Jrst [Type " ?ELSE without IF"
+		Jrst Erret]
+	Jrst Colis
+
+Colon3:	Caie T1,THENa
+	  Jrst Colon4
+	Skipge IFc
+	  Jrst [Type " ?THEN without IF"
+		Jrst Erret]
+	Sos IFc
+	Jrst Colis
+
+Colon4:	Caie T1,BEGINa
+	  Jrst Colon5
+	Skipge WHILEc
+	  Jrst [Type " ?BEGIN without WHILE"
+		Jrst Erret]
+	Setom BEGINp
+	Jrst Colis
+
+Colon5:	Caie T1,ENDa
+	  Jrst Colis
+	Skipge WHILEc
+	  Jrst [Type " ?END without WHILE"
+		Jrst Erret]
+	Skipn BEGINp
+	  Jrst [Type " ?END without BEGIN"
+		Jrst Erret]
+	Pop P,BEGINp
+	Sos WHILEc
+
+Colis:	Move T4,4(T1)
+	Aoj D,
+	Movem T4,@Dicte
+
+CLoad:	Caie T1,DOTQa
+	  Cain T1,LOADa
+	    Jrst [Call BText
+		  Jrst Colon1]
+
+Colis1:	Caie T1,UNTILa
+	  Jrst Colis2
+	Skipge UNTILc
+	  Jrst [Type " ?UNTIL without REPEAT"
+		Jrst Erret]
+	Sos UNTILc
+	Jrst Colon1
+
+Colis2:	Caie T1,LOOPa
+	  Cain T1,LOOPPa
+	    Skipa
+	Jrst Colis3
+	Skipge DOc
+	  Jrst [Type " ?LOOP without DO"
+		Jrst Erret]
+	Sos DOc
+	Jrst Colon1
+
+Colis3:	Caie T1,IFa
+	  Jrst Colis4
+	Aos IFc
+	Jrst Colon1
+
+Colis4:	Caie T1,DOa
+	  Jrst Colis5
+	Move A,DOc
+	Cail A,DOn-1
+	  Jrst [Type " ?DOs nested too deeply"
+		Jrst Erret]
+	Aos DOc
+	Jrst Colon1
+
+Colis5:	Caie T1,REPTa
+	  Jrst Colis6
+	Move A,UNTILc
+	Cail A,UNTILn-1
+	  Jrst [Type " ?REPEATs nested too deeply"
+		Jrst Erret]
+	Aos UNTILc
+	Jrst Colon1
+
+Colis6:	Caie T1,WHILEa
+	  Jrst Colon1
+	Move A,WHILEc
+	Cail A,WHILEn-1
+	  Jrst [Type " ?WHILEs nested too deeply"
+		Jrst Erret]
+	Aos WHILEc
+	Push P,BEGINp
+	Setzm BEGINp
+	Jrst Colon1
+
+Coldun:	Skipl IFc
+	  Jrst [Type " ?Unfinished IF"
+		Jrst Erret]
+	Skipl DOc
+	  Jrst [Type " ?Unfinished DO"
+		Jrst Erret]
+	Skipl UNTILc
+	  Jrst [Type " ?Unfinished REPEAT"
+		Jrst Erret]
+	Skipl WHILEc
+	  Jrst [Type " ?Unfinished WHILE"
+		Jrst Erret]
+	Hrrz T1,Dicte
+	Addi T1,4	;Address of executable part
+	Addi D,2
+	Hrl T1,D
+	Movem T1,-1(T1)	;Length,,Address
+	Addm D,Dicte
+	Setzm Making
+	Return
+
+;;;
+;;;	Dictionary building words
+;;;
+
+Builds:	Skipe Making				; 
+	  Jrst [Move V,BStart
+		Call 4SAVE
+		Return]
+	Move T1,Dicte
+	Move T2,E
+	Aoj D,
+	Hrl T2,D
+	Movem T2,3(T1)
+	Addm D,Dicte
+	Setzm Making
+	Setom Did
+	Return
+
+Comma:	Skipn Making			; ,
+	  Jrst Buierr
+	Call 4REST
+	Aoj D,
+	Movem V,@Dicte
+	Return
+
+Allot:	Skipn Making			; ALLOT
+	  Jrst Buierr
+	Call 4REST
+	Skiple V
+	  Add D,V
+	Return
+
+Ticome:	Skipn Making			; ] --> n
+	  Jrst Buierr
+	Setz V,
+Ticom2:	Call Getwrd
+	  Call Refill
+	Skipe INump
+	  Jrst Numer
+	Skipn IAddr
+	  Jrst UDef
+	Move A,IAddr
+	Cain A,SEMIa
+	  Jrst [Call 4SAVE
+		Return]
+	Aoj D,
+	Movem A,@Dicte
+	Aoja V,Ticom2
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;                  Error Messages and Handling		   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+NoFile:	Type " ?Can't access file"
+	Jrst Rerun
+
+UFlow:	Type " ?Stack underflow"
+	Jrst Erret
+
+OFlow:	Type " ?Stack overflow"
+	Jrst Erret
+
+Buierr:	Type " ?Not building"
+	Jrst Erret
+
+DOerr:	Type " ?Loops too shallow"
+	Jrst Erret
+
+NForm:	Type " ?Not formatting"
+	Jrst Erret
+
+Unform:	Type " ?Formatting # gone"
+	Setzm Format
+	Jrst Erret
+
+UDef:	Type " ?Undefined word"
+	Jrst Erret
+
+Numer:	Type " ?Numeric word"
+	Jrst Erret
+
+WMode:	Type " ?Immediate use disallowed"
+
+Erret:	Call Terpri
+	Move T1,[440700,,InBuf]
+	Move T2,nIchar
+	Soj T2,
+Erret2:	Ildb A,T1
+	PBOUT
+	Sojg T2,Erret2
+Erret3:	Type "<--"
+
+UnMake:	Skipn Making
+	  Jrst ReRun
+	Call Terpri
+	Type "%Unbuilding"
+	Setzm @Dicte
+	Sojge D,.-1
+	Setzm Making
+
+ReRun:	Setzm nIchar
+	Setom Level
+	Setom DOc
+	Setom IFc
+	Setom WHILEc
+	Setom UNTILc
+	Move P,PDList
+	Skipn Loadp
+	  Jrst PPRun
+	Call Terpri
+	Type "%Aborting load"
+	Call Unload
+	Jrst PPRun
+
+NamErr:	Movei A,40
+	PBOUT
+	Hrroi A,IStrin
+	PSOUT
+	Movei A,"?
+	PBOUT
+	Movei A,40
+	PBOUT
+	Jrst ReRun
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;                          Subroutines			   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;								   ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+4SAVE:	Cail U,Deep
+	  Jrst OFlow
+	Aoj U,
+	Push S,V
+	Return
+
+4REST:	Jumpe U,UFlow
+	Soj U,
+	Pop S,V
+	Return
+
+Getchr:	Ildb K,pInBuf		;Returns one character in K.  Skips
+	Skipn K			;if there's something to get.
+	  Return
+	Aos nIchar
+	Jrst Popj1
+
+Refill:	Skipe Echo		;Does a fill-input-buffer and returns
+	  Call Terpri		;to the instruction BEFORE the call.
+	Call FillIB
+	Sos (P)
+	Sos (P)
+	Return
+
+FillIB:	Setzb T2,nIchar		;Gets a line of input from the input
+	Move T4,[440700,,InBuf]	;source, with rubout handling, and
+GL2:	Move A,iJFN		;stores it in InBuf - Appropriate BPs
+GL2a:	BIN			;and character counts are reset.
+	Erjmp [Call Unload
+	       Jrst GLF]
+	Andi B,177
+	Cain B,^M
+	  Jrst GL4
+	Cain B,^E
+	  Jrst [Setcmm Echo
+		Jrst GL2a]
+	Caige B,40
+	  Jrst GL2
+	Cain B,177
+	  Jrst [Jumpe T2,GL2
+		DBP T4
+		Movei A,^H
+		PBOUT
+		Movei A,40
+		PBOUT
+		Movei A,^H
+		PBOUT
+		Soja T2,GL2]
+GL3:	Move A,B
+	Skipe Echo
+	  PBOUT
+GL4:	Cail T2,IBufln*5
+	  Jrst GL2
+	Idpb B,T4
+	Aoj T2,
+	Caie B,^M
+	  Jrst GL2
+
+GLnulp:	Caie T2,1	;Ignore blank lines.
+	  Jrst GLF
+	Skipe Echo
+	  Call Terpri
+	Jrst FillIB
+
+GLF:	Idpb T4		;Store the final 0 to make string ASCIZ
+	Move B,[440700,,InBuf]
+	Movem B,pInbuf
+	Return
+
+Getwrd:	Setzm IStrin			;Reads one word (terminated by
+	Move A,[IStrin,,IStrin+1]	;a blank, tab, or CR), parses
+	BLT A,IVal			;it, and sets flags.  If INUMp
+	Setz T2,			;is true, it's a number, whose
+	Move T4,[440700,,IStrin]	;value is in IVAL.  If IADDR is
+GWskip:	Call Getchr			;nonzero, then it is the address
+	  Return			;in the Dictionary of the word.
+	Caie K,40
+	  Cain K,^I
+	    Jrst GWskip
+	Jrst GW3
+GW2:	Call Getchr
+	  Jrst Check
+GW3:	Caie K,40
+	  Cain K,^I
+	    Jrst Check
+	Cain K,^M
+	  Jrst Check
+	Cail T3,5*3	;Only 15 characters are significant
+	  Jrst GW2
+	Cail K,140
+	  Trz K,40
+	Cail K,"0	;if 0-9, or - in 1st place, or a ".", then ok.
+	  Caile K,"9
+	    Skipa
+	Jrst GW4
+	Cain K,"-
+	  Skipe T2
+	    Skipa
+	Jrst GW4
+	Caie K,".
+	  Setom NotNum
+GW4:	Idpb K,T4	;Store UPPERCASE
+	Aoja T2,GW2
+
+Check:	Skipn T2
+	  Return
+	Move T1,[350700,,IStrin]
+	Call StoN
+	  Jrst FCheck
+	Movem T2,IVal
+	Setom INump
+	Jrst Popj1
+
+FCheck:	Skipe NotNum
+	  Jrst Search
+	Move A,[440700,,IStrin]
+	FLIN
+	  Jrst Search
+	Movem B,IVal
+	Setom INump
+	Jrst Popj1
+
+Search:	Movei T1,Dict
+S1:	Move T4,IStrin
+	Came T4,(T1)
+	  Jrst NFound
+	Move T4,IStrin+1
+	Came T4,1(T1)
+	  Jrst NFound
+	Move T4,IStrin+2
+	Came T4,2(T1)
+	  Jrst NFound
+	Hrrzm T1,IAddr
+	Jrst Popj1
+
+NFound:	Hlrz T2,3(T1)
+	Skipn T2
+	  Jrst Popj1
+	Add T1,T2
+	Jrst S1
+
+Eval:	Aos Level	;The heart of FORTH.  EVAL is the creature that
+	Skipn Trace	;evaluates *things* - It either pushes constants,
+	  Jrst Eval1	;calls subroutines (FORTH primitives), or EVALs
+	Call Terpri	;the body of a FORTH word.  Note than that EVAL
+	Move C,Level	;is, by nature, recursive.
+	Jumpe C,ET1
+	IMuli C,2
+	Movei A,"=
+	PBOUT
+	Sojn C,.-1
+ET1:	Movei A,">
+	PBOUT
+
+Eval1:	Came L,[-1]
+	  Jrst Eval2
+	Move V,1(E)
+	Call 4SAVE
+	Skipn Trace
+	  Aoja E,EExit
+	Type " Constant"
+	Call SDump
+	Aoja E,EExit
+
+Eval2:	Skipl L
+	  Jrst Eval3
+	Skipe Trace
+	  Jrst [Movei A,40
+		PBOUT
+		Call PFind
+		Hrli V,350700
+		Call 7TLoop
+		Jrst .+1]
+	Call (L)		; -1,,Subroutine
+	Skipe Trace
+	  Call SDump
+	Jrst EExit
+
+Eval3:	Hrrz T1,L	;T1 = Dict Addr
+	Push P,E
+	Hrrz E,3(T1)	;Code field
+	Movei B,4(T1)
+	Movem B,BStart
+	Skipn Trace
+	  Jrst Eval5
+	Movei A,40
+	PBOUT
+	Move V,T1
+	Hrli V,350700
+	Call 7TLoop
+	Call SDump
+
+Eval5:	Skipe Did
+	  Jrst EExitd
+	Move L,(E)
+	Jumpe L,EExit1
+	Call Eval		;Recurse!
+	Aoja E,Eval5
+
+EExitd:	Setzm Did
+EExit1:	Pop P,E
+EExit:	Sos Level
+	Return
+
+
+MHead:	Call Getwrd		;This starts a Dictionary entry by filling
+	  Call Refill		;in the name field, and reserving 1 more.
+	Skipe INump
+	  Jrst [Type " ?Numeric name field"
+		Jrst Erret]
+	Skipe IAddr
+	  Jrst [Type " ?Already defined"
+		Jrst Erret]
+	Movei D,2
+MH2:	Move T2,IStrin(D)
+	Movem T2,@Dicte
+	Sojge D,MH2
+	Movei D,3
+	Movei A,1
+	Movem A,@Dicte
+	Return
+
+sText:	Call Getchr		;This reads text from the input buffer
+	  Call Refill		;(delimited by 1st character) and stores
+	Movem K,Delim		;them using T1 as the BP.  It saves the
+sTextd:	Hrli T1,440700		;# of chars read in LSTEXT
+	Setzm lsText
+BTLoop:	Call Getchr
+	  Call Refill
+	Camn K,Delim
+	  Jrst BTdone
+	Idpb K,T1
+	Aos lsText
+	Jrst BTLoop
+BTdone:	Idpb T1		;Make asciz
+	Return
+
+BText:	Skipn Making		;Used for ." and so on while building
+	  Jrst Buierr		;to save the text in the Dictionary entry.
+	Move T1,Dicte
+	Aoj D,
+	Add T1,D
+	Call sText
+	Move T2,lsText
+	Idivi T2,5
+	Add D,T2
+	Return
+
+PFind:	Movei V,Dict+3		;This finds the address of the primitive
+PFind1:	Hrre A,(V)		;whose machine address we know (L)
+	Jumpg A,[Setz V,
+		 Return]
+	Came L,1(V)
+	  Jrst [Hlrz B,(V)
+		Add V,B
+		Jrst PFind1]
+	Subi V,3
+	Return
+
+SDump:	Call Terpri			;This dumps the top 10. numbers
+	Type "[ "			;on the stack for TRACEing.  TOS
+	Jumpe U,[Type "Nil ] "		;is to the right.
+		Return]
+	Move C,U
+	Soj C,
+	Caig C,10.
+	  Jrst SDump1
+	Type "... "
+	Movei C,10.
+SDump1:	Move V,S
+	Sub V,C
+	Move V,(V)
+	Call Dota
+	Sojge C,SDump1
+	Type "] "
+	Return
+
+StoN:	Setzb A,B		;This is the String-to-Number routine.  It
+	Setzb T3,StoNmp		;expects a BP to the text in T1, and returns
+SN1:	Ldb K,T1		;(skipping) with T2 as the number, and T3
+	Caie K,40		;the number of character read.
+	  Cain K,^I
+	    Aoja T3,SN1
+	Skipa
+SN2:	Ldb K,T1
+	Aoj A,
+	Caie K,40	;String ends on "," or  or 
+	  Cain K,^M	;or a 0-byte
+	    Jrst SNtest
+	Caie K,",
+	  Skipn K
+	    Jrst SNtest
+	Cain K,"-
+	  Caie A,1
+	    Jrst SN3
+	Setom StoNmp
+	Ibp T1
+	Jrst SN2
+SN3:	Subi K,60
+	Skipge K
+	  Jrst SNbad
+	Caml K,Base
+	  Jrst SNbad
+	Push P,K
+	Ibp T1
+	Aoja B,SN2
+
+SNtest:	Jumpe B,SNbad
+	Setz T2,
+	Movei T4,1
+SNgood:	Pop P,K
+	Imul K,T4
+	Imul T4,Base
+	Add T2,K
+	Sojn B,SNgood
+SNg2:	Skipe StoNmp
+	  Movns T2
+	Add T3,A
+	Jrst Popj1
+
+SNbad:	Skipn B
+	  Return
+	Pop P,K
+	Soja B,SNbad
+
+Lose:	Type "--Severe lossage--Dying--"
+Die:	HALTF
+	Jrst .-1
+
+;;;
+;;;	The End
+;;;
+
+Variables
+Constants
+
+	END Start
\ No newline at end of file
diff --git a/twenex-forth.txt b/twenex-forth.txt
new file mode 100755
index 0000000..82e962a
--- /dev/null
+++ b/twenex-forth.txt
@@ -0,0 +1,136 @@
+TWENEX FORTH WORDS
+
+	DUP
+	SWAP
+	ROLL
+	PICK
+	DROP
+	OVER
+	ROT
+	-DUP
+	?DUP
+	LEVEL
+	DEPTH
+	FLOAT
+	+
+	-
+	*
+	/
+	^
+	F+
+	F-
+	F*
+	F/
+	FIX
+	MOD
+	/MOD
+	0=
+	0=_
+	0<
+	0<=
+	0>
+	0>=
+	EXCHANGE
+	JSYS
+	=
+	=_
+	<
+	<=
+	>
+	>=
+	FLUSH
+	TRACE
+	@
+	!
+	+!
+	-!
+	FILL
+	'
+	'#
+	]
+	QUIT
+	<#
+	#
+	HOLD
+	#N
+	SIGN
+	#S
+	#>
+	HOME
+	CR
+	CLEAR
+	SPACE
+	SPACES
+	EMIT
+	TYPE
+	[TYPE]
+	KEY
+	?TERMINAL
+	EXPECT
+	[EXPECT]
+	C@
+	C!
+	C>
+	C<
+	.
+	.R
+	F.
+	."
+	:"
+	(")
+	["]
+	VLIST
+	(
+	ABS
+	MINUS
+	+-
+	1+
+	1-
+	MAX
+	MIN
+	SINE
+	COSINE
+	ROOT
+	LN
+	<-,,
+	SW,,AP
+	,,->
+	AND
+	OR
+	NOT
+	XOR
+	EXECUTE
+	FORGET
+	:
+	;
+	
+	,
+	ALLOT
+	LOAD
+	[LOAD]
+	UNLOAD
+	DECIMAL
+	OCTAL
+	BINARY
+	IF
+	ELSE
+	THEN
+	DO
+	LOOP
+	+LOOP
+	I
+	J
+	IJ..N
+	RUNT
+	REPEAT
+	UNTIL
+	CMOVE
+	[CMOVE]
+	HERE
+	LEAVE
+	ERROR
+	[NUMBER]
+	WHILE
+	BEGIN
+	END
diff --git a/wareki.fs b/wareki.fs
new file mode 100755
index 0000000..b47eafa
--- /dev/null
+++ b/wareki.fs
@@ -0,0 +1,103 @@
+\ wareki.fs - Display WAREKI and Anno Domini corresponding years
+\ +JMJ 2013 David Meyer 
+
+\ help-wareki - Display module help
+: help-wareki ( -- )
+    cr ." WAREKI" cr
+    ." Display Japanese era years corresponding to A.D. years and" cr
+    ." vice versa." cr
+    ." HEISEI ( u -- ) Display A.D. year corresponding to Heisei era year." cr
+    ." MEIJI ( u -- ) Display A.D. year corresponding to Meiji era year." cr
+    ." NENGO ( u -- ) Display Japanese year in Meiji, Taishou, Shouwa," cr
+    ."                or Heisei eras corresponding to A.D. year." cr
+    ." SHOWA ( u -- ) Display A.D. year corresponding to Shouwa era year." cr
+    ." TAISHO ( u -- ) Display A.D. year corresponding to Taishou era year." cr
+;
+
+\ nengo - Display NENGO for A.D. (Meiji, Taishou, Shouwa,
+\         Heisei eras only)
+: nengo ( u -- )
+    dup 1868 < if
+	." ERROR: Year precedes MEIJI era " drop
+    else
+	dup 1868 = if
+	    ." MEIJI GANNEN (Sep 8 -) " drop
+	else
+	    dup 1912 < if
+		." MEIJI " 1867 - .
+	    else
+		dup 1912 = if
+		    ." MEIJI 45/TAISHO GANNEN (Jul 30-) " drop
+		else
+		    dup 1926 < if
+			." TAISHO " 1911 - .
+		    else
+			dup 1926 = if
+			    ." TAISHO 15/SHOWA GANNEN (Dec 25-) " drop
+			else
+			    dup 1989 < if
+				." SHOWA " 1925 - .
+			    else
+				dup 1989 = if
+				    ." SHOWA 64/HEISEI GANNEN (Jan 8-) " drop
+				else
+				    ." HEISEI " 1988 - .
+				then
+			    then
+			then
+		    then
+		then
+	    then
+	then
+    then
+;
+
+\ meiji - Display A.D. for Meiji era NENGO.
+: meiji ( u -- )
+    dup 0= if
+	." ERROR: NENGO < 1 " drop
+    else
+	dup 45 > if
+	    ." ERROR: NENGO > 45 " drop
+	else
+	    ." AD " 1867 + .
+	then
+    then
+;
+
+\ taisho - Display A.D. for Taishou era NENGO.
+: taisho ( u -- )
+    dup 0= if
+	." ERROR: NENGO < 1 " drop
+    else
+	dup 15 > if
+	    ." ERROR: NENGO > 15 " drop
+	else
+	    ." AD " 1911 + .
+	then
+    then
+;
+
+\ showa - Display A.D. for Shouwa era NENGO.
+: showa ( u -- )
+    dup 0= if
+	." ERROR: NENGO < 1 " drop
+    else
+	dup 64 > if
+	    ." ERROR: NENGO > 64 " drop
+	else
+	    ." AD " 1925 + .
+	then
+    then
+;
+
+\ heisei - Display A.D. for Heisei era NENGO.
+: heisei ( u -- )
+    dup 0= if
+	." ERROR: NENGO < 1 " drop
+    else
+	." AD " 1988 + .
+    then
+;
+
+cr ." Type 'help-wareki' for help" 
diff --git a/yuko-notes.org b/yuko-notes.org
new file mode 100755
index 0000000..2260363
--- /dev/null
+++ b/yuko-notes.org
@@ -0,0 +1,155 @@
+Yuko Development Notes
+
+* Purpose 
+
+To replace Cora Phyco with unit conversion system using primarily
+integer arithmetic.
+
+* Style 
+
+Instead of Cora Phyco-style
+conversion-constants-with-universal-converter, use more conventional
+function-per-unit-pair style. Results not prnted but left on top of
+stack for user to print or use in further calculation.
+
+Reduce supported units to minimum necessary to reduce number of
+functions to program.
+
+Reduce all ratios to lowest terms to reduce chance of overflow.
+
+* Conversion Ratios
+
+The statement "The ratio of unit A to unit B is x:y" means that for a
+given quantity, the magnitude of the quantity measured in unit A and
+the magnitude of the same quantity measured in unit B are in the
+ratio x:y. (NOT the ratio of the quantities of 1 unit of A and 1 unit
+of B.)
+
+** Linear measure
+
+Units: mm, in, ft, m, km, mi
+
+*** Defined ratios
+
+| in:mm | 10:254 = 5:127 |
+
+| m:mm | 1:1000 |
+| km:m | 1:1000 |
+
+| ft:in |   1:12 |
+| mi:ft | 1:5280 |
+
+*** Derived ratios
+
+| km:mm | 1:1000000 |
+| mi:in |   1:63360 |
+
+| ft:mm |          5:1524 |
+| mi:mm |       1:1609344 |
+| m:in  |        127:5000 |
+| km:in |     127:5000000 |
+| m:ft  |        381:1250 |
+| km:ft |     381:1250000 |
+| mi:m  |    5000:8047863 |
+| mi:km | 5000000:8047863 |
+
+
+
+
+** Time
+
+Units: s, min, hr, day, yr
+
+| 60 s = 1 min      | 60/1       | min>s   | 60 *       |
+|                   |            | s>min   | 60 /       |
+| 3600 s = 1 hr     | 3600/1     | hr>s    | 3600 *     |
+|                   |            | s>hr    | 3600 /     |
+| 86400 s = 1 day   | 86400/1    | day>s   | 86400 *    |
+|                   |            | s>day   | 86400 /    |
+| 30780000 s = 1 yr | 30780000/1 | yr>s    | 30780000 * |
+|                   |            | s>yr    | 30780000 / |
+| 60 min = 1 hr     | 60/1       | hr>min  | 60 *       |
+|                   |            | min>hr  | 60 /       |
+| 1440 min = 1 day  | 1440/1     | day>min | 1440 *     |
+|                   |            | min>day | 1440 /     |
+| 24 hr = 1 day     | 24/1       | day>hr  | 24 *       |
+|                   |            | hr>day  | 24 /       |
+| 513000 min = 1 yr | 513000/1   | yr>min  | 513000 *   |
+|                   |            | min>yr  | 513000 /   |
+| 4 yr = 1425 day   |            |         |            |
+
+|     |       s |      min |     hr |     day |       yr |
+|-----+---------+----------+--------+---------+----------|
+| s   |       - |     60:1 | 3600:1 | 86400:1 |        X |
+| min |    1:60 |        - |   60:1 |  1440:1 | 525960:1 |
+| hr  |  1:3600 |     1:60 |      - |    24:1 |   8766:1 |
+| day | 1:86400 |   1:1440 |   1:24 |       - |   1461:4 |
+| yr  |       X | 1:525960 | 1:8766 |  4:1461 |        - |
+
+| s>min   | 60 /      |   | min>s   | 60 *      |
+| s>hr    | 3600 /    |   | hr>s    | 3600 *    |
+| s>day   | 86400 /   |   | day>s   | 86400 *   |
+| min>hr  | 60 /      |   | hr>min  | 60 *      |
+| min>day | 1440 /    |   | day>min | 1440 *    |
+| min>yr  | 525960 /  |   | yr>min  | 525960 *  |
+| hr>day  | 24 /      |   | day>hr  | 24 *      |
+| hr>yr   | 8766 /    |   | yr>hr   | 8766 *    |
+| day>yr  | 4 1461 */ |   | yr>day  | 1461 4 */ |
+
+** Volume
+
+ML milliliter  L liter
+TSP teaspoon  TBSP tablespoon  CUP  FLOZ fluid ounce  
+PT pint  QT quart  GAL gallon
+
+| 1000 ml = 1 l         |           1000:1 |
+| 3 tsp = 1 tbsp        |              3:1 |
+| 2 tbsp = 1 fl oz      |              2:1 |
+| 48 tsp = 1 cup        |             48:1 |
+| 8 fl oz = 1 cup       |              8:1 |
+| 2 cup = 1 pt          |              2:1 |
+| 2 pt = 1 qt           |              2:1 |
+| 4 qt = 1 gal          |              4:1 |
+| 3785.41784 ml = 1 gal | 378541784:100000 |
+|                       |   47317723:12500 |
+| (4.93 ml = 1 tsp)     |                  |
+
+|       |       ml |        tsp |       tbsp |      fl oz |       cup |        pt |        qt |          l |       gal |
+| ml    |        - |   47317723 |   47317723 |   47317723 |  47317723 |  47317723 |  47317723 |     1000:1 |  47317723 |
+|       |          |   :9600000 |   :3200000 |   :1600000 |   :200000 |   :100000 |    :50000 |            |    :12500 |
+| tsp   | 9600000: |          - |        3:1 |        6:1 |      48:1 |      96:1 |     192:1 | 9600000000 |     768:1 |
+|       | 47317723 |            |            |            |           |           |           |  :47317723 |           |
+| tbsp  | 3200000: |        1:3 |          - |        2:1 |      16:1 |      32:1 |      64:1 | 3200000000 |     256:1 |
+|       | 47317723 |            |            |            |           |           |           |  :47317723 |           |
+| fl oz | 1600000: |        1:6 |        1:2 |          - |       8:1 |      16:1 |      32:1 | 1600000000 |     128:1 |
+|       | 47317723 |            |            |            |           |           |           |  :47317723 |           |
+| cup   |  200000: |       1:48 |       1:16 |        1:8 |         - |       2:1 |       4:1 |  200000000 |      16:1 |
+|       | 47317723 |            |            |            |           |           |           |  :47317723 |           |
+| pt    |  100000: |       1:96 |       1:32 |       1:16 |       1:2 |         - |       2:1 |  100000000 |       8:1 |
+|       | 47317723 |            |            |            |           |           |           |  :47317723 |           |
+| qt    |   50000: |      1:192 |       1:64 |       1:32 |       1:4 |       1:2 |         - |   50000000 |       4:1 |
+|       | 47317723 |            |            |            |           |           |           |  :47317723 |           |
+| l     |   1:1000 |  47317723: |  47317723: |  47317723: | 47317723: | 47317723: | 47317723: |          - | 47317723: |
+|       |          | 9600000000 | 3200000000 | 1600000000 | 200000000 | 100000000 |  50000000 |            |  12500000 |
+| gal   |   12500: |      1:768 |      1:256 |      1:128 |      1:16 |       1:8 |       1:4 |  12500000: |         - |
+|       | 47317723 |            |            |            |           |           |           |   47317723 |           |
+
+
+
+
+
+* Double-precision division
+
+dn = nl + m*nh
+
+dn / d = (nl + m*nh)/d
+        = nl/d + m*nh/d
+
+: dn/ ( d n1 -- n2 ) tuck / rot rot / swap d>s ;
+
+(Thought I would need this for converting between seconds and years,
+but not so.)
+
+
+
+
diff --git a/yuko-test.fs b/yuko-test.fs
new file mode 100755
index 0000000..81c1c0e
--- /dev/null
+++ b/yuko-test.fs
@@ -0,0 +1,185 @@
+\ yuko-test.fs - Test driver for Yuko Units Converter
+\ 2013 David Meyer 
+
+\ require yuko.fs
+
+: test ( - )
+    cr ." Starting tests... "
+    ." s>min "
+    assert( 4199 s>min 69 = )
+    assert( 4200 s>min 70 = )
+    assert( 4201 s>min 70 = )
+
+    ." s>hr "
+    assert( 251999 s>hr 69 = )
+    assert( 252000 s>hr 70 = )
+    assert( 252001 s>hr 70 = )
+
+    ." s>day "
+    assert( 6047999 s>day 69 = )
+    assert( 6048000 s>day 70 = )
+    assert( 6048001 s>day 70 = )
+
+    ." min>hr "
+    assert( 4199 min>hr 69 = )
+    assert( 4200 min>hr 70 = )
+    assert( 4201 min>hr 70 = )
+
+    ." min>day "
+    assert( 100799 min>day 69 = )
+    assert( 100800 min>day 70 = )
+    assert( 100801 min>day 70 = )
+
+    ." min>yr "
+    assert( 36817199 min>yr 69 = )
+    assert( 36817200 min>yr 70 = )
+    assert( 36817201 min>yr 70 = )
+
+    ." hr>day "
+    assert( 1679 hr>day 69 = )
+    assert( 1680 hr>day 70 = )
+    assert( 1681 hr>day 70 = )
+
+    ." hr>yr "
+    assert( 613619 hr>yr 69 = )
+    assert( 613620 hr>yr 70 = )
+    assert( 613621 hr>yr 70 = )
+
+    ." day>yr "
+    assert( 29219 day>yr 79 = )
+    assert( 29220 day>yr 80 = )
+    assert( 29221 day>yr 80 = )
+
+    ." min>s "
+    assert( 69 min>s 4140 = )
+    assert( 70 min>s 4200 = )
+    assert( 71 min>s 4260 = )
+
+    ." hr>s "
+    assert( 69 hr>s 248400 = )
+    assert( 70 hr>s 252000 = )
+    assert( 71 hr>s 255600 = )
+
+    ." day>s "
+    assert( 69 day>s 5961600 = )
+    assert( 70 day>s 6048000 = )
+    assert( 71 day>s 6134400 = )
+
+    ." hr>min "
+    assert( 69 hr>min 4140 = )
+    assert( 70 hr>min 4200 = )
+    assert( 71 hr>min 4260 = )
+
+    ." day>min "
+    assert( 69 day>min 99360 = )
+    assert( 70 day>min 100800 = )
+    assert( 71 day>min 102240 = )
+
+    ." yr>min "
+    assert( 69 yr>min 36291240 = )
+    assert( 70 yr>min 36817200 = )
+    assert( 71 yr>min 37343160 = )
+
+    ." day>hr "
+    assert( 69 day>hr 1656   = )
+    assert( 70 day>hr 1680 = )
+    assert( 71 day>hr 1704 = )
+
+    ." yr>hr "
+    assert( 69 yr>hr 604854 = )
+    assert( 70 yr>hr 613620 = )
+    assert( 71 yr>hr 622386 = )
+
+    ." yr>day "
+    assert( 79 yr>day 28854 = )
+    assert( 80 yr>day 29220 = )
+    assert( 81 yr>day 29585 = )
+
+    ." ml>tsp " assert( 47317723 ml>tsp 9600000 = )
+    ." ml>tbsp " assert( 47317723 ml>tbsp 3200000 = )
+    ." ml>floz " assert( 47317723 ml>floz 1600000 = )
+    ." ml>cup " assert( 47317723 ml>cup 200000 = )
+    ." ml>pt " assert( 47317723 ml>pt 100000 = )
+    ." ml>qt " assert( 47317723 ml>qt 50000 = )
+    ." ml>l " assert( 100000 ml>l 100 = )
+    ." ml>gal " assert( 47317723 ml>gal 12500 = )
+
+    ." tsp>ml " assert( 9600000 tsp>ml 47317723 = )
+    ." tsp>tbsp " assert( 76800 tsp>tbsp 25600 = )
+    ." tsp>floz " assert( 76800 tsp>floz 12800 = )
+    ." tsp>cup " assert( 76800 tsp>cup 1600 = )
+    ." tsp>pt " assert( 76800 tsp>pt 800 = )
+    ." tsp>qt " assert( 76800 tsp>qt 400 = )
+    ." tsp>l " assert( 9600000000 tsp>l 47317723 = )
+    ." tsp>gal " assert( 76800 tsp>gal 100 = )
+
+    ." tbsp>ml " assert( 3200000 tbsp>ml 47317723 = )
+    ." tbsp>tsp " assert( 25600 tbsp>tsp 76800 = )
+    ." tbsp>floz " assert( 25600 tbsp>floz 12800 = )
+    ." tbsp>cup " assert( 25600 tbsp>cup 1600 = )
+    ." tbsp>pt " assert( 25600 tbsp>pt 800 = )
+    ." tbsp>qt " assert( 25600 tbsp>qt 400 = )
+    ." tbsp>l " assert( 3200000000 tbsp>l 47317723 = )
+    ." tbsp>gal " assert( 25600 tbsp>gal 100 = )
+
+    ." floz>ml " assert( 1600000 floz>ml 47317723 = )
+    ." floz>tsp " assert( 12800 floz>tsp 76800 = )
+    ." floz>tbsp " assert( 12800 floz>tbsp 25600 = )
+    ." floz>cup " assert( 12800 floz>cup 1600 = )
+    ." floz>pt " assert( 12800 floz>pt 800 = )
+    ." floz>qt " assert( 12800 floz>qt 400 = )
+    ." floz>l " assert( 1600000000 floz>l 47317723 = )
+    ." floz>gal " assert( 12800 floz>gal 100 = )
+
+    ." cup>ml " assert( 200000 cup>ml 47317723 = )
+    ." cup>tsp " assert( 1600 cup>tsp 76800 = )
+    ." cup>tbsp " assert( 1600 cup>tbsp 25600 = )
+    ." cup>floz " assert( 1600 cup>floz 12800 = )
+    ." cup>pt " assert( 1600 cup>pt 800 = )
+    ." cup>qt " assert( 1600 cup>qt 400 = )
+    ." cup>l " assert( 200000000 cup>l 47317723 = )
+    ." cup>gal " assert( 1600 cup>gal 100 = )
+
+    ." pt>ml " assert( 100000 pt>ml 47317723 = )
+    ." pt>tsp " assert( 800 pt>tsp 76800 = )
+    ." pt>tbsp " assert( 800 pt>tbsp 25600 = )
+    ." pt>floz " assert( 800 pt>floz 12800 = )
+    ." pt>cup " assert( 800 pt>cup 1600 = )
+    ." pt>qt " assert( 800 pt>qt 400 = )
+    ." pt>l " assert( 100000000 pt>l 47317723 = )
+    ." pt>gal " assert( 800 pt>gal 100 = )
+
+    ." qt>ml " assert( 50000 qt>ml 47317723 = )
+    ." qt>tsp " assert( 400 qt>tsp 76800 = )
+    ." qt>tbsp " assert( 400 qt>tbsp 25600 = )
+    ." qt>floz " assert( 400 qt>floz 12800 = )
+    ." qt>cup " assert( 400 qt>cup 1600 = )
+    ." qt>pt " assert( 400 qt>pt 800 = )
+    ." qt>l " assert( 50000000 qt>l 47317723 = )
+    ." qt>gal " assert( 400 qt>gal 100 = )
+
+    ." l>ml " assert( 100 l>ml 100000 = )
+    ." l>tsp " assert( 47317723 l>tsp 9600000000 = )
+    ." l>tbsp " assert( 47317723 l>tbsp 3200000000 = )
+    ." l>floz " assert( 47317723 l>floz 1600000000 = )
+    ." l>cup " assert( 47317723 l>cup 200000000 = )
+    ." l>pt " assert( 47317723 l>pt 100000000 = )
+    ." l>qt " assert( 47317723 l>qt 50000000 = )
+    ." l>gal " assert( 47317723 l>gal 12500000 = )
+
+    ." gal>ml " assert( 12500 gal>ml 47317723 = )
+    ." gal>tsp " assert( 100 gal>tsp 76800 = )
+    ." gal>tbsp " assert( 100 gal>tbsp 25600 = )
+    ." gal>floz " assert( 100 gal>floz 12800 = )
+    ." gal>cup " assert( 100 gal>cup 1600 = )
+    ." gal>pt " assert( 100 gal>pt 800 = )
+    ." gal>qt " assert( 100 gal>qt 400 = )
+    ." gal>l " assert( 12500000 gal>l 47317723 = )
+
+    ." All tests successful." cr ;
+
+
+
+test
+
+\ +JMJ
diff --git a/yuko.fs b/yuko.fs
new file mode 100755
index 0000000..9e22982
--- /dev/null
+++ b/yuko.fs
@@ -0,0 +1,271 @@
+\ yuko.fs -- YUnit KOnverter
+\ +JMJ 2013-2014 David Meyer 
+
+\ help-yuko -- Print module help text.
+: help-yuko ( -- )
+    \     ---------1---------2---------3---------4---------5---------6---------7
+    cr ." YUKO -- YUnit KOnverter"
+    cr ." YUKO is a Forth module that provides functions for converting between"
+    cr ." various units of measurement. Most functions take the number of"
+    cr ." source units of a given quantity as an unsigned integer from the top"
+    cr ." of the stack and returns the equivalent number of target units."
+    cr ." Temperature functions take input and output as signed integers."
+    cr ." See also: HELP-YUKO-LENGTH, HELP-YUKO-MASS, HELP-YUKO-TEMP,"
+    cr ."  HELP-YUKO-TIME, HELP-YUKO-VOLUME, HELP-YUKO-PRICE"
+    cr
+;
+
+\ help-yuko-length -- Print help for length/distance conversions.
+: help-yuko-length ( -- )
+    \     ---------1---------2---------3---------4---------5---------6---------7
+    cr ." YUKO LENGTH/DISTANCE CONVERSIONS"
+    cr ." Units: foot (ft), inch (in), kilometer (km), meter (m), mile (mi),"
+    cr ."  millimeter (mm)"
+    cr ." Conversions: ft>in ft>km ft>m ft>mi ft>mm in>ft in>km in>m in>mi"
+    cr ."  in>mm km>ft km>in km>m km>mi km>mm m>ft m>in m>km m>mi m>mm mi>ft"
+    cr ."  mi>in mi>km mi>m mi>mm mm>ft mm>in mm>km mm>m mm>mi"
+    cr
+;
+
+\ help-yuko-mass -- Print help for mass/weight conversions.
+: help-yuko-mass ( -- )
+    \     ---------1---------2---------3---------4---------5---------6---------7
+    cr ." YUKO MASS/WEIGHT CONVERSIONS"
+    cr ." Units: gram (g), kilogram (kg), ounce (oz), pound (lb),"
+    cr ." troy ounce (ozt)
+    cr ." Conversions: kg>lb kg>g lb>oz kg>oz g>oz lb>g lb>kg g>kg oz>lb oz>kg"
+    cr ."   oz>g g>lb ozt>g g>ozt"
+    cr
+;
+
+\ help-yuko-temp -- Print help for temperature conversions.
+: help-yuko-temp ( -- )
+    \     ---------1---------2---------3---------4---------5---------6---------7
+    cr ." YUKO TEMPERATURE CONVERSIONS"
+    cr ." (Input and output in signed integers.)"
+    cr ." Units: Celsius degrees (c), Fahrenheit degrees (f)"
+    cr ." Conversions: c>f f>c"
+    cr
+;
+
+\ help-yuko-time -- Print help for time conversions.
+: help-yuko-time ( -- )
+    \     ---------1---------2---------3---------4---------5---------6---------7
+    cr ." YUKO TIME CONVERSIONS"
+    cr ." Units: day, hour (hr), minute (min), second (s), year (yr)"
+    cr ." Conversions: s>min s>hr s>day min>hr min>day min>yr hr>day hr>yr"
+    cr ."  day>yr min>s hr>s day>s hr>min day>min yr>min day>hr yr>hr yr>day"
+    cr ."  (No second <-> year conversion due to scale difference.)
+    cr
+;
+
+\ help-yuko-volume -- Print help for volume conversions.
+: help-yuko-volume ( -- )
+    \     ---------1---------2---------3---------4---------5---------6---------7
+    cr ." YUKO VOLUME CONVERSIONS"
+    cr ." Units: cup, fluid ounce (floz), gallon (gal), liter (l),"
+    cr ."  milliliter (ml), pint (pt), quart (qt), tablespoon (tbsp),"
+    cr ."  teaspoon (tsp)"
+    cr ." Conversions: cup>floz cup>gal cup>l cup>ml cup>pt cup>qt cup>tbsp"
+    cr ."  cup>tsp floz>cup floz>gal floz>l floz>ml floz>pt floz>qt floz>tbsp"
+    cr ."  floz>tsp gal>cup gal>floz gal>l gal>ml gal>pt gal>qt gal>tbsp"
+    cr ."  gal>tsp l>cup l>floz l>gal l>ml l>pt l>qt l>tbsp l>tsp ml>cup"
+    cr ."  ml>floz ml>gal ml>l ml>pt ml>qt ml>tbsp ml>tsp pt>cup pt>floz pt>gal"
+    cr ."  pt>l pt>ml pt>qt pt>tbsp pt>tsp qt>cup qt>floz qt>gal qt>l qt>ml"
+    cr ."  qt>pt qt>tbsp qt>tsp tbsp>cup tbsp>floz tbsp>gal tbsp>l tbsp>ml"
+    cr ."  tsp>qt tsp>tbsp tbsp>pt tbsp>qt tbsp>tsp tsp>cup tsp>floz tsp>gal"
+    cr ."  tsp>l tsp>ml tsp>pt"
+    cr
+;
+
+\ help-yuko-price -- Print help for price conversions.
+: help-yuko-price ( -- )
+    \     ---------1---------2---------3---------4---------5---------6---------7
+    cr ." YUKO PRICE CONVERSIONS"
+    cr ." Units: USD per troy ounce (do), JPY per gram (yg)"
+    cr ." Conversions: do>yg yg>do"
+    cr ." (Second argument is JPY:USD exchange rate in JPY per 1000 USD.)"
+    cr
+;
+
+\ LINEAR MEASURE
+\  FT foot, IN inch, KM kilometer, M meter, MI mile, MM millimeter  
+\  All values are unsigned integers.
+
+: ft>in ( u1 -- u2 ) 12 * ;
+: ft>km ( u1 -- u2 ) 381 1250000 */ ;
+: ft>m ( u1 -- u2 ) 381 1250 */ ;
+: ft>mi ( u1 -- u2 ) 5280 / ;
+: ft>mm ( u1 -- u2 ) 1524 5 */ ;
+: in>ft ( u1 -- u2 ) 12 / ;
+: in>km ( u1 -- u2 ) 127 5000000 */ ;
+: in>m ( u1 -- u2 ) 127 5000 */ ;
+: in>mi ( u1 -- u2 ) 63360 / ;
+: in>mm ( u1 -- u2 ) 127 5 */ ;
+: km>ft ( u1 -- u2 ) 1250000 381 */ ;
+: km>in ( u1 -- u2 ) 5000000 127 */ ;
+: km>m ( u1 -- u2 ) 1000 * ;
+: km>mi ( u1 -- u2 ) 5000000 8047863 */ ;
+: km>mm ( u1 -- u2 ) 1000000 * ;
+: m>ft ( u1 -- u2 ) 1250 381 */ ;
+: m>in ( u1 -- u2 ) 5000 127 */ ;
+: m>km ( u1 -- u2 ) 1000 / ;
+: m>mi ( u1 -- u2 ) 5000 8047863 */ ;
+: m>mm ( u1 -- u2 ) 1000 * ;
+: mi>ft ( u1 -- u2 ) 5280 * ;
+: mi>in ( u1 -- u2 ) 63360 * ;
+: mi>km ( u1 -- u2 ) 8047863 5000000 */ ;
+: mi>m ( u1 -- u2 ) 8047863 5000 */ ;
+: mi>mm ( u1 -- u2 ) 1609344 * ;
+: mm>ft ( u1 -- u2 ) 5 1524 */ ;
+: mm>in ( u1 -- u2 ) 5 127 */ ;
+: mm>km ( u1 -- u2 )  1000000 / ;
+: mm>m ( u1 -- u2 ) 1000 / ;
+: mm>mi ( u1 -- u2 ) 1609344 / ;
+
+\ MASS/WEIGHT
+\  G gram, KG kilogram, LB pound, OZ ounce, OZT troy ounce
+\  All values unsigned integers.
+\  OZT conversion to/from G only.
+
+: kg>lb ( u1 -- u2 ) 100000000 45359237 */ ;
+: kg>g ( u1 -- u2 ) 1000 * ;
+: lb>oz ( u1 -- u2 ) 16 * ;
+: kg>oz ( u1 -- u2 ) 1600000000 45359237 */ ;
+: g>oz ( u1 -- u2 ) 1600000 45359237 */ ;
+: lb>g ( u1 -- u2 ) 45359237 100000 */ ;
+: lb>kg ( u1 -- u2 ) 45359237 100000000 */ ;
+: g>kg ( u1 -- u2 ) 1000 / ;
+: oz>lb ( u1 -- u2 ) 16 / ;
+: oz>kg ( u1 -- u2 ) 45359237 1600000000 */ ;
+: oz>g ( u1 -- u2 ) 45359237 1600000 */ ;
+: g>lb ( u1 -- u2 ) 100000 45359237 */ ;
+: g>ozt ( u1 -- u2 ) 10000000 311034768 */ ;
+: ozt>g ( u1 -- u2 ) 311034768 10000000 */ ;
+
+\ TEMPERATURE
+\  C degrees Celsius, F degrees Fahrenheit
+\  All values signed integers
+
+: c>f ( n1 -- n2 ) 9 5 */ 32 + ;
+: f>c ( n1 -- n2 ) 32 - 5 9 */ ;
+
+\ TIME
+\  S second, MIN minute, HR hour, DAY, YR year
+\  (No s<->yr conversion due to scale diff.)
+\  All values unsigned integers.
+
+: s>min  ( u1 -- u2 )  60 /      ;   
+: s>hr  ( u1 -- u2 ) 3600 /    ;   
+: s>day  ( u1 -- u2 ) 86400 /   ;
+: min>hr  ( u1 -- u2 ) 60 /      ;   
+: min>day  ( u1 -- u2 ) 1440 /    ;   
+: min>yr  ( u1 -- u2 ) 525960 /  ;   
+: hr>day  ( u1 -- u2 )   24 /      ;   
+: hr>yr  ( u1 -- u2 )  8766 /    ;   
+: day>yr  ( u1 -- u2 )   4 1461 */ ;   
+: min>s  ( u1 -- u2 )  60 *      ;
+: hr>s  ( u1 -- u2 )   3600 *    ;
+: day>s  ( u1 -- u2 )    86400 *   ;
+: hr>min  ( u1 -- u2 ) 60 *      ;
+: day>min  ( u1 -- u2 )  1440 *    ;
+: yr>min  ( u1 -- u2 ) 525960 *  ;
+: day>hr  ( u1 -- u2 )   24 *      ;
+: yr>hr  ( u1 -- u2 )  8766 *    ;
+: yr>day  ( u1 -- u2 )   1461 4 */ ;
+
+\ VOLUME (LIQUIDS)
+\  ML milliliter  TSP teaspoon  TBSP tablespoon  FLOZ fluid ounce
+\  CUP  PT pint  QT quart  L liter  GAL gallon
+\  All values unsigned integers.
+
+: ml>tsp ( u1 -- u2 ) 9600000 47317723 */ ;
+: ml>tbsp ( u1 -- u2 ) 3200000 47317723 */ ;
+: ml>floz ( u1 -- u2 ) 1600000 47317723 */ ;
+: ml>cup ( u1 -- u2 ) 200000 47317723 */ ;
+: ml>pt ( u1 -- u2 ) 100000 47317723 */ ;
+: ml>qt ( u1 -- u2 ) 50000 47317723 */ ;
+: ml>l ( u1 -- u2 ) 1000 / ;
+: ml>gal ( u1 -- u2 ) 12500 47317723 */ ;
+
+: tsp>ml ( u1 -- u2 ) 47317723 9600000 */ ;
+: tsp>tbsp ( u1 -- u2 ) 3 / ;
+: tsp>floz ( u1 -- u2 ) 6 / ;
+: tsp>cup ( u1 -- u2 ) 48 / ;
+: tsp>pt ( u1 -- u2 ) 96 / ;
+: tsp>qt ( u1 -- u2 ) 192 / ;
+: tsp>l ( u1 -- u2 ) 47317723 9600000000 */ ;
+: tsp>gal ( u1 -- u2 ) 768 / ;
+
+: tbsp>ml ( u1 -- u2 ) 47317723 3200000 */ ;
+: tbsp>tsp ( u1 -- u2 ) 3 * ;
+: tbsp>floz ( u1 -- u2 ) 2 / ;
+: tbsp>cup ( u1 -- u2 ) 16 / ;
+: tbsp>pt ( u1 -- u2 ) 32 / ;
+: tbsp>qt ( u1 -- u2 ) 64 / ;
+: tbsp>l ( u1 -- u2 ) 47317723 3200000000 */ ;
+: tbsp>gal ( u1 -- u2 ) 256 / ;
+
+: floz>ml ( u1 -- u2 ) 47317723 1600000 */ ;
+: floz>tsp ( u1 -- u2 ) 6 * ;
+: floz>tbsp ( u1 -- u2 ) 2 * ;
+: floz>cup ( u1 -- u2 ) 8 / ;
+: floz>pt ( u1 -- u2 ) 16 / ;
+: floz>qt ( u1 -- u2 ) 32 / ;
+: floz>l ( u1 -- u2 ) 47317723 1600000000 */ ;
+: floz>gal ( u1 -- u2 ) 128 / ;
+
+: cup>ml ( u1 -- u2 ) 47317723 200000 */ ;
+: cup>tsp ( u1 -- u2 ) 48 * ;
+: cup>tbsp ( u1 -- u2 ) 16 * ;
+: cup>floz ( u1 -- u2 ) 8 * ;
+: cup>pt ( u1 -- u2 ) 2 / ;
+: cup>qt ( u1 -- u2 ) 4 / ;
+: cup>l ( u1 -- u2 ) 47317723 200000000 */ ;
+: cup>gal ( u1 -- u2 ) 16 / ;
+
+: pt>ml ( u1 -- u2 ) 47317723 100000 */ ;
+: pt>tsp ( u1 -- u2 ) 96 * ;
+: pt>tbsp ( u1 -- u2 ) 32 * ;
+: pt>floz ( u1 -- u2 ) 16 * ;
+: pt>cup ( u1 -- u2 ) 2 * ;
+: pt>qt ( u1 -- u2 ) 2 / ;
+: pt>l ( u1 -- u2 ) 47317723 100000000 */ ;
+: pt>gal ( u1 -- u2 ) 8 / ;
+
+: qt>ml ( u1 -- u2 ) 47317723 50000 */ ;
+: qt>tsp ( u1 -- u2 ) 192 * ;
+: qt>tbsp ( u1 -- u2 ) 64 * ;
+: qt>floz ( u1 -- u2 ) 32 * ;
+: qt>cup ( u1 -- u2 ) 4 * ;
+: qt>pt ( u1 -- u2 ) 2 * ;
+: qt>l ( u1 -- u2 ) 47317723 50000000 */ ;
+: qt>gal ( u1 -- u2 ) 4 / ;
+
+: l>ml ( u1 -- u2 ) 1000 * ;
+: l>tsp ( u1 -- u2 ) 9600000000 47317723 */ ;
+: l>tbsp ( u1 -- u2 ) 3200000000 47317723 */ ;
+: l>floz ( u1 -- u2 ) 1600000000 47317723 */ ;
+: l>cup ( u1 -- u2 ) 200000000 47317723 */ ;
+: l>pt ( u1 -- u2 ) 100000000 47317723 */ ;
+: l>qt ( u1 -- u2 ) 50000000 47317723 */ ;
+: l>gal ( u1 -- u2 ) 12500000 47317723 */ ;
+
+: gal>ml ( u1 -- u2 ) 47317723 12500 */ ;
+: gal>tsp ( u1 -- u2 ) 768 * ;
+: gal>tbsp ( u1 -- u2 ) 256 * ;
+: gal>floz ( u1 -- u2 ) 128 * ;
+: gal>cup ( u1 -- u2 ) 16 * ;
+: gal>pt ( u1 -- u2 ) 8 * ;
+: gal>qt ( u1 -- u2 ) 4 * ;
+: gal>l ( u1 -- u2 ) 47317723 12500000 */ ;
+
+\ PRICE
+\  For precious metal price comparisons
+\  DO usd per troy oz., YG jpy per g
+\  (2nd argument is JPY per 1000 USD)
+
+: do>yg ( u1 u2 -- u3 ) 10000 * 311034768 */ ;
+: yg>do ( u1 u2 -- u3 ) 311034768 swap 10000 * */ ;
+
+cr ." Type 'help-yuko' for help" 
diff --git a/yukoa.fs b/yukoa.fs
new file mode 100755
index 0000000..7c87a8e
--- /dev/null
+++ b/yukoa.fs
@@ -0,0 +1,142 @@
+\ yukoa.fs -- Alternate words for YUKO
+\ +JMJ 2016 David Meyer 
+
+cr ." Alternate YUKO words: A2B is equivalent to A>B" 
+: ft2in ft>in ;
+: ft2km ft>km ;
+: ft2m ft>m ;
+: ft2mi ft>mi ;
+: ft2mm ft>mm ;
+: in2ft in>ft ;
+: in2km in>km ;
+: in2m in>m ;
+: in2mi in>mi ;
+: in2mm in>mm ;
+: km2ft km>ft ;
+: km2in km>in ;
+: km2m km>m ;
+: km2mi km>mi ;
+: km2mm km>mm ;
+: m2ft m>ft ;
+: m2in m>in ;
+: m2km m>km ;
+: m2mi m>mi ;
+: m2mm m>mm ;
+: mi2ft mi>ft ;
+: mi2in mi>in ;
+: mi2km mi>km ;
+: mi2m mi>m ;
+: mi2mm mi>mm ;
+: mm2ft mm>ft ;
+: mm2in mm>in ;
+: mm2km mm>km ;
+: mm2m mm>m ;
+: mm2mi mm>mi ;
+: kg2lb kg>lb ;
+: kg2g kg>g ;
+: lb2oz lb>oz ;
+: kg2oz kg>oz ;
+: g2oz g>oz ;
+: lb2g lb>g ;
+: lb2kg lb>kg ;
+: g2kg g>kg ;
+: oz2lb oz>lb ;
+: oz2kg oz>kg ;
+: oz2g oz>g ;
+: g2lb g>lb ;
+: g2ozt g>ozt ;
+: ozt2g ozt>g ;
+: c2f c>f ;
+: f2c f>c ;
+: s2min s>min ;
+: s2hr s>hr ;
+: s2day s>day ;
+: min2hr min>hr ;
+: min2day min>day ;
+: min2yr min>yr ;
+: hr2day hr>day ;
+: hr2yr hr>yr ;
+: day2yr day>yr ;
+: min2s min>s ;
+: hr2s hr>s ;
+: day2s day>s ;
+: hr2min hr>min ;
+: day2min day>min ;
+: yr2min yr>min ;
+: day2hr day>hr ;
+: yr2hr yr>hr ;
+: yr2day yr>day ;
+: ml2tsp ml>tsp ;
+: ml2tbsp ml>tbsp ;
+: ml2floz ml>floz ;
+: ml2cup ml>cup ;
+: ml2pt ml>pt ;
+: ml2qt ml>qt ;
+: ml2l ml>l ;
+: ml2gal ml>gal ;
+: tsp2ml tsp>ml ;
+: tsp2tbsp tsp>tbsp ;
+: tsp2floz tsp>floz ;
+: tsp2cup tsp>cup ;
+: tsp2pt tsp>pt ;
+: tsp2qt tsp>qt ;
+: tsp2l tsp>l ;
+: tsp2gal tsp>gal ;
+: tbsp2ml tbsp>ml ;
+: tbsp2tsp tbsp>tsp ;
+: tbsp2floz tbsp>floz ;
+: tbsp2cup tbsp>cup ;
+: tbsp2pt tbsp>pt ;
+: tbsp2qt tbsp>qt ;
+: tbsp2l tbsp>l ;
+: tbsp2gal tbsp>gal ;
+: floz2ml floz>ml ;
+: floz2tsp floz>tsp ;
+: floz2tbsp floz>tbsp ;
+: floz2cup floz>cup ;
+: floz2pt floz>pt ;
+: floz2qt floz>qt ;
+: floz2l floz>l ;
+: floz2gal floz>gal ;
+: cup2ml cup>ml ;
+: cup2tsp cup>tsp ;
+: cup2tbsp cup>tbsp ;
+: cup2floz cup>floz ;
+: cup2pt cup>pt ;
+: cup2qt cup>qt ;
+: cup2l cup>l ;
+: cup2gal cup>gal ;
+: pt2ml pt>ml ;
+: pt2tsp pt>tsp ;
+: pt2tbsp pt>tbsp ;
+: pt2floz pt>floz ;
+: pt2cup pt>cup ;
+: pt2qt pt>qt ;
+: pt2l pt>l ;
+: pt2gal pt>gal ;
+: qt2ml qt>ml ;
+: qt2tsp qt>tsp ;
+: qt2tbsp qt>tbsp ;
+: qt2floz qt>floz ;
+: qt2cup qt>cup ;
+: qt2pt qt>pt ;
+: qt2l qt>l ;
+: qt2gal qt>gal ;
+: l2ml l>ml ;
+: l2tsp l>tsp ;
+: l2tbsp l>tbsp ;
+: l2floz l>floz ;
+: l2cup l>cup ;
+: l2pt l>pt ;
+: l2qt l>qt ;
+: l2gal l>gal ;
+: gal2ml gal>ml ;
+: gal2tsp gal>tsp ;
+: gal2tbsp gal>tbsp ;
+: gal2floz gal>floz ;
+: gal2cup gal>cup ;
+: gal2pt gal>pt ;
+: gal2qt gal>qt ;
+: gal2l gal>l ;
+: do2yg do>yg ;
+: yg2do yg>do ;