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>