Trailing-Edge
-
PDP-10 Archives
-
BB-R775E-BM
-
sources/edt/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) 1983, 1985 *
;* BY DIGITAL EQUIPMENT CORPORATION, LEEDS, ENGLAND *
;* 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. 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