PDP-10 Archive: tatsub.mac from bb-k345a-sb

Trailing-Edge - PDP-10 Archives - bb-k345a-sb - tatsub.mac

There are 6 other files named tatsub.mac in the archive. Click here to see a list.

	TITLE	TATSUB - SUBROUTINES FOR TATTLE V2 AND FORTRAN-10
	SUBTTL	SYMINT -  LOADS A SYMBOL TABLE INTO CORE
	ENTRY SYMSRC,SYMINT

SYMINT:	SKIPN	1,@(16)
	MOVE	1,[SIXBIT /SYSTEM/]
	CAMN	1,NAME
	POPJ P,
	MOVEM	1,NAME
	SETZM	SYMFIL		;FLAG NO SYMBOL TABLE IN CORE
REINIT:	INIT 0,17
DEV1:	SIXBIT/DSK/
	0
	  JRST	E.INIT
	SETZM	NAME+3
	LOOKUP NAME
	  JRST	E.LOOK		;ASK FOR FILE NAME
	SKIPE	3,OJOBFF
	JRST	.+3
	MOVE	3,.JBFF##
	MOVEM	3,OJOBFF
	HRRM	3,CL1
	SOS CL1
	ADDI	3,200
	CAMG	3,.JBREL##
	JRST .+3
	CORE	3,
	  JRST	E.CORE
	INPUT CL1
	MOVE 3,OJOBFF
	HRRZ 1,116(3)
	JUMPE	1,E.SYMT
	HLRO 2,116(3)
	MOVNS 2
	ADD 3,2
	MOVEM 3,.JBFF##
	CORE 3,
	  JRST	E.CORE
	MOVE	4,1(16)		;GET FNAME ADDR
	MOVE	0,DEV1
	MOVEM	0,0(4)
	MOVE	0,NAME		;GET FILNAME USED
	MOVEM	0,1(4)
	HLLZ	0,NAME+1
	MOVEM	0,2(4)

	MOVE 4,1
	IDIVI 4,200
	USETI 1(4)
	INPUT CL1
	MOVE 4,OJOBFF
	ADDI 4,177
	SUB 4,5
	JUMPE 5,NOBLT
	MOVE 6,OJOBFF
	ADD 6,5
	HRLS 6
	HRR 6,OJOBFF
	BLT 6,(4)
NOBLT:	HRRM 4,CL2
	SUBI 5,200
	ADD 5,2
	MOVNS 5
	HRLM 5,CL2
	INPUT CL2
	RELEASE 0
	MOVE 4,OJOBFF
	ADD 4,2
	SOS 4
	MOVEM 4,SYMST
	SETOM	SYMFIL		;FLAG SYMBOL TABLE SETUP
	POPJ P,

OJOBFF:	0
SYMST:	0
CL1:	IOWD 200,.-.
	0
CL2:	0
	0
NAME:	0
	SIXBIT/XPN/
	0
	0

E.INIT:	OUTSTR	[ASCIZ /?CANT INIT /]
	JSA	16,KLU67	;GET DEVICE THAT FAILED
	EXP	DEV1
	EXP	AZNAM
	JRST	RETRY		;GET NEW AND TRY AGAIN
E.LOOK:	OUTSTR	[ASCIZ	/?LOOKUP FAILURE ON /]
ERRFIL:	JSA	16,KLU67	;DEVICE
	EXP	DEV1
	EXP	AZNAM
	OUTSTR	AZNAM
	MOVEI	CH,":"
	OUTCHR	CH
	JSA	16,KLU67	;GET FILE NAME IN ASCII
	EXP	NAME
	EXP	AZNAM
	OUTSTR	AZNAM
	MOVEI	CH,"."		;DOT FOR EXT
	OUTCHR	CH
	JSA	16,KLU67
	EXP	NAME+1		;EXTENSION
	EXP	AZNAM
RETRY:	OUTSTR	AZNAM
	OUTSTR	[ASCIZ	/
WHERE IS EXPANDED FILE? /]
	JSA	16,KLUNAM	;GET NEW FILE NAME
	EXP	DEV1		;STORE DEVICE THERE
	EXP	NAME
	SKIPN	NULFLG	;NULL RESPONSE?
	JRST	REINIT		;TRY AGAIN
	SETZM	SYMFIL		;YES, USE NO SYMBOLS
	POPJ	17,0

E.SYMT:	OUTSTR	[ASCIZ	/?CANT FIND SYMBOL TABLE IN /]
	JRST	ERRFIL
SYMFIL:	0
AZNAM:	0
	0

E.CORE:	OUTSTR	[ASCIZ	/?INSUFFICIENT CORE TO READ /]
	JSA	16,KLU67
	EXP	NAME
	EXP	AZNAM
	OUTSTR	AZNAM
	MOVEI	CH,"."
	OUTCHR	CH
	JSA	16,KLU67
	EXP	NAME+1
	EXP	AZNAM
	OUTSTR	AZNAM
	OUTSTR	[ASCIZ	/ SYMBOL TABLE
/]
	SETZM	SYMFIL		;FLAG NO SYMBOL TABLE
	POPJ	17,0

	SUBTTL	SYMSRC - SEARCHES SYMBOL TABLE LOADED BY SYMINT

;CALLING SEQUENCE
;	CALL SYMSRC(ADDR, GLOBAL, LOCAL, VALUE)
;ADDR IS INPUT
;GLOBAL IS MODULE NAME CONTAINING ADDR
;LOCAL IS HIGHEST VALUED SYMBOL WITH VALUE LESS OR EQUAL ADDR
;VALUE IS VALUE OF LOCAL

SYMSRC:	HRRZ	10,@(16)	;PICK UP SEARCH ADDRESS
	SKIPN	SYMFIL		;DO WE HAVE A SYMBOL TABLE?
	JRST	SYMERR		;NO, RETURN BLANKS
	SETZ 7,
	MOVE 6,SYMST		;END OF SYMBOL TABLE
LOOP1:	HRRZ (6)		;ADDR OF THIS MODULE
	CAMLE	10
	JRST FND1		;MUST BE IN PRECEDING MODULE
	MOVE 7,6		;SAVE THIS MODULE ADDRESS IN TABLE
	HLRO 1,(6)		;LENGHT OF MODULE'S TABLE
	ADD 6,1		;POINT 6 TO NEXT MODULE TABLE
	HLRZ (6)		;CHECK POINTER TO NEXT
	JUMPN LOOP1		;IF ANY FOUND, LOOK IN IT
	JUMPN 7,FND1		;NO NEXT. IF LAST, LOOK THERE
SYMERR:	HRRZ 1,1(16)		;OTHERWISE , RETURN BLANK
	MOVE [ASCII/     /]
	MOVEM (1)
	MOVEM 1(1)
SYMER1:	HRRZ 1,2(16)
	MOVE [ASCII/     /]
	MOVEM (1)
	MOVEM 1(1)
	MOVEM	10,@3(16)
	POPJ	17,0

FND1:	JUMPE 7,SYMERR
	HLRE	6,(7)		;LENGHT OF MODULE'S SYMBOL TABLE
	JUMPGE	6,SYMERR
	MOVE -1(7)		;GET NAME (RADIX50)
	JSP 2,R50
	HRRZ 2,1(16)
	MOVEM 11,(2)
	MOVEM 12,1(2)
	SETO	4,
LOOP2:	HRRZ 5,(7)
	JUMPE 6,FND2
	SUBI 7,2
	ADDI 6,2
	CAMG 5,10
	CAMG 5,4
	JRST LOOP2
	MOVEI 3,1(7)
	MOVE 4,5
	JRST LOOP2

FND2:	JUMPL	4,SYMER1
	MOVE (3)
	JSP 2,R50
	HRRZ 2,2(16)
	MOVEM 11,(2)
	MOVEM 12,1(2)
	HRRZ	1(3)
	MOVEM	@3(16)
	POPJ	17,0

R50:	SETZB 11,12
	MOVE 13,[POINT 7,11]
	MOVEI 14,6
	TLZ 740000
LOOP3:	IDIVI 50
	JUMPE 1,R5BLNK
	CAIN 1,46
	JRST R5$
	CAIN 1,47
	JRST R5%
	CAIN 1,45
	JRST R5.
	CAIGE 1,13
	JRST R5NUMB
	ADDI 1,266
R51:	PUSH 17,1
	SOJG 14,LOOP3
	MOVEI 14,6
LOOP4:	POP 17,1
	IDPB 1,13
	SOJG 14,LOOP4
	JRST (2)

R5BLNK:	MOVEI 1,240
	JRST R51
R5$:	MOVEI 1,244
	JRST R51
R5%:	MOVEI 1,245
	JRST R51
R5.:	MOVEI 1,256
	JRST R51
R5NUMB:	ADDI 1,257
	JRST R51

P==17
CH==0
N==1
N1==2

	ENTRY	FILNAM

;READ A DEV:FILE.EXT[P,PN] FROM TTY

KLUNAM:	0
	PUSHJ	17,FILNAM
	JRA	16,2(16)
FILNAM:	SETZM	NULFLG		;ASSUME NON-NULL RESPONSE
	PUSHJ	P,SIXBN
	JUMPGE	CH,.+2		;IF TERM NOT BREAK, OK
	JUMPE	N,NULRET	;ELSE, IF NO NAME, RETURN NULL
	CAIE	CH,":"
	JRST	NODEV		;NOT A NEW DEVICE
	MOVEM	N,@(16)		;RETURN NEW DEVICE NAME
	PUSHJ	P,SIXBN		;AND COLLECT NEXT WORD
NODEV:	JUMPE	N,.+2		;DON'T STORE ZERO
	MOVEM	N,@1(16)	;SAVE NAME
	CAIE	CH,"."		;CHECK FOR EXT SPECIFIED
	JRST	FILPPN		;NO, LOOK FOR PPN
	PUSHJ	P,SIXBN
	TRZ	N,-1		;THREE CHARS ONLY
	MOVE	N1,1(16)	;PICK UP NAME ADDR
	MOVEM	N,1(N1)		;SAVE EXT AFTER IT
	JUMPL	CH,RETNAM	;IF EOL, RETURN
FILPPN:	CAIE	CH,"["		;IS THERE A PPN?
	JRST	EOLCHK		;NO, CHECK FOR BREAK TERMINATOR
	PUSHJ	P,OCTN		;COLLECT PROJECT
	MOVEI	N1,(N)		;SAVE IT
	CAIE	CH,","		;CHECK ITS A COMMA
	JRST	WHAT		;SOMETHINGS WRONG
	PUSHJ	P,OCTN		;GET PROGRAMMER
	HRLI	N,(N1)		;COMBINE
	MOVE	N1,1(16)	;GET ENTER BLOCK ADDR
	MOVEM	N,3(N1)		;STORE PPN
	CAIN	CH,"]"		;CHECK TRAILING BRACKET
	PUSHJ	P,INCH		;ELSE PICK UP BREAK CHAR
EOLCHK:	JUMPGE	CH,WHAT		;ASK AGAIN IF NOT <CR>
RETNAM:POPJ	17,0

WHAT:	OUTSTR	[ASCIZ	/?WHAT?
/]
	PUSHJ	P,INCH		;SEARCH FOR END OF LINE
	JUMPGE	CH,.-1
	JRST	FILNAM+1	;THEN ASK AGIAN

NULRET:	SETOM	NULFLG		;FLAG NULL RESPONSE
	POPJ	17,0

NULFLG:	0

SIXBN:	SETZ	N,		;CLEAR RESULT
	MOVE	N1,[POINT 6,N]
SIXBL:	PUSHJ	P,INCH
	CAIL	CH,"0"
	CAILE	CH,"Z"
	POPJ	P,
	CAIGE	CH,"A"
	CAIG	CH,"9"
	JRST	.+2
	POPJ	P,
	SUBI	CH,40		;CONVERT TO SIXBIT
	TLNE	N1,(77B5)	;WORD FULL?
	IDPB	CH,N1		;NO, STORE ANOTHER CHAR
	JRST	SIXBL

OCTN:	SETZ	N,		;CLEAR ACCUMULATOR
OCTL:	PUSHJ	P,INCH
	CAIL	CH,"0"
	CAILE	CH,"7"		;IS IT AN OCTAL DIGIT?
	POPJ	P,
	LSH	N,3		;YES, SHIFT LEFT FOR IT
	ANDI	CH,7		;STRIP EXTRA BITS
	ADD	N,CH
	JRST	OCTL		;GET NEXT

INCH:	INCHWL	CH		;GET A CHAR
	CAIN	CH,15		;CR WILL BE FOLLOWED BY LF
	JRST	INCH		;SO USETHAT AS TERMINATOR
	CAIL	CH,140		;CHECK FOR LOWER CASE
	TRZ	CH,40		;AND FORCE UPPER
	CAIL	CH,12		;LOOK FOR BREAKS
	CAILE	CH,15
	CAIN	CH,33		;INCLUDING ALTMODE
	SETO	CH,		;SET BREAKS NEGATIVE
	POPJ	P,

	SUBTTL	MINOR UTILITIES

	ENTRY RHIST,RHISTN,TRAN67,TRAN6B

KLU67:	0
	PUSHJ	17,TRAN67
	JRA	16,2(16)
TRAN6B:	MOVSI	(JFCL)		;SET TO STORE BLANKS
	JRST	TRAN
TRAN67:	MOVE	[JUMPE BHJ]	;SET TO STORE NULLS
TRAN:	MOVEM	BHAN
	HRRZ	1,(16)
	HRLI	1,(<POINT 6>)
	HRRZ	2,1(16)
	HRLI	2,(<POINT 7>)
	MOVEI	3,6
LOOP67:	ILDB	1
BHAN:	JUMPE	.+2
	ADDI	40
BHJ:	IDPB	2
	SOJG	3,LOOP67
	IDPB	3,2		;STORE TRAILING NULL
	POPJ	17,0

RHISTN:				;HISTOGRAM FILE
	MOVE	1,[XWD -3,[	POINT 6,HIST+1,17
				POINT 6,HIST+1,11
				POINT 6,HIST+1,5	]]
RHISTL:	LDB	2,0(1)		;GET LOW ORDER CHARACTER FROM EXT
	CAIL	2,'0'
	CAILE	2,'9'		;IS IT NUMERIC?
	MOVEI	2,'0'-1		;NO, MAKE IT SO
	AOJ	2,		;INCREMENT IT
	DPB	2,0(1)		;STORE AWAY
	CAIG	2,'9'		;IF NO CARRY,
	JRST	RHNXIT		;QUIT NOW
	MOVEI	2,'0'		;OTHERWISE, RESET TO ZERO
	DPB	2,0(1)
	AOBJN	1,RHISTL	;AND CARRY TO NEXT DIGIT
	SETZM	CYCFLG		;UNLESS 999, IN WHICH CASE WE LOOSE
	POPJ	17,0

RHNXIT:	SETOM	CYCFLG		;ENABLE AUTOMATIC NAME SELECTION
	POPJ	17,0

RHIST:	HRRZ (16)
	SOS
	HRRM CL
	MOVN @1(16)
	HRLM CL
	SKIPE	CYCFLG		;ENABLED FOR AUTOMATIC NEXT FILE?
	JRST	RHNAME		;YES, DO NOT ASK FOR NAME, IT'S ALREADY THERE
	MOVE	1,[SIXBIT /MONITR/]
	MOVEM	1,HIST		;AS GOOD A DEFAULT NAME AS ANY
	MOVSI	1,'HST'		;DEFAULT EXTENSION
	MOVEM	1,HIST+1
HISTFL:	OUTSTR	[ASCIZ	/HISTOGRAM FILE: /]
	JSA	16,KLUNAM
	EXP	DEV2
	EXP	HIST
	SKIPE	NULFLG		;ANY INPUT GIVEN?
	JRST	NOMORE		;NO, RETURN ZERO TO STOP
RHNAME:	MOVE	1,2(16)
	MOVE	HIST
	MOVEM	0(1)
	HLLZ	HIST+1
	MOVEM	1(1)
INIT2:	INIT 17
DEV2:	SIXBIT/DSK/
	0
	  JRST	E.INT2
	LOOKUP	HIST
	  JRST	E.LOK2
	INPUT CL
	RELEAS
	SETZM	CYCFLG		;MUST GENERATE NEW NAME TO DO AUTO AGAIN
	POPJ	17,0

E.INT2:	OUTSTR	[ASCIZ	/?CANT INIT
/]
	JRST	HISTFL
E.LOK2:	OUTSTR	[ASCIZ	/?CANT LOOKUP
/]
	JRST	HISTFL
NOMORE:	SETZM	@(16)
	SETZM	CYCFLG		;JUST PRECAUTION
	POPJ	17,0

HIST:	SIXBIT	/MONITR/
	SIXBIT/HST/
	0
	0
	0
CL:	.-.
	0
CYCFLG:	0

	ENTRY	STCODE
STCODE:	HRRZ	2,(16)		;ADDRESS OF STATES ARRAY
	HRLI	2,-^D32		;LENGTH OF IT
	SETZ	3,
STLOOP:	MOVEI	1,25		;GETTAB CODE FOR STATES TABLE
	HRLI	1,(3)		;DESIRED TRPILET
	GETTAB	1,
STRET:	POPJ	17,0
	MOVEI	4,3		;CODES PER TABLE WORD
STLUP2:	SETZ	0,
	LSHC	0,6		;GET CHAR IN 0
	ADDI	0,40		;MAKE ASCII
	DPB	0,PNT1
	SETZ	0,
	LSHC	0,6		;GETSECOND OF PAIR
	ADDI	0,40
	DPB	0,PNT2
	AOBJP	2,STRET		;QUIT AT END OF ARRAY
	SOJG	4,STLUP2	;OR GET ANOTHER PAIR
	AOJA	3,STLOOP	;OR A TRIPLET

PNT1:	POINT	7,(2),6
PNT2:	POINT	7,(2),13

	END