*20
	EJECT
/QUICK ASSEMBLER FOR THE PDP-12 VO18
	PMODE
/FAST DIAL ASSEMBLER, 10/18/71
/COPYRIGHT 1971
/DIGITAL EQUIPMENT CORP.
/MAYNARD, MASS.
/
/THIS IS A MODIFICATION OF THE PDP-12 FLOATING POINT
/ASSEMBLER TO ENABLE IT TO HANDLE LINC AS WELL AS
/PDP-8 CODE. THE HANDLER FOR FLOATING POINT CODE
/HAS BEEN REMOVED.
/
/
/
/
	FLD0=0
	FLD1=10
	ORG 3
	DECIMAL
VERS,	1018			/VERSION NUMBER
	OCTAL
OLDN3,	0			/TEMP FOR LOOKUP
OTEMP,	0			/A COUPLE OF TEMPS THAT
OCNT,	0			/DIDNT FIT INTO THEIR PAGE
PAGSIZ,	-76			/LINES PER PAGE COUNTER
X10,	0
X11,	0
X12,	0
X13,	0
X14,	0
X15,	0
NEXT,	FREE-1
CHRPTR,	0
NCHARS,	-1			/CHARACTER INPUT STUFF
CPTMP,	0
NCTMP,	0			/USED TO SAVE CHAR POSITION
LINSIZ,	0			/SIZE OF LINE FOR PRINTING
CHRCNT,	-1			/CHAR COUNT FOR INPUT FILE
SIZPAG,	-76			/NUMBER OF LINES PER PAGE
LOCTR1,	0			/24 BIT LOCATION COUNTER
LOCTR2,	200
LITRG2,	0
EXPVAL,	0			/EXPRESSION VALUE
	0
	0
EXPTYP,	0			/EXPRESSION TYPE
EXPSW,	0			/FLAG=1 IF NO EXPR
WORD1,	0			/TEMPORARY 2 WORD OPERAND
WORD2,	0
OPCODE,	0			/OPCODE OR PSEUDO-OP POINTER
XINCR,	1			/FLAG = 0 IF + LEGAL IN INDEX EXPR
BUCKET,	0			/FIRST CHAR OF NAME
NAME1,	0			/CHARS 2 AND 3 OF NAME
NAME2,	0			/CHARS 4 AND 5 OF NAME
NAME3,	0			/CHAR 6 OF NAME AND TYPE
LASTOP,	0			/LAST OPERATOR ENCOUNTERRED IN EXPR
PASSNO,	1			/PASS NUMBER
ASMOF,	0			/SET TO 1 WHEN ASSEMBLY OFF
LINENO,	0			/LINE NUMBER
LISTSW,	1			/LIST SWITCH
LSTON,	1			/NO LIST OPTION SWITCH
OUTSWT,	0			/OUT SWITCH
SCSWT,	0			/SEMICOLON SWITCH
RADIX,	0			/RADIX FOR INTEGERS (0 IS OCTAL)
LTEMP,	0			/TEMP USED BY LOOKUP
EXTMP,	0			/TEMPS USED BY EXPR AND OTHERS
EXTMP2,	0
EQUN,	0;0;0;0
LITRL,	0			/SET = 1 FOR LITERAL
DIALRD,	7774			/DIAL INPUT ROUTINE
DIALWR,	7775			/DIAL OUTPUT ROUTINE
BBLOCK,	0			/CURRENT BINARY OUT BLOCK (REL)
/BFUDGE,370			/BINARY FUDGE FACTOR
SBLOCK,	70			/CURRENT SOURCE INPUT BLOCK (INITIALLY BLK 70 OF UNIT 100)
/SFUDGE,370			/SOURCE FUDGE FACTOR
STAR20,	0			/IGNORE *20 AT BEGINNING OF FILE
P0LIT,	177
CPLIT,	177
ACE,	0
OPE,	0
	
MODE,	0		/0 = PMODE, -1 = LMODE
	
ACHR,	0		/USED BY PRINT ROUTINES
CHAR,	0		/USED BY TEXT PSEUDO-OP (ONLY)
LWAIT,	SKPLTD		/NOPAUSE TAPE POINTER
PAR6,	0		/PARAM LIST FOR "LISTAPE" PSEUDO-OP
	10		/CORE = 4000 (CHECK RING BUFFER CODE BEFORE YOU CHANGE THIS!)
LBLOCK,	0
	1		/1 AT A TIME
	CPLBUF=6000
	LINE=6200
	USETBL=6340
	BINARY=6400
	SOURCE=5000
	P0LBUF=5400
	USEB=14
	BINARB=15
	SOURCB=12
	PAGE
NEXTST,	JMS	GETEM	/THIS HASSLE IS NECESSARY TO TAKE
	JMP I	(ASMBL	/CARE OF MULTI-LINE "TEXT" STATEMENTS
GETEM,	0
	CLA CMA			/CHECK PASS NUMBER
	TAD	PASSNO
	SNA CLA
	JMP	START		/IF PASS 1 THEN NO LISTING
	TAD	LISTSW		/CHECK LIST STATUS
	SNA CLA
	JMP	START		/NO, DONT LIST
	TAD	OUTSWT		/DID THIS LINE GENERATE OUTPUT?
	SZA CLA
	JMP	START		/YES, NO PRINT NECESSARY
	JMS I	[PRINTC		/PRINT CR/LF
	TAD	LINENO		/PRINT LINE NUMBER
	JMS I	[OCTOUT
	TAD	[247
	JMS I	[PRINTC		/THEN TAB
	TAD	[247		/ANOTHER TAB
	JMS I	[PRINTC
	JMS I	(PRNTLN		/THEN PRINT LINE
	JMP	START
FAKEIT,	TAD	(ASMBL
	DCA	GETEM	/FAKE SUBROUTINE CALL
START,	JMS I	[GETCHR		/ANY MORE CHARS ?
	JMP	NOTEG
	JMS I	[ERMSG		/EXTRA GARBAGE ON LAST LINE
	0507			/*EG*
NOTEG,	TAD	SCSWT		/DID LAST LINE END WITH SEMICOLON ?
	SNA CLA
	JMP	.+5		/NO
	DCA	SCSWT		/KILL SC SWITCH
	ISZ	CHRPTR		/SKIP OVER SEMICOLON
	ISZ	NCHARS
	JMP I	(ASMBL		/DONT READ NEW LINE
	TAD	[LINE-1		/RESET POINTER
	DCA	CHRPTR
	TAD	(-137		/95 CHARACTERS ONLY
	DCA	MAXLIN
	DCA	OUTSWT		/CLEAR OUTPUT SWITCH
	DCA	LTMSG		/SET LT MESSAGE SWITCH
RDLOOP,	ISZ	CHRCNT		/ANY MORE CHARS IN THIS BLOCK?
	JMP	NOREAD		/YES, GO GET IT
	TAD	M1000		/NUMBER OF CHARS PER BLOCK
	DCA	CHRCNT
	TAD	[SOURCE		/SOURCE FILE BUFFER
	DCA	WDPTR		/INTO POINTER
	DCA	ODDEVN		/START WITH EVEN CHAR
	TAD	SBLOCK		/FIND BLOCK NUMBER
/	TAD	SFUDGE
	DCA	RDBLOK
	TAD	STAR20		/CHECK FOR FIRST READ
	SZA CLA
	JMP	.+6
	ISZ	STAR20		/SET SWITCH
	TAD	(-774		/IGNORE FIRST FOUR CHARACTERS
	DCA	CHRCNT
	TAD	(SOURCE+2	/SKIP FIRST TWO WORDS
	DCA	WDPTR
	JMS I	DIALRD		/DIAL READ
	SRCUNT			/PARAMETER POINTER
/	CLA			/DOES DIAL RETURN ZERO AC? (YES!)
	ISZ	SBLOCK		/INCREMENT RELATIVE BLOCK NUMBER
NOREAD,	TAD	ODDEVN		/WHICH CHAR?
	SZA CLA
	JMP	ODDCHR		/ODD ONE
	ISZ	ODDEVN		/FLIP SWITCH
	TAD I	WDPTR		/GET EVEN CHAR
	RTR
	RTR
	RTR
DOCHR,	AND	[77		/SIX BITS
	SNA			/ZERO IS EOF
	JMP I	(ENDX		/SO DO "END"
	TAD	[-43		/DIAL CR
	SNA
	JMP	ENDLIN		/BUMP LINE NUMBER
	TAD	(3		/CONVERT TO ASCII
	SPA
	TAD	[100
	TAD	[240
	DCA I	CHRPTR
	ISZ	MAXLIN		/TEST FOR LINE TOO LONG
	JMP	RDLOOP		/PUT CHAR AWAY AND GET NEXT 1
	CLA CMA
	DCA	MAXLIN		/IGNORE REST OF LINE
	CLA CMA
	TAD	CHRPTR		/BACK UP BUFFER
	DCA	CHRPTR
	ISZ	LTMSG		/SET SWITCH
	JMP	RDLOOP
ODDCHR,	DCA	ODDEVN
	TAD I	WDPTR		/GET ODD CHAR
	ISZ	WDPTR		/BUMP WORD POINTER
	JMP	DOCHR
ENDLIN,	ISZ	LINENO		/BUMP LINE NUMBER
M1000,	NOP	
	TAD	LINENO
	7421			/PUT LINE NUM INTO MQ
	CLA			/NO BUG ON NON-MQ MACHINES
	TAD	CHRPTR		/FIND - NUMBER OF CHARS - 1
	CMA
	TAD	[LINE-1
	DCA	NCHARS
	IAC			/SAVE SIZE OF LINE FOR PRINT
	TAD	NCHARS
	DCA	LINSIZ
	TAD	[LINE-1
	DCA	CHRPTR		/SET POINTER
	TAD	LTMSG		/CHECK FOR LINE TOO LONG MESSAGE
	SNA CLA
	JMP I	GETEM		/NONE, OK
	JMS I	[ERMSG		/PRINT LINE TOO LONG MESSAGE
	1424			/*LT*
	JMP I	GETEM
	MAXLIN=LTEMP
/
SRCUNT,	100			/SOURCE UNIT
	SOURCB			/CORE LOC OVER 256
RDBLOK,	0			/BLOCK NUMBER
	1			/NUMBER OF BLOCKS
/
ODDEVN,	0
LTMSG,	0
WDPTR,	0
	PAGE
ASMBL,	JMS I	[GETCHR		/LOOK FOR A CHARACTER
	JMP I	[NEXTST
	TAD	[-257		/IS IT SLASH ?
	SNA
	JMP	NOASM		/YES, COOL IT
	TAD	(257-244	/IS IT $
	SNA
	JMP	ISDOLR
	TAD	(244-240	/IS IT BLANK OR TAB ?
	SNA CLA
	JMP	ASMBL		/YES, TRY AGAIN
	JMS I	[BACK1		/NO, PUT IT BACK
	TAD	ASMOF		/IS ASSEMBLY SWITCHED OFF ?
	SNA CLA
	JMP I	(LUNAME		/ASSEMBLE STMT
NOASM,	CLA CMA
	DCA	NCHARS		/DONT ASSEMBLE THIS LINE
	JMP I	[NEXTST		/(PREVENTING *EG* MESSAGE)
ISDOLR,	DCA	ASMOF		/TURN ASSEMBLY BACK ON (IF IT WAS OFF)
	JMP I	[NEXTST
OVER3,	0			/DIVIDE AC BY THREE
	DCA	EXTMP2		/MQ
	TAD	(-15		/SET SHIFT COUNT
	DCA	LTEMP
DIVLUP,	CLL			/ZERO LINK
	TAD	(-3		/SUBTRACT DIVISOR FROM AC
	SZL			/IF AC>=3 SET LINK TO 1
	JMP	.+3		/OK, DONT RESTORE
	TAD	(3		/TOO SMALL, RESTORE AC
	CLL			/SET LINK BACK TO 0
	DCA	EXTMP		/SAVE AC
	TAD	EXTMP2		/ROTATE MQ-AC LEFT, PUT LINK INTO MQ
	RAL
	DCA	EXTMP2		/SAVE MQ
	TAD	EXTMP		/GET BACK AC
	RAL			/COMPLETE SHIFT
	ISZ	LTEMP		/TEST COUNT
	JMP	DIVLUP		/KEEP GOING
	DCA	EXTMP		/THIS IS REMAINDER
	TAD	EXTMP2		/RETURN QUOTIENT
	JMP I	OVER3
OCTOUT,	0
	DCA	OTEMP		/SAVE WORD
	TAD	[-4
	DCA	OCNT		/FOUR DIGITS
OLOOP,	TAD	OTEMP
	CLL RTL
	RAL
	DCA	OTEMP		/SAVE SHIFTED WORD
	TAD	OTEMP
	RAL			/SHIFT REST OF THE WAY
	AND	[7
	TAD	[260		/CONVERT TO ASCII
	JMS I	[PRINTC
	ISZ	OCNT
	JMP	OLOOP
	TAD	[240		/PRINT BLANK
	JMS I	[PRINTC
	JMP I	OCTOUT
ENDEXP,	JMS I	[BACK1		/END OF EXPR, PUT BACK CHAR
	TAD	LITRL		/LITERAL ?
	SZA CLA
	JMS I	(CRLIT		/GO CREATE LITERAL
	TAD	EXPSW		/DONT SKIP IF NO EXPRESSION
	SZA CLA
	JMP I	(BAD		/BECAUSE ITS AN ERROR
	TAD	LASTOP		/WAS THERE A TRAILING OPERATOR ?
	SNA
	JMP I	(OKEXP		/NO, JUST RETURN
	TAD	(-1		/WAS IT PLUS ?
	SNA
	TAD	XINCR		/AND IS IT LEGAL ?
	SNA CLA
	JMP I	(OKEXP		/YES TO BOTH
	JMP I	(BAD
	
/
/CODE TO CHANGE FROM LINC MODE TO PDP-8 MODE
/OR VICE-VERSA (PDP-8 MODE ASSUMED AT LOAD TIME)
/ALSO FIXES THE CODES  JMP, HLT, NOP, AND SKP
/THAT HAVE DIFFERENT VALUES DEPENDING ON THE MODE.
/175.3 USEC.
/
MODEL,	TAD	(LLST-1	/CALL TO CHANGE TO LINC MODE
	DCA	X13	/POINTER TO LIST OF LINC VALUES
	CLA CMA		/SET MODE SWITCH (-1 = LMODE)
	JMP	CMOVE	/DO THE THING
MODEP,	TAD	(PLST-1	/CALL FOR PMODE
	DCA	X13
CMOVE,	DCA	MODE	/0 = PMODE
	TAD	(-5
	DCA	VERS	/CONVENIENT DO-NOTHING LOCATION
	TAD	(LST-1	/LIST OF ADDRESSES
	DCA	X14
CLOOP,	TAD I	X14	/GET WHERE TO PUT
	DCA	OTEMP
	TAD I	X13	/GET WHAT TO PUT
	CDF 10
	DCA I	OTEMP	/...AND PUT IT
	CDF 0
	ISZ	VERS
	JMP	CLOOP
	JMP I	[NEXTST	/WE"RE OFF AND RUNNING
/
LLST,	0		/HLT
	16		/NOP
	467		/SKP
	6000		/JMP (VAL)
	LINCMR		/JMP (HANDLER CODE)
PLST,	7402
	7000
	7410
	5000
	PDPMR
LST,	KHLT
	KNOP
	KSKP
	KJMP
	KJMP2
/
DECX,	CLA IAC		/RADIX = DECIMAL
OCTALX,	DCA	RADIX	/RADIX = OCTAL
	JMP I	[NEXTST
	PAGE
LUNAME,	TAD	CHRPTR		/SAVE CHAR STUFF
	DCA	CPTMP
	TAD	NCHARS
	DCA	NCTMP
	JMS I	[GETNAM		/LOOK FOR NAME
	JMP I	EXPGET		/NONE, MIGHT BE EXPRESSION
	JMS I	[GETCHR		/LOOK FOR COMMA
	JMP	JSTONE		/ITS JUST ONE SYMBOL
	TAD	(-254		/COMMA TEST
	SZA
	JMP	TRYEQU		/NO COMMA, CHECK FOR EQUAL
	JMS I	[LOOKUP		/LOOK UP SYMBOL
	JMP	NEWLBL		/ITS COMPLETELY NEW
	SNA CLA
	JMP	DEFLBL		/ITS UNDEFINED
	TAD I	X10		/CHECK LOCCTR AGAINST OLD DEFINITION
	CIA
	TAD	LOCTR1		/FIRST UPPERR HALF
	SZA CLA
	JMP	.+6
	TAD I	X10
	CIA
	TAD	LOCTR2		/THEN LOWER HALF
	SNA CLA
	JMP	DEFIND
	JMS I	[ERMSG		/MULTIPLY DEFINED
	1504			/*MD*
	JMP I	(ASMBL		/FIELD IS OK
NEWLBL,	CLL CML RTL		/BUMP NEXT BY 2
	TAD	NEXT		/TO MAKE ROOM
	DCA	NEXT		/FOR NEW SYMBOL
DEFLBL,	ISZ I	LTEMP		/SET TYPE TO 1 (USER ADDR)
	TAD	MODE		/2 IF LMODE
	SPA CLA
	ISZ I	LTEMP		/...IT"S LMODE
	TAD	LOCTR1		/PUT LOCATION COUNTER
	DCA I	X10		/INTO VALUE
	TAD	LOCTR2
	DCA I	X10
DEFIND,	CDF	FLD0		/GO LOOK FOR ANOTHER TAG
	JMP I	(ASMBL
TRYEQU,	TAD	(-21		/CHECK FOR EQUAL SIGN
	SZA
	JMP	TRYBLK		/NO, TRY BLANK
	TAD	NAME1
	DCA	EQUN		/SAVE 6 CHARACTER NAME
	TAD	NAME2
	DCA	EQUN+1
	TAD	NAME3
	DCA	EQUN+2
	TAD	BUCKET
	DCA	EQUN+3
	JMS I	[EXPR		/GET VALUE RIGHT OF EQUALS
	JMP	EQUERR		/BAD EQU
	TAD	EXPTYP		/IS EXPR UNDEFINED ?
	SNA CLA
	JMP I	[NEXTST		/YES, LEAVE SYMBOL UNDEFINED
	TAD	EQUN		/RESTORE NAME
	DCA	NAME1
	TAD	EQUN+1
	DCA	NAME2
	TAD	EQUN+2
	DCA	NAME3
	TAD	EQUN+3
	DCA	BUCKET
	JMS I	[LOOKUP		/LOOKUP SYMBOL
	JMP	NEWSYM		/NEW SYMBOL
/	SNA
/	IAC			/REFNCD BUT UNDEF, ASSUME ADDR TYPE
/	CIA
/	TAD	EXPTYP		/COMPARE TYPES
/	SZA CLA
/	JMP	EQUERR		/TYPE CONFLICT
	CLA
MOV2WD,	TAD	EXPVAL+1	/D.P. OR ADDRESS SYMBOL
	DCA I	X10
	TAD	EXPVAL+2
	DCA I	X10
	TAD I	LTEMP		/NOW GET TYPE WORD
	AND	(7740		/ZERO OLD TYPE (PRESERVING FORCE BIT)
/	TAD	EXPTYP		/PUT IN NEW
	IAC			/***FORCE TYPE 1
	DCA I	LTEMP		/RESTORE WORD
	CDF	FLD0
	JMP I	[NEXTST		/GO GET NEXT STMT
EQUERR,	JMS I	[ERMSG		/BAD EQU
	0205			/*BE*
	JMP I	[NEXTST
NEWSYM,	ISZ	NEXT		/TWICE FOR DP AND ADDRESS
	ISZ	NEXT
	JMP	MOV2WD
TRYBLK,	TAD	(35		/CHECK FOR BLANK
	SZA CLA
	JMP I	EXPGET		/NO BLANK, GO TRY FOR EXPRESSION
JSTONE,	JMS I	[LOOKUP		/LOOKUP SYMBOL
	JMP I	(NEWONE		/ITS A NEW SYMBOL
	TAD	OPCTBL		/CREATE JUMP THRU TABLE
	DCA	OPCJMP		/SAVE IT
	TAD I	X10		/PICK UP FIRST WORD OF VALUE
	DCA	OPCODE		/ITS AN OPCODE-MAYBE?
	CDF	FLD0
OPCJMP,	0			/JUMP SOMEWHERE
OPCTBL,	JMP I	.+1
EXPGET,	GETEXP			/UNDEFINED
	GETEXP			/USER ADDRESS
	GETEXP			/*LINC USER ADDR
	EQUERR			/USER FP *****
	GETEXP			/PDP 8 OPERATE
	PSEUDO			/PSEUDO OP
	PDP8MR			/PDP8	MR
	LBTA		/LINC BETA CLASS
	LMR		/LINC MEM. REF.
/
/ROUTINE TO SET UP "LISTAPE-" PSEUDO-OP
LTPE,	JMS I	[EXPR	/FIRST SCAN OFF THE REST OF THE LINE, IF ANY
	JMP I	[NEXTST		/IF NONE
	TAD	EXPVAL+2	/GET ARG
	SPA CLA		/LISTAPE (-) ONLY
	CLA CMA
	TAD	PASSNO
	SZA CLA		/PASS 1 ONLY
	JMP I	[NEXTST		/IF + OR NOT PASS 1
	TAD	LISTNP		/GET PATCH WORD
	DCA I	(PATCHL
	JMP I	.+1
	LTPRT2		/PART TWO...
LISTNP,	PATCH?377+5000		/"JMP PATCH" IN DISGUISE
/
	PAGE
/THE "ALL THE JUNK THAT DIDN"T FIT ANYPLACE ELSE" PAGE
NEWONE,	DCA I	NEXT		/RESERVE 2 WORDS
	DCA I	NEXT		/THUS ASSUMING ADDR TYPE
	CDF	FLD0
GETEXP,	TAD	CPTMP		/RESTORE CHARACTER POINTER
	DCA	CHRPTR
	TAD	NCTMP		/TO JUST AFTER TAG (IF ANY)
	DCA	NCHARS
	JMS I	[EXPR		/TRY FOR AN EXPRESSION
	JMP	BADEXP		/IF NONE, ERROR
/	CLL CMA	RAL
/	TAD	EXPTYP		/CHECK TYPE
/	SNA
/	JMP	BADEXP	/D.P.
/	SPA CLA
	CLA
	JMP	OUT1WD		/ADDRESS, OUTPUT 1 WORD
/OUT3WD,	JMP	BADEXP	/F.P.
/OUT2WD,	JMP	BADEXP	/D.P.
OUT1WD,	TAD	EXPVAL+2
	JMS I	[OUTWRD
	JMP I	[NEXTST		/GO DO NEXT STMT
BADEXP,	JMS I	[ERMSG		/BAD EXPRESSION
	0230
	JMP I	[NEXTST		/DO NEXT STMT
PSEUDO,	JMP I	OPCODE		/GO HANDLE PSEUDO OP
/
PRNTLN,	0			/PRINT THE LINE
	TAD	OUTSWT		/HAS THE LINE BEEN PRINTED YET?
	SZA CLA
	JMP I	PRNTLN		/YES, COOL IT
	ISZ	OUTSWT		/SET SWITCH
	TAD	[LINE-1		/POINTER TO LINE
	DCA	X10
	TAD I	X10		/GET A CHAR
	JMS I	[PRINTC		/PRINT IT
	ISZ	LINSIZ		/BUMP COUNT
	JMP	.-3
	JMP I	PRNTLN
GETUNT,	0			/GET UNIT FOR CHAIN
	JMS I	[GETCHR		/IS ANYTHING THERE ?
	JMP	NOUNIT		/TREAT IT AS UNIT 0
	JMS I	[BACK1		/PUT BACK EXPR CHAR
	JMS I	[ADRGET		/GET UNIT EXPR
	TAD	EXPVAL+2
/	TAD	(-10		/CHECK RANGE
/	SMA			/CHECK RANGE
/	JMP I	(CHERR		/TOO BIG
/	TAD	(10
	SPA
	JMP I	(CHERR		/TOO SMALL
NOUNIT,	DCA I	(UNIT		/SAVE UNIT
	JMP I	GETUNT		/RETURN
	
GETCN,	0			/RETURN NEXT CHAR OR 77
	JMS I	[GETCHR		/GET CHAR
	JMP I	(CHERR		/NONE, GIVE ERROR
	TAD	(-242		/IS IT "
	SNA
	JMP	ISQ		/YES
	TAD	(242		/FIX CHAR
	AND	[77
	JMP I	GETCN		/RETURN IT
ISQ,	JMS I	[BACK1		/PUT BACK "
	TAD	[77		/RETURN 77
	JMP I	GETCN	
/
/RING BUFFER CODE
/KINDLY NOTE THAT BUFFER LENGTH MUST BE A
/POWER OF TWO AND STARTING ADDRESS OF BUFFER
/MUST BE DIVISIBLE BY ITS LENGTH...
/OR THIS JUST AINT GONNA WORK, FOLKS.
/
PUT,	0			/ENTER WITH CHAR IN AC
	DCA	PTEMP		/COOL YOUR JETS, FRIEND
	TAD	COUNTR		/WHILE WE LOOK AROUND
	SNA		/CHECK FOR BUFFER EMPTY
	JMP	.+6		/WHICH IS A SPECIAL OK CASE
	AND	BUFAND		/THIS GIVES AC=0
	SZA CLA			/IF BUFFER IS FULL
	JMP	.+3		/STILL ROOM
	JMS	CHECK		/NO ROOM, GOT TO TAKE ONE OUT
	JMP	PUT+2		/TRY AGAIN
	TAD	PTEMP		/REGET CHAR
	DCA I	INP		/PUT IN BUFR
	TAD	INP		/NOW THE HASSLE...
	IAC			/WHEN WE GET TO END OF BUFR
	AND	BUFAND		/THIS RESETS US...
	DCA	INP		/GROOVY.
	ISZ	COUNTR		/KEEP UP-TO-DATE
	JMP I	PUT
/
CHECK,	0			/TRY TO PRINT SOMETHING
	TAD	COUNTR
	SNA CLA			/ANYTHING THERE?
	JMP I	CHECK		/NOPE
IOTCHK,	TSF			/THIS BECOMES LSF IF LPT
	JMP I	CHECK		/DEVICE BUSY
GETC,	CLA CMA			/-1
	TAD	COUNTR		/DEVICE IDLE!
	DCA	COUNTR		/SO BUMP DOWN COUNT
	TAD I	OUTP		/GET A CHAR
	JMS I	PC		/PC=TTY OR LPT HANDLER, DEPENDING
	CLA IAC			/+1
	TAD	OUTP		/CHECK WRAP-AROUND
	AND	BUFAND		/?
	DCA	OUTP		/WHATEVER THE VERDICT, ITS OK NOW
	JMP I	CHECK
PC,	TTY
INP,	FIRST
OUTP,	FIRST
BUFAND,	-400-1
COUNTR,	0
PTEMP,	0
	FIRST=4000
/
/A COUPLE OF WAYWARD PARAMETER LISTS...THEY CAN GO ANYWHERE
PAR2,	111
	USEB
USEBLK,	57
	1
/
PAR3,	100
	36			/INTO 17000
SYSBLK,	22
	2
/
/NOW FOR PART TWO OF OUR THRILLING ADVENTURE...
LTPRT2,	JMS I	DIALRD	/GET THE OLD BIT MAP
	PAR7		/DIFFICULT HOLE...
	TAD	(-41
	DCA	PUT	/TEMPORARY TEMPORARY
	TAD	(USETBL-1
	DCA	CHECK	/TEMPORARY TEMPORARY
	TAD	(6737
	DCA	GETCN	/TEMPORARY TEMPORARY
QQQQQQ,	TAD I	GETCN
	DCA I	CHECK
	ISZ	GETCN
	ISZ	CHECK
	ISZ	PUT
	JMP	QQQQQQ
	JMP I	[NEXTST
PAR7,	111
	15
	57		/*6400
	1
	PAGE
PDP8MR,	JMS	CHKIND		/CHECK FOR INDIRECT
	JMP	.+4		/NO
	TAD	OPCODE		/PUT INDIRECT INTO OPCODE
	TAD	(400
	DCA	OPCODE
	JMS	ADRGET		/PICK UP ADDRESS FIELD
	TAD	EXPVAL+2	/CHECK PAGE OF ADDRESS
	AND	[7600
	SNA
	JMP	PAGE0		/ITS IN PAGE 0
	CIA
	TAD	LOCTR2		/COMPARE WITH CURRENT PAGE
	AND	[7600
	SNA CLA
	JMP	THSPAG		/OK, ITS THIS PAGE
	TAD	OPCODE		/CAN WE USE A LINK ?
	AND	(400		/IS INDIRECT BIT ON ?
	SNA CLA
	JMP	MAKLNK		/YES, GO MAKE LINK
	JMS I	[ERMSG		/NOPE, ITS AN ILLEGAL REFERENCE
	1122			/*IR*
	TAD	(7402
	JMP	AAA		/*PUT HLT FOR IR
MAKLNK,	JMS I	(CRLINK		/YES, CREATE LINK
THSPAG,	TAD	EXPVAL+2	/GET ADDRESS
	AND	[177		/LOWER 7 BITS
	TAD	[200		/PUT IN PAGE BIT
	SKP
PAGE0,	TAD	EXPVAL+2	/GET ADDRESS (UPPER 5 BITS ZERO)
	TAD	OPCODE		/PLUS OPCODE
AAA,	JMS I	[OUTWRD		/OUTPUT WORD
	JMP I	[NEXTST
XITEMP,	
CHKIND,	0			/CHECK FOR "I"
	TAD	CHRPTR		/SAVE CHAR POSITION
	DCA	CPTMP
	TAD	NCHARS
	DCA	NCTMP
	JMS I	[GETNAM		/LOOK FOR NAME "I"
	JMP I	CHKIND		/IF NO NAME, NO INDIRECT
	TAD	BUCKET		/DID IT START WITH "I"?
	TAD	(-11
	SZA CLA
	JMP	NOTIND		/NO, GO AWAY
	TAD	NAME1		/WAS "I" ENTIRE NAME?
	SZA CLA
	JMP	NOTIND		/NO, GO AWAY
	ISZ	CHKIND		/YES, SKIP ON RETURN
	JMS I	[GETCHR		/LOOK FOR BLANK
	JMP I	CHKIND		/NONE LEFT, RETURN
	TAD	[-240
	SZA CLA
	JMS I	[BACK1		/NOT BLANK, BACKUP
	JMP I	CHKIND		/RETURN
NOTIND,	TAD	CPTMP		/RESET CHAR POSITION
	DCA	CHRPTR
	TAD	NCTMP
	DCA	NCHARS
	JMP I	CHKIND		/RETURN, NO SKIP
ADRGET,	0			/GET ADDRESS EXPR AND CHECK TYPE
	JMS I	[EXPR		/GET EXPR
	NOP		/***
/	CLA CLL CMA RAL		/MUST BE TYPE 1 OR 0 (ADR OR UND)
/	TAD	EXPTYP
/	SPA SNA CLA
	CLA
	JMP I	ADRGET
ERR1,	JMS I	[ERMSG		/BAD ADDR EXPR
	0230			/*BX*
	DCA	EXPVAL+1	/SET EXPR TO 0
	DCA	EXPVAL+2
	JMP I	ADRGET
/
/COME HERE TO HANDLE LINC MEMORY REFERENCE
/(ADD, JMP, STC)
LMR,	JMS	ADRGET		/*GET ADDRESS EXPRESSION
	TAD	EXPVAL+2
	AND	(1777		/TRUNCATE TO 10 BITS
ADDOP,	TAD	OPCODE
	JMS I	[OUTWRD		/STORE THIS NOW
	JMP I	[NEXTST		/EXIT
LBTA,	JMS	CHKIND		/COME HERE FOR LDA I B TYPES
	JMP	.+4
	TAD	OPCODE		/PUT IN I BIT
	TAD	(20		/= 20 IN LINC MODE
	DCA	OPCODE
	JMS	ADRGET		/GET THE "BETA" PART
	TAD	EXPVAL+2
	AND	[17		/TRUNCATE TO 4 BITS
	JMP	ADDOP		/PUT IN REST
/
ANALEX,	0			/ANALEX PRINTER HANDLER
	DCA	ACHR
	TAD	ACHR		/LINE FEED?
	TAD	(-212
	SNA CLA
	JMP I	ANALEX		/YES,IGNORE IT
	6661			/WAIT FOR PRINTER
	JMP	.-1
	6652			/CLEAR FLAG
	TAD	ACHR		/GET CHAR BACK
	TAD	(-215		/END LINE ON CR
	SNA
	JMP	FINLPB
	IAC			/CHECK FOR FORM
	SNA CLA
	JMP	FINLPB-1	/PAGE EJECT ON FORM
	TAD	ACHR		/PRINT CHAR
	6654
	CLA
	JMP I	ANALEX
	TAD	[7		/SET CONTROL
FINLPB,	TAD	(10
	6664
	CLA
	JMP I	ANALEX
TTY,	0
	TSF
	JMP	.-1
	TLS
	CLA
	JMP I	TTY
/
	CHAIN "LINO18B"UB