Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/tingle.fai
There are no other files named tingle.fai in the archive.
Title Tingle Gonzoid Intelligence in the Pornography Domain.
;First file of Tingle--see LEXICON for grammar & vocabulary.
;Copyright (C) 1976,1977,1978,1979,1980 by BruzeMcLaren of the
; Computer Science Department at Carnegie-Mellon University.
?V.Tingle__12 ;Major version
?V.Edit__67 ;Edit number
Comment ` Edit History:
Edit Who When What
----- --- --------- ---------------------------------------
12.67 BZM 23 Mar 79 Punt BACKUP at Stanford since it hangs
at LOGIN. Also punt LOGOUT check.
12.66 BZM 17 Mar 79 Add COMPRESS macro for tighter lexicon.
Change {} to <> in LEXICON.
12.65 BZM 7 Mar 79 Reformat slightly. Change names of
some LEXICON macros. More preparation
for Mesa version--decoupling LEXICON.
12.64 BZM 3 Mar 79 Rename files to TINGLE and LEXICON;
move LEXICON macros into TINGLE;
reformat LEXICON for MESA version.
12.63 BZM 2 Mar 79 Make CMU code alias us to FINGER when
not logged in--for TINGLE server.
11.62 BZM 8 Mar 78 Correct DOC and Tenex terminal params.
11.61 BZM 24 Feb 78 Add Version switch and global V.Tingle.
11.60 BZM 22 Feb 78 Fix BACKUP, GETCHR for Stanford, again!
11.57 BZM 5 Feb 78 Change INITRAND to use only the
DATETIME macro, flushing UPTIME.
11.56 BZM 5 Feb 78 Change INITRAND to use old, last value
of RAND if available for speed.
11.55 BZM 4 Feb 78 Make PROCEDURE routine handle <=0 args.
11.54 BZM 25 Jan 78 Give error messages if the assembly
parameters (machine type) are bogus.
11.53 BZM 24 Jan 78 Fix matching <> conditional bug.
11.52 BZM 5 Dec 77 Change CHKCMU to LOGOUT on RUN error.
11.51 BZM 4 Dec 77 Change GETSTINGS to know VT,FF,^Z,BEL.
11.50 BZM 21 Nov 77 Add EXTERNAL PROCEDURE capability.
10.4n BZM 20 Nov 77 Add ITS switch and clean up switches.
10.44 BZM 29 Sep 77 Change BACKUP for Stanford's RESCAN.
10.43 BZM&CFE 14 Sep 77 Fix LOGOUT code to check more than
just logged in as [2,5].
10.42 BZM&PLL 14 Sep 77 Fix BACKUP to handle SYSTAT WHO right.
10.41 BZM 2 Jul 77 Print <crlf><dot> on LOGOUT.
10.40 BZM&BKR 10 May 77 Do a LOGOUT for WHO if not logged in.
7.3n BZM 29 Mar 77 Changes for Tenex (not quite Twenex).
7.2n BZM 23 Mar 77 Internal additions for Twenex (TOPS20):
do JSYSs and macroize dependent code.
6.20 BZM 19 Mar 77 Move DEBUGing routines' data to
writeable segment so DDT works.
6.17 BZM 19 Mar 77 Documentation & other cosmetic changes.
5.16 BZM 1 Mar 77 Insert PORTALs so we can run in
CONCEALED mode on KL's--execute only.
5.15 BZM 21 Feb 77 Change ST to use a specific template.
5.1n BZM&PLK 18 Feb 77 FAILize for better macro control.
4.10 BZM 1 Feb 77 Change PRINT to handle line hypenation.
4.7 BZM 24 Jan 77 Changes to random number initializer.
3.6 BZM 3 Dec 76 Fix RANDOM to assure RAND>0.
3.5 BZM 10 Nov 76 Recoding of the printing routines
to reduce UUO overhead (see PRINT).
2.4 BZM 25 Oct 76 Addition of the CCL RUN code: CHKCMU.
1.0 BZM 13 Oct 76 Creation of Tingle from PORN.
---- --- --------- -------------------------------------`
define subtitle (text) <subtl(\v.tingle,\v.edit,{text})>
define subtl | (a,b,c) <subttl V|a|.|b|: c>
xall ;do not list macro expansions.
nolit ;or in-line literals.
Subtitle Definitions--making things easy, modulo FAIL.
Comment `
OPERATION
To use this program on DEC-flavored systems simply type ".RUN TINGLE"
and you will get a "tingling" sentence. Similary, use "@TINGLE" on
Tenex and Twenex, and ":TINGLE" on ITS. To get N screenfulls of
sentences type ".RUN TINGLE;;;...;", where there are N semicolons on
the command line. Use "@TINGLE!!!...!" on Twenex; the ";!" feature
does not work under Tenex. Further information on Tingle's use at
CMU can be found in TINGLE.HLP[C410BN30]@CMUA. Also note that Tingle
is readily available as a procedure easily called from a high-level
language (see below). Some Arpanet hosts also have Tingle Servers.
MOTIVATION
The sole function of this code is to produce the most humorous
pornographic sentences possible. It's purpose includes a bit more,
however, as I want to demonstrate an instantiation of the often-made
claim:
"With the right data structures,
the algorithm is truly trivial."
Thus it is that the SENTENCE algorithm in this program--the routine
which actually manipulates the grammar and vocabulary data
structures--has a twelve instruction loop with four additional
initialization and clean-up instructions. Trivial.
The organization needed to accomplish this requires that the tables
SENTENCE manipulates be constructed to achieve tight packing while
retaining very fast access properties with -10 instructions. I feel
an excellent trade-off has been obtained, although this program is
certainly UUO-bound, ie, spends most of its time typing out
characters.
DOCUMENTATION
Since I have substituted this "language generation" problem for one
of the standard problems in the CMU CS Immigration Course, I've
undertaken to make my solution as robust and well-documented as
possible. Thus while some may contend that this program is much too
verbose for what it does, I repudiate such assertions and instead
claim that all reasonable programs should be documented at least this
well. Although twice as much "programming" effort may be (indeed,
has been) required to transform a working program into a reasonable
one, it is clear that documentation, when treated as an intellectual
exercise rather than as a pedantic chore, results in both cleaner
code by the author and more readily understood, maintained, and
modified code by other readers. Challengers please step forward.
HISTORY
Tingle's origin is at best apocryphal. Several long-time Playboy
readers (heaven help them) have reported reading a 1972-vintage
feature in which soft-core pornographic sentences were constructed by
filling in the blanks of a supplied "sentence" with words from the
article's vocabulary. These reports are reinforced by the fact that
some of PORN's (see below) most baroque phrases are remembered to
have appeared in the Playboy article.
Whatever the origin of the concept, one of its first machine
instantiations was as PORN, a crufty, time- and space-wasteful
program authored by someone at an unknown Tenex site. Although
limited to one sexist sentence type (template), a very soft-core
vocabulary, and having a markedly non-random pseudo-random number
generator, it was still capable of printing an occassional worthwhile
sentence. Thus REG@SAIL lifted it from its Tenex home and put it up
at the Lab as PRN during April, 1973.
Impressed with its potential but unsatisfied with its output,
BZM@CMUA essentially rewrote the entire program, retaining only the
vocabulary and single template from PORN. Data structures were
linearized and compressed by a factor of six over the unnecessarily
wordy, linked PORN versions, and macros were written to do the table
construction easily so that target language enhancement would be as
simple as possible. Debugging routines were inserted, and
conditional code was installed so that Tingle could be run as a part
of a login routine (as at SAIL), modulo DEC's bogus way of handling
this situation. In spite of all this, however, credit for the basic
scheme still belongs with the anonyomous soft-core Tenex hacker.
In the several years since this transformation Tingle--with the
continual assistance of its expanding user community--has grown
fairly steadily, the vocabulary by a factor of three and the
templates by a factor of two.
COMPREHENSION
The way to understand this program is by:
[1] Scanning enough output to discover what's going on;
[2] Looking at [2a] the macro calls and [2b] the macro
definitions in the LEXICON file of this program;
[3] Reading [3a] the SENTENCE routine and its subroutines,
and then [3b] the driver code.
[4] Scanning the DEBUG routines to see what they help you do.
TYPOGRAPHY
Potential manglers of this code--those unacquainted with lower case
devices--are hereinafter informed that the text of this program has
been CAREFULLY composed (mod upper case OPCODE AC,E devotees) with a
FULL (albeit ASCII, not Stanford) character set.
CREATION
Tingle is written in FAIL because it is superior in features
(particularly macro scanning), but also because it runs AT LEAST FIVE
TIMES FASTER than MACRO.
To create a reentrant production version of TINGLE type (using
DEC-flavored command language):
.LOAD/FAIL TINGLE ;include /list, /cref as you will.
sw1__1 ;type in any assembly switches you want when
sw2__1 ;prompted and "TTY:" is typed out.
^Z
.SSAVE TINGLE ;or NSSAVE
For a Debugging load type
.DEBUG/FAIL TINGLE
DEBUG__1 ;type this in when prompted.
^Z
By far the easiest way to install Tingle at a strange PDP10 site is
with a .REL file generated by FAIL on a friendly machine (with the
correct switch settings), and then LOADed and SAVED on the alien one.
For Stanford, Tenex, and Twenex sites, it is best to tell LINK to
load code into contiguous pages starting at 0. To do this use the
/SET:.HIGH.:1000,TINGLE/SSAVE switches, which starts loading code
into the second page (the amount of writeable data is only 100 words
or so). The SSAVE prevents LINK from getting a REMAP error.
CMU CCL LINKAGE
If the CMU switch is on during assembly, then the Tingle produced
will try to do a RUN on the program specified in TMPCOR:TIN when it
exits after being called at CCL entry. (Note that NO disk file is
EVER looked for, even if TMPCOR is full.) This allows a user's
program to "call" Tingle and then run another program, eg, get
returned to in a subroutine-like fashion (with no context saved). If
the TMPCOR file is not found or errors occur, Tingle just EXITs.
The format of the four word TMPCOR file TIN is:
<starting offset of program to run>,,1;offset usually 0 or 1.
SIXBIT .DEVICE. ;generally SYS or DSK.
SIXBIT .PROGRM. ;name of the program to run.
<octal PPN> ;0 unless PROGRM is in an alien UFD.
If the CMU, DEC, or STANFORD switches are on, Tingle does a LOGOUT if
the job is not logged in. This can happen via certain programs.
EXTERNAL PROCEDURE LINKAGE
If the PROCEDURE switch is on during assembly, then the Tingle
produced will not be a program, but rather a routine callable from
another program (eg, directly from ones written in SAIL or FAIL, and
through a trivial interface from ones written in BLISS, LISP, ALGOL,
...). See the PROCEDURE.DRIVER section for full details.
`
;Ac assignments
Define AC (reg) {?reg_regCount
regCount__regCount+1
IFG regCount-20 <.FATAL> }
regCount__0
AC CCLFLG ;use non-indexing ac for remembering ccl entry
AC AC1 ;Tenex JSYS ACs--MUST BE THESE!!!
AC AC2 ;..
AC AC3 ;..
AC AC4 ;..
AC LINEBP ;output LINE byte pointer
AC CNT ;output line character count
AC RAND ;random number register
AC STINGS ;number of sentences to type out
AC SD ;sentence descriptor
AC LD ;lexicon descriptor
AC A ;Working ACs--not guaranteed preserved.
AC B ;A+1 ;..
AC C ;B+1 ;..
?S_17 ;STACK pointer IS FIXED!
;Mumbles
define MUMBLE {Comment `} ;for long comments.
opdef PJRST [jrst] ;replace pushj, popj sequences with pjrst
define DECLARE {reloc} ;switch to private data area for variables.
define ERALCED {reloc} ;back to sharable code area.
define SETSTACK {move s,[iowd stklen,stack]} ;stack initialization
?CR__15 ;character definitions.
?LF__12
?ALT__33
?BELL__7
?FF__14
?VT__13
?EOF__32
;Make a two segment program which gets loaded apropriately.
twoseg ;Both low and high.
reloc 0 ;Data in low segment.
reloc 400000 ;Code in high segment.
;Switch and parameter macros
define PARAM (par,value) {?par__<=value>} ;init parameters, make available.
define DEFAULT (place,par,value) {
if.on place { ;process defaults only for given site.
IFLE par, {par__<=value>} ;dont use default if value already given.
end.if pplace } }
define SWITCH (sw) {?sw__0} ;init switches to off and make available.
define IF.ON {ifn } ;make conditional assembly clear
define IF.OFF {ife } ;by using these unconfusing names.
define END.IF {;} ;..
;Assembly parameters
PARAM CharsPerLine,0 ;Chars in tty line minus length of longest vocab. word.
PARAM LinesPerPage,0 ;Number of sentences which will fit on tty screen.
PARAM StatBlks,1 ;Number of disk blocks to use in statistics-keeping.
PARAM HistLen,100 ;Length of the HISTogram buffer in routine RT.
PARAM StkLen,20 ;Maximum depth of the stack.
PARAM DataPages,1 ;Number of 1000 word pages of writeable data.
;Assembly switches
SWITCH Debug ;set nonzero to get the debug code--routines CT,RT,PT,ST.
SWITCH Procedure ;set nonzero to get Tingle routine .REL file.
SWITCH Statistics ;set nonzero to get who-ran-Tingle statistics code.
SWITCH XListLexicon ;set nonzero to kill listing of LEXICON file.
SWITCH Version ;set nonzero to output version in .JBVER.
SWITCH NoLexCompression ;set nonzero to suppress lexicon packing.
SWITCH DEC ;set nonzero to vanilla DECsystem10 version.
SWITCH CMU ;set nonzero to get CMU stuff--mainly for logging in.
SWITCH ITS ;set nonzero to get ITS (MIT) version.
SWITCH TENEX ;set nonzero to get Tenex version.
SWITCH TWENEX ;set nonzero to get Twenex (TOPS-20) version.
SWITCH STANFORD,;set nonzero to get Stanford version (like PRN).
;Now get the user switch settings directly from TTY:
prints `
Please indicate a desired machine environment (CMU, ITS,
STANFORD, DEC, TWENEX, TENEX) and/or include any assembly options you
want (Debug, Procedure, Statistics, XListLexicon, NoLexCompression)
by typing name_1<cr> for each one. You can also change any assembly
parameters you need to (CharsPerLine, LinesPerPage, StkLen, HistLen,
StatBlks) by typing paramname_=decimal#<cr>. When finished, type ^Z.
`
.INSERT TTY:
MUMBLE Here is the TTY-parameter stuff. This could almost be done
on a per-terminal rather than per-site basis by using the appropriate
UUOs to get the width and length, but it doesn't seem worth it right
now. Both of the variables defined here are used later to define
three new ones, LINELEN, PERPAGE, and BUFLEN which are actually used
in the code. They represent the effective line length, number of
sentences per page, and words for the line buffer, respectively.
`
NumMachines__DEC + CMU + ITS + Tenex + Twenex + Stanford
IFN NumMachines-1 < prints `
You have either specified NO machine environment or MORE THAN
ONE machine environment. Type ^C^C and try again, setting exactly
ONE of the parameters to 1.
`
.FATAL ;Stop--incorrect environment requested. >
; Turn off lexicon compression since Fail requires more than 512P of memory to do this...
NoLexCompression__1
; Allow random CMU display.
default CMU,CharsPerLine,80
default CMU,LinesPerPage,24
default CMU,Version,1
; Know about typical ITS display.
default ITS,CharsPerLine,80
default ITS,LinesPerPage,25
default ITS,Version,0
; Assume DD as regular SAIL display.
default STANFORD,CharsPerLine,84
default STANFORD,LinesPerPage,30
default STANFORD,Version,1
; Allow for most losing terminal in most general case.
default DEC,CharsPerLine,80
default DEC,LinesPerPage,24
default DEC,Version,1
; Let regular Twenex be the CMU TWENEX's with VT05.
default TWENEX,CharsPerLine,80
default TWENEX,LinesPerPage,25
default TWENEX,Version,1
; Let regular Tenex be PARC Alto screen.
default TENEX,CharsPerLine,90
default TENEX,LinesPerPage,40
default TENEX,Version,1
Subtitle Machine Environment Definitions--put all dependencies in these macros.
if.on DEC!CMU!STANFORD < ;For TOPS-like systems (hence Stanford), use these UUOs:
opdef RESET [reset] ;start job.
opdef STOP [exit 1,] ;stop job.
if.off STANFORD < ;for standard TOPS do this:
define BACKUP { ;Backup TTY buffer pointer to reread a cmd.
rescan ;try to rescan, but don not barf if cant.
ttcall 14, ;skpinl ;if anything was there or was RESCANed, skip.
popj s, ; otherwise, punt now.
}
define GETCHR (adr) { ;read the next tty char into ADR.
inchwl adr ;do it--wait if necessary.
}
define DATETIME { ;get full word of date/time in AC1.
move ac1,[53,,11] ;get universal date/time
gettab ac1, ;.. (should work in DEC monitors).
timer ac1, ; use this if it fails for some reason.
} ;end DATETIME
end.if STANFORD >
if.on STANFORD <
define BACKUP { ;Backup TTY buffer pointer to reread a cmd
popj s, ;Do nothing for now--act like none.
;;;rescan ac1 ;backup and get # of chars in ac1
;;;jumple ac1,cpopj ;return if there were none
}
define GETCHR (adr) { ;Stanford RESCAN funny,
inchrs adr ; so never wait.
skipa c,[lf] ; pretend we read a LF.
caia ;got something, use it!
movem c,adr ; ..
}
define DATETIME { ;get full word of date/time in AC1.
calli ac1,400101 ;ACCTIM UUO.
} ;end DATETIME.
end.if STANFORD >
define PUTSTRING (adr) { ;send asciz string at ADR to tty.
outstr adr
}
define UPTIME { ;return system uptime in AC1.
move ac1,[5,,56]
gettab ac1, ;go for it.
timer ac1, ; no dice--substitute this.
}
end.if DEC!CMU!STANFORD >
if.on TWENEX!TENEX < ;For Tenex or TWENEX systems, use these JSYSs:
opdef JSYS [104B8] ;"unimplemented" instruction.
opdef ERJMP [jump 16,] ;for jsys error returns.
opdef RESET [jsys 147] ;Tenex reset.
opdef STOP [jsys 170] ;continuably stop a job with HALTF.
define GETCHR (adr) { ;read a char into ADR.
jsys 73 ;read a byte with PBIN.
movem ac1,adr ;put it where requested.
}
define PUTSTRING (adr) { ;send asciz string at ADR to tty.
hrroi ac1,adr ;use ac1 for string adr, as
jsys 76 ;required by PSOUT.
erjmp .+1 ; should have no problems.
}
define DATETIME {jsys 227} ;get full word day,,time from GTAD in AC1.
define UPTIME {jsys 14} ;get system uptime from TIME in AC1.
end.if TWENEX!TENEX >
if.on TWENEX < ;Use this code for TWENEX only:
define BACKUP { ;reset tty buffer pointer, POPJ if can't.
setzi ac1, ;set RESCAN arg to do last cmd.
jsys 500 ;rescan the last command with RSCAN.
erjmp .+2 ; just try to read on buffer ovf.
jumpe ac1,cpopj ;if no chrs to read, don't.
}
end.if TWENEX >
if.on TENEX < ;Use this code on Tenex only:
define BACKUP {
popj s, ;Punt--not possible with Tenex!!!
}
end.if TENEX >
if.on ITS < ;Use this code for the MIT systems:
opdef RESET [] ;start job.
opdef STOP [] ;stop job.
define BACKUP { ;Backup TTY buffer pointer to reread a cmd.
}
define GETCHR (adr) { ;read the next tty char into ADR.
}
define PUTSTRING (adr) { ;send asciz string at ADR to tty.
}
define DATETIME { ;get full word of date/time in AC1.
}
define UPTIME { ;return system uptime in AC1.
}
end.if ITS }
Subtitle Drivers--program and procedure flavors.
if.off PROCEDURE < begin PROGRAM.DRIVER
MUMBLE This is the program-driving routine. It figures out how many
tingles to send by scanning the input line, sends them, and then quits
back to the exec or perhaps to another program, if requested by CCL.
`
^TINGLE:portal cmd ;PORTAL for KI/KL concealed entry--execute only.
portal ccl ;PORTAL on CCL too.
cmd: reset ;reset everything on normal entry.
restart:tdza cclflg,cclflg ;mark us as non-ccl.
ccl: setoi cclflg, ;do no RESET and remember CCL entry.
setstack ;init the PDL
if.on CMU <
pushj s,loggedin ;Are we running logged in?
skipa a,['FINGER'] ; No, hide our real name.
jrst .+2 ;Yes, don't do anything--TINGLE is OK.
setnam a, ; Change us to impersonate FINGER.
end.if CMU >
if.on STANFORD <
move a,['LOGIN '] ;Hide our real name from Stanford users who
setnam a, ;get this program as a regular login option.
end.if STANFORD >
pushj s,getstings ;go get number of !;s on command line in STINGS.
pushj s,initrand ;set up RAND
pushj s,initline ;set up tty and output buffer
pushj s,sentence ;send tingler
sojg stings,.-1 ;always send at least 1 sentence
if.on CMU!DEC < ;at these sites do RUN or LOGOUT if necessary.
pushj s,chkrun ;handle CCL RUN if requested.
pushj s,loggedin ;check if logged in.
jrst [ putstring([asciz '.'])
logout ]
end.if CMU!DEC >
stop ;do a fast exit
portal restart ;and restart if user .continues
declare ;put stack with driver.
^stack: block stklen ;the only local data to this routine.
eralced
MUMBLE This routine tries to rescan the command line which may have
invoked us. If it can, it counts the number of !s and ;s seen on it
and returns this number times PERPAGE. Thus the number of comment
delimeters on the command line is the number of screenfuls of
Tinglers that will be typed out. Reading stops when either a
Linefeed, Altmode, or other standard terminator has been seen. On
some machines, BACKUP may not be possible and the macro may just punt
instead of do tty reading.
The call is
;do NOTHING to the TTY input buffer.
pushj s,getstings
;return with STINGS=PERPAGE*(# of ;! found),
;and TTY ready to read the next line.
`
GETSTINGS:
movni stings,perpage ;initialize counter lessthan 0.
jumpn cclflg,cpopj ;if we are CCL, do no tty reading, otherwise
backup ;try to backup the tty to read a command
;line, but POPJ in BACKUP if we cannot.
addi stings,perpage ;add in another pagefull of sentences.
read: getchr c ;read a chr from cmd line we found.
caie c,";" ;is it a semicolon?
cain c,"!" ; or bang?
jrst read-1 ; yes--bump counter.
caie c,lf ;did we read a linefeed?
cain c,alt ; or an altmode?
popj s, ; yes--end of line--return.
caie c,ff ;formfeed?
cain c,vt ; or vertical tab?
popj s, ; yep. stop reading.
caie c,eof ;control Z?
cain c,bell ; or control G?
popj s, ; yep. stop again.
jrst read ; nope, get another chr.
if.on CMU!DEC!Stanford < ;Use this code at DEC-flavors only.
MUMBLE This stuff does the CCL RUN described in the introduction.
`
CHKRUN: jumpe cclflg,cpopj ;if not ccl then never try a RUN.
move 7,[2,,['TIN',,0 ;read a 4 word tmpcor file containing RUN args:
iowd 4,0]] ; offset,,1; DEV; FILE; PPN; in internal form.
tmpcor 7, ;read into acs 0-3--sets up ac0 for the RUN.
pjrst cpopj ;if no TMPCOR file, treat as normal Tingle.
move 5,3 ;got it, move PPN to 5th arg position for RUN
setzb 3,6 ;clear the EXT and CORE arg positions of RUN.
run 0, ;try to run, DEV and FILE args already setup.
logout ;ignore errors
MUMBLE This routine SKIPs if the job is logged in.
`
LOGGEDIN:
pjob a, ;get job number
movni a,(a) ;negate
jobsts a, ;get job's status
movei a,0 ;ignore errors--assume not logged in (safe).
tlne a,(1b1) ;check and see if job is logged in.
aos (s) ;it is, give skip return to caller.
popj s, ;it's not, give normal return.
end.if CMU >
bend PROGRAM.DRIVER end.if PROCEDURE >
if.on PROCEDURE < begin PROCEDURE.DRIVER
MUMBLE This code implements Tingle as a routine. When the PROCEDURE
switch is on, the .REL file produced by FAIL contains one routine,
Tingle, which takes one parameter, the number of sentences to be
typed. If the parameter is less than zero, zero is used. The Tingle
procedure does no RESETS, STOPS, or other funny UUOs other than
TTCALLs (or their equivalents on non DEC-like systems) and DATETIME
stuff. In particular, it never tries to read from the terminal. It
saves ALL registers around its call, and uses about 10 words of AC17
as its pushdown stack.
The .REL file produced tries to load into both the high (8P) and low
(50 words) segments, so watch out if you use a language with a
runtime system. In this case, direct LINK to load all into the low
segment with the %.seg:low. switch.
Also, it is possible to get the Tingle procedure to call YOUR output
routine to handle each sentence. In this way you could redirect the
sentences anywhere you want--down a PTY, to the disk, whatever.
Basically you must redefine PUTSTRING and save ALL registers; see me
if you want to do this.
To call Tingle from a language with a different calling sequence than
SAIL, just invent an interface which puts the integer parameter on a
stack of length 10 or greater in AC17. See below for exact details.
The machine code calling sequence is:
push 17,[integer # of tinglers wanted]
pushj 17,tingle
;return with STACK CLEARED OF ARG and NO AC'S DISTURBED.
The SAIL calling sequence is:
EXTERNAL SIMPLE PROCEDURE Tingle (INTEGER numberOfSentences);
Tingle(n);
`
TINGLE^:movem 16,saveacs+16 ;save all ac's except 17.
movei 16,saveacs ;move them into the saveacs area.
blt 16,saveacs+15 ;..
pop 17,stings ;get the return address and
exch stings,(17) ; swap it with our one param on top of stack.
pushj s,initrand ;get the random #s going.
pushj s,initline ;clear off the tty.
jrst .+2 ;if stings lessthenorequal 0, do nothing.
pushj s,sentence ;send as many tinglers as asked.
sojge stings,.-1 ;..
movsi 16,saveacs ;restore registers and return.
blt 16,16 ;..
popj 17, ;..
declare ;data for the routine-version of tingle.
saveacs:block 17 ;all but the last.
eralced
bend PROCEDURE.DRIVER end.if PROCEDURE >
Subtitle Sentence Generation--interpret the slot & filler grammar.
begin SENTENCE.ROUTINES
MUMBLE The SENTENCE routine is the heart of the code. It picks up
the sentence descriptor (sd) of a template "at random" and then goes
off to print each lexicon descriptor in it, ie, for each ld, print any
preamble text specified and then print a "random" phrase from the
lexicon list itself. PRINT handles the output line-formatting, we just
supply the final "." and throw some new lines.
The call is
;clean up the tty and output buffer and initialize RAND
pushj s,sentence ;uses a-c,ld,sd
;returns with tty and output buffer at "newlines"
To generate a sentence corresponding to a particular template, rather
than a random one, use the similar call
move sd, sentence descriptor of the template you want
pushj s,phrase
`
^SENTENCE:
movei b,N.Templates ;get the number of templates
pushj s,random ;and select a sent. descr. (sd) from one of
move sd,Templates(b) ;these using the random index returned in b.
^PHRASE:move ld,(sd) ;get the first lexicon descriptor (ld) of the sd
hlrz a,ld ;and get the text to be printed before the phr
pushj s,print ;go print it
hlrz b,(ld) ;now get the # of lexicons in the lexlist
pushj s,random ;and select one of them at random.
rotc b,-1 ;see which halfword the chosen text ptr is in
addi b,(ld) ;make the lexlist-relative addr absolute
hrrz a,(b) ;assume the string pointer is in a right halfwd
tlne c,(1b0) ;true (ie, was b even??)?
hlrz a,1(b) ;no, get odd ptrs from left of next word
pushj s,print ;print the lexicon
aobjn sd,phrase ;and repeat for the next ld in this sd
pjrst period ;finish sentence and return.
if.on DEBUG < begin SENTENCE.TEST
MUMBLE The ST=sentence test routine outputs sentences directly via ddt.
The call is
;set SENTENCE to the address of the sentence you want and
;REPEAT to the number of sentences you want to make with it.
st$g ;uses most acs
;back to ddt when done
`
opdef XX [stop] ;for DDT.
ST: setstack ;get a stack
move stings,repeat ;send REPEAT sentences
pushj s,initrandom ;start the generator
pushj s,initline ;get the PRINTer ready
move sd,@sentence ;get the sd of the sentence wanted.
pushj s,phrase ;type a sentence with it.
sojg stings,.-2 ;do as many times as requested.
jrst DDT^ ;back to ddt when done
declare
sentence: Templates+N.Templates-1 ;default sentence is last one--the newest?
repeat: perpage ;default repeat count is to fill a screen
eralced
bend SENTENCE.TEST end.if DEBUG >
if.on DEBUG < begin COUNT.TEST
MUMBLE The CT=count test routine is used with ddt to find the total
number of sentences which can be generated from the given template
grammar and lexlist vocabulary. The number of sentences it counts
is returned as a floating point number. It checks for overflow.
The call is
;no args or setup
ct$g ;to ddt--uses most acs
;return to ddt with count in ac A as single precision floater.
;it will clear A to zero if overflow occurred.
`
CT: movei cnt,N.Templates-1 ;get decreasing index to templates (assume GE 0).
setz a, ;clear the count
jfcl 17,.+1 ;clear flags so we can check later
sents: move sd,Templates(cnt) ;get a sentence descriptor
movsi b,(1.0) ;and multiply together its lexlist lengths
phrases:move ld,(sd) ;get a lexicon descriptor in this sd
hlrz c,(ld) ;get the size of the ld = # of lexicons in it
fsc c,233 ;float the bear--its less than 27 bits long
fmpr b,c ;accumulate running product
aobjn sd,phrases ;get another ld in this sd if there is one
fadr a,b ;add count of this template to the others
sojge cnt,sents ;and try to do another..
jfov .+2 ;if overflow occurred we have INF sentences,
jrst DDT^ ; no overflow--go back.
setzi a, ;so flag it with zero.
jrst ddt ;now go back
bend COUNT.TEST end.if DEBUG >
bend SENTENCE.ROUTINES
Subtitle Printing--for the terminal only.
begin PRINT.CLASS
MUMBLE This routine initializes the PRINTER CLASS (cf SIMULA). It
sets up the tty on a newline and leaves the local variables used by
PRINT, ENDLINE, and PERIOD in appropriate states. See PRINT for more.
The call is
;no setup
pushj s,initline;uses acs c,cnt,linebp
;return with the PRINTer ready to go.
`
^INITLINE:
movsi c,(<byte (7) cr,lf>) ;preface the first output with CRLF.
movem c,line ;put CRLF at head of output buffer
move linebp,[point 7,line,=13] ;adjust linebp to start with 3rd chr.
setzi cnt, ;start char counting in column 0
^CPOPJ: popj s, ;return with line,linebp,cnt set up
MUMBLE PRINT is a pseudo-coroutine which formats chars on the tty.
When resumed by SENTENCE it prints the text given to it, breaking it
across lines when necessary to keep within the margin. PRINT also
fixes up some bogosities in the lexicon texts themselves which were
introduced by continuing their macro argument text across lines.
Note that the first version of this routine typed each character
individually with OUTCHR. This was very slow, however, due to the
UUO overhead involved, and since 400 milliseconds/sentence is
intolerable when one wants to generate several thousand sentences
(porn novel?), the routine was recoded to do just one UUO per line
of output. Thus PRINT and its two friends assemble characters into
the buffer LINE, which is printed every CRLF (or so).
The call is
;make sure cnt and linebp were initialized somewhere
hrrzi a,asciz ptr ;the LH of A MUST BE 0
pushj s,print ;uses c,cnt,linebp
;return, cnt and linebp are setup for nexttime.
`
^PRINT: tloa a,440700 ;make a into an ascii byte pointer
keepit: idpb c,linebp ;put the character in the output buffer
skipit: ildb c,a ;get a chr
jumpe c,cpopj ;if null then were done
caige c," " ;is it a cr, lf, tab ..?
jrst skipit ;yes, flush it--continuing a macro arg across lines.
caie c," " ;are we at a space--word break?
cain c,"-" ;or hyphen?
caige cnt,linelen ;are we also beyond the right margin?
aoja cnt,keepit ;no, print this chr, get more
cain c,"-" ;yes, are we hypenating a word?
idpb c,linebp ;yep--put out the hypen.
pushj s,endline ;no, start a new line
jrst skipit ;..
MUMBLE This routine performs newlines and sentence terminations for
the PRINT CLASS. It fills out the LINE output buffer with (perhaps)
a period, some CRLFs, and a null, and then sends the buffer to the
tty. It then reinitializes the buffer and its pointers for the next
line.
The call is
;should have called INITLINE sometime.
pushj s,period ; or
pushj s,endline ;uses acs cnt,linebp.
;returns with tty on newline and everything ready to go.
`
^PERIOD:skipa cnt,[<byte (7) lf,cr,lf,cr,".">-1] ;end sents. with . and 2 CRLF
^ENDLINE:movei cnt,<byte (7) lf,cr>-=22 ;end lines with CRLF
idpb cnt,linebp ;send low byte to buffer
lsh cnt,-7 ;and shift the next one down
jumpn cnt,.-2 ;deposit this one if not null
idpb cnt,linebp ;terminate the buffer with a null (asciz)
putstring line ;and send it out to the user.
move linebp,[point 7,line] ;get a new buffer-filling pointer
popj s, ;and return--nb, cnt is already zero.
declare ;put the line buffer here.
line: block =35 ;linelen/5+20 ;allow many extra characters.
eralced
if.on DEBUG < begin PRINT.TEST
MUMBLE The PT=print test routine checks out the PRINT routine using
ddt. As a side-effect, however, it also types out an entire lexicon
list. Thus it is very good to check out new instances of LEXLIST
calls which have been added to extend the vocabulary (and probably
indirectly the grammar, too).
The call is
;set up lexlist to have whatever lexlist you want with ddt
pt$g ;uses most acs
;return to ddt
`
pp__1 ;lexicon pointer
np__2 ;number of lexicons
PT: setstack ;get PDL
move pp,lexlist ;get the adr of a lexicon list
hrli pp,(<point =18,,=17>) ;make a halfwd byte pointer to the list
ldb np,pp ;get the number of lexicons in np
pushj s,initline ;get the TTY ready
phrase: ildb a,pp ;get a phrase text pointer
pushj s,print ;send it to tty
movei a,[asciz ` `] ;space between them so PRINT can format
pushj s,print ;..
sojg np,phrase ;send them all
pushj s,endline ;finish up and
jrst DDT^ ;go back to ddt.
declare
lexlist:q1 ;the adr of some lexlist--use quotes to start
eralced
bend PRINT.TEST end.if DEBUG >
bend PRINT.CLASS
Subtitle Random Number Generation--use a DEK technique with a REG seed.
begin RANDOM.CLASS
MUMBLE This routine initializes RAND to be some random number which
is a fn of the time, date, and other things which REG found
appropriate. It is somewhat modified--to give uniform
behavior--compared with the original routine. A copy of
RAND is kept in LASTRANDOM at all times so that we do not have
to initialize again if restarted or reinvoked.
The call is
;no args
pushj s,initrandom ;uses rand,AC1
;return, rand set up
`
^INITRANDOM:
camn rand,lastrandom ;if AC value is memory value, then
jumpn rand,cpopj ; there is no need to init again unless
; both are zero.
datetime ;get XWD date,time in AC1.
movem ac1,lastrandom ;make this the initial random value,
movms rand,lastrandom ; once it is positive.
popj s, ;hope this randomness is random enough.
MUMBLE This routine takes an integer arg .gt. 0 in b, and returns a
random integer uniform in [0,b-1] also in b. This randomizer is
specifically for -10s, taken from SYS:BLILIB.DOC@CMUA. Thms,
problems, etc., from Knuth V2, are cited in BLILIB in its support.
It uses RAND as its repeating value, but also preserves this in
memory as LASTRANDOM in case we are restarted or reinvoked.
The call is
;move b,some number .gt. 0
pushj s,random ;uses c,rand
;return with b setup, rand updated
`
^RANDOM:imul rand,five15 ;scheme is U := (5^15*U+7261067085) mod 2^35
add rand,[=7261067085] ;where U is some random integer initially.
hrloi c,377777 ;make rand positive mod 2^35, and simultaneously
andb c,rand ;copy rand into c for subrange computation.
movem rand,lastrandom ;store away the new random number.
mul b,c ;puts U[0,b) back in b--think of c as U[0,1)
popj s, ;and multiply to NOT get the even, odd, even,
;odd, ... which results from using this
;generator with a mod (idiv) technique.
five15: 5*5*5*5*5*5*5*5*5*5*5*5*5*5*5
declare
lastrandom: block 1 ;cell for keeping RAND.
eralced
if.on DEBUG < begin RANDOM.TEST
MUMBLE This routine (RT=random test) tests the two routines random
and initrandom, above. It constructs a histogram in memory and also
keeps a sum and odd/even count. It should be used with DDT, to print
the results and easily change the boxes,loops, and trials parameters.
The call is
;setup boxes,loops,trials as you wish with ddt
rt$g ;type this to ddt--rt uses most acs
;returns to ddt when done
`
even__1 ;obvious acs for RT
odd__2
lps__3
trls__4
RT: setstack ;init the stack
setzb odd,sum ;zero the counters and sum
setzb even,hist ;and the table
move a,[hist,,hist+1]
blt a,hist+histlen-1 ;zero the histogram table
move trls,trials
l.trls: sojl trls,DDT^ ;perform TRIALS trials, then back to ddt
pushj s,initrand ;for each trial get a new seed
move lps,loops
l.lps: sojl lps,l.trls ;for each trial do LOOPS loops
move b,boxes ;each of which adds to the histogram
pushj s,random ;by filling one of its boxes at random
aos hist(b) ;bump the right cell of histogram
addm b,sum ;remember total so we can find mean
trnn b,1 ;see if odd
aoja even,l.lps ;no, bump even and loop
aoja odd,l.lps ;bump odd ..
radix =10 ;data area here ...
declare
boxes: 20 ;20 cells in HIST initially--must be LT HISTLEN
loops: 200 ;each of which should get 10 points
trials: 1 ;one pass only
sum: 0 ;sum of rand #s
hist: block histlen
eralced
radix 8
bend RANDOM.TEST end.if DEBUG >
bend RANDOM.CLASS
Subtitle Working Store--lay out the global data.
MUMBLE Declare any left-over stuff here. Since we tried to confine
the data for individual routines with the routines (hiding it), there
should be very little here.
`
declare ;impure stuff
.var:
var ;just in case, put any VARs here.
eralced ;back to pure space.
.lit:
lit ;put read-only literals and code here so that they
;will be on the same memory page as the program.
if.on XListLexicon <xlist> ;kill LIST of LEXICON if not wanted.
Subtitle Lexicon Macro Definitions--making lexicon modification trivial.
begin LEXICON ;isolate most of this from TINGLE.
MUMBLE The next three macros build tables of halfwords in a nice way.
The calls
beghalfwd
halfwd x1
halfwd x2 x1,,x2
. will generate .
. .
. .
halfwd xn xn-1,,xn or xn,,0
endhalfwd
where the last word is determined by n being even or odd.
`
define BEGHALFWD { ;initialize halfword macro
.left__1 } ;set flag to "filling the left halfword"
define ENDHALFWD { ;finish up halfword macro
ife .left, <xwd .save,0> } ;remember to output last halfwd if n odd
define HALFWD(arg) {
.left1__.left ;remember our current state (left or right)
ifn .left1, < ;fill left half.
define .save {arg} ;save argument as .save macro text for next call.
.left__0 > ;keep lh until we know the rh
ife .left1, < ;fill right half.
xwd .save,arg ;got rh, assemble full word now.
.left__1 >
} ;end halfwd
define TextHalfWd (text) { HalfWd(< [ASCIZ `text`] >) }
MUMBLE COMPRESS and USECOMPRESSION compress the TABs and CRLFs out
of lexicon entries. The human-oriented format of the LEXICON file
leaves extra TABs and CRLFs in the text, and does not require extra
<>s, in the arguments to SENTENCE and LEXLIST. This pair of macros
is used to eliminate the nice, but unwanted, format characters. This
compression is not done for correctness or speed because the PRINT
routine already handles it. Rather it is done to reduce the run-time
storage needed by LEXICON. With many lexemes having 3-4 or 8-9
characters, flushing CRLFs alone prevents the extra ASCIZ word from
being generated needlessly.
These macros ARE HAIRY. Compress handles the NoLexCompression case
by punting space for time if requested. Otherwise it cycles through
each CHR in the LEX. If the CHR is good--ie, if it is not .LE.
SPACE, (not CRLF, TAB, etc.)--it appends the CHR onto the end of the
new, compressed lex, CompLex. This append is handled by redefining
the CompLex macro in ADDCHR. The dummy 0 arg is needed so we can
FORCE evaluation at the right times with "\". GetCompression returns
the compressed lexeme in an ASCIZ statement, ie, ASCIZ .lexeme. It
uses .GetComp to handle this.
`
define Compress (lex) {
;;; begin LEXCOMP ;BEND is in UseCompression
if.on NoLexCompression <define CompLex {0,<lex>}>
if.off NoLexCompression <
define CompLex {0,<>}
for chr E {lex} {
IFGE "chr"-" " < .AddChr(\CompLex,<chr>) > }
end.if NoLexCompression >
} ;end Compress
define .AddChr | (zero, oldText, newChr) { define CompLex {0,<oldText|newChr>} }
define UseCompression (macroName) { .UseComp(\CompLex,macroName)
}
;;; bend LEXCOMP ;BEGIN is in Compression
define .UseComp (zero, compText, name) { name(<compText>) }
MUMBLE LEXLIST constructs lexicon lists by using the halfwd macros.
The call
lexlist <argument1,argument2,...,argumentn> ;can be on multiple lines
generates the equivalent of
byte(18) n,lex1,lex2,...,lexn
where n is the number of lexicons in the arg list, and each lexi
is a pointer to an asciz string containing the TEXT of the argumenti.
Note that the CRLFs and TABs--but not ANY SPACES--included in the
argments are flushed by the PRINT routine. This allows lexicons to be
split between lines with no trouble. If you must use commas in a
lexicon, surround it with {} (see label Q1). A lexicon can contain any
character, but if FAIL thinks it's special then be sure to use {} or
<> to enclose the lexicon (thus {} and <> are valid too as long as you
don't use both at once). Be sure to put the commas terminating
bracketed arguments IMMEDIATELY adjacent to the braces, ie,
",{arg},", or problems can result with the expansion. Do not give a
null argument list to lexlist.
`
;Zero this counter which will be bumped in the macro.
;It is used much later, too.
?N.lexicons__0 ;Number of lexicons (maybe just words).
define LEXLIST (lexes) {
BEGIN LXLIST
.count__0 ;number of lexicons
beghalfwd ;init macro
halfwd(.length) ;put in count at first
for lexx in (lexes)
{.count__.count+1
Compress(<lexx>)
UseCompression(TextHalfWd)
} ;put text pointers into successive halfwords
endhalfwd ;grab last halfword if in lh
.length__.count ;put in the count now that we know it
^N.lexicons__N.lexicons+.count ;increase number of lexicons counter.
BEND LXLIST
} ;end of lexlist
MUMBLE SENTENCE makes template construction easy. It generates two
flavors of descriptors which are pointers to the encoding of the
template used the the SENTENCE routine. These pointers are called
sentence descriptors (sds), and lexicon descriptors (lds). The sd is
an AOBJN word to the lds, which are a list of <text>,,<ptr to
lexiconlists> . The sd is generated in-line, and is one of the
N.Templates templates available to the program. The lds are generated
as literals. A call like
SENTENCE<The ,adj, ,noun1, is on the ,noun2> ;3 pairs text,phrlist of args
will generate
-3,,adr ;the sd--an aobjn ptr to the list of ld text,,phrlst pairs
inline and
adr: [asciz 'The '],,adj ;1st ld
[asciz ' '],,noun1 ;2nd ld
[asciz ' is on the '],,noun2 ;3rd ld
in the LIT area. Thus the sentences this template can make are like
"The red cat is on the table", if red,cat,table are in the lexicon
lists for adj,noun1,noun2, respectively.
`
;Zero this counter which will be bumped in the macro.
;This is used later, too.
?N.templates__0 ;Number of templates defined in here.
define SENTENCE (pairlist) {
BEGIN TLIST
.pairs__0 ;keep count of # of pairs in template
xwd .neglength, [ ;we want the adr of the descr. list here
beghalfwd ;set up halfword assembler
for halfpair in (pairlist)
{ife .pairs&1
< Compress(<halfpair>)
UseCompression(TextHalfWd)
> ;left halfwd is string pointer
ifn .pairs&1
< halfwd (halfpair)
> ;right half is adr of lexicon list
.pairs__.pairs+1
} ;alternate between left and right
endhalfwd
] ;end of lexicon descr list literal
.neglength__-.pairs/2
^N.templates__N.templates+1 ;increase number of templates counter.
BEND TLIST
} ;end of SENTENCE
Subtitle Sentence Templates and Vocabulary Lexicons--machine independent data base.
MUMBLE Compute the lengths of lines and lines/sentence for output routines.
`
MaxWordLen__=16 ;Length of longest vocabulary word.
AvgLinesPerSentence__=4 ;Mean # of CRLFs in one sentence.
^LineLen__CharsPerLine-MaxWordLen
;The effective line length knows about the longest word
; in the vocabulary so we can hypenate properly.
^PerPage__(LinesPerPage-2)/AvgLinesPerSentence
;The number of sentences that will fit on a screen
; depends on the averge number of lines per tingler.
;Include the separate LEXICON file:
if.off NoLexCompression <^NoLexCompression__Debug>
;Don't waste infinite assembly time if debugging!!!
if.on Debug <LALL>
;Expand macros so we can see what's wrong.
.INSERT LEXICON
MUMBLE Make the template table address and length available to
the routines that need them (FAIL hackery).
`
^Templates_Templates ;Template table address.
^N.Templates_N.Templates;Number of templates defined.
^Q1_Q1 ;Quote table address--for debugging.
MUMBLE Finish off by defining the version. The Major version
corresponds to the version of the code in TINGLE. The minor version
is the number of SENTENCEs defined, and the edit number is the total
number of lexicons defined with LEXLIST. The latter two are computed
by the corresponding macros for use here. V.Tingle is carried
through from TINGLE and is redefined globally as our total version #.
`
^V.Tingle^__<byte (3)7(9)V.Tingle(6)N.Templates(18)N.Lexicons>
;The N.values not known until end of assembly.
if.on VERSION < if.off PROCEDURE <
.JBVER^__137 ;Declare version so users can see changes.
loc .JBVER ;..
V.Tingle
reloc
end.if PROCEDURE > end.if VERSION >
bend LEXICON ;end of grammar and vocabulary stuff.
LIST ;reinstate listing if XListLexiconed.
if.on PROCEDURE < END >
if.off PROCEDURE < END TINGLE >