/GLOBL.PA  VERSION 2
/A PROGRAM TO SHORTEN THE MONITOR SYMBOL LIST
/		OCTOBER 1974
/START-ADDRESS IS 00200
/WHEN ASSEMBLING PARTS OF THE MULTI8-SYSTEM,
/E.G. MODULES,MUCH TIME IS SPENT BY THE ASSEMBLER
/TO COPY THE MONITOR-SYMBOLS (M.LS)TO ITS INTERNAL
/SYMBOL-LIST. THIS TIME CAN BE MINIMIZED BY
/SHORTENING THE MONITOR-SYMBOL-LIST.
/THIS OPERATION MAY BE PERFORMED BY THIS PROGRAM.
/IT WILL ONLY COPY THOSE SYMBOLS WHICH ARE IN A
/SECOND LIST (OR WHICH ARE NOT, OR ALL) ON THE SPE-
/CIFIED OUTPUT FILE.
/HOW TO USE:
/.R GLOBL
/*OUT<INP1,INP2/X
/INP1 IS THE REFERENCE LIST (SYMBLS)
/INP2 IS THE INPUT FILE     (M.LS)
/IF ONLY 1 INPUTFILE IS SPECIFIED, COPY ALL SYMBOLS
/
/THE REFERENCE LIST MUST START AND END WITH A LINE
/CONTAINING A "*" AT THE FIRST POSITION.
/THE FILE INP2 IS THE OUTPUT OF THE ASSEMBLER WHEN
/ASSEMBLING THE MONITOR (WITH OPTIONS /H/N/D)
/
/SPECIFIED OPTION X :
/ /V MEANS: INVERTED SENSE (=COPY ALL SYMBOLS WHICH ARE NOT
/	IN THE REFERENCE LIST.)
/WHEN NO OPTION IS SPECIFIED: COPY ALL SYMBOLS WHICH ARE
/	IN THE REFERENCE LIST. (IF ANY)
*15
P15,	PS8OUT-1	/POINTER TO OS8OUT IN FLD 0
P16,	OS8OUT-1	/POINTER TO OS8OUT IN FLD 1
T17,	-400		/MOVE 400 LOCS
MOVE,	HLT		/MOVE SUBROUTINE
	TAD I P15
	CDF 10
	DCA I P16
	CDF 0
	ISZ T17
	JMP MOVE+1
	JMP I MOVE	/RETURN
NAMTAL,	0
NAMINT,	0
OUTTAL,	-4
INCTAL,	0
INCPNT,	0
INCP2,	0
SRTAL,	0
SRPNT,	0
NAMPNT,	0
TEM,	0
CHR,	0
NAME2,	ZBLOCK 3

/THERE IS ROOM LEFT IN PAGE 0,SO WE CAN
/PUT A SUBROUTINE HERE

HEAD,	HLT		/GIVE HEADING
	JMS I [XLSTX	/XLIST;IFNDEF MONITO <
	JMS I [PRSTR
	"I;"F;"N;"D;"E;"F;211;"M;"O;"N;"I;"T;"O
	211;"<;215;212;0
	JMP I HEAD
PAGE
/START OF PROGRAM
START,	JMS MOVE	/MOVE UP OS8OUT,OS8IN
	JMS I [RDLIST	/READ REFERENCE LIST
RDRET0,	JMS I [SKCR	/ SKIP 3 (CR)
OPTAST,	JMS I [SKCR
	JMS I [SKCR
	JMS HEAD	/OUTPUT HEADING
LOOP,	JMS INNAM	/READ A NAME
	JMP ENDFIL	/E.O.T RETURN
	JMS I [INCOD	/MAKE ASCII-240 CODE
SRINS,	JMS I [SEARCH	/NAME IN THE LIST ?
/NOTE: SRINS,SRINS+1,SRINS+2 WILL BE CHANGED BY
/OPTIONS /A OR /V, SO KEEP THEM IN THIS ORDER
	JMP LOOP	/NO
	JMS OUTPUT	/OUTPUT NAME + NUMBER
	JMP LOOP

ENDFIL,	JMS I [FXTAB	/COMMENT AFTER LIST
	TAD [232	/CNTRL Z TO CLOSE THE FILE
	JMS I [OUT

INNAM,	HLT		/READ A NAME (11 CHARS)
	TAD [NAME
	DCA NAMPNT	/SET POINTER
	TAD [-13
	DCA NAMTAL	/SET TALLY
L1,	CDF CIF 10
	JMS I [OS8IN	/READ A CHAR
	DCA CHR
INSTRT,	JMP TESTOP	/OVERLAID BY: TAD CHR
	TAD [-240
	SPA
	 JMP NOCHAR
	TAD [240-"/	/SLASH ?
	SNA CLA
	 JMP SLASH	/COMMENT
	JMP CHAROK
NOCHAR,	TAD [240-212	/IGNORE LINEFEED
	SNA
	 JMP INNAM+1
	TAD [212-215	/C.R. ?
	SNA
	 JMP INNAMR	/TOO SHORT; MAKE SPACES
	IAC	/215-214/FORM ?
	SNA
	 JMP INNAM+1	/YES: IGNORE
	TAD [214-232	/CTRL Z ?
	SNA CLA
	 JMP I INNAM	/ERROR RETURN
CHAROK,	TAD CHR
	DCA I NAMPNT	/TO BUFFER
	ISZ NAMPNT
	ISZ NAMTAL
	JMP L1		/NEXT CHAR
	JMS I [SKCR	/SKIP TILL (CR)
INRET,	ISZ INNAM	/NORMAL RETURN
	JMP I INNAM
SLASH,	JMS I [SKCR
	JMP INNAM+1
INNAMR,	TAD [240	/GENERATE SPACES
	DCA I NAMPNT
	ISZ NAMPNT
	ISZ NAMTAL
	JMP INNAMR	/LOOP
	JMP INRET	/RETURN

OUTPUT,	HLT
	TAD ["=
	DCA NAME+6	/SPACE TO "=
	JMS I [PRSTR	/OUTPUT THE STRING
NAME,	ZBLOCK 14
	ISZ OUTTAL	/DONE 4 ?
	JMP OUTX	/NO
	TAD [-4		/RESET TALLY
	DCA OUTTAL
	TAD [215	/OUTPUT CRLF
	JMS I [OUT
	TAD [212
	JMS I [OUT
	JMP I OUTPUT	/RETURN
OUTX,	TAD [";
	JMS I [OUT
	TAD [211
	JMS I [OUT
	JMP I OUTPUT
XLSTX,	HLT		/OUTPUT "XLIST"
	JMS I [PRSTR
	"X;"L;"I;"S;"T;215;212;0
	JMP I XLSTX

TESTOP,	TAD [TAD CHR	/TEST OPTIONS
	DCA INSTRT	/MAKE INNAM CORRECT
	TAD [7700	/FROM NOW ON USR IS NOT IN CORE
	CDF 10
	DCA I [OSIUSR	/PATCH OS8IN
	TAD I [7621	/GET SECOND INPUT
	SNA CLA
	 JMP OPTA	/NO SECOND INPUT
	TAD I [7644	/GET 2ND OPTION WORD
	CDF 0
	AND [4		/TEST OPTION V
	SNA CLA		/YES
	 JMP INSTRT	/NO OPTION SPECIFIED
OPTV,	TAD SRINS+2	/CHANGE THE PROGRAM A BIT
	DCA SRINS+1	/JMP LOOP WILL BE JMS OUTPUT
	TAD SRINS+3	/JMS OUTPUT WILL BE JMP LOOP
	DCA SRINS+2
	JMP INSTRT	/RETURN
OPTA,	CDF 0
	TAD [SKP CLA	/CHANGE PROGRAM
	DCA SRINS
	JMP OPTAST

PAGE
OUT,	HLT
	CIF 10
	JMS I [OS8OUT
	JMP I OUT

PRSTR,	HLT
	TAD I PRSTR	/GET CHAR
	ISZ PRSTR
	SNA
	JMP I PRSTR
	TAD [-240	/DON'T OUTPUT SPACES
	SNA
	JMP PRSTR+1
	TAD [240
	JMS OUT
	JMP PRSTR+1

SEARCH,	HLT		/NAME IN NAMLIST
	TAD [NAMLST
	DCA SRPNT
SRLP,	JMS SRCH1
	JMP I SEARCH	/NOT FOUND
	TAD NAME2+1
	JMS SRCH2
	JMP SRLPX	/TRY NEXT NAME
	TAD NAME2+2
	JMS SRCH2
	JMP SRLP	/TRY NEXT NAME
	ISZ SEARCH	/FOUND
	JMP I SEARCH	/RETURN
SRLPX,	ISZ SRPNT
	JMP SRLP

SRCH1,	HLT
SRLP2,	TAD I SRPNT
	ISZ SRPNT
	SNA		/END OF LIST
	JMP I SRCH1	/YES
	TAD NAME2
	SNA CLA
	JMP SRCH1X	/FOUND
	ISZ SRPNT
	ISZ SRPNT	/POINT TO NEXT NAME
	JMP SRLP2	/NEXT TRY
SRCH1X,	ISZ SRCH1	/NORMAL RETURN
	JMP I SRCH1
SKCR,	HLT
	CDF CIF 10
	JMS I [OS8IN
	TAD [-215
	SZA CLA
	JMP SKCR+1
	JMP I SKCR

SRCH2,	HLT		/NEXT CHARS EQUAL ?
	TAD I SRPNT
	ISZ SRPNT
	SNA CLA		/NO
	ISZ SRCH2	/YES
	JMP I SRCH2	/RETURN

INCOD,	HLT		/MAKE NAME2=NAME(ASCII-240 CODE)
	TAD [-3
	DCA INCTAL	/SET TALLY
	TAD [NAME
	DCA INCPNT
	TAD [NAME2	/2ND TALLY
	DCA INCP2
INCLP1,	TAD I INCPNT	/GET CHAR
	ISZ INCPNT
	TAD [-240	/MAKE ASCII-240
	AND [77
	CLL RTL;RTL;RTL	/BSW
	DCA I INCP2	/TO NAME2
	TAD I INCPNT	/2ND CHAR
	ISZ INCPNT
	TAD [-240
	AND [77
	TAD I INCP2	/+FIRST
	DCA I INCP2	/RESTORE
	ISZ INCP2
	ISZ INCTAL	/READY ?
	JMP INCLP1	/NO
	JMP I INCOD	/RETURN
RDLIST,	HLT		/INPUT NAMLST FROM FIRST FILE
	TAD [NAMLST-1	/SET POINTER
	DCA 11
RDLP,	JMS I [INNAM	/READ NAME FROM FIRST FILE
	JMP RDLP	/BAD NAME ?
	TAD I [NAME	/CHECK NAME
	TAD [-"*	/A "*" ?
	SZA CLA		/Y
	JMP RDLP	/NO:TRY AGAIN
RDLP2,	JMS I [INNAM	/READ NAME
	HLT		/*****ERROR*****
	TAD I [NAME	/TEST FOR END
	TAD [-"*
	SNA CLA
	JMP RDEND	/END OF FIRST FILE
	JMS INCOD	/MAKE ASCII-240
	TAD NAME2	/MOVE NAME2
	CIA		/MINUS FOR COMPARE
	DCA I 11
	TAD NAME2+1
	CIA		/MINUS
	DCA I 11
	TAD NAME2+2
	CIA		/MINUS
	DCA I 11
	JMP RDLP2	/NEXT NAME
RDEND,	DCA I 11	/0=END OF LIST
	JMP I RDLIST	/RETURN

FXTAB,	HLT		/COMMENT AFTER LIST
	JMS I [PRSTR
	">;215;212;"F;"I;"X;"T;"A;"B;";;0
	JMS I [XLSTX
	JMP I FXTAB	/RETURN
PAGE

NAMLST=.
/OS8IN-OS8OUT
/THESE ROUTINES WILL BE LOAD IN FIELD 0
/BUT RUN IN FIELD 1
/IF THE PROGRAM STARTS THESE TWO PAGES
/WILL BE MOVED UP TO 17200-17577
	TWOPAG=1
	BUFOUT=0000
	BLKOUT=7
	HANDL=7200
	PFIELD=10
	FILNAM=7601
	BUFFLD=10
	WRITE=4000

PS8OUT,	0
	OS8OUT=7200
	DCA CHAR
/	RDF
/	TAD PSOCIF
/	DCA PSORET
	CDF PFIELD
PSINIT,	JMP PSOBEG
	JMS PSWRIT
	TAD CHAR
	TAD PSM232
	SZA CLA
	JMP PSORET
	DCA CHAR
PSPACK,	JMS PACKB
	SKP
	JMP .-2
	JMS PSWRIT
	CLA CLL IAC RTL
	JMS PSOUSR
PSOCIF,	CIF CDF 0
	JMP I PS7600
PSORET,	CDF CIF 0
	JMP I PS8OUT
	7400
PACKB,	0
	TAD OUPKSW
	SZA
	JMP PACKON
	TAD CHAR
	DCA I OUPTR
	TAD OUPTR
	CLL RAR
	SNL CLA
	JMP .+4
	CLA CLL CMA RAL
	DCA OUPKSW
	SKP
	ISZ OUPTR
	JMP PACKEX
PACKON,	CLA CMA
	TAD OUPTR
	DCA OUPTR
	TAD CHAR
	RTL
	RTL
	DCA PSOBL-1
	TAD PSOBL-1
	AND PACKB-1
	TAD I OUPTR
	DCA I OUPTR
	ISZ OUPTR
	TAD PSOBL-1
	ISZ OUPKSW
	JMP PACKON+4
PS7600,	7600
	TAD LIMIT
	TAD OUPTR
	SPA CLA
PACKEX,	ISZ PACKB
	JMP I PACKB
	FILNAM
PSOUSR,	0
	DCA PSCALL+1
	TAD PSOUSR-1
	DCA PSCALL+2
	TAD PSOBL
	DCA PSCALL+3
	TAD I PS7600
	AND (17
PSCALL,	JMS I USR
	0
	0
	0
	JMP ERR2
	JMP I PSOUSR

PSOBEG,	TAD I PS7600
	SNA
	CLA CLL CML IAC RAL
	DCA I PS7600
	TAD I PS7600
	JMS I USR
PSOBL,	1
PSOHND,	HANDL+TWOPAG
	CLA CLL IAC RAL
	CLL CML IAC RAL
	JMS PSOUSR
	TAD PSPACK
	DCA PSINIT
	DCA PSOBL
	JMP PSINIT
ERR4,	ISZ PSOUSR-1
ERR3,	ISZ PSOUSR-1
ERR2,	ISZ PSOUSR-1
	JMP PSOHND+1
	BLKOUT
PSWRIT,	0
	TAD PSCALL+2
	DCA PSOWRI
	TAD PSCALL+3
	CLL
	TAD PSWRIT-1
	SZL
	JMP ERR3
	DCA PSCALL+3
	CIF 0
	JMS I PSOHND
	BLKOUT^200+BUFFLD+WRITE
PSOBUF,	BUFOUT
PSOWRI,	-5
	JMP ERR4
	TAD PSWRIT-1
	TAD PSCALL+2
	DCA PSCALL+2
	TAD PSWRIT-1
	TAD PSOBL
	DCA PSOBL
	TAD PSOBUF
	DCA OUPTR
	JMP I PSWRIT

CHAR,	0
OUPKSW,	0
OUPTR,	BUFOUT
LIMIT,	-BLKOUT^400-BUFOUT
USR,	7700
PSM232,	-232
PAGE
/OS8 INPUT ROUTINE
	IBUFST=3400
	IBUFLG=7
	IHNDLR=6601
	OSIEXT=1423	/.LS
	IBUFLD=10
	OSICCD=1
	OSIREL=1
	NOICDF=1
	IUSR=200	/WILL BE CHANGED TO 7700

/---------------------------------------------------------------/

/OS8IN-1975  J.VERBURG  7-NOV-75
/	OS/8 INPUT ROUTINE

/CONFIGURATION LOGIC:
/	DEFAULT VALUES:
IFNDEF OS8IN <OS8IN=7400>
IFNDEF OSIFLD <OSIFLD=10>
IFNDEF IPRFLD <IPRFLD=0>
IFNDEF IBUFLD <IBUFLD=10>
IFNDEF IUSR <IUSR=7700>
IFNDEF IHNDLR <IHNDLR=7201>
IFNDEF OSIEXT <OSIEXT=0>
IFNDEF IBUFST <IBUFST=4000>
IFNDEF IBUFLG <IBUFLG=6>

/	PARAMETER TESTS:
IFNZRO IBUFST&1 <BUFSTR,XERROR>
IFNZRO IBUFLG-1&7760 <BUFLGR,XERROR>
IFNZRO IBUFST%2+77%100+IBUFLG+IBUFLG-1^10-IBUFLD&7400 <BUFLCR,XERROR>
IFNZRO OS8IN&177 <OS8INR,XERROR>
IFNZRO OS8IN%2+100&4000 <OS8INR,XERROR>
IFNZRO OSIFLD&7707 <IFLDR,XERROR>
IFNZRO IPRFLD&7707 <PRFLDR,XERROR>
IFNZRO IBUFLD&7707 <BUFLDR,XERROR>

/	DATAFIELD:
/0 FIELD 0
/1 FIELD 10
/2 BUFFER FIELD
/3 FIELD OF OS8IN
/4 FIELD OF CALLING PROGRAM
IFNDEF OSIREL <
FIELD OSIFLD%10
*OS8IN		>
IFDEF OSIREL <
RELOC OS8IN	>
O=(7760	/FOR OSI377
	0
IFDEF OSICLA <
	CLA		/? >
IFDEF OSIOLD <
	RDF		/4 COMPUTE CALLING FIELD
	TAD (CDF CIF	/4
	DCA OSICDI	/4 >
IFNDEF NOICDF <
	CDF IBUFLD	/2 >
	JMP I OSIPCH	/2 COROUTINES

OSIFRST,
IFDEF OSICCD <
IFNZRO IBUFLD <
	CDF 0		/0 >
OSIPNT,	TAD OSIHND	/2
OSINDC,	DCA I OSIBLK	/0 SET NON-RESTARTABLE
IFNZRO OSIFLD <
	CDF OSIFLD	/3 >
IFNZRO OSIFLD-10 <
	CIF 10		/3 >
OSINUM,	JMS I OSIUSR	/3 CALL COMMAND DECODER
OSICNT,	   5		/3
	   OSIEXT	/3
IFDEF NOCLOS <
	   0		/3 >
IFZERO IBUFLD-10 <
IFNZRO OSIFLD-10 <
	CDF 10		/1 >>>

OSINXT,			/1,2
IFNZRO IBUFLD-10 <
	CDF 10		/1 >
	TAD (IHNDLR&7601/1 NEXT (FIRST) INPUT FILE
	DCA OSIHND	/1
	ISZ OSIFILP	/1
	TAD I OSIFILP	/1
IFNZRO OSIFLD-10 <
	CDF OSIFLD	/3 >
	SNA		/3
IFDEF IRSTRT <
	 JMP OSIRST	/3 NO NEXT ONE, MAKE RESTARTABLE >
IFNDEF IRSTRT <
	 JMP OSIEND	/3 NO NEXT ONE, RETURN ^Z >
IFNZRO OSIFLD-10 <
	CIF 10		/3 >
	JMS I OSIUSR	/3
	   1		/3 FETCH HANDLER
OSIHND,	   1000		/3 INIT VALUE
IFDEF INPER1 <
IFZERO OSIFLD-IPRFLD <
	JMP I (INPER1	/3 HANDLER FETCH ERROR >
IFNZRO OSIFLD-IPRFLD <
	JMP OSIER1	/3 HANDLER FETCH ERROR >>
IFNDEF INPER1 <
	  HLT		/3 HANDLER FETCH ERROR ... >
IFNZRO OSIFLD-10 <
	CDF 10		/1 >
	TAD I OSIFILP	/1
OSI377,	AND (7760	/1
	CLL RTR		/1
	RTR		/1
	SZA		/1
	 TAD (7400	/1
	DCA OSINUM	/1 NUMBER OF BLOCKS
	ISZ OSIFILP	/1
	TAD I OSIFILP	/1
	DCA OSIBLK	/1
IFZERO IBUFLD-OSIFLD <
IFNZRO OSIFLD-10 <
	CDF OSIFLD	/3 >>

OSIREAD,		/2,3
IFNZRO IBUFLD-OSIFLD <
	CDF OSIFLD	/3 >
IFNZRO IBUFLG-1 <
	CLL STA		/3
	DCA OSINDC	/3
	TAD (IBUFLG	/3
	TAD OSINUM	/3
	SNA SZL		/3
	 ISZ OSINDC	/3 WILL SKIP
	DCA OSINUM	/3
	CLL RTR		/3
	RTR		/3
	RTR		/3
	TAD (-IBUFLG^200/3
	DCA OSICNT	/3
	TAD OSICNT	/3
	CIA		/3
IFZERO IBUFLG-20 <
	SPA		/3
	 CLA		/3 >
IFNZRO IBUFLD <
	TAD (IBUFLD	/3 >>
IFZERO IBUFLG-1 <
	TAD (7600	/3
	DCA OSICNT	/3
	TAD (200+IBUFLD	/3 >
	DCA OSIFUNC	/3
IFNZRO OSIFLD <
	CIF 0		/3 >
	JMS I OSIHND	/3
OSITEM,
OSIFUNC,   IBUFLG&17^200+IBUFLD/3
OSIBUF,	   IBUFST	/3
OSIBLK,	   7746		/3 INIT VALUE
IFDEF INPER2 <
IFZERO OSIFLD-IPRFLD <
	JMP I (INPER2	/3 >
IFNZRO OSIFLD-IPRFLD <
	JMP OSIER2	/3 >>
IFNDEF INPER2 <
	  HLT		/3 INPUT ERROR, FATAL ?... >
IFNZRO IBUFLG-1 <
	TAD (IBUFLG	/3
	TAD OSIBLK	/3
	DCA OSIBLK	/3 >
IFZERO IBUFLG-1 <
	ISZ OSIBLK	/3 >
IFNZRO IBUFST <
	TAD OSIBUF	/3 >
	DCA OSIPNT	/3
IFNZRO OSIFLD-IBUFLD <
	CDF IBUFLD	/2 >

OSILP,	TAD I OSIPNT	/2 FAST BUFFER UNPACK
	JMS OSIPCH	/2
	TAD I OSIPNT	/2
	ISZ OSIPNT	/2
	AND (7400	/2
	DCA OSITEM	/2
	TAD I OSIPNT	/2
	JMS OSIPCH	/2
	TAD I OSIPNT	/2
	ISZ OSIPNT	/2
IFZERO IBUFST%400+IBUFLG-20&4000 <
	NOP		/2 >
	AND (7400	/2
	CLL RTR		/2
	RTR		/2
	TAD OSITEM	/2
	RTR		/2
	RTR		/2
	JMS OSIPCH	/2
	ISZ OSICNT	/2
	 JMP OSILP	/2
IFNZRO IBUFLG-1 <
	ISZ OSINDC	/2
	 JMP OSINXT	/2
	JMP OSIREAD	/2 >
IFZERO IBUFLG-1 <
	ISZ OSINUM	/2
	 JMP OSIREAD	/2
	JMP OSINXT	/2 >
OSIPCH,	OSIFRST		/2 COROUTINES
	AND OSI377	/2
	TAD (-232	/2
	SNA		/2
	 JMP OSINXT	/2
OSIEND,	TAD (232	/2,3
IFDEF OSIOLD <
OSICDI,	  HLT		/4 CDF CIF CALLING FIELD	>
IFNDEF OSIOLD <
IFNZRO OSIFLD-IPRFLD <
	CDF CIF IPRFLD	/4 >
IFZERO OSIFLD-IPRFLD <
IFNZRO IBUFLD-IPRFLD <
	CDF IPRFLD	/4 >>>
	JMP I OS8IN	/4

IFNZRO OSIFLD-IPRFLD <
IFDEF INPER1 <
OSIER1,	CDF CIF IPRFLD	/4
	JMP I (INPER1	/4 >
IFDEF INPER2 <
OSIER2,	CDF CIF IPRFLD	/4
	JMP I (INPER2	/4 >>

IFDEF IRSTRT <
OSIRST,	TAD (OSINXT	/3
	DCA OSIPCH	/3
	TAD (7617-1	/3
	DCA OSIFILP	/3
	JMP OSIEND	/3 >

OSIFILP,7617-1
OSIUSR,	IUSR
IFNDEF OSICCD <
OSIPNT,	0
OSINUM,	0
OSICNT,	0
IFNZRO IBUFLG-1 <
OSINDC,	0		>>

PAGE
IFDEF OSIREL <
RELOC		>
$