Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/makhlp.mac
There are 10 other files named makhlp.mac in the archive. Click here to see a list.
	TITLE	MAKHLP

	SEARCH	MONSYM,MACSYM


;******************************************************************************
;*									      *
;*  COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATIO 1983, 1988 ALL RIGHTS RESERVED.*
;* 									      *
;*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED    *
;*  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE    *
;*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER    *
;*  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY    *
;*  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY    *
;*  TRANSFERRED.							      *
;* 									      *
;*  THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE    *
;*  AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT    *
;*  CORPORATION.							      *
;* 									      *
;*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS    *
;*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.		      *
;*									      *
;******************************************************************************


	EXTERN	HELPER

	SALL

	CUSTVR==0
	DECVER==1
	DECMVR==0
	DECEVR==0

	VERSN==:<CUSTVR>B2!<DECVER>B11!<DECMVR>B17!DECEVR

	LOC	<.JBVER==137>
	VERSN
	IF2	<PURGE	VERSN,CUSTVR,DECVER,DECEVR,DECMVR>
	RELOC
;
;The help library is divided into two parts. The first part contains the
;header, level-0 table and all subsequent tables. The second part contains
;text. Each level-1 table starts on a page boundary. The text associated
;with each level-0 entry also starts on a page boundary. This is done to
;simplify library maintenance.
;
;The first page of the file contains a header with the following format:
;
;	+------------------------+------------------------+
;	|                        |    Library flags       |
;	+------------------------+------------------------+
;	|            Librarian version word               |
;	+------------------------+------------------------+
;	| Length of text area    |  Start address of text |
;	+------------------------+------------------------+
;	|   Offset to table-0    | Adrs. of first free wd.|
;	+------------------------+------------------------+
;	| Length of level-0 tbl. | Length of longest key  |
;	+------------------------+------------------------+
;	|            Date of last modification            |
;	+------------------------+------------------------+
;
;The layout of the key tables is the same for all tables and is as follows:
;
;	+------------------------+------------------------+
;	|                        |    Table length        |
;	+------------------------+------------------------+
;	|  Pointer to key name   |  Pointer to entry text |
;	+------------------------+------------------------+
;	|       Flags            |  Pointer to next level |
;	+------------------------+------------------------+
;	|       .....            |         .....          |
;	+------------------------+------------------------+
;
;The pointer to the key name is always relative to the start of the page
;containing the level-0 or level-1 table as appropriate. The pointer to the
;entry's text is an absolute pointer if the table is level-0 or is relative
;to the level-0 value for all other tables. The pointer to the next level
;is an absolute pointer in the level-0 table and is relative to the level-1
;page base in all other tables.
;
;The text area contains ASCIZ strings which all start on word boundaries.
;The text associated with a level-0 entry and its subsequent levels also
;starts on a page boundary.
;
;The flags halfwords are as follows:
;
;	+------------------+-----------------+
;	|  Text length     |  Table length   |
;	+------------------+-----------------+
;	 0                8 9            17
;
;Where,
;	Table length is the length of the next level table in pages.
;	    This is only used in the level-0 table.
;	Text length is the length of the text area in pages. This is
;	    only used in the level-0 table.
	SUBTTL	MACROS 

;
;TAB (STR,RTN) - table entry macro. This creates entries in the command
;keyword tables. STR is the keyword string enclosed in angle brackets,
;RTN is the address to call or flags.
;
DEFINE	TAB(STR,RTN<0>)<
	[ASCIZ /STR/],,RTN
>

;
;NOISE (TEXT) - parse guide words. TEXT is the quide word string enclosed
;in angle brackets.
;
DEFINE	NOISE(TEXT)<
	MOVEI	A,[ASCIZ \TEXT\]
	CALL	CNOISE
>

;
;$COMND (BLOCK) - perform a COMND JSYS using the specified FDB. Only the
;last three letters of the FDB should be specified.
;
DEFINE	$COMND(BLOCK)<
	MOVEI	A,CSB
	MOVEI	B,FDB'BLOCK
	COMND
	 ERCAL	ERRPC
>

;
;CONFIRM - parse a carriage return in a command line.
;
DEFINE	CONFIRM<
	$COMND	CFM
	TXNE	A,CM%NOP
	 JRST	INVCMD
>

;
;SGJBLK (FLAG, NAME, EXTN) - set up the GTJFN block during command
;parsing. FLAG is either INPUT or OUTPUT as appropriate. NAME is a
;byte pointer to the default name, or blank. EXTN is a byte pointer
;to the default extension, or blank.
;
DEFINE	SGJBLK(FLAG,NAME,EXTN)<
  IFIDN	<FLAG><INPUT>,<
	MOVX	A,GJ%OLD!GJ%XTN
  >
  IFIDN	<FLAG><OUTPUT>,<
	MOVX	A,GJ%FOU!GJ%XTN!GJ%MSG
  >
	MOVEM	A,GTJBLK+.GJGEN

  IFNB	<NAME>,<
	MOVE	A,NAME
	MOVEM	A,GTJBLK+.GJNAM
  >
  IFB	<NAME>,<
	SETZM	GTJBLK+.GJNAM
  >

  IFNB	<EXTN>,<
	MOVE	A,EXTN
	MOVEM	A,GTJBLK+.GJEXT
  >
  IFB	<EXTN>,<
	SETZM	GTJBLK+.GJEXT
>>

;
;PG2ADR (X) - convert the contents of AC X from pages to address.
;
DEFINE	PG2ADR(X)<LSH X,^D9>

;
;ADR2PG (X) - convert the contents of AC X from address to pages.
;
DEFINE	ADR2PG(X)<LSH X,-^D9>

;
;OUTSTR (TEXT) - output the string TEXT to the file whose JFN is in
;OUTJFN. If TEXT is blank, then a <CR><LF> is output.
;
DEFINE	OUTSTR(TEXT)<
	HRRZ	A,OUTJFN
  IFNB	<TEXT>,<
	MOVE	B,[POINT 7,[ASCIZ \TEXT\]]
  >
  IFB	<TEXT>,<
	MOVE	B,[POINT 7,[ASCIZ /
/]]
  >
	SETZB	C,D
	SOUT
>
	PAGE
	SUBTTL	AC DEFINITIONS AND PARAMETERS

;AC DEFINITIONS

	N=0
	A=1
	B=2
	C=3
	D=4
	E=5
	F=6
	AP=16
	P=17

;SUBLEVEL TABLE TYPES (ST)

	H.NORM==0			;NORMAL SUBLEVEL
	H.SWIT==1			;SWITCHES = /NAME
	H.SUBC==2			;SUBCOMMAND = &NAME
	H.RELC==3			;RELATED COMMANDS

;LIBRARY CONTROL

	OUTPAG=40			;OUTPUT COLLECTION PAGE
	.OUTPG=OUTPAG_^D9
	LV0PAG=100			;NUMBER OF LEVEL-0 PAGE IN MEMORY
	.LV0PG=LV0PAG_^D9		;(PHYSICAL ADDRESS)
	.LV0TB=.LV0PG+10		;(ADDRESS OF TABLE)
	LPAGES=4			;PAGES PER LEVEL
	.LV0KY=.LV0PG+100		;LEVEL-0 KEYNAMES
	KEYPAG=140
	.KEYPG=KEYPAG_^D9
	TXTPAG=200			;START OF TEXT FOR TOPIC
	.TXTPG=TXTPAG_^D9
	MAXLVL=7			;MAXIMUM LEVEL NUMBER IN LIBRARY

	SPACE=40			;SPACE CODE
	TAB=11				;TAB CODE
	SUBTTL	PARSING TABLES ETC

PUTTXT:	0				;-1 says text pointer has been set
TXTPTR:	0				;Pointer to txtbuf
TXTBUF:	BLOCK	52			;Command buffer
	TXTBLN=<.-TXTBUF>*5
ATOM:	BLOCK	10			;Atom buffer
	ATOMLN=<.-ATOM>*5

CSB:					;Comnd argument block
	0				;Reparse address
	.PRIIN,,.PRIOU			;Jfn's
	POINT 7,[ASCIZ /MAKHLP> /]	;Prompt (^R buffer)
	POINT 7,TXTBUF			;Buffer
	POINT 7,TXTBUF
	TXTBLN
	TXTBLN
	POINT 7,ATOM
	ATOMLN
	GTJBLK				;GTJFN BLOCK ADDRESS

GTJBLK:					;GTJFN BLOCK
	BLOCK	16
FDBINI:	FLDDB.	.CMINI
FDBCMD:	FLDDB.	.CMKEY,,CMDTBL
FDBHLP:	FLDDB.	.CMFIL,<CM%HPP!CM%SDH>,,<Help text file specification>
FDBSET:	FLDDB.	.CMKEY,,SETTBL
FDBNOI:	FLDDB.	.CMNOI
FDBLIB:	FLDDB.	.CMFIL,<CM%HPP!CM%SDH>,,<Library file specification>
FDBLST:	FLDDB.	.CMFIL,<CM%HPP!CM%SDH>,,<Listing file specification>
FDBFAC:	FLDDB.	.CMFLD,<CM%HPP!CM%SDH>,,<Facility name>
FDBTXT:	FLDDB.	.CMTXT,<CM%HPP!CM%SDH>,,<Help topic>
FDBCFM:	FLDDB.	.CMCFM


CMDTBL:	CMDLEN,,CMDLEN
	TAB	<ADD>,CMADD
	TAB	<EXTRACT>,CMEXT
	TAB	<HELP>,CMHLP
	TAB	<LIST>,CMLIS
	TAB	<QUIT>,CMQIT
	TAB	<SET>,CMSET

	CMDLEN=.-CMDTBL-1

;
;SET keywords and flags
;

	SET%FC=1			;SET FACILITY
	SET%VY=2			;SET [NO]VERIFY
	SET%NO=1B18			;SET NO...

SETTBL:	SETLEN,,SETLEN
	TAB	<FACILITY>,<SET%FC>
	TAB	<NOVERIFY>,<SET%VY+SET%NO>
	TAB	<VERIFY>,<SET%VY>


	SETLEN=.-SETTBL-1
	SUBTTL	MAIN DATA AREA

;THE FOLLOWING 8 WORDS FORM A COPY OF THE LIBRARY HEADER

LHEADR:	0				;Header word
LVERSN:	0				;Librarian version number
LTXTPT:	0				;Pointer to text area of library
LKEYPT:	0				;Pointer to key names in level-0
LV0LEN:					;(LHS) Length of level-0 table (pages)
MAXKEY:	0				;(RHS) Length of longest keyname
LSTMOD:	0				;Last modification date
	0
	0
HDRLEN==.-LHEADR			;Length of header


LVOPEN:	0				;-1 if a level is being created
CURLVL:	0				;Current level number
NEWLIB:	0				;-1 => new library
LV0OFS:	0				;Offset to level-0 keys
LV0TOP:	0				;Address of last level-0 key name
LV0PTR:	0				;Pointer to level-0 name to be used
LV0NAM:	BLOCK	^D16			;Name assigned to level-0
LV0ENT:	0				;Pointer to level-0 entry
LV0FLG:	0				;-1 If level-0 already seen
OPTADR:	0				;Address in output page
TPOINT:	0				;Pointer to text area
KPOINT:	0				;Pointer to keynames area
K0PTR:	0				;Level-0 keynames pointer
INPJFN:	0				;Input file JFN
OUTJFN:	0				;Output file JFN
TEMP:	BLOCK	^D16			;Temporary string area
TBLADR:	BLOCK	MAXLVL+1		;Ptr to table base
CURENT:	BLOCK	MAXLVL+1		;Pointer to current table entries
VERIFY:	0				;-1 to enable verify mode
NUMPGS:	0				;Number of pages mapped in list
HLPARG:	XWD	-1,0			;HELP command argument block
	0				;Pointer to help string
ASMPTR:	0				;Pointer to destination for GETTOP
ITEMS:	0				;Item count for summary
EXTOFS:	0				;Pointer used by CHKENT for EXTRACT cmd.
ONCE:	0				;Set to -1 when header done once

STACK:	BLOCK	100			;Stack
	SUBTTL	STARTUP AND COMMAND PARSING

MAKHLP::
	MOVE	P,[IOWD 100,STACK]
	RESET				;RESET ALL
	MOVEI	B,MKH.2
	MOVEM	B,CSB+.CMFLG
	SKIPE	ONCE			;Do header once
	 JRST	MKH.1
	SETOM	ONCE
	TMSG	<MAKHLP version >
	MOVEI	A,.PRIOU
	MOVEM	A,OUTJFN
	MOVE	A,.JBVER		;Pick up current version
	MOVEM	A,LVERSN
	CALL	VEROUT			;Type the version
	SETZM	OUTJFN			;Prevent losing the terminal
	TMSG	<

>
MKH.1:
	MOVE	A,[POINT 7,ATOM]	;Default the GETTOP pointer
	MOVEM	A,ASMPTR
	$COMND	INI			;Init the COMND JSYS
MKH.2:
	SETZM	EXTOFS			;Clear it just in case
	SETZM	ITEMS			;Nothing processed yet
	$COMND	CMD			;Get the command
	TXNE	A,CM%NOP		;OK?
	 JRST	INVCMD			;No
	HRRZ	B,(B)			;Get the command number
	JRST	(B)			;Do the command


CMQIT:				;QUIT command
	CONFIRM
	HALTF
	SUBTTL	HELP COMMAND

CMHLP:
	$COMND	TXT
	MOVE	B,[POINT 7,ATOM]	; Then he wants help on a topic
	MOVEM	B,HLPARG+1
	MOVEI	AP,HLPARG+1		;Point to the arguments
	CALL	HELPER			;Go for help
	SKIPN	A,N			;If N=0 then all OK
	 JRST	MKH.1
	MOVE	A,[POINT 7,[ASCIZ /Unable to find help file/]
		   POINT 7,[ASCIZ /Unable to allocate memory/]
		   POINT 7,[ASCIZ /MAKHLP facility not found in file/]]-1(A)
	PUSH	P,A
	TMSG	<
?MAKHLP - >
	POP	P,A
	PSOUT				;Output the error message
	TMSG	<
>
	JRST	MKH.1			;Done
	SUBTTL	ADD COMMAND

CMADD:
	NOISE	<TEXT>
	SGJBLK	INPUT,,<[POINT 7,[ASCIZ /HLP/]]>
ADD.1:
	$COMND	HLP			;Parse the help text file spec
	TXNE	A,CM%NOP
	 JRST	INVCMD			;Failed
	MOVEM	B,INPJFN		;Input file jfn
	MOVE	A,[POINT 7,TEMP]
	MOVX	C,1B8			;Only need file name
	SETZ	D,
	JFNS				;get it
	MOVE	A,[POINT 7,TEMP]
	SKIPN	LV0PTR			;If the level-0 name has not been set
	 MOVEM	A,LV0PTR		; Then set it now
	SGJBLK	OUTPUT,<[POINT 7,TEMP]>,<[POINT 7,[ASCIZ /HLB/]]>
	NOISE	<TO LIBRARY>
	$COMND	LIB			;Parse the library spec
	TXNE	A,CM%NOP
	 JRST	INVCMD
	MOVEM	B,OUTJFN		;Save the JFN
	CONFIRM
ADDNEW:
	SETZM	LV0FLG			;Not seen level-0 name yet
	SETZM	LHEADR
	MOVE	A,[LHEADR,,LHEADR+1]
	BLT	A,LHEADR+HDRLEN-1	;Clear it all out
	MOVEI	A,HDRLEN
	HRLM	A,LKEYPT		;Set pointer to level-0
	MOVE	A,.JBVER		;Set up header for file
	MOVEM	A,LVERSN
	MOVEI	A,.LV0KY		;Get address of level-0 keys
	MOVEM	A,LV0OFS
	MOVEM	A,LV0TOP		;Save as top address
	MOVE	A,[POINT 7,.TXTPG]	;Set pointer to text area
	MOVEM	A,TPOINT
	SETZM	KPOINT			;Clear offset to keynames
	MOVEI	A,.LV0KY		;Point to level-0 keys
	MOVEM	A,K0PTR
	SETZ	B,			;Clear a counter
ADN.0:
	MOVEI	A,(B)
	IMULI	A,1000*LPAGES		;Offset to next table start
	ADDI	A,.LV0PG		;Make it physical
	SKIPN	B			;If this is level-0
	 ADDI	A,10			; then skip the header
	SETZM	(A)			;Preset the table
	MOVEM	A,TBLADR(B)		;Save the pointer
	SETZM	CURENT(B)		;No current entry yet
	AOS	B
	CAIG	B,MAXLVL		;Continue until done
	 JRST	ADN.0
	GTAD				;Save date of latest mod
	MOVEM	A,LSTMOD

ADF.1:
	HRRZ	A,INPJFN
	MOVE	B,[7B5+OF%RD]		;Set up for open
	OPENF
	 ERCAL	ERRPC
	SETZM	LVOPEN			;No levels open yet
	SETZM	CURLVL
ADF.2:
	MOVE	B,[POINT 7,TXTBUF]	;Reset the buffer pointer
	MOVEM	B,TXTPTR
	HRRZ	A,INPJFN
	MOVEI	C,TXTBLN
	MOVEI	D,12			;Terminate read on <LF>
	SIN
	 ERJMP	[HRRZ	A,INPJFN	;See if its EOF
		 GTSTS
		 TXNE	B,GS%EOF
		  JRST	ADFNXT		;Yes - go for next file
		 PUSH	P,[ADF.2]
		 JRST	ERRPC]
	CAIN	C,TXTBLN		;If nothing read
	 JRST	ADF.2			; then try again
	ILDB	A,TXTPTR		;Get the first character
	CAIN	A,"!"			;Ignore comment lines
	 JRST	ADF.2
	CAIG	A,MAXLVL+"0"
	 CAIGE	A,"0"			;If its a valid level number
	  SKIPA
	   JRST	ADF.6			;Then handle it
	SKIPL	LVOPEN			;If a level is not open
	 JRST	ADF.2			; then ignore this text
ADF.3:				;Come here to insert text
	SKIPE	PUTTXT			;If text is already started
	 JRST	ADF.4			; then don't do this
	SETOM	PUTTXT			;Set the flag for next time
	MOVE	C,TPOINT		;Correct the pointer
	SETZ	B,
	IDPB	B,C			;Make sure the last string has null
	ADDI	C,1			;Word align text
	HRLI	C,(POINT 7,0)
	MOVEM	C,TPOINT		;And save the new pointer
	MOVE	B,CURLVL		;Find where to put the pointer
	MOVE	B,CURENT(B)
	SUBI	C,.TXTPG		;Save the offset only
	HRRM	C,(B)			;And save it in the data area
ADF.4:
	IDPB	A,TPOINT		;Save it
	ILDB	A,TXTPTR		;Copy a byte
	CAIN	A,12			;End on a line feed
	 JRST	[IDPB	A,TPOINT	;Save it in the file
		 JRST	ADF.2]		;And continue
	JRST	ADF.4			;Loop for more

ADF.6:				;Start a new level
	AOS	ITEMS			;Another item processed
	SETZM	PUTTXT			;Allow text pointer to be saved
	SUBI	A,"0"			;Get the new number
	CAMLE	A,CURLVL
	 JRST	ADF.12			;New level being started
	CAML	A,CURLVL		;If same as current level
	 JRST	ADF.10			; continue
	MOVE	B,CURLVL		;Start with old level
ADF.7:
	MOVE	C,TBLADR(B)		;Point to the table
	MOVE	C,(C)			;Get the table length
	LSH	C,1			;In words
	ADDI	C,1			;Offset to next table
	ADDB	C,TBLADR(B)		;Update the pointer
	SETZM	(C)			;And preset the table
	CAIE	B,1(A)			;If not up to the new level
	 SOJA	B,ADF.7			; then do the next higher level

ADF.10:				;Add a new entry to the current level
	MOVEM	A,CURLVL		;This is now the level to use
	CALL	GETTOP			;Scan the topic name
	 JRST	AER.2			; blew it!
	CALL	ADDTOP			;Add topic to table
	 JRST	AER.2
	JRST	ADF.15

ADF.12:				;Create a new level
	AOS	CURLVL			;Get new level number
	CAILE	A,MAXLVL
	 JRST	AER.3			;Too far
	CAME	A,CURLVL		;Are the two now equal
	 JRST	AER.4			; no - something missing
	SKIPE	CURENT-1(A)		;Was the previous level set up?
	 JRST	ADF.14			; yes - ok
	CAIE	A,1			;No - is this level-1
	 JRST	AER.4			; no - something missing
	PUSH	P,TXTPTR		;Save this for later
	SETZM	CURLVL			;This is for level-0
	MOVE	A,LV0PTR
	MOVEM	A,TXTPTR		;Set a pointer for GETTOP
	CALL	GETTOP			;And scan the name
	 JRST	[POP	P,TXTPTR
		 JRST	AER.5]		;Failed
	CALL	ADDTOP			;And insert the new name
	 JRST	[POP	P,TXTPTR
		 JRST	AER.5]		;Failed
	MOVE	A,CURENT		;Copy the level-0 entry pointer
	MOVEM	A,LV0ENT
	MOVE	A,K0PTR
	HRLI	A,(POINT 7,0)		;Get a byte pointer
	HRRZ	B,INPJFN
	MOVX	C,1B2+1B5+1B8+1B11+1B14+1B35
	SETZ	D,
	JFNS				;Get filespec of source
	MOVEI	B,1(A)
	GTAD				;And date of mod
	MOVEM	A,(B)
	MOVEI	A,1(B)
	MOVEM	A,K0PTR			;Save new pointer
	SUBI	A,.LV0PG		;Make it an offset
	MOVEI	B,(A)
	ADR2PG	A
	ADDI	A,1			;Number of pages in level-0 table
	HRLM	A,LV0LEN
	HRRM	B,LKEYPT		;Next free word in level-0
	AOS	A,CURLVL		;Go back to level-1
	POP	P,TXTPTR
ADF.14:
	CALL	GETTOP			;Scan the name
	 JRST	AER.2
	MOVE	A,CURLVL
	MOVE	B,CURENT-1(A)		;Get the address of this table
	MOVE	A,TBLADR(A)		;Point to the table
	HRRM	A,1(B)			;And save its address in the entry
	CALL	ADDTOP			;And add the name to it
	 JRST	AER.2
ADF.15:
	SETOM	LVOPEN			;Level is now open
	CALL	SKIPSP			;Skip leading spaces
	JUMPE	A,ADF.2			;If empty - ignore it
	 JRST	ADF.3


ADFNXT:				;Come here to finish off and get next one
	HRRZ	A,INPJFN
	CLOSF
	 ERCAL	ERRPC
	HRRZ	A,OUTJFN		;Get the jfn
	MOVEI	B,OF%WR			;36-bit write
	OPENF
	 ERCAL	ERRPC
	MOVEI	A,.OUTPG		;Point to the output buffer
	MOVEM	A,OPTADR
	MOVEI	F,1			;Scan the tables, copy and correct them
ADX.1:
	MOVE	A,TBLADR(F)		;Last or second last table address
	SKIPN	B,(A)
	 JRST	ADX.2			;It was the end
	LSH	B,1			;Table not closed - find the end
	ADDI	B,1
	ADDB	B,A			;End of table + 1
ADX.2:
	MOVE	B,F			;Level number
	IMULI	B,LPAGES		
	ADDI	B,LV0PAG		;Page number of table
	PUSH	P,B			;Save this for later
	PG2ADR	B			;Make it an address
	PUSH	P,B
	PUSH	P,A			;Save some acs
	ANDI	A,<LPAGES*1000>-1	;Keep offset part of address
	ADD	A,OPTADR		;The offset is cumulative
	SUBI	A,.OUTPG
ADX.3:
	SKIPN	C,(B)			;Get table length
	 JRST	ADX.6			; done
	ADDI	B,1			;And point to the first entry
ADX.4:
	SKIPN	D,1(B)			;Get subtable pointer
	 JRST	ADX.5			;Empty - don't correct it
	ANDI	D,<LPAGES*1000>-1	;And keep only the offset
	ADD	D,A
	HRRM	D,1(B)			;Correct and replace the offset
ADX.5:
	ADDI	B,2			;Step to next
	SOJG	C,ADX.4			;Loop round this table
	JRST	ADX.3			;See if there is another table
ADX.6:
	POP	P,A			;Restore things
	POP	P,B
	SUB	A,B			;Table length
	HRLS	B			;Build a blt pointer
	HRR	B,OPTADR		;Destination
	ADDI	A,(B)			;End of destination
	MOVEM	A,OPTADR		;Save for next time
	BLT	B,-1(A)			;Copy this table
	CAIGE	F,MAXLVL		;If more tables to try
	 AOJA	F,ADX.1			; then loop for the next one
	MOVE	A,OPTADR		;Now correct the tables for keynames
	SETZ	(A)			;Mark table end
	SUBI	A,.OUTPG		;Offset to first keyname
	HRLZS	A			;Must be in left half
	MOVEI	B,.OUTPG
	MOVE	C,(B)			;Length of first table
ADX.7:
	ADDI	B,1			;Point to first entry
	ADDM	A,(B)			;Correct the pointer
	ADDI	B,2			;Point to next entry
	SOJG	C,.-2			;Loop till done
	SKIPE	C,(B)			;Get next table length
	 JRST	ADX.7			;And continue if non-zero
	MOVE	A,OPTADR		;Copy the keynames on top of the tables
	MOVE	B,KPOINT		;Length of key data
	ADDI	B,(A)			;Last address
	MOVEM	B,OPTADR		;Save for later
	HRLI	A,.KEYPG		;Make the blt pointer
	BLT	A,-1(B)			;Copy the keynames
	MOVEI	A,OUTPAG		;Now page the tables out to the file
	HRLI	A,.FHSLF
	HRLZ	B,OUTJFN		;Jfn
	HLR	B,LV0LEN		;Page to start
	MOVE	C,OPTADR		;Find length of data
	SUBI	C,.OUTPG
	ADDI	C,777			;And round up to page boundary
	ANDI	C,777000
	ADR2PG	C			;Make into page count
	MOVE	D,CURENT		;Save the length in level-0 table
	HRLM	C,1(D)
	HRLI	C,(PM%CNT)
	PMAP
	 ERCAL	ERRPC
	HLRZ	B,LV0LEN		;Get page number of next table (lvl-1)
	PG2ADR	B
	HRRM	B,1(D)
	MOVEI	A,TXTPAG		;Page text from here
	HRLI	A,.FHSLF
	HLR	B,1(D)			;Length of table
	ADDI	B,1
	PG2ADR	B			;Address of text
	HRRM	B,(D)			;Save in level-0 key
	PUSH	P,B			;Save for later
	ADR2PG	B
	HRL	B,OUTJFN		;Jfn
	MOVE	C,TPOINT		;Get number of pages
	SUBI	C,.TXTPG
	ADDI	C,777			;Round up to page boundary
	ANDI	C,777000
	PUSH	P,C			;Save this
	ADR2PG	C
	PUSH	P,C			;Save page count
	HRLI	C,(PM%CNT)
	PMAP				;Output it
	 ERCAL	ERRPC
	POP	P,C
	MOVE	A,LV0ENT		;Point to current level-0 entry
	DPB	C,[POINT 9,1(A),8]	;And insert text length
	MOVE	A,[LHEADR,,.LV0PG]	;Copy level-0 header
	BLT	A,.LV0PG+7
	MOVEI	A,.LV0TB		;Correct the keyname entries in level-0
	MOVE	B,(A)
	ADDI	A,1
ADX.8:
	HLR	C,(A)			;Get keyname pointer
	ANDI	C,<LPAGES*1000>-1	;Make it relative
	HRLM	C,(A)
	ADDI	A,2			;Point to next entry
	SOJG	B,ADX.8
	MOVEI	A,LV0PAG		;And map it out to the file
	HRLI	A,.FHSLF
	HRLZ	B,OUTJFN
	HLRZ	C,LV0LEN		;Length of level-0
	HRLI	C,(PM%CNT)
	PMAP				;Output it
	 ERCAL	ERRPC
	POP	P,C			;Point to end of file
	POP	P,B
	ADD	C,B
	MOVSI	A,.FBSIZ		;Update the size
	TXO	A,CF%NUD
	HRR	A,OUTJFN
	SETO	B,			;All bits in .fbsiz
	CHFDB
	 ERCAL	ERRPC
	MOVSI	A,.FBBYV		;And the byte size
	HRR	A,OUTJFN
	MOVSI	B,(FB%BSZ)
	MOVSI	C,(^D36B11)
	CHFDB
	 ERCAL	ERRPC
	HRRZ	A,OUTJFN
	CLOSF				;Close the file
	 ERCAL	ERRPC
	CALL	WRTITM			;Print summary
	JRST	MKH.1
	SUBTTL	SET COMMAND

CMSET:
	$COMND	SET			;Get the keyword
	TXNE	A,CM%NOP
	 JRST	INVCMD
	HRRZ	B,(B)			;Get the flags etc
	MOVEI	A,(B)
	TXZ	A,SET%NO		;Get only the keyword number
	JRST	@[SETFAC		;SET FACILITY
		  SETVFY]-1(A)		;SET [NO]VERIFY


SETFAC:				;SET FACILITY command
	$COMND	FAC			;Parse the name
	TXNE	A,CM%NOP
	 JRST	INVCMD
	MOVE	A,[POINT 7,ATOM]
	MOVE	B,[POINT 7,LV0NAM]	;Set up for copy
SETL.1:
	ILDB	C,A
	IDPB	C,B			;Copy a byte
	SKIPE	C
	 JRST	SETL.1
	CONFIRM
	MOVE	B,[POINT 7,LV0NAM]	;Flag the presence of a name
	MOVEM	B,LV0PTR
	JRST	MKH.1			;Done


SETVFY:				;SET [NO]VERIFY command
	SETZM	VERIFY			;Assume SET NOVERIFY
	TXNN	B,SET%NO
	 SETOM	VERIFY			;Really SET VERIFY
	CONFIRM
	JRST	MKH.1
	SUBTTL	LIST COMMAND

CMLIS:
	NOISE	<LIBRARY FILE>
	SGJBLK	INPUT,,<[POINT 7,[ASCIZ /HLB/]]>
	$COMND	LIB			;Parse a library file spec
	TXNE	A,CM%NOP
	 JRST	INVCMD
	MOVEM	B,INPJFN		;Save the JFN
	PUSH	P,A			;Save the flags
	MOVE	A,[POINT 7,TEMP]
	MOVX	C,1B8			;Only get file name
	SETZ	D,
	JFNS				;Get it

	SGJBLK	OUTPUT,[POINT 7,TEMP],[POINT 7,[ASCIZ /LST/]]

	POP	P,A			;Get the old flags again
	TXNE	A,CM%EOC		;If just LIST library...
	 JRST	LIST.1			; Then use default file spec
	NOISE	<ON FILE>
	$COMND	LST			;Parse the list file spec
	TXNE	A,CM%NOP
	 JRST	INVCMD
	MOVEM	B,OUTJFN
	JRST	LIST.2
LIST.1:
	MOVEI	A,GTJBLK		;Get a JFN on the default file
	SETZ	B,
	GTJFN
	 JFCL
	HRRZM	A,OUTJFN
LIST.2:
	CONFIRM
	HRRZ	A,INPJFN		;Open the input file
	MOVEI	B,OF%RD			;Read, 36 bit
	OPENF
	 ERCAL	ERRPC
	HRRZ	A,OUTJFN		;Open the output file
	MOVX	B,7B5+OF%WR		;Write, 7 bit
	OPENF
	 ERCAL	ERRPC

	HRLZ	A,INPJFN		;Map page zero of the file
	MOVE	B,[.FHSLF,,LV0PAG]	;Into LV0PAG
	MOVX	C,PM%RD
	PMAP
	 ERCAL	ERRPC
	MOVE	A,[.LV0PG,,LHEADR]
	BLT	A,LHEADR+HDRLEN-1	;Copy the library header
	HLRZ	C,LV0LEN		;See how long level-0 is
	CAIG	C,1
	 JRST	LIST.3			;Only one page - OK
	MOVEI	A,1
	HRL	A,INPJFN		;Read from file page 1
	MOVE	B,[.FHSLF,,LV0PAG+1]	;To the next page here
	SUBI	C,1
	HRLI	C,(PM%CNT!PM%RD)	;Read (C)-1 pages
	PMAP
	 ERCAL	ERRPC
LIST.3:
	OUTSTR	<Listing of library:  >
	HRRZ	B,INPJFN
	MOVX	C,1B2+1B5+1B8+1B11+1B14+1B35
	JFNS				;Type some header info
	OUTSTR	<  on:  >
	SETO	B,
	SETZ	C,
	ODTIM				;Enter the current date & time
	OUTSTR	<

Library version number:  >
	CALL	VEROUT			;Output the version number
	OUTSTR	<
Library last modified:  >
	MOVE	B,LSTMOD
	SETZ	C,
	ODTIM				;Last modification date

	HLR	A,LKEYPT
	ADDI	A,.LV0PG
	MOVE	B,(A)			;Number of entries
	MOVEM	B,CURENT		;Save it
	ADDI	A,1
	MOVEM	A,TBLADR		;Pointer to level-0 entry

LIST.4:				;Loop for level-0 entries
	MOVE	A,TBLADR
	LDB	C,[POINT 9,1(A),17]	;Get the table size
	MOVEM	C,NUMPGS		;Save for clean-up
	HRLI	C,(PM%CNT!PM%RD)
	MOVE	B,[.FHSLF,,KEYPAG]	;Put it in KEYPAG
	HRRZ	A,1(A)			;Table start
	ADR2PG	A			;Make it a page number
	HRL	A,INPJFN
	PMAP				;Read the table
	 ERCAL	ERRPC

	OUTSTR	<

Facility:  >
	MOVE	B,TBLADR
	HLRZ	B,(B)			;Offset to keyname
	ADD	B,[POINT 7,.LV0PG]
	SOUT
	PUSH	P,B			;Save the pointer
	OUTSTR	<
Source file:  >
	POP	P,B
	ADDI	B,1			;Point to the filespec part
	HRLI	B,(POINT 7,0)
	SOUT
	PUSH	P,B
	OUTSTR	<  added:  >
	POP	P,B
	MOVE	B,1(B)			;Get date of addition
	ODTIM
	MOVE	B,[POINT 7,[ASCIZ /

/]]
	SOUT
	OUTSTR	<Pages of text:  >
	MOVE	B,TBLADR
	LDB	B,[POINT 9,1(B),8]
	MOVEI	C,^D10
	NOUT				;Output # pages of text
	 ERCAL	ERRPC
	OUTSTR	<  pages of keys:  >
	MOVE	B,TBLADR
	LDB	B,[POINT 9,1(B),17]
	MOVEI	C,^D10
	NOUT				;Output # pages of keys
	 ERCAL	ERRPC
	SETZ	C,
	MOVE	B,[POINT 7,[ASCIZ /

/]]
	SOUT				;Be tidy

	PUSH	P,VERIFY		;Save the actual verify flag
	SETOM	VERIFY			;And force it
	MOVEI	A,1
	MOVEM	A,CURLVL		;Preset the next loop
	MOVEI	A,.KEYPG+1
	MOVEM	A,TBLADR+1		;Address of first table entry
	MOVE	A,.KEYPG
	MOVEM	A,CURENT+1		;Number of entries
LIST.5:				;Loop for table entries
	HRRZ	A,OUTJFN
	MOVE	B,CURLVL		;Point to the current table entry
	MOVE	B,TBLADR(B)
	HLRZ	B,(B)
	ADD	B,[POINT 7,.KEYPG]	;Point to keyname
	SETZ	C,
	CALL	DOVRFY			;Output the key name
				;Terminate the loop
	MOVE	A,CURLVL
	MOVE	B,TBLADR(A)		;Point to current entry
	HRRZ	C,1(B)			;Address of next table (if present)
	SOS	CURENT(A)		;Count down one entry
	ADDI	B,2
	MOVEM	B,TBLADR(A)		;Update the pointer to next entry
	SKIPE	C
	 JRST	[ADDI	C,.KEYPG	;Point to next table
		 AOS	A,CURLVL	;Update current level
		 MOVE	B,(C)
		 MOVEM	B,CURENT(A)	;Number of entries
		 AOS	C
		 MOVEM	C,TBLADR(A)	;Pointer to entries
		 JRST	LIST.5]		;Keep looping
	SKIPLE	CURENT(A)		;Count down the entries
	 JRST	LIST.5			;Loop for more
LIST.6:
	SOSLE	A,CURLVL		;Else go to previous level
	 JRST	[SKIPLE	CURENT(A)	;Is this level also empty now?
		  JRST	LIST.5		;No
		 JRST	LIST.6]		;Yes - try the next one

	POP	P,VERIFY		;Restore the flag
	SETO	A,			;Tidy up
	MOVE	B,[.FHSLF,,KEYPAG]
	MOVE	C,NUMPGS
	HRLI	C,(PM%CNT)
	PMAP				;Delete the pages
	 ERCAL	ERRPC

	AOS	TBLADR
	AOS	TBLADR			;Point to next level-0 entry
	SOSLE	CURENT
	 JRST	LIST.4			;More to do

	OUTSTR	<

[End of listing]
>
LIST.7:
	SETO	A,
	MOVE	B,[.FHSLF,,LV0PAG]
	HLRZ	C,LV0LEN
	HRLI	C,(PM%CNT)
	PMAP				;Discard level-0 pages as well
	 ERCAL	ERRPC
	HRRZ	A,INPJFN
	CLOSF				;Close the input file
	 ERCAL	ERRPC
	HRRZ	A,OUTJFN
	CLOSF				;Close the output file
	 ERCAL	ERRPC
	SETZM	INPJFN			;Mark successful close
	SETZM	OUTJFN
	JRST	MKH.1			;Next command
	SUBTTL	EXTRACT COMMAND

CMEXT:
	NOISE	<FACILITY>
	$COMND	FAC			;Parse the facility name
	TXNE	A,CM%NOP
	 JRST	INVCMD
	MOVE	A,[POINT 7,ATOM]
	MOVEM	A,TXTPTR		;Source for GETTOP
	MOVE	A,[POINT 7,LV0NAM]
	MOVEM	A,ASMPTR		;Destination for GETTOP
	CALL	GETTOP			;Scan the facility name
	 JRST	LER.1
	PUSH	P,C			;Save the length for later

	NOISE	<FROM LIBRARY>
	SGJBLK	INPUT,,[POINT 7,[ASCIZ /HLB/]]
	$COMND	LIB			;Parse library spec
	TXNE	A,CM%NOP
	 JRST	INVCMD
	MOVEM	B,INPJFN		;Save the JFN
	PUSH	P,A			;Save parse flags
	SGJBLK	OUTPUT,[POINT 7,LV0NAM],[POINT 7,[ASCIZ /HLP/]]
	POP	P,A
	TXNE	A,CM%EOC		;If no output spec
	 JRST	EXTR.1			; Then default it

	NOISE	<INTO FILE>
	$COMND	HLP			;Parse the help file spec
	TXNE	A,CM%NOP
	 JRST	INVCMD
	MOVEM	B,OUTJFN		;Save the JFN
	JRST	EXTR.2
EXTR.1:
	MOVEI	A,GTJBLK		;Get default output JFN
	SETZ	B,
	GTJFN
	 ERCAL	ERRPC
	HRRZM	B,OUTJFN		;Save the JFN
EXTR.2:
	CONFIRM				;End of command

	HRRZ	A,INPJFN
	MOVEI	B,OF%RD
	OPENF				;Open the input file (36-bit mode)
	 ERCAL	ERRPC

	HRLZ	A,INPJFN		;Read first page
	MOVE	B,[.FHSLF,,LV0PAG]	;Into LV0PAG
	MOVX	C,PM%RD
	PMAP
	 ERCAL	ERRPC
	MOVE	A,[.LV0PG,,LHEADR]
	BLT	A,LHEADR+HDRLEN-1	;Copy the header
	HLRZ	C,LV0LEN
	CAIG	C,1			;If only one page
	 JRST	EXTR.3			; Then done now
	MOVEI	A,1
	HRL	A,INPJFN		;Else read the rest of level-0
	MOVE	B,[.FHSLF,,LV0PAG+1]
	SUBI	C,1
	HRLI	C,(PM%RD!PM%CNT)
	PMAP				;Do it
	 ERCAL	ERRPC
EXTR.3:
	SETZM	CURLVL			;Currently on level-0
	MOVEI	A,.LV0PG		;Set the offset to level-0 names
	MOVEM	A,EXTOFS
	ADDI	A,HDRLEN		;Point to level-0 table
	MOVE	B,[POINT 7,LV0NAM]	;And facility name
	POP	P,C			;Get length back
	CALL	TBLUKP			;And search for it
	 JRST	LER.2			;Not there
	MOVEM	B,LV0PTR		;Save the results of TBLUKP
	PUSH	P,A

	HRRZ	A,OUTJFN		;All OK
	MOVX	B,7B5+OF%WR		;So open the output file - ASCII
	OPENF
	 ERCAL	ERRPC

	LDB	C,[POINT 9,(P),8]	;Get length of text area (pages)
	HRRZM	C,NUMPGS		;And save it for cleanup
	HRLI	C,(PM%CNT!PM%RD)
	MOVE	A,LV0PTR
	ADR2PG	A			;Get page number for level-0
	HRL	A,INPJFN
	MOVE	B,[.FHSLF,,TXTPAG]	;Destination
	PMAP				;Get the text
	 ERCAL	ERRPC
	POP	P,A
	LDB	C,[POINT 9,A,17]	;Get number of level-1 pages
	HRLM	C,NUMPGS		;And save it for later
	HRLI	C,(PM%CNT!PM%RD)
	HRRZS	A
	ADR2PG	A
	HRL	A,INPJFN		;Source
	MOVE	B,[.FHSLF,,KEYPAG]	;Destination
	PMAP				;Get the level-1 tables
	 ERCAL	ERRPC

	MOVEI	A,1
	MOVEM	A,CURLVL		;Preset the loop
	MOVEI	A,.KEYPG+1
	MOVEM	A,TBLADR+1		;First table entry
	MOVE	A,.KEYPG
	MOVEM	A,CURENT+1		;Length of first table
EXTR.4:
	AOS	ITEMS			;Count another item
	HRRZ	A,OUTJFN
	MOVE	B,CURLVL
	ADDI	B,"0"			;Make level number a digit
	BOUT
	MOVEI	B," "			;And space it out
	BOUT
	MOVE	B,CURLVL
	MOVE	B,TBLADR(B)		;Point to next entry
	PUSH	P,B			;And save it
	HLRZ	B,(B)			;Point to key name
	ADD	B,[POINT 7,.KEYPG]
	PUSH	P,B			;Save for verify
	SETZ	C,
	SOUT				;Output the key name
	MOVE	B,[POINT 7,[ASCIZ /
/]]
	SOUT				;And terminate it
	POP	P,B			;Point to key name again
	MOVEI	A,.PRIOU		;Output to terminal
	SETZ	C,
	CALL	DOVRFY			;Type the verify line
	POP	P,B
	HRRZ	B,(B)
	ADD	B,[POINT 7,.TXTPG]	;Point to the text
	HRRZ	A,OUTJFN
	SETZ	C,
	SOUT
				;Terminate the loop
	MOVE	A,CURLVL
	MOVE	B,TBLADR(A)		;Point to current entry
	HRRZ	C,1(B)			;Address of next table (if present)
	SOS	CURENT(A)		;Count down one entry
	ADDI	B,2
	MOVEM	B,TBLADR(A)		;Update the pointer to next entry
	SKIPE	C
	 JRST	[ADDI	C,.KEYPG	;Point to next table
		 AOS	A,CURLVL	;Update current level
		 MOVE	B,(C)
		 MOVEM	B,CURENT(A)	;Number of entries
		 AOS	C
		 MOVEM	C,TBLADR(A)	;Pointer to entries
		 JRST	EXTR.4]		;Keep looping
	SKIPLE	CURENT(A)		;Count down the entries
	 JRST	EXTR.4			;Loop for more
EXTR.5:
	SOSLE	A,CURLVL		;Else go to previous level
	 JRST	[SKIPLE	CURENT(A)	;Is this level also empty now?
		  JRST	EXTR.4		;No
		 JRST	EXTR.5]		;Yes - try the next one

	SETO	A,
	MOVE	B,[.FHSLF,,KEYPAG]	;Delete level-1 pages
	HLRZ	C,NUMPGS		;Number to lose
	HRLI	C,(PM%CNT)
	PMAP				;Do it
	 ERCAL	ERRPC
	MOVE	B,[.FHSLF,,TXTPAG]	;Delete text pages
	HRR	C,NUMPGS		;Number to lose
	PMAP
	 ERCAL	ERRPC

	CALL	WRTITM			;Do summary
	JRST	LIST.7			;Tidy up in LIST code
	SUBTTL	SUBROUTINES

;
;GETTOP - form the next topic name in the atom buffer. terminates on
;the first space or control character (after converting lower case to
;upper case). TXTPTR is left pointing to the next character.
;
;On exit:	C = length of string
;

GETTOP:				;Form next topic name in atom
	CALL	SKIPSP			;Skip leading spaces
	SETZ	C,			;Clear the counter
	MOVE	B,ASMPTR		;Point to the destination
GTP.1:
	JUMPE	A,GTP.2			;Null = end of string
	CAIL	A,140			;Convert lower case to upper
	 SUBI	A,40
	CAIG	A,SPACE			;If this is a good character ...
	 JRST	GTP.2
	IDPB	A,B			;... then save it in atom
	ILDB	A,TXTPTR		;Get the next byte
	AOJA	C,GTP.1			;Increment counter and loop
GTP.2:
	SETZ	A,			;Terminate on a null byte
	IDPB	A,B
	SETO	A,
	ADJBP	A,TXTPTR		;Back off the pointer one place
	MOVEM	A,TXTPTR
	SKIPE	C			;If anything was copied
	 AOS	(P)			;Then skip return
	RET

;
;SKIPSP - Skip leading spaces and tabs in the text buffer. Returns the
;first non-space in A, and leaves TXTPTR pointing to the next character.
;

SKIPSP:
	ILDB	A,TXTPTR		;Get a byte
	CAIE	A,SPACE			;And if it is a space
	 CAIN	A,TAB			; or a tab
	  JRST	SKIPSP			;  then ignore it
	RET
;
;ADDTOP - Add a new topic to a table and increment the count in the
;table header. Set the keyname pointer (provisionaly) and the flags.
;
;On entry:	A = pointer to table header
;		C = Length of key name
;
;On exit:	A =Updated table pointer
;		CURENT = address of entry in table
;
;Non-skip:	Ambiguous or multiply defined topic.
;

ADDTOP:				;Add new topic name to table
	MOVE	A,CURLVL		;Get the table entry for this level
	MOVE	A,TBLADR(A)
	PUSH	P,A			;Save a for now
	SKIPN	(A)			;Is it empty?
	 JRST	[MOVEI	B,1(A)		;Yes - set a pointer to new entry
		 JRST	ADT.1]
	MOVE	B,[POINT 7,ATOM]	;Get a string pointer
	CALL	TBLUKP			;And look for an entry
	 SKIPE	A			;Ok if not found
	  JRST	[POP	P,A		;Ambiguous or already there
		 RET]
	SKIPL	B			;Off end of table?
	 JRST	ADT.1			;Yes - no need to expand
	PUSH	P,C			;Save string length
	HLRO	A,B			;Copy the count remaining
	LSH	A,1			;And double it
	PUSH	P,A			;Save the word count
	MOVNS	A
	ADDI	A,-1(B)			;Point to last word of table
	MOVE	C,(A)			;Copy a word at a time
	MOVEM	C,2(A)			;(blt wont work here)
	AOSE	(P)			;Count up
	 SOJA	A,.-3			;And loop till done
	ADJSP	P,-1			;Clear the stack
	POP	P,C
ADT.1:
	MOVE	A,CURLVL		;Use current level and
	HRRZM	B,CURENT(A)		;Save a pointer to this entry
	SETZM	1(B)			;Clear the flags and next level
	MOVE	E,KPOINT		;Point to keynames area
	SKIPN	CURLVL			;If this is level-0
	 MOVE	E,K0PTR			; then use alternate pointer
	HRLZM	E,(B)			;Put this in the table
	SKIPE	CURLVL			;If not level-0
	 ADDI	E,.KEYPG		; then offset into keynames
	HRLI	E,(POINT 7,0)		;And make it a pointer
	MOVE	A,C
	MOVEI	D,1(C)
	MOVE	B,[POINT 7,ATOM]
	EXTEND	A,[MOVSLJ		;Copy the name
		    0]
	 JFCL
	MOVEI	A,.PRIOU
	MOVE	B,[POINT 7,ATOM]
	CALL	DOVRFY			;Verify the key if required
ADT.2:
	POP	P,A			;Updated pointer
	HRRZ	B,MAXKEY
	CAMLE	C,B			;Save longest key
	 HRRM	C,MAXKEY
	AOS	(A)			;Increment the count
	AOS	(P)			;Skip return
	SKIPN	CURLVL			;If this is level-0
	 JRST	[ADDI	E,1		; make this word aligned
		 HRRZM	E,K0PTR		; and save it for later
		 RET]
	SUBI	E,.KEYPG-1		;Update the offset
	HRRZM	E,KPOINT		;And save it
	RET
;
;TBLUKP - lookup an entry in a table and check for non-existant
;entries or ambiguous values. A flag is also set when the table
;has an inconsistancy - but we don't die here.
;
;On entry:	A = base address of table
;		B = Byte pointer to the string
;		C = length of string
;
;On exit:	A = Contents of second word of table
;		B = Address of text (uncorrected)
;
;Non-skip:	A = -1 if ambiguous
;		A =  0 if not found
;

TBLUKP:
	MOVN	D,(A)			;-ve count
	HRL	A,D			;Make an AOBJN pointer
	AOS	A			;Point to first word pair
TBK.0:
	CALL	CHKENT			;See if the entry exists
	 JRST	TBK.1			; Not far enough down yet
	 JRST	[MOVE	B,A		;Copy the pointer
		 SETZ	A,		; Too far - not found
		 RET]
	PUSH	P,A			;Save the pointer
	AOS	A
	AOBJN	A,.+2			;Point to next entry
	 JRST	TBK.3			;End of table
	CALL	CHKENT			;See if its ambiguous
	 JFCL
	 CAIA
	  JRST	TBK.2
TBK.3:
	POP	P,A
	HRRZ	B,(A)			;Address of text
	MOVE	A,1(A)			;Second word of table
	AOS	(P)			;Good return
	RET
TBK.1:
	AOS	A
	AOBJN	A,TBK.0			;Go for next entry
	MOVE	B,A			;Copy the pointer
	SETZ	A,
	RET				;Not found
TBK.2:
	POP	P,A
	SETO	A,
	RET				;Ambiguous
;
;CHKENT - See if the current entry matches the one given.
;
;On entry:	A = pointer to current entry
;		B = pointer to string
;		C = length of string
;
;On exit:	return +1 = Current entry too low
;		return +2 = Current entry too high
;		return +3 = Current entry matches (may be abbrev.)
;

CHKENT:
	PUSH	P,A
	PUSH	P,B			;Save some things
	MOVE	D,C
	HLR	E,(A)			;Form pointer to key entry
	SKIPE	CURLVL			;If this is not level-0
	 ADDI	E,.KEYPG		; Then offset into keys page
	ADD	E,EXTOFS		;Offset into level-0 (if EXTRACT)
	HRLI	E,(POINT 7,0)
	PUSH	P,E			;Save this pointer
	MOVE	A,C
	EXTEND	A,[CMPSE]		;Compare - no need for filler
	 JRST	CHK.1
	ADJSP	P,-1			;Tidy up and set for good return
	AOS	-2(P)
	AOS	-2(P)
	JRST	CHK.2			;Strings are equal
CHK.1:
	POP	P,E
	MOVE	A,C
	MOVE	D,C			;Reset to find if too far
	MOVE	B,(P)
	EXTEND	A,[CMPSG]
	 AOS	-2(P)
CHK.2:
	POP	P,B
	POP	P,A
	RET
;
;CNOISE - parse a noise word.
;

CNOISE:
	HRLI	A,(POINT 7,0)
	MOVEM	A,FDBNOI+.CMDAT		;Save the pointer
	$COMND	NOI
	RET


;
;WRTELM - Print the summary: # items written to file
;

WRTITM:
	HRROI	A,[ASCIZ /
/]
	SKIPE	VERIFY			;If verifying
	 PSOUT				;Then make it neater
	MOVEI	A,.PRIOU
	MOVE	B,ITEMS			;Number of items
	MOVEI	C,^D10
	NOUT
	 ERCAL	ERRPC
	TMSG	< items written
>
	RET

;
;VEROUT - Print the version number in LVERSN to the JFN in OUTJFN.
;

VEROUT:
	HRRZ	A,OUTJFN		;Output to here
	LDB	B,[POINT 9,LVERSN,11]	;Get major version number
	MOVEI	C,^D10
	NOUT				;Always present
	 JFCL
	LDB	B,[POINT 5,LVERSN,17]	;Minor version number
	ADDI	B,"@"			;Convert to letter
	CAILE	B,"@"			;And output only if non-zero
	 BOUT
	HRRZ	B,LVERSN		;Get edit number
	JUMPE	B,VOUT.1		;Ignore if zero
	MOVEI	B,"("
	BOUT				;Open bracket
	HRRZ	B,LVERSN
	MOVEI	C,^D10
	NOUT				;Output edit number
	 JFCL
	MOVEI	B,")"
	BOUT				;Closing bracket
VOUT.1:
	RET


;
;DOVRFY - Output the verify string if VERIFY is set. This is always the case
;in the LIST command. On entry:
;
;	A = output JFN
;	B = Pointer to the key name
;	C = length of key name or zero
;

DOVRFY:
	SKIPN	VERIFY			;If not verifying
	 RET				;Then ignore this
	PUSH	P,B			;Save the pointer
	PUSH	P,C			;And the key name length
	MOVE	B,CURLVL		;Put the level in the list
	ADDI	B,"0"
	BOUT
	MOVE	B,[POINT 7,[ASCIZ /                  /]]
	MOVE	C,CURLVL
	ASH	C,1
	ADDI	C,3			;Output 2*N+3 spaces
	SETZ	D,
	SOUT
	POP	P,C
	POP	P,B			;Point to the key name
	SOUT
	MOVE	B,[POINT 7,[ASCIZ /
/]]
	SOUT
	RET
	SUBTTL	ERRORS FOR ADD COMMAND

AER.1:
	TMSG	<%Multiple level-0 name specified>
	JRST	AER.10
AER.2:
	TMSG	<%Invalid or multiply defined level name>
	JRST	AER.10
AER.3:
	TMSG	<%Maximum level number exceeded>
	JRST	AER.10
AER.4:
	TMSG	<%Missing or invalid sublevels>
	JRST	AER.10
AER.5:
	TMSG	<?Ambiguous or multiply defined facility name - >
	HRROI	A,ATOM
	PSOUT
	JRST	ERR.2


AER.10:
	TMSG	< - command ignored:
>
	HRROI	A,TXTBUF		;TYPE THE WHOLE LINE
	PSOUT
	TMSG	<
>
	SETZM	LVOPEN			;NO LEVEL OPEN NOW
	JRST	ADF.2
	SUBTTL	EXTRACT AND LIST ERRORS

LER.1:
	TMSG	<?Invalid facility name>
	JRST	ERR.2
LER.2:
	JUMPL	A,[HRROI A,[ASCIZ /?Ambiguous facility name - /]
		   JRST	 .+2]
	 HRROI	A,[ASCIZ /?Facility not found - /]
	PSOUT
	HRROI	A,LV0NAM
	PSOUT
	JRST	ERR.2
	SUBTTL	GENERAL ERROR PROCESSING

INVCMD:
	TMSG	<?Invalid command - >
	JRST	ERR.1


ERRPC:
	TMSG	<
?Error at PC >
	POP	P,B
	HRRZS	B
	SOJ	B,
	MOVEI	A,.PRIOU
	MOVEI	C,10
	NOUT
	 ERJMP	.+1
	TMSG	<
>
	MOVEI	A,"?"
	PBOUT
ERR.1:
	MOVEI	A,.PRIOU
	HRLOI	B,.FHSLF
	ERSTR
	 JFCL
	 JFCL
ERR.2:
	TMSG	<
>
	SETO	A,
	RLJFN				;Release any JFN's around
	 JFCL
	JRST	MAKHLP

	END	MAKHLP