Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/util/simdir.mac
There is 1 other file named simdir.mac in the archive. Click here to see a list.
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

AUTHOR:		Claes Wihlborg

UPDATE:		12

PURPOSE:	SIMDIR is a utility program used to getting directory
		lists of and cross references between separately
		compiled SIMULA modules

COMPILATION and LOADING:
		UNIVERSAL SIMMAC must be available at compile time.
		Must be loaded with HELPER.REL from SYS: or REL:


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


	SALL
	SEARCH	SIMMAC
	CTITLE	SIMDIR (Utility program)
	SUBTTL	PROLOGUE

	INTERN	SIMDIR
	EXTERN	.JBFF,.JBREL

	MACINIT

	TWOSEG
	SUBTTL	DEFINITIONS

;ACCUMULATOR DEFINITIONS

	XTOP=16
	XSWITCH=15
	XEXT=14
	XPPN=13
	XDEV=12
	XPATH=11
	XDIR=10
	XMP2=7
	XMOD2=6
	XMOD=5
	XZUS=4
	XCC=2

	XCOMTYP=XEXT
	XPATTERN=XPATH
	XMBP=XMP2


;ASSEMBLY TIME CONSTANT DEFINITIONS

	LSTCH=1
	DIRCH=2
	MODCH=3

	QUSING=2
	QREQUIRED=4

	QBUFSZ=204
	QMAXLINE=55
	QSZSTK=200

	QSWM=1
	QSWMM=2
	QSWC=4
	QSWFP=10
	QSWMP=20
	QSWSP=40
	QSWSFD=100
	QSWF=200
	QSWT=400
	QSWOTH=1K
	QSWPJ=2K
	QSWPG=4K
	QSWLIB=200K	;[12] Module is member of a library
	QSWMP2=400K

	QSWP=QSWFP+QSWMP+QSWSP
	QSWEXT=QSWC+QSWP
	QSWALL=QSWM+QSWEXT


;FIELD DEFINITIONS

	;PATTERN RECORD (Defines a search pattern)

	PATPPN=0	;PPN
	PATDEV=1	;Device
	PATSW=2		;Switches
	PATNAME=3	;File-name

	;ZDI RECORD (Defines a directory)

	ZDISW=-1		;Switches
	ZDIPPN=-2		;PPN
	ZDIDEV=-3		;Device
	DF(ZDINXT,-4,18,17)	;Link to next dir independent of structure
	DF(ZDIBACK,-4,18,35)	;Link to directory containing name of this SFD
	DF(ZDISFD,-5,18,17)	;Link to SFD:s under this directory
	DF(ZDIMOD,-5,18,35)	;Link to modules under this directory

	;ZMO RECORD (Defines a module)

	ZMONAME=-1		;File name
	ZMOUNR=-2		;Unique number of prototype
	ZMOSW=-3		;Switches
	DF(ZMODIR,-3,18,17)	;Link to directory containing name of this module
	DF(ZMOUS,-4,18,17)	;Link to cref this module using
	DF(ZMOREQ,-4,18,35)	;Link to cref this module required by
	DF(ZMONXT,-5,18,17)	;Link to next module independent of structure
	DF(ZMOMOD,-5,18,35)	;Link to next module under same directory
	DF(ZMOLIB,-6,36,35)	;[12] Library name if module is in a library

	;ZUS RECORD (Defines a cross reference)

	DF(ZUSNXT,-1,18,17)	;Link next cross reference
	DF(ZUSMOD,-1,18,35)	;Link to module

	;ZCH RECORD (Defines properties of characters)

	DSW(ZCHILLEGAL,ZCH,35)	;Character illegal in command
	DSW(ZCHSKIP,ZCH,34)	;Character should be skipped in command
	DSW(ZCHEND,ZCH,33)	;Character terminates command
	DSW(ZCHOCT,ZCH,32)	;Character is octal digit
	DSW(ZCHNAME,ZCH,0)	;Character allowed in names
	DSW(ZCHBLANK,ZCH,30)	;Character is blank,tab etc.

;SWITCH DEFINITIONS

	DSW(SWLIST,YSWLIST,36)	;List file is given
	DSW(SWTTY,YSWTTY,36)	;Output on TTY
	DSW(SWFAST,YSWFAST,36)	;Output no path


;MACRO AND OPDEF DEFINITIONS

	DEFINE DEFOP(A)<
		IRP A,<OPDEF A[PUSHJ XPDP,.'A]>
	>

	DEFOP(<ATRSCAN,ENDSCAN,GETWORD,MODINIT,PPNMATCH,SCANANDTEST,SETCRF,SKIPINPUT,TESTANDSCAN>)
	DEFOP(<GETPPN,GETSWITCH,GETFILE,GETNAME,GETOCT>)
	DEFOP(<OUTCOM,OUTSIX,OUTOCT,OUTDEC,OUTCH,OUTPPN,OUTMOD,OUTPAGE,OUTLINE>)
	DEFOP(<SIXRX50>)	;[12] RADIX50 to SIXBIT

	OPDEF	SCAN[ILDB XCC,COMBBP]

	DEFINE GETNW(N)<
		IRP N,<DEFINE GET'N'W<
			ADD	XTOP,[N,,N]
			SKIPL	XTOP
			EXEC	MORECORE
			>
		>
	>

	GETNW(<1,2,5,6>)

	SYN	GET6W,GETZMO	;[12a]

	DEFINE	MATCH(A)<
		L	XMBP,[POINT 6,A]
		EXEC	.MATCH
	>

	DEFINE	OUTTEXT(A)<
		EXEC	.OUTTEXT,<<[POINT 7,A]>>
	>

	DEFINE COMERR(MESSAGE)<
		GOTO	[OUTSTR[ASCIZ/
 /]
			LI	XCC,0
			IDPB	XCC,COMBBP
			OUTSTR	COMBUF
			OUTSTR	[ASCIZ/
? MESSAGE
/]
			GOTO	RNC
			]
	>

	DEFINE	ERROR(MESSAGE)<
		GOTO	[OUTSTR	[ASCIZ/
? MESSAGE
/]
			GOTO	RNC
			]
	>

	DEFINE	SEVERE(MESSAGE)<
		GOTO	[OUTSTR	[ASCIZ/?
? MESSAGE/]
			EXIT]
	>
	SUBTTL	LOW SEGMENT DATA AREAS

	LOC	137	;.jbver
	EXP	VERCOM	;set same version as compiler

	RELOC	0

LOWSTART:

OWNPPN:		BLOCK	1	;PPN of controlling job
YSTK:		BLOCK	QSZSTK	;Push-down list

;DATA AREAS WHICH ARE RESET BETWEEN COMMANDS

COMBUF:		BLOCK	^D28	;Command buffer
COMBBP:		BLOCK	1	;Command buffer byte pointer
LASTPPN:	BLOCK	1	;Last directory outputted
YPAT1:		BLOCK	4	;1:st search pattern
YPAT2:		BLOCK	4	;2:nd search pattern
DIRSW:		BLOCK	1	;Switches in directory command

COMEND:

;DIR-COMMAND DATA AREAS

DIRBASE:	BLOCK	1
DIRTOP:		BLOCK	1
DIRSTREAM:	BLOCK	1	;Contains elements in search list of job
DIRZDI:		BLOCK	1	;Link directories
DIRZMO:		BLOCK	1	;Link modules
LIBNAME:	BLOCK	1	;[12] Name of current ATR library or zero
BLOCKNO:	BLOCK	1	;[12] Count of input blocks on current file
MOFSET:		BLOCK	1	;[12] Offset of module within disk block
YPATH:		BLOCK	12	;Path used at lookup
DIROBL:		BLOCK	3	;Open block for directories
MODOBL:		BLOCK	3	;Open block for modules
DIRLBL:		BLOCK	4	;Lookup block for directories
MODLBL:		BLOCK	4	;Lookup block for modules
DIRBH:		BLOCK	3	;Buffer header for directories
MODBH:		BLOCK	3	;Buffer header for modules
INDEX:		BLOCK	200	;[12] Current index block
DIRBUF:		BLOCK	2*QBUFSZ	;Buffer ring for directories
MODBUF:		BLOCK	2*QBUFSZ	;Buffer ring for modules

;LIST COMMAND DATA AREAS

LSTOBL:		BLOCK	3	;Open block for list file
LSTEBL:		BLOCK	4	;Enter block for list file
LSTBH:		BLOCK	3	;Buffer header for list file
LSTLINE:	BLOCK	1	;Line count
LSTPAGE:	BLOCK	1	;Page count
YSWLIST:	BLOCK	1	;Location of switch SWLIST
YSWTTY:		BLOCK	1	;Location of switch SWTTY

;SEARCH COMMAND DATA AREAS

YSWFAST:	BLOCK	1	;Location of switch SWFAST

;START OF DYNAMIC STORAGE

DYNSTART:
	SUBTTL	High segment data

	RELOC	400K

INCOMMAND:	ASCIZ %[,]/M
%


PAGEHEADER:	ASCIZ/	SIMDIR OUTPUT				PAGE /

ZCH:
	DEFINE X(CH,SW)<
		REPEAT CH-XCH,<XSW>
		XCH=CH
		XSW=0
		IRPC SW,<XSW=XSW+SW'Q>
	>

	XCH=0
	IQ=1
	SQ=2
	EQ=4
	OQ=10
	NQ=400K,,0
	BQ=40

X(0,S)
X(1,I)
X(QHT,B)
X(QLF,ES)
X(QCR,S)
X(QCR+1,I)
X(33,ES)
X(34,I)
X(" ",B)
X(" "+1,I)
X("*")
X("0",ON)
X("8",N)
X("9"+1)
X("A",N)
X("Z"+1)
X("a",N)
X("z"+1)
X(177,S)
X(200)
	SUBTTL	Initialization routine


COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

The program starts execution here

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


SIMDIR:

	RESET	;ALL I/O

	LI	DYNSTART+1K
	CORE
	SEVERE(NOT ENOUGH CORE)

;CLEAR LOWSEG

	SETZM	LOWSTART
	MOVSI	LOWSTART
	HRRI	LOWSTART+1
	L	X1,.JBREL
	BLT	(X1)

;SETUP PUSH-DOWN POINTER

	L	XPDP,[IOWD QSZSTK,YSTK]

;SETUP DYNAMIC DATA AREA POINTER

	LI	XTOP,DYNSTART
	LI	DYNSTART
	SUB	.JBREL
	HRL	XTOP,

;INIT OPEN BLOCKS

	LI	14	;STATUS WHEN READING
	ST	DIROBL
	ST	MODOBL
	LI	0	;STATUS WHEN WRITING
	ST	LSTOBL

	LI	DIRBH
	ST	DIROBL+2
	LI	MODBH
	ST	MODOBL+2
	MOVSI	LSTBH
	ST	LSTOBL+2

;SET UP INPUT BUFFERS

	L	[201,,DIRBUF+1]
	ST	DIRBUF+QBUFSZ+1
	L	[201,,DIRBUF+QBUFSZ+1]
	ST	DIRBUF+1

	L	[201,,MODBUF+1]
	ST	MODBUF+QBUFSZ+1
	L	[201,,MODBUF+QBUFSZ+1]
	ST	MODBUF+1

;GET OWN PPN

	CALLI	24	;GETPPN IS REDEFINED
	ST	OWNPPN

;SIMULATE A
;*DIRECTORY [SELF]/MAIN
;COMMAND

	L	[POINT 7,INCOMMAND]
	ST	COMBBP
	SCAN
	GOTO	EDC	;EXECUTE COMMAND
	SUBTTL	RNC	Read next command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	This routine reads a command from user TTY, stores it in
		the command buffer and checks if it can recognize the
		command specifier. If so a jump to the appropriate action
		routine is performed, otherwise a new command is read after
		issuing an error message.


EXIT CONDITIONS:The command buffer byte pointer is positioned on the first non-blank
		character following the command specifier.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


RNC:

;REINITIALIZE PUSH-DOWN POINTER IN CASE OF ERROR

	L	XPDP,[IOWD QSZSTK,YSTK]

;OUTPUT PROMPTER

	SKPINC	;CLEAR ^O
	NOP
	OUTSTR	[ASCIZ/
*/]

;CLEAR COMMAND DATA AREAS

	SETZM	COMBUF
	MOVSI	COMBUF
	HRRI	COMBUF+1
	BLT	COMEND-1

	SETOFF	SWFAST

;READ UNTIL <LF>,<VT>,<FF> OR <ALTMODE>
;SKIP <CR> AND <NUL> CHARACTERS

	L	X1,[POINT 7,COMBUF]
	ST	X1,COMBBP
	L	X3,[POINT 7,COMBUF+^D27,34]

	LOOP
		INCHWL	XCC
		IFOFF	ZCHSKIP(XCC)
		IDPB	XCC,COMBBP
	AS
		IFON	ZCHILLEGAL(XCC)
		GOTO	[ENDSCAN
			COMERR(ILLEGAL CHARACTER IN COMMAND)]
		CAMN	X3,COMBBP
		GOTO	[ENDSCAN
			ERROR(TOO LONG COMMAND)]
		IFOFF	ZCHEND(XCC)
		GOTO	TRUE
	SA

	LI	XCC,QCR
	IDPB	XCC,COMBBP
	LI	XCC,QLF
	IDPB	XCC,COMBBP

	ST	X1,COMBBP	;RESET COMMAND BUFFER BYTE POINTER

	SCANANDTEST
	CAIN	XCC,QCR
	GOTO	RNC	;IF NULL COMMAND

	GETNAME
	COMERR(COMMAND NOT RECOGNIZED)

	LI	X3,RNCTRV-RNCNAM-1

	LOOP
		SUBI	X3,1
	AS
		MATCH	RNCNAM(X3)
		SOJG	X3,TRUE
	SA

	SKIPGE	X3
	COMERR(COMMAND NOT RECOGNIZED)

	LSH	X3,-1
	GOTO	@RNCTRV(X3)

;COMMAND NAMES

RNCNAM:	SIXBIT/CLOSE: /
	SIXBIT/EXIT:  /
	SIXBIT/HELP:  /
	SIXBIT/LIST:  /
	SIXBIT/DIRECTORY:/
	SIXBIT/SEARCH:/

;TRANSFER VECTOR

RNCTRV:	ECC
	EEC
	EHC
	ELC
	EDC
	ESC
	SUBTTL	ECC	Execute CLOSE command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Close current list file


COMMAND SYNTAX:	<close-command>::=CLOSE


EXIT CONDITIONS:	SWLIST is off


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


ECC:

	CAIE	XCC,QCR
	COMERR(ERROR IN COMMAND)

	IFOFF	SWLIST
	ERROR(ILLEGAL COMMAND)	;No list file to close

	SETOFF	SWLIST

	CLOSE	LSTCH,
	STATZ	LSTCH,740K
	ERROR(CLOSE LIST FILE)

	GOTO	RNC	;READ NEXT COMMAND
	SUBTTL	EDC	Execute DIRECTORY command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Find all modules under the given directories and their
		subdirectories and append them to the core data base


COMMAND SYNTAX:	<directory-command>::=DIRECTORY<directory>[<directory>]...
		Further details in the help text

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


EDC:

	L	YSWLIST
	SETCAM	YSWTTY

	ST	XTOP,DIRBASE	;SAVE BASE ADDRESS OF COLLECTED DIRECTORIES

	EXEC	EDCSCD	;SCAN FIRST DIRECTORY

	WHILE
		CAIE	XCC,","
		GOTO	FALSE
	DO
		SCANANDTEST
		EXEC	EDCSCD
	OD

	CAIE	XCC,QCR
	COMERR(ERROR IN COMMAND)

	ST	XTOP,DIRTOP	;SAVE TOP OF COLLECTED DIRECTORIES

;HERE IF SYNTACTICALLY CORRECT COMMAND

	OUTCOM	;OUTPUT COMMAND ON LIST FILE (IF ANY)

;APPEND THE COLLECTED DIRECTORIES TO LIST

	SETOM	DIRSTREAM

	WHILE	;MORE FILE STRUCTURES
		LI	DIRSTREAM
		JOBSTR
		ERROR(JOBSTR UUO FAILURE)
		SKIPN	XDEV,DIRSTREAM
		GOTO	FALSE	;IF FENCE REACHED
	DO	;READ MFD AND MATCH DIRECTORIES

		ST	XDEV,DIROBL+1
		OPEN	DIRCH,DIROBL
		SEVERE(CANNOT OPEN MFD)
		L	[1,,1]
		ST	DIRLBL
		ST	DIRLBL+3
		MOVSI	'UFD'
		ST	DIRLBL+1
		SETZM	DIRLBL+2
		LOOKUP	DIRCH,DIRLBL
		SEVERE(CANNOT LOOKUP MFD)
		L	[400K,,DIRBUF+1]
		ST	DIRBH
;MFD INITIALIZED FOR READING
		WHILE
			EXEC	EDCNF
			GOTO	FALSE
		DO	;MATCH THIS PPN VERSUS THOSE FROM COMMAND
			L	XDIR,DIRBASE
			LOOP	;THRU THE PPN GIVEN
				ADD	XDIR,[2,,2]
				L	XSWITCH,ZDISW(XDIR)
				L	ZDIPPN(XDIR)
				XOR	XPPN
				IF
					PPNMATCH
					GOTO FALSE	;IF NOT
				THEN
					EXEC	EDCAPD	;APPEND DIRECTORY
				FI
			AS
				CAME	XDIR,DIRTOP
				GOTO	TRUE
			SA
		OD
	OD

;SEARCH DIRECTORY LIST IF ANY DIRECTORIES NEED READING

	L	XDIR,DIRZDI

	WHILE
		JUMPE	XDIR,FALSE
	DO	;CHECK THIS DIRECTORY
		IF
			HRLZ	XSWITCH,ZDISW(XDIR)
			ANDCM	XSWITCH,ZDISW(XDIR)
			JUMPE	XSWITCH,FALSE
		THEN	;DIR NEEDS READING
			ORM	XSWITCH,ZDISW(XDIR)
			L	ZDIDEV(XDIR)
			ST	DIROBL+1
			ST	MODOBL+1
			OPEN	DIRCH,DIROBL
			SEVERE(CANNOT OPEN UFD)
			OPEN	MODCH,MODOBL
			SEVERE(CANNOT OPEN MODCH)
			LI	XPATH,YPATH+1
			MOVSI	'UFD'
			ST	DIRLBL+1
			L	[1,,1]
			ST	DIRLBL+3
			EXEC	EDCSCF	;SCAN AND APPEND FILES
		FI
		LF	XDIR,ZDINXT(XDIR)
	OD

	GOTO	RNC	;READ NEXT COMMAND
	SUBTTL	EDCAPD	Append directory to data base

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Check if a directory with given device and PPN exists
		in the data base. If so set switches, otherwise create a
		new directory object with specified properties.


ENTRY CONDITIONS:	XDEV	Device
			XPPN	PPN
			XSWITCH	Switches

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


EDCAPD:	PROC

	SAVE	XDIR

	L	XDIR,DIRZDI
	TRZ	XSWITCH,<QSWPJ+QSWPG+QSWMM>

	WHILE
		JUMPE	XDIR,FALSE
	DO	;SEE IF DIRECTORY ALREADY APPENDED

		IF
			CAMN	XDEV,ZDIDEV(XDIR)
			CAME	XPPN,ZDIPPN(XDIR)
			GOTO	FALSE
		THEN	;IT IS
			ORM	XSWITCH,ZDISW(XDIR)	;ADD (NEW?) SWITCHES
			RETURN
		FI
		LF	XDIR,ZDINXT(XDIR)
	OD

;DIRECTORY NOT FOUND, APPEND IT TO LIST

	GET5W	;GET ZDI-RECORD
	ST	XPPN,ZDIPPN(XTOP)
	ST	XDEV,ZDIDEV(XTOP)
	ST	XSWITCH,ZDISW(XTOP)

	L	DIRZDI
	SF	,ZDINXT(XTOP)
	HRRZM	XTOP,DIRZDI

	RETURN
	EPROC
	SUBTTL	EDCSCD	Scan <directory>

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	This routine will scan a directory in the command buffer


EXIT CONDITIONS:	The properties of the scanned directory are placed
			in a ZDI-record on top of lowseg.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


EDCSCD:	PROC

	L	XSWITCH,DIRSW	;LOAD DEFAULT SWITCH SETTING

	IF
		CAIE	XCC,"/"
		GOTO	FALSE
	THEN	;CHANGE DEFAULT SWITCH SETTING
		GETSWITCH
		TRNE	XSWITCH,<QSWEXT+QSWT+QSWF>
		COMERR(ILLEGAL SWITCH)
		ST	XSWITCH,DIRSW
	FI

	CAIE	XCC,"["
	COMERR(PPN EXPECTED)

	GETPPN
	TRNE	XSWITCH,QSWOTHER
	COMERR(ILLEGAL PPN)

	IF
		CAIE	XCC,"/"
		GOTO	FALSE
	THEN	;CHANGE SWITCH FROM DEFAULT
		GETSWITCH
		TRNE	XSWITCH,<QSWEXT+QSWF+QSWT>
		COMERR(ILLEGAL SWITCH)
	FI

	TRO	XSWITCH,<QSWEXT+QSWSFD>

	GET2W	;GET SHORTENED ZDI-RECORD
	ST	XSWITCH,ZDISW(XTOP)
	ST	XPPN,ZDIPPN(XTOP)

	RETURN
	EPROC
	SUBTTL	EDCNF	New file

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	This routine reads a directory and for each call it returns
		a new member. If a MFD is read a UFD is returned otherwise
		a file or a SFD is returned.


EXIT CONDITIONS:	Skip return if new member found.
			Simple return if EOF or read error.
				XPPN	holds the filename
				XEXT	holds the extension (swapped)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


EDCNF:	PROC

;FIND PPN OR FILENAME

	LOOP
		IF
			SOSL	DIRBH+2
			GOTO	FALSE
		THEN
			IN	DIRCH,
			SOSGE	DIRBH+2
			GOTO	[CLOSE	DIRCH,
				RETURN		;EOF OR ERROR
				]
		FI
		ILDB	XPPN,DIRBH+1
	AS
		JUMPE	XPPN,TRUE
	SA

;GET EXTENSION

	SOSGE	DIRBH+2
	ERROR(DIRECTORY PHASE ERROR)
	ILDB	XEXT,DIRBH+1
	HLRZ	XEXT,XEXT

	AOS	(XPDP)
	RETURN
	EPROC
	SUBTTL	EDCSCF	Scan files in directory

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	This routine reads a UFD (or SFD) and appends all modules
		and SFD:s to the core data base. The same is
		done for all SFD:s found.


ENTRY CONDITIONS:	XDIR	Points to directory to be read

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


EDCSCF:	PROC
	SAVE	XDIR

	L	XPPN,ZDIPPN(XDIR)
	ST	XPPN,DIRLBL
	SETZM	DIRLBL+2
	LOOKUP	DIRCH,DIRLBL
	GOTO	[RETURN	;IF PROTECTION FAILURE
		]
	L	[400K,,DIRBUF+1]
	ST	DIRBH

	PUSH	XPATH,XPPN

	WHILE
		EXEC	EDCNF
		GOTO	FALSE
	DO

		IF
			CAIN	XEXT,'REL'
			TLNN	XSWITCH,QSWM
			GOTO	FALSE
		THEN	;APPEND THIS MAIN MODULE
			EXEC	EDCMAIN
			CLOSE	MODCH,
		ELSE
		IF
			CAIN	XEXT,'ATR'
			TLNN	XSWITCH,QSWEXT
			GOTO	FALSE
		THEN	;APPEND THIS EXTERNAL MODULE
			EXEC	EDCATR
			CLOSE	MODCH,
		ELSE
		IF
			CAIN	XEXT,'SFD'
			TLNN	XSWITCH,QSWSFD
			GOTO	FALSE
		THEN	;APPEND THIS SFD
			GET5W
			ST	XPPN,ZDIPPN(XTOP)
			LF	,ZDISFD(XDIR)
			SF	,ZDINXT(XTOP)
			SF	XTOP,ZDISFD(XDIR)
			SF	XDIR,ZDIBACK(XTOP)
		FI FI FI
	OD

;READ FILES IN COLLECTED SFD'S

	LF	XDIR,ZDISFD(XDIR)

	WHILE
		JUMPE	XDIR,FALSE
	DO
		MOVSI	'SFD'
		ST	DIRLBL+1
		LI	YPATH
		ST	DIRLBL+3
		EXEC	EDCSCF
		LF	XDIR,ZDINXT(XDIR)
	OD

	SETZM	(XPATH)
	SUB	XPATH,[1,,1]

	RETURN
	EPROC
	SUBTTL	EDCATR	[12] Read ATR file and append one or more external modules

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	This routine will read an ATR file and collect useful
		information on the corresponding module.


ENTRY CONDITIONS:	XPPN	Filename
			XEXT	Extension (swapped)


EXIT CONDITIONS:	If a record for this module already exists it
			is updated otherwise a record is created.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


	OPDEF	LIBERROR	[JSP [ERROR(ATR library inconsistent)]]

EDCATR:	PROC

	MODINIT
	RETURN

	GETWORD		;1st word
	RETURN		;If file is empty

	HLRZ	X1
	IF	;INDEX block header is found
		CAIE	14
		GOTO	FALSE
	THEN	;Save the index block, treat all modules in library
		ST	XPPN,LIBNAME
	L1():!	HRRZ	X1,MODBH	;Make BLT word
		HRLI	X1,2(X1)	;for copying the entire buffer
		HRRI	X1,INDEX
		BLT	X1,INDEX+177
		EXEC	EDCATI		;Get next bufferful
		LIBERROR
		LI	INDEX
		ST	INDEX		;Use as pointer to current word

	L2():!	AOS	X1,INDEX
		HLRZ	(X1)
		IF	;Start of index item
			CAIE	4
			GOTO	FALSE
		THEN	;Find offset,,block no
			HRRZ	X1,(X1)
			ADDI	X1,1
			ADDB	X1,INDEX
			L	X1,(X1)
			HLRZM	X1,MOFSET
			HRRZ	X1
			IF	;Not current block
				SUB	BLOCKNO
				JUMPE	FALSE
			THEN	;Make sure the block is input
				IF	;Already bypassed
					JUMPG	FALSE
				THEN	LIBERROR
				ELSE
					LOOP
						EXEC	EDCATI
						LIBERROR
					AS	SOJG	TRUE
					SA
			FI	FI
			;Now check if offset is ok
			HRRZ	MODBH+1
			SUBI	@MODBH
			SUBI	1
			CAMLE	MOFSET
			LIBERROR
			L	MOFSET
			ADDI	@MODBH	;Adjust byte ptr
			ADDI	1
			HRRM	MODBH+1
			LI	200	;and byte count
			SUB	MOFSET
			ST	MODBH+2
			GETWORD
			LIBERROR
			EXEC	EDCATM	;Treat the library module
			GOTO	L2
		ELSE	;Not index item, should be link to next index block
			HRRE	(X1)
			IF	;Not last block
				JUMPL	FALSE
			THEN	;Find the index block
				SUB	BLOCKNO
				IF	;Accessible
					JUMPL	FALSE
				THEN	;Make it the current block
					WHILE
						SOJL	FALSE
					DO
						EXEC	EDCATI
						LIBERROR
					OD
				ELSE
					LIBERROR
				FI
				GOTO	L1
		FI	FI
	ELSE	;Separate ATR file
		SETZM	LIBNAME
		EXEC	EDCATM
	FI
	RETURN
	EPROC



EDCATI:	IN	MODCH,
	AOS	(XPDP)	;Normal return is skip
	AOS	BLOCKNO		;Count the block
	RETURN
	SUBTTL	EDCATM	[12] Read and append external ATR module

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	EDCATM reads one ATR module either from a library
		or from a separate ATR file and saves some useful info.

ENTRY CONDITIONS:	XPPN	filename
			LIBNAME filename if library, otherwise zero.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

EDCATM:	PROC
	HLRZ	X1
	IF	;New format
		CAIE	4
		GOTO	FALSE
	THEN	;Treat overhead info
		LI	XEXT,1(X1)
		SKIPINPUT
		RETURN
		HLRZ	X1
		CAIE	6	;Must be name block
		RETURN		; if not
		GETWORD
		RETURN
		GETWORD
		RETURN
		IF	;Library file
			SKIPN	LIBNAME
			GOTO	FALSE
		THEN	;Put name of module in XPPN
			L	X1
			SIXRX50
			ST	XPPN
		FI
		GETWORD
		RETURN
		WHILE	;Not type 0 block
			TLNN	X1,-1
			GOTO	FALSE
		DO	;Skip blocks
			LI	XEXT,1(X1)
			SKIPINPUT
		OD
		GETWORD
		RETURN
	FI
	LI	XEXT,6
	SKIPINPUT
	RETURN

; X1 CONTAINS FIRST WORD OF ZHB-RECORD

	HRRZ	X2,MODBH+1
	L	X3,4(X2)

	L	XMOD,DIRZMO
	WHILE
		JUMPE	XMOD,FALSE
		SKIPE	ZMONAME(XMOD)
		GOTO	TRUE
		CAMN	X3,ZMOUNR(XMOD)
		GOTO	FALSE
	DO
		LF	XMOD,ZMONXT(XMOD)
	OD

	IF
		JUMPN	XMOD,FALSE
	THEN
		GETZMO
		LI	XMOD,(XTOP)
		ST	X3,ZMOUNR(XMOD)
		L	DIRZMO
		SF	,ZMONXT(XMOD)
		ST	XMOD,DIRZMO
	FI

	LF	,ZDIMOD(XDIR)
	SF	,ZMOMOD(XMOD)
	SF	XMOD,ZDIMOD(XDIR)
	SF	XDIR,ZMODIR(XMOD)
	ST	XPPN,ZMONAME(XMOD)

;GET TYPE OF EXTERNAL

	LF	,ZHETYP(,1)
	IF	;Class
		CAIE	QCLASB
		GOTO	FALSE
	THEN
		LI	X1,QSWC
	ELSE	;Discriminate MACRO, FORTRAN, SIMULA
		LF	X1,ZHBMFO(X2)	;[5] Get tag field
		IF	;[5] SIMULA code
			JUMPN	X1,FALSE
		THEN	LI	X1,QSWSP
		ELSE	;Check for MACRO or FORTRAN
			IF	;"CODE" or "QUICK"
				CAILE	X1,QEXMQI
				GOTO	FALSE
			THEN	;MACRO procedure
				LI	X1,QSWMP
			ELSE	;FORTRAN assumed
				LI	X1,QSWFP
	FI	FI	FI	;[5]

	L	LIBNAME
	IF	;Scanning a library
		JUMPE	FALSE
	THEN	;Save library name, set QSWLIB
		SF	,ZMOLIB(XMOD)
		TRO	X1,QSWLIB
	FI

	ORM	X1,ZMOSW(XMOD)

	ATRSCAN
	RETURN

	WHILE
		GETWORD
		RETURN
		JUMPE	X1,FALSE
	DO
		GETWORD
		RETURN
		SETCRF
		GETWORD
		RETURN
		GETWORD
		RETURN
	OD

	RETURN
	EPROC
	SUBTTL	EDCMAIN	Read REL file and append main module

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Read a REL file and test if it originates from a
		SIMULA main program. If so, append the module to the
		data base and search for cross references.


ENTRY CONDITIONS:	XPPN	Filename
			XEXT	Extension (swapped)
			XDIR	Points to directory which contains this module

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


EDCMAIN:PROC

	MODINIT
	RETURN

	GETWORD
	RETURN
	IF	;[030406] Entry block with one data word
		CAME	X1,[4,,1]
		GOTO	FALSE
	THEN	;Could be SIMULA, check for name .MAIN
		GETWORD	;reloc word
		RETURN
		GETWORD	;Entry name
		RETURN
		CAMN	X1,[RADIX50 0,.MAIN]
		GETWORD
		RETURN
	FI	;[030406]
	CAMN	X1,[6,,2]
	GETWORD
	RETURN
	CAIN	X1,0
	GETWORD
	RETURN
	CAMN	X1,[RADIX50 0,.MAIN]
	GETWORD
	RETURN
	CAMN	X1,[QSIMREL]
	GETWORD
	RETURN

;SETUP ZMO-RECORD FOR THIS MODULE

	GETZMO
	LI	XMOD,(XTOP)
	ST	XPPN,ZMONAME(XMOD)
	LI	QSWM
	ORM	ZMOSW(XMOD)
	L	DIRZMO
	SF	,ZMONXT(XMOD)
	ST	XMOD,DIRZMO
	LF	,ZDIMOD(XDIR)
	SF	,ZMOMOD(XMOD)
	SF	XMOD,ZDIMOD(XDIR)
	SF	XDIR,ZMODIR(XMOD)

;FIND LINK ITEM [0,,N] WHICH DEFINES THE EXTERNALS

	WHILE
		TLNE	X1,-1
		GOTO	TRUE
		TRNE	X1,-1
		GOTO	FALSE
	DO
		LI	XPPN,21(X1)
		IDIVI	XPPN,22
		L	XEXT,XPPN
		ADDI	XEXT,(X1)
		SKIPINPUT
		RETURN
	OD

;CREATE CROSS REFERENCES

	LI	XPPN,21(X1)
	IDIVI	XPPN,22
	ADDI	XPPN,(X1)

	LOOP
		GETWORD
		RETURN
		SKIPN	X1
		RETURN
		SETCRF
	AS
		SOJG	XPPN,TRUE
	SA

	RETURN
	EPROC
	SUBTTL	EEC	Execute EXIT command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	If a list file is open, close it. Return to monitor.


COMMAND SYNTAX:	<exit-command>::=EXIT

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


EEC:

	CAIE	XCC,QCR
	COMERR(ERROR IN COMMAND)

	IFOFF	SWLIST
	EXIT

	CLOSE	LSTCH,
	STATZ	LSTCH,740K
	SEVERE(CLOSE LIST FILE)

	EXIT
	SUBTTL	EHC	Execute HELP command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output help text. If /TTY switch is given, output on
		user TTY even if list file exists.


COMMAND SYNTAX:	<help-command>::=HELP [/TTY]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	EXTERN	.HELPR	;[12]

EHC:

	L	YSWLIST
	SETCAM	YSWTTY
	LI	XSWITCH,0

	IF
		CAIE	XCC,"/"
		GOTO	FALSE
	THEN
		GETSWITCH
		TRNN	XSWITCH,QSWT
		COMERR(ILLEGAL SWITCH)
		SETON	SWTTY
	FI

	CAIE	XCC,QCR
	COMERR(ERROR IN COMMAND)

;HERE IF COMMAND SYNTACTICALLY CORRECT

	OUTCOM	;OUTPUT ON LIST FILE (IF ANY)

;[12]	OUTTEXT	HELPTEXT
	L	1,[SIXBIT/SIMDIR/]	;[12]
	EXEC	.HELPR			;[12]

	GOTO	RNC	;READ NEXT COMMAND
	SUBTTL	ELC	Execute LIST command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	If old list file exists, close it. Open new list file.


COMMAND SYNTAX:	<list-command>::=LIST <file specification>


EXIT CONDITIONS:	SWLIST  has been set

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


ELC:

;GET OUTPUT FILE SPECIFICATION

	GETFILE

	SKIPN	XDEV
	MOVSI	XDEV,'DSK'
	ST	XDEV,LSTOBL+1

	SKIPN
	L	['SIMDIR']
	ST	LSTEBL

	IF
		CAIE	XCC,"."
		GOTO	FALSE
	THEN	;EXTENSION IS GIVEN
		SCANANDTEST
		GETNAME
		NOP	;ACCEPT NULL EXTENSION
	ELSE
		MOVSI	'LST'
	FI

	HLLZM	LSTEBL+1
	SETZM	LSTEBL+2

	LI	XPPN,0
	IF
		CAIE	XCC,"["
		GOTO	FALSE
	THEN	;PPN IS GIVEN
		LI	XSWITCH,0
		GETPPN
		TRNE	XSWITCH,<QSWOTHER+QSWPJ+QSWPG>
		COMERR(ILLEGAL PPN)
	FI
	ST	XPPN,LSTEBL+3

	CAIE	XCC,QCR
	COMERR(ERROR IN COMMAND)

;HERE IF COMMAND SYNTACTICALLY CORRECT
;CLOSE OLD LIST FILE (IF ANY)

	IF
		IFOFF	SWLIST
		GOTO	FALSE
	THEN
		SETOFF	SWLIST
		CLOSE	LSTCH,
		STATZ	LSTCH,740K
		ERROR(CLOSE OLD LIST FILE)
	FI

;IF NEW DEVICE IS TTY: THEN READ NEXT COMMAND

	CAMN	XDEV,[SIXBIT/TTY/]
	GOTO	RNC

;OPEN NEW LIST FILE

	OPEN	LSTCH,LSTOBL
	ERROR(CANNOT OPEN LIST FILE)
	ENTER	LSTCH,LSTEBL
	ERROR(CANNOT ENTER LIST FILE)

	HRRZM	XTOP,.JBFF
	OUTBUF	LSTCH,

;RECOMPUTE XTOP

	L	XTOP,.JBFF
	L	XTOP
	SUB	.JBREL
	HRL	XTOP,

;INIT OUTPUT

	SETZM	LSTPAGE
	SETON	SWLIST
	SETOFF	SWTTY

	OUTPAGE

	GOTO	RNC	;READ NEXT COMMAND
	SUBTTL	ESC	Execute SEARCH command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Performs syntax checking and all actions of a SEARCH command


COMMAND SYNTAX:	<search-command>::=SEARCH<pattern>[<relation>[<pattern>]]
		Further details in help text.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


ESC:

	CAIN	XCC,QCR
	COMERR(NO PATTERN FOUND)

	L	YSWLIST
	SETCAM	YSWTTY

	LI	XPATTERN,YPAT1
	EXEC	ESCPAT

	LI	XCOMTYP,0	;SIMPLE SEARCH

	IF
		CAIN	XCC,QCR
		GOTO	FALSE
	THEN	;SCAN <RELATION>
		GETNAME
		COMERR(ILLEGAL COMMAND)
		IF
			MATCH	[SIXBIT/USING:/]
			GOTO	FALSE
		THEN	;RELATION IS USING
			LI	XCOMTYP,QUSING
		ELSE	;RELATION MUST BE REQUIRED BY
			MATCH	[SIXBIT/REQUIRED:/]
			COMERR(ERROR IN COMMAND)
			GETNAME
			COMERR(ERROR IN COMMAND)
			MATCH	[SIXBIT/BY:/]
			COMERR(ERROR IN COMMAND)
			LI	XCOMTYP,QREQUIRED
		FI
		IF
			CAIN	XCC,QCR
			GOTO	FALSE
		THEN	;SECOND PATTERN EXISTS
			LI	XPATTERN,YPAT2
			ADDI	XCOMTYP,1
			EXEC	ESCPAT
		FI
	FI

	CAIE	XCC,QCR
	COMERR(ERROR IN COMMAND)

;HERE WHEN COMMAND SYNTACTICALLY CORRECT

	OUTCOM	;OUTPUT COMMAND ON LIST FILE IF ANY

;IF NO MODULES EXISTS, READ NEXT COMMAND

	SKIPN	XMOD,DIRZMO
	GOTO	RNC

;IF SECOND PATTERN EXISTS, MARK ALL THOSE WHO MATCH IT

	IF
		TRNN	XCOMTYP,1
		GOTO	FALSE
	THEN	;SECOND PATTERN EXISTS
		;FIRST RESET MATCH MARK FOR ALL MODULES

		LI	XMP2,QSWMP2

		LOOP
			ANDCAM	XMP2,ZMOSW(XMOD)
		AS
			LF	XMOD,ZMONXT(XMOD)
			JUMPN	XMOD,TRUE
		SA

		;THEN MARK ALL THOSE WHO MATCH

		EXEC	ESCDIR
	FI

;OUTPUT THOSE WHO MATCH FIRST PATTERN (AND RELATION)

	LI	XPATTERN,YPAT1
	EXEC	ESCDIR

	GOTO	RNC	;READ NEXT COMMAND
	SUBTTL	ESCPAT	Scan search pattern

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Scan and decode a search pattern.


ENTRY CONDITIONS:	XPATTERN Points to the pattern record to be updated

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


ESCPAT:	PROC

	GETFILE
	ST	XDEV,PATDEV(XPATTERN)
	ST	PATNAME(XPATTERN)

	LI	XSWITCH,0

	IF
		CAIE	XCC,"["
		GOTO	FALSE
	THEN	;PPN IS GIVEN
		GETPPN
		ST	XPPN,PATPPN(XPATTERN)
	ELSE	;PPN NOT GIVEN, ASSUME [*,*]
		TRO	XSWITCH,<QSWPJ+QSWPG>
	FI

	WHILE
		CAIE	XCC,"/"
		GOTO	FALSE
	DO
		GETSWITCH
		TRNE	XSWITCH,QSWMM
		COMERR(ILLEGAL SWITCH)
	OD

	TRNN	XSWITCH,QSWALL
	TRO	XSWITCH,QSWALL	;SET ALL IF NO CATEGORY IS GIVEN

	TRZE	XSWITCH,QSWT
	SETON	SWTTY

	TRZE	XSWITCH,QSWF
	SETON	SWFAST

	ST	XSWITCH,PATSW(XPATTERN)

	RETURN
	EPROC
	SUBTTL	ESCDIR	Find UFD:s matching a pattern

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	For all UFD:s matching a pattern, call ESCMOD to find
		out if any modules match the pattern.


ENTRY CONDITIONS:	XPATTERN Points to the pattern

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


ESCDIR:	PROC

	L	XDIR,DIRZDI
	L	XSWITCH,PATSW(XPATTERN)

	WHILE
		JUMPE	XDIR,FALSE
	DO
		L	PATPPN(XPATTERN)
		XOR	ZDIPPN(XDIR)
		IF
			PPNMATCH
			GOTO	FALSE
		THEN	;PPN DO MATCH
			L	PATDEV(XPATTERN)
			IF
				JUMPE	TRUE
				CAME	ZDIDEV(XDIR)
				GOTO	FALSE
			THEN	;DEVICE MATCH
				TDNE	XSWITCH,ZDISW(XDIR)
				EXEC	ESCMOD	;There may be matching modules
			FI
		FI
		LF	XDIR,ZDINXT(XDIR)
	OD

	RETURN
	EPROC
	SUBTTL	ESCMOD	Find modules matching a pattern

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Search all modules under the given directory and
		call ESCMOD for all SFD:s under the directory.


ENTRY CONDITIONS:	XDIR	Points to a directory to be searched

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


ESCMOD:	PROC

	SAVE	XDIR

	LF	XMOD,ZDIMOD(XDIR)
	WHILE
		JUMPE	XMOD,FALSE
	DO
		IF
			TDNN	XSWITCH,ZMOSW(XMOD)
			GOTO	FALSE
			SKIPN	X1,PATNAME(XPATTERN)
			GOTO	TRUE	;IF NO NAME IN PATTERN
			CAME	X1,ZMONAME(XMOD)
			GOTO	FALSE
		THEN	;MODULE MATCH
			IF
				CAIE	XPATTERN,YPAT2
				GOTO	FALSE
			THEN	;SECOND PATTERN MATCH
				ORM	XMP2,ZMOSW(XMOD)
			ELSE	;FIRST PATTERN MATCH
				EXEC	ESCFPM
			FI
		FI
		LF	XMOD,ZMOMOD(XMOD)
	OD

	LF	XDIR,ZDISFD(XDIR)
	WHILE
		JUMPE	XDIR,FALSE
	DO
		EXEC	ESCMOD
		LF	XDIR,ZDINXT(XDIR)
	OD

	RETURN
	EPROC
	SUBTTL	ESCFPM	First pattern match found

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output the module if no relation given or if module
		satisfies the relation.


ENTRY CONDITIONS:
		XCOMTYP	Gives the relation and the existence of a second pattern
		XMOD	Points to the module
			XMP2	Contains a bit pattern for testing of 2:nd pattern match
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


ESCFPM:	PROC

	SAVE	XMOD

	IF
		JUMPE	XCOMTYP,FALSE
	THEN	;RELATION WAS GIVEN
		IF
			TRNN	XCOMTYP,QUSING
			GOTO	FALSE
		THEN	;RELATION IS USING
			LF	XZUS,ZMOUS(XMOD)
		ELSE
			LF	XZUS,ZMOREQ(XMOD)
		FI
		IF
			TRNN	XCOMTYP,1
			GOTO	FALSE
		THEN	;SECOND PATTERN WAS GIVEN
			WHILE
				JUMPE	XZUS,FALSE	;IF NO MATCH FOUND
				LF	XMOD2,ZUSMOD(XZUS)
				TDNN	XMP2,ZMOSW(XMOD2)
				GOTO	TRUE	;TRY NEXT
				OUTMOD
				GOTO	FALSE	;MATCH FOUND
			DO
				LF	XZUS,ZUSNXT(XZUS)
			OD
		ELSE	;NO SECOND PATTERN
			OUTMOD
			WHILE
				JUMPE	XZUS,FALSE
			DO
				LI	XCC,QHT
				OUTCH
				LF	XMOD,ZUSMOD(XZUS)
				OUTMOD
				LF	XZUS,ZUSNXT(XZUS)
			OD
		FI
	ELSE	;NO RELATION
		OUTMOD
	FI

	RETURN
	EPROC
	SUBTTL	ATRSCAN	Scan a declaration segment

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	The routine will scan past a declaration segment in the
		ATR file. Such a segment starts with a ZHB-record,
		contains ZQU-records and declaration segments and
		terminates with a zeroword.


ENTRY CONDITIONS:	The last word read is the first word of a ZHB-record


EXIT CONDITIONS:	If an EOF or error occurs a return is made.
			If routine successful, a skip return is made.
			The last word read is the terminating zero-word.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.ATRSCAN:PROC

	LI	XEXT,4
	SKIPINPUT
	RETURN

	WHILE
		JUMPE	X1,FALSE
	DO
		LF	,ZDETYP(,1)
		IF
			CAIE	ZQU%V
			GOTO	FALSE
		THEN
			LI	XEXT,5
			SKIPINPUT
			RETURN
		ELSE
			ATRSCAN
			RETURN
			GETWORD
			RETURN
		FI
	OD

	AOS	(XPDP)
	RETURN
	EPROC
	SUBTTL	ENDSCAN	Scan until end of command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	The routine will read terminal input until a termination
		character is found. It is used when an error has been
		found in command input.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.ENDSCAN:PROC

	WHILE
		IFON	ZCHEND(XCC)
		GOTO	FALSE
	DO
		INCHWL	XCC
	OD

	RETURN
	EPROC
	SUBTTL	GETPPN	Scan PPN

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Scan PPN in command buffer


ENTRY CONDITIONS:	The left bracket has just been scanned.


EXIT CONDITIONS:	XPPN	holds the PPN.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.GETPPN:PROC

	SCANANDTEST
	IF
		IFOFF	ZCHOCT(XCC)
		GETNAME
		GOTO	FALSE
	THEN	;PPN IS [SELF] OR [OTHERS]
		L	XPPN,OWNPPN
		IF
			MATCH	[SIXBIT/OTHERS:/]
			GOTO	FALSE
		THEN	;IT IS [OTHERS]
			TRO	XSWITCH,QSWOTHER
		ELSE	;TRY [SELF]
			MATCH	[SIXBIT/SELF:/]
			COMERR(ERROR IN PPN)
		FI
	ELSE	;PPN IS [...,...]
		LI	XPPN,0
		IF
			CAIE	XCC,"*"
			GOTO	FALSE
		THEN	;PPN IS [*,...
			TRO	XSWITCH,QSWPJ
			SCAN
		ELSE
		IF
			CAIE	XCC,","
			GOTO	FALSE
		THEN	;PPN IS [,..
			HLL	XPPN,OWNPPN
		ELSE
			GETOCT
			HRL	XPPN,XCC-1
		FI FI

		TESTANDSCAN
		CAIE	XCC,","
		COMERR(ERROR IN PPN)

		SCANANDTEST

		IF
			CAIE	XCC,"*"
			GOTO	FALSE
		THEN	;PPN IS [...,*]
			TRO	XSWITCH,QSWPG
			SCAN
		ELSE
		IF
			CAIE	XCC,"]"
			GOTO	FALSE
		THEN	;PPN IS [...,]
			HRR	XPPN,OWNPPN
		ELSE
			GETOCT
			HRR	XPPN,XCC-1
		FI FI
		TESTANDSCAN
	FI

	CAIE	XCC,"]"
	COMERR(ERROR IN PPN)

	SCANANDTEST

	RETURN
	EPROC
	SUBTTL	GETFILE

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Scan <device>:<filename> in command buffer


EXIT CONDITIONS:	XDEV	Contains <device>. 0 if not given.
			X0	Contains <filename>. 0 if not given.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.GETFILE:PROC

	LI	XDEV,0

	GETNAME
	RETURN		;NOTHING

	CAIE	XCC,":"
	RETURN		;<FILENAME>

	CAME	[SIXBIT/DSK/]
	L	XDEV,	;ONLY IF NOT DSK

	SCANANDTEST

	GETNAME
	RETURN		;<DEVICE>:
	RETURN		;<DEVICE>:<FILENAME>

	EPROC
	SUBTTL	GETSWITCH

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	The routine will scan a switch in the command buffer.


ENTRY CONDITIONS:	The leading / has just been scanned.


EXIT CONDITIONS:	XSWITCH	Is updated.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.GETSWITCH:PROC

	SCANANDTEST

	IF
		CAIE	XCC,"-"
		GOTO	FALSE
	THEN	;TRY /-MAIN
		SCANANDTEST
		GETNAME
		COMERR(ERROR IN SWITCH)
		MATCH	[SIXBIT/MAIN:/]
		COMERR(ERROR IN SWITCH)
		TRZ	XSWITCH,QSWM
		TRO	XSWITCH,QSWMM
	ELSE
		GETNAME
		COMERR(ERROR IN SWITCH)

		LI	X3,YSWBIT-YSWL-1
		LOOP
			SUBI	X3,1
		AS
			MATCH	YSWL(X3)
			SOJG	X3,TRUE
		SA

		SKIPGE	X3
		COMERR(ERROR IN SWITCH)

		LSH	X3,-1
		TDO	XSWITCH,YSWBIT(X3)
	FI

	RETURN
	EPROC

YSWL:
	SIXBIT/FPROCEDURES:/
	SIXBIT/MPROCEDURES:/
	SIXBIT/SPROCEDURES:/
	SIXBIT/FAST:   /
	SIXBIT/TTY:    /
	SIXBIT/PROCEDURES:/
	SIXBIT/CLASSES:/
	SIXBIT/MAIN:   /
	SIXBIT/ALL:    /
YSWBIT:
	QSWFP
	QSWMP
	QSWSP
	QSWF
	QSWT
	QSWP
	QSWC
	QSWM
	QSWALL
	SUBTTL	GETNAME

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Scan a name in command buffer


EXIT CONDITIONS:	If no name found take simple return.
			If name found X0 and X1 keeps the
			name in SIXBIT. Take skip return.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.GETNAME:PROC

	SETZB	X0,X1

	SKIPL	ZCH(XCC)
	RETURN		;IF NO NAME FOUND

	AOS	(XPDP)

	L	XCC+1,[POINT 6,0]
	LOOP
		CAIL	XCC,140	;IF LOWER CASE LETTER
		TRZ	XCC,40	;THEN CONVERT TO UPPER CASE
		SUBI	XCC,40	;CONVERT TO SIXBIT
		CAME	XCC+1,[POINT 6,1,35]
		IDPB	XCC,XCC+1
		SCAN
	AS
		SKIPGE	ZCH(XCC)
		GOTO	TRUE
	SA

	TESTANDSCAN
	RETURN
	EPROC
	SUBTTL	GETOCT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Scan an octal number in command buffer.


EXIT CONDITIONS:	XCC-1	Holds the octal number.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.GETOCT:PROC

	IFOFF	ZCHOCT(XCC)
	COMERR(OCTAL DIGIT EXPECTED)

	LI	XCC-1,0

	LOOP
		ROT	XCC,-3
		LSHC	XCC-1,3
		SCAN
	AS
		IFON	ZCHOCT(XCC)
		GOTO	TRUE
	SA

	RETURN
	EPROC
	SUBTTL	GETWORD

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Reads a word from ATR or REL file.


EXIT CONDITIONS:	If EOF or error occurs take simple return,
			Otherwise take skip return with value in X1.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.GETWORD:PROC

	IF
		SOSL	MODBH+2
		GOTO	FALSE
	THEN
		IN	MODCH,
		SOSGE	MODBH+2
		RETURN
		AOS	BLOCKNO		;[12] Count the block
	FI

	ILDB	X1,MODBH+1

	AOS	(XPDP)
	RETURN
	EPROC
	SUBTTL	MATCH

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Match two names versus each other. The first name must be
		an initial segment of the second name.


ENTRY CONDITIONS:	XMBP	Byte pointer to second name
			X0 & X1	First name in SIXBIT


EXIT CONDITIONS:	If a match is found then take skip return,
			otherwise take simple return.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.MATCH:	PROC

	SAVE	<X4,X5,X6>

	L	X6,[POINT 6,0]

	LOOP
		ILDB	X4,XMBP
		ILDB	X5,X6
	AS
		CAMN	X4,X5
		GOTO	TRUE
	SA

	CAIN	X5,0
	AOS	-3(XPDP)	;MODIFY RETURN ADDRESS IF MATCH

	RETURN
	EPROC
	SUBTTL	MODINIT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Perform some actions common to the REL and ATR files
		when opened.


ENTRY CONDITIONS:	XPPN	Filename
			XEXT	Extension (swapped)


EXIT CONDITIONS:	If the file is successfully looked up and the first
			buffer read take skip return,otherwise take simple return

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.MODINIT:PROC

	ST	XPPN,MODLBL
	MOVSM	XEXT,MODLBL+1
	SETZM	MODLBL+2
	LI	YPATH
	ST	MODLBL+3
	LOOKUP	MODCH,MODLBL
	RETURN

	L	[400K,,MODBUF+1]
	ST	MODBH
	IN	MODCH,
	AOS	(XPDP)
	LI	1	;[12]
	ST	BLOCKNO	;[12] Initial count
	RETURN
	EPROC
	SUBTTL	MORECORE

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Expand low segment one page.


EXIT CONDITIONS:	XTOP	Left halfword is updated.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


MORECORE:PROC

	SAVE	X1

	HRRZ	X1,.JBREL
	ADDI	X1,1K
	CORE	X1,
	SEVERE(NOT ENOUGH CORE)

	HRRZ	X1,XTOP
	SUB	X1,.JBREL
	HRL	XTOP,X1

	RETURN
	EPROC
	SUBTTL	OUTCOM	Output command

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output the given command to list file (if any)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTCOM:PROC

	IFON	SWTTY
	RETURN	;IF OUTPUT ON TTY

	OUTLINE
	LI	XCC,"*"
	OUTCH
	OUTTEXT	COMBUF
	OUTLINE

	RETURN
	EPROC
	SUBTTL	OUTMOD	Output module

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output a module name and its accessing path.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTMOD:PROC

	SAVE	XDIR

	IF
		SKIPN	XCC+1,ZMONAME(XMOD)
		GOTO	FALSE
	THEN	;MODULE FOUND IN SOME DIRECTORY
		OUTSIX
		IF	;[12] Part of a library
			L	ZMOSW(XMOD)
			TRNN	QSWLIB
			GOTO	FALSE
		THEN	;Output library name also
			OUTTEXT	<[ASCIZ/	in /]>
			LF	XCC+1,ZMOLIB(XMOD)
			OUTSIX
		FI	;[12]
		LF	XDIR,ZMODIR(XMOD)
		OUTPPN
	ELSE
		OUTTEXT	<[ASCIZ/NOT FOUND
/]>
	FI

	RETURN
	EPROC
	SUBTTL	OUTPPN	Output PPN

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output <ht><device>:[PPN,SFD..]


ENTRY CONDITIONS:	XDIR	Points to a directory.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTPPN:PROC

	IF
		IFOFF	SWFAST
		CAMN	XDIR,LASTPPN
		GOTO	FALSE
	THEN
		ST	XDIR,LASTPPN
		LI	XCC,QHT
		OUTCH
		EXEC	..OUTPPN
		LI	XCC,"]"
		OUTCH
	FI

	OUTLINE

	RETURN
	EPROC


..OUTPPN:PROC

	SAVE	XCC-1

	IF
		SKIPN	XCC+1,ZDIDEV(XDIR)
		GOTO	FALSE
	THEN	;UFD
		OUTSIX	;OUTPUT DEVICE
		OUTTEXT	[ASCIZ/:	[/]
		HLRZ	XCC-1,ZDIPPN(XDIR)
		OUTOCT
		LI	XCC,","
		OUTCH
		HRRZ	XCC-1,ZDIPPN(XDIR)
		OUTOCT
	ELSE	;SFD
		L	XCC-1,XDIR
		LF	XDIR,ZDIBACK(XDIR)
		EXEC	..OUTPPN
		LI	XCC,","
		OUTCH
		L	XCC+1,ZDIPPN(XCC-1)
		OUTSIX
	FI

	RETURN
	EPROC
	SUBTTL	OUTSIX	Output a sixbit name

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output a sixbit name. Trailing blanks are not output.


ENTRY CONDITIONS:	XCC+1	Holds the name left justified.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTSIX:PROC

	LOOP
		LI	XCC,0
		LSHC	XCC,6
		ADDI	XCC,40
		OUTCH
	AS
		JUMPN	XCC+1,TRUE
	SA

	RETURN
	EPROC
	SUBTTL	OUTDEC

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output a number in decimal radix.


ENTRY CONDITIONS:	XCC-1	Holds the number.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTDEC:PROC

	SAVE	XCC

	IDIVI	XCC-1,^D10
	SKIPE	XCC-1
	OUTDEC

	ADDI	XCC,60
	OUTCH

	RETURN
	EPROC
	SUBTTL	OUTOCT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output a number in octal radix.


ENTRY CONDITIONS:	XCC-1	Holds the number.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTOCT:PROC

	SAVE	XCC

	IDIVI	XCC-1,8
	SKIPE	XCC-1
	OUTOCT

	ADDI	XCC,60
	OUTCH

	RETURN
	EPROC
	SUBTTL	OUTTEXT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output a ASCIZ string. The corresponding macro call
		will generate the byte pointer.


ENTRY CONDITIONS:	The argument is a byte pointer to the string.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTTEXT:PROC	BP

	WHILE
		ILDB	XCC,BP
		JUMPE	XCC,FALSE
	DO
		OUTCH
	OD

	RETURN
	EPROC
	SUBTTL	OUTLINE

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output carriage-return line-feed.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTLINE:PROC

	LI	XCC,QCR
	OUTCH
	LI	XCC,QLF
	OUTCH

	RETURN
	EPROC
	SUBTTL	OUTPAGE

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output form feed and page header.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTPAGE:PROC

	LI	QMAXLIN
	ST	LSTLIN

	LI	XCC,QFF
	OUTCH

	OUTTEXT	PAGEHEADER

	AOS	XCC-1,LSTPAGE
	OUTDEC

	OUTLINE
	OUTLINE

	SETZM	LASTPPN

	RETURN
	EPROC
	SUBTTL	OUTCH

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Output one character.


ENTRY CONDITIONS:	XCC	Holds the character.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.OUTCH:PROC

	IF
		IFOFF	SWTTY
		GOTO	FALSE
	THEN	;OUTPUT ON TTY
		OUTCHR	XCC
	ELSE	;OUTPUT ON LIST FILE
		SOSGE	LSTBH+2
		EXEC	.OUT
		IDPB	XCC,LSTBH+1

;IF <LF> THEN DECREMENT LINE-COUNT
;IF LINE-COUNT < 0 THEN OUTPUT NEW PAGE

		IF
			CAIN	XCC,QLF
			SOSL	LSTLINE
			GOTO	FALSE
		THEN
			OUTPAGE
		FI
	FI

	RETURN
	EPROC


.OUT:	PROC

	OUT	LSTCH,
	SOSGE	LSTBH+2
	ERROR(ERROR ON OUTPUT LIST FILE)

	RETURN
	EPROC
	SUBTTL	PPNMATCH

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Match two PPN versus each other.


ENTRY CONDITIONS:	X0	Holds the result when the two PPN:s
				are XOR:ed with each other.
			XSWITCH	Holds information about *:s etc.


EXIT CONDITIONS:	Skip return if match, otherwise simple return.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.PPNMATCH:PROC

	SAVE	X1
	LI	X1,0
	TLNE	-1
	TRNE	XSWITCH,QSWPJ
	ADDI	X1,1
	TRNE	-1
	TRNE	XSWITCH,QSWPG
	ADDI	X1,1
	TRNE	XSWITCH,QSWOTHER
	TRC	X1,2
	TRNE	X1,2
	AOS	-1(XPDP)

	RETURN
	EPROC
	SUBTTL	SETCRF

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Create a cross reference (2 ZUS-records).


ENTRY CONDITIONS:	X1	Unique number of used module.
			XMOD	Module which requires the other


EXIT CONDITIONS:	Both modules get a ZUS-record pointing at each other.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.SETCRF:PROC

	SAVE	XMOD2

	L	XMOD2,DIRZMO

	WHILE
		JUMPE	XMOD2,FALSE
		CAMN	X1,ZMOUNR(XMOD2)
		GOTO	FALSE
	DO
		LF	XMOD2,ZMONXT(XMOD2)
	OD

	IF
		JUMPN	XMOD2,FALSE
	THEN
		GETZMO
		LI	XMOD2,(XTOP)
		ST	X1,ZMOUNR(XMOD2)
		L	DIRZMO
		ST	XMOD2,DIRZMO
		SF	,ZMONXT(XMOD2)
	FI

	GET1W
	LF	,ZMOUS(XMOD)
	SF	XTOP,ZMOUS(XMOD)
	SF	,ZUSNXT(XTOP)
	SF	XMOD2,ZUSMOD(XTOP)

	GET1W
	LF	,ZMOREQ(XMOD2)
	SF	XTOP,ZMOREQ(XMOD2)
	SF	,ZUSNXT(XTOP)
	SF	XMOD,ZUSMOD(XTOP)

	RETURN
	EPROC
	SUBTTL	SIXRX50

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Convert X0 from RADIX50 to SIXBIT

INPUT:		X0 = Radix50 symbol

OUTPUT:		X0 = SIXBIT symbol

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

.SIXRX50:PROC
	SAVE	<X1,X2>
	TLZ	(74B4)	;Eliminate code bits
	SETZ	X2,	;Accumulate SIXBIT in X2
	LOOP	;Over all characters
		IDIVI	X0,50
		IF	;Special characters
			CAIGE	X1,45
			GOTO	FALSE
		THEN
			L	X1,[EXP '.','$','%']-45(X1)
		ELSE	;Null, digit or letter
			IF	;Not null
				JUMPE	X1,FALSE
			THEN
				LI	X1,'A'-13(X1)	;Assume letter
				CAIGE	X1,'A'
				LI	X1,'0'-'A'+12(X1)	;Modif for digit
		FI	FI
		LSHC	X1,-6	;One SIXBIT character into X2
	AS
		JUMPN	TRUE
	SA
	L	X2
	RETURN
	EPROC
	SUBTTL	SKIPINPUT

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Scan past some words in the REL or ATR file.


ENTRY CONDITIONS:	XEXT Holds number of words to be skipped.


EXIT CONDITIONS:	Skip return if routine succeded, otherwise (EOF or
			read error) simple return.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.SKIPINPUT:PROC

	LOOP
		GETWORD
		RETURN
	AS
		SOJGE	XEXT,TRUE
	SA

	AOS	(XPDP)
	RETURN
	EPROC
	SUBTTL	SCAN AND TEST

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Find first non-blank character past current.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.SCANANDTEST:PROC

	SAVE	X0

	LOOP
		SCAN
	AS
		IFON	ZCHBLANK(XCC)
		GOTO	TRUE
	SA

	RETURN
	EPROC
	SUBTTL	TEST AND SCAN

COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

FUNCTION:	Find first non-blank character.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


.TESTANDSCAN:PROC

	SAVE	X0

	WHILE
		IFOFF	ZCHBLANK(XCC)
		GOTO	FALSE
	DO
		SCAN
	OD

	RETURN
	EPROC
	SUBTTL	EPILOG
	LIT
	END	SIMDIR