IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140),SLINE(80) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /SEEDS/ SEED1,SEED2 COMMON /DOC/ DOPOIN,DOVAR COMMON /INPL/ SLINE,LINEE,LINEX2 EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) INTEGER CSEED1(5) C CALL TIME(CSEED1) TYPE 10 10 FORMAT(1X) SEED1 = CSEED1(1)+CSEED1(2)+CSEED1(3)+CSEED1(4) CALL WEBSTER BUFFER(BUFFP) = -1 BUFFER(BUFFP+2) = 9997 - BUFFP DO 100 KEY=0,NINIT-1 CALL PROCESS(KEY,I) IF (I .EQ. 1) GOTO 200 100 CONTINUE 200 CONTINUE DO 999 KEY=6000,5999+NREP CALL PROCESS(KEY,I) IF (I .EQ. 1) GOTO 200 999 CONTINUE GOTO 200 END BLOCK DATA IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /SEEDS/ SEED COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) DATA INHAND /-1/ DATA LOGICALS /31, 51, 52/ DATA DIGITS /'0','1','2','3','4','5','6','7','8','9'/ DATA UC /'A','B','C','D','E','F','G','H','I','J','K','L','M', + 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/ DATA LC /'a','b','c','d','e','f','g','h','i','j','k','l','m', + 'n','o','p','q','r','s','t','u','v','w','x','y','z'/ END SUBROUTINE ERROR(ENUM) COMMON /FIX1/ SKEY1 COMMON /RECSTU/ REC,BP,SBUFF INTEGER SKEY1,REC,BP,SBUFF,ENUM CHARACTER*40 ERRLIN C GOTO (10,20,30,40,50,60,70,80,90,100,110,120), ENUM+1 10 ERRLIN = ' Invalid Opcode' GOTO 200 20 ERRLIN = ' Ill-Placed Logical' GOTO 200 30 ERRLIN = ' Invalid Eval Key' GOTO 200 40 ERRLIN = ' Invalid Bit Value' GOTO 200 50 ERRLIN = ' Invalid Where' GOTO 200 60 ERRLIN = ' Invalid Set Value' GOTO 200 70 ERRLIN = ' Invalid Bit Set' GOTO 200 80 ERRLIN = ' Invalid Object Movement' GOTO 200 90 ERRLIN = ' Invalid Say' GOTO 200 100 ERRLIN = ' Invalid Code for Executive' GOTO 200 110 ERRLIN = ' Save Operation Failed' GOTO 200 120 ERRLIN = ' Restore Operation Failed' 200 IBP1 = BP - SBUFF ISK = SKEY + 1 TYPE 220, ERRLIN, REC, ISK, IBP1 220 FORMAT (' Error!!',A,/,' In execution of Record:',I4, 1 ' at Location:',I3) CALL EXIT END SUBROUTINE WEBSTER IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140),SLINE(80) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP, 1 RPTR1,RPTR2 COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR COMMON /INPL/ SLINE,LINEE,LINEX2 COMMON /FIX100/ NINDX EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) LOGICAL*1 FIND CHARACTER*30 FIDCHR C LINEE = -100 LINEX2 = 0 BUFFP = 1 OPEN (UNIT=1, FILE='FILES.DIR', TYPE='OLD', READONLY, ERR=999) READ (1,350) FIDCHR OPEN (UNIT=3, FILE=FIDCHR, TYPE='OLD', FORM='UNFORMATTED', 1 READONLY) READ (3,END=999,ERR=999) HERE,SYMCNT,THERE,STATUS DO 300, I=1,SYMCNT READ (3,END=999,ERR=999) (LINE(ARG1),ARG1=1,12),KEY CALL SCOPY(LINE,BUFFER(BUFFP),6) BUFFER(BUFFP+3)=KEY BUFFP = BUFFP + 4 300 CONTINUE CLOSE (UNIT=3) READ (1,350) FIDCHR 350 FORMAT (A) OPEN (UNIT=4, FILE='ADVENTTMP.TMP', TYPE='SCRATCH', 1 ACCESS='DIRECT', RECORDSIZE=128) OPEN (UNIT=2, FILE=FIDCHR, TYPE='OLD', ACCESS='DIRECT', 1 READONLY) RPTR1 = BUFFP BUFFP = BUFFP + 256 RPTR = BUFFP NINDX = 1 DO 400, I=1,HERE READ (2'I,ERR=998) (BUFFER(ARG1),ARG1=BUFFP,BUFFP+3) IF (BUFFER(BUFFP+1) .GE. 0) GOTO 400 BUFFP = BUFFP + 4 NINDX = NINDX + 1 400 CONTINUE BUFFER(BUFFP) = 9999 BUFFP = BUFFP + 4 RPTR2 = BUFFP TMPREC = 1 TMPPTR = RPTR1 DO 405, I=1,HERE READ (2'I) (BUFFER(ARG1),ARG1=TMPPTR,TMPPTR+3) IF (BUFFER(TMPPTR+1) .LT. 0) GOTO 405 TMPPTR = TMPPTR + 4 IF (TMPPTR .LT. RPTR1 + 256) GOTO 405 WRITE (4'TMPREC) (BUFFER(ARG1),ARG1=RPTR1,TMPPTR-1) TMPREC= TMPREC+1 BUFFER(BUFFP) = BUFFER(TMPPTR-4) BUFFER(BUFFP+1) = BUFFER(TMPPTR-3) BUFFP = BUFFP + 2 TMPPTR = RPTR1 405 CONTINUE WRITE (4'TMPREC) (BUFFER(ARG1),ARG1=RPTR1,TMPPTR-1) BUFFER(BUFFP) = 9999 BUFFP = BUFFP + 2 CLOSE(UNIT=2) READ (1,350) FIDCHR OPEN (UNIT=2, FILE=FIDCHR, TYPE='OLD', ACCESS='DIRECT', 1 READONLY) READ (1,350) FIDCHR CLOSE (UNIT=1) OPEN (UNIT=1, FILE=FIDCHR, TYPE='OLD', ACCESS='DIRECT', 1 READONLY) IF (FIND(HERE,'HERE')) GOTO 9999 IF (FIND(THERE,'THERE')) GOTO 9999 IF (FIND(STATUS,'STATUS')) GOTO 9999 IF (FIND(ARG1,'ARG1')) GOTO 9999 IF (FIND(ARG2,'ARG2')) GOTO 9999 IF (FIND(NOBJ,'NOBJ')) GOTO 9999 IF (FIND(NPLACE,'NPLACE')) GOTO 9999 IF (FIND(NREP,'NREP')) GOTO 9999 IF (FIND(NINIT,'NINIT')) GOTO 9999 IF (FIND(NVARS,'NVARS')) GOTO 9999 IF (FIND(EXPLORE,'EXPLORE')) GOTO 9999 IF (FIND(SAYXX,'SAY')) GOTO 9999 C C DEFINE "STATUS" BITS C MOVED = ISL(1,0) BRIEF = ISL(1,1) FAST = ISL(1,2) LOOKING = ISL(1,3) BEEN = ISL(1,1) DUAL = ISL(1,3) XOBJECT = ISL(1,15) XVERB = ISL(1,14) XPLACE = ISL(1,13) BADWORD = ISL(1,12) OBJVP = BUFFP OBJLP = BUFFP+NOBJ OBJBP = OBJLP+NOBJ BUFFP = OBJBP+NOBJ DO 50 I=OBJBP,BUFFP-1 50 BUFFER(I) = XOBJECT VARVP = BUFFP VARBP = BUFFP+NVARS BUFFP = VARBP+NVARS DO 60 I=VARBP,BUFFP-1 60 BUFFER(I) = XVERB PLABP = BUFFP BUFFP = BUFFP+NPLACE DO 70 I=PLABP,BUFFP-1 70 BUFFER(I) = XPLACE RETURN 999 STOP 'Trouble with Symbol Table' 998 STOP 'Trouble with Record Index File' 9999 TYPE 1,(BADVAR(I),I=1,6) 1 FORMAT (' Missing variable: ',6A1) STOP END LOGICAL FUNCTION FIND(INUM, ID) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140),SLINE(80) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP, 1 RPTR1,RPTR2 COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR COMMON /INPL/ SLINE,LINEE,LINEX2 EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) LOGICAL*1 IDE(8) CALL SCOPY(ID,IDE,6) CALL STRPAD(IDE,6) LOW = 1 HIGH = RPTR1 / 4 DO 5 TEMP4=1,6 IF (IDE(TEMP4) .LT. LC(1) .OR. IDE(TEMP4) .GT. LC(26)) GOTO 5 DO 3 TEMP5=1,26 3 IF (IDE(TEMP4) .EQ. LC(TEMP5)) GOTO 4 4 IDE(TEMP4) = UC(TEMP5) 5 CONTINUE 10 INUM = (LOW + HIGH) / 2 IF (CEQUAL(IDE,BUFFER(INUM*4-3),6) .EQ. 0) GOTO 30 IF (LOW .LT. HIGH) GOTO 15 CALL SCOPY(IDE,BADVAR,6) FIND=.TRUE. RETURN 15 IF (CEQUAL(IDE,BUFFER(INUM*4-3),6).LT. 0) GOTO 20 LOW = INUM + 1 GOTO 10 20 HIGH = INUM - 1 GOTO 10 30 INUM = BUFFER(INUM*4) FIND = .FALSE. RETURN END LOGICAL FUNCTION NEAR(I) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) C EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) C EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) TEMP3 = WHERE(I) TEMP1 = BITVAL(I) TEMP2 = EVAL(HERE) NEAR = (TEMP3 .EQ. TEMP2) .OR. + (TEMP3 .EQ. TEMP2-1 .AND. IAND(TEMP1, DUAL) .NE. 0) RETURN END SUBROUTINE PROCESS(RECNO, I10) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR COMMON /FIX1/ SKEY1 EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) LOGICAL*1 RESP, NEAR, EOR CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C The PROCEED module contains the actual interpreter code for C C the ADVENTURE program. The following definitions and notes C C should be observed: C C C C The things being manipulated herein consist of variables, C C objects, places, verbs, words on the command line entered C C by the user, and numerical values. Each of these things has C C certain characteristics, to wit: C C C C Variables have both numerical values and bit values. The C C numerical values are sixteen bits in magnitude and are signed. C C The bits for each variable are numbered 0 through 15; each one C C may be either set or reset. The numerical and bit values C C do not interact. C C C C Objects have both bit values and numerical values (or "states"). C C The state of an object is used to select the text to be printed C C when the object is visible to the player. Certain of the bit C C settings are specially interpreted by the program (i.e., the C C "SCHIZOID" bit indicates that the object is visible in two C C adjacent places) and must not be changed in the program unless C C they are changed in the database; other bits are available for C C arbitrary use by the database code. C C C C Places have bit settings, but no numerical values. C C C C The words entered on the command line are available through the C C special variables ARG1 and ARG2. They cannot be saved from one C C input to another. Special bits in ARG1 and ARG2 may be examined C C to see what kind of word was entered (verb/object/place/invalid). C C If the "NAME" opcode uses ARG1 or ARG2 as the second argument, the C C actual text entered by the user will be substituted for any C C occurrance of the character "#" when the text is printed. C C C C Numerical values may range from -32768 through 999. Values of C C 0 through 15 may be used to specify bit numbers in any of the C C bit-manipulation opcodes. C C C C Most references to arguments get run through a procedure called C C "EVAL", which figures out the difference between constant values C C and variables/places/objects, etc. EVAL returns the real value to C C be worked upon - a constant value is simply turned right around C C and returned; references to objects, and variables are transformed C C into the actual values of the indicated entities. C C C C Special things will happen if the argument of an opcode is a C C variable and if the variable's numerical value is the same as C C the reference number ("address", for you assembler freaks) of C C a text string, object, or place. In this case, any non- C C arithmetic operation performed on the variable (i.e., any C C bit-manipulation operation, a "SAY" or "NAME", an "IFNEAR" or C C "IFAT", an "APPORT", and so on will act upon the entity whose C C reference number is in the variable rather than on the variable C C itself (i.e., one automatic level of indirection). This indirection C C does not occur for arithmetic operations on variables (including C C the "SET" operation), but can be kludged up by way of the "EVAL" C C and "DEPOSIT" opcodes which do indirect loads and stores. C C C C The following major command codes may be used to create an C C ADVENTURE database: C C C C LIST - produce a compile-time list of the following statements. C C C C NOLIST - turn LIST feature off C C C C INCLUDE file - read commands from indicated file until EOF, then C C revert to reading from standard input device (M:SI). C C C C SYNON a,b1,b2,b3,.... - "a" must be an expression consisting of C C self-defining constant terms and/or already-defined symbols. C C b1, b2, and so on will be set to be "synonymous" with a. C C C C PLACE placename - defines a place called "placename" - the next C C available place referece number will be assigned. The C C following lines (up to the next major command) contain C C the text used to describe the place - the first set of C C lines give the "quick" description, the next set of lines C C gives the "full" description. C C C C OBJECT objectname - defines an object - the next available object C C reference number is assigned. The following lines give the C C object's description - the first set gives its "inventory" C C description (i.e., a short one-liner denoting what it's C C described as when you're carrying it); the second set gives C C its "state 0" description, the third set gives its "state 1" C C description, and so on as necessary. 59 states maximum, C C please. C C C C VERB verb1,verb2,..... - defines a set of synonymous verbs. All of C C the verbs listed will be defined with the same verb reference C C number, so that the player can enter any of them. NOTE - C C all action definitions for this set of verbs should be C C entered using only 1 of the possible choices (all with verb1, C C or all with verb2, etc., but not a mixture) or terrible C C things may happen! C C C C TEXT textname - defines a text string (one or more lines) called C C "textname". The following lines should consist of one set C C of text defining the message to be output when this C C text set is invoked. The character "#" may be used as a C C special symbol - if a "#" is encountered during the C C processing of a "NAME" or "VALUE" opcode, the "#" will be C C deleted from the string and the name or value of the variable C C indicated in the "NAME" or "VALUE" command will be substituted C C in its place. C C C C VARIABLE v1,v2,v3,.... - defines one or more variables. These C C variables are *not* synonymous with one another! C C C C LABEL labelname - defines a set of executable code called C C "labelname". The following lines contain the code. C C C C AT place - defines code to be executed when the player is at C C the indicated place - the following lines contain the actual C C code. More than 1 "AT" command may be defined for a C C particular place (in fact, up to 499); they will be C C executed in the order encountered during compilation. C C C C ACTION verb [keyword,keyword,....] - defines code to be executed C C when a particular verb is entered. The keywords are C C optional - if used, the code will be executed iff all C C keywords given were actually entered by the user on an C C input command line (this is the same as if the keywords C C were entered seperately on a "KEYWORD" op-code directly C C following the "ACTION" statement - see "KEYWORD" for C C details). Note that it is perfectly permissible to use C C the name of an object as a verb (e.g., "WATER"). C C C C INITIAL - defines once-only code to be executed at initialization C C time. Multiple INITIAL commands may be used and are C C executed in the order encountered. C C C C REPEAT - defines the main action-processing code that is executed C C during each player input. After the INITIAL code has been C C executed, the REPEAT statements are executed. Once the last C C REPEAT statement is executed, the program loops back and startsC C again with the first. The REPEAT process may be cut short at C C any time by the use of the "QUIT" opcode, which will restart C C execution at the beginning of the REPEAT set. C C C C Each of the above "major command" words must appeat in column C C 1. The command will consist of all following lines up to but C C not including the next major command statement (i.e., all lines C C in which column 1 is blank). Any line with an asterisk in column C C 1 is considered to be a comment and is ignored. Comments may be C C placed on major-command and opcode-control lines (but not on C C text-string lines) by starting the comment portion of the line C C with an asterisk or a left-brace ( "{" ). At the moment, only one C C opcode (with arguments) can be placed on each line; this may C C change if I get around to adding the code to the parser. C C C C In the description of objects and places above, the term "set of C C lines" was used. A set of lines is simply one or more lines of C C text. The first line in each set except the first is denoted by C C a percent sign ( "%" ) placed immediately before the first C C significant character. Any line that begins with an asterisk C C ( "*" ) or with the sequence ">$<" is considered to be a null C C or comment string and is not actually written to the text C C file. Normally, leading blanks are stripped by the compiler - C C to suppress this, place a slash ( "/" ) before the first blank C C that you wish to be included in the text record. C C C C The following is a list of the available op-codes and a quickie C C description of what they do: C C C C KEYWORD a,b,c,... If all indicated words appear in input, C C do following; otherwise PROCEED C C C C HAVE a,b,c,... If all indicated objects are in hand, C C do following; else PROCEED C C C C NEAR a,b,c If all indicated objects are in hand or C C nearby do following; else PROCEED C C C C AT a,b,c,.. If at any of indicated places do following; C C else PROCEED C C C C ANYOF a,b,c,... If any of indicated words are in command do C C following; else PROCEED C C C C IFEQ i,j If i=j do following C C C C IFLT i,j If ij do following C C C C IFAT i If at place "i" do following C C C C CHANCE i Do following i% of the time. C C C C ELSE Do following if current "if" wasn't done C C C C FIN End of "if" group C C C C EOF End of all "if" groups C C C C GET i Move object i into my hands C C C C DROP i Remove object i from hands, leave it C C here. C C C C APPORT i,j Move object i to place j. C C C C SET i,j Set i to j C C C C ADD i,j Set i to i+j C C C C SUB i,j Set i to i-j C C C C GOTO i Go to place i C C C C MOVE i,j If you said "i" or "MOVE i", go to C C place j and then quit C C C C CALL i Call and execute code defined for "i" C C (label, place, verb, etc.) C C C C SAY i Say text string/object description/place C C description i. C C C C NAME i,j Like SAY, but replace "#" with name of C C object j. C C C C VALUE i,j Like SAY, but replace "#" with value C C of variable/object/place j. C C C C PROCEED Jump to next portion of place/verb code. C C If none left, go back up one CALL level. C C C C QUIT Flush all CALLs and go to first REPEAT C C routine. C C C C STOP Terminate program immediately. C C C C IFHAVE i Do following if object i is in hand. C C C C IFNEAR i Do following if object i is nearby. C C C C RANDOM i,j Set i to random number in range [0, j-1] C C C C BITST i,j Do following if bit j in entity i is set C C C C BISET i,j Set bit j in variable i C C C C BICLEAR i,j Reset bit j in variable i C C C C ITOBJ i Loop to EOI running i through range of C C object reference values. C C C C ITPLACE i Loop to EOI running i through range of C C place reference values. C C C C EOI End of ITOBJ/ITLIST/ITPLACE loop C C C C IFLOC i,j Do following if object i is at C C place j C C C C INPUT Input and parse a command, set ARG1/ARG2 C C C C LOCATE i,j Set i equal to reference value of object C C j's location. C C C C NOT Invert following IF test C C C C IFKEY i Do following code if word i appeared C C in last command input. C C C C LDA i,j Set i equal to reference value of j - C C gets address rather than value. C C C C EVAL i,j j has ref. value of a variable or object - C C set i equal to value of var. or obj. C C C C MULTIPLY i,j set i = i * j C C C C DIVIDE i,j set i = i / j C C C C SVAR i,j set i equal to "system variable" j C C (see SVAR listing) C C C C EXEC i,j Perform "executive action" i, set C C results into variable j (see EXECUTIVE module)C C C C QUERY i Do a "SAY i", ask for yes/no answer - C C do following code if "yes". C C C C DEPOSIT i,j i is var. containing ref(k) - set k C C to j. C C C C ITLIST i Like ITOBJ but omits most objects that C C aren't nearby (but not all!) C C C C SMOVE i,j,k Like MOVE but if move performed, do C C "SAY k" before quitting. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC REC=RECNO I10=0 CALLS=0 SKEY=0 DOS=0 1000 BP=0 1100 IF (READBUFF(REC,-SKEY-1)) GOTO 1500 SKIPFLAG=0 NEGATE=.FALSE. PASSON=.FALSE. LOGICMODE = 1 1200 OPCODE=BUFFER(BP) SKEY1 = SKEY BP=BP+1 IF(OPCODE.GT.0) GO TO 2000 IF (BP.EQ.2) GOTO 1500 1300 SKEY = SKEY + 1 GOTO 1000 1500 IF (CALLS.EQ.0) RETURN REC=CALLREC(CALLS) SKEY=CALLSK(CALLS) BP=CALLBP(CALLS) DOS=CALLDOS(CALLS) CALLS=CALLS-1 GO TO 1100 1900 RETURN 2000 GO TO (2100,2200,2300,2400,2500,2600,2700,2800, + 2900,3000,3100,3200,3300,3400,3500,3600,3700, + 3800,3900,4000,4100,4200,4300,4400,4500,4600, + 4700,4800,4900,5000,5100,5200,5400,5500, + 5600,5700,5800,5900,6000,6100,6200,6300,6400, + 6500, 6600, 6700, 6800, 6900, 7000, 7100, 5100, 5100, + 7200, 7300, 7400, 7500), OPCODE CALL ERROR(0) C C "KEYWORD" C 2100 CONTINUE WORD1=BUFFER(BP) BP=BP+1 DO 2110 I=1,LINELEN 2110 IF(WORD1.EQ.LINEWORD(I)) GO TO 1200 GO TO 1300 C C "HAVE" C 2200 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF(WHERE(REF(WORD1)).EQ.INHAND) GO TO 1200 GO TO 1300 C C "NEAR" C 2300 CONTINUE WORD1=BUFFER(BP) BP=BP+1 TEMP1=REF(WORD1) TEMP2=WHERE(TEMP1) IF (TEMP2 .EQ. INHAND .OR. NEAR(TEMP1)) GOTO 1200 GO TO 1300 C C "AT" C 2400 CONTINUE TRUTH=.FALSE. 2410 CONTINUE WORD1=BUFFER(BP) BP=BP+1 TRUTH=TRUTH.OR.(WORD1.EQ.EVAL(HERE)) IF(BUFFER(BP).NE.4) GO TO 2420 BP=BP+1 GO TO 2410 2420 IF(TRUTH) GO TO 1200 GO TO 1300 C C "ANYOF" C 2500 CONTINUE TRUTH=.FALSE. 2510 CONTINUE WORD1=BUFFER(BP) BP=BP+1 DO 2520 TEMP1=1,LINELEN 2520 TRUTH=TRUTH.OR.(WORD1.EQ.LINEWORD(TEMP1)) IF(BUFFER(BP).NE.5) GO TO 2530 BP=BP+1 GO TO 2510 2530 IF(TRUTH) GO TO 1200 GO TO 1300 C C "IFEQ" C 2600 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=(EVAL(WORD1).EQ.EVAL(WORD2)) C C -- GENERAL "IF" PROCESSING -- C 2610 TRUTH = EOR(TRUTH,NEGATE) IF (LOGICMODE .EQ. 1) TRUTH = TRUTH .OR. PASSON IF (LOGICMODE .EQ. 2) TRUTH = TRUTH .AND. PASSON IF (LOGICMODE .EQ. 3) TRUTH = EOR(TRUTH,PASSON) PASSON=.FALSE. NEGATE=.FALSE. DO 2615 LOGICMODE = 1, 3 2615 IF (BUFFER(BP) .EQ. LOGICALS(LOGICMODE)) GOTO 2616 LOGICMODE = 1 GOTO 2620 2616 CONTINUE BP=BP+1 PASSON=TRUTH GO TO 1200 2620 IF(SKIPFLAG.EQ.0) GO TO 2630 SKIPFLAG=SKIPFLAG+1 GO TO 1200 2630 IF (.NOT.TRUTH) SKIPFLAG=1 GO TO 1200 C C "IFLT" C 2700 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=(EVAL(WORD1).LT.EVAL(WORD2)) GO TO 2610 C C "IFGT" C 2800 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=(EVAL(WORD1).GT.EVAL(WORD2)) GO TO 2610 C C "IFAT" C 2900 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=(REF(WORD1).EQ.EVAL(HERE)) GO TO 2610 C C "CHANCE" C 3000 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=(EVAL(WORD1).GT.RND(100)) GO TO 2610 C C "ELSE" C 3100 CONTINUE IF(SKIPFLAG.GT.1) GO TO 1200 SKIPFLAG=1-SKIPFLAG GO TO 1200 C C "FIN" C 3200 CONTINUE SKIPFLAG=MAX0(SKIPFLAG-1,0) GO TO 1200 C C "EOF" C 3300 CONTINUE SKIPFLAG=0 GO TO 1200 C C "GET" C 3400 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF(SKIPFLAG.GT.0) GO TO 1200 CALL MOVEOBJ(REF(WORD1), INHAND) TEMP1 = EVAL(REF(WORD1)) IF (TEMP1 .LT. 0) CALL SETVAL(REF(WORD1), -1 - TEMP1) GO TO 1200 C C "DROP" C 3500 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF(SKIPFLAG.GT.0) GO TO 1200 CALL MOVEOBJ(REF(WORD1), EVAL(HERE)) GO TO 1200 C C "APPORT" C 3600 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL MOVEOBJ(REF(WORD1), REF(WORD2)) GO TO 1200 C C "SET" C 3700 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETVAL(WORD1,EVAL(WORD2)) GO TO 1200 C C "ADD" C 3800 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETVAL(WORD1,EVAL(WORD1)+EVAL(WORD2)) GO TO 1200 C C "SUB" C 3900 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETVAL(WORD1,EVAL(WORD1)-EVAL(WORD2)) GO TO 1200 C C "GOTO" C 4000 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF(SKIPFLAG.GT.0) GO TO 1200 TEMP1 = EVAL(HERE) TEMP2 = BITVAL(HERE) CALL SETVAL(HERE, REF(WORD1)) CALL SETBIT(HERE, BITVAL(REF(WORD1))) CALL SETVAL(THERE, TEMP1) CALL SETBIT(THERE, TEMP2) CALL SETBIT(STATUS, IOR(BITVAL(STATUS), MOVED)) GO TO 1200 C C "MOVE" C 4100 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 IF (WORD1 .NE. LINEWORD(1) .AND. (LINELEN .LT. 2 .OR. + WORD1 .NE. LINEWORD(2) .OR. (LINEWORD(1) .NE. EXPLORE + .AND. LINEWORD(1) .NE. SAYXX))) GOTO 1200 TEMP1 = EVAL(HERE) TEMP2 = BITVAL(HERE) CALL SETVAL(HERE, REF(WORD2)) CALL SETBIT(HERE, BITVAL(REF(WORD2))) CALL SETVAL(THERE, TEMP1) CALL SETBIT(THERE, TEMP2) CALL SETBIT(STATUS, IOR(BITVAL(STATUS), MOVED)) I10=1 RETURN C C "CALL" C 4200 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF(SKIPFLAG.GT.0) GO TO 1200 CALLS=CALLS+1 CALLREC(CALLS)=REC CALLSK(CALLS)=SKEY CALLBP(CALLS)=BP-SBUFF CALLDOS(CALLS)=DOS REC=REF(WORD1) SKEY=0 TEMP1 = CLASS(REF(WORD1)) IF (TEMP1 .EQ. 2) SKEY = 1 GO TO 1000 C C "SAY" C 4300 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SAY(REF(WORD1),0,1) GO TO 1200 C C "NAME" C 4400 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 DO 4410 TEMP1=1,4 4410 IF(WORD2.EQ.ARGWORDS(TEMP1)) GO TO 4420 GOTO 4430 4420 CALL SAY(REF(WORD1), WORD2,2) GOTO 1200 4430 CONTINUE CALL SAY(REF(WORD1),REF(WORD2),2) GO TO 1200 C C "VALUE" C 4500 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SAY(REF(WORD1),REF(WORD2),3) GO TO 1200 C C "PROCEED" C 4600 CONTINUE IF(SKIPFLAG.GT.0) GO TO 1200 GOTO 1300 C C "QUIT" C 4700 CONTINUE IF(SKIPFLAG.GT.0) GO TO 1200 I10=1 RETURN C C "STOP" C 4800 CONTINUE IF(SKIPFLAG.GT.0) GO TO 1200 STOP C C "IFHAVE" C 4900 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=(WHERE(REF(WORD1)).EQ.INHAND) GO TO 2610 C C "IFNEAR" C 5000 CONTINUE WORD1=BUFFER(BP) BP=BP+1 IF (SKIPFLAG.GT.0) GOTO 2610 TEMP1=REF(WORD1) TEMP2=WHERE(TEMP1) TRUTH = (TEMP2 .EQ. INHAND .OR. NEAR(TEMP1)) GO TO 2610 C C "OR" - SHOULD NEVER GET HERE! C 5100 CALL ERROR(1) C C "RANDOM" C 5200 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 1200 CALL SETVAL(WORD1,RND(EVAL(WORD2))) GOTO 1200 C C "BITST" C 5400 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=IAND(BITVAL(WORD1),BITVAL(WORD2)).NE.0 GO TO 2610 C C "BISET" C 5500 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETBIT(WORD1,IOR(BITVAL(WORD1),BITVAL(WORD2))) GO TO 1200 C C "BICLEAR" C 5600 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETBIT(WORD1,IAND(BITVAL(WORD1),INOT(BITVAL(WORD2)))) GO TO 1200 C C "ITOBJ" C 5700 CONTINUE WORD1=BUFFER(BP) BP=BP+1 DOS=DOS+1 IF(SKIPFLAG.GT.0) GO TO 1200 DOVAR(DOS)=WORD1 CALL SETVAL(WORD1,1000) DOPOINT(DOS)=BP DOMODE(DOS)=1 GO TO 1200 C C "ITPLACE" C 5800 CONTINUE WORD1=BUFFER(BP) BP=BP+1 DOS=DOS+1 IF(SKIPFLAG.GT.0) GO TO 1200 DOVAR(DOS)=WORD1 CALL SETVAL(WORD1,2000) DOPOINT(DOS)=BP DOMODE(DOS)=2 GO TO 1200 C C "EOI" C 5900 CONTINUE IF(SKIPFLAG.EQ.0) GO TO 5910 5905 DOS=DOS-1 GO TO 1200 5910 TEMP5=EVAL(DOVAR(DOS))+1 CALL SETVAL(DOVAR(DOS),TEMP5) GOTO (5920,5930,5940), DOMODE(DOS) 5920 IF (MOD(TEMP5, 1000) .EQ. NOBJ) GOTO 5905 GOTO 5980 5930 IF (MOD(TEMP5, 1000) .EQ. NPLACE) GOTO 5905 GOTO 5980 5940 IF (MOD(TEMP5, 1000) .EQ. NOBJ) GOTO 5905 5945 IF (.NOT.NEAR(TEMP5).AND.MOD(TEMP5, 1000).NE.NOBJ-1) GOTO 5900 5980 BP=DOPOINT(DOS) GOTO 1200 C C "IFLOC" C 6000 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH=(WHERE(REF(WORD1)).EQ.REF(WORD2)) GOTO 2610 C C "INPUT" C 6100 CONTINUE IF(SKIPFLAG.GT.0) GO TO 1200 CALL COMMAND GO TO 1200 C C "LOCATE" C 6200 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETVAL(WORD1,WHERE(REF(WORD2))) GOTO 1200 C C "NOT" C 6300 CONTINUE IF (SKIPFLAG.GT.0) GO TO 1200 NEGATE = .NOT. NEGATE GO TO 1200 C C "IFKEY" C 6400 CONTINUE WORD1 = BUFFER(BP) BP = BP + 1 IF (SKIPFLAG.GT.0) GOTO 2610 TRUTH = .FALSE. DO 6410 TEMP1 = 1,LINELEN TRUTH = TRUTH .OR. (WORD1 .EQ. LINEWORD(TEMP1)) 6410 CONTINUE GOTO 2610 C C "LDA" C 6500 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GOTO 1200 CALL SETVAL(WORD1, WORD2) GOTO 1200 C C "EVAL" C 6600 CONTINUE WORD1 = BUFFER(BP) WORD2 = BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GOTO 1200 CALL SETVAL(WORD1, EVAL(REF(WORD2))) GOTO 1200 C C "MULTIPLY" C 6700 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETVAL(WORD1,EVAL(WORD1)*EVAL(WORD2)) GO TO 1200 C C "DIVIDE" C 6800 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GO TO 1200 CALL SETVAL(WORD1,EVAL(WORD1)/EVAL(WORD2)) GO TO 1200 C C "SVAR" C 6900 CONTINUE WORD1 = BUFFER(BP) WORD2 = BUFFER(BP+1) BP=BP+2 IF(SKIPFLAG.GT.0) GOTO 1200 I = EVAL(WORD2) CALL SVAR(EVAL(WORD1), I) CALL SETVAL(WORD2, I) GOTO 1200 C C "EXEC" C 7000 CONTINUE WORD1 = BUFFER(BP) WORD2 = BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 1200 CALL EXECUTIVE GOTO 1200 C C "QUERY" C 7100 CONTINUE WORD1 = BUFFER(BP) BP = BP + 1 IF (SKIPFLAG .GT. 0) GOTO 2610 7110 CALL SAY(REF(WORD1),0,1) ACCEPT 7111,RESP 7111 FORMAT(A1) TRUTH = (RESP .EQ. 'Y') .OR. (RESP .EQ. 'y') IF (TRUTH .OR. (RESP.EQ.'N'.OR.RESP.EQ.'n')) GOTO 2610 7120 TYPE *,' Please answer the question.!' GOTO 7110 C C "DEPOSIT" C 7200 CONTINUE WORD1 = BUFFER(BP) WORD2 = BUFFER(BP+1) BP=BP+2 IF (SKIPFLAG.GT.0) GOTO 1200 CALL SETVAL(REF(WORD1),EVAL(WORD2)) GOTO 1200 C C "ITLIST" C 7300 CONTINUE WORD1=BUFFER(BP) BP=BP+1 DOS=DOS+1 IF(SKIPFLAG.GT.0) GO TO 1200 DOVAR(DOS)=WORD1 TEMP5=1000 CALL SETVAL(WORD1,TEMP5) DOPOINT(DOS)=BP DOMODE(DOS)=3 GO TO 5945 C C "SMOVE" C 7400 CONTINUE WORD1=BUFFER(BP) WORD2=BUFFER(BP+1) WORD3=BUFFER(BP+2) BP=BP+3 IF(SKIPFLAG.GT.0) GO TO 1200 IF (WORD1 .NE. LINEWORD(1) .AND. (LINELEN .LT. 2 .OR. + WORD1 .NE. LINEWORD(2) .OR. (LINEWORD(1) .NE. EXPLORE + .AND. LINEWORD(1) .NE. SAYXX))) GOTO 1200 TEMP1 = EVAL(HERE) TEMP2 = BITVAL(HERE) CALL SETVAL(HERE, REF(WORD2)) CALL SETBIT(HERE, BITVAL(REF(WORD2))) CALL SETVAL(THERE, TEMP1) CALL SETBIT(THERE, TEMP2) CALL SETBIT(STATUS, IOR(BITVAL(STATUS), MOVED)) CALL SAY(WORD3,0,1) I10=1 RETURN C C "DEFAULT" C 7500 CONTINUE WORD1 = BUFFER(BP) BP = BP + 1 IF (SKIPFLAG.GT.0) GOTO 1200 IF (LINELEN .NE. 1) GOTO 1200 WORD2 = 0 DO 7510 WORD3=1000,999+NOBJ IF (.NOT.NEAR(WORD3).OR.IAND(BITVAL(WORD3),BITVAL(WORD1)).EQ.0) + GOTO 7510 IF (WORD2 .NE. 0) GOTO 1200 WORD2 = WORD3 7510 CONTINUE IF (WORD2 .EQ. 0) GOTO 1200 CALL SETVAL(ARGWORDS(2), WORD2) CALL SETBIT(ARGWORDS(2), BITVAL(WORD2)) LINEWORD(2) = WORD2 CALL SETVAL(STATUS, 2) LINELEN = 2 GOTO 1200 END INTEGER FUNCTION CLASS(EDITKEY) INTEGER EDITKEY CLASS = EDITKEY / 1000 RETURN END SUBROUTINE EXECUTIVE IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) COMMON /COMTEMP/ COMTEMP GOTO (100, 200, 300, 320, 310, 310, 700, 800), WORD1 CALL ERROR(9) 100 CONTINUE C C EXEC 1 - "SAVE" C OPEN (UNIT=3, FILE='SAVE.ADV', FORM='UNFORMATTED', 1 TYPE='NEW') CALL SETVAL(WORD2, 1) WRITE (3,ERR=140,END=150) (BUFFER(I),I=OBJVP,BUFFP-1) 130 CALL SETVAL(WORD2, 0) 140 CALL CLOSE (3) RETURN 150 CALL ERROR(10) 9999 CALL ERROR(11) 200 CONTINUE C C EXEC 2 - "RESTORE" C OPEN (UNIT=3, FILE='SAVE.ADV', TYPE='OLD', FORM='UNFORMATTED', 1 READONLY, ERR=140) CALL SETVAL(WORD2, 1) READ(3,ERR=140,END=9999) (BUFFER(I),I=OBJVP,BUFFP-1) GOTO 130 300 CONTINUE C C EXEC 3 - "DELETE" C 310 CALL SETVAL(WORD2,0) 320 RETURN C C EXEC 4 - "CLEAR CACHE" C C C EXEC 5 - "PRIME TIME" REQUEST C C C EXEC 6 - PRINT HOURS C 700 CONTINUE C C EXEC 7 - SAVE A VARIABLE C COMTEMP = EVAL(WORD2) RETURN 800 CONTINUE C C EXEC 8 - RESTORE SAVED VARIABLE C CALL SETVAL(WORD2, COMTEMP) RETURN END INTEGER FUNCTION REF(ID) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) REF = ID IF (CLASS(ID) .NE. 7) RETURN 3100 REF = BUFFER(VARVP+MOD(ID, 1000)) RETURN END LOGICAL FUNCTION READTEXT(KEY, SECKEY, FLAG) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP, 1 RPTR1, RPTR2 COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) COMMON /READT/ READBL,READB COMMON /TXTF/ TBUFF,TBLK INTEGER TBUFF(256),TBLK IF (FLAG .GT. 0) GOTO 10 ITEMP = RPTR2 5 IF (BUFFER(ITEMP)-KEY) 7,6,9 6 IF (BUFFER(ITEMP+1)-SECKEY) 7,9,9 7 ITEMP = ITEMP+2 GOTO 5 9 ITEMP = (ITEMP-RPTR2)/2 + 1 READ (4'ITEMP) (BUFFER(T1),T1=RPTR1,RPTR1+255) ITEMP = SRCH(KEY,IABS(SECKEY),1) IF (ITEMP .EQ. 0) GOTO 20 READBL = BUFFER(ITEMP+2) READB = BUFFER(ITEMP+3) 10 CALL READTX(TBUFF,TBLK,READBL,READB,TEXT,FLAG,KEY,SECKEY) 20 READTEXT = (READBL.EQ.-1) RETURN END INTEGER FUNCTION SRCH(KEY,SECKEY,IFLG) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP, 1 RPTR1,RPTR2 COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR COMMON /LINSTG/ LIK,LIS,LIB COMMON /FIX100/ NINDX EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) SRCH = 0 HIGH = 4*NINDX - 4 IF (IFLG .NE. 0) HIGH = 252 RPT = RPTR IF (IFLG .NE. 0) RPT = RPTR1 SKEY10 = IABS(SECKEY) LOW = 0 10 IF (HIGH .LT. LOW) GOTO 1000 MID = (LOW+HIGH)/8*4 MID1 = MID + RPT IF (KEY-BUFFER(MID1)) 30,20,40 20 IF (SKEY10-IABS(BUFFER(MID1+1))) 30,50,40 30 HIGH = MID - 4 GOTO 10 40 IF (IFLG .EQ. 0) GOTO 45 IF (BUFFER(MID1) .EQ. 0) GOTO 30 45 LOW = MID + 4 GOTO 10 50 IF (SECKEY .EQ. BUFFER(MID1+1)) SRCH = MID1 1000 RETURN END LOGICAL FUNCTION READBUFF(KEY, SECKEY) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) COMMON /INSTF/ IBUFF,IBLK INTEGER IBUFF(256),IBLK SBUFF = BUFFP READBUFF=.FALSE. 18 IF (BUFFER(SBUFF) .EQ. -1) GOTO 1000 IF (BUFFER(SBUFF) .NE. KEY) GOTO 20 IF (BUFFER(SBUFF+1) .EQ. SECKEY) GOTO 14 20 SBUFF = SBUFF + BUFFER(SBUFF+2) + 4 GOTO 18 1000 TEMP5 = SRCH(KEY,SECKEY,0) IF (TEMP5 .EQ. 0) GOTO 15 BBLEN = 0 CALL RDINST(IBUFF,IBLK,BUFFER(TEMP5+2),BUFFER(TEMP5+3), 1 BUFFER(SBUFF+3),BBLEN) IF (BUFFER(SBUFF+2) .GE. BBLEN + 5) GOTO 13 SBUFF = BUFFP BUFFER(BUFFP+2) = 9997 - BUFFP 13 ITEMP = BUFFER(SBUFF+2) - BBLEN - 4 CALL RDINST(IBUFF,IBLK,BUFFER(TEMP5+2),BUFFER(TEMP5+3), 1 BUFFER(SBUFF+3),BBLEN) BUFFER(SBUFF) = KEY BUFFER(SBUFF+1) = SECKEY BUFFER(SBUFF+2) = BBLEN ITEMP1 = BBLEN + 4 + SBUFF BUFFER(ITEMP1-1) = 0 BUFFER(ITEMP1) = -1 BUFFER(ITEMP1+2) = ITEMP 14 SBUFF = SBUFF + 3 BP = SBUFF + BP RETURN 15 READBUFF=.TRUE. RETURN END SUBROUTINE RTXT COMMON /TXTF/ TBUFF,TBLK INTEGER TBUFF(256),TBLK READ (1'TBLK,ERR=1,END=1) (TBUFF(I),I=1,256) RETURN 1 TYPE *, TBLK STOP 'Error on Text File' END SUBROUTINE RINST COMMON /INSTF/ IBUFF,IBLK INTEGER IBUFF(256),IBLK READ (2'IBLK,ERR=1,END=1) (IBUFF(I),I=1,256) RETURN 1 STOP 'Error on Instruction File' END SUBROUTINE SAY(KEY,EVL,MODE) IMPLICIT INTEGER(A-Z) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) LOGICAL*1 READTEXT VALUTA = EVL J = 0 TEMP5 = 0 100 GOTO (9999,9998,9997),KEY-3999 IF (CLASS(KEY) .EQ. 4) GOTO 200 IF (CLASS(KEY) .EQ. 2) GOTO 70 IF (CLASS(KEY) .NE. 1) CALL ERROR(8) 50 IF (WHERE(KEY) .EQ. INHAND) GOTO 200 IF (EVAL(KEY) .LT. 0) GOTO 9999 TEMP5 = EVAL(KEY)+1 GOTO 200 70 I = BITVAL(STATUS) IF (IAND(I, LOOKING) .NE. 0) GOTO 80 IF ((IAND(I, BRIEF) .NE. 0 .AND. IAND(BITVAL(KEY), BEEN) + .NE. 0) .OR. IAND(I, FAST) .NE. 0) GOTO 200 80 TEMP5 = 1 200 IF (READTEXT(KEY,TEMP5,J)) GOTO 9999 J = 1 IF (CEQUAL(TEXT,'>$<',3).EQ.0) GOTO 200 IF (MODE .EQ. 1) GOTO 1000 300 DO 400 I=1, 140 400 IF (TEXT(I) .EQ. '#') GOTO 410 GOTO 1000 410 IF (MODE .EQ. 3) GOTO 500 DO 412 J1=1,4 412 IF(EVL.EQ.ARGWORDS(J1)) GO TO 413 GOTO 417 413 CALL SCOPY(ARG(1,J1),LINE,6) 411 DO 416 K=1,6 IF (LINE(K) .LT. UC(1) .OR. LINE(K) .GT. UC(26)) + GOTO 416 DO 414 J1=1,26 414 IF (LINE(K) .EQ. UC(J1)) GOTO 415 GOTO 416 415 LINE(K) = LC(J1) 416 CONTINUE GOTO 600 417 CONTINUE DO 420 J1=1, SYMCNT 420 IF (BUFFER(J1*4) .EQ. EVL) GOTO 430 GOTO 1000 430 CALL SCOPY(BUFFER(J1*4-3),LINE,6) GOTO 411 500 CALL SCOPY(' ',LINE) DO 510 J1=6,1,-1 K=MOD(VALUTA, 10)+1 VALUTA = VALUTA / 10 LINE(J1) = DIGITS(K) IF (VALUTA .EQ. 0) GOTO 520 510 CONTINUE 520 IF (LINE(1).NE. ' ') GOTO 600 CALL SCOPY(LINE(2),LINE,6) GOTO 520 600 CALL SCOPY(TEXT,TEMP(20),I-1) CALL SCOPY(LINE,TEMP(I+19),6) J1 = ZLEN(TEMP(20)) CALL SCOPY(TEXT(I+1),TEMP(J1+20),99-I) CALL SCOPY(TEMP(20),TEXT,99) 1000 TYPE 1001, (TEXT(I),I=1,ZLEN(TEXT)) 1001 FORMAT(1X,100A1) GOTO 200 9997 TYPE *,' Ok.' GOTO 9999 9998 TYPE *,' ' 9999 RETURN END INTEGER FUNCTION EVAL(ID) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) TEMP4=CLASS(ID) ID1 = MOD (ID, 1000) EVAL =ID1 IF (TEMP4 .EQ. 0) RETURN IF (TEMP4 .EQ. 7) GOTO 1200 IF (TEMP4 .NE. 1) CALL ERROR(2) 1100 EVAL = BUFFER(ID1+OBJVP) RETURN 1200 EVAL = BUFFER(ID1+VARVP) RETURN END C C C INTEGER FUNCTION BITVAL(ID) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) ID1 = ID 1900 TEMP4 = CLASS(ID1) INDEX = MOD(ID1, 1000) IF (TEMP4 .EQ. 7) GOTO 2200 IF (TEMP4 .EQ. 2) GOTO 2300 IF (TEMP4 .EQ. 0) GOTO 2400 IF (TEMP4 .NE. 1) CALL ERROR(3) 2100 BITVAL = BUFFER(OBJBP+INDEX) RETURN 2200 TEMP4 = CLASS(BUFFER(VARVP+INDEX)) IF (TEMP4 .NE. 2 .AND. TEMP4 .NE. 1) GOTO 2210 ID1 = BUFFER(VARVP+INDEX) GOTO 1900 2210 BITVAL = BUFFER(VARBP+INDEX) RETURN 2300 BITVAL = BUFFER(PLABP+INDEX) RETURN 2400 BITVAL = ISL(1, ID) RETURN END C C C INTEGER FUNCTION WHERE(ID) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) TEMP4 = CLASS(ID) IF (TEMP4 .NE. 1) CALL ERROR(4) 4100 INDEX = MOD(ID, 1000) WHERE = BUFFER(OBJLP+INDEX) RETURN END SUBROUTINE SETVAL(I, J) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) TEMP4 = CLASS(I) INDEX = MOD(I, 1000) IF (TEMP4 .EQ. 7) GOTO 1200 IF (TEMP4 .NE. 1) CALL ERROR(5) 1100 BUFFER(OBJVP+INDEX) = J RETURN 1200 BUFFER(VARVP+INDEX) = J RETURN END C C C SUBROUTINE SETBIT(I, J) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) TEMP4 = CLASS(I) INDEX = MOD(I, 1000) 1999 IF (TEMP4 .EQ. 7) GOTO 2200 IF (TEMP4 .EQ. 2) GOTO 2300 IF (TEMP4 .NE. 1) CALL ERROR(6) 2100 BUFFER(OBJBP+INDEX) = J RETURN 2200 BUFFER(VARBP+INDEX) = J TEMP4 = CLASS(BUFFER(VARVP+INDEX)) IF (TEMP4 .NE. 2 .AND. TEMP4 .NE. 1) RETURN INDEX = MOD(REF(I), 1000) GOTO 1999 2300 BUFFER(PLABP+INDEX) = J RETURN END C C C SUBROUTINE MOVEOBJ(I, J) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) TEMP4 = CLASS(I) INDEX = MOD(I, 1000) IF (TEMP4 .NE. 1) CALL ERROR(7) 3100 BUFFER(OBJLP+INDEX) = J RETURN END INTEGER FUNCTION RND(X) INTEGER X,SEED1,SEED2 COMMON /SEEDS/ SEED1,SEED2 RND = IFIX(FLOAT(X)*RAN(SEED1,SEED2)) RETURN END SUBROUTINE COMMAND IMPLICIT INTEGER(A-Z) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140),SLINE(80) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR COMMON /INPL/ SLINE,LINEE,LINEX2 EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) 1 LINELEN = 0 DO 5 WORD1=1, 4 5 LINEWORD(WORD1) = -1 IF (LINEX2 .LE. LINEE) GOTO 8 TYPE 6 6 FORMAT (' > ',$) ACCEPT 7,(SLINE(LINEX2),LINEX2=1,79) 7 FORMAT (79A1) CALL SCOPY(SLINE,SLINE,79) CALL STRPAD(SLINE,79) LINEX2 = 1 8 DO 11, LINEX2 = LINEX2, 79 11 IF (SLINE(LINEX2) .NE. ' ') GOTO 21 LINEX2 = 80 21 CALL TRIM(SLINE) LINEE = ZLEN(SLINE) LINEND = LINEE IF (SLINE(LINEX2) .EQ. 0) GOTO 1 10 IF (PARSE(LINEVAL)) GOTO 100 LINEX2 = LINEX2 + 1 IF (FIND(LINEVAL,LEX)) GOTO 50 IF (CLASS(LINEVAL) .EQ. 8) GOTO 10 20 LINELEN = LINELEN + 1 LINEWORD(LINELEN) = LINEVAL CALL SCOPY(LEX,ARG(1,LINELEN),6) IF (SEP .EQ. ',') GOTO 100 IF (LINELEN .LT. 4) GOTO 10 GOTO 100 50 LINEVAL = -1 GOTO 20 100 CONTINUE DO 99 WORD1=1, 2 WORD2 = 0 WORD3 = CLASS(LINEWORD(WORD1)) IF (WORD3.EQ.1.OR.WORD3.EQ.2) WORD2=BITVAL(LINEWORD(WORD1)) IF (WORD3 .EQ. 3) WORD2 = XVERB IF (LINEWORD(WORD1) .LT. 0) WORD2 = BADWORD CALL SETVAL(ARGWORDS(WORD1), LINEWORD(WORD1)) 99 CALL SETBIT(ARGWORDS(WORD1), WORD2) CALL SETVAL(STATUS, LINELEN) WORD1 = CLASS(LINEWORD(1)) IF (WORD1 .EQ. 3) + CALL SETBIT(STATUS, IOR(BITVAL(STATUS), XVERB)) IF (WORD1 .EQ. 1) + CALL SETBIT(STATUS, IOR(BITVAL(STATUS), XOBJECT)) IF (WORD1 .EQ. 2) + CALL SETBIT(STATUS, IOR(BITVAL(STATUS), XPLACE)) IF (LINELEN .LT. 2) GOTO 999 999 CONTINUE RETURN END LOGICAL FUNCTION PARSE(I10) IMPLICIT INTEGER(A-Y) LOGICAL*1 LINE(80),LEX(10),TEXT(100),SEP,BADVAR(8) LOGICAL*1 DIGITS(10),UC(26),LC(26),ARG(7,4) LOGICAL*1 TRUTH,PASSON,NEGATE,TEMP(140),SLINE(80) DIMENSION LOGICALS(3),ARGWORDS(4) C THE DIMENSION OF BUFFER WILL BE CHANGED TO FIT *ALL* AVAILABLE MEMORY DIMENSION BUFFER(10000) DIMENSION LINEWORD(4),CALLREC(10),CALLSK(10) DIMENSION CALLBP(10),CALLDOS(10) DIMENSION DOVAR(2),DOPOINT(2),DOMODE(2) COMMON /STRINGS/ LINE,LEX,DIGITS, + TEXT,ARG,UC,LC,BADVAR COMMON /VALUES/ LINEX, TEMP, SKEY, + LINEND, SYMCNT, BUFFER, LINEWORD, LINELEN, + HERE, THERE, STATUS, + ARG1, ARG2, ARG3, ARG4, NOBJ, NPLACE, NREP, NINIT, + PARSTAT, DUAL, BADWORD, SYNTAX, XVERB, XOBJECT, + XPLACE, XVOBJ, INHAND, BRIEF, FAST, VARVAL, VARBIT, + LOOKING,BEEN,MOVED,WORD1,WORD2,OPCODE,SKIPFLAG,TRUTH,SEP, + NEGATE,PASSON, NVARS, + EXPLORE, SAYXX, LOGICMODE, LOGICALS, DOMODE, WORD3 COMMON /RECSTUFF/ REC, BP, SBUFF COMMON /CPTR/ BUFFP,OBJBP,OBJLP,OBJVP,PLABP,RPTR,VARBP,VARVP COMMON /CALLC/ CALLBP,CALLDO,CALLRE,CALLSK COMMON /DOC/ DOPOIN,DOVAR COMMON /INPL/ SLINE,LINEE,LINEX2 EQUIVALENCE (ARGWORDS(1), ARG1) EQUIVALENCE (TEMP,TEMP1),(TEMP(3),TEMP2),(TEMP(5),TEMP3) EQUIVALENCE (TEMP(7),TEMP4),(TEMP(9),TEMP5) PARSE=.FALSE. DO 10 TEMP1=LINEX2,LINEE 10 IF (SLINE(TEMP1) .NE. ' ') GOTO 15 PARSE=.TRUE. RETURN 15 DO 20 TEMP2=TEMP1,LINEE + 1 SEP = SLINE(TEMP2) 20 IF (SEP .EQ. ' ' .OR. SEP .EQ. ',') GOTO 25 TEMP2 = LINEE + 1 25 CALL SCOPY(SLINE(TEMP1),LEX,MIN0(6,TEMP2-TEMP1)) LINEX2 = TEMP2 RETURN END