	SUBROUTINE A5TOA1(A,B,C,CHARS,LENG)

C
C  IN ORDER TO WORK ON A PDP-11, THIS HAS BEEN CHANGED TO BE
C  AN A4 TO A1 CONVERSION ROUTINE.
C  A AND B CONTAIN A 1- TO 8-CHARACTER WORD IN A4 FORMAT, C CONTAINS ANOTHER
C  WORD AND/OR PUNCTUATION.  THEY ARE UNPACKED TO ONE CHARACTER PER WORD IN THE
C  ARRAY "CHARS", WITH EXACTLY ONE BLANK BETWEEN B AND C (OR NONE, IF C 'S 100
C  BIT IS OFF).
C  THE INDEX OF THE LAST NON-BLANK CHAR IN CHARS IS RETURNED IN LENG.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ASCVAR
	DIMENSION CHARS(20),WORDS(3)
	DATA BLANK/' '/
	NOPUN = 0
C
C	NOPUN = 0 MEANS THAT WE DO NOT HAVE A PUNCTUATION CHARACTER.
C	NOPUN = -1 MEANS THAT WE DO HAVE A PUNCTUATION CHARACTER.
C
	IF(C.AND."100.NE."100) NOPUN=-1

	WORDS(1)=A
	WORDS(2)=B
	WORDS(3)=C
	POSN=1
	DO 1 WORD=1,3
	MASK = "377
	JUST = 1
	IF(WORD.EQ.2.AND.POSN.NE.5)GOTO 1
	IF(WORD.EQ.3.AND.NOPUN.EQ.-1)POSN=POSN+1
	DO 2 CH=1,4
	CHARS(POSN)=(((WORDS(WORD).AND.MASK)/JUST)+"4010020000)
	IF(CHARS(POSN).EQ.BLANK)GOTO 1
	LENG=POSN
	MASK = MASK * "400
	JUST = JUST * "400
2	POSN=POSN+1
1	CONTINUE
	RETURN
	END

C  DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP)


	INTEGER*4 FUNCTION VOCAB(ID,INIT)

C  LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS "DEFINITION" (KTAB), OR
C  -1 IF NOT FOUND.  IF INIT IS POSITIVE, THIS IS AN INITIALISATION CALL SETTING
C  UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG.  IT ALSO MEANS
C  THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED.
C  (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED
C  AS AN OBJECT.)  AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 KTAB,ASCVAR
	COMMON /VOCCOM/ KTAB,ATAB,TABSIZ
	DIMENSION KTAB(300),ATAB(300)

	HASH=ID
	DO 1 I=1,TABSIZ
	IF(KTAB(I).EQ.-1)GOTO 2
	IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1
	IF(ATAB(I).EQ.HASH)GOTO 3
1	CONTINUE
	CALL BUG(21)

2	VOCAB=-1
	IF(INIT.LT.0)RETURN
	TYPE 100,HASH
100	FORMAT(' KEYWORD = ',A4)
	CALL BUG(5)

3	VOCAB=KTAB(I)
	IF(INIT.GE.0)VOCAB=MOD(VOCAB,1000)
	RETURN
	END



	SUBROUTINE DSTROY(OBJECT)

C  PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A NON-EXISTENT LOCATION.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ASCVAR

	CALL MOVE(OBJECT,0)
	RETURN
	END



	SUBROUTINE JUGGLE(OBJECT)

C  JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURPOSE
C  BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ATLOC,LINK,PLACE,FIXED,ASCVAR
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

	I=PLACE(OBJECT)
	J=FIXED(OBJECT)
	CALL MOVE(OBJECT,I)
	CALL MOVE(OBJECT+100,J)
	RETURN
	END



	SUBROUTINE MOVE(OBJECT,WHERE)

C  PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT.  MAY ALREADY BE
C  TOTING, IN WHICH CASE THE CARRY IS A NO-OP.  MUSTN'T PICK UP OBJECTS WHICH
C  ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ATLOC,LINK,PLACE,FIXED,ASCVAR
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

	IF(OBJECT.GT.100)GOTO 1
	FROM=PLACE(OBJECT)
	GOTO 2
1	FROM=FIXED(OBJECT-100)
2	IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM)
	CALL DROP(OBJECT,WHERE)
	RETURN
	END



	INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL)

C  PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE
C  NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ASCVAR

	CALL MOVE(OBJECT,WHERE)
	PUT=(-1)-PVAL
	RETURN
	END



	SUBROUTINE CARRY(OBJECT,WHERE)

C  START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER
C  LOCATION.  INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED.  IF OBJECT>100
C  (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ATLOC,LINK,PLACE,FIXED,ASCVAR
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

	IF(OBJECT.GT.100)GOTO 5
	IF(PLACE(OBJECT).EQ.-1)RETURN
	PLACE(OBJECT)=-1
	HOLDNG=HOLDNG+1
5	IF(ATLOC(WHERE).NE.OBJECT)GOTO 6
	ATLOC(WHERE)=LINK(OBJECT)
	RETURN
6	TEMP=ATLOC(WHERE)
7	IF(LINK(TEMP).EQ.OBJECT)GOTO 8
	TEMP=LINK(TEMP)
	GOTO 7
8	LINK(TEMP)=LINK(OBJECT)
	RETURN
	END



	SUBROUTINE DROP(OBJECT,WHERE)

C  PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.  DECR
C  HOLDNG IF THE OBJECT WAS BEING TOTED.

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ATLOC,LINK,PLACE,FIXED,ASCVAR
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)
	
	IF(OBJECT.GT.100)GOTO 1
	IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1
	PLACE(OBJECT)=WHERE
	GOTO 2
1	FIXED(OBJECT-100)=WHERE
2	IF(WHERE.LE.0)RETURN
	LINK(OBJECT)=ATLOC(WHERE)
	ATLOC(WHERE)=OBJECT
	RETURN
	END

C  WIZARDRY ROUTINES (START, MAINT, WIZARD, HOURS(X), NEWHRS(X), MOTD, POOF)


	LOGICAL FUNCTION START(DUMMY)

C  CHECK TO SEE IF THIS IS "PRIME TIME".  IF SO, ONLY WIZARDS MAY PLAY, THOUGH
C  OTHERS MAY BE ALLOWED A SHORT GAME FOR DEMONSTRATION PURPOSES.  IF SETUP<0,
C  WE'RE CONTINUING FROM A SAVED GAME, SO CHECK FOR SUITABLE LATENCY.  RETURN
C  TRUE IF THIS IS A DEMO GAME (VALUE IS IGNORED FOR RESTARTS).

	IMPLICIT INTEGER*4(A-Z)
	LOGICAL PTIME,SOON,YESM
	DIMENSION HNAME(4)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

C  FIRST FIND OUT WHETHER IT IS PRIME TIME (SAVE IN PTIME) AND, IF RESTARTING,
C  WHETHER IT'S TOO SOON (SAVE IN SOON).  PRIME-TIME SPECS ARE IN WKDAY, WKEND,
C  AND HOLID; SEE MAINT ROUTINE FOR DETAILS.  LATNCY IS REQUIRED DELAY BEFORE
C  RESTARTING.  WIZARDS MAY CUT THIS TO A THIRD.

	CALL DATIME(D,T)
	PRIMTM=WKDAY
	IF(MOD(D,7).LE.1)PRIMTM=WKEND
	IF(D.GE.HBEGIN.AND.D.LE.HEND)PRIMTM=HOLID
	PTIME=(PRIMTM.AND.SHIFT(1,T/60)).NE.0
	SOON=.FALSE.
	IF(SETUP.GE.0)GOTO 20
	DELAY=(D-SAVED)*1440+(T-SAVET)
	IF(DELAY.GE.LATNCY)GOTO 20
	TYPE 10,DELAY
10	FORMAT(' THIS ADVENTURE WAS SUSPENDED A MERE',I3,' MINUTES AGO.')
	SOON=.TRUE.
	IF(DELAY.GE.LATNCY/3)GOTO 20
	CALL MSPEAK(2)
	STOP

C  IF NEITHER TOO SOON NOR PRIME TIME, NO PROBLEM.  ELSE SPECIFY WHAT'S WRONG.

20	START=.FALSE.
	IF(SOON)GOTO 30
	IF(PTIME)GOTO 25
22	SAVED=-1
	RETURN

C  COME HERE IF NOT RESTARTING TOO SOON (MAYBE NOT RESTARTING AT ALL), BUT IT'S
C  PRIME TIME.  GIVE OUR HOURS AND SEE IF HE'S A WIZARD.  IF NOT, THEN CAN'T
C  RESTART, BUT IF JUST BEGINNING THEN WE CAN OFFER A SHORT GAME.

25	CALL MSPEAK(3)
	CALL HOURS
	CALL MSPEAK(4)
	IF(WIZARD(0))GOTO 22
	IF(SETUP.LT.0)GOTO 33
	START=YESM(5,7,7)
	IF(START)GOTO 22
	STOP 

C  COME HERE IF RESTARTING TOO SOON.  IF HE'S A WIZARD, LET HIM GO (AND NOTE
C  THAT IT THEN DOESN'T MATTER WHETHER IT'S PRIME TIME).  ELSE, TOUGH BEANS.

30	CALL MSPEAK(8)
	IF(WIZARD(0))GOTO 22
33	CALL MSPEAK(9)
	STOP
	END



	SUBROUTINE MAINT

C  SOMEONE SAID THE MAGIC WORD TO INVOKE MAINTENANCE MODE.  MAKE SURE HE'S A
C  WIZARD.  IF SO, LET HIM TWEAK ALL SORTS OF RANDOM THINGS, THEN EXIT SO CAN
C  SAVE TWEAKED VERSION.  SINCE MAGIC WORD MUST BE FIRST COMMAND GIVEN, ONLY
C  THING WHICH NEEDS TO BE FIXED UP IS ABB(1).

	IMPLICIT INTEGER*4(A-Z)
C	INTEGER*2 ABB
	LOGICAL YESM,BLKLIN
	DIMENSION HNAME(4),ABB(150)
	COMMON /BLKCOM/ BLKLIN
	COMMON /ABBCOM/ ABB
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

	IF(.NOT.WIZARD(0))RETURN
	BLKLIN=.FALSE.
	IF(YESM(10,0,0))CALL HOURS
	IF(YESM(11,0,0))CALL NEWHRS
	IF(.NOT.YESM(26,0,0))GOTO 10
	CALL MSPEAK(27)
	ACCEPT 1,HBEGIN
1	FORMAT(G)
	CALL MSPEAK(28)
	ACCEPT 1,HEND
	CALL DATIME(D,T)
	HBEGIN=HBEGIN+D
	HEND=HBEGIN+HEND-1
	CALL MSPEAK(29)
	ACCEPT 2,HNAME
2	FORMAT(4A4)
10	TYPE 12,SHORT
12	FORMAT(' LENGTH OF SHORT GAME (NULL TO LEAVE AT',I3,'):')
	ACCEPT 1,X
	IF(X.GT.0)SHORT=X
	CALL MSPEAK(12)
	CALL GETIN(X,Y,Y,Y)
	IF(X.NE.' ')MAGIC=X
	CALL MSPEAK(13)
	ACCEPT 1,X
	IF(X.GT.0)MAGNM=X
	TYPE 16,LATNCY
16	FORMAT(' LATENCY FOR RESTART (NULL TO LEAVE AT',I3,'):')
	ACCEPT 1,X
	IF(X.GT.0.AND.X.LT.45)CALL MSPEAK(30)
	IF(X.GT.0)LATNCY=MAX0(45,X)
	IF(YESM(14,0,0))CALL MOTD(.TRUE.)
	SAVED=0
	SETUP=2
	ABB(1)=0
	CALL MSPEAK(15)
	BLKLIN=.TRUE.
	CALL CIAO
	END



	LOGICAL FUNCTION WIZARD(DUMMY)

C  ASK IF HE'S A WIZARD.  IF HE SAYS YES, MAKE HIM PROVE IT.  RETURN TRUE IF HE
C  REALLY IS A WIZARD.

	IMPLICIT INTEGER*4(A-Z)
	LOGICAL YESM
	DIMENSION HNAME(4),VAL(5)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

	WIZARD=YESM(16,0,7)
	IF(.NOT.WIZARD)RETURN

C  HE SAYS HE IS.  FIRST STEP: DOES HE KNOW ANYTHING MAGICAL?

	CALL MSPEAK(17)
	CALL GETIN(WORD,X,Y,Z)
	IF(WORD.NE.MAGIC)GOTO 99
C
C	FOR NOW, IF THE PERSON KNOWS 'DWAR' LET HIM BE A WIZARD.
C
	GO TO 100

C  HE DOES.  GIVE HIM A RANDOM CHALLENGE AND CHECK HIS REPLY.

	CALL DATIME(D,T)
	T=T*2+1
	WORD='@@@@@'
	DO 15 Y=1,5
	X=79+MOD(D,5)
	D=D/5
	DO 12 Z=1,X
12	T=MOD(T*1027,1048576)
	VAL(Y)=(T*26)/1048576+1
15	WORD=WORD+SHIFT(VAL(Y),36-7*Y)
	IF(YESM(18,0,0))GOTO 99
	TYPE 18,WORD
18	FORMAT(/1X,A5)
	CALL GETIN(WORD,X,Y,Z)
	CALL DATIME(D,T)
	T=(T/60)*40+(T/10)*10
	D=MAGNM
	DO 19 Y=1,5
	Z=MOD(Y,5)+1
	X=MOD(IABS(VAL(Y)-VAL(Z))*MOD(D,10)+MOD(T,10),26)+1
	T=T/10
	D=D/10
19	WORD=WORD-SHIFT(X,36-7*Y)
	IF(WORD.NE.'@@@@@')GOTO 99

C  BY GEORGE, HE REALLY *IS* A WIZARD!

100	CALL MSPEAK(19)
	RETURN

C  AHA!  AN IMPOSTOR!

99	CALL MSPEAK(20)
	WIZARD=.FALSE.
	RETURN
	END



	SUBROUTINE HOURS

C  ANNOUNCE THE CURRENT HOURS WHEN THE CAVE IS OPEN FOR ADVENTURING.  THIS INFO
C  IS STORED IN WKDAY, WKEND, AND HOLID, WHERE BIT SHIFT(1,N) IS ON IF THE
C  HOUR FROM N:00 TO N:59 IS "PRIME TIME" (CAVE CLOSED).  WKDAY IS FOR
C  WEEKDAYS, WKEND FOR WEEKENDS, HOLID FOR HOLIDAYS.  NEXT HOLIDAY IS FROM
C  HBEGIN TO HEND.

	IMPLICIT INTEGER*4(A-Z)
	DIMENSION HNAME(4),VAL(5)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME

	TYPE 1
1	FORMAT()
	CALL HOURSX(WKDAY,'MON-','FRI:')
	CALL HOURSX(WKEND,'SAT-','SUN:')
	CALL HOURSX(HOLID,'HOLI','DAYS')
	CALL DATIME(D,T)
	IF(HEND.LT.D.OR.HEND.LT.HBEGIN)RETURN
	IF(HBEGIN.GT.D)GOTO 10
	TYPE 5,HNAME
5	FORMAT(/' TODAY IS A HOLIDAY, NAMELY ',4A4)
	RETURN

10	D=HBEGIN-D
	T='DAYS'
	IF(D.EQ.1)T='DAY '
	TYPE 15,D,T,HNAME
15	FORMAT(/' THE NEXT HOLIDAY WILL BE IN',I3,' ',A4,', NAMELY ',4A4)
	RETURN
	END



	SUBROUTINE HOURSX(H,DAY1,DAY2)

C  USED BY HOURS (ABOVE) TO PRINT HOURS FOR EITHER WEEKDAYS OR WEEKENDS.

	IMPLICIT INTEGER*4(A-Z)
	LOGICAL FIRST

	FIRST=.TRUE.
	FROM=-1
	IF(H.NE.0)GOTO 10
	TYPE 2,DAY1,DAY2
2	FORMAT(10X,2A4,'  OPEN ALL DAY')
	RETURN

10	FROM=FROM+1
	IF((H.AND.SHIFT(1,FROM)).NE.0)GOTO 10
	IF(FROM.GE.24)GOTO 20
	TILL=FROM
14	TILL=TILL+1
	IF((H.AND.SHIFT(1,TILL)).EQ.0.AND.TILL.NE.24)GOTO 14
	IF(FIRST)TYPE 16,DAY1,DAY2,FROM,TILL
	IF(.NOT.FIRST)TYPE 18,FROM,TILL
16	FORMAT(10X,2A4,I4,':00 TO',I3,':00')
18	FORMAT(20X,I4,':00 TO',I3,':00')
	FIRST=.FALSE.
	FROM=TILL
	GOTO 10

20	IF(FIRST)TYPE 22,DAY1,DAY2
22	FORMAT(10X,2A4,'  CLOSED ALL DAY')
	RETURN
	END



	SUBROUTINE NEWHRS

C  SET UP NEW HOURS FOR THE CAVE.  SPECIFIED AS INVERSE--I.E., WHEN IS IT
C  CLOSED DUE TO PRIME TIME?  SEE HOURS (ABOVE) FOR DESC OF VARIABLES.

	IMPLICIT INTEGER*4(A-Z)
	DIMENSION HNAME(4)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME

	CALL MSPEAK(21)
	WKDAY=NEWHRX('WEEK','DAYS')
	WKEND=NEWHRX('WEEK','ENDS')
	HOLID=NEWHRX('HOLI','DAYS')
	CALL MSPEAK(22)
	CALL HOURS
	RETURN
	END



	INTEGER FUNCTION NEWHRX(DAY1,DAY2)

C  INPUT PRIME TIME SPECS AND SET UP A WORD OF INTERNAL FORMAT.

	IMPLICIT INTEGER*4(A-Z)

	NEWHRX=0
	TYPE 1,DAY1,DAY2
1	FORMAT(' PRIME TIME ON ',2A4)
10	TYPE 2
2	FORMAT(' FROM:')
	ACCEPT 3,FROM
3	FORMAT(G)
	IF(FROM.LT.0.OR.FROM.GE.24)RETURN
	TYPE 4
4	FORMAT(' TILL:')
	ACCEPT 3,TILL
	TILL=TILL-1
	IF(TILL.LT.FROM.OR.TILL.GE.24)RETURN
	DO 5 I=FROM,TILL
5	NEWHRX=(NEWHRX.OR.SHIFT(1,I))
	GOTO 10
	END



	SUBROUTINE MOTD(ALTER)

C  HANDLES MESSAGE OF THE DAY.  IF ALTER IS TRUE, READ A NEW MESSAGE FROM THE
C  WIZARD.  ELSE PRINT THE CURRENT ONE.  MESSAGE IS INITIALLY NULL.

C
C  CHANGED TO SIMPLY RETURN.
C
	IMPLICIT INTEGER*4(A-Z)
	LOGICAL ALTER

	RETURN
	END



	SUBROUTINE POOF

C  AS PART OF DATABASE INITIALISATION, WE CALL POOF TO SET UP SOME DUMMY
C  PRIME-TIME SPECS, MAGIC WORDS, ETC.

	IMPLICIT INTEGER*4(A-Z)
	DIMENSION HNAME(4)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

	WKDAY="00777400
	WKEND=0
	HOLID=0
	HBEGIN=0
	HEND=-1
	SHORT=30
	MAGIC='DWAR'
	MAGNM=11111
	LATNCY=90
	RETURN
	END

C  UTILITY ROUTINES (SHIFT, RAN, DATIME, CIAO, BUG)


	INTEGER FUNCTION SHIFT(VAL,DIST)
	IMPLICIT INTEGER*4(A-Z)

C  RETURN VAL LEFT-SHIFTED (LOGICALLY) DIST BITS (RIGHT-SHIFT IF DIST<0).

	SHIFT=VAL
	IF(DIST)10,20,30
10	IDIST=-DIST
	DO 11 I=1,IDIST
	J=0
	IF(SHIFT.LT.0)J="10000000000
11	SHIFT=((SHIFT.AND."17777777777)/2)+J
20	RETURN
30	SHIFT = ISHFT(VAL,DIST)
	RETURN
	END



	INTEGER FUNCTION RAN(RANGE)

C  SINCE THE RAN FUNCTION IN LIB40 SEEMS TO BE A REAL LOSE, WE'LL USE ONE OF
C  OUR OWN.  IT'S BEEN RUN THROUGH MANY OF THE TESTS IN KNUTH VOL. 2 AND
C  SEEMS TO BE QUITE RELIABLE.  RAN RETURNS A VALUE UNIFORMLY SELECTED
C  BETWEEN 0 AND RANGE-1.  NOTE RESEMBLANCE TO ALG USED IN WIZARD.

	IMPLICIT INTEGER*4(A-Z)
	DATA R/0/

	D=1
	IF(R.NE.0)GOTO 1
	CALL DATIME(D,T)
	R=18*T+5
	D=1000+MOD(D,1000)
1	DO 2 T=1,D
2	R=MOD(R*1021,1048576)
	RAN=(RANGE*R)/1048576
	RETURN
	END



	SUBROUTINE DATIME(D,T)

C  RETURN THE DATE AND TIME IN D AND T.  D IS NUMBER OF DAYS SINCE 01-JAN-77,
C  T IS MINUTES PAST MIDNIGHT.

	IMPLICIT INTEGER*2(A-Z)
	INTEGER*2 X,YEAR
	INTEGER*4 D,T
	REAL XX
	DIMENSION DAT(2),MONTHS(12),HATH(12)
	DATA MONTHS/1,2,3,4,5,6,7,8,9,10,11,12/
	DATA HATH/31,28,31,30,31,30,31,31,30,31,30,31/


	CALL IDATE(X,ID,YEAR)
	XX = SECNDS(0.0) / 60.
	D = ID
	T=XX

	DO 1 MON=1,12
	IF(X.EQ.MONTHS(MON))GOTO 2
1	D=D+HATH(MON)
	CALL BUG(28)

2	D=D+YEAR*365+YEAR/4
	IF(MOD(YEAR,4).EQ.3.AND.MON.GT.2)D=D+1
	RETURN
	END



	SUBROUTINE CIAO

C  EXITS, AFTER ISSUING REMINDER TO SAVE NEW CORE IMAGE.  USED WHEN SUSPENDING
C  AND WHEN CREATING NEW VERSION VIA MAGIC MODE.  ON SOME SYSTEMS, THE CORE
C  IMAGE IS LOST ONCE THE PROGRAM EXITS.  IF SO, SET K=31 INSTEAD OF 32.

	IMPLICIT INTEGER*4(A-Z)
	DATA K/31/

	CALL MSPEAK(K)
	IF(K.EQ.31)CALL GETIN(A,B,C,D)
	STOP
	END



	SUBROUTINE BUG(NUM)
	IMPLICIT INTEGER*4(A-Z)

C  THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS.  NUMBERS < 20
C  ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME".
C	0	MESSAGE LINE > 70 CHARACTERS
C	1	NULL LINE IN MESSAGE
C	2	TOO MANY WORDS OF MESSAGES
C	3	TOO MANY TRAVEL OPTIONS
C	4	TOO MANY VOCABULARY WORDS
C	5	REQUIRED VOCABULARY WORD NOT FOUND
C	6	TOO MANY RTEXT OR MTEXT MESSAGES
C	7	TOO MANY HINTS
C	8	LOCATION HAS COND BIT BEING SET TWICE
C	9	INVALID SECTION NUMBER IN DATABASE
C	20	SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST
C	21	RAN OFF END OF VOCABULARY TABLE
C	22	VOCABULARY TYPE (N/1000) NOT BETWEEN 0 AND 3
C	23	INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST
C	24	TRANSITIVE ACTION VERB EXCEEDS GOTO LIST
C	25	CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE
C	26	LOCATION HAS NO TRAVEL ENTRIES
C	27	HINT NUMBER EXCEEDS GOTO LIST
C	28	INVALID MONTH RETURNED BY DATE FUNCTION

	TYPE 1, NUM
1	FORMAT (' FATAL ERROR, SEE SOURCE CODE FOR INTERPRETATION.'/
	1	' PROBABLY CAUSE: ERRONEOUS INFO IN DATABASE.'/
	2	' ERROR CODE =',I2/)
	STOP
	END
