mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-03-03 09:55:20 +00:00
Commit changes to SNOBOL files in preparation for proofing and correction: correct sequence numbers, up-case text; commit README file.
This commit is contained in:
Paul Kimpel
37
SNOBOL-UW-Chambers/README.txt
Normal file
37
SNOBOL-UW-Chambers/README.txt
Normal file
@@ -0,0 +1,37 @@
|
||||
SNOBOL3 Interpreter for the Burroughs B5500
|
||||
|
||||
This implementation of SNOBOL3 was written by John Chambers at the
|
||||
University of Wisconsin. The source was apparently obtained from CUBE
|
||||
library tape CUBEA13, file SNOBOL/L200010.
|
||||
|
||||
A user manual is available at
|
||||
http://bitsavers.org/pdf/burroughs/B5000_5500_5700/listing/
|
||||
B5700_Snobol_Manual_Jun76.pdf.
|
||||
|
||||
The compiler and test program were originally transcribed by Rich
|
||||
Cornwell of North Carolina, US.
|
||||
|
||||
|
||||
**NOTE**
|
||||
These files have not yet been proofread and corrected.
|
||||
|
||||
|
||||
SNOBOL3-Compile.card
|
||||
Card deck to compile the SNOBOL interpreter.
|
||||
|
||||
SYMBOL/SNOBOL.alg_m
|
||||
Source of the interpreter, transcribed from
|
||||
http://bitsavers.org/pdf/burroughs/B5000_5500_5700/listing/
|
||||
B5700_Snobol_Compiler_Apr77.pdf
|
||||
by Rich Cornwell of
|
||||
|
||||
SNTEST.card
|
||||
A card deck with a series of SNOBOL test runs supplied by Rich
|
||||
Cornwell.
|
||||
|
||||
|
||||
__________
|
||||
2016-07-16 Paul Kimpel
|
||||
Commit initial files as transcribed by Rich Cornwell; overwrite with
|
||||
revised source having up-cased text and sequence number corrections,
|
||||
ready for proofreading.
|
||||
@@ -1,159 +1,159 @@
|
||||
?execute snobol/disk
|
||||
?file print = print back up disk
|
||||
?common=3
|
||||
?data program
|
||||
-list
|
||||
* example 2, differentiation of algebraic expression
|
||||
?EXECUTE SNOBOL/DISK
|
||||
?FILE PRINT = PRINT BACK UP DISK
|
||||
?COMMON=3
|
||||
?DATA PROGRAM
|
||||
-LIST
|
||||
* EXAMPLE 2, DIFFERENTIATION OF ALGEBRAIC EXPRESSION
|
||||
*
|
||||
* this program differentiates a fully parenthesized
|
||||
* algebraic expression with respect to x. the exponentiation
|
||||
* operator is indicated by a dollar sign.
|
||||
- space 2
|
||||
define("d(d)","do","u,v,n")
|
||||
define("simplify(exp)","s0","u")
|
||||
trace("d,simplify")
|
||||
- space
|
||||
* READ In the expression.
|
||||
- space
|
||||
read exp = trim(syspit) /f(end)
|
||||
- space
|
||||
mode("anchor")
|
||||
syspot =
|
||||
syspot = "the derivative of " exp " is " simplify(d(exp))
|
||||
. /(end)
|
||||
- space 2
|
||||
* the function "d"
|
||||
- space
|
||||
do d "(" *(u)* "+" *(v)* ")" = "(" d(u) "+" d(v) ")"
|
||||
. /s(return)
|
||||
- space
|
||||
D "(" *(u)* "-" *(v)* ")" = "(" d(u) "-" d(v) ")"
|
||||
. /s(return)
|
||||
- space
|
||||
D "(" *(u)* "*" *(v)* ")" = "((" u "*" d(v) ")+("
|
||||
. v "*" d(u) "))" /s(return)
|
||||
- space
|
||||
D "(" *(u)* "/" *(v)* ")" = "(((" v "*" d(u) ")-("
|
||||
. u "*" d(v) "))/(" v "$2))" /s(return)
|
||||
- space
|
||||
D "(" *(u)* "$" *(v)* ")" =
|
||||
. "((" n "*(" U "$" n - "1" "))*" d(U) ")"
|
||||
. /s(return)
|
||||
- space
|
||||
d = equals(d,"x") "1" /s(return)
|
||||
d = "0" /(return)
|
||||
* THIS PROGRAM DIFFERENTIATES A FULLY PARENTHESIZED
|
||||
* ALGEBRAIC EXPRESSION WITH RESPECT TO X. THE EXPONENTIATION
|
||||
* OPERATOR IS INDICATED BY A DOLLAR SIGN.
|
||||
- SPACE 2
|
||||
DEFINE("D(D)","DO","U,V,N")
|
||||
DEFINE("SIMPLIFY(EXP)","S0","U")
|
||||
TRACE("D,SIMPLIFY")
|
||||
- SPACE
|
||||
* READ IN THE EXPRESSION.
|
||||
- SPACE
|
||||
READ EXP = TRIM(SYSPIT) /F(END)
|
||||
- SPACE
|
||||
MODE("ANCHOR")
|
||||
SYSPOT =
|
||||
SYSPOT = "THE DERIVATIVE OF " EXP " IS " SIMPLIFY(D(EXP))
|
||||
. /(END)
|
||||
- SPACE 2
|
||||
* THE FUNCTION "D"
|
||||
- SPACE
|
||||
DO D "(" *(U)* "+" *(V)* ")" = "(" D(U) "+" D(V) ")"
|
||||
. /S(RETURN)
|
||||
- SPACE
|
||||
D "(" *(U)* "-" *(V)* ")" = "(" D(U) "-" D(V) ")"
|
||||
. /S(RETURN)
|
||||
- SPACE
|
||||
D "(" *(U)* "*" *(V)* ")" = "((" U "*" D(V) ")+("
|
||||
. V "*" D(U) "))" /S(RETURN)
|
||||
- SPACE
|
||||
D "(" *(U)* "/" *(V)* ")" = "(((" V "*" D(U) ")-("
|
||||
. U "*" D(V) "))/(" V "$2))" /S(RETURN)
|
||||
- SPACE
|
||||
D "(" *(U)* "$" *(V)* ")" =
|
||||
. "((" N "*(" U "$" N - "1" "))*" D(U) ")"
|
||||
. /S(RETURN)
|
||||
- SPACE
|
||||
D = EQUALS(D,"X") "1" /S(RETURN)
|
||||
D = "0" /(RETURN)
|
||||
|
||||
* the function "simplify"
|
||||
- space
|
||||
s0 mode("unanch")
|
||||
s1 exp "(" *(u)* "*0)" = "0" /s(s1)
|
||||
exp "(0*" *(u)* ")" = "0" /s(s1)
|
||||
s2 exp "(" *(u)* "$1)" = u /s(s2)
|
||||
s3 exp "(" *(u)* "*1)" = u /s(s3)
|
||||
s4 exp "(1*" *(u)* ")" = u /s(s4)
|
||||
s5 exp "(0+" *(u)* ")" = u /s(s5)
|
||||
s6 exp "(" *(u)* "+0)" = U /S(S6)
|
||||
s7 exp "(" *(u)* "-0)" = u /s(s7)
|
||||
simplify = exp /(return)
|
||||
end
|
||||
?data card
|
||||
(((a*(x$2))+(b*x))+c)
|
||||
?end
|
||||
?execute snobol/disk
|
||||
?file print = print back up disk
|
||||
?common=3
|
||||
?data program
|
||||
-list
|
||||
* example 1. the wang algorithm
|
||||
* THE FUNCTION "SIMPLIFY"
|
||||
- SPACE
|
||||
S0 MODE("UNANCH")
|
||||
S1 EXP "(" *(U)* "*0)" = "0" /S(S1)
|
||||
EXP "(0*" *(U)* ")" = "0" /S(S1)
|
||||
S2 EXP "(" *(U)* "$1)" = U /S(S2)
|
||||
S3 EXP "(" *(U)* "*1)" = U /S(S3)
|
||||
S4 EXP "(1*" *(U)* ")" = U /S(S4)
|
||||
S5 EXP "(0+" *(U)* ")" = U /S(S5)
|
||||
S6 EXP "(" *(U)* "+0)" = U /S(S6)
|
||||
S7 EXP "(" *(U)* "-0)" = U /S(S7)
|
||||
SIMPLIFY = EXP /(RETURN)
|
||||
END
|
||||
?DATA CARD
|
||||
(((A*(X$2))+(B*X))+C)
|
||||
?END
|
||||
?EXECUTE SNOBOL/DISK
|
||||
?FILE PRINT = PRINT BACK UP DISK
|
||||
?COMMON=3
|
||||
?DATA PROGRAM
|
||||
-LIST
|
||||
* EXAMPLE 1. THE WANG ALGORITHM
|
||||
*
|
||||
* this program is the algorithm by hao want (cf. "toward
|
||||
* mechanical mathematics", ibm journal be research and
|
||||
* development for the propositional calculus., it prints out a
|
||||
* PRoof or disproof according as a given formula is a theorem
|
||||
* or not. thealogrithm uses sequents which consist of two
|
||||
* lists of formulas seperated by an arrow (--*). INITIALLY, for
|
||||
* a given formula p the sequent
|
||||
* THIS PROGRAM IS THE ALGORITHM BY HAO WANT (CF. "TOWARD
|
||||
* MECHANICAL MATHEMATICS", IBM JOURNAL BE RESEARCH AND
|
||||
* DEVELOPMENT FOR THE PROPOSITIONAL CALCULUS., IT PRINTS OUT A
|
||||
* PROOF OR DISPROOF ACCORDING AS A GIVEN FORMULA IS A THEOREM
|
||||
* OR NOT. THEALOGRITHM USES SEQUENTS WHICH CONSIST OF TWO
|
||||
* LISTS OF FORMULAS SEPERATED BY AN ARROW (--*). INITIALLY, FOR
|
||||
* A GIVEN FORMULA P THE SEQUENT
|
||||
*
|
||||
* --* f
|
||||
* --* F
|
||||
*
|
||||
* is formed. wang has defined rules for simplifying a formula
|
||||
* IN a sequent by removing the main connective and then
|
||||
* generating a new sequent or sequents. there is a terminal
|
||||
* test for a sequent consisting of only atomic formulas:
|
||||
* IS FORMED. WANG HAS DEFINED RULES FOR SIMPLIFYING A FORMULA
|
||||
* IN A SEQUENT BY REMOVING THE MAIN CONNECTIVE AND THEN
|
||||
* GENERATING A NEW SEQUENT OR SEQUENTS. THERE IS A TERMINAL
|
||||
* TEST FOR A SEQUENT CONSISTING OF ONLY ATOMIC FORMULAS:
|
||||
*
|
||||
* two sequent consisting of only atomic formulas is valid if
|
||||
* the two lists of formulas have a formula in common.
|
||||
* TWO SEQUENT CONSISTING OF ONLY ATOMIC FORMULAS IS VALID IF
|
||||
* THE TWO LISTS OF FORMULAS HAVE A FORMULA IN COMMON.
|
||||
*
|
||||
* by repeated application of the rules one is led to a set of
|
||||
* sequents consisting of atomic formulas. if each one of these
|
||||
* sequents is valid then so is the original formula.
|
||||
- space 5
|
||||
define("wang(ante,conseq)" , "wang","phi,psi")
|
||||
* read in the expression
|
||||
- space
|
||||
read exp = trim(syspit) /f(end)
|
||||
syspot =
|
||||
syspot = "formula: " exp
|
||||
syspot =
|
||||
wang(," " exp) /f(invalid)
|
||||
syspot = "valid" /(read)
|
||||
invalid syspot = "not valid" /(read)
|
||||
wang syspot = ante " --* " conseq
|
||||
ante " not(" *(phi)* ")" = /s(anot)
|
||||
ante " and(" *(phi)* "," *(psi)* ")" = /s(aand)
|
||||
ante " imp(" *(phi)* "," *(psi)* ")" = /s(aimp)
|
||||
ante " or(" *(phi)* "," *(psi)* ")" = /s(aor)
|
||||
ante " equ(" *(phi)* "," *(psi)* ")" = /s(aequ)
|
||||
- space
|
||||
conseq " not(" *(phi)* ")" = /s(cnot)
|
||||
conseq " and(" *(phi)* "," *(psi)* ")" = /s(cand)
|
||||
conseq " imp(" *(phi)* "," *(psi)* ")" = /s(cimp)
|
||||
conseq " or(" *(phi)* "," *(psi)* ")" = /s(cor)
|
||||
conseq " equ(" *(phi)* "," *(psi)* ")" = /s(cequ)
|
||||
- space
|
||||
(ante " :" conseq " ") " " *(p)* " " ** ":" ** " " p " "
|
||||
. /s(return)f(freturn)
|
||||
anot wang(ante,conseq " " phi) /s(return)f(freturn)
|
||||
* BY REPEATED APPLICATION OF THE RULES ONE IS LED TO A SET OF
|
||||
* SEQUENTS CONSISTING OF ATOMIC FORMULAS. IF EACH ONE OF THESE
|
||||
* SEQUENTS IS VALID THEN SO IS THE ORIGINAL FORMULA.
|
||||
- SPACE 5
|
||||
DEFINE("WANG(ANTE,CONSEQ)" , "WANG","PHI,PSI")
|
||||
* READ IN THE EXPRESSION
|
||||
- SPACE
|
||||
READ EXP = TRIM(SYSPIT) /F(END)
|
||||
SYSPOT =
|
||||
SYSPOT = "FORMULA: " EXP
|
||||
SYSPOT =
|
||||
WANG(," " EXP) /F(INVALID)
|
||||
SYSPOT = "VALID" /(READ)
|
||||
INVALID SYSPOT = "NOT VALID" /(READ)
|
||||
WANG SYSPOT = ANTE " --* " CONSEQ
|
||||
ANTE " NOT(" *(PHI)* ")" = /S(ANOT)
|
||||
ANTE " AND(" *(PHI)* "," *(PSI)* ")" = /S(AAND)
|
||||
ANTE " IMP(" *(PHI)* "," *(PSI)* ")" = /S(AIMP)
|
||||
ANTE " OR(" *(PHI)* "," *(PSI)* ")" = /S(AOR)
|
||||
ANTE " EQU(" *(PHI)* "," *(PSI)* ")" = /S(AEQU)
|
||||
- SPACE
|
||||
CONSEQ " NOT(" *(PHI)* ")" = /S(CNOT)
|
||||
CONSEQ " AND(" *(PHI)* "," *(PSI)* ")" = /S(CAND)
|
||||
CONSEQ " IMP(" *(PHI)* "," *(PSI)* ")" = /S(CIMP)
|
||||
CONSEQ " OR(" *(PHI)* "," *(PSI)* ")" = /S(COR)
|
||||
CONSEQ " EQU(" *(PHI)* "," *(PSI)* ")" = /S(CEQU)
|
||||
- SPACE
|
||||
(ANTE " :" CONSEQ " ") " " *(P)* " " ** ":" ** " " P " "
|
||||
. /S(RETURN)F(FRETURN)
|
||||
ANOT WANG(ANTE,CONSEQ " " PHI) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
AAND wang(ante " " phi " " psi, conseq) /s(return)f(freturn)
|
||||
AAND WANG(ANTE " " PHI " " PSI, CONSEQ) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
aor wang(ante " " phi,conseq) /f(freturn)
|
||||
wang(ante " " psi,conseq) /s(return)f(freturn)
|
||||
AOR WANG(ANTE " " PHI,CONSEQ) /F(FRETURN)
|
||||
WANG(ANTE " " PSI,CONSEQ) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
aimp wang(ante " " psi,conseq) /f(freturn)
|
||||
wang(ante,conseq " " phi) /s(return)f(freturn)
|
||||
AIMP WANG(ANTE " " PSI,CONSEQ) /F(FRETURN)
|
||||
WANG(ANTE,CONSEQ " " PHI) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
aequ wang(ante " " phi " " psi,conseq) /f(freturn)
|
||||
wang(ante,conseq " " phi " " psi) /S(return)F(FREturn)
|
||||
AEQU WANG(ANTE " " PHI " " PSI,CONSEQ) /F(FRETURN)
|
||||
WANG(ANTE,CONSEQ " " PHI " " PSI) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
cnot wang(ante " " phi,conseq) /s(return)f(freturn)
|
||||
CNOT WANG(ANTE " " PHI,CONSEQ) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
cand wang(ante,conseq " " phi) /f(freturn)
|
||||
wang(ante,conseq " " psi) /s(return)f(freturn)
|
||||
CAND WANG(ANTE,CONSEQ " " PHI) /F(FRETURN)
|
||||
WANG(ANTE,CONSEQ " " PSI) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
cor wang(ante,conseq " " phi " " psi) /s(return)F(FRETURN)
|
||||
COR WANG(ANTE,CONSEQ " " PHI " " PSI) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
CIMP WANG(ANTE " " PHI,CONSEQ " " PSI) /s(return)f(freturn)
|
||||
CIMP WANG(ANTE " " PHI,CONSEQ " " PSI) /S(RETURN)F(FRETURN)
|
||||
-
|
||||
cequ wang(ante " " phi,conseq " " psi) /f(freturn)
|
||||
wang(ante " " psi,conseq " " phi) /s(RETURN)f(freturn)
|
||||
end
|
||||
imp(not(or(p,q)),not(p))
|
||||
imp(and(not(p),not(q)),equ(p,q))
|
||||
imp(imp(OR(P,Q),or(p,r)),OR(P,imp(q,r)))
|
||||
stop
|
||||
?end
|
||||
?execute snobol/disk
|
||||
?file print = print back up disk
|
||||
?common=3
|
||||
?data program
|
||||
-list
|
||||
CEQU WANG(ANTE " " PHI,CONSEQ " " PSI) /F(FRETURN)
|
||||
WANG(ANTE " " PSI,CONSEQ " " PHI) /S(RETURN)F(FRETURN)
|
||||
END
|
||||
IMP(NOT(OR(P,Q)),NOT(P))
|
||||
IMP(AND(NOT(P),NOT(Q)),EQU(P,Q))
|
||||
IMP(IMP(OR(P,Q),OR(P,R)),OR(P,IMP(Q,R)))
|
||||
STOP
|
||||
?END
|
||||
?EXECUTE SNOBOL/DISK
|
||||
?FILE PRINT = PRINT BACK UP DISK
|
||||
?COMMON=3
|
||||
?DATA PROGRAM
|
||||
-LIST
|
||||
* BLANK IS A CONCATENATION OPERATOR!
|
||||
FIRST = "HORACE"
|
||||
SECOND = "GREELEY"
|
||||
NAME = FIRST " " SECOND
|
||||
SYSPOT = NAME
|
||||
INT = 12 div 2 * 3
|
||||
INT = 12 DIV 2 * 3
|
||||
* MULTIPLICATION HAS HIGHER PRECEDENCE THAN DIVISION
|
||||
* ARITHMETIC HAS HIGHER PRECENCE THAN CONCATENATION
|
||||
SYSPOT = "12 / 2 * 3 = " INT
|
||||
@@ -174,208 +174,208 @@ LOOP STUFF "CAT" = "DOG" /S(LOOP)
|
||||
END
|
||||
THE CAT JUMPED OVER THE DOG.
|
||||
THE DOG JUMPED OVER THE CAT.
|
||||
?end
|
||||
?execute snobol/disk
|
||||
?file print = print back up disk
|
||||
?common=3
|
||||
?data program
|
||||
-list
|
||||
?END
|
||||
?EXECUTE SNOBOL/DISK
|
||||
?FILE PRINT = PRINT BACK UP DISK
|
||||
?COMMON=3
|
||||
?DATA PROGRAM
|
||||
-LIST
|
||||
* ID START
|
||||
* DATA
|
||||
READ LINE = SYSPIT
|
||||
LINE "STOP" /S(QUIT)
|
||||
NLINE = LINE
|
||||
NLINE *LAST* "," *FIRST* "-" *TITLE*
|
||||
AUTHOR = FIRST " " LAST
|
||||
TITLE = " " TITLE " "
|
||||
TITLE " THE " = " "
|
||||
TITLE " A " = " "
|
||||
TITLE " AN " = " "
|
||||
STITLE = TITLE
|
||||
DEBLANK TITLE " " = " " /S(DEBLANK)
|
||||
LOOP TITLE " " = "," /S(LOOP)
|
||||
TITLE *FIRSTCHAR/"1"* =
|
||||
WORDLIST = WORDLIST TITLE
|
||||
SYSPOT = LINE
|
||||
SYSPOT = AUTHOR "-" STITLE
|
||||
SYSPOT = TITLE "$" WORDLIST
|
||||
/(READ)
|
||||
QUIT SIZE = "14"
|
||||
REDEFINE ALPHABET = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789. "
|
||||
DECR SIZE = SIZE - "1"
|
||||
SIZE "-" /S(DONE)
|
||||
BACK WORDLIST *WORD* "," = /F(LAST)
|
||||
WORD *HEAD/SIZE* *PIT/"1"* /F(ALL)
|
||||
$PIT = $PIT WORD "," /(BACK)
|
||||
ALL BIN = BIN WORD "," /(BACK)
|
||||
LAST BIN *WORDLIST* =
|
||||
AGAIN ALPHABET *PIT/"1"* = /F(REDEFINE)
|
||||
WORDLIST = WORDLIST $PIT
|
||||
$PIT = /(AGAIN)
|
||||
DONE SYSPOT = "WORDLIST" WORDLIST
|
||||
END READ
|
||||
STURGEON,THEODORE-MORE THAN HUMAN
|
||||
SMITH,E.E.-GRAY LENSMAN
|
||||
SMITH,E.E.-TRIPLANETARY
|
||||
RAGAN,RICHARD-TEST THE PROGRAM
|
||||
READ LINE = SYSPIT
|
||||
LINE "STOP" /S(QUIT)
|
||||
NLINE = LINE
|
||||
NLINE *LAST* "," *FIRST* "-" *TITLE*
|
||||
AUTHOR = FIRST " " LAST
|
||||
TITLE = " " TITLE " "
|
||||
TITLE " THE " = " "
|
||||
TITLE " A " = " "
|
||||
TITLE " AN " = " "
|
||||
STITLE = TITLE
|
||||
DEBLANK TITLE " " = " " /S(DEBLANK)
|
||||
LOOP TITLE " " = "," /S(LOOP)
|
||||
TITLE *FIRSTCHAR/"1"* =
|
||||
WORDLIST = WORDLIST TITLE
|
||||
SYSPOT = LINE
|
||||
SYSPOT = AUTHOR "-" STITLE
|
||||
SYSPOT = TITLE "$" WORDLIST
|
||||
/(READ)
|
||||
QUIT SIZE = "14"
|
||||
REDEFINE ALPHABET = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789. "
|
||||
DECR SIZE = SIZE - "1"
|
||||
SIZE "-" /S(DONE)
|
||||
BACK WORDLIST *WORD* "," = /F(LAST)
|
||||
WORD *HEAD/SIZE* *PIT/"1"* /F(ALL)
|
||||
$PIT = $PIT WORD "," /(BACK)
|
||||
ALL BIN = BIN WORD "," /(BACK)
|
||||
LAST BIN *WORDLIST* =
|
||||
AGAIN ALPHABET *PIT/"1"* = /F(REDEFINE)
|
||||
WORDLIST = WORDLIST $PIT
|
||||
$PIT = /(AGAIN)
|
||||
DONE SYSPOT = "WORDLIST" WORDLIST
|
||||
END READ
|
||||
STURGEON,THEODORE-MORE THAN HUMAN
|
||||
SMITH,E.E.-GRAY LENSMAN
|
||||
SMITH,E.E.-TRIPLANETARY
|
||||
RAGAN,RICHARD-TEST THE PROGRAM
|
||||
STOP
|
||||
?end
|
||||
?execute snobol/disk
|
||||
?file print = print back up disk
|
||||
?common=3
|
||||
?data program
|
||||
-list
|
||||
DEFINE("PERM(NAME,RENAME)","ENT")
|
||||
READ1 CARD1 = SYSPIT
|
||||
CARD1 "STOP" /S(END)
|
||||
CARD2 = SYSPIT
|
||||
CARD1 *NUMCOD1/"6"* =
|
||||
CARD2 *NUMCOD2/"4"* =
|
||||
CARD1 *Y/"2"* =
|
||||
CARD2 *Y/"4"* =
|
||||
EQUALS(CARD1,CARD2) /S(SAME)
|
||||
NUM1 = PERM(CARD1,"FIRST")
|
||||
NUM2 = PERM(CARD2,"LAST")
|
||||
.EQ(NUM1,NUM2) /S(ASET)
|
||||
.LT(NUM1,NUM2) /S(FILL1)F(FILL2)
|
||||
FILL1 A = NUM1
|
||||
ADD A = A + "1"
|
||||
$("FIRST" A ) =
|
||||
.EQ(A,NUM2) /F(ADD)S(CONT)
|
||||
FILL2 A = NUM2
|
||||
INCR A = A + "1"
|
||||
$("LAST" A) =
|
||||
.EQ(A,NUM1) /F(INCR)S(CONT)
|
||||
ASET A = NUM1
|
||||
CONT COUNT = "0"
|
||||
MORE COUNT = COUNT + "1"
|
||||
SYSPOT = NUMCOD1 " " NUMCOD2 " " $("FIRST" COUNT)
|
||||
SYSPOT = NUMCOD1 " " NUMCOD2 " " $("LAST" COUNT)
|
||||
.EQ(COUNT,A) /F(MORE)S(READ1)
|
||||
SAME SYSPOT = NUMCOD1 " " NUMCOD2 " " CARD1 /(READ1)
|
||||
ENT NAME = TRIM(NAME) " "
|
||||
DEBLANK NAME " " = " " /S(DEBLANK)
|
||||
NAME *WORD1* " " =
|
||||
NAME = NAME "$" WORD1 " "
|
||||
PERM = "0"
|
||||
LOOP PERM = PERM + "1"
|
||||
NAME *WORD* " " =
|
||||
NAME = NAME WORD " "
|
||||
NAME ANCHOR(X) "$" = /S(RETURN)
|
||||
$(RENAME PERM ) = NAME
|
||||
CLEAN $(RENAME PERM ) "$" = /S(CLEAN)F(LOOP)
|
||||
END
|
||||
STURGEON,THEODORE-MORE THAN HUMAN
|
||||
SMITH,E.E.-GRAY LENSMAN
|
||||
SMITH,E.E.-TRIPLANETARY
|
||||
RAGAN,RICHARD-TEST THE PROGRAM
|
||||
?END
|
||||
?EXECUTE SNOBOL/DISK
|
||||
?FILE PRINT = PRINT BACK UP DISK
|
||||
?COMMON=3
|
||||
?DATA PROGRAM
|
||||
-LIST
|
||||
DEFINE("PERM(NAME,RENAME)","ENT")
|
||||
READ1 CARD1 = SYSPIT
|
||||
CARD1 "STOP" /S(END)
|
||||
CARD2 = SYSPIT
|
||||
CARD1 *NUMCOD1/"6"* =
|
||||
CARD2 *NUMCOD2/"4"* =
|
||||
CARD1 *Y/"2"* =
|
||||
CARD2 *Y/"4"* =
|
||||
EQUALS(CARD1,CARD2) /S(SAME)
|
||||
NUM1 = PERM(CARD1,"FIRST")
|
||||
NUM2 = PERM(CARD2,"LAST")
|
||||
.EQ(NUM1,NUM2) /S(ASET)
|
||||
.LT(NUM1,NUM2) /S(FILL1)F(FILL2)
|
||||
FILL1 A = NUM1
|
||||
ADD A = A + "1"
|
||||
$("FIRST" A ) =
|
||||
.EQ(A,NUM2) /F(ADD)S(CONT)
|
||||
FILL2 A = NUM2
|
||||
INCR A = A + "1"
|
||||
$("LAST" A) =
|
||||
.EQ(A,NUM1) /F(INCR)S(CONT)
|
||||
ASET A = NUM1
|
||||
CONT COUNT = "0"
|
||||
MORE COUNT = COUNT + "1"
|
||||
SYSPOT = NUMCOD1 " " NUMCOD2 " " $("FIRST" COUNT)
|
||||
SYSPOT = NUMCOD1 " " NUMCOD2 " " $("LAST" COUNT)
|
||||
.EQ(COUNT,A) /F(MORE)S(READ1)
|
||||
SAME SYSPOT = NUMCOD1 " " NUMCOD2 " " CARD1 /(READ1)
|
||||
ENT NAME = TRIM(NAME) " "
|
||||
DEBLANK NAME " " = " " /S(DEBLANK)
|
||||
NAME *WORD1* " " =
|
||||
NAME = NAME "$" WORD1 " "
|
||||
PERM = "0"
|
||||
LOOP PERM = PERM + "1"
|
||||
NAME *WORD* " " =
|
||||
NAME = NAME WORD " "
|
||||
NAME ANCHOR(X) "$" = /S(RETURN)
|
||||
$(RENAME PERM ) = NAME
|
||||
CLEAN $(RENAME PERM ) "$" = /S(CLEAN)F(LOOP)
|
||||
END
|
||||
STURGEON,THEODORE-MORE THAN HUMAN
|
||||
SMITH,E.E.-GRAY LENSMAN
|
||||
SMITH,E.E.-TRIPLANETARY
|
||||
RAGAN,RICHARD-TEST THE PROGRAM
|
||||
STOP
|
||||
?end
|
||||
?execute snobol/disk
|
||||
?file print = print back up disk
|
||||
?common=3
|
||||
?data program
|
||||
-list
|
||||
- TITLE PROCESS S A T AND 1 2 T H G R A D E CARDS.
|
||||
* THIS PROGRAM TAKES AN SAT CARD AND A 12TH GRADE SCHOOL CARD
|
||||
* AND ATTEMPTS TO GENERATE A SINGLE CARD COMBINING THE
|
||||
* INFORMATION ON BOTH OF THESE. IN PARTICULAR THE PROGRAM
|
||||
* SEARCHES OUT THE BEST SCHOOL NAME FROM THE TWO CARDS.
|
||||
* WHEN A MATCH IS NOT OBTAINED MULTIPLE CARDS ARE GENERATED
|
||||
* CONTAINING CYCLIC PERMUTATIONS OF THE SCHOOL NAME FROM
|
||||
* BOTH CARDS. THE CHOICE OF THE ADDRESS CARD TO BE USED
|
||||
* IS LEFT TO THE DISCRETION OF THE USER. IN GENERAL
|
||||
* ONLY ONE CARD WILL BE GENERATED SINCE CERTAIN KEYWORDS
|
||||
* SUCH AS "HIGH" , "SCHOOL", "HS", "H S" ARE ELIMINATED
|
||||
* FROM THE TEXT BEFORE COMPARISON OF SCHOOL NAMES IS
|
||||
* ATTEMPTED. THIS RESULTS IN A MUCH HIGHER PERCENTAGE OF
|
||||
* MATCHES THAN WOULD OTHERWISE BE OBTAINED.
|
||||
*
|
||||
* RICHARD RAGAN
|
||||
* FSU COMPUTING CNTR.
|
||||
* 5-1-66
|
||||
DEFINE("EXCERPT(STRING,WORD1,WORD2)","ENTRY")
|
||||
DEFINE("PERM(NAME,RENAME)","ENT")
|
||||
DEFINE("HSGET(SNAME,SLOC)","Z")
|
||||
DEFINE("RESTOR(QUAL,QUAN)","104")
|
||||
BLANK = " "
|
||||
READ SAT = SYSPIT
|
||||
SAT "STOP" /S(END)
|
||||
12TH = SYSPIT
|
||||
12TH *12CODE/"4"* *FILLER/"3"* *12NAME/"27"* *COUNTY/"4"*
|
||||
. *FILLER/"3"* *CTYCODE/"2"* *FILLER/"3"* *12LOC*
|
||||
SAT *FILLER/"2"* *SATCODE/"4"* *FILLER/"2"* *SATNAME/"21"*
|
||||
. *FILLER/"22"* *SATLOC*
|
||||
12NAME = TRIM(12NAME) " "
|
||||
SATNAME = TRIM(SATNAME) " "
|
||||
DEMIN 12NAME "-" = " " /S(DEMIN)
|
||||
DEMINUS SATNAME "-" = " " /S(DEMINUS)
|
||||
SATNAME = HSGET(SATNAME,12LOC)
|
||||
S12NAME = 12NAME
|
||||
SSATNAME = SATNAME
|
||||
12NAME = EXCERPT(12NAME," SCHOOL "," SCH ")
|
||||
12NAME = EXCERPT(12NAME," H "," S ")
|
||||
12NAME = EXCERPT(12NAME," HS "," HIGH ")
|
||||
SATNAME = EXCERPT(SATNAME," SCHOOL "," SCH ")
|
||||
SATNAME = EXCERPT(SATNAME," H "," S ")
|
||||
SATNAME = EXCERPT(SATNAME," HS "," HIGH ")
|
||||
12NAME = EXCERPT(12NAME," SR "," JR ")
|
||||
SATNAME = EXCERPT(SATNAME," SR "," JR ")
|
||||
EQUALS(12NAME,SATNAME) /S(LUCK)
|
||||
OFF = RESTOR(12NAME,S12NAME)
|
||||
ON = RESTOR(SATNAME,SSATNAME)
|
||||
P12 = PERM(12NAME,"12.")
|
||||
PSAT = PERM(SATNAME,"SAT.")
|
||||
COUNT = "0"
|
||||
MORE COUNT = COUNT + "1"
|
||||
ALL = $("12." COUNT) OFF
|
||||
ALL = ALL BLANK
|
||||
ALL *FIXFLD/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY FIXFLD TRIM(12LOC)
|
||||
.EQ(P12,COUNT) /F(MORE)
|
||||
COUNT = "0"
|
||||
AGAIN COUNT = COUNT + "1"
|
||||
NONE = $("SAT." COUNT) ON
|
||||
NONE = NONE BLANK
|
||||
NONE *FLD/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY FLD TRIM(12LOC)
|
||||
.EQ(PSAT,COUNT) /F(AGAIN)S(READ)
|
||||
LUCK .GE(SIZE(S12NAME),SIZE(SSATNAME)) /S(S12)F(SSAT)
|
||||
S12 S12NAME = S12NAME BLANK
|
||||
S12NAME *SAVE/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY SAVE TRIM(12LOC)
|
||||
. /(READ)
|
||||
SSAT SSATNAME = SSATNAME BLANK
|
||||
SSATNAME *KEEP/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY KEEP TRIM(12LOC)
|
||||
. /(READ)
|
||||
- EJECT
|
||||
ENTRY STRING WORD1 = " "
|
||||
STRING WORD2 = " "
|
||||
EXCERPT = STRING /(RETURN)
|
||||
- EJECT
|
||||
Z SNAME ANCHOR(X) "HIGH SCHOOL" /F(FRETURN)
|
||||
SLOC *TNAME* "FLORIDA" /S(ROTAT)
|
||||
SLOC *TNAME* "FLA" /F(FRETURN)
|
||||
ROTAT HSGET = TNAME SNAME /(RETURN)
|
||||
- EJECT
|
||||
ENT NAME = TRIM(NAME) " "
|
||||
PERM = "1"
|
||||
DEBLANK NAME " " = " " /S(DEBLANK)
|
||||
$(RENAME PERM) = NAME
|
||||
NAME *WORD1* " " =
|
||||
NAME = NAME "$" WORD1 " "
|
||||
NAME ANCHOR(X) "$" = /S(RETURN)
|
||||
LOOP PERM = PERM + "1"
|
||||
$(RENAME PERM) = NAME
|
||||
NAME *WORD* " " =
|
||||
NAME ANCHOR(X) "$" = /S(OKAY)
|
||||
NAME = NAME WORD " "
|
||||
CLEAN $(RENAME PERM) "$" = /S(CLEAN)
|
||||
BL $(RENAME PERM) " " = " " /S(BL)F(LOOP)
|
||||
OKAY $(RENAME PERM) "$" = /(RETURN)
|
||||
- EJECT
|
||||
104 QUAN QUAL *CODE*
|
||||
RESTOR = TRIM(CODE) " " /(RETURN)
|
||||
END
|
||||
?end
|
||||
?END
|
||||
?EXECUTE SNOBOL/DISK
|
||||
?FILE PRINT = PRINT BACK UP DISK
|
||||
?COMMON=3
|
||||
?DATA PROGRAM
|
||||
-LIST
|
||||
- TITLE PROCESS S A T AND 1 2 T H G R A D E CARDS.
|
||||
* THIS PROGRAM TAKES AN SAT CARD AND A 12TH GRADE SCHOOL CARD
|
||||
* AND ATTEMPTS TO GENERATE A SINGLE CARD COMBINING THE
|
||||
* INFORMATION ON BOTH OF THESE. IN PARTICULAR THE PROGRAM
|
||||
* SEARCHES OUT THE BEST SCHOOL NAME FROM THE TWO CARDS.
|
||||
* WHEN A MATCH IS NOT OBTAINED MULTIPLE CARDS ARE GENERATED
|
||||
* CONTAINING CYCLIC PERMUTATIONS OF THE SCHOOL NAME FROM
|
||||
* BOTH CARDS. THE CHOICE OF THE ADDRESS CARD TO BE USED
|
||||
* IS LEFT TO THE DISCRETION OF THE USER. IN GENERAL
|
||||
* ONLY ONE CARD WILL BE GENERATED SINCE CERTAIN KEYWORDS
|
||||
* SUCH AS "HIGH" , "SCHOOL", "HS", "H S" ARE ELIMINATED
|
||||
* FROM THE TEXT BEFORE COMPARISON OF SCHOOL NAMES IS
|
||||
* ATTEMPTED. THIS RESULTS IN A MUCH HIGHER PERCENTAGE OF
|
||||
* MATCHES THAN WOULD OTHERWISE BE OBTAINED.
|
||||
*
|
||||
* RICHARD RAGAN
|
||||
* FSU COMPUTING CNTR.
|
||||
* 5-1-66
|
||||
DEFINE("EXCERPT(STRING,WORD1,WORD2)","ENTRY")
|
||||
DEFINE("PERM(NAME,RENAME)","ENT")
|
||||
DEFINE("HSGET(SNAME,SLOC)","Z")
|
||||
DEFINE("RESTOR(QUAL,QUAN)","104")
|
||||
BLANK = " "
|
||||
READ SAT = SYSPIT
|
||||
SAT "STOP" /S(END)
|
||||
12TH = SYSPIT
|
||||
12TH *12CODE/"4"* *FILLER/"3"* *12NAME/"27"* *COUNTY/"4"*
|
||||
. *FILLER/"3"* *CTYCODE/"2"* *FILLER/"3"* *12LOC*
|
||||
SAT *FILLER/"2"* *SATCODE/"4"* *FILLER/"2"* *SATNAME/"21"*
|
||||
. *FILLER/"22"* *SATLOC*
|
||||
12NAME = TRIM(12NAME) " "
|
||||
SATNAME = TRIM(SATNAME) " "
|
||||
DEMIN 12NAME "-" = " " /S(DEMIN)
|
||||
DEMINUS SATNAME "-" = " " /S(DEMINUS)
|
||||
SATNAME = HSGET(SATNAME,12LOC)
|
||||
S12NAME = 12NAME
|
||||
SSATNAME = SATNAME
|
||||
12NAME = EXCERPT(12NAME," SCHOOL "," SCH ")
|
||||
12NAME = EXCERPT(12NAME," H "," S ")
|
||||
12NAME = EXCERPT(12NAME," HS "," HIGH ")
|
||||
SATNAME = EXCERPT(SATNAME," SCHOOL "," SCH ")
|
||||
SATNAME = EXCERPT(SATNAME," H "," S ")
|
||||
SATNAME = EXCERPT(SATNAME," HS "," HIGH ")
|
||||
12NAME = EXCERPT(12NAME," SR "," JR ")
|
||||
SATNAME = EXCERPT(SATNAME," SR "," JR ")
|
||||
EQUALS(12NAME,SATNAME) /S(LUCK)
|
||||
OFF = RESTOR(12NAME,S12NAME)
|
||||
ON = RESTOR(SATNAME,SSATNAME)
|
||||
P12 = PERM(12NAME,"12.")
|
||||
PSAT = PERM(SATNAME,"SAT.")
|
||||
COUNT = "0"
|
||||
MORE COUNT = COUNT + "1"
|
||||
ALL = $("12." COUNT) OFF
|
||||
ALL = ALL BLANK
|
||||
ALL *FIXFLD/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY FIXFLD TRIM(12LOC)
|
||||
.EQ(P12,COUNT) /F(MORE)
|
||||
COUNT = "0"
|
||||
AGAIN COUNT = COUNT + "1"
|
||||
NONE = $("SAT." COUNT) ON
|
||||
NONE = NONE BLANK
|
||||
NONE *FLD/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY FLD TRIM(12LOC)
|
||||
.EQ(PSAT,COUNT) /F(AGAIN)S(READ)
|
||||
LUCK .GE(SIZE(S12NAME),SIZE(SSATNAME)) /S(S12)F(SSAT)
|
||||
S12 S12NAME = S12NAME BLANK
|
||||
S12NAME *SAVE/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY SAVE TRIM(12LOC)
|
||||
. /(READ)
|
||||
SSAT SSATNAME = SSATNAME BLANK
|
||||
SSATNAME *KEEP/"27"*
|
||||
SYSPPT = 12CODE SATCODE CTYCODE COUNTY KEEP TRIM(12LOC)
|
||||
. /(READ)
|
||||
- EJECT
|
||||
ENTRY STRING WORD1 = " "
|
||||
STRING WORD2 = " "
|
||||
EXCERPT = STRING /(RETURN)
|
||||
- EJECT
|
||||
Z SNAME ANCHOR(X) "HIGH SCHOOL" /F(FRETURN)
|
||||
SLOC *TNAME* "FLORIDA" /S(ROTAT)
|
||||
SLOC *TNAME* "FLA" /F(FRETURN)
|
||||
ROTAT HSGET = TNAME SNAME /(RETURN)
|
||||
- EJECT
|
||||
ENT NAME = TRIM(NAME) " "
|
||||
PERM = "1"
|
||||
DEBLANK NAME " " = " " /S(DEBLANK)
|
||||
$(RENAME PERM) = NAME
|
||||
NAME *WORD1* " " =
|
||||
NAME = NAME "$" WORD1 " "
|
||||
NAME ANCHOR(X) "$" = /S(RETURN)
|
||||
LOOP PERM = PERM + "1"
|
||||
$(RENAME PERM) = NAME
|
||||
NAME *WORD* " " =
|
||||
NAME ANCHOR(X) "$" = /S(OKAY)
|
||||
NAME = NAME WORD " "
|
||||
CLEAN $(RENAME PERM) "$" = /S(CLEAN)
|
||||
BL $(RENAME PERM) " " = " " /S(BL)F(LOOP)
|
||||
OKAY $(RENAME PERM) "$" = /(RETURN)
|
||||
- EJECT
|
||||
104 QUAN QUAL *CODE*
|
||||
RESTOR = TRIM(CODE) " " /(RETURN)
|
||||
END
|
||||
?END
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user