Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-07 - decus/20-0161/file.mac
There are no other files named file.mac in the archive.
;<HURLEY.2>FILE.MAC.179, 12-Dec-80 09:00:26, EDIT BY HURLEY

VMAJOR==1			;MAJOR VERSION NUMBER
VMINOR==0			;MINOR
VEDIT==7			;EDIT NUMBER
VWHO==0				;CUSTOMER EDIT

	TITLE FILE - COMPUTERIZED FILING SYSTEM FOR HARDCOPY DOCUMENTS
	SUBTTL PETER M. HURLEY,  JULY 18, 1979

	SEARCH MONSYM,MACSYM,PARUNV
	EXTERNAL PARSE
	.REQUIRE PARSE
	.REQUIRE SYS:MACREL

	SALL

VFILE==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT

	T1=1
	T2=2
	T3=3
	T4=4
	Q1=5
	Q2=6
	Q3=7
	P1=10
	P2=11
	P3=12
	P4=13
	P5=14
	P6=15
	CX=16
	P=17



;RANDOM VARIABLES

	MAXSTW==400		;MAXIMUM NUMBER OF WORDS IN A KEYWORD
DEFINE ERRMES (TEXT) <
	JSP [	HRROI T1,[ASCIZ\? TEXT\]
		PSOUT
		HALTF
		JRST FILE]>

DEFINE WARN (INST,TEXT) <
	JSP CX,[HRROI T1,[ASCIZ\
% TEXT
\]
		PSOUT
IFNB <INST>,<	INST>
		JRST .+1]>

DEFINE TYPE (AC,TEXT) <
	CALL [	MOVE CX,[[ASCIZ\TEXT\],,AC]
		CALLRET TYPRTN]>

DEFINE CHKTYP (TYP) <
	CAIE T1,.CM'TYP
	ERRMES (<UNEXPECTED TYPE CODE RETURNED FROM "PARSE">)>

DEFINE RETBAD (A,B) <
IFB <B>,<
IFB <A>,<	RET>
IFNB <A>,<	JRST [	MOVEI T1,A
			RET]>>
IFNB <B>,<	JRST [	B
			RETBAD (A)]>>


DEFINE PION <
	CALL PION.>

DEFINE PIOFF <
	CALL PIOFF.>

DEFINE LOCK (A) <>		;LOCK MACRO IS A NOP

DEFINE UNLOCK (A) <>

DEFINE SAVEQ <
	JSP CX,SAVQ>

DEFINE SAVEPQ <
	JSP CX,SAVPQ>

DEFINE SAVET <
	JSP CX,SAVT>

DEFINE SAVEP <
	JSP CX,SAVP>

;STORAGE

;PAGE 0 OF THE DATA BASE FILE

	DBVERW==1		;WHERE TO STORE VERSION NUMBER OF DATA BASE
	DBVER==1		;VERSION OF DATA BASE

	FREFFW==2		;FIRST FREE WORD IN FREE POOL
	FREMAX==3		;END OF FREE POOL 
	FRELST==4		;POINTER TO NEXT BLOCK ON FREE LIST

	KEYPTR==10		;POINTER TO FIRST PAGE IN KEYWORD HASH TABLE
	KEYLEN==11		;NUMBER OF PAGES IN KEYWORD HASH TABLE
	AUTPTR==12		;PAGE NUMBER OF FIRST PAGE IN AUTHOR HASH TABLE
	AUTLEN==13		;NUMBER OF PAGES IN AUTHOR HASH TABLE
	DOCPTR==14		;POINTER TO 1ST PAGE IN DOCUMENT INDEX TABLE
	DOCLEN==15		;# OF PAGES IN DOCUMENT INDEX TABLE
	NXTDOC==16		;NEXT DOCUMENT NUMBER TO USE (-1)
	FREPTR==17		;POINTER TO 1ST PAGE IN FREE POOL
	FRELEN==20		;# OF PAGES IN FREE POOL

;DATA BASE FILE LAYOUT

	NRESPG==1		;# OF PAGES IN FIRST SECTION OF FILE

	NKEYPG==4		;# OF KEYWORD HASH TABLE PAGES
	KEYPAG==0+NRESPG	;FIRST PAGE OF KEYWORD HASH TABLE

	NAUTPG==4		;# OF PAGES IN THE AUTHOR HASH TABLE
	AUTPAG==KEYPAG+NKEYPG	;FIRST PAGE OF AUTHOR HASH TABLE

	NDOCPG==10000		;# OF PAGES IN DOCUMENT INDEX TABLE
	DOCPAG==AUTPAG+NAUTPG	;FIRST PAGE OF DOCUMENT INDEX TABLE

	NFREPG==200000		;# OF PAGES IN THE FREE POOL
	FREPAG==DOCPAG+NDOCPG	;FIRST PAGE IN FREE POOL

	NFILPG==NRESPG+NKEYPG+NAUTPG+NDOCPG+NFREPG
;CORE LAYOUT

	DBPAG0==100		;WHERE TO MAP THE FIRST FEW DATA BASE PAGES
	MAXDB0==40		;MAX NUMBER OF PAGES IN FIRST PART OF FILE
	IFL <MAXDB0-NRESPG-NKEYPG-NAUTPG>,<PRINTX ? MAPPED AREA IS OVERLAPPED>

	NCORPG==300		;NUMBER OF PAGES TO USE FOR MAPPING INTO
	DCORPG==1		;DEBUG VALUE FOR NCORPG
	CORPAG==MAXDB0+DBPAG0	;START MAPPING AT THIS PAGE

	PGTABL==NFILPG		;LENGTH OF PAGE MAP TABLE
	NPGTBP==<PGTABL+777>/1000 ;NUMBER OF PAGES IN PAGTAB
	PAGTAB==<CORPAG+NCORPG>	;START OF THE PAGE MAP TABLE
	PAGTBA==PAGTAB_11	;ADR OF START OF PAGTAB

	IFLE <770-PAGTAB-NPGTBP>,<PRINTX ? RAN OUT OF STORAGE SPACE>


;LOCAL PROGRAM STORAGE ASSIGNMENTS

DEFINE ASG (NAM,LEN) <
	NAM=ASGVAL
	ASGVAL==ASGVAL+LEN>

	ASGVAL==20000

	PDLEN==4000+4*MAXSTW
ASG PDL,PDLEN			;PUSH DOWN LIST

	ASGVAL==<ASGVAL+777>/1000*1000
ZERPAG==ASGVAL_-11		;START OF ARE TO ZERO AT RESTART TIME

ASG CORPGN,1			;COUNT OF PAGES TO USE (USUALLY SET TO NCORPG)
ASG CORNXT,1			;NEXT CORE PAGE TO MAP INTO
ASG CORTAB,NCORPG		;CORE MAPPING TABLE

ASG COLUMN,1			;TERMINAL COLUMN NUMBER
ASG DBJFN,1			;DATA BASE JFN
ASG TLJFN,1			;TRANSACTION LOG JFN
ASG TRAFLG,1			;FLAG FOR FIRST TRANSACTION WRITE
ASG ENQLCK,1			;LOCK WORD USED BY ENQJFN/DEQJFN

	DOCTBL==2000		;LENGTH OF DOC LIST
ASG DOCTAB,DOCTBL		;TABLE TO COLLECT DOC #'S WHEN SEARCHING
ASG VALTAB,DOCTBL		;PARALLEL TABLE OF VALUES
ASG NUMTAB,DOCTBL		;NUMBER OF TIMES THIS DOC WAS FOUND

ASG TITLE,1			;DOC TITLE
ASG AUTHOR,1			;DOC AUTHOR
ASG PDM,1			;PDM
ASG KEYWRD,1			;KEYWORD
ASG TDATE,1			;TO DATE
ASG FDATE,1			;FROM DATE
ASG DATE,1			;DATE
ASG LOCATN,1			;LOCATION
ASG FILNAM,1			;FILE NAME

	GTJBLN==16
ASG GTJBLK,GTJBLN		;BLOCK FOR LONG FORM GTJFN

	STRNGL==MAXSTW		;STRING TO HOLD DESCRIPTIONS
	STRNGC==STRNGL*5-1	;NUMBER OF CHARACTERS IN STRING
ASG STRING,STRNGL

	ANSWRL==20*MAXSTW
ASG ANSWER,ANSWRL		;BLOCK TO RECEIVE PARSED COMMANDS
ASG CMDBUF,STRNGL+ANSWRL	;BLOCK TO HOLD THE COMMAND TEXT
ASG CMDPTR,1			;POINTER TO WHERE TO STORE THE COMMAND

ZEREND==ASGVAL			;END OF AREA TO BE ZEROED
NZERPG==<ZEREND+777>/1000-ZERPAG

IFLE <DBPAG0_11-ASGVAL>,<PRINTX ? RAN OUT OF STORAGE SPACE>
	RELOC
;DATA BASE DATA STRUCTURES

;LIST BLOCK

	LSTSIZ==13		;LENGTH OF LIST BLOCK
DEFSTR (LSTPTR,0,35,36)		;POINTER TO THE NEXT BLOCK IN LIST
DEFSTR (HSHPTR,1,35,36)		;POINTER TO NEXT HASH BLOCK
DEFSTR (ASCPTR,2,35,36)		;POINTER TO THE ASCIZ STRING
	LST1WD==3		;FIRST DATA WORD IN LIST BLOCK
	LSTNWD==LSTSIZ-LST1WD	;NUMBER OF DATA WORDS IN THE BLOCK


;DOCUMENT BLOCK

	DOCSIZ==17		;LENGTH OF DOCUMENT BLOCK
DEFSTR (DOCNUM,0,35,36)		;DOCUMENT NUMBER
DEFSTR (DOCLNK,1,35,36)		;POINTER TO ADDITIONAL DATA BLOCKS (IF ANY)
DEFSTR (DOCSTS,2,35,36)		;STATUS WORD
	DS%DEL==1B0		;DELETED
	DS%OTD==1B1		;OUT DATED
    MSKSTR (DSDEL,2,DS%DEL)
DEFSTR (DOCDAT,3,35,36)		;DATE OF DOCUMENT
DEFSTR (DOCTTL,6,35,36)		;TITLE OF DOCUMENT
DEFSTR (DOCPDM,7,35,36)		;PDM
DEFSTR (DOCAUT,10,35,36)	;AUTHOR LIST
DEFSTR (DOCKEY,11,35,36)	;KEYWORD LIST
DEFSTR (DOCLOC,12,35,36)	;LOCATION
DEFSTR (DOCFIL,13,35,36)	;FILE NAME


;STRING LIST BLOCK

	STRSIZ==4		;LENGTH OF A STRING LIST BLOCK
DEFSTR (STRPTR,0,35,36)		;POINTER TO NEXT STRING BLOCK IN LIST
	STR1WD==1		;FIRST DATA WORD IN BLOCK
	STRNWD==STRSIZ-STR1WD	;NUMBER OF DATA WORDS IN BLOCK
;FREE BLOCK HEADER

DEFSTR (BLKTYP,0,8,9)		;TYPE OF BLOCK
DEFSTR (BLKVER,0,17,9)		;VERSION OF BLOCK
DEFSTR (BLKLEN,0,35,18)		;LENGTH OF BLOCK
DEFSTR (BLKLNK,1,35,36)		;LINK TO NEXT BLOCK ON FREE LIST
				;(ONLY USED WHEN BLOCK IS RELEASED

	BLKHDL==1		;LENGTH OF HEADER
				;DOES NOT INCLUDE "BLKLNK"

	TYPLST==1		;LIST BLOCK TYPE
	TYPDOC==2		;DOCUMENT BLOCK TYPE
	TYPSTB==3		;STRING BLOCK TYPE
	TYPASC==4		;ASCIZ BLOCK TYPE

	VERLST==1		;LIST BLOCK VERSION
	VERDOC==1		;DOC BLOCK VERSION
	VERSTR==1		;STRING BLOCK VERSION
	VERASC==1		;ASCIZ BLOCK VERSION

;ENTRY VECTOR

ENTVEC:	JRST FILE		;START ADR
	JRST REENT		;REENTER
	VFILE			;VERSION NUMBER

;MAIN ROUTINE

REENT:
FILE:	MOVE P,[IOWD PDLEN,PDL]	;INIT THE PUSH DOWN STACK POINTER
	CALL UNMAP
	RESET			;RESET THE WORLD
	SETO T1,		;UNMAP ALL TEMP STORAGE
	HRLI T2,.FHSLF
	HRRI T2,ZERPAG		;START AT FIRST PAGE TO ZERO
	MOVE T3,[PM%CNT!NZERPG]
	PMAP			;UNMAP THE WORK SPACE

;OPEN THE DATA BASE FILE

	HRROI T1,[ASCIZ/NAME OF DATA BASE FILE: /]
	CALL OPNFIL		;OPEN THE DATA BASE FILE
	 JRST [	CALL ERRTYP	;TYPE OUT THE ERROR
		JRST FILE]
	MOVEM T1,DBJFN		;SAVE THE JFN OF TE DATA BASE FILE
	MOVEM T2,TLJFN		;SAVE THE JFN OF THE TRANSACTION LOG
	MOVEI T1,NCORPG		;GET NUMBER OF PAGES TO MAP
	MOVEM T1,CORPGN		;INIT VARIABLE
	SETOM ENQLCK		;INIT THE ENQ FLAG
	JRST LEVEL0

;ENTRY POINT TO UPDATE THE TRANSACTION LOG AND THE DATA BASE

LOGLV0:	CALL UPDDB		;GO UPDATE THE DATA BASE
	JRST LEVEL0
;PARSE THE LEVEL 0 COMMAND

LEVEL0:	MOVE T1,DBJFN		;GET JFN OF DATA BASE
	CALL DEQJFN		;UNLOCK THE DATA BASE
	CALL INITRA		;INIT TRANSACTION AREA
	HRROI T1,[ASCIZ/

/]
	CALL COPCMD		;INITIALIZE EACH LINE WITH A CRLF
	HRROI T1,[ASCIZ/FILE> /]
	MOVEI T2,LEV0CT		;GET ADR OF LEVEL 0 COMMAND TABLE
	MOVEI T3,ANSWER		;GET ADR OF ANSWER BLOCK
	CALL PARSE		;GO PARSE THIS COMMAND
	 ERRMES <ILLEGALLY FORMATTED COMMAND TABLE (LEVEL 1)>
	CALL COPCMD		;COPY THIS COMMAND TO THE BUFFER
	MOVEI P1,ANSWER		;SET UP A POINTER TO THE PARSED COMMAND
	HLRZ T1,(P1)		;GET THE FIRST FUNCTION CODE
	CAIE T1,.CMKEY		;MUST BE A KEY WORD
	ERRMES <UNKNOWN TYPE CODE RECEIVED FROM "PARSE">
	MOVE T1,DBJFN		;LOCK THE DATA BASE
	CALL ENQJFN
	HRRZ T1,(P1)		;GET DISPATCH ADR
	AOJA P1,(T1)		;DISPATCH
;THE CHECK-DATABASE COMMAND

CHKCMD:	HLRZ T1,(P1)		;GET TYPE CODE
	CHKTYP (CFM)
	SETZ Q1,		;INIT COUNT
	CALL CHKKEY		;CHECK THE KEYWORD TABLE
	 AOS Q1			;FAILED
	CALL CHKAUT		;CHECK THE AUTHOR TABLE
	 AOS Q1			;FAILED
	CALL CHKDB		;CHECK DOC BLOCKS
	 AOS Q1			;FAILED
	SKIPG Q1		;ANY FAILURES?
	JRST LEVEL0		;NO
	WARN (,<DATABASE NEEDS REBUILDING>)
	JRST LEVEL0
;ROUTINE TO CHECK THE KEYWORD TABLE AND AUTHOR TABLE

CHKKEY:	TDZA T4,T4		;INDICATE KEYWORD
CHKAUT:	MOVEI T4,1		;AUTHOR
	SAVEPQ
	MOVE P4,T4		;SAVE FLAG
	MOVEI T4,DBPAG0_11
	XCT [	MOVE Q1,KEYPTR(T4) ;GET POINTER TO TABLE
		MOVE Q1,AUTPTR(T4)](P4)
	XCT [	MOVE Q2,KEYLEN(T4) ;GET LENGTH OF TABLE
		MOVE Q2,AUTLEN(T4)](P4)
CHKAU1:	MOVE T1,Q1		;GET TABLE ADR
	CALL MAPBLK		;MAP THE NEXT WORD
	SKIPN T1,(T1)		;AN ENTRY HERE?
	JRST CHKAU2		;NO
	CALL CHKLST		;YES, GO CHECK IT
	 RET			;FAILED
CHKAU2:	AOS Q1			;STEP TO NEXT WORD IN TABLE
	SOJG Q2,CHKAU1		;LOOP BACK TIL DONE
	RETSKP
;ROUTINE TO CHECK A LIST BLOCK
;ACCEPTS IN T1/	ADR OF FIRST LIST BLOCK
;	CALL CHKLST
;RETURNS +1:	NO GOOD
;	 +2:	OK

CHKLST:	SAVEPQ
	MOVE Q1,T1		;SAVE ADR
CHKLS1:	MOVE T1,Q1		;CHECK THE BLOCK
	MOVEI T2,TYPLST		;LIST BLOCK?
	CALL CHKBLK
	 RET			;NO
	MOVE Q2,Q1
CHKLS2:	MOVE T1,Q2		;GET BLOCK ADR
	CALL MAPBLK		;MAP IT
	LOAD T1,ASCPTR,(T1)	;GET ADR OF STRING BLOCK
	MOVEI T2,TYPASC		;CHECK IT
	CALL CHKBLK
	 RET
	MOVE T1,Q2		;GET BLOCK AGAIN
	CALL MAPBLK		;MAP IT 
	LOAD Q2,LSTPTR,(T1)	;STEP DOWN THE LIST
	MOVE T1,Q2		;CHECK THIS BLOCK
	MOVEI T2,TYPLST
	CALL CHKBLK
	 RET
	JUMPN Q2,CHKLS2		;LOOP BACK FOR ALL BLOCKS IN LIST
	MOVE T1,Q1		;NOW SEE IF THERE IS A HASH LIST
	CALL MAPBLK
	LOAD Q1,HSHPTR,(T1)	;GET HASH LIST POINTER
	JUMPN Q1,CHKLS1		;IF ONE THERE, GO SCAN IT
	RETSKP			;DONE
;ROUTINE TO CHECK A DOC BLOCK

CHKDB:	SAVEPQ
	STKVAR <<CHKDBS,MAXSTW>>
	MOVEI T4,DBPAG0_11	;GET POINTER TO FIRST PAGE
	SKIPG Q2,NXTDOC(T4)	;ANY DOC BLOCKS YET?
	RETSKP			;NOPE
	MOVEI Q3,1		;START AT BLOCK 1
	SETZ Q1,		;INIT ERROR COUNT
CHKDB1:	CAMLE Q3,Q2		;DONE?
	JRST CHKDB4		;YES
	MOVE T1,Q3		;GET DOC NUMBER
	CALL MAPDOC
	SKIPN P1,(T1)		;IS THERE AN ENTRY HERE?
	AOJA Q3,CHKDB1		;NO, SKIP IT
	MOVE T1,P1		;GET ADR OF THE BLOCK
	MOVEI T2,TYPDOC		;IS IT A DOC BLOCK?
	CALL CHKBLK
	 AOJA Q1,CHKDB3		;NO
	MOVE T1,P1		;BLOCK OK
	CALL MAPBLK		;MAP IT
	LOAD T2,DOCNUM,(T1)	;GET DOC #
	CAME T2,Q3		;SAME?
	AOS Q1			;NO, ERROR
	LOAD T1,DOCTTL,(T1)	;GET ADR OF STRING
	MOVEI T2,TYPASC		;IS IT AN ASCII BLOCK?
	SKIPE T1		;ANY BLOCK THERE?
	CALL CHKBLK
	 AOS Q1			;NO, ERROR
	MOVE T1,P1		;GET BLOCK ADR AGAIN
	CALL MAPBLK		;MAP IT
	LOAD T1,DOCLOC,(T1)	;GET ADR OF STRING
	MOVEI T2,TYPASC		;IS IT AN ASCII BLOCK?
	SKIPE T1
	CALL CHKBLK
	 AOS Q1			;NO, ERROR
	MOVE T1,P1		;GET BLOCK ADR AGAIN
	CALL MAPBLK		;MAP IT
	LOAD T1,DOCFIL,(T1)	;GET ADR OF STRING
	MOVEI T2,TYPASC		;IS IT AN ASCII BLOCK?
	CALL CHKBLK
	 AOS Q1			;NO, ERROR
	MOVE T1,P1		;GET BLOCK ADR AGAIN
	CALL MAPBLK		;MAP IT
	LOAD T1,DOCKEY,(T1)	;GET ADR OF STRING BLOCK
	MOVEI T2,TYPASC		;IS IT AN ASCII BLOCK?
	SKIPE T1		;ONE THERE?
	CALL CHKSTB
	 AOS Q1			;NO, ERROR
	MOVE T1,P1		;GET BLOCK ADR AGAIN
	CALL MAPBLK		;MAP IT
	LOAD T1,DOCAUT,(T1)	;GET ADR OF STRING BLOCK
	MOVEI T2,TYPASC		;IS IT AN ASCII BLOCK?
	SKIPE T1		;ONE THERE?
	CALL CHKSTB
	 AOS Q1			;NO, ERROR
	MOVE T1,P1		;GET BLOCK ADR AGAIN
	CALL MAPBLK		;MAP IT
	LOAD T1,DOCTTL,(T1)	;GET TITLE ADR
	JUMPE T1,CHKDB3		;IF NONE, DONE
	CALL MAPBLK		;MAP TITLE BLOCK
	HRLI T1,(POINT 7,0)
	MOVEI T2,CHKDBS		;GET TEMP STRING
	HRLI T2,(POINT 7,0)
CHKDB2:	ILDB T3,T1		;COPY TITLE TO TEMP STRING
	IDPB T3,T2
	JUMPN T3,CHKDB2
	MOVE T1,Q3		;GET DOC #
	HRROI T2,CHKDBS
	SETZ T3,		;GO MAKE KEYWORDS POINT TO THIS DOC
	CALL SADD		;BUT DONT MAKE NEW KEYWORDS
	 JFCL			;DONT WORRY IF NO ENTRY MADE
CHKDB3:	AOJA Q3,CHKDB1		;LOOP BACK FOR ALL DOC #'S

CHKDB4:	SKIPE Q1		;ANY ERRORS?
	RET			;YES
	RETSKP			;NO
;ROUTINE TO CHECK A BLOCK
;ACCEPTS IN T1/	BLOCK ADR
;	    T2/	BLOCK TYPE
;	CALL CHKBLK
;RETURNS +1:	BAD BLOCK
;	 +2:	OK

CHKBLK:	SAVEQ
	DMOVE Q1,T1		;SAVE THE ARGS
	JUMPE T1,RSKP		;0 IS OK
	CALL MAPBLK		;MAP THE BLOCK
	SUBI T1,BLKHDL		;GET ADR OF HEADER
	LOAD T2,BLKTYP,(T1)	;GET TYPE CODE
	CAME T2,Q2		;THE SAME?
	RET			;NO
	RETSKP			;YES


;ROUTINE TO CHECK A STRING BLOCK
;ACCEPTS IN T1/	ADR OF THE BLOCK
;	CALL CHKSTB
;RETURNS +1:	FAILED
;	 +2:	OK

CHKSTB:	SAVEQ
	MOVE Q1,T1		;SAVE THE ADR
	JUMPE T1,RSKP		;IF NONE, THEN OK
CHKST1:	MOVE T1,Q1		;GET BLOCK ADR
	MOVEI T2,TYPSTB
	CALL CHKBLK		;CHECK THE BLOCK
	 RET			;BAD
	MOVE Q2,Q1		;GET ADR OF BLOCK
	ADDI Q2,STR1WD		;GET ADR OF FIRST WORD IN BLOCK
	MOVEI Q3,STRNWD		;GET COUNT
CHKST2:	MOVE T1,Q2		;GET ADR OF NEXT WORD
	CALL MAPBLK		;MAP IT
	SKIPN T1,(T1)		;IS THERE AN ENTRY HERE?
	JRST CHKST3		;NO
	MOVEI T2,TYPASC		;YES, CHECK IF IT POINTS TO AN ASCII BLK
	CALL CHKBLK
	 RET
CHKST3:	AOS Q2			;STEP TO NEXT WORD IN BLOCK
	SOJG Q3,CHKST2		;LOOP BACK FOR ALL WORDS IN THE BLOCK
	MOVE T1,Q1		;STEP TO NEXT BLOCK IN CHAIN
	CALL MAPBLK
	LOAD Q1,STRPTR,(T1)	;GET POINTER TO NEXT BLOCK
	JUMPN Q1,CHKST1		;IS THERE ONE THERE?
	RETSKP			;NO, DONE
;THE DUMP COMMAND

DMPCMD:	HLRZ T1,(P1)		;GET TYPE CODE
	CHKTYP (OFI)
	HRRZ T1,(P1)		;GET POINTER TO JFN
	MOVE T1,ANSWER(T1)	;GET JFN
	HRRZS Q1,T1		;RH ONLY
	MOVE T2,[070000,,OF%WR]
	OPENF			;OPEN OUTPUT FILE FOR WRITE
	 WARN (<JRST LEVEL0>,<COULD NOT OPEN THE OUTPUT FILE>)
	CALL OUTCTL		;OUTPUT THE CTL FILE
	MOVE T1,Q1		;GET THE JFN
	CLOSF			;CLOSE THE FILE
	 WARN (,<COULD NOT CLOSE THE CONTROL FILE>)
	JRST LEVEL0
;ROUTINE TO OUTPUT THE CONTROL FILE FOR DUMP COMMAND
;ACCEPTS IN T1/	JFN

OUTCTL:	SAVEPQ
	STKVAR <OUTCTJ>
	MOVEM T1,OUTCTJ		;SAVE THE JFN
	HRROI T2,[ASCIZ/
;CONTROL FILE TO REBUILD A "FILE" DATA BASE

RENAME /]
	SETZ T3,
	SOUT
	MOVE T2,DBJFN		;GET JFN OF DATA BASE
	MOVE T3,[1B2!1B5!1B8!1B11!1B35]
	JFNS			;OUTPUT FILE.TYP OF DATA BASE
	HRROI T2,[ASCIZ/.* /]
	SETZ T3,
	SOUT
	MOVE T2,DBJFN
	MOVE T3,[1B2!1B5!1B8!1B35]	;OUTPUT THE DATA BASE FILE NAME
	JFNS
	HRROI T2,[ASCIZ/.BACK-UP-DATA-BASE.-1

R FILE
/]
	SETZ T3,
	SOUT
	MOVE T2,DBJFN		;GET JFN OF DATA BASE AGAIN
	MOVE T3,[1B2!1B5!1B8!1B11!1B35]
	JFNS			;CAUSE THE SAME NAME FOR NEW DATA BASE
	HRROI T2,[ASCIZ/
YES
/]
	SETZ T3,
	SOUT
	MOVEI T2,DBPAG0_11	;GET ADR OF DATA BASE PAGE 0
	MOVE Q2,NXTDOC(T2)	;GET HIGHEST DOC NUMBER IN USE
	MOVEI Q3,1		;START AT DOC # 1
OUTCT1:	CAMLE Q3,Q2		;REACHED THE END?
	JRST OUTCT2		;YES
	MOVE T1,Q3		;GET DOC #
	CALL MAPDOC		;MAP IT
	SKIPN (T1)		;ONE THERE?
	AOJA Q3,OUTCT1		;NO, SKIP IT
	MOVE T1,OUTCTJ		;GET JFN
	HRROI T2,[ASCIZ/
;DOCUMENT # /]
	SETZ T3,
	SOUT
	MOVE T2,Q3		;GET DOC #
	MOVEI T3,^D10
	NOUT			;OUTPUT THE DOC #
	 JFCL
	HRROI T2,[ASCIZ/

ADD DOCUMENT /]
	SETZ T3,
	SOUT
	MOVE T2,Q3		;GET THE DOC #
	MOVEI T3,^D10
	NOUT
	 JFCL
	HRROI T2,[ASCIZ/
 !TITLE! /]
	SETZ T3,
	SOUT
	MOVE T1,Q3		;GET THE DOC #
	CALL MAPDOC		;MAP IN THE INDEX BLOCK
	MOVE T1,(T1)		;GET THE ADR OF THE DOC BLOCK
	MOVE Q1,T1		;SAVE ADR OF DOC BLOCK
	CALL MAPBLK		;MAP IN THE DOC BLOCK
	LOAD T1,DOCTTL,(T1)	;GET ADR OF TITLE BLOCK
	CALL MAPBLK		;MAP IN TITLE BLOCK
	HRRO T2,T1
	MOVE T1,OUTCTJ		;GET JFN
	SETZ T3,
	SOUT			;OUTPUT THE TITLE
	HRROI T2,[ASCIZ/
 !AUTHOR! /]
	SOUT
	MOVE T1,Q1		;GET ADR OF DOC BLOCK
	CALL MAPBLK		;MAP IT
	LOAD T2,DOCAUT,(T1)	;GET ADR OF AUTHOR LIST BLOCK
	MOVE T1,OUTCTJ		;GET JFN
	CALL OUTSTR		;OUTPUT THE LIST OF STRINGS
	MOVE T1,OUTCTJ		;GET JFN
	HRROI T2,[ASCIZ/
 !DATE! /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET ADR OF DOC BLOCK
	CALL MAPBLK		;MAP IT
	LOAD T2,DOCDAT,(T1)	;GET DATE OF DOCUMENT
	MOVE T1,OUTCTJ		;GET THE JFN
	MOVX T3,OT%NTM		;OUTPUT ONLY THE DATE PART
	ODTIM
REPEAT 0,<
	HRROI T2,[ASCIZ/
 !PDM! /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET THE ADR OF THE DOC BLOCK
	CALL MAPBLK		;MAP IT
	LOAD T1,DOCPDM,(T1)	;GET THE PDM STRING
	JUMPE T1,OUTCT3		;IF NONE, SKIP IT
	CALL MAPBLK		;MAP IT
	HRLI T1,(POINT 7,0)
	MOVE T2,T1		;GET POINTER TO STRING
	MOVE T1,OUTCTJ		;GET JFN
	SETZ T3,
	SOUT
OUTCT3:	MOVE T1,OUTCTJ		;GET THE JFN
	HRROI T2,[ASCIZ/
 !FILE NAME! /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET DOC BLOCK
	CALL MAPBLK
	LOAD T1,DOCFIL,(T1)	;GET FILE NAME 
	JUMPE T1,OUTCT4		;IF NONE, SKIP IT
	CALL MAPBLK
	HRLI T1,(POINT 7,0)
	MOVE T2,T1		;GET POINTER TO STRING
	MOVE T1,OUTCTJ		;GET JFN
	SETZ T3,
	SOUT
>
OUTCT4:	MOVE T1,OUTCTJ		;GET THE JFN
	HRROI T2,[ASCIZ/
 !KEYWORDS! /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET THE DOC BLOCK
	CALL MAPBLK
	LOAD T2,DOCKEY,(T1)	;GET POINTER TO STRING BLOCK
	MOVE T1,OUTCTJ		;GET JFN
	CALL OUTSTR		;OUTPUT THE KEYWORDS
	MOVE T1,OUTCTJ		;GET THE JFN
	HRROI T2,[ASCIZ\
 !FILE CABINET NAME/FOLDER NAME! \]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET THE DOC BLOCK
	CALL MAPBLK
	LOAD T1,DOCLOC,(T1)	;GET LOCATION STRING
	JUMPE T1,OUTCT5		;IF NONE, SKIP IT
	CALL MAPBLK
	HRLI T1,(POINT 7,0)
	MOVE T2,T1		;GET POINTER TO STRING
	MOVE T1,OUTCTJ		;GET JFN
	SETZ T3,
	SOUT
OUTCT5:	MOVE T1,Q1		;GET DOC BLOCK ADR
	CALL MAPBLK		;MAP IT
	LOAD T4,DOCPDM,(T1)	;GET PDM
	JUMPE T4,OUTCT6		;ANY THERE?
	MOVE T1,OUTCTJ		;GET JFN
	HRROI T2,[ASCIZ/
 SET PDM /]
	SETZ T3,
	SOUT
	MOVE T2,Q3		;GET DOC #
	MOVEI T3,12
	NOUT
	 JFCL
	MOVEI T2," "		;SPACE
	BOUT
	MOVE T1,T4		;GET ADR OF STRING BLOCK
	CALL MAPBLK		;MAP IT
	HRLI T1,(POINT 7,0)
	MOVE T2,T1
	MOVE T1,OUTCTJ		;GET JFN
	SETZ T3,
	SOUT
OUTCT6:	MOVE T1,Q1		;GET DOC BLOCK ADR
	CALL MAPBLK		;MAP IT
	LOAD T4,DOCFIL,(T1)	;GET FILE NAME
	JUMPE T4,OUTCT7		;ANY THERE?
	MOVE T1,OUTCTJ		;GET JFN
	HRROI T2,[ASCIZ/
 SET FILE /]
	SETZ T3,
	SOUT
	MOVE T2,Q3		;GET DOC #
	MOVEI T3,12
	NOUT
	 JFCL
	MOVEI T2," "		;SPACE
	BOUT
	MOVE T1,T4		;GET ADR OF STRING BLOCK
	CALL MAPBLK		;MAP IT
	HRLI T1,(POINT 7,0)
	MOVE T2,T1
	MOVE T1,OUTCTJ		;GET JFN
	SETZ T3,
	SOUT
OUTCT7:	MOVE T1,Q1		;GET DOC BLOCK ADR
	CALL MAPBLK		;MAP IN BLOCK
	JE DSDEL,(T1),OUTCT8	;IF NOT DELETED, SKIP THIS STEP
	MOVE T1,OUTCTJ		;GET THE JFN
	HRROI T2,[ASCIZ/
DELETE DOCUMENT /]
	SETZ T3,
	SOUT
	MOVE T2,Q3		;GET THE DOC #
	MOVEI T3,12
	NOUT
	 JFCL
OUTCT8:	MOVE T1,OUTCTJ		;GET JFN
	HRROI T2,[ASCIZ/

/]
	SETZ T3,
	SOUT

	AOJA Q3,OUTCT1		;LOOP BACK FOR ALL DOCUMENTS

OUTCT2:	MOVE T1,OUTCTJ		;GET THE JFN
	HRROI T2,[ASCIZ/

EXIT
/]
	SETZ T3,
	SOUT
	RET
;ROUTINE TO OUTPUT THE STRINGS POINTED TO BY A STRING BLOCK
;ACCEPTS IN T1/	JFN
;	    T2/	FILE ADR OF FIRST STRING BLOCK IN LIST

OUTSTR:	SAVEPQ
	MOVE Q1,T1		;SAVE THE JFN
	MOVE P1,T2		;SAVE THE LIST ADR
	JUMPE P1,R		;IF NONE, THEN DONE
	SETO P4,		;INIT FIRST TIME THROUGH FLAG
OUTST1:	MOVE P2,P1		;GET ADR OF FIRST DATA WORD IN BLOCK
	ADDI P2,STR1WD
	MOVEI P3,STRNWD		;GET COUNT OF DATA WORDS IN BLOCK
OUTST2:	MOVE T1,P2		;MAP IN THE BLOCK
	CALL MAPBLK
	SKIPN T1,(T1)		;IS THERE A STRING HERE?
	JRST OUTST3		;NO
	CALL MAPBLK		;YES, MAP IT IN
	HRLI T1,(POINT 7,0)	;SET UP A BYTE POINTER
	MOVE T4,T1
	MOVE T1,Q1		;GET THE JFN
	SETZ T3,
	HRROI T2,[ASCIZ/, /]	;SET UP TO ADD A COMMA
	AOSE P4			;FIRST TIME THROUGH?
	SOUT			;NO, OUTPUT THE COMMA
	MOVE T2,T4		;GET POINTER TO STRING
	SOUT			;OUTPUT THE STRING
OUTST3:	AOS P2			;STEP TO NEXT STRING IN BLOCK
	SOJG P3,OUTST2		;LOOP BACK THROUGH BLOCK
	MOVE T1,P1		;GET ADR OF STRING BLOCK
	CALL MAPBLK		;MAP IT
	LOAD P1,STRPTR,(T1)	;GET LINK TO NEXT STRING BLOCK (IF ANY)
	JUMPN P1,OUTST1		;LOOP BACK IF ANOTHER STRING BLOCK FOUND
	RET			;OTHERWISE, DONE
;EXIT COMMAND

EXIT:	CALL UNMAP		;UNMAP THE DATA BASE FILE
	HRRZ T1,DBJFN		;NOW DEQ THE DATA BASE FILE
	CALL DEQJFN
	HRRZ T1,DBJFN		;NOW CLOSE THE DATA BASE FILE
	CLOSF
	 JSP ERROR
	HRRZ T1,TLJFN		;AND RELEASE THE TRANSACTION LOG JFN
	RLJFN
	 JFCL
	HALTF			;DONE
	JRST FILE		;CONTINUE = START OVER AGAIN
;THE TYPE AND LIST COMMANDS

LSTCMD:	HRROI P2,[ASCIZ/LPT:FILE.OUT/]
	JRST TYPCM1

TYPCMD:	HRROI P2,[ASCIZ/TTY:/]
TYPCM1:	HLRZ T1,(P1)		;GET TYPE CODE
	CHKTYP (KEY)
	HRRZ T1,(P1)		;GET DISPATCH ADR
	AOJA P1,(T1)		;DISPATCH

LSTTTL:	MOVEI P4,2		;TITLE
	JRST LSTKE1

LSTLOC:	MOVEI P4,3		;LOCATION
	JRST LSTKE1

LSTAUT:	MOVEI P4,4		;AUTHORS
	JRST LSTKE1

LSTDOC:	TDZA P4,P4		;INDEX 0
LSTKEY:	MOVEI P4,1
LSTKE1:	HLRZ T2,(P1)		;GET TYPE CODE
	HRRZ T1,(P1)		;GE POINTER TO JFN
	MOVE T1,ANSWER(T1)	;GET JFN IF ANY GIVEN
	CAIN T2,.CMOFI		;FILE NAME?
	AOJA P1,LSTKE2		;YES
	MOVE T2,P2		;NO, GET DEVICE NAME
	MOVX T1,GJ%FOU!GJ%SHT
	GTJFN
	 WARN (<JRST LEVEL0>,<COULD NOT OPEN OUTPUT FILE>)
LSTKE2:	MOVE T2,[070000,,OF%WR]	;OPEN IT FOR WRITE
	OPENF
	 WARN (<JRST LEVEL0>,<COULD NOT OPEN OUTPUT FILE>)
	HRRZ Q1,T1		;SAVE THE JFN
	HRRZ T2,(P1)		;GET POINTER TO DOC NUMBER
	MOVE T2,ANSWER(T2)	;GET DOCUMENT NUMBER
	SETZ T3,		;NO VALUE 
	XCT [	CALL OUTDOC	;OUTPUT THE DOC INFO
		CALL OUTKEY
		CALL OUTTTL
		CALL OUTLOC
		CALL OUTAUT](P4) ;OUTPUT THE AUTHORS
	MOVE T1,Q1		;GET THE JFN
	CLOSF			;CLOSE IT
	 WARN (,<COULD NOT CLOSE THE OUTPUT FILE>)
	JRST LEVEL0
;ROUTINES TO OUTPUT THE LOCATION AND TITLE LISTS
;ACCEPTS IN T1/	JFN

OUTLOC:	TDZA T4,T4
OUTTTL:	MOVEI T4,1
	SAVEPQ
	MOVE P4,T4		;SAVE THE INDEX
	MOVE Q1,T1		;SAVE THE JFN
	MOVEI T2,DBPAG0_11
	MOVE Q2,NXTDOC(T2)	;GET THE END OF THE DOC TABLE
	MOVEI Q3,1		;START AT DOC # 1
OUTTT1:	CAMLE Q3,Q2		;REACHED THE END?
	RET			;YES, DONE
	MOVE T1,Q3		;NO, CHECK IF ONE THERE
	CALL MAPDOC
	SKIPN (T1)		;THIS DOC NUMBER IN USE?
	AOJA Q3,OUTTT1		;NO, SKIP IT
	MOVE T1,Q1		;GET JFN
	MOVE T2,Q3		;GET DOC NUMBER
	MOVEI T3,^D10
	CALL TYPNUM		;OUTPUT THE NUMBER
	MOVE T1,Q1		;GET THE JFN
	MOVEI T2,^D10
	CALL TYPSPA		;GO TO COL 10
	MOVE T1,Q3		;GE DOC #
	CALL MAPDOC
	MOVE T1,(T1)
	CALL MAPBLK		;MAP IT
	XCT [	LOAD T1,DOCLOC,(T1)
		LOAD T1,DOCTTL,(T1)](P4)
	JUMPE T1,OUTTT2		;IF NO STRING, EXIT
	CALL MAPBLK		;MAP IT
	HRLI T1,(POINT 7,0)
	MOVE T2,T1
	MOVE T1,Q1		;GET JFN
	CALL TYPSTR		;OUTPUT THE STRING
	MOVE T1,Q1		;GET THE JFN
	MOVEI T2,^D50		;STEP TO COL 50
	CALL TYPSPA
	MOVE T1,Q3		;GET DOC #
	CALL MAPDOC
	MOVE T1,(T1)	
	CALL MAPBLK		;MAP THE DOC BLOCK
	XCT [	LOAD T1,DOCTTL,(T1)
		LOAD T1,DOCLOC,(T1)](P4)
	JUMPE T1,OUTTT2		;IF NONE, SKIP IT
	CALL MAPBLK
	HRLI T1,(POINT 7,0)
	MOVE T2,T1
	MOVE T1,Q1		;GET THE JFN
	CALL TYPSTR
OUTTT2:	MOVE T1,Q1		;GET THE JFN
	HRROI T2,[ASCIZ/
/]
	CALL TYPSTR
	AOJA Q3,OUTTT1		;LOOP BACK FOR OTHER DOC #'S
;ROUTINE TO OUTPUT THE LIST OF KEYWORDS OR AUTHORS
;ACCEPTS IN T1/	JFN

OUTKEY:	TDZA T4,T4
OUTAUT:	MOVEI T4,1
	SAVEPQ
	STKVAR <<OUTAUS,MAXSTW>>
	MOVE P4,T4		;SAVE THE INDEX
	MOVE Q1,T1		;SAVE THE JFN
	MOVEI T2,DBPAG0_11
	MOVE Q2,NXTDOC(T2)	;GET THE END OF THE DOC TABLE
	MOVEI Q3,1		;START AT DOC # 1
OUTAU1:	CAMLE Q3,Q2		;REACHED THE END?
	RET			;YES, DONE
	MOVE T1,Q3		;NO, CHECK IF ONE THERE
	CALL MAPDOC
	SKIPN T1,(T1)		;THIS DOC NUMBER IN USE?
	AOJA Q3,OUTAU1		;NO, SKIP IT
	CALL MAPBLK		;MAP THE DOC BLOCK
	XCT [	LOAD P1,DOCKEY,(T1)
		LOAD P1,DOCAUT,(T1)](P4)
OUTAU2:	MOVE P2,P1		;GET ADR OF STRING BLOCK
	ADDI P2,STR1WD		;GET ADR OF FIRST WORD
	MOVEI P3,STRNWD		;GET COUNT OF WORDS
OUTAU3:	MOVE T1,P2		;GET THE ADR
	CALL MAPBLK		;MAP IT
	SKIPN P5,(T1)		;AN ENTRY HERE?
	JRST OUTAU5		;NO
	MOVE T1,Q1		;GET JFN
	MOVE T2,Q3		;GET DOC NUMBER
	MOVEI T3,^D10
	CALL TYPNUM		;OUTPUT THE NUMBER
	MOVE T1,Q1		;GET THE JFN
	MOVEI T2,^D10
	CALL TYPSPA		;GO TO COL 10
	MOVE T1,P5		;GET ADR OF BLOCK
	CALL MAPBLK		;MAP IT
	HRLI T1,(POINT 7,0)
	HRROI T2,OUTAUS		;GO CONVERT THE STRING
	MOVE T3,P4		;IF AUTHOR, PUT LAST NAME FIRST
	CALL CNVSTR
	HRROI T2,OUTAUS		;GET POINTER TO STRING
	MOVE T1,Q1		;GET THE JFN
	CALL TYPSTR		;OUTPUT THE STRING
	MOVE T1,Q1		;GET THE JFN
	MOVEI T2,^D50		;STEP TO COL 50
	CALL TYPSPA
	MOVE T1,Q3		;GET DOC #
	CALL MAPDOC
	MOVE T1,(T1)	
	CALL MAPBLK		;MAP THE DOC BLOCK
	LOAD T1,DOCTTL,(T1)
	JUMPE T1,OUTAU4		;IF NONE, SKIP IT
	CALL MAPBLK
	HRLI T1,(POINT 7,0)
	MOVE T2,T1
	MOVE T1,Q1		;GET THE JFN
	CALL TYPSTR
OUTAU4:	MOVE T1,Q1		;GET THE JFN
	HRROI T2,[ASCIZ/
/]
	CALL TYPSTR
OUTAU5:	AOS P2			;STEP TO NEXT ITEM IN BLOCK
	SOJG P3,OUTAU3		;LOOP BACK FOR REST OF ITEMS
	MOVE T1,P1		;GET POINTER TO BLOCK
	CALL MAPBLK		;MAP IT
	LOAD P1,STRPTR,(T1)	;GET POINTER TO NEXT BLOCK
	JUMPN P1,OUTAU2		;LOOP BACK IF THERE IS ANOTHER BLOCK
	AOJA Q3,OUTAU1		;LOOP BACK FOR ALL DOC #'S
;ROUTINE TO OUTPUT A DOCUMENT TO A JFN
;ACCEPTS IN T1/	JFN
;	    T2/	DOC #
;	    T3/	VALUE OR 0 IF NONE

OUTDOC:	SAVEPQ
	STKVAR <OUTDOJ,OUTDOD>
	MOVEM T1,OUTDOJ		;SAVE THE JFN
	MOVEM T2,OUTDOD		;SAVE THE DOC NUMBER
	DMOVE P3,T3		;SAVE THE VALUE AND COUNT
	MOVE T1,OUTDOD		;CHECK THE DOC #
	CALL CHKDOC
	 JRST OUTDO0		;ILLEGAL DOC #
	MOVE T1,OUTDOD
	CALL MAPDOC		;SEE IF IT IS DEFINED YET
	MOVE T1,(T1)		;GET ADR OF DOC BLOCK
	JUMPE T1,OUTDO0		;IF ZERO, THEN NOT DEFINED
	MOVE T1,OUTDOJ		;GET JFN
	HRROI T2,[ASCIZ/
DOCUMENT # /]
	SETZ T3,
	SOUT
	MOVE T2,OUTDOD		;GET DOC #
	MOVEI T3,^D10
	NOUT			;OUTPUT THE DOC #
	 JFCL
	JUMPE P3,OUTDO1		;ANY VALUE GIVEN?
	HRROI T2,[ASCIZ/  (/]
	SETZ T3,
	SOUT
	HRROI T2,[ASCIZ/MATCH VALUE = /]
	SKIPE P3
	SOUT
	MOVE T3,[1B4!1B6!2B23!2B29]
	SKIPE T2,P3		;GET VALUE
	FLOUT
	 JFCL
	HRROI T2,[ASCIZ/)/]
	SETZ T3,
	SOUT
OUTDO1:	HRROI T2,[ASCIZ/

	TITLE:     /]
	SETZ T3,
	SOUT
	MOVE T1,OUTDOD		;GET THE DOC #
	CALL MAPDOC		;MAP IN THE INDEX BLOCK
	MOVE T1,(T1)		;GET THE ADR OF THE DOC BLOCK
	MOVE Q1,T1		;SAVE ADR OF DOC BLOCK
	CALL MAPBLK		;MAP IN THE DOC BLOCK
	LOAD T1,DOCTTL,(T1)	;GET ADR OF TITLE BLOCK
	CALL MAPBLK		;MAP IN TITLE BLOCK
	HRRO T2,T1
	MOVE T1,OUTDOJ		;GET JFN
	SETZ T3,
	SOUT			;OUTPUT THE TITLE
	HRROI T2,[ASCIZ/
	AUTHOR:    /]
	SOUT
	MOVE T1,Q1		;GET ADR OF DOC BLOCK
	CALL MAPBLK		;MAP IT
	LOAD T2,DOCAUT,(T1)	;GET ADR OF AUTHOR LIST BLOCK
	MOVE T1,OUTDOJ		;GET JFN
	CALL OUTSTR		;OUTPUT THE LIST OF STRINGS
	MOVE T1,OUTDOJ		;GET JFN
	HRROI T2,[ASCIZ/
	DATE:      /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET ADR OF DOC BLOCK
	CALL MAPBLK		;MAP IT
	LOAD T2,DOCDAT,(T1)	;GET DATE OF DOCUMENT
	MOVE T1,OUTDOJ		;GET THE JFN
	MOVX T3,OT%NTM		;OUTPUT ONLY THE DATE PART
	ODTIM
	HRROI T2,[ASCIZ/
	PDM:       /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET THE ADR OF THE DOC BLOCK
	CALL MAPBLK		;MAP IT
	LOAD T1,DOCPDM,(T1)	;GET THE PDM STRING
	JUMPE T1,OUTDO3		;IF NONE, SKIP IT
	CALL MAPBLK		;MAP IT
	HRLI T1,(POINT 7,0)
	MOVE T2,T1		;GET POINTER TO STRING
	MOVE T1,OUTDOJ		;GET JFN
	SETZ T3,
	SOUT
OUTDO3:	MOVE T1,OUTDOJ		;GET THE JFN
	HRROI T2,[ASCIZ/
	DISK FILE NAME: /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET DOC BLOCK
	CALL MAPBLK
	LOAD T1,DOCFIL,(T1)	;GET FILE NAME 
	JUMPE T1,OUTDO4		;IF NONE, SKIP IT
	CALL MAPBLK
	HRLI T1,(POINT 7,0)
	MOVE T2,T1		;GET POINTER TO STRING
	MOVE T1,OUTDOJ		;GET JFN
	SETZ T3,
	SOUT
OUTDO4:	MOVE T1,OUTDOJ		;GET THE JFN
	HRROI T2,[ASCIZ/
	KEYWORDS:  /]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET THE DOC BLOCK
	CALL MAPBLK
	LOAD T2,DOCKEY,(T1)	;GET POINTER TO STRING BLOCK
	MOVE T1,OUTDOJ		;GET JFN
	CALL OUTSTR		;OUTPUT THE KEYWORDS
	MOVE T1,OUTDOJ		;GET THE JFN
	HRROI T2,[ASCIZ\
	FILE CABINET NAME/FOLDER NAME:  \]
	SETZ T3,
	SOUT
	MOVE T1,Q1		;GET THE DOC BLOCK
	CALL MAPBLK
	LOAD T1,DOCLOC,(T1)	;GET LOCATION STRING
	JUMPE T1,OUTDO5		;IF NONE, SKIP IT
	CALL MAPBLK
	HRLI T1,(POINT 7,0)
	MOVE T2,T1		;GET POINTER TO STRING
	MOVE T1,OUTDOJ		;GET JFN
	SETZ T3,
	SOUT
OUTDO5:	MOVE T1,OUTDOJ		;GET JFN
	HRROI T2,[ASCIZ/

/]
	SETZ T3,
	SOUT
	RET


OUTDO0:	MOVE T1,OUTDOJ		;GET THE JFN
	HRROI T2,[ASCIZ/
? NO SUCH DOCUMENT NUMBER

/]
	SETZ T3,
	SOUT
	RET
;THE SET COMMAND

SETCMD:	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (KEY)
	HRRZ T1,(P1)		;GET DISPATCH ADR
	AOJA P1,(T1)		;DISPATCH

;SET TITLE

SETTTL:	MOVEI Q3,0		;GET INDEX
	CALL SETTT1
	 JRST LEVEL0
	JRST LOGLV0

;SET LOCATION

SETLOC:	MOVEI Q3,1		;SET UP INDEX
	CALL SETTT1
	 JRST LEVEL0
	HRRZ T1,(P1)		;GET DOC NUMBER
	MOVE T1,ANSWER(T1)
	HRRZ T2,1(P1)		;GET POINTER TO STRING
	MOVEI T2,ANSWER(T2)
	HRLI T2,(POINT 7,0)
	SETO T3,		;ALLOW NEW ADDITIONS
	CALL SADD		;ADD THESE WORDS AS KEYWORDS
	 JRST LEVEL0		;FAILED
	JRST LOGLV0

;SET FILE-NAME 

SETFIL:	MOVEI Q3,2		;SET UP INDEX
	CALL SETTT1
	 JRST LEVEL0
	JRST LOGLV0
;SET PDM

SETPDM:	MOVEI Q3,3		;SET UP INDEX
	CALL SETTT1
	 JRST LEVEL0
	JRST LOGLV0

SETTT1:	HLRZ T1,(P1)		;GET TYPE CODE
	ANDI T1,777		;STRIP OFF RADIX
	CHKTYP (NUM)
	HRRZ T1,(P1)		;GET POINTER TO NUMBER
	MOVE Q1,ANSWER(T1)	;GET THE DOC NUMBER
	MOVE T1,Q1		;GET DOC #
	CALL CHKDOC		;IS IT LEGAL?
	 WARN (<RET>,<ILLEGAL DOCUMENT #>)
	HLRZ T1,1(P1)		;GET SECOND TYPE CODE
	CHKTYP (TXT)
	HRRZ T1,1(P1)		;GET POINTER TO TEXT STRING
	MOVEI Q2,ANSWER(T1)
	HRLI Q2,(POINT 7,0)	;BUILD A POINTER TO THE TITLE
	MOVE T1,Q1		;GET THE DOC #
	CALL MAPDOC		;MAP IT
	SKIPN T1,(T1)		;GET DOC BLOCK ADR
	WARN (<RET>,<NO SUCH DOCUMENT #>)
	CALL MAPBLK		;MAP THE DOC BLOCK
	XCT [	LOAD T1,DOCTTL,(T1)
		LOAD T1,DOCLOC,(T1)
		LOAD T1,DOCFIL,(T1)
		LOAD T1,DOCPDM,(T1)](Q3)
	CALL RELFRE		;RELEASE THIS BLOCK
	MOVE T1,Q2		;GET POINTER TO NEW STRING
	CALL COPSTR		;MAKE A COPY OF IT
	 WARN (<RET>,<NO MORE ROOM IN DATA BASE>)
	MOVE Q2,T1		;SAVE THE ADR OF THE BLOCK
	MOVE T1,Q1		;GET DOC #
	CALL MAPDOC		;MAP IT
	MOVE T1,(T1)
	CALL MAPBLK		;MAP THE DOC BLOCK
	XCT [	STOR Q2,DOCTTL,(T1)
		STOR Q2,DOCLOC,(T1)
		STOR Q2,DOCFIL,(T1)
		STOR Q2,DOCPDM,(T1)](Q3)
	RET
;SET DATE COMMAND

SETDAT:	HLRZ T1,(P1)		;GET TYPE CODE
	ANDI T1,777		;STRIP OFF RADIX
	CHKTYP (NUM)
	HRRZ T1,(P1)		;GET DOC #
	MOVE Q1,ANSWER(T1)
	MOVE T1,Q1		;CHECK THE DOC #
	CALL CHKDOC
	 WARN (<JRST LEVEL0>,<ILLEGAL DOCUMENT #>)
	HLRZ T1,1(P1)		;GET TYPE CODE
	CHKTYP (TAD)
	HRRZ T1,1(P1)		;GET POINTER TO DATE
	MOVE Q2,ANSWER(T1)
	MOVE T1,Q1		;GET DOC #
	CALL MAPDOC		;MAP IT
	SKIPN T1,(T1)		;GET ADR OF DOC BLOCK
	WARN (<JRST LEVEL0>,<NO SUCH DOCUMENT #>)
	CALL MAPBLK		;MAP THE DOC BLOCK
	STOR Q2,DOCDAT,(T1)	;UPDATE THE DATE WORD
	JRST LOGLV0		;GO LOG IT
;THE "SET KEYWORD" AND "SET AUTHOR" COMMANDS

SETKEY:	MOVEI P4,1		;GET THE INDEX
	JRST SETAU0

SETAUT:	MOVEI P4,0
SETAU0:	HLRZ T1,(P1)		;GET TYPE CODE
	ANDI T1,777		;STRIP OFF RADIX
	CHKTYP (NUM)
	HRRZ T1,(P1)		;GET THE DOC NUMBER
	MOVE Q1,ANSWER(T1)
	MOVE T1,Q1
	CALL CHKDOC		;CHECK THE DOC # FOR LEGALITY
	 WARN (<JRST LEVEL0>,<ILLEGAL DOCUMENT #>)
	MOVE T1,Q1		;GET THE DOC NUMBER
	XCT [	CALL DELAUS	;DELETE THE AUTHOR STRING
		CALL DELKYS](P4) ;DELETE THE KEYWORD LIST
	AOS P1			;STEP TO THE NEXT FIELD
SETAU1:	HRRZ T2,(P1)		;GET ADR OF ANSWER STRING
	ADDI T2,ANSWER
	HRLI T2,(POINT 7,0)	;SET UP A BYTE POINTER TO STRING
	MOVE T1,Q1		;GET THE DOC #
	XCT [	CALL ASADD	;ADD THE AUTHOR STRING
		CALL KSADD](P4)	;OR ADD THE KEYWORD STRING
	 WARN (<JRST LEVEL0>,<COULD NOT COMPLETE THE COMMAND>)
	AOS T2,P1		;STEP TO THE NEXT FIELD
	HLRZ T3,(P1)		;GET TYPE CODE
	CAIN T3,.CMFLD		;FIELD?
	JRST SETAU1		;YES, GO PROCESS IT
	CAIN T3,.CMCMA		;COMMA?
	AOJA P1,SETAU1		;YES
	JRST LOGLV0		;NO, DONE
;ROUTINE TO DELETE THE AUTHOR STRING FROM A DOCUMENT BLOCK
;ACCEPTS IN T1/	DOC #
;RETURNS +1:	OK

DELAUS:	CALL MAPDOC		;MAP IN THE DOC NUMBER
	SKIPN T1,(T1)		;GET ADR OF DOC BLOCK
	RET			;NONE
	ASUBR <DELAUD>		;SAVE ADR
	CALL MAPBLK		;MAP IN DOC BLOCK
	LOAD T2,DOCAUT,(T1)	;GET THE ADR OF THE STRING LIST
	SETZRO DOCAUT,(T1)	;ZERO THE LOCATION
	MOVE T1,T2		;GET ADR
	CALL DELSTR		;DELETE THE STRING LIST
	RET			;DONE


;ROUTINE TO DELETE THE KEYWORD LIST FROM A DOC BLOCK
;ACCEPTS IN T1/	DOC #
;RETURNS +1:	OK

DELKYS:	CALL MAPDOC		;MAP IN THE DOC NUMBER
	SKIPN T1,(T1)		;GET ADR OF DOC BLOCK
	RET			;NONE
	ASUBR <DELKYD>		;SAVE ADR
	CALL MAPBLK		;MAP IN DOC BLOCK
	LOAD T2,DOCKEY,(T1)	;GET THE ADR OF THE STRING LIST
	SETZRO DOCKEY,(T1)	;ZERO THE LOCATION
	MOVE T1,T2		;GET ADR
	CALL DELSTR		;DELETE THE STRING LIST
	RET			;DONE


;ROUTINE TO DELETE A STRING BLOCK LIST
;ACCEPTS IN T1/	ADR OF FIRST BLOCK IN LIST

DELSTR:	SAVEQ
	JUMPE T1,R		;IF NONE, THEN DONE
	MOVE Q1,T1		;SAVE THE ARG
DELST1:	MOVE Q2,Q1		;GET COPY OF ADR
	ADDI Q2,STR1WD		;GET ADR OF FIRST DATA WORD
	MOVEI Q3,STRNWD		;GET COUNT OF DATA WORDS
DELST2:	MOVE T1,Q2		;GET ADR OF DATA WORD
	CALL MAPBLK		;MAP IT
	SKIPE T1,(T1)		;GET ADR OF STRING (IF ANY)
	CALL RELFRE		;RELEASE IT
	AOS Q2			;STEP TO NEXT WORD
	SOJG Q3,DELST2		;LOOP BACK TILL DONE
	MOVE T1,Q1		;GET BACK STRING BLOCK AGAIN
	CALL MAPBLK		;MAP IT
	LOAD T1,STRPTR,(T1)	;GET ADR OF NEXT LINKED BLOCK
	EXCH Q1,T1		;SAVE IT
	CALL RELFRE		;RELEASE THE OLD STRING BLOCK
	JUMPN Q1,DELST1		;LOOP BACK IF MORE TO BE DONE
	RET			;OTHERWISE, DONE
;THE FIND COMMAND

FNDCMD:	MOVEI Q1,ANSWER		;GET START OF ANSWER AREA
	MOVEI P5,.PRIOU		;ASSUME TTY IF NO FILE NAME SPECIFIED
	HLRZ T1,(P1)		;GET TYPE CODE
	CAIE T1,.CMOFI		;FILE NAME?
	JRST FNDCM0		;NO
	HRRZ T1,(P1)		;YES, GET THE JFN
	HRRZ P5,ANSWER(T1)	;GET JFN
	MOVE T1,P5
	MOVE T2,[070000,,OF%WR]
	OPENF			;OPEN THE JFN
	 WARN (<JRST LEVEL0>,<COULD NOT OPEN THE OUTPUT FILE>)
	AOS P1
FNDCM0:	HLRZ T1,(P1)		;GET TYPE CODE
	CHKTYP (CFM)
	MOVE T1,DBJFN		;GET THE DATA BASE JFN
	CALL DEQJFN		;UNLOCK THE DATA BASE
REPEAT 0,<
	HRROI T1,[ASCIZ/   TITLE: /]
	MOVEI T2,FINDT		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,TITLE		;SAVE ADR OF ANSWER BLOCK
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "FIND TITLE" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,TITLE		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (TXT)
>

	HRROI T1,[ASCIZ/   AUTHOR: /]
	MOVEI T2,FINDA		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,AUTHOR		;SAVE ADR OF ANSWER BLOCK
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "FIND AUTHOR" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER

	HRROI T1,[ASCIZ/   DATE  -  FROM: /]
	MOVEI T2,FNDDF		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET THE ADR OF THE ANSWER BLOCK
	MOVEM T3,FDATE		;SAVE THE ADR
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "FIND DATE - FROM" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,FDATE
	HLRZ T2,(P1)		;GET TYPE CODE
	HRRZ T1,(P1)		;GET POINTER TO DATE
	ADD T1,FDATE
	CAIE T2,.CMTAD		;DATE?
	TDZA T1,T1		;NO
	MOVE T1,(T1)		;GET DATE
	MOVEM T1,FDATE		;SAVE THE DATE

	HRROI T1,[ASCIZ/              TO: /]
	MOVEI T2,FNDDT		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,TDATE		;SAVE ADR
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "FIND DATE - TO" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,TDATE
	HLRZ T2,(P1)		;GET TYPE CODE
	HRRZ T1,(P1)		;GET POINTER TO DATE
	ADD T1,TDATE
	CAIE T2,.CMTAD		;DATE?
	TDZA T1,T1		;NO
	MOVE T1,(T1)		;GET DATE
	MOVEM T1,TDATE		;SAVE THE DATE

REPEAT 0,<
	SETZM PDM		;INIT POINTER
	HRROI T1,[ASCIZ/   PDM: /]
	MOVEI T2,FINDP		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,PDM		;SAVE ADR
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "FIND PDM" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,PDM		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (TXT)
>

	HRROI T1,[ASCIZ/   KEYWORDS: /]
	MOVEI T2,FINDK		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,KEYWRD
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "FIND KEYWORDS" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE T1,DBJFN		;GET THE JFN OF THE DATA BASE
	CALL ENQJFN		;LOCK THE DATA BASE

	SETO P2,		;INIT COUNT OF DOC #'S FOUND
	SETZ Q3,		;INIT COUNT OF ITEMS SPECIFIED
	SETZB P4,P3		;START WITH THE KEYWORDS FIRST
FNDCM4:	XCT [	MOVE P1,KEYWRD	;GET ADR OF ANSWER BLOCK
		MOVE P1,AUTHOR](P4)
FNDCM2:	HLRZ T1,(P1)		;GET TYPE CODE
	CAIE T1,.CMFLD		;ANYTHING THERE?
	JRST FNDCM5		;NO
	AOS Q3			;COUNT UP ITEMS ENTERED BY USER
	MOVE T1,[DOCTAB,,VALTAB]
	HRLZ T2,P2		;GET COUNT OF ITEMS FOUND SO FAR
	HRRI T2,NUMTAB		;GET ADR OF COUNT TABLE
	MOVE T3,P4		;GET TYPE (0 = KEYWORD, 1 = AUTHOR)
	SKIPG P3		;ALLOW ADDITIONS?
	HRROS T3		;YES
	MOVE T4,P1		;GET POINTER TO KEYWORD PHRASE
	HRRZ T4,(T4)		;GET ADR OF STRING
	XCT [	ADD T4,KEYWRD
		ADD T4,AUTHOR](P4)
	HRLI T4,(POINT 7,0)	;SET UP BYTE POINTER
	MOVE Q1,FDATE		;GET FROM DATE
	MOVE Q2,TDATE		;GET TO DATE
	CALL BLDLST		;GO BUILD THE LIST
	MOVE P2,T1		;SAVE THE NUMBER IN TABLE
	AOS P1			;STEP TO NEXT KEYWORD
	HLRZ T2,(P1)		;GET TYPE CODE
	CAIN T2,.CMCMA		;COMMA?
	AOS P1			;YES, STEP TO NEXT ENTRY
	HLRZ T2,(P1)		;GET TYPE CODE
	CAIN T2,.CMFLD		;ANOTHER FIELD?
	JRST FNDCM2		;YES, GO NARROW DOWN THE LIST
FNDCM5:	MOVE P3,P2		;SAVE COUNT
	SKIPG P4		;DONE?
	AOJA P4,FNDCM4		;NO, GO DO AUTHOR

	JUMPLE P2,[WARN (<JRST LEVEL0>,<NO DOCUMENTS MATCH THESE SPECIFICATIONS>)]
	MOVN Q1,P2		;SET UP A COUNTER
	HRLZS Q1
FNDCM3:	MOVEI T1,DOCTAB		;SORT THE TABLE
	MOVEI T2,VALTAB
	MOVEI T3,NUMTAB
	MOVE T4,P2		;GET COUNT OF ITEMS
	CALL SORTV
	MOVE T1,P5		;GET JFN TO USE
	MOVE T2,[DOCTAB,,VALTAB]
	HRL T3,P2		;GET COUNT
	HRRI T3,NUMTAB		;GET ADR OF NUMTAB
	MOVE T4,Q3		;GET THE COUNT OF REQUIRED ITEMS 
	CALL OUTDL		;OUTPUT THE LIST
	MOVE T1,P5		;GET JFN
	CAIN T1,.PRIOU
	JRST LEVEL0
	CLOSF			;CLOSE IT
	 WARN (,<COULD NOT CLOSE THE OUTPUT FILE>)
	JRST LEVEL0
;ROUTINE TO OUTPUT THE DOC LIST
;ACCEPTS IN T1/	JFN
;	    T2/	ADR OF DOC TABLE,,ADR OF VALUE TABLE
;	    T3/	COUNT OF ITEMS,,ADR OF COUNT TABLE
;	    T4/	MINIMUM # OF MATCHES REQUIRED
;	CALL OUTDL
;RETURNS +1:	ALWAYS

OUTDL:	SAVEPQ
	DMOVE P1,T1		;SAVE THE ARGS
	DMOVE P3,T3
	SETZ P5,		;INIT COUNT
	HLRE T1,P3		;GET COUNT
	JUMPLE T1,OUTDL5	;IF NONE, GIVE ERROR MESSAGE
	HLRZ Q2,P3		;GET COUNT
	MOVNS Q2		;BUILD COUNTER
	HRLZS Q2
OUTDL3:	HRRZ T4,P3		;GET ADR OF NUMBER TABLE
	ADDI T4,(Q2)		;GET ADR OF ENTRY
	CAMLE P4,(T4)		;FOUND A MATCH?
	JRST OUTDL4		;NO
	MOVE T1,P1		;GET THE JFN
	HLRZ T4,P2		;GE ADR OF DOC TABLE
	ADDI T4,(Q2)
	MOVE T2,(T4)		;GET DOC NUMBER
	HRRZ T4,P2		;GET VALUE TABLE
	ADDI T4,(Q2)
	MOVE T3,(T4)		;GET VALUE
	CALL OUTDOC		;OUTPUT THE DOC
	AOS P5			;COUNT UP THE DOC'S OUTPUT
OUTDL4:	AOBJN Q2,OUTDL3		;LOOP BACK FOR ALL DOC'S
	JUMPLE P5,OUTDL5	;IF NONE FOUND,...
	RET			;DONE

OUTDL5:	MOVE T1,P1		;GET THE JFN
	HRROI T2,[ASCIZ/
NO DOCUMENTS MATCH THESE SPECIFICATIONS
/]
	SETZ T3,
	SOUT
	RET
;ROUTINE TO SORT THE DOC TABLE
;ACCEPTS IN T1/	DOC TABLE ADR
;	    T2/	VALUE TABLE ADR
;	    T3/	COUNT TABLE ADR
;	    T4/	# OF ELEMENTS TO SORT

SORTV:	SAVEPQ
	JUMPE T4,R		;IF NONE TO DO, THEN EXIT
	DMOVE P1,T1		;SAVE THE ARGS
	DMOVE P3,T3
SORTV1:	SETZ Q3,		;INIT THE COUNT
	MOVN Q1,P4		;GET COUNT
	HRLZS Q1		;BUILD AOBJN POINTER
	HRRZ T4,Q1		;GET FIRST ENTRY
	ADD T4,P2		;GET VALUE
	MOVE Q2,(T4)		;START WITH THE FIRST VALUE
	AOBJP Q1,R		;IFONLY ONE ENTRY, THEN DONE
SORTV2:	HRRZ T4,Q1		;GET VALUE ENTRY
	ADD T4,P2
	CAML Q2,(T4)		;OUT OF ORDER?
	JRST SORTV3		;NO
	MOVE T1,-1(T4)		;YES, SWAP VALUES
	EXCH T1,(T4)
	MOVEM T1,-1(T4)
	HRRZ T3,Q1		;NOW SWAP DOC NUMBERS
	ADD T3,P1
	MOVE T1,-1(T3)		;GET PREVIOUS DOC NUMBER
	EXCH T1,(T3)
	MOVEM T1,-1(T3)		;STORE DOC NUMBER
	HRRZ T3,Q1		;NOW SWAP COUNT
	ADD T3,P3
	MOVE T1,-1(T3)
	EXCH T1,(T3)
	MOVEM T1,-1(T3)
	AOS Q3			;COUNT UP NUMBER OF SWAPS DONE
SORTV3:	MOVE Q2,(T4)		;GET THE NEW VALUE
	AOBJN Q1,SORTV2		;LOOP BACK 
	JUMPG Q3,SORTV1		;IF ANY SWITCHES MADE, GO BACK AGAIN
	RET			;DONE
;ROUTINE TO BUILD THE LIST OF THE DOC #'S MATCHING THE KEYWORDS

;ACCEPTS IN T1/	ADR OF DOC LIST,,ADR OF VALUE LIST
;	    T2/	# OF ITEMS IN LIST ALREADY,,ADR OF COUNT TABLE
;	    T3/	LH=0 - DO NOT ADD TO LIST
;		    -1 - ADD TO LIST
;		RH=0 = KEYWORDS, 1 = AUTHORS
;	    T4/	POINTER TO THE PHRASE STRING
;	    Q1/	TO DATE
;	    Q2/	FROM DATE
;	CALL BLDLST
;RETURNS +1:	ALWAYS, T1/ # OF ITEMS NOW ON THE LIST

BLDLST:	SAVEPQ
	STKVAR <BLDLSA,BLDLSN,BLDLSP,BLDLSC,BLDLSO,BLDLSF,BLDLTD,BLDLFD>
	MOVEM T1,BLDLSA		;SAVE ADR OF LISTS
	HRRZM T2,BLDLSC		;SAVE THE ADR OF THE COUNT TABLE
	HLRES T2		;SAVE THE START COUNT
	SKIPGE T2		;ANYTHING THERE YET
	SETZ T2,		;NO, START AT 0
	MOVEM T2,BLDLSN		;SAVE THE COUNT
	MOVEM T4,BLDLSP		;SAVE THE POINTER TO THE PHRASE
	MOVEM T4,BLDLSO		;SAVE THE ORIGINAL POINTER TO PHRASE ALSO
	HLREM T3,BLDLSF		;SAVE CREATE FLAG
	HRRES T3		;GET COUNT
	MOVEM Q1,BLDLFD		;SAVE FROM DATE
	MOVEM Q2,BLDLTD		;SAVE TO DATE
	CAIG T3,1		;TOO BIG?
	JUMPL T3,BLDLS4		;NO, NEGATIVE?
	MOVE P4,T3		;SAVE INDEX
BLDLS0:	MOVE T1,BLDLSP		;GET POINTER TO PHRASE
	MOVE T2,P4		;GET TYPE 
	CALL FNDLST		;FIND THE NEXT LIST BLOCK
	 JRST BLDLS4		;NONE FOUND
	MOVEM T1,BLDLSP		;SAVE UPDATED POINTER TO PHRASE
	MOVE Q1,T2		;GET POINTER TO LIST BLOCK
BLDLS1:	MOVE Q2,Q1		;GET POINTER TO LIST BLOCK
	ADDI Q2,LST1WD		;GET ADR OF FIRST WORD IN BLOCK
	MOVEI Q3,LSTNWD		;GET COUNT
BLDLS2:	MOVE T1,Q2		;GET ADR OF NEXT WORD IN BLOCK
	CALL MAPBLK		;MAP IT
	SKIPN P1,(T1)		;IS THERE A DOC #?
	JRST BLDLS3		;NO
	MOVE T1,P1		;GET DOC #
	CALL MAPDOC		;MAP IT
	SKIPN T1,(T1)		;ONE THERE?
	JRST BLDLS3		;NO
	CALL MAPBLK		;MAP THE DOC BLOCK
	JN DSDEL,(T1),BLDLS3	;IF DELETED, SKIP IT
	LOAD T2,DOCDAT,(T1)	;GET THE DATE
	MOVE T3,BLDLFD		;GET FROM DATE
	CAMGE T2,T3		;PAST FROM DATE?
	JUMPN T3,BLDLS3		;IF ONE IS SET
	MOVE T3,BLDLTD		;GET TO DATE
	CAMLE T2,T3		;BEFORE TO DATE
	JUMPN T3,BLDLS3		;IF ONE SPECIFIED
	MOVE T1,P1		;GET THE DOC #
	MOVE T2,BLDLSO		;GET ORIGINAL POINTER TO PHRASE
	MOVE T3,P4		;GET TYPE
	CALL GETVAL		;GET VALUE FOR THIS DOC #
	 SETZ T1,		;NO MATCH
	MOVE T2,T1		;GET VALUE
	MOVE P2,T1		;SAVE THE VALUE
	MOVE T1,P1		;GET DOC #
	MOVE T3,BLDLSA		;GET ADR OF DOC LIST
	HRLZ T4,BLDLSN		;GET COUNT
	HRR T4,BLDLSC		;AND ADR OF COUNT TABLE
	CALL UPDLST		;UPDATE THE LIST
	 SKIPL BLDLSF		;GO ADD THIS ENTRY
	JRST BLDLS3		;ADDED TO LIST
	JUMPLE P2,BLDLS3	;IF VALUE = 0, THEN DONT ADD IT
	HLRZ T1,BLDLSA		;GET DOC TABLE ADR
	ADD T1,BLDLSN		;GET END OF TABLE
	MOVEM P1,(T1)		;PUT DOC # AT END OF TABLE
	HRRZ T1,BLDLSA		;GET VALUE TABLE ADR
	ADD T1,BLDLSN		;GET END OF TABLE
	MOVEM P2,(T1)		;STORE VALUE IN TABLE
	MOVE T1,BLDLSC		;GET ADR OF COUNT TABLE
	ADD T1,BLDLSN		;GET END OF TABLE
	MOVEI T2,1		;SET IT TO 1
	MOVEM T2,(T1)
	AOS T1,BLDLSN		;UPDATE THE COUNT
	CAIL T1,DOCTBL		;TOO MANY WORDS?
	WARN (<SOS BLDLSN>,<OVERFLOWED INTERNAL SORT TABLE>)
BLDLS3:	AOS Q2			;STEP TO NEXT DOC #
	SOJG Q3,BLDLS2		;LOOP BACK IF ANY MORE
	MOVE T1,Q1		;SEE IF THERE IS ANOTHER LIST BLOCK
	CALL MAPBLK
	LOAD Q1,LSTPTR,(T1)	;GET POINTER TO NEXT BLOCK
	JUMPN Q1,BLDLS1		;LOOP BACK IF ANY THERE
	JRST BLDLS0		;GO TRY FOR THE NEXT WORD IN PHRASE

BLDLS4:	MOVE T1,BLDLSN		;GET COUNT OF ENTRIES IN TABLE
	RET			;DONE
;ROUTNE TO FIND THE LIST BLOCK FOR NEXT WORD IN PHRASE STRING
;ACCEPTS IN T1/	POINTER TO PHRASE STRING
;	    T2/	0=KEYWORD, 1=AUTHOR
;	CALL FNDLST
;RETURNS +1:	NONE FOUND
;	 +2:	T1/	UPDATED POINTER TO PHRASE STRING
;		T2/	ADR OF LIST BLOCK
;		T3/	# OF WORDS SCANNED IN PHRASE STRING

FNDLST:	SAVEPQ
	STKVAR <FNDLSP,<FNDLSS,MAXSTW>>
	MOVEM T1,FNDLSP		;SAVE POINTER TO STRING
	MOVE P4,T2		;SAVE THE INDEX
	SETZ P3,		;INIT COUNT OF WORDS
FNDLS1:	MOVE T1,FNDLSP		;GET POINTER TO PHRASE
	HRROI T2,FNDLSS		;POINTER TO ANSWER STRING
	SETZ T3,		;NO STRING FOR WORD
	CALL REDUCE		;GET REDUCED WORD
	 RET			;NO MORE WORDS
	MOVEM T1,FNDLSP		;SAVE THE POINTER
	AOS P3			;COUNT UP WORDS SEEN
	HRROI T1,FNDLSS		;GET POINTER TO REDUCED WORD
	MOVEI T4,DBPAG0_11
	XCT [	MOVE T2,KEYPTR(T4) ;GET ADR OF TABLE
		MOVE T2,AUTPTR(T4)](P4)
	XCT [	MOVE T3,KEYLEN(T4) ;GET LENGTH OF TABLE
		MOVE T3,AUTLEN(T4)](P4)
	SETZ T4,		;DO NOT ALLOW CREATION OF LIST BLOCKS
	CALL TABADD		;GO FIND THE LIST BLOCK
	 JRST [	LDB T1,FNDLSP	;REACHED THE END?
		JUMPN T1,FNDLS1	;NO, GO BACK FOR MORE
		RET]		;DONE
	MOVE T2,T1		;GET ADR OF LIST BLOCK
	MOVE T1,FNDLSP		;GET UPDATED STRING POINTER
	MOVE T3,P3		;GET COUNT OF WORDS SEEN
	RETSKP			;DONE
;ROUTINE TO UPDATE THE VALUE OF A DOC # IN THE DOC LIST
;ACCEPTS IN T1/	DOC #
;	    T2/	VLAUE
;	    T3/	ADR OF DOC LIST,,ADR OF VALUE LIST
;	    T4/	# OF ELEMENTS IN LIST,,ADR OF COUNT TABLE
;	CALL UPDLST
;RETURNS +1:	DOC # NOT FOUND
;	 +2:	OK, VALUE UPDATED

UPDLST:	SAVEPQ
	DMOVE P1,T1
	DMOVE P3,T3		;SAVE THE ARGS
	HLRZ T1,P3		;GET DOC LIST
	HRRZ T2,P3		;GET VALUE LIST ADR
	HLRE T4,P4		;GET COUNT
	JUMPLE T4,R		;IF NO ENTRIES, EXIT
	MOVNS T4		;BUILD COUNTER
	HRLZS T4
UPDLS1:	HRRZ T3,T4		;GET COUNT
	ADD T3,T1		;GET ADR OF DOC WORD
	CAMN P1,(T3)		;A MATCH?
	JRST UPDLS2		;YES
	AOBJN T4,UPDLS1		;NO, LOOP THROUGH LIST
	RET			;NOT FOUND

UPDLS2:	HRRZ T3,T4		;GET INDEX AGAIN
	ADD T3,T2		;GET POINTER INTO THE VALUE TABLE
	FMPRM P2,(T3)		;MERGE IN THE VALUE
	HRRZ T3,P4		;GET COUNT TABLE ADR
	ADDI T3,(T4)		;ADD IN THE INDEX
	SKIPLE P2		;IS VALUE POSITIVE
	AOS (T3)		;UP THE COUNT BY ONE
	RETSKP			;DONE
;ROUTINE TO GET THE VALUE OF A DOC # MATCHING A TEST PHRASE
;ACCEPTS IN T1/	DOC #
;	    T2/	POINTER TO PHRASE STRING
;	    T3/	0=KEYWORD, 1=AUTHOR
;	CALL GETVAL
;RETURNS +1:	NO MATCH
;	 +2:	T1/	VALUE

GETVAL:	SAVEPQ
	STKVAR <GETVAD,GETVAP,GETVAV>
	MOVEM T1,GETVAD		;SAVE DOC #
	MOVEM T2,GETVAP		;SAVE THE POINTER
	MOVE P4,T3		;SAVE THE INDEX
	CALL CHKDOC		;CHECK THE DOC #
	 RET
	MOVE T1,GETVAD		;GET THE DOC #
	MOVE T2,GETVAP		;AND POINTER
	MOVEI T3,0		;DO THE TITLE FIRST
	SKIPN P4		;KEYWORD?
	CALL GETVT		;GET VALUE OF TITLE MATCH
	 SETZ T1,		;NO MATCH
	MOVEM T1,GETVAV		;SAVE THE VALUE
	MOVE T1,GETVAD		;GET DOC #
	MOVE T2,GETVAP		;GET PHRASE
	MOVEI T3,1		;COMPARE LOCATION STRING
	SKIPN P4		;KEYWORD?
	CALL GETVT		;YES
	 SETZ T1,		;NO MATCH
	CAMLE T1,GETVAV		;NEW HIGH?
	MOVEM T1,GETVAV		;YES, REMEMBER IT
	MOVE T1,GETVAD		;GET DOC #
	CALL MAPDOC		;MAP IT
	SKIPN T1,(T1)		;ANY THERE?
	 RET			;NO
	CALL MAPBLK		;MAP THE DOC BLOCK
	XCT [	LOAD Q1,DOCKEY,(T1) ;GET ADR OF LIST BLOCK
		LOAD Q1,DOCAUT,(T1)](P4)
	JUMPE Q1,R		;IF NONE, THEN DONE
GETVA1:	MOVE Q2,Q1		;GET ADR OF STRING BLOCK
	ADDI Q2,STR1WD		;GE ADR OF 1ST WORD IN BLOCK
	MOVEI Q3,STRNWD
GETVA2:	MOVE T1,Q2		;GET ADR OF WORD IN BLOCK
	CALL MAPBLK		;MAP IT
	SKIPN T1,(T1)		;GET ADR OF ASCIZ BLOCK
	JRST GETVA3		;NONE THERE
	MOVE T2,GETVAP		;GET POINTER TO PHRASE
	CALL CMPPHR		;COMPARE THE PHRASES
	 SETZ T1,		;NO MATCH
	CAMLE T1,GETVAV		;NEW HIGH?
	MOVEM T1,GETVAV		;YES, SAVE THE HIGHEST MATCH VALUE
GETVA3:	AOS Q2			;STEP TO NEXT WORD
	SOJG Q3,GETVA2		;LOOP BACK FOR EACH STRING
	MOVE T1,Q1		;GE ADR OF STRING BLOCK AGAIN
	CALL MAPBLK		;MAP IT
	LOAD Q1,STRPTR,(T1)	;IS THERE ANOTHER BLOCK?
	JUMPN Q1,GETVA1		;IF YES, GO LOOK AT IT
	MOVE T1,GETVAV		;GET THE VALUE
	JUMPE T1,R		;ANY MATCHES?
	RETSKP			;YES
;ROUTINE TO GET VALUE OF TITLE/PHRASE COMPARISON
;ACCEPTS IN T1/	DOC #
;	    T2/	POINTER TO PHRASE
;	    T3/	0 = TITLE, 1 = LOCATION
;	CALL GETVT
;RETURNS +1:	NO MATCH
;	 +2:	T1/	VALUE

GETVT:	SAVEQ
	DMOVE Q1,T1		;SAVE THE ARGS
	MOVE Q3,T3		;SAVE INDEX
	CALL MAPDOC		;MAP THE DOC
	SKIPN T1,(T1)		;ANY THERE?
	RET			;NO
	CALL MAPBLK		;MAP DOC BLOCK
	XCT [	LOAD T1,DOCTTL,(T1)	;GET POINTER TO TITLE
		LOAD T1,DOCLOC,(T1)](Q3)
	JUMPE T1,R		;NONE
	MOVE T2,Q2		;GET POINTER TO PHRASE
	CALL CMPPHR		;COMPARE THEM
	 RET			;NO MATCH
	RETSKP			;DONE
;ROUTINE TO COMPARE TWO PHRASES
;ACCEPTS IN T1/	ADR OF ASCIZ STRING BLOCK
;	    T2/	POINTER TO PHRASE
;	CALL CMPPHR
;RETURNS +1:	NO MATCH
;	 +2:	T1/	VALUE

CMPPHR:	SAVEQ
	DMOVE Q1,T1		;SAVE THE ANSWERS
	CALL CMPPH0		;COMPARE THE STRINGS
	 RET			;FAILED
	MOVEM T1,Q3		;SAVE VALUE
	DMOVE T1,Q1		;GET ARGS AGAIN
	CALL CMPP0E		;COMPARE AGAIN (ONLY REVERSED)
	 RET
	CAMLE T1,Q3		;GET THE LOWEST VALUE
	MOVE T1,Q3
	RETSKP			;DONE

CMPPH0:	TDZA T4,T4		;SET THE FLAG
CMPP0E:	MOVEI T4,1
	SAVEPQ
	MOVE P4,T4		;REMEMBER THE FLAG
	STKVAR <CMPPHO,CMPPHP,CMPPHV,CMPPHC,CMPPHT,<CMPPHS,MAXSTW>,<CMPPW1,MAXSTW>,<CMPPW2,MAXSTW>,<CMPPW3,MAXSTW>,<CMPPW4,MAXSTW>>
	SETZM CMPPHV		;INIT VALUE WORD
	JUMPE T1,CMPPH7		;IF NO ASCIZ STRING, THEN NO MATCH
	MOVEM T2,CMPPHO		;SAVE THE ORIGINAL POINTER
	CALL MAPBLK		;MAP THE STRING
	HRLI T1,(POINT 7,0)	;SET UP BYTE POINTER
	MOVEI T2,CMPPHS		;SET UP TO COPY STRING TO MEMORY
	HRLI T2,(POINT 7,0)
	MOVEI T4,MAXSTW*5-1	;SET UP COUNTER
CMPPH1:	ILDB T3,T1		;GET NEXT CHAR
	IDPB T3,T2		;STORE IN STRING
	SOJLE T4,[WARN (<RET>,<STRING TOO LONG>)]
	JUMPN T3,CMPPH1		;LOOP BACK TIL STRING COPIED TO STACK
	HRROI T1,CMPPHS		;GET POINTER TO STRING
	SKIPE P4		;REVERSE THE STRINGS?
	EXCH T1,CMPPHO		;YES
	MOVEM T1,CMPPHP		;INIT POINTER TO PHRASE
	SETZM CMPPHC		;INIT COUNT
CMPPH2:	MOVE T1,CMPPHP		;GET POINTER TO STRING
	HRROI T2,CMPPW3		;GET POINTER TO REDUCED ANSWER STRING
	HRROI T3,CMPPW1		;PLACE TO STORE WORD
	CALL REDUCE		;GET REDUCED WORD
	 JRST CMPPH7		;NO MORE WORDS
	MOVEM T1,CMPPHP		;SAVE UPDATED POINTER
	AOS CMPPHC		;UP THE COUNT
	SETZM CMPPHT		;INIT TEMP VALUE
	MOVE Q1,CMPPHO		;GET ORIGINAL POINTER TO PHRASE
CMPPH3:	MOVE T1,Q1		;GET POINTER TO PHRASE
	HRROI T2,CMPPW4		;STRING TO HOLD REDUCED WORD
	HRROI T3,CMPPW2		;STRING TO GET WORD
	CALL REDUCE		;REDUCE THE PHRASE
	 JRST CMPPH6		;NO MORE WORDS
	MOVEM T1,Q1		;SAVE THE UPDATED STRING POINTER
	HRROI T1,CMPPW1		;GET POINTER TO WORD 1
	HRROI T2,CMPPW2		;GET POINTER TO WORD 2
	CALL CMPSUB		;COMPARE THEM
	 JRST CMPPH4		;NO MATCH
	JUMPE T1,[MOVE T1,[0.8]	;IF SUBSET, USE VALUE OF .8
		CAMLE T1,CMPPHT	;NEW MAX?
		MOVEM T1,CMPPHT	;YES
		JRST CMPPH5]
	MOVE T1,[1.0]		;IF EXACT MATCH, USE VALUE OF 1.0
	CAMLE T1,CMPPHT		;NEW MAX?
	MOVEM T1,CMPPHT		;YES
	JRST CMPPH5

CMPPH4:	HRROI T1,CMPPW2		;NOW LOOK FOR SUBSET IN OTHER DIRECTION
	HRROI T2,CMPPW1
	CALL CMPSUB		;COMPARE THEM
	 JRST [	HRROI T1,CMPPW3	;COMPARE THE FULLY REDUCED WORDS
		HRROI T2,CMPPW4
		CALL CMPEXA	;MUST BE AN EXACT MATCH
	 	 JRST CMPPH5	;NO MATCH
		MOVE T1,[0.1]	;THIS GETS A LITTLE VALUE
		CAMLE T1,CMPPHT	;NEW MAX?
		MOVEM T1,CMPPHT	;YES
		JRST CMPPH5]
	MOVE T1,[0.6]		;SUBSET IS WORTH .6
	CAMLE T1,CMPPHT		;NEW MAX?
	MOVEM T1,CMPPHT		;YES
CMPPH5:	LDB T1,Q1		;SEE IF THE END WAS REACHED
	JUMPE T1,CMPPH6		;YES
	JRST CMPPH3		;LOOP BACK FOR OTHER WORDS

CMPPH6:	MOVE T1,CMPPHT		;GET VALUE
	FADRM T1,CMPPHV		;ADD THIS TO THE TOTAL
	LDB T1,CMPPHP		;WAS THE END REACHED?
	JUMPE T1,CMPPH7		;...
	JRST CMPPH2		;LOOP BACK FOR ANOTHER PHRASE

CMPPH7:	MOVE T1,CMPPHV		;GET VALUE
	FLTR T2,CMPPHC		;GET WORD COUNT
	FDVR T1,T2		;GET ADJUSTED VALUE
	SKIPG T1		;FOUND A MATCH?
	RET			;NO MATCH
	RETSKP			;FOUND SOMETHING
;ROUTINE TO COMPARE TWO STRING FOR EXACT MATCH
;ACCEPTS IN T1/	STRING POINTER
;	    T2/	STRING POINTER
;	CALL CMPEXA
;RETURNS +1:	NO MATCH
;	 +2:	EXACT MATCH

CMPEXA:	TLC T1,-1		;CONVERT POINTER
	TLCN T1,-1
	HRLI T1,(POINT 7,0)
	TLC T2,-1
	TLCN T2,-1
	HRLI T2,(POINT 7,0)
CMPEX1:	ILDB T3,T1		;GET CHAR
	ILDB T4,T2
	CAME T3,T4		;MATCH?
	RET			;NO, FAIL
	JUMPN T3,CMPEX1		;LOOP BACK TIL NULL
	RETSKP			;EXACT MATCH


;ROUTINE TO COMPARE FOR A SUBSET
;ACCEPTS IN T1/	STRING POINTER TO LONGER STRING
;	    T2/	STRING POINTER TO SHORTER STRING
;	CALL CMPSUB
;RETURNS +1:	NO MATCH
;	 +2:	T1/	0=SUBSTRING, -1=EXACT MATCH

CMPSUB:	TLC T1,-1		;INIT POINTERS
	TLCN T1,-1
	HRLI T1,(POINT 7,0)
	TLC T2,-1
	TLCN T2,-1
	HRLI T2,(POINT 7,0)
CMPSU1:	ILDB T3,T1		;GET CHARS
	ILDB T4,T2
	CAME T3,T4		;MATCH?
	JUMPN T4,R		;IF SHORTER NOT AT END, THEN FAIL
	JUMPN T4,CMPSU1		;IF NOT AT END, LOOP BACK
	SKIPE T3		;AT END OF BOTH STRINGS?
	TDZA T1,T1		;NO, SUBSTRING
	SETO T1,		;YES, EXACT MATCH
	RETSKP			;DONE

SETSTS:
SETDEL:
SETNDL:
SETOUT:
SETNOU:
SETNOT:
DELKEY:
	WARN (,<THIS FUNCTION IS NOT IMPLEMENTED YET>)
	JRST LEVEL0
;THE DELETE COMMAND

DELCMD:	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (KEY)
	HRRZ T1,(P1)		;GET DISPATCH ADR
	AOJA P1,(T1)		;DISPATCH

DELDOC:	HLRZ T1,(P1)		;GET TYPE CODE
	ANDI T1,777		;GET JUST THE TYPE CODE
	CHKTYP (NUM)
	HRRZ T1,(P1)		;GET NUMBER
	MOVE P4,ANSWER(T1)
	MOVE T1,P4		;GET DOC #
	CALL CHKDOC		;CHECK IT
	 WARN (<JRST LEVEL0>,<INVALID DOCUMENT #>)
	MOVE T1,P4		;GET NUMBER
	CALL MAPDOC		;MAP IT
	SKIPN T1,(T1)		;ONE THERE?
	WARN (<JRST LEVEL0>,<NO SUCH DOCUMENT #>)
	CALL MAPBLK		;MAP IN THE BLOCK
	SETONE DSDEL,(T1)	;DELETE THE DOCUMENT
	JRST LOGLV0		;GO LOG THIS
;THE UNDELETE COMMAND

UNDCMD:	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (KEY)
	HRRZ T1,(P1)		;GET DISPATCH ADR
	AOJA P1,(T1)		;DISPATCH

UNDDOC:	HLRZ T1,(P1)		;GET TYPE CODE
	ANDI T1,777		;GET JUST THE TYPE CODE
	CHKTYP (NUM)
	HRRZ T1,(P1)		;GET NUMBER
	MOVE P4,ANSWER(T1)
	MOVE T1,P4		;GET DOC #
	CALL CHKDOC		;CHECK IT
	 WARN (<JRST LEVEL0>,<INVALID DOCUMENT #>)
	MOVE T1,P4		;GET NUMBER
	CALL MAPDOC		;MAP IT
	SKIPN T1,(T1)		;ONE THERE?
	WARN (<JRST LEVEL0>,<NO SUCH DOCUMENT #>)
	CALL MAPBLK		;MAP IN THE BLOCK
	SETZRO DSDEL,(T1)	;UNDELETE THE DOCUMENT
	JRST LOGLV0		;GO LOG THIS
;THE "ADD" COMMAND

ADDCMD:	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (KEY)
	HRRZ T1,(P1)		;GET DISPATCH ADR
	AOJA P1,(T1)		;DISPATCH

;THE "ADD DOCUMENT" COMMAND

ADDDOC:	SETZ P4,		;INIT DOC NUMBER
	HLRZ T1,(P1)		;GET THE TYPE CODE
	ANDI T1,777
	HRRZ T2,(P1)		;GET POINTER TO NUMBER
	CAIE T1,.CMNUM		;NUMBER SPECIFIED?
	JRST ADDDO0		;NO
	MOVE P4,ANSWER(T2)	;GET DOC NUMBER SPECIFIED
	MOVE T1,P4
	CALL CHKDOC		;LEGAL?
	 WARN (<JRST LEVEL0>,<INVALID DOCUMENT NUMBER>)
	MOVE T1,P4		;GET DOC #
	CALL MAPDOC		;MAP IT
	SKIPE (T1)		;ONE THERE?
	WARN (<JRST LEVEL0>,<DOCUMENT NUMBER ALREADY IN USE>)
ADDDO0:	MOVE T1,DBJFN		;GET THE DATA BASE JFN
	CALL DEQJFN		;UNLOCK THE DATA BASE
	HRROI T1,[ASCIZ/   TITLE: /]
	MOVEI T2,ADDT		;GET PARSE TABLE ADR
	MOVEI T3,ANSWER		;GET ADR OF ANSWER BLOCK
	MOVEM T3,TITLE		;SAVE ADR OF ANSWER BLOCK
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "ADD TITLE" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,TITLE		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (TXT)

	HRROI T1,[ASCIZ/   AUTHOR: /]
	MOVEI T2,ADDA		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,AUTHOR		;SAVE ADR OF ANSWER BLOCK
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "ADD AUTHOR" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,AUTHOR		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (FLD)

	HRROI T1,[ASCIZ/   DATE: /]
	MOVEI T2,ADDD		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET THE ADR OF THE ANSWER BLOCK
	MOVEM T3,DATE		;SAVE THE ADR
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "ADD DATE" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,DATE		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (TAD)

	SETZM PDM		;INIT POINTER
REPEAT 0,<
	HRROI T1,[ASCIZ/   PDM: /]
	MOVEI T2,ADDP		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,PDM		;SAVE ADR
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "ADD PDM" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,PDM		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CAIE T1,.CMCFM		;CONFIRMED?
	CAIN T1,.CMTXT		;OR TEXT?
	SKIPA			;YES
	ERRMES (<UNEXPECTED TYPE CODE RETURNED IN PDM COMMAND>)
>

	SETZM FILNAM		;INIT POINTER
REPEAT 0,<
	HRROI T1,[ASCIZ/   FILE NAME: /]
	MOVEI T2,ADDF		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,FILNAM		;SAVE ADR
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "ADD FILE NAME" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,FILNAM		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CAIE T1,.CMCFM		;CONFIRMED?
	CAIN T1,.CMTXT		;OR TEXT?
	SKIPA			;YES
	ERRMES (<UNEXPECTED TYPE CODE RETURNED IN FIILE NAME COMMAND>)
>

	HRROI T1,[ASCIZ/   KEYWORDS: /]
	MOVEI T2,ADDK		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,KEYWRD
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "ADD KEYWORDS" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,KEYWRD		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (FLD)
	HRROI T1,[ASCIZ\   FILE CABINET NAME/FOLDER NAME: \]
	MOVEI T2,ADDL		;GET PARSE TABLE ADR
	MOVE T3,Q1		;GET ADR OF ANSWER BLOCK
	MOVEM T3,LOCATN		;SAVE ADR
	CALL PARSE		;PARSE THE LINE
	 ERRMES <ILLEGALLY FORMATTED "ADD LOCATION" TABLE>
	MOVE Q1,T2		;SAVE THE END OF THE ANSWER BLOCK
	CALL COPCMD		;COPY THE COMMAND TO THE BUFFER
	MOVE P1,LOCATN		;GET ADR OF ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CAIE T1,.CMCFM		;CONFIRMED?
	CAIN T1,.CMTXT		;OR TEXT?
	SKIPA			;YES
	ERRMES (<UNEXPECTED TYPE CODE RETURNED IN LOCATION COMMAND>)

	MOVE T1,DBJFN		;GET THE DATA BASE JFN
	CALL ENQJFN		;LOCK THE DATA BASE
	MOVE T1,P4		;GET DOC # (IF ANY SPECIFIED)
	CALL TADDOC		;GO GET A DOC NUMBER
	 JRST ADDDO3		;FAILED
	DMOVE Q1,T1		;SAVE DOC # AND BLOCK ADR
	MOVE T1,Q2		;GET BLOCK ADR
	CALL MAPBLK		;MAP IT IN
	STOR Q1,DOCNUM,(T1)	;STORE THE DOC #
	MOVE T2,DATE		;GET ADR OF DATE
	HRRZ T3,(T2)
	ADD T3,DATE		;GET POINTER TO DATE WORD
	MOVE T3,(T3)		;GET DATE
	STOR T3,DOCDAT,(T1)	;STORE IT IN THE BLOCK
	MOVE T1,TITLE		;GET POINTER TO ANSWER BLOCK
	HRRZ T1,(T1)		;GET POINTER TO STRING
	ADD T1,TITLE		;ADD IN THE OFFSET
	HRLI T1,(POINT 7,0)	;BUILD A BYTE POINTER
	 MOVE Q3,T1		;SAVE POINTER TO STRING
	CALL COPSTR		;COPY THE STRING INTO THE FILE
	 JRST ADDDO3		;FAILED TO GET ROOM
	EXCH Q3,T1		;SAVE THE ADR OF THE STRING BLOCK
	MOVE T2,T1		;GET POINTER TO STRING INTO T2
	MOVE T1,Q1		;GET DOC NUMBER
	SETZ T3,		;DONT ALLOW NEW KEYWORDS TO BE ADDED
	CALL SADD		;GO ADD THESE KEYWORDS
	 JFCL			;DONT WORRY IF NO ENTRY MADE
	MOVE T1,Q2		;GET THE ADR OF THE DOC BLOCK
	CALL MAPBLK		;MAP IN THE DOC BLOCK
	STOR Q3,DOCTTL,(T1)	;STORE THE STRING ADR IN THE DOC BLOCK
	MOVE T1,PDM		;GET POINTER TO ANSWER BLOCK
	JUMPE T1,ADDDO4		;IF NONE, SKIP IT
	HLRZ T2,(T1)		;GET THE TYPE CODE
	CAIE T2,.CMTXT		;TEXT?
	JRST ADDDO4		;NO, SKIP IT
	HRRZ T1,(T1)		;GET POINTER TO STRING
	ADD T1,PDM		;ADD IN THE OFFSET
	HRLI T1,(POINT 7,0)	;BUILD A BYTE POINTER
	CALL COPSTR		;COPY THE STRING INTO THE FILE
	 JRST ADDDO3		;FAILED TO GET ROOM
	MOVE Q3,T1		;SAVE THE ADR OF THE STRING BLOCK
	MOVE T1,Q2		;GET THE ADR OF THE DOC BLOCK
	CALL MAPBLK		;MAP IN THE DOC BLOCK
	STOR Q3,DOCPDM,(T1)	;STORE THE STRING ADR IN THE DOC BLOCK
ADDDO4:	MOVE T1,LOCATN		;GET POINTER TO ANSWER BLOCK
	HLRZ T2,(T1)		;GET THE TYPE CODE
	CAIE T2,.CMTXT		;TEXT?
	JRST ADDDO5		;NO, SKIP IT
	HRRZ T1,(T1)		;GET POINTER TO STRING
	ADD T1,LOCATN		;ADD IN THE OFFSET
	HRLI T1,(POINT 7,0)	;BUILD A BYTE POINTER
	MOVE Q3,T1		;SAVE THE POINTER
	CALL COPSTR		;COPY THE STRING INTO THE FILE
	 JRST ADDDO3		;FAILED TO GET ROOM
	EXCH Q3,T1		;SAVE THE ADR OF THE STRING BLOCK
	MOVE T2,T1		;GET POINTER TO STRING INTO T2
	MOVE T1,Q1		;GET DOC NUMBER
	SETO T3,		;ALLOW NEW KEYWORDS TO BE ADDED IF NECESSARY
	CALL SADD		;GO ADD THESE KEYWORDS
	 JRST ADDDO3		;FAILED
	MOVE T1,Q2		;GET THE ADR OF THE DOC BLOCK
	CALL MAPBLK		;MAP IN THE DOC BLOCK
	STOR Q3,DOCLOC,(T1)	;STORE THE STRING ADR IN THE DOC BLOCK
ADDDO5:	MOVE T1,FILNAM		;GET POINTER TO ANSWER BLOCK
	JUMPE T1,ADDDO6		;IF NONE, SKIP IT
	HLRZ T2,(T1)		;GET THE TYPE CODE
	CAIE T2,.CMTXT		;TEXT?
	JRST ADDDO6		;NO, SKIP IT
	HRRZ T1,(T1)		;GET POINTER TO STRING
	ADD T1,FILNAM		;ADD IN THE OFFSET
	HRLI T1,(POINT 7,0)	;BUILD A BYTE POINTER
	CALL COPSTR		;COPY THE STRING INTO THE FILE
	 JRST ADDDO3		;FAILED TO GET ROOM
	MOVE Q3,T1		;SAVE THE ADR OF THE STRING BLOCK
	MOVE T1,Q2		;GET THE ADR OF THE DOC BLOCK
	CALL MAPBLK		;MAP IN THE DOC BLOCK
	STOR Q3,DOCFIL,(T1)	;STORE THE STRING ADR IN THE DOC BLOCK

ADDDO6:	MOVE Q3,KEYWRD		;GET ADR OF ANSWER BLOCK
ADDDO1:	MOVE T2,Q3		;GET POINTER TO NEXT FIELD
	HRRZ T2,(T2)
	ADD T2,KEYWRD		;GET ADR OF STRING
	HRLI T2,(POINT 7,0)	;MAKE A STRING POINTER
	MOVE T1,Q1		;GET DOC #
	CALL KSADD		;GO ADD THIS STRING TO TABLE
	 JRST ADDDO3		;FAILED
	AOS T2,Q3		;STEP TO NEXT POINTER IN BLOCK
	HLRZ T3,(T2)		;GET THE TYPE CODE
	CAIN T3,.CMFLD		;FIELD?
	JRST ADDDO1		;YES, LOOP BACK FOR KEYWORD
	CAIN T3,.CMCMA		;COMMA?
	AOJA Q3,ADDDO1		;YES, LOOP BACK FOR NEXT STRING

	MOVE Q3,AUTHOR		;GET ADR OF ANSWER BLOCK
ADDDO2:	MOVE T2,Q3		;GET POINTER TO USER
	HRRZ T2,(T2)
	ADD T2,AUTHOR		;GET ADR OF FIRST STRING
	HRLI T2,(POINT 7,0)	;MAKE A STRING POINTER
	MOVE T1,Q1		;GET DOC #
	CALL ASADD		;GO ADD THIS STRING TO TABLE
	 JRST ADDDO3		;FAILED
	AOS T2,Q3		;STEP TO NEXT POINTER IN BLOCK
	HLRZ T3,(T2)		;GET THE TYPE CODE
	CAIN T3,.CMUSR		;NEXT USER?
	JRST ADDDO2		;YES
	CAIN T3,.CMCMA		;COMMA?
	AOJA Q3,ADDDO2		;YES, LOOP BACK FOR NEXT STRING

	MOVEI T1,.PRIOU
	HRROI T2,[ASCIZ/
DOCUMENT NUMBER = /]
	SETZ T3,
	SOUT
	MOVE T2,Q1		;GET THE DOCUMENT NUMBER
	MOVEI T3,12
	NOUT
	 JFCL
	HRROI T2,[ASCIZ/

/]
	SETZ T3,
	SOUT
	JRST LOGLV0		;DONE

ADDDO3:	WARN (,<FAILED TO ADD THIS DOCUMENT TO THE DATA BASE>)
	JRST LEVEL0
;ROUTINE TO ADD A DOCUMENT BLOCK TO THE DOCUMENT INDEX
;ACCEPTS IN T1/	DOC # TO USE (OR 0 IF FREE CHOICE)
;	CALL TADDOC
;RETURNS +1:	FAILED
;	 +2:	T1/	DOCUMENT #
;		T2/	BLOCK ADR WITHIN FILE

TADDOC:	SAVEPQ
	MOVE P1,T1		;GET DOC NUMBER
	MOVEI Q3,DBPAG0_11	;GET THE ADR OF PAGE 0
	JUMPE P1,TADDO1		;FREE CHOICE?
	MOVE T1,P1		;NO, USE THIS ONE
	CALL CHKDOC		;CHECK IT
	 RET
	CALL MAPDOC		;MAP IT
	SKIPE (T1)		;IN USE?
	RET			;YES, FAIL
TADDO1:	MOVEI T1,DOCSIZ		;GET THE SIZE OF A DOC BLOCK
	MOVEI T2,TYPDOC		;GET TYPE CODE
	MOVEI T3,VERDOC		;GET VERSION NUMBER
	CALL ASGFRE		;GET FREE SPACE
	 RET			;NONE LEFT
	MOVE Q2,T1		;SAVE THE BLOCK ADR
	JUMPLE P1,TADDO2	;USING A SPECIAL NUMBER?
	CAML P1,NXTDOC(Q3)	;NEW HIGH?
	MOVEM P1,NXTDOC(Q3)	;YES, REMEMBER IT
	SKIPA Q1,P1
TADDO2:	AOS Q1,NXTDOC(Q3)	;GET THE NEXT DOC #
	CAML Q1,DOCLEN(Q3)	;ANY ROOM LEFT?
	JRST [	SOS NXTDOC(Q3)	;NO, BACK OFF
		RET]
	MOVE T1,Q1		;GET ADR OF DOC INDEX WORD
	CALL MAPDOC		;MAP IT
	MOVEM Q2,(T1)		;POINT TO THE NEW DOC BLOCK
	DMOVE T1,Q1		;GET THE ANSWERS
	RETSKP			;DONE
;ROUTINE TO MAP A DOCUMENT INDEX PAGE
;ACCEPTS IN T1/	DOC #
;	CALL MAPDOC
;RETURNS +1:	T1/	ADR OF MAPPED WORD

MAPDOC:	MOVEI T2,DBPAG0_11
	ADD T1,DOCPTR(T2)	;GET ADR OF WORD IN FILE
	CALL MAPBLK		;MAP IT
	RET			;DONE


;ROUTINE TO CHECK THE LEGALITY OF A DOC #
;ACCEPTS IN T1/	DOC #
;	CALL CHKDOC
;RETURNS +1:	ILLEGAL DOC #
;	 +2:	OK

CHKDOC:	MOVEI T4,DBPAG0_11	;GET ADR OF PAGE 0
	JUMPLE T1,R		;NEGATIVE OR ZERO IS ILLEGAL
	CAML T1,DOCLEN(T4)	;IS IT BELOW THE TABLE LIMIT?
	RET			;NO, ILLEGAL
	RETSKP			;OK
;ROUTINE TO ADD A KEYWORD PHRASE TO A DOC BLOCK
;ACCEPTS IN T1/	DOC #
;	    T2/	STRING POINTER TO KEYWORD PHRASE
;	CALL KSADD
;RETURNS +1:	FAILED
;	 +2:	OK

KSADD:	SAVEPQ
	STKVAR <<KSADDS,MAXSTW>,KSADDP>
	DMOVE Q1,T1		;SAVE THE ARGS
	MOVEM T2,KSADDP		;SAVE THE ORIGINAL POINTER
KSADD1:	HRROI T2,KSADDS		;GET ANSWER STRING POINTER
	MOVE T1,Q2		;GET POINTER TO SOURCE STRING
	SETZ T3,		;NO STRING FOR WORD
	CALL REDUCE		;GET REDUCED KEYWORD TO HASH
	 JRST KSADD2		;NO MORE
	MOVE Q2,T1		;SAVE UPDATED STRING POINTER
	MOVE T1,Q1		;GET DOC #
	HRROI T2,KSADDS		;GET POINTER TO KEYWORD
	SETO T3,		;ALLOW NEW CREATIONS
	CALL KADDOC		;GO ADD IT
	 RET			;FAILED
	LDB T1,Q2		;SEE IF THE LAST CHAR WAS A NULL
	JUMPN T1,KSADD1		;IF NOT, LOOP BACK TIL DONE
KSADD2:	MOVE T1,Q1		;GET THE DOC #
	CALL MAPDOC		;MAP IN THE INDEX BLOCK
	MOVE Q3,(T1)		;GET ADR OF DOC BLOCK
	MOVE T1,Q3		;GET DOC BLOCK
	CALL MAPBLK		;MAP IT IN
	LOAD T2,DOCKEY,(T1)	;GET POINTER TO STRING LIST
	JUMPN T2,KSADD3		;ONE THERE?
	MOVEI T1,STRSIZ		;NO
	MOVEI T2,TYPSTB		;BUILD A STRING BLOCK
	MOVEI T3,VERSTR
	CALL ASGFRE
	 RET
	MOVE P1,T1		;SAVE THE LIST BLOCK ADR
	MOVE T1,Q3		;MAP IN THE DOC BLOCK AGAIN
	CALL MAPBLK
	STOR P1,DOCKEY,(T1)	;MAKE DOC BLOCK POINT TO THE LIST BLOCK
KSADD3:	MOVE T1,Q3		;GET THE DOC BLOCK
	CALL MAPBLK
	LOAD T2,DOCKEY,(T1)	;GET POINTER TO STRING BLOCK
	MOVE T1,KSADDP		;GET TEMP STRING POINTER
	CALL STRADD		;GO ADD THIS STRING TO THE BLOCK
	 RET			;FAILED
	RETSKP			;DONE
;ROUTINE TO ADD A DOCUMENT TO A KEYWORD LIST AND DOC BLOCK
;ACCEPTS IN T1/	DOC #
;	    T2/	POINTER TO TEMP KEYWORD STRING
;	    T3/	0 = DONT ADD NEW KEYWORDS IF NECESSARY
;		-1 = ADD NEW KEYWORDS IF NECESSARY
;	CALL KADDOC
;RETURNS +1:	FAILED
;	 +2:	DONE

KADDOC:	SAVEQ
	DMOVE Q1,T1		;SAVE THE ARGS
	MOVE Q3,T3		;SAVE INDEX
	CALL CHKDOC		;LEGAL DOC #?
	 RET			;NO
	MOVE T1,Q2		;GET POINTER TO STRING
	MOVEI T4,DBPAG0_11	;GET INDEX OF PAGE 0
	MOVE T2,KEYPTR(T4)	;GET ADR OF KEYWORD TABLE
	MOVE T3,KEYLEN(T4)	;GET LENGTH
	MOVE T4,Q3		;GET CODE
	CALL TABADD		;ADD THE KEYWORD TO THE TABLE
	 RET			;FAILED
	MOVE T2,Q1		;GET DOC #
	CALL LADDOC		;ADD DOC # TO LIST POINTED TO BY T1
	 RET			;FAILED
	RETSKP			;DONE
;ROUTINE TO ADD THE LOC PHRASE TO THE KEYWORD LIST
;ACCEPTS IN T1/	DOC #
;	    T2/	STRING POINTER TO LOCATION PHRASE
;	    T3/	0 = DONT ALLOW NEW KEYWORD ADDITIONS
;		-1 = ALLOW NEW KEYWORD ADDITIONS
;	CALL SADD
;RETURNS +1:	FAILED
;	 +2:	OK

SADD:	SAVEPQ
	STKVAR <<SADDS,MAXSTW>,SADDP,SADDV>
	SETZM SADDV		;INIT COUNT OF FAILURES
	DMOVE Q1,T1		;SAVE THE ARGS
	MOVE Q3,T3		;SAVE FLAG
	MOVEM T2,SADDP		;SAVE THE ORIGINAL POINTER
SADD1:	HRROI T2,SADDS		;GET ANSWER STRING POINTER
	MOVE T1,Q2		;GET POINTER TO SOURCE STRING
	SETZ T3,		;NO STRING FOR WORD
	CALL REDUCE		;GET REDUCED KEYWORD TO HASH
	 JRST SADD2		;NO MORE
	MOVE Q2,T1		;SAVE UPDATED STRING POINTER
	MOVE T1,Q1		;GET DOC #
	HRROI T2,SADDS		;GET POINTER TO KEYWORD
	MOVE T3,Q3		;GET FLAG
	CALL KADDOC		;GO ADD IT
	 AOS SADDV		;COUNT UP FAILURES
	LDB T1,Q2		;SEE IF THE LAST CHAR WAS A NULL
	JUMPN T1,SADD1		;IF NOT, LOOP BACK TIL DONE
SADD2:	SKIPE SADDV		;IS COUNT OF FAILURES STILL 0?
	RET			;NO, GIVE ERROR RETURN
	RETSKP
;ROUTINE TO ADD A AUTHOR NAME TO A DOC BLOCK
;ACCEPTS IN T1/	DOC #
;	    T2/	STRING POINTER TO AUTHOR NAME
;	CALL ASADD
;RETURNS +1:	FAILED
;	 +2:	OK

ASADD:	SAVEPQ
	STKVAR <<ASADDS,MAXSTW>,ASADDP>
	DMOVE Q1,T1		;SAVE THE ARGS
	MOVEM T2,ASADDP		;SAVE THE ORIGINAL POINTER
ASADD1:	HRROI T2,ASADDS		;GET ANSWER STRING POINTER
	MOVE T1,Q2		;GET POINTER TO SOURCE STRING
	SETZ T3,		;NO STRING FOR WORD
	CALL REDUCE		;GET REDUCED KEYWORD TO HASH
	 JRST ASADD2		;NO MORE
	MOVE Q2,T1		;SAVE UPDATED STRING POINTER
	MOVE T1,Q1		;GET DOC #
	HRROI T2,ASADDS		;GET POINTER TO KEYWORD
	CALL AADDOC		;GO ADD IT
	 RET			;FAILED
	LDB T1,Q2		;SEE IF THE LAST CHAR WAS A NULL
	JUMPN T1,ASADD1		;IF NOT, LOOP BACK TIL DONE
ASADD2:	MOVE T1,Q1		;GET THE DOC #
	CALL MAPDOC		;MAP IN THE INDEX BLOCK
	MOVE Q3,(T1)		;GET ADR OF DOC BLOCK
	MOVE T1,Q3		;GET DOC BLOCK
	CALL MAPBLK		;MAP IT IN
	LOAD T2,DOCAUT,(T1)	;GET POINTER TO STRING LIST
	JUMPN T2,ASADD3		;ONE THERE?
	MOVEI T1,STRSIZ		;NO
	MOVEI T2,TYPSTB		;BUILD A STRING BLOCK
	MOVEI T3,VERSTR
	CALL ASGFRE
	 RET
	MOVE P1,T1		;SAVE THE LIST BLOCK ADR
	MOVE T1,Q3		;MAP IN THE DOC BLOCK AGAIN
	CALL MAPBLK
	STOR P1,DOCAUT,(T1)	;MAKE DOC BLOCK POINT TO THE LIST BLOCK
ASADD3:	MOVE T1,Q3		;GET THE DOC BLOCK
	CALL MAPBLK
	LOAD T2,DOCAUT,(T1)	;GET POINTER TO STRING BLOCK
	MOVE T1,ASADDP		;GET TEMP STRING POINTER
	CALL STRADD		;GO ADD THIS STRING TO THE BLOCK
	 RET			;FAILED
	RETSKP			;DONE
;ROUTINE TO ADD AN AUTHOR TO THE AUTHOR TABLE AND DOC BLOCK
;ACCEPTS IN T1/	DOC #
;	    T2/	POINTER TO AUTHOR STRING (TEMP)

AADDOC:	SAVEPQ
	MOVEI Q3,DBPAG0_11	;GET POINTER TO PAGE 0
	DMOVE Q1,T1		;SAVE THE ARGS
	CALL CHKDOC		;LEGAL DOC #
	 RET			;NO
	MOVE T1,Q2		;GET POINTER TO STRING
	MOVE T2,AUTPTR(Q3)	;GET ADR OF TABLE
	MOVE T3,AUTLEN(Q3)	;GET LENGTH OF AUTHOR TABLE
	SETO T4,		;ALLOW THE CREATION OF A NEW LIST BLOCK
	CALL TABADD		;GO ADD THE AUTHOR
	 RET			;FAILED
	MOVE T2,Q1		;GET DOC#
	CALL LADDOC		;GO ADD THIS DOC # TO THE LIST
	 RET			;FAILED
	RETSKP			;DONE
;ROUTINE TO ADD A STRING TO A TABLE (KEYWORD OR AUTHOR)
;ACCEPTS IN T1/	POINTER TO THE TEMP STRING
;	    T2/	ADR OF THE TABLE
;	    T3/	TABLE LENGTH
;	    T4/	0 = DO NOT CREATE A NEW BLOCK IF NEEDED
;		-1= ADD A NEW LIST BLOCK IF NECESSARY
;	CALL TABADD
;RETURNS +1:	FAILED
;	 +2:	T1/	ADR OF FIRST LIST BLOCK IN CHAIN

TABADD:	SAVEPQ
	MOVE Q1,T1		;SAVE POINTER
	DMOVE P2,T2		;SAVE TABLE ADR AND LENGTH
	MOVE P4,T4		;SAVE CREATION FLAG
	MOVE T2,P3		;GET THE LENGTH OF THE TABLE
	CALL HASH		;GET INDEX INTO TABLE
	 RET
	MOVE Q2,T1		;SAVE THE INDEX
	ADD Q2,P2		;GET WORD IN TABLE
	MOVE T1,Q2
	CALL MAPBLK		;MAP THE WORD
	SKIPE (T1)		;IS THERE ANYTHING HERE YET?
	JRST TABAD1		;YES
	JUMPE P4,R		;SHOULD A NEW BLOCK BE CREATED?
	MOVEI T1,LSTSIZ		;NO, GO PUT A BLOCK HERE
	MOVEI T2,TYPLST		;GET TYPE CODE
	MOVEI T3,VERLST		;GET VERSION NUMBER
	CALL ASGFRE		;GET A BLOCK
	 RET
	MOVEM T1,Q3		;SAVE THE BLOCK ADR
	MOVE T1,Q1		;GET THE STRING POINTER
	CALL COPSTR		;COPY IT TO A FILE BLOCK
	 RET
	MOVEM T1,P1		;SAVE THE STRING BLOCK ADR
	MOVE T1,Q2		;GET ADR OF TABLE WORD
	CALL MAPBLK		;MAP IT
	MOVEM Q3,(T1)		;SAVE THE LIST BLOCK ADR IN THE TABLE
	MOVE T1,Q3		;MAP THE LIST BLOCK
	CALL MAPBLK
	STOR P1,ASCPTR,(T1)	;STORE THE ASCIZ STRING IN THE LIST BLOCK
TABAD1:	MOVE T1,Q2		;GET ADR OF INDEX
	CALL MAPBLK		;MAP IT
	MOVE T1,(T1)		;GET ADR OF FIRST LIST BLOCK
TABAD2:	MOVE Q2,T1		;REMEMBER THE LIST BLOCK ADR
	CALL MAPBLK		;MAP THE LIST BLOCK
	LOAD T2,ASCPTR,(T1)	;GET THE ASCIZ STRING
	MOVE T1,Q1		;GET THE TEMP STRING ADR
	SETZ T3,		;GET AN EXACT MATCH
	CALL STRCMP		;COMPARE THE STRINGS
	 JRST [	MOVE T1,Q2	;NO MATCH, STEP TO NEXT BLOCK IN HASH LIST
		CALL MAPBLK
		LOAD T1,HSHPTR,(T1) ;GET ADR OF NEXT HASH BLOCK
		JUMPN T1,TABAD2	;IF ONE THERE, GO LOOK AT IT
		JRST TABAD3]	;NONE, GO ADD ONE
	MOVE T1,Q2		;GET ADR OF LIST BLOCK
	RETSKP			;DONE
TABAD3:	JUMPE P4,R		;SHOULD A NEW BLOCK BE CREATED?
	MOVEI T1,LSTSIZ		;NEED TO ADD A LIST BLOCK
	MOVEI T2,TYPLST		;GET TYPE CODE
	MOVEI T3,VERLST		;GET VERSION NUMBER
	CALL ASGFRE		;GET A BLOCK
	 RET
	MOVEM T1,Q3		;SAVE THE BLOCK ADR
	MOVE T1,Q1		;GET THE STRING POINTER
	CALL COPSTR		;COPY IT TO THE FILE
	 RET
	MOVEM T1,P1		;SAVE THE STRING BLOCK ADR
	MOVE T1,Q3		;GET THE LIST BLOCK ADR
	CALL MAPBLK		;MAP IT
	STOR P1,ASCPTR,(T1)	;SAVE THE ASCIZ STRING ADR
	MOVE T1,Q2		;GET THE LAST BLOCK ADR
	CALL MAPBLK		;MAP IT
	STOR Q3,HSHPTR,(T1)	;ADD THIS BLOCK TO THE END OF THE HASH LIST
	MOVE T1,Q3		;GET THE LIST BLOCK ADR
	RETSKP			;DONE
;ROUTINE TO ADD A STRING TO A STRING BLOCK
;ACCEPTS IN T1/	POINTER TO TEMP STRING
;	    T2/	ADR OF FIRST STRING BLOCK
;	CALL STRADD
;RETURNS +1:	FAILED
;	 +2:	OK

STRADD:	SAVEPQ
	DMOVE Q1,T1		;SAVE THE ARGS
	CALL FNDSTR		;GO FIND THE STRING
	 SKIPA			;NOT FOUND
	RETSKP			;FOUND, NO NEED TO ADD IT AGAIN
	JUMPN T1,[MOVE Q3,T1	;SAVE THE ADR OF THE FIRST FREE SLOT
		MOVE T1,Q1	;GET STRING POINTER AGAIN
		CALL COPSTR	;COPY IT TO THE FILE
		 RET		;FAILED
		EXCH T1,Q3	;GET ADR OF BLOCK AGAIN
		CALL MAPBLK	;MAP IT
		MOVEM Q3,(T1)	;SAVE THE POINTER TO THE STRING
		RETSKP]		;DONE
	MOVE Q3,T2		;SAVE THE ADR OF THE LAST BLOCK
	MOVEI T1,STRSIZ		;GET A STRING BLOCK
	MOVEI T2,TYPSTB		;GET TYPE CODE
	MOVEI T3,VERSTR		;GET VERSION NUMBER
	CALL ASGFRE
	 RET
	MOVE P1,T1		;SAVE THE STRING BLOCK ADR
	MOVE T1,Q1		;GET THE TEMP STR POINTER
	CALL COPSTR		;COPY IT TO THE FILE
	 RET
	MOVE P2,T1		;SAVE THE STRING ADR
	MOVE T1,P1		;GET THE STRING BLOCK ADR
	CALL MAPBLK		;MAP IT
	MOVEM P2,STR1WD(T1)	;SAVE THE STRING ADR
	MOVE T1,Q3		;GET ADR OF THE LAST BLOCK
	CALL MAPBLK		;MAP IN THE LAST BLOCK
	STOR P1,STRPTR,(T1)	;ADD THE NEW BLOCK TO THE LAST ONE
	RETSKP			;DONE
;ROUTINE TO FIND A STRING ON A STRING BLOCK LIST
;ACCEPTS IN T1/	TEMP STRING POINTER
;	    T2/	FILE ADR OF THE START OF THE LIST
;	CALL FNDSTR
;RETURNS +1:	T1/	FILE ADR OF THE FIRST FREE SLOT OR 0 IF NONE
;		T2/	FILE ADR OF THE LAST STRING BLOCK CHECKED
;	 +2:	T1/	FILE ADR OF WORD POINTING TO THE STRING

FNDSTR:	SAVEPQ
	SETZ P1,		;START WITH NO SLOT ADR
	DMOVE Q1,T1		;SAVE ARGS
FNDST1:	MOVE P2,T2		;SAVE THE ADR OF THE STRING BLOCK
	ADDI P2,STR1WD		;GET THE ADR OF THE FIRST WORD
	MOVEI P4,STRNWD		;GET COUNT OF DATA WORDS IN BLOCK
FNDST2:	MOVE T1,P2		;GET THE WORD TO LOOK AT
	CALL MAPBLK		;MAP IT
	MOVE P3,T1		;SAVE ITS CORE ADR
	MOVE T1,Q1		;GET TEMP STRING ADR
	SETZ T3,		;EXACT MATCH
	SKIPE T2,(P3)		;IS THERE AN ENTRY HERE?
	CALL STRCMP		;YES, COMPARE THE STRINGS
	 SKIPA			;NO MATCH OR NO STRING
	JRST [	MOVE T1,P2	;GET THE ADR OF THE WORD
		RETSKP]
	MOVE T1,P2		;MAP IN THE WORD AGAIN
	CALL MAPBLK
	MOVE P3,T1		;SAVE THE CORE ADR
	JUMPN P1,FNDST3		;FOUND A FREE SLOT YET?
	SKIPN (P3)		;IS THIS A FREE SLOT?
	MOVE P1,P2		;YES, REMEMBER ITS ADR
FNDST3:	AOS P2			;STEP TO THE NEXT WORD
	SOJG P4,FNDST2		;LOOP BACK THRU BLOCK
	MOVE T1,Q2		;GET BLOCK MAPPED
	CALL MAPBLK
	MOVE T2,Q2		;SAVE LAST BLOCK ADR
	LOAD Q2,STRPTR,(T1)	;SEE IF THERE IS ANOTHER BLOCK IN LIST
	MOVE T1,P1		;GET THE LAST FREE SLOT
	JUMPE Q2,R		;DONE?
	MOVE T2,Q2		;NO, GO BACK AND LOOK AT THIS BLOCK
	JRST FNDST1
;ROUTINE ADD A DOC # TO A LIST
;ACCEPTS IN T1/	ADR OF START OF LIST
;	    T2/	DOC #

LADDOC:	SAVEPQ
	DMOVE Q1,T1		;SAVE THE ARGS
	CALL FNDDOC		;FIND IF THIS DOC # ALREADY IN LIST
	 SKIPA			;NO
	RETSKP			;YES, THEN DONE
	JUMPN T1,[CALL MAPBLK	;MAP IN THE WORD
		MOVEM Q2,(T1)	;STORE THE DOC # IN THE FREE SLOT
		RETSKP]		;DONE
	MOVE Q3,T2		;SAVE THE LAST BLOCK CHECKED
	MOVEI T1,LSTSIZ		;GO GET SPACE FOR A NEW LIST BLOCK
	MOVEI T2,TYPLST		;GET TYPE CODE
	MOVEI T3,VERLST		;GET VERSION NUMBER
	CALL ASGFRE
	 RET
	MOVE P1,T1		;SAVE THE ADR OF THE BLOCK
	CALL MAPBLK		;MAP IN THE BLOCK
	MOVEM Q2,LST1WD(T1)	;STORE THE DOC # IN THIS BLOCK
	MOVE T1,Q3		;GET THE LAST BLOCK
	CALL MAPBLK		;MAP IT
	STOR P1,LSTPTR,(T1)	;LINK THE BLOCK ONTO THE LAST ONE
	RETSKP
;ROUTINE TO FIND A DOC # IN A DOC LIST
;ACCEPTS IN T1/	FILE ADR OF THE START OF THE LIST
;	    T2/	DOC #
;	CALL FNDDOC
;RETURNS +1:	T1/	FILE ADR OF FIRST FREE SLOT OR 0 IF NONE
;		T2/	FILE ADR OF LAST BLOCK IN CHAIN (IF T1=0)
;	 +2:	T1/	FILE ADR OF THE SLOT CONTAINING THE DOC #

FNDDOC:	SAVEPQ
	SETZ P1,		;START WITH NO FREE SLOT
	MOVE Q2,T2		;SAVE DOC #
	MOVE Q3,T1		;SAVE ADR OF LIST BLOCK
FNDDO1:	MOVE P2,T1		;SAVE ADR OF 1ST WORD IN BLOCK
	ADDI P2,LST1WD		; ...
	CALL MAPBLK		;MAP THE LIST BLOCK
	MOVE Q1,T1		;SAVE THE ADR
	MOVEI T4,LSTNWD		;GET # OF WORDS IN BLOCK
	MOVEI T1,LST1WD(Q1)	;GET ADR OF FIRST WORD IN BLOCK
FNDDO2:	CAMN Q2,(T1)		;FOUND A MATCH?
	JRST [	MOVE T1,P2	;YES, GET THE ADR
		RETSKP]		;DONE
	JUMPN P1,FNDDO3		;FOUND A FREE SLOT YET?
	SKIPN (T1)		;NO, IS THIS SLOT EMPTY
	MOVE P1,P2		;YES, REMEMBER ITS ADR
FNDDO3:	AOS P2			;STEP THE FILE ADR
	AOS T1			;STEP THE CORE ADR
	SOJG T4,FNDDO2		;LOOP BACK THRU THE LIST BLOCK
	MOVE T2,Q3		;GET THE LIST BLOCK ADR
	LOAD Q3,LSTPTR,(Q1)	;STEP TO THE NEXT LIST BLOCK
	JUMPE Q3,[MOVE T1,P1	;IF AT THE END, GET SLOT ADR
		RET]		;THEN DONE (T2 = ADR OF LAST BLOCK)
	MOVE T1,Q3		;GET NEXT LIST BLOCK ADR
	JRST FNDDO1		;GO LOOK THRU THIS LIST BLOCK
;ROUTINE TO COPY A TEMP STRING INTO THE DATA BASE FILE
;ACCEPTS IN T1/	POINTER TO THE TEMP STRING
;	CALL COPSTR
;RETURNS +1:	NO MORE ROOM IN DATA BASE
;	 +2:	T1/	FILE ADR OF THE COPIED STRING

COPSTR:	SAVEQ
	TLC T1,-1		;GET BYTE POINTER
	TLCN T1,-1
	HRLI T1,(POINT 7,0)	;SET UP THE BYTE POINTER
	MOVE Q1,T1		;SAVE THE BYTE POINTER
	MOVEI T2,1		;COUNT THE CHARACTERS
COPST1:	ILDB T3,T1		;GET THE NEXT CHAR
	SKIPE T3		;NULL?
	AOJA T2,COPST1		;LOOP BACK TILL END OF STRING
	ADDI T2,4		;GET THE # OF WORDS IN THE STRING
	IDIVI T2,5		;...
	MOVE T1,T2		;NOW GET SPACE FOR THE STRING
	MOVEI T2,TYPASC		;GET TYPE CODE
	MOVEI T3,VERASC		;GET VERSION NUMBER
	CALL ASGFRE
	 RET
	MOVE Q2,T1		;SAVE THE ADR
	CALL MAPBLK		;MAP THE STRING BLOCK
	HRLI T1,(POINT 7,0)	;SET UP A BYTE POINTER
COPST2:	ILDB T2,Q1		;COPY THE STRING
	IDPB T2,T1
	JUMPN T2,COPST2		;LOOP BACK TIL NUL SEEN
	MOVE T1,Q2		;GET THE ADR OF THE BLOCK
	RETSKP
;ROUTINE TO COMPARE TWO STRINGS
;ACCEPTS IN T1/	POINTER TO TEMP STRING
;	    T2/	ADR OF STRING IN FILE AREA
;	    T3/	0 = EXACT MATCH, -1 = ALLOW WILD CARDS
;	CALL STRCMP
;RETURNS +1:	NO MATCH
;	 +2:	MATCH

STRCMP:	SAVEQ
	TLC T1,-1		;SET UP BYTE POINTER
	TLCN T1,-1
	HRLI T1,(POINT 7,0)
	DMOVE Q1,T1		;SAVE THE ARGS
	MOVE Q3,T3
	MOVE T1,Q2		;MAP IN THE FILE BLOCK
	CALL MAPBLK
	HRLI T1,(POINT 7,0)	;BUILD A STRING POINTER
	MOVE T2,Q1		;GET TEMP STRING AGAIN
STRCM1:	ILDB T3,T1		;GET CHAR
	ILDB T4,T2
	CAME T3,T4		;MATCH?
	RET			;NO
	JUMPN T3,STRCM1		;LOOP BACK UNTIL NULL
	RETSKP
;ROUTINE TO CONVERT AN AUTHOR STRING TO LAST NAME FIRST
;ACCEPTS IN T1/	STRING POINTER
;	    T2/	ANSWER STRING POINTER
;	    T3/	1 = AUTHOR

CNVSTR:	SAVEPQ
	STKVAR <CNVSTS,CNVSTA,<CNVSTT,MAXSTW>,CNVSTP>
	TLC T1,-1
	TLCN T1,-1		;CREATE A BYTE POINTER
	HRLI T1,(POINT 7,0)
	TLC T2,-1
	TLCN T2,-1
	HRLI T2,(POINT 7,0)
	MOVEM T1,CNVSTS		;SAVE STRING POINTER
	MOVEM T2,CNVSTA		;SAVE ANSWER POINTER
	CAIE T3,1		;AUTHOR?
	JRST CNVST9		;NO, JUST COPY THE STRING
	MOVE T2,CNVSTS		;GET POINTER TO STRING
	MOVEM T2,CNVSTP		;INIT POINTER
	SETZB Q3,CNVSTT		;INIT TEMP STRING
	MOVE P1,CNVSTS		;GET START OF STRING
	MOVE Q2,CNVSTS		;INIT Q2 ALSO
	SETZ P2,		;INIT COUNT
CNVST1:	SETZ T4,		;INIT COUNT OF CHARS
	MOVEI T3,CNVSTT		;GET POINTER TO TEMP STRING
	HRLI T3,(POINT 7,0)
	MOVE T2,CNVSTP		;GET POINTER TO STRING
CNVST2:	ILDB T1,CNVSTP		;GET NEXT CHAR FROM STRING
	CAIL T1,"A"+40		;LETTER?
	CAILE T1,"Z"+40		;OF THE LOWER CASE PERSUATION?
	SKIPA			;NO
	JRST CNVST3		;YES
	CAIL T1,"0"		;NUMBER?
	CAILE T1,"9"
	SKIPA
	JRST CNVST3		;YES
	CAIL T1,"A"		;LETTER?
	CAILE T1,"Z"
	SKIPA
	JRST CNVST3		;YES
	CAIN T1,"-"
	JRST CNVST3
	CAIN T1,"."
	JRST CNVS31		;IF ".", THEN DO NOT STORE IT IN STRING
	CAIE T1,42		;"
	CAIN T1,47		;OR '
	JRST CNVST3		;YES
	CAIE T1,"#"
	CAIN T1,"$"
	JRST CNVST3
	CAIE T1,"%"
	CAIN T1,"&"
	JRST CNVST3
	JRST CNVST4		;NONE OF THE ABOVE

CNVST3:	IDPB T1,T3		;STORE IN THE TEMP STRING
CNVS31:	MOVSI T1,774000		;GET MASK
	SKIPN T4		;FIRST TIME THROUGH?
	ANDM T1,CNVSTT		;YES, ZERO REST OF THE STRING
	AOJA T4,CNVST2		;LOOP BACK TIL END

CNVST4:	JUMPE T4,CNVS41		;ANYTHING FOUND?
	MOVE P2,Q3		;SAVE LAST COUNT
	MOVE P1,Q2		;SAVE LAST START
	MOVE Q3,T4		;SAVE COUNT
	MOVE Q2,T2		;SAVE START POINTER
	MOVE Q1,CNVSTP		;SAVE END POINTER
CNVS41:	JUMPE T1,CNVST5		;NUL = DONE
	JRST CNVST1

CNVST5:	JUMPE Q3,CNVST9		;IF NO WORDS, GO COPY STRING
	MOVE T1,CNVSTT		;GET LAST WORD
	CAME T1,[ASCIZ/PHD/]
	CAMN T1,[ASCIZ/JR/]
	MOVE Q2,P1
	CAME T1,[ASCIZ/LTD/]
	CAMN T1,[ASCIZ/CO/]
	MOVE Q2,P1
	CAME T1,[ASCIZ/INC/]
	CAMN T1,[ASCIZ/III/]
	MOVE Q2,P1
	MOVE T2,Q2		;GET START POINTER
CNVST6:	ILDB T1,T2		;COPY LAST NAME TO ANSWER
	CAMN T2,Q1		;DONE?
	JRST CNVS61		;YES
	IDPB T1,CNVSTA
	JRST CNVST6		;LOOP BACK TIL DONE

CNVS61:	CAMN Q2,CNVSTS		;IS THERE A FIRST NAME?
	JRST CNVST7		;NO, SKIP THE COMMA
	MOVEI T1,","		;YES, ADD A COMMA
	IDPB T1,CNVSTA
	MOVEI T1," "		;SPACE
	IDPB T1,CNVSTA
CNVST7:	CAMN Q2,CNVSTS		;NOW COPY THE FIRST PART OF STRING
	JRST CNVST8
	ILDB T1,CNVSTS		;GET A CHAR
	IDPB T1,CNVSTA		;PUT IT IN THE ANSWER
	JRST CNVST7

CNVST8:	MOVEI T1,0		;END WITH A NUL
	IDPB T1,CNVSTA
	RET			;DONE

CNVST9:	ILDB T1,CNVSTS		;GET A CHAR
	IDPB T1,CNVSTA		;COPY IT TO THE ANSWER
	JUMPN T1,CNVST9
	RET
;ROUTINE TO MAP A BLOCK
;ACCEPTS IN T1/	ADR OF BLOCK IN THE FILE
;	CALL MAPBLK
;RETURNS +1:	T1/	ADR OF MAPPED BLOCK

MAPBLK:	SAVEQ
	MOVE Q1,T1		;SAVE THE ADR
	LSH T1,-11		;GET THE PAGE #
	CAIL T1,PGTABL		;LEGAL VALUE?
	ERRMES (<ILLEGAL ADDRESS IN DATA BASE, FILE NEEDS REBUILDING>)
	MOVE Q2,T1		;SAVE THE PAGE ADR
	SKIPN T1,PAGTBA(Q2)	;MAPPED ALREADY?
	JRST MAPBL1		;NO
	LSH T1,11		;YES, BUILD THE IN CORE ADR
	ANDI Q1,777		;JUST GET THE LOW ORDER BITS
	IOR T1,Q1		;GET PAGE # AND WORD #
	RET			;DONE

MAPBL1:	MOVE Q3,CORNXT		;GET NEXT FREE PAGE TO USE
	CAML Q3,CORPGN		;AT END OF AREA?
	SETZB Q3,CORNXT		;YES, START OVER AGAIN
	AOS CORNXT		;STEP TO NEXT SLOT
	SKIPE T1,CORTAB(Q3)	;IS THERE SOMETHING MAPPED ALREADY
	SETZM PAGTBA(T1)	;YES, CLEAR IT
	MOVEM Q2,CORTAB(Q3)	;REMEMBER WHAT IS MAPPED HERE
	HRLZ T1,DBJFN		;NOW MAP THE PAGE
	HRR T1,Q2		;GET PAGE #
	HRLI T2,.FHSLF		;MAP IT INTO THIS FORK
	HRRI T2,CORPAG(Q3)	;GET CORE PAGE
	MOVX T3,PM%RD!PM%WR	;MAP IT FOR READ AND WRITE
	PMAP
	HRRZM T2,PAGTBA(Q2)	;SAVE THE PAGE NUMBER
	MOVEI T1,CORPAG(Q3)	;GET CORE PAGE
	LSH T1,11		;BUILD AN ADR
	ANDI Q1,777		;GET LOW 9 BITS OF ADR
	IOR T1,Q1		;MERGE THE BITS
	RET			;DONE
;ROUTINE TO OPEN THE DATA BASE FILE
;ACCEPTS IN T1/	POINTER TO THE PROMPT STRING
;	CALL OPNFIL
;RETURNS +1:	FAILED, ERROR CODE IN T1
;	 +2:	DONE - 	T1/	JFN OF DATA BASE FILE
;			T2/	JFN OF TRANSACTION LOG FILE

OPNFIL:	STKVAR <OPNFIJ,OPNFIE,<OPNFIS,20>>
	MOVE T2,[GTJBLK,,GTJBLK+1]
	SETZM GTJBLK		;INITIALIZE GTJFN BLOCK
	BLT T2,GTJBLK+GTJBLN-1
	MOVEM T1,GTJBLK+.GJRTY	;SAVE PROMPT IN ^R BUFFER
	PSOUT			;TYPE OUT THE PROMPT
	HRROI T1,[ASCIZ/FILE/]	;SET UP DEFAULT FILE NAME
	MOVEM T1,GTJBLK+.GJNAM	; TO BE "FILE.DATA-BASE"
	HRROI T1,[ASCIZ/DATA-BASE/]
	MOVEM T1,GTJBLK+.GJEXT
	MOVEI T1,GTJBLN-.GJF2-1	;SET UP EXTENDED GTJFN BLOCK
	MOVEM T1,GTJBLK+.GJF2
	MOVX T1,GJ%CFM!GJ%XTN	;SET UP FLAGS
	MOVEM T1,GTJBLK+.GJGEN
	MOVE T1,[.PRIIN,,.PRIOU]
	MOVEM T1,GTJBLK+.GJSRC	;SET UP TO GET INPUT FROM TTY
	SETZ T2,		;NO MAIN STRING POINTER
	MOVEI T1,GTJBLK
	GTJFN			;GET A JFN ON THE DATA BASE FILE
	 RET			;FAILED
	MOVEM T1,OPNFIJ		;SAVE THE JFN
	MOVE T2,[440000,,OF%RD!OF%WR]
	OPENF			;OPEN THE DATA BASE FILE
	 JRST [	CAIN T1,OPNX9	;INVALID SIMULTANEOUS ACCESS?
		JRST OPNFI1	;YES, OK
		MOVEM T1,OPNFIE	;SAVE THE ERROR CODE
		MOVE T1,OPNFIJ	;GET BACK THE JFN
		RLJFN		;RELEASE IT
		 JFCL
		MOVE T1,OPNFIE	;GET BACK ERROR CODE
		RET]
	CALL MAPFIL		;MAP IN THE DATA BASE
	 JRST [	CALL UNMAP
		MOVE T1,OPNFIJ	;GET THE JFN AGAIN
		HRLI T1,(CZ%ABT)
		CLOSF		;CLOSE IT
		 JFCL
		RET]
	CALL UNMAP		;UNMAP IT
	MOVE T1,OPNFIJ		;GET THE JFN
	HRLI T1,(CO%NRJ)	;DON'T RELEASE THE JFN
	CLOSF			;CLOSE IT
	 JFCL
OPNFI1:	MOVE T1,OPNFIJ		;GET THE JFN AGAIN
	MOVE T2,[440000,,OF%RD!OF%WR!OF%THW!OF%DUD]
	OPENF			;OPEN THE DATA BASE FILE
	 JRST [	MOVEM T1,OPNFIE	;FAILED, SAVE THE ERROR CODE
		MOVE T1,OPNFIJ	;GET BACK THE JFN
		RLJFN		;RELEASE IT
		 JFCL
		MOVE T1,OPNFIE	;GET BACK ERROR CODE
		RET]
	CALL MAPFIL		;GO MAP IT AGAIN
	 RET
	HRROI T1,[ASCIZ/TRANSACTION-LOG/]
	MOVEM T1,GTJBLK+.GJEXT	;SET UP EXT OF TRANSACTION LOG FILE
	MOVE T1,[377777,,377777]
	MOVEM T1,GTJBLK+.GJSRC	;GET FILE NAME FROM STRING ONLY
	HRROI T1,OPNFIS		;NOW GET THE FILE NAME
	MOVE T2,OPNFIJ		;FROM THE DATA BASE JFN
	MOVE T3,[111000,,1]	;GET STR:<DIR>NAME
	JFNS
	MOVEI T1,GTJBLK		;NOW GET JFN ON TRANSACTION LOG FILE
	HRROI T2,OPNFIS
	GTJFN
	 WARN (<MOVEI T1,0>,<COULD NOT OPEN TRANSACTION LOG FILE>)
	MOVE T2,T1		;RETURN JFN IN T2
	MOVE T1,OPNFIJ		;AND DATA BASE JFN IN T1
	SETZM TRAFLG		;MARK THAT THIS IS FIRST TIME THRU
	RETSKP			;DONE
;ROUTINE TO MAP THE DATA BASE FILE
;ACCEPTS IN T1/	JFN
;RETURNS +1:	DO NOT CREATE A NEW FILE
;	 +2:	OK, MAPPED

MAPFIL:	STKVAR <MAPFLJ>
	MOVEM T1,MAPFLJ		;SAVE THE JFN
	HRLZS T1		;MAP IN THE PAGE 0
	HRLI T2,.FHSLF
	HRRI T2,DBPAG0		;INTO DBPAG0
	MOVE T3,[PM%CNT!PM%RD!PM%WR!NRESPG]
	PMAP
	HRLZ T1,MAPFLJ		;NOW LOOK TO SEE IF THE PAGE EXISTS
	RPACS
	TXNE T2,PA%PEX		;IS THIS A NEW FILE?
	JRST MAPFI1		;NO
	CALL INIDB		;YES, GO INITIALIZE THE DATA BASE
	 RET			;USER DID NOT WANT TO CREATE NEW FILE
MAPFI1:	MOVEI T4,DBPAG0_11	;GET POINTER TO PAGE 0
	HRLZ T1,MAPFLJ		;GET JFN
	HRLI T2,.FHSLF
	HRRI T2,DBPAG0		;MAP IN THE FIRST BLOCK OF PAGES
	MOVE T3,DOCPTR(T4)	;MAP UP TO THE DOCUMENT INDEX AREA
	LSH T3,-11		;GET PAGE NUMBER OF DOCPAG
	HRLI T3,(PM%CNT!PM%RD!PM%WR)
	PMAP			;MAP THEM
	RETSKP
;ROUTINE TO UNMAP ALL MAPPED AREAS

UNMAP:	SETO T1,		;UNMAP THE PAGES
	HRLI T2,.FHSLF		;FROM THIS FORK
	HRRI T2,DBPAG0		;START WITH THE FIRST SECTION
	MOVE T3,[PM%CNT!MAXDB0]
	PMAP
	HRRI T2,CORPAG		;NEXT DO THE MAPPING AREA
	MOVE T3,[PM%CNT!NCORPG]
	PMAP
	HRRI T2,PAGTAB		;AND THEN DO THE PAGE MAP TABLE
	MOVE T3,[PM%CNT!NPGTBP]
	PMAP
	RET
;ROUTINE TO INITIALIZE THE DATA BASE

INIDB:	HRROI T1,[ASCIZ/
THE FILE NAME SPECIFIED DOES NOT CURRENTLY EXIST, 
DO YOU WANT TO CREATE A NEW DATA BASE (YES OR NO): /]
	CALL YESNO		;GET AN ANSWER
	 RET			;NO
	HRROI T1,[ASCIZ/
[CREATING NEW DATA BASE FILE]

/]
	PSOUT
	MOVEI T1,DBPAG0_11	;GET ADR OF PAGE 0
	MOVEI T2,DBVER		;SET UP VERSION OF DATA BASE
	MOVEM T2,DBVERW(T1)
	MOVE T2,[FREPAG_11]	;SET UP FIRST FREE WORD
	MOVEM T2,FREFFW(T1)
	MOVE T2,[FREPAG_11+NFREPG_11]
	MOVEM T2,FREMAX(T1)	;SET UP POINTER TO END OF FREE POOL
	MOVEI T2,KEYPAG_11	;SET UP POINTER TO KEYWORD TABLE
	MOVEM T2,KEYPTR(T1)
	MOVEI T2,NKEYPG_11	;SET UP KEYWORD TABLE LENGTH
	MOVEM T2,KEYLEN(T1)
	MOVEI T2,AUTPAG_11	;SET UP POINTER TO AUTHOR TABLE
	MOVEM T2,AUTPTR(T1)
	MOVEI T2,NAUTPG_11	;SET UP LENGTH OF AUTHOR TABLE
	MOVEM T2,AUTLEN(T1)
	MOVE T2,[DOCPAG_11]	;SET UP POINTER TO DOC INDEX TABLE
	MOVEM T2,DOCPTR(T1)
	MOVE T2,[NDOCPG_11]	;SET UP THE LENGTH OF THE DOC INDEX
	MOVEM T2,DOCLEN(T1)
	SETZM NXTDOC(T1)	;INIT DOC NUMBER
	MOVE T2,[FREPAG_11]	;SET UP POINTER TO FREE POOL
	MOVEM T2,FREPTR(T1)
	MOVE T2,[NFREPG_11]	;SET UP THE LENGTH OF THE FREE POOL
	MOVEM T2,FRELEN(T1)
	RETSKP			;DONE
;ROUTINE TO GET A YES OR NO ANSWER
;ACCEPTS IN T1/	POINTER TO THE PROMPT STRING
;	CALL YESNO
;RETURNS +1:	ANSWER IS "NO"
;	 +2:	ANSWER IS "YES"

YESNO:	STKVAR <<YNBLK,20>>
	MOVEI T2,YNCT		;GET ADDRESS OF THE YESNO COMMAND TABLE
	MOVEI T3,YNBLK
	CALL PARSE		;GO GET THE ANSWER
	 ERRMES <ILLEGALLY FORMATTED YES/NO COMMAND TABLE>
	CALL COPCMD		;COPY THIS TO CMDBLK
	HLRZ T1,YNBLK		;GET TYPE CODE
	CAIE T1,.CMKEY		;IS IT WHAT WE WANT
	ERRMES <UNKNOWN TYPE CODE RECEIVED FROM "PARSE">
	HRRZ T1,YNBLK
	JUMPE T1,R		;0 = NO
	RETSKP			;1 = YES
;ROUTINE TO INIT THE TRANSACTION AREA

INITRA:	MOVE T1,[POINT 7,CMDBUF]
	MOVEM T1,CMDPTR		;INITIALIZE THE POINTER TO CMDBUF
	RET


;ROUTINE TO COPY A COMMAND TO THE TRANSACTION LOG BUFFER (CMDBUF)
;ACCEPTS IN T1/	POINTER TO COMMAND
;	CALL COPCMD
;RETURNS +1:	ALWAYS

COPCMD:	MOVE T2,CMDPTR		;GET POINTER TO COMMAND BUFFER AREA
	SETZ T3,
	SIN			;COPY COMMAND INTO BUFFER
	MOVEM T2,CMDPTR		;UPDATE POINTER TO END OF COMMAND
	RET			;DONE
;ROUTINE TO UPDATE THE DATA BASE

UPDDB:	STKVAR <<UPDDBS,40>,UPDDBU>
	SKIPN T1,TLJFN		;GET TRANSACTION JFN
	JRST UPDDB2		;NONE
	MOVE T2,[070000,,OF%APP] ;OPEN IT FOR APPEND
	OPENF
	 WARN (<JRST UPDDB2>,<COULD NOT OPEN THE TRANSACTION LOG FILE>)
	SKIPE TRAFLG		;FIRST TIME THRU?
	JRST UPDDB1		;NO, DONT PUT IN TIME STAMP
	SETO T1,		;YES, GET USER NAME
	HRROI T2,UPDDBU
	MOVEI T3,.JIUNO		;GET USER NUMBER
	GETJI
	 JRST UPDDB1		;FAILED
	HRROI T1,UPDDBS		;NOW BUILD TIME STAMP
	HRROI T2,[ASCIZ/

; UPDATED BY /]
	SETZ T3,
	SOUT
	MOVE T2,UPDDBU		;NAOW ADD IN USER NAME
	DIRST
	 JRST UPDDB1		;FAILED
	HRROI T2,[ASCIZ/ ON /]
	SOUT
	SETO T2,		;AND THEN THE CURENT DATE
	ODTIM
	HRROI T2,[ASCIZ/

/]
	SOUT
	MOVE T1,TLJFN		;AND NOW COPY IT TO TLOG FILE
	HRROI T2,UPDDBS
	SOUT
	SETOM TRAFLG		;MARK THAT NO LONGER FIRST TIME THRU
UPDDB1:	MOVE T1,TLJFN		;GET TLOG JFN
	MOVE T2,[POINT 7,CMDBUF]
	SETZ T3,
	SOUT			;COPY COMMAND TO TLOG
	TXO T1,CO%NRJ		;DONT RELEASE THE JFN
	CLOSF			;CLOSE THE TLOG FILE
	 JFCL
UPDDB2:	HRLZ T1,DBJFN		;NOW UPDATE THE DATA BASE
	MOVEI T2,NFILPG
	UFPGS
	 WARN (<JRST .+1>,<COULD NOT UPDATE THE DATA BASE>)
	RET			;DONE
;ROUTINE TO REDUCE A STRING TO MINIMUM FORM FOR HASHING
;	THIS ROUTINE SCANS FOR WORDS, 
;	STRIPS OFF "S", "ES", "IES", "ED", AND "ING" ENDINGS
;	REMOVES VOWELS
;	ELIMINATES DOUBLE LETTERS

;ACCEPTS IN T1/	STRING POINTER TO SOURCE STRING
;	    T2/	STRING POINTER TO RECEIVE FULLY REDUCED ANSWER STRING
;	    T3/	POINTER TO STRING FOR PARTIALLY REDUCED WORD
;		(E.G. NO PLURALS, OR PAST TENSE)
;	CALL REDUCE
;RETURNS +1:	NO MORE WORDS IN STRING
;	 +2:	T1/	UPDATED SOURCE STRING

REDUCE:	SAVEPQ
	STKVAR <REDUCS,REDUCA,REDUCW,<REDUCP,MAXSTW>,<REDUCQ,MAXSTW>>
	TLC T1,-1		;TURN POINTER INTO BYTE POINTER
	TLCN T1,-1
	HRLI T1,(POINT 7,0)
	TLC T2,-1
	TLCN T2,-1
	HRLI T2,(POINT 7,0)
	MOVEM T1,REDUCS		;SAVE SOURCE POINTER
	MOVEM T2,REDUCA		;SAVE ANSWER POINTER
	TLC T3,-1		;CONVERT TO BYTE POINTER
	TLCN T3,-1
	HRLI T3,(POINT 7,0)
	MOVEM T3,REDUCW		;SAVE POINTER
REDUC0:	MOVEI Q1,-1+REDUCP	;GET POINTER TO STACK 1
	HRLI Q1,-MAXSTW
	MOVEI Q2,-1+REDUCQ	;GET POINTER TO STACK 2
	HRLI Q2,-MAXSTW
	SETZ Q3,		;INIT COUNT OF THE CHARS SEEN
	PUSH Q1,[0]		;START WITH A NULL ON THE STACK

REDUC1:	ILDB T1,REDUCS		;GET SOURCE CHAR
	CAIE T1,42		;"
	CAIN T1,47		;OR '
	JRST REDUC1		;YES, IGNORE THEM
	CAIE T1,"$"
	CAIN T1,"%"
	MOVEI T1,"-"
	CAIE T1,"^"
	CAIN T1,"_"
	MOVEI T1,"-"
	CAIE T1,"#"
	CAIN T1,"."
	MOVEI T1,"-"
	CAIE T1," "
	CAIN T1,";"
	JRST REDUC2
	CAIE T1,"&"
	CAIN T1,"/"
	JRST REDUC2
	CAIE T1,"="
	CAIN T1,"\"
	JRST REDUC2
	CAIE T1,"*"
	CAIN T1,"+"
	JRST REDUC2
	CAIN T1,"?"
	JRST REDUC2
	CAIE T1,"!"
	CAIN T1,","
	JRST REDUC2
	CAIE T1,"("
	CAIN T1,")"
	JRST REDUC2
	CAIE T1,"["
	CAIN T1,"]"
	JRST REDUC2
	CAIE T1,"<"
	CAIN T1,">"
	JRST REDUC2
	CAIE T1,":"
	CAIN T1,0
	JRST REDUC2

	CAIL T1,"A"+40		;RAISE LOWER CASE LETTERS
	CAILE T1,"Z"+40
	SKIPA
	SUBI T1,40

	PUSH Q1,T1		;SAVE THE CHAR ON THE STACK
	CAIL T1,"A"		;LETTER?
	CAILE T1,"Z"
	SKIPA			;NO
	AOJA Q3,REDUC1		;YES, REMEMBER THIS FACT
	CAIL T1,"0"		;NUMBER?
	CAILE T1,"9"
	JRST REDUC1		;LOOP BACK TIL END OF WORD
	AOJA Q3,REDUC1		;COUNT UP ALPHA-NUMERIC CHARS

;HERE AT END OF A WORD

REDUC2:	SKIPG Q3		;ANY ALPHA-NUMERIC CHARS SEEN?
	JUMPE T1,R		;NO, NULL?
	SKIPG Q3
	JRST REDUC0		;SKIP THIS WORD, GO LOOK FOR ANOTHER
	POP Q1,T1		;GET LAST CHAR OF WORD
	CAIE T1,"S"		;CHECK FOR "S", "ES", OR "IES"
	JRST REDUC5
	POP Q1,T2		;GET NEXT TO LAST CHAR
	CAIE T2,"E"		;"ES"?
	JRST REDUC3		;JUST ENDS IN "S"
	POP Q1,T3		;GET THIRD TO LAST CHAR
	CAIN T3,"I"		;"IES"?
	JRST [	MOVEI T3,"Y"	;YES, CHANGE IT TO A Y
		PUSH Q1,T3	;PUT "Y" ON STACK
		JRST REDUC6]
	PUSH Q1,T3		;"ES", PUT BACK THIRD CHAR
	CAIE T3,0		;NULL?
	JRST REDUC6		;NO, REMOVE THE "ES"
	PUSH Q1,T2		;LEAVE THE "ES"
	PUSH Q1,T1
	JRST REDUC6

REDUC3:	CAIN T2,"S"		;DOUBLE "S"?
	JRST [	PUSH Q1,T2	;YES, PUT BACK BOTH "S"
		PUSH Q1,T2
		JRST REDUC6]
	CAIE T2,"A"		;ANOTHER VOWEL?
	CAIN T2,"I"
	JRST REDUC4		;YES
	CAIE T2,"O"
	CAIN T2,"U"
	JRST REDUC4		;YES
	PUSH Q1,T2		;NOT A VOWEL, STORE CHAR BACK
	CAIN T2,0		;REACHED THE END?
	PUSH Q1,T1		;YES, SINGLE "S"
	JRST REDUC6		;DONE

;HERE IF WORD ENDS IN "A,I,O,U" "S"

REDUC4:	PUSH Q1,T2		;PUT BACK THIS ENDING
	PUSH Q1,T1
	JRST REDUC6

;HERE TO CHECK FOR "ED" AND "ING"

REDUC5:	CAIE T1,"D"		;"ED"?
	JRST REDU10		;NO
	POP Q1,T2		;GET SECOND TO LAST CHAR
	CAIE T2,"E"		;"ED"?
	JRST [	PUSH Q1,T2	;NO, PUT THE CHARS BACK
		PUSH Q1,T1
		JRST REDUC6]
	POP Q1,T3		;GET THIRD CHAR FROM END
	CAIN T3,"I"		;"IED"?
	JRST [	MOVEI T3,"Y"	;YES, CHANGE IT TO A "Y"
		PUSH Q1,T3	;STACK THE "Y"
		JRST REDUC6]
	CAIE T3,0		;NULL?
	JRST [	PUSH Q1,T3	;NO, PUT BACK THIS CHAR
		JRST REDUC6]	;DONE
	PUSH Q1,T3		;IF NULL, PUT BACK "ED"
	PUSH Q1,T2
	PUSH Q1,T1
	JRST REDUC6

;HERE TO CHECK FOR "ING"

REDU10:	CAIE T1,"G"		;END IN "G"?
	JRST [	PUSH Q1,T1	;NO
		JRST REDUC6]
	POP Q1,T2		;GET SECOND CHAR
	POP Q1,T3		;AND THIRD
	CAIN T2,"N"
	CAIE T3,"I"
	JRST [	PUSH Q1,T3	;NOT "ING"
		PUSH Q1,T2	;RESTORE ENDING
		PUSH Q1,T1
		JRST REDUC6]
	JRST REDUC6		;DROP THE "ING"


;HERE WHEN WORD IS DONE;  COPY CHARS TO ANSWER STRINGS

REDUC6:	MOVEI T1,0		;START WITH A NULL
REDUC7:	PUSH Q2,T1		;STORE THE CHAR ON THE STACK
	POP Q1,T1		;GET THE NEXT CHAR
	JUMPN T1,REDUC7		;LOOP BACK TILL REACHED THE NUL
	POP Q2,P1		;NOW STORE CHARS INTO STRINGS
REDUC8:	IDPB P1,REDUCW		;STORE THE FULL WORD IN ONE STRING
	JUMPE P1,[IDPB P1,REDUCA ;IF AT END, STORE THE FINAL NULL
		MOVE T1,REDUCS	;GET THE UPDATED STRING POINTER
		RETSKP]		;DONE
	POP Q2,P2		;GET NEXT CHAR
	CAMN P1,P2		;DOUBLE LETTERS?
	JRST REDUC8		;YES, SKIP ONE OF THEM
	MOVE T1,P1		;GET THE CHAR AGAIN
;	CALL CHKVOW		;VOWEL?
	 IDPB P1,REDUCA		;NO, STORE IT ON THE STRING
REDUC9:	MOVE P1,P2		;STEP TO THE NEXT CHAR
	JRST REDUC8		;LOOP BACK TIL DONE
;ROUTINE TO CHECK A CHARACTER FOR A VOWEL
;ACCEPTS IN T1/	CHAR
;	CALL CHKVOW
;RETURNS +1:	NOT A VOWEL
;	 +2:	CHAR IS A VOWEL

CHKVOW:	CAIL T1,"A"+40		;CONVERT LOWER CASE TO UPPER CASE
	CAILE T1,"Z"+40
	SKIPA
	SUBI T1,40
	CAIE T1,"A"
	CAIN T1,"E"
	RETSKP
	CAIE T1,"I"
	CAIN T1,"O"
	RETSKP
	CAIE T1,"U"
	CAIN T1,"Y"
	RETSKP
	RET			;NOT A VOWEL
;ROUTINE TO CALCULATE AN INDEX INTO THE HASH TABLE

;ACCEPTS IN T1/	POINTER TO THE STRING
;	    T2/	LENGTH OF HASH TABLE
;	CALL HASH
;RETURNS +1:	ILLEGAL ARGUMENT - ERROR CODE IN T1
;	 +2:	HASH INDEX IN T1

HASH:	SAVEQ
	DMOVE Q1,T1		;SAVE THE ARGS
	CALL STHASH		;HASH THE STRING
	 RET			;ILLEGAL STRING POINTER
	CALL MHASH		;HASH THE TWO NUMBERS TOGETHER
	MOVMS T1		;MAKE SURE IT IS POSITIVE
	IDIV T1,Q2		;GET FINAL HASH INDEX
	MOVE T1,T2		;USE REMAINDER
	RETSKP			;AND GIVE OK RETURN
;ROUTINE TO HASH TWO NUMBERS TOGETHER

;ACCEPTS IN T1/	NUMBER
;	    T2/	NUMBER
;	CALL MHASH
;RETURNS +1:	ALWAYS - T1/	HASH

MHASH:	XOR T1,RANDOM		;GUARD AGAINST A ZERO IN T1
	XOR T2,RANDOM		;OR IN T2
	MUL T2,RANDOM		;GET A RANDOM NUMBER
	MUL T1,T2		;...
	RET

RANDOM:	5*5*5*5*5*5*5*5*5*5*5*5*5*5*5


;ROUTINE TO HASH A STRING

;ACCEPTS IN T1/	STRING POINTER IN CORE
;	CALL STHASH
;RETURNS +1:	ILLEGAL STRING POINTER - ERROR CODE IN T1
;	 +2:	HASH IN T1
;		# OF CHARS IN STRING IN T2

STHASH:	STKVAR <STHSHP,STHSHX,STHSHC,STHSHB,STHSHN>
	TLC T1,-1		;CONVERT THE POINTER
	TLCN T1,-1
	HRLI T1,(POINT 7,0)
	MOVEM T1,STHSHP		;SAVE POINTER
	MOVEI T3,5		;5 BYTES PER WORD
	MOVEM T3,STHSHN		;SAVE NUMBER OF BYTES PER WORD
	AND T1,[007700,,0]	;BUILD A BYTE POINTER
	TDO T1,[POINT 0,T2]	;POINTING TO AC T2
	MOVEM T1,STHSHB		;SAVE IT FOR LATER
	SETZM STHSHC		;INITIALIZE THE COUNT OF CHARACTERS
	SETZM STHSHX		;INITIALIZE ANSWER REGISTER
STHSH1:	MOVE T4,STHSHN		;INITIALIZE COUNTER
	MOVE T3,STHSHB		;AND BYTE POINTER
	SETZ T2,		;INITIALIZE RECEIVER AC
STHSH2:	AOS T1,STHSHC		;COUNT UP CHARACTER COUNTER
	ILDB T1,STHSHP		;GET A BYTE FROM THE USER'S STRING
	JUMPE T1,STHSH3		;END OF STRING?
	IDPB T1,T3		;NO, STORE CHARACTER IN T2
	SOJG T4,STHSH2		;LOOP BACK FOR 5 CHARACTERS
	XORM T2,STHSHX		;XOR THIS INTO ANSWER WORD
	JRST STHSH1		;LOOP BACK UNTIL END OF STRING
STHSH3:	XORM T2,STHSHX		;STORE PARTIAL WORD TOO
	MOVE T1,STHSHX		;GET ANSWER
	MOVE T2,STHSHC		;GET CHARACTER COUNT
	RETSKP			;AND RETURN
;ROUTINE TO ASSIGN FREE SPACE
;ACCEPTS IN T1/	LENGTH OF BLOCK DESIRED
;	    T2/	TYPE CODE
;	    T3/	VERSION NUMBER OF BLOCK
;	CALL ASGFRE
;RETURNS +1:	NOT AVAILABLE
;	 +2:	T1/	ADR WITHIN FILE OF THE BLOCK THAT WAS ASSIGNED

ASGFRE:	JUMPLE T1,R		;MUST BE GREATER THAN 0
	ADDI T1,BLKHDL		;ADD IN HEADER LENGTH
	ASUBR <ASGFRL,ASGFRT,ASGFRV,ASGFRA>
	CAIL T1,1000		;LESS THAN A PAGE?
	RET			;NO, TOO BIG
	MOVEI T4,DBPAG0_11	;GET INDEX INTO PAGE 0
	MOVE T2,FREFFW(T4)	;GET FIRST FREE WORD
	MOVE T3,T2		;GET END OF DESIRED BLOCK
	ADDI T3,-1(T1)		;GET ADR OF LAST WORD IN BLOCK
	TRZ T2,777		;SEE IF IT CROSSED A PAGE BOUND
	TRZ T3,777
	CAME T2,T3		;START AND END ON THE SAME PAGE
	MOVEM T3,FREFFW(T4)	;MOVE FFW POINTER UP TO NEXT PAGE
	ADD T1,FREFFW(T4)	;GET NEW FIRST FREE WORD
	CAML T1,FREMAX(T4)	;IS THERE ENOUGH ROOM?
	RET			;NO
	EXCH T1,FREFFW(T4)	;GET THE ADR OF THIS BLOCK
	MOVEM T1,ASGFRA		;SAVE THE ANSWER
	CALL MAPBLK		;MAP IT
	MOVE T2,ASGFRL		;GET LENGTH
	STOR T2,BLKLEN,(T1)	;STORE LENGTH IN HEADER
	MOVE T2,ASGFRT		;GET TYPE
	STOR T2,BLKTYP,(T1)
	MOVE T2,ASGFRV		;GET THE VERSION
	STOR T2,BLKVER,(T1)
	MOVE T1,ASGFRA		;GET THE ANSWER
	ADDI T1,BLKHDL		;STEP OVER THE HEADER
	RETSKP			;AND RETURN
;ROUTINE TO RELEASE FREE SPACE
;ACCEPTS IN T1/	ADR OF BLOCK

RELFRE:	JUMPE T1,R		;ZERO IS OK
	SAVEQ
	SUBI T1,BLKHDL		;GET BACK TO HEADER
	ASUBR <RELFRA>
	MOVEI Q1,DBPAG0_11	;GET INDEX TO FIRST DATA PAGE
	MOVE Q2,FREPTR(Q1)	;GET FIRST WORD OF FREE POOL
	ADD Q2,FRELEN(Q1)	;GET LAST WORD OF FREE POOL
	CAMGE T1,Q2		;OUT OF BOUNDS?
	CAMGE T1,FREPTR(Q1)
	WARN (<RET>,<FREE BLOCK OUT OF BOUNDS>)
	CALL MAPBLK		;MAP IN THE FREE BLOCK
	LOAD T2,BLKLEN,(T1)	;GET THE LENGTH
	ADD T2,RELFRA		;GET THE END OF THE BLOCK
	CAML T2,Q2		;WITHIN BOUNDS?
	WARN (<RET>,<FREE BLOCK TOO LONG>)
	MOVE T2,FRELST(Q1)	;GET ADR OF FIRST BLOCK ON LIST
	STOR T2,BLKLNK,(T1)	;STORE IT IN THE BLOCK
	MOVEM T2,FRELST(Q1)	;POINT TO THIS NEW BLOCK
	RET			;DONE
;ROUTINE TO ENQ A JFN
;ACCEPTS IN T1/	JFN

ENQJFN:	STKVAR <<ENQJFB,5>,<ENQJFS,3>,<ENQJFU,10>>
	AOSE ENQLCK		;NEED TO LOCK IT?
	RET			;NO, NESTED CALL
	HRRZM T1,.ENQLV+ENQJFB	;SAVE THE JFN 
	MOVE T1,[1,,5]		;SET UP ENQ BLOCK
	MOVEM T1,.ENQLN+ENQJFB
	SETZM .ENQID+ENQJFB	;ID = 0
	MOVX T1,5B2
	MOVEM T1,.ENQUC+ENQJFB	;UNIQUE CODE = 0
	SETZM .ENQRS+ENQJFB	;EXCLUSIVE LOCK
	MOVEI T1,.ENQAA		;ASK FOR LOCK
	MOVEI T2,ENQJFB
	ENQ
	 SKIPA			;NOT AVAILABLE
	RET			;GOT IT LOCKED
	CAIE T1,ENQX6		;ALREADY IN USE?
	JSP ERROR		;NO, ERROR
	MOVEI T1,.ENQCS		;NOW GET JOB NUMBER OF OWNER
	MOVEI T2,ENQJFB
	MOVEI T3,ENQJFS		;GET ADR OF STATUS BLOCK
	ENQC			;GET STATUS INFO
	 JSP ERROR		;FAILED
	HRRZ T1,ENQJFS		;GET JOB NUMBER OF OWNER
	HRROI T2,T4		;GET USER NUMBER OF JOB
	MOVEI T3,.JIUNO
	GETJI
	 JSP ERROR		;FAILED
	MOVEI T1,.PRIOU
	TYPE T1,<&THE DATA BASE IS IN USE BY >
	HRROI T1,ENQJFU		;GET USER NAME
	MOVE T2,T4		;GET USER NUMBER
	DIRST
	 SKIPA T2,[-1,,[ASCIZ/USER/]]
	HRROI T2,ENQJFU		;GET USER NAME STRING
	MOVEI T1,.PRIOU
	CALL TYPSTR		;OUTPUT THE USER NAME STRING
	TYPE T1,< ON JOB >
	HRRZ T2,ENQJFS		;NOW OUTPUT THE JOB NUMBER
	MOVEI T3,^D10		;IN DECIMAL
	CALL TYPNUM
	TYPE T1,<, WAITING...>
	MOVEI T1,.ENQBL		;NOW DO A BLOCKING ENQ
	MOVEI T2,ENQJFB
	ENQ
	 JSP ERROR
	MOVEI T1,.PRIOU
	TYPE T1,<&    OK, CONTINUING...&>
	RET
;ROUTINE TO DEQ A JFN
;ACCEPTS IN T1/	JFN

DEQJFN:	STKVAR <<DEQJFB,5>>
	SOSGE T2,ENQLCK		;NEED TO DEQ?
	CAME T2,[-1]		;SEE IF AT GROUND LEVEL
	JRST DEQJF1		;NO NEED TO DEQ
	HRRZM T1,.ENQLV+DEQJFB	;SAVE JFN
	MOVE T1,[1,,5]
	MOVEM T1,.ENQLN+DEQJFB	;SET UP HEADER
	SETZM .ENQID+DEQJFB
	MOVX T1,5B2
	MOVEM T1,.ENQUC+DEQJFB	;UNIQUE CODE = 0
	SETZM .ENQRS+DEQJFB
	MOVEI T1,.DEQDR		;DEQ THE RESOURCE
	MOVEI T2,DEQJFB
	DEQ
	 JSP ERROR
DEQJF1:	SETOM ENQLCK		;INIT LOCK WORD
	RET



;ROUTINES TO TURN OFF AND ON THE INTERRUPT SYSTEM
;ALL ACS ARE PRESERVED

PIOFF.:	PUSH P,T1		;SAVE ALL ACS
	MOVEI T1,.FHSLF		;THIS FORK
	DIR			;DISABLE INTERRUPT SYSTEM
	POP P,T1		;RESTORE AC
	RET			;AND RETURN

PION.:	PUSH P,T1		;SAVE ALL ACS
	MOVEI T1,.FHSLF		;THIS FORK
	EIR			;ENABLE INTERRUPTS AGAIN
	POP P,T1		;RESTORE AC
	RET			;AND RETURN
;TYPE OUT ROUTINES

TYPRTN:	PUSH P,T1
	PUSH P,T2
	PUSH P,T3
	PUSH P,T4
	HRRZ T1,(CX)		;GET OUTPUT JFN
	HLRZ T4,CX		;GET ADR OF ASCIZ STRING
	HRLI T4,(POINT 7,0)	;TURN IT INTO A BYTE POINTER
TYPRT1:	ILDB T2,T4		;GET NEXT CHAR IN STRING
	JUMPE T2,TYPRT3		;IF NULL, THEN DONE
	CAIN T2,"&"		;CRLF?
	JRST TYPRT2		;YES
	CALL TYPCHR		;OUTPUT THE CHAR
	JRST TYPRT1		;LOOP BACK FOR REST

TYPRT2:	MOVEI T2,15		;CR
	CALL TYPCHR
	MOVEI T2,12		;LF
	CALL TYPCHR
	JRST TYPRT1		;LOOP BACK FOR REST

TYPRT3:	POP P,T4
	POP P,T3
	POP P,T2
	POP P,T1
	RET


;ROUTINE TO TYPE A CHARACTER
;ACCEPTS IN T1/	JFN
;	    T2/	CHARACTER

TYPCHR:	CAIN T2,15		;CR?
	SETZM COLUMN		;YES, ZERO COLUMN COUNTER
	CAIL T2," "		;PRINTING CHARACTER?
	AOS COLUMN		;YES, COUNT COL UP BY ONE
	CAIN T2,11		;TAB?
	JRST [	EXCH T2,COLUMN	;YES
		LSH T2,-3	;UPDATE COLUMN TO NEXT TAB STOP
		LSH T2,3
		ADDI T2,8
		EXCH T2,COLUMN
		JRST .+1]
	BOUT			;OUTPUT THE CHAR
	RET
;ROUTINE TO TYPE OUT SPACES TO THE SPECIFIED COLUMN
;ACCEPTS IN T1/	OUTPUT JFN
;	    T2/	COLUMN POSITION

TYPSPA:	SAVET
	MOVEI T3,-1(T2)		;GET COLUMN POS INTO T3
	SUB T3,COLUMN		;GET NUMBER OF SPACES TO TYPE
	MOVEI T2," "
	CALL TYPCHR		;TYPE OUT AT LEAST ONE
	SOJG T3,.-1		;LOOP BACK TILL AT DESIRED COLUMN
	RET


;ROUTINE TO TYPE OUT A FLOATING POINT NUMBER

TYPFLT:	SAVET
	STKVAR <<TYPFLS,10>,TYPFLJ>
	MOVEM T1,TYPFLJ		;SAVE THE JFN
	HRROI T1,TYPFLS		;GET ADR OF STRING
	SETZ T3,		;NORMAL FORMAT
	FLOUT
	 JRST ERROR
	MOVE T1,TYPFLJ		;GET JFN AGAIN
	HRROI T2,TYPFLS		;NOW TYPE OUT THE ANSWER
	CALLRET TYPSTR


;ROUTINE TO TYPE OUT AN INTEGER
;ACCEPTS IN T1/	OUTPUT JFN
;	    T2/	NUMBER
;	    T3/	RADIX

TYPNUM:	SAVET
	STKVAR <<TYPNUS,10>,TYPNUJ>
	MOVEM T1,TYPNUJ		;SAVE JFN
	HRROI T1,TYPNUS		;GET ADR OF STRING
	NOUT
	 JRST ERROR
	MOVE T1,TYPNUJ		;GET JFN AGAIN
	HRROI T2,TYPNUS		;NOW OUTPUT THE NUMBER
	CALLRET TYPSTR
;ROUTINE TO TYPE OUT A STRING
;ACCEPTS IN T1/	JFN
;	    T2/	STRING POINTER

TYPSTR:	SAVET
	MOVE T3,T2		;GET BYTE POINTER
	TLC T3,-1
	TLNE T2,-1		;LH = 0?
	TLCN T3,-1		;OR LH = -1?
	HRLI T3,(POINT 7,0)	;YES, SET UP BYTE POINTER
TYPST1:	ILDB T2,T3		;GET NEXT CHAR TO BE OUTPUT
	JUMPE T2,R		;IF NULL, DONE
	CALL TYPCHR		;TYPE IT OUT
	JRST TYPST1		;LLOP BACK FOR REST OF CHARS
;ROUTINE TO TYPE OUT AN ERROR MESSAGE

ERROR:	HRROI T1,[ASCIZ/
? FATAL ERROR: /]
	PSOUT
	MOVEI T1,.PRIOU		;GET OUTPUT JFN
	HRLOI T2,.FHSLF
	SETZ T3,
	ERSTR			;OUTPUT THE ERROR MESSAGE
	 JFCL
	 JFCL
	HALTF
	JRST FILE


;ROUTINE TO TYPE AN ERROR MESSAGE

ERRTYP:	HRROI T1,[ASCIZ/
% ERROR: /]
	PSOUT
	MOVEI T1,.PRIOU
	HRLOI T2,.FHSLF
	SETZ T3,
	ERSTR
	 JFCL
	 JFCL
	RET
;SAVE ROUTINES

SAVT:	PUSH P,T1
	PUSH P,T2
	PUSH P,T3
	PUSH P,T4
	CALL 0(CX)
	 SKIPA
	AOS -4(P)
	POP P,T4
	POP P,T3
	POP P,T2
	POP P,T1
	RET

SAVQ:	PUSH P,Q1
	PUSH P,Q2
	PUSH P,Q3
	CALL (CX)
	 SKIPA
	AOS -3(P)
	POP P,Q3
	POP P,Q2
	POP P,Q1
	RET

SAVPQ:	PUSH P,Q1
	PUSH P,Q2
	PUSH P,Q3
	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
	PUSH P,P4
	PUSH P,P5
	PUSH P,P6
	CALL 0(CX)
	 SKIPA
	AOS -11(P)
	POP P,P6
	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1
	POP P,Q3
	POP P,Q2
	POP P,Q1
	RET
SAVP:	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
	PUSH P,P4
	PUSH P,P5
	PUSH P,P6
	CALL 0(CX)
	 SKIPA
	AOS -6(P)
	POP P,P6
	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1
	RET
;COMMAND TREES

LEV0CT:	$INIT (LEV0C1)
LEV0C1:	$KEYDSP (LEV0TB)
LEV0TB:	$STAB
	DSPTAB (LEV0CA,ADDCMD,<ADD>)
	DSPTAB (CRLF,CHKCMD,<CHECK-DATABASE>)
	DSPTAB (LEV0CD,DELCMD,<DELETE>)
	DSPTAB (LEV0CC,DMPCMD,<DUMP-DATABASE>)
	DSPTAB (CRLF,EXIT,<EXIT>)
	DSPTAB (LEV0F,FNDCMD,<FIND>)
	DSPTAB (LEV0CL,LSTCMD,<LIST>)
	DSPTAB (LEV0CS,SETCMD,<SET>)
	DSPTAB (LEV0TP,TYPCMD,<TYPE>)
	DSPTAB (LEV0CU,UNDCMD,<UNDELETE>)
	$ETAB

LEV0CA:	$KEYDSP (LEVCA1)
LEVCA1:	$STAB
	DSPTAB (LEVCA2,ADDDOC,<DOCUMENT>)
	$ETAB

LEVCA2:	PDBDEF (.CMNUM,,<^D10>,,,CRLF,CRLF)

LEVNUM:	$NUMBER (CRLF,<^D10>,<DOCUMENT NUMBER>)

LEV0F:	PDBDEF (.CMOFI,,,,,CRLF,CRLF)

LEV0CD:	$KEYDSP (LEVCD1)
LEVCD1:	$STAB
	DSPTAB (LEVNUM,DELDOC,<DOCUMENT>)
	DSPTAB (LEVDK,DELKEY,<KEYWORD>)
	$ETAB

LEV0CU:	$KEYDSP (LEVCU1)
LEVCU1:	$STAB
	DSPTAB (LEVNUM,UNDDOC,<DOCUMENT>)
	$ETAB

LEVDK:	$FIELD (LEVDK1,<KEYWORD>)
LEVDK1:	$NOISE (LEVNUM,<FROM DOCUMENT>)

LEV0CC:	$NOISE (LEVCC1,<TO CONTROL FILE>)
LEVCC1:	$OFILE (CRLF)

LEV0CL:
LEV0TP:	$KEYDSP (LEV0T1)
LEV0T1:	$STAB
	DSPTAB (LEV0F,LSTAUT,<AUTHORS>)
	DSPTAB (LEVNUM,LSTDOC,<DOCUMENT>)
	DSPTAB (LEV0F,LSTLOC,<FILE-CABINET-FOLDER-NAMES>)
	DSPTAB (LEV0F,LSTKEY,<KEYWORDS>)
	DSPTAB (LEV0F,LSTTTL,<TITLES>)
	$ETAB

CRLF:	$CRLF

;YES/NO COMMAND TABLE

YNCT:	$INIT (YNCT1)
YNCT1:	$KEYDSP (YNCT2)
YNCT2:	$STAB
	DSPTAB (CRLF,0,<NO>)
	DSPTAB (CRLF,1,<YES>)
	$ETAB

LEV0CS:	$KEYDSP (LEVSTB)
LEVSTB:	$STAB
	DSPTAB (LEVSA,SETAUT,<AUTHORS>)
	DSPTAB (LEVSD,SETDAT,<DATE>)
	DSPTAB (LEVSF,SETFIL,<FILE-NAME>)
	DSPTAB (LEVSK,SETKEY,<KEYWORDS>)
	DSPTAB (LEVSL,SETLOC,<LOCATION-OF-FILE-CABINET>)
	DSPTAB (LEVSP,SETPDM,<PDM>)
;	DSPTAB (LEVSS,SETSTS,<STATUS>)
	DSPTAB (LEVST,SETTTL,<TITLE>)
	$ETAB

LEVSA:	$NOISE (LEVSA1,<OF DOCUMENT>)
LEVSA1:	$NUMBER (LEVSA2,<^D10>,<DOCUMENT NUMBER>)
LEVSA2:	$NOISE (LEVSA3,<TO>)
LEVSA3:	PDBDEF (.CMFLD,<CM%BRK>,,,,,LEVSA4,,,,ADDKB)
LEVSA4:	PDBDEF (.CMCMA,,,,,LEVSA5,LEVSA3)
LEVSA5:	PDBDEF (.CMCFM,<CM%SDH>,,,,LEVSA3)

LEVSD:	$NOISE (LEVSD1,<OF DOCUMENT>)
LEVSD1:	$NUMBER (LEVSD2,<^D10>,<DOCUMENT NUMBER>)
LEVSD2:	$NOISE (LEVSD3,<TO>)
LEVSD3:	$DATE (CRLF)

LEVSF:	$NOISE (LEVSF1,<OF DOCUMENT>)
LEVSF1:	$NUMBER (LEVSF2,<^D10>,<DOCUMENT NUMBER>)
LEVSF2:	$NOISE (LEVSF3,<TO>)
LEVSF3:	$TEXT (CRLF,<FILE NAME OF DOCUMENT>)

LEVSK:	$NOISE (LEVSK1,<OF DOCUMENT>)
LEVSK1:	$NUMBER (LEVSK2,<^D10>,<DOCUMENT NUMBER>)
LEVSK2:	$NOISE (LEVSK3,<TO>)
LEVSK3:	PDBDEF (.CMFLD,<CM%BRK>,,,,,LEVSK4,,,,ADDKB)
LEVSK4:	PDBDEF (.CMCMA,,,,,LEVSK5,LEVSK3)
LEVSK5:	PDBDEF (.CMCFM,<CM%SDH>,,,,LEVSK3)

LEVSL:	$NOISE (LEVSL1,<OF DOCUMENT>)
LEVSL1:	$NUMBER (LEVSL2,<^D10>,<DOCUMENT NUMBER>)
LEVSL2:	$NOISE (LEVSL3,<TO>)
LEVSL3:	$TEXT (CRLF,<WHERE THE DOCUMENT IS PHYSICALLY FILED>)

LEVSP:	$NOISE (LEVSP1,<OF DOCUMENT>)
LEVSP1:	$NUMBER (LEVSP2,<^D10>,<DOCUMENT NUMBER>)
LEVSP2:	$NOISE (LEVSP3,<TO>)
LEVSP3:	$TEXT (CRLF,<ENTER THE PDM NUMBER OF THE DOCUMENT>)

LEVSS:	$NOISE (LEVSS1,<OF DOCUMENT>)
LEVSS1:	$NUMBER (LEVSS2,<^D10>,<DOCUMENT NUMBER>)
LEVSS2:	$NOISE (LEVSS3,<TO>)
LEVSS3:	$KEYDSP (LEVSS4)
LEVSS4:	$STAB
	DSPTAB (CRLF,SETDEL,<DELETED>)
	DSPTAB (LEVSS5,SETNOT,<NOT>)
	DSPTAB (CRLF,SETOUT,<OUT-DATED>)
	$ETAB
LEVSS5:	$KEYDSP (LEVSS6)
LEVSS6:	$STAB
	DSPTAB (CRLF,SETNDL,<DELETED>)
	DSPTAB (CRLF,SETNOU,<OUT-DATED>)
	$ETAB

LEVST:	$NOISE (LEVST1,<OF DOCUMENT>)
LEVST1:	$NUMBER (LEVST2,<^D10>,<DOCUMENT NUMBER>)
LEVST2:	$NOISE (LEVST3,<TO>)
LEVST3:	$TEXT (CRLF,<ENTER THE TITLE OF THE DOCUMENT>)


ADDT:	$INIT (ADDT1)
ADDT1:	$TEXT (CRLF,<ENTER THE TITLE OF THE DOCUMENT>)

ADDA:	$INIT (ADDA1)
ADDA1:	PDBDEF (.CMFLD,<CM%BRK>,,,,,ADDA2,,,,ADDKB)
ADDA2:	PDBDEF (.CMCMA,,,,,ADDA3,ADDA1)
ADDA3:	PDBDEF (.CMCFM,<CM%SDH>,,,,ADDA1)

ADDD:	$INIT (ADDD1)
ADDD1:	$DATE (CRLF)

ADDP:	$INIT (ADDP1)
ADDP1:	PDBDEF (.CMCFM,<CM%SDH>,,,,ADDP2)
ADDP2:	$TEXT (,<ENTER THE PDM NUMBER (IF ANY)>)

ADDK:	$INIT (ADDK1)
ADDK1:	PDBDEF (.CMFLD,<CM%BRK>,,,,,ADDK2,,,,ADDKB)
ADDK2:	PDBDEF (.CMCMA,,,,,ADDK3,ADDK1)
ADDK3:	PDBDEF (.CMCFM,<CM%SDH>,,,,ADDK1)

ADDKB:	777377,,777760
	200040,,000420
	000000,,000000
	000000,,000020

ADDL:	$INIT (ADDL1)
ADDL1:	PDBDEF (.CMCFM,<CM%SDH>,,,,ADDL2)
ADDL2:	$TEXT (,<ENTER THE PHYSICAL LOCATION OF WHERE THE DOCUMENT IS FILED>)

ADDF:	$INIT (ADDF1)
ADDF1:	PDBDEF (.CMCFM,<CM%SDH>,,,ADDF2)
ADDF2:	$TEXT (,<FILE NAME OF DOCUMENT (IF DOCUMENT IS STORED ON COMPUTER>)


FINDT:	$INIT (FINDT1)
FINDT1:	PDBDEF (.CMCFM,<CM%SDH>,,,,FINDT2)
FINDT2:	$TEXT (,<TITLE OF THE DOCUMENT TO FIND>)

FINDA:	$INIT (FINDA3)
FINDA1:	PDBDEF (.CMFLD,<CM%BRK>,,,,,FINDA2,,,,ADDKB)
FINDA2:	PDBDEF (.CMCMA,,,,,FINDA3,FINDA1)
FINDA3:	PDBDEF (.CMCFM,<CM%SDH>,,,,FINDA1)

FNDDF:	$INIT (FNDDF1)
FNDDF1:	PDBDEF (.CMCFM,<CM%SDH>,,,,FNDDF2)
FNDDF2:	$DATE 

FNDDT:	$INIT (FNDDT1)
FNDDT1:	PDBDEF (.CMCFM,<CM%SDH>,,,,FNDDT2)
FNDDT2:	$DATE 

FINDP:	$INIT (FINDP1)
FINDP1:	PDBDEF (.CMCFM,<CM%SDH>,,,,FINDP2)
FINDP2:	$TEXT (,<PDM NUMBER>)

FINDK:	$INIT (FINDK3)
FINDK1:	PDBDEF (.CMFLD,<CM%BRK>,,,,,FINDK2,,,,ADDKB)
FINDK2:	PDBDEF (.CMCMA,,,,,FINDK3,FINDK1)
FINDK3:	PDBDEF (.CMCFM,<CM%SDH>,,,,FINDK1)

	END <3,,ENTVEC>