/ PRINT OUT MEMORY MAP
/
/ CLYDE G. ROBY, JR.
/ DEPARTMENT OF MEDICINE
/ WEST VIRGINIA UNIVERSITY
/ MORGANTOWN, WEST VIRGINIA
/ APRIL, 1972

FIELD 1

*2000

	CLA CLL
	TAD (TYPEXX)
	DCA OUTIT	/SET UP OUTPUT FOR TTY
	JMS TYPMESS	/TELL USER WHO WE ARE
	  MAPVER
	JMS CRLF
	TAD (XXPUT)
	DCA OUTIT	/RESET FOR STANDARD OUTPUT

START,	JMS I (SETUP)	/SET UP FOR COMMAND DECODER
	  0216		/ASSUMED INPUT FILE IS .BN
	  EOFILE	/END OF FILE ROUTINE
	STL CLA RTR	/2000 TO ACC
	AND I (MPARAM+2)/CHECK FOR /Z OPTION
	SNA CLA
	TAD (10)	/MAKE A 'SNA CLA' INSTR
	TAD SZACLA
	DCA I (ZSWITC)	/PUT IN 'MAPWD' ROUTINE
	STA
	DCA 10		/INITIALIZE PTR WITH 0
	TAD (-6000)
	DCA CTR
	CDF 00
STLP1,	DCA I 10	/CLEAR CORE MAP
	ISZ CTR
	JMP STLP1
	CDF 10		/BACK TO OUR FIELD
	TAD (-10)
	DCA CTR
	TAD (TFIELD-1)
	DCA 10
STLP3,	DCA I 10	/ZAP FIELD CONTAINMENT TABLE
	ISZ CTR
	JMP STLP3
	STA
	DCA OLDFLD	/SOMETHING ILLEGAL FOR FAIL-SAFE

LOADER,	DCA CHKSUM	/ZAP CHECKSUM
	DCA XFIELD	/ASSUME START FIELD IS ZERO
	TAD (200)
	DCA ORIGIN	/ASSUME START LOC IS 0200
GETBIN,	JMS I (XXGET)	/GET A CHAR
	SNA
	JMP GETBIN	/IGNORE FIRST ZEROES
	TAD (-200)	/LOOK FOR LEADER CODE
SZACLA,	SZA CLA
	JMP LOADER+1	/IIGNORE OTHER GARBAGE
LEADER,	JMS I (XXGET)
	SNA
	JMP GETBIN	/IGNORE MORE ZEROES
	TAD (-200)
	SNA
	JMP LEADER	/IGNORE FURTHER LEADER CODE
NEWWD,	SMA
	JMP FIELDW	/IS A FIELD SPECIFICATION
	TAD (200)	/GENERATE PART OF ORG OR DATA WORD
	DCA WD1
	JMS I (XXGET)	/ANOTHER PART OF WORD
	DCA WD2
	JMS I (XXGET)	/GET NEW ONE
	TAD (-200)
	SNA
	JMP ITSOVR	/TRAILER CODE AT END
	DCA WD
	JMS ASSEMB	/ASSEMBLE A BINARY WORD
	SNL
	JMP DATAWD	/IS A DATAWORD
	DCA ORIGIN	/SAVE NEW ORIGIN
	JMP GETNXT
DATAWD,	STA
	JMS MAPWD	/GO MAP THE WORD IN MEMORY
	ISZ ORIGIN
	NOP
GETNXT,	TAD WD1
	TAD WD2
	TAD CHKSUM
	DCA CHKSUM	/UPDATE THE CHECK SUM
	TAD WD
	JMP NEWWD	/CHECK NEW WORD

ITSOVR,	JMS ASSEMB	/ASSEMBLE THE CHECK SUM
	CIA
	TAD CHKSUM	/EQUAL TO OUR CHECK SUM?
	SZA CLA
	JMP BADCK	/NO, IS BAD ERROR
	JMP LOADER	/YES, NOW LOAD ANOTHER FILE

CTR,	0
CHKSUM,	0
WD,	0
WD1,	0
WD2,	0

PAGE
/ END OF FILE HAS OCCURRED
/ NOW TO PRINT OUT BIT MAP

EOFILE,	JMS ECHECK	/HOW DOES HE WANT THE OUTPUT?
	DCA XFIELD	/START WITH FIELD 0
	TAD (-10)
	DCA ECTR1	/8 FIELDS TO CHECK
EOF2,	TAD XFIELD
	TAD (TFIELD)	/POINTS TO FIELD CONTAINMENT TABLE
	DCA EPTR	/SAVE POINTER
	TAD I EPTR	/ANYTHING ASSIGNED TO FIELD?
	SNA CLA
	JMP EOF3	/NO, SKIP IT
	DCA ORIGIN	/YES, START AT LOC 0
EOF5,	JMS MAPWD	/WAS THIS LOC MAPPED?
	JMP EOF4	/YES, SOMETHING IN FIELD WAS MAPPED
	ISZ ORIGIN	/INCREMENT LOC
	JMP EOF5
EOF3,	ISZ XFIELD	/END OF FIELD, INCREMENT
	ISZ ECTR1	/ALL CHECKED?
	JMP EOF2	/NO, DO IT
EOFOUT,	JMS CRLF
	JMS CRLF
	JMS I (XXCLOSE)
	JMP START	/YES, START OVER AGAIN

EOF4,	JMS CRLF	/SOMETHING IN FIELD
	JMS TYPMESS
	  FIELDM	/"FIELD "
	TAD XFIELD
	TAD ("0)
	JMS I (XXPUT)	/OUTPUT FIELD NO.
	JMS CRLF
	JMS CRLF

	DCA ORIGIN	/ZAP LOC TO 0
OMAP0,	TAD (-100)
	DCA ECTR2	/100(8) WORDS ACROSS PAGE
OMAP1,	JMS MAPWD	/IS THIS WORD ASSIGNED?
	JMP OMAP2	/YES, OUTPUT A LINE
	ISZ ORIGIN
	NOP
	ISZ ECTR2
	JMP OMAP1
	TAD I (MPARAM)	/CHECK FOR OPTION SWITHC /F
	AND (100)
	SZA CLA
	JMP OMAP12	/YES, DO NOT OUTPUT ORIGIN
	TAD XFIELD
	TAD ("0)
	JMS I (XXPUT)	/OUTPUT 5 DIGIT ADDRESS
	TAD (-100)
	TAD ORIGIN
	JMS OCTOUT	/OUTPUT THE CURRENT ORG
OMAP10,	JMS CRLF	/END OF A LINE
	TAD ORIGIN
	AND (177)
	SNA CLA
	JMS CRLF	/END OF A PAGE, EXTRA CR/LF
OMAP12,	TAD ORIGIN
	SNA CLA
	JMP EOF3	/DONE WITH THIS FIELD
	JMP OMAP0	/NOT DONE, CHECK NEXT 100 WDS

OMAP2,	TAD ORIGIN
	AND (7700)	/BACK TO BEGINNING OF LINE
	DCA ORIGIN
	TAD XFIELD
	TAD ("0)
	JMS I (XXPUT)	/OUTPUT FIELD FOR 5 DIGIT ORG
	TAD ORIGIN
	JMS OCTOUT	/OUTPUT THE ORIGIN
	JMS CRSP	/CRLF OR SPACES?
	TAD (-100)
	DCA ECTR2	/100(8) WORDS ACROSS PAGE
OMAP3,	JMS MAPWD	/WAS THIS WORD ASSIGNED?
	CLA IAC		/YES, OUTPUT A '1'
	TAD ("0)	/NO, OUTPUT A '0'
	JMS I (XXPUT)
	ISZ ORIGIN	/INCREMENT LOC
	JMP .+4
	JMS CRLF
	JMS CRLF
	JMP EOF3	/END OF FIELD
	ISZ ECTR2	/END OF LINE?
	SKP
	JMP OMAP10	/YES, GO END IT
	TAD ORIGIN	/NO, 8 LOCS OUT?
	AND (7)
	SZA CLA
	JMP OMAP3	/NO, GO OUTPUT ANOTHER LOC
	TAD (" )
	JMS I (XXPUT)	/YES, OUTPUT AN EXTRA SPACE
	JMP OMAP3

EPTR,	0
ECTR1,	0
ECTR2,	0
ORIGIN,	0
XFIELD,	0

PAGE
/ OUTPUT AN OCTAL NUMBER IN ACCUMULATOR

OCTOUT,	0
	DCA OCT1
	TAD (-4)
	DCA OCT2
OCT3,	TAD OCT1
	CLL RTL
	RAL
	DCA OCT1
	TAD OCT1
	RAL
	AND (7)
	TAD ("0)
	JMS I (XXPUT)
	ISZ OCT2
	JMP OCT3
	JMP I OCTOUT

OCT1,	0
OCT2,	0

/ ASSEMBLE A BINARY WORD

ASSEMB,	0
	TAD WD1
	CLL RTL
	RTL
	RTL
	TAD WD2
	JMP I ASSEMB

/ SUBROUTINE TO MAP A WORD INTO MEMORY
/ ENTER WITH AC=7777 TO SET BIT
/   ALWAYS RETURN TO .+1
/ ENTER WITH AC=0000 TO FETCH BIT
/   RETURN TO .+1 IF BIT SET; .+2 IF CLEAR

MAPWD,	0
	DCA MAPSW	/SAVE THE SWITCH
	TAD OLDFLD
	CIA
	TAD XFIELD	/ARE FIELDS THE SAME?
	SZA CLA
	JMP MAP00	/NO, MUST RECALC
	TAD OLDORG
	CMA
	TAD ORIGIN	/DID ORG JUST INCREASE BY 1 ?
	SNA CLA
	JMP MAP5	/YES, NO CALCULATION
MAP00,	TAD XFIELD	/NO, CALCULATE
	SNA
	JMP MAP0	/IS FIELD 0
	CIA
	DCA MAPCTR	/NO. OF FIELDS
	TAD (600)
	ISZ MAPCTR	/MULTIPLY BY 600(8)
	JMP .-2
MAP0,	DCA BFIELD	/THIS IS THE LOC OF THE FIELD MAP
	DCA BLOC	/CLEAR BINARY LOC PTR
	TAD ORIGIN
MAP1,	CLL
	TAD (-14)	/12 BITS PER WORD
	SNL
	JMP MAP2
	ISZ BLOC	/INCREMENT BINARY PTR
	JMP MAP1
MAP2,	DCA MAPCTR	/NO. OF BITS TO SHIFT
	TAD BLOC
	TAD BFIELD
	DCA BLOC	/NOW POINTS TO EXACT WORD TO CHECK
	CLA STL		/SET LINK
	RAL		/ROTATE THRU ACC
	ISZ MAPCTR
	JMP .-2
	DCA BINBIT	/SET TO RIGHT PLACE
MAP7,	TAD ORIGIN
	DCA OLDORG	/SAVE THE OLD ORIGIN
	TAD XFIELD
	DCA OLDFLD	/AND THE OLD FIELD
	ISZ MAPSW	/SET IT OR FETCH IT?
	JMP MAP4	/GO FETCH IT
	TAD BINBIT	/SET IT
	CMA
	CDF 00		/TABLE IN FIEDL 0
	AND I BLOC	/MAKE SURE THAT IT'S OFF
	TAD BINBIT	/THEN SET IT
	DCA I BLOC
	CDF 10
	TAD XFIELD
	TAD (TFIELD)	/POINTS TO FIELD TABLE
	DCA MAPPTR
	ISZ I MAPPTR	/ONE MORE WORD ASSIGNED TO FIELD
	SKP
	ISZ I MAPPTR	/IF ZAPPED TO 0, MAKE IT 1
	JMP I MAPWD

MAP4,	CDF 00		/TABLE IN FIELD 0
	TAD I BLOC	/GET THE WORD
	AND BINBIT	/GET THE BIT
	CDF 10
ZSWITC,	SNA CLA		/OR SZA CLA
	ISZ MAPWD	/NOT SET, .+2
	JMP I MAPWD	/SET, .+1 RETURN

MAP5,	TAD BINBIT	/INCREMENT EFF ADDR BY 1
	CLL RAR
	SZA		/MUST WE INCREMENT PTR
	JMP .+3		/NO, IT'S STILL IN THIS ONE
	ISZ BLOC	/YES, INCREMENT
	STL CLA RAR	/4000 TO AC
	DCA BINBIT	/NEW BIT FOR NEW WORD
	JMP MAP7

OLDFLD,	0
OLDORG,	0
MAPSW,	0
MAPCTR,	0
MAPPTR,	0
BFIELD,	0
BLOC,	0
BINBIT,	0

TFIELD,	ZBLOCK	10	/0 IF NOTHING ASSIGNED TO FIELD

PAGE
/ CHECK FOR WHICH TYPE OF OUTPUT HE WANTS
/ /R MEANS HE WANTS RANGES TO BE OUTPUT

ECHECK,	0
	JMS CRLF
	TAD I (MPARAM+1)
	AND (100)	/CHECK FOR /R
	SNA CLA
	JMP I ECHECK	/HE WANTS BIT MAP
	DCA XFIELD	/START AT FIELD 0
	TAD (-10)	/JUST 8 FIELDS ON PDP-8
	DCA ECCTR1
ECHK2,	TAD XFIELD
	TAD (TFIELD)
	DCA ECPTR
	TAD I ECPTR	/ANY THING ASSIGNED TO THIS FIELD?
	SNA CLA
	JMP ECHK3	/NO, GO FOR NEXT FIELD
	JMS CRLF
	JMS TYPMESS	/OUTPUT "FIELD "
	  FIELDM
	TAD XFIELD
	TAD ("0)
	JMS I (XXPUT)	/OUTPUT FIELD NUMBER
	JMS CRLF
	JMS CRLF
	DCA ORIGIN	/START AT LOC 0
ECHK4,	JMS MAPWD	/CHECK OUT THIS LOC
	JMP ECHK5	/IS ASSIGNED
ECHK9,	ISZ ORIGIN	/INCREMENT LOC PTR
	JMP ECHK4
ECHK3,	ISZ XFIELD	/END OF FIELD, INCREM
	ISZ ECCTR1	/ALL FIELDS CHHCKED?
	JMP ECHK2
	JMP EOFOUT	/YES, DONE

ECHK5,	TAD XFIELD
	TAD ("0)
	JMS I (XXPUT)	/OUTPUT 5 DIGIT ADDRESS
	TAD ORIGIN	/LOWER LIMIT
	JMS OCTOUT
	JMS TYPMESS	/OUTPUT A " - "
	  SPMSP
	TAD ORIGIN
	DCA FLOC	/FIRST LOC OF RANGE
	JMP ECHK6	/INCREMENT LOC PTR
ECHK8,	JMS MAPWD	/IS THIS WORD ASSIGNED?
	SKP
	JMP ECHK7	/NO, END OF RANGE
ECHK6,	ISZ ORIGIN	/YES, INCREMENT PTR
	JMP ECHK8	/CHECK FOR MORE
	STA
	JMS OUTLAST	/OUTPUT LAST LOC OF RANGE
	JMP ECHK3	/END OF FIELD

ECHK7,	STA
	TAD ORIGIN	/LOC IS CURRENT - 1
	JMS OUTLAST	/OUTPUT LAST LOC OF RANGE
	JMP ECHK9	/NOW LOOK FOR ANOTHER RANGE

ECCTR1,	0
ECPTR,	0
ETEMP,	0
FLOC,	0

OUTLAST, 0
	DCA ETEMP	/SAVE THE LAST LOC
	TAD XFIELD
	TAD ("0)
	JMS I (XXPUT)	/OUTPUT 5 DIGIT ADDRESS
	TAD ETEMP
	JMS OCTOUT	/THEN OUTPUT IN OCTAL
	JMS TYPMESS	/OUTPUT "  N = "
	  NEQUAL
	TAD ETEMP	/LAST LOC
	CMA
	TAD FLOC	/FIRST LOC
	CIA
	JMS OCTOUT	/OUTPUT LENGTH OF CONSECUTIVE AREA
	JMS CRLF
	JMP I OUTLAST

/ OUTPUT CARRIAGE RETURN/LINE FEED COMBINATION

CRLF,	0
	CLA
	TAD OUTIT
	DCA CRLFIT	/SAME OUTPUT DEVICE
	TAD (215)
	JMS I CRLFIT
	TAD (212)
	JMS I CRLFIT
	JMP I CRLF

CRLFIT,	0

TYPEXX,	0
	TLS		/OUTPUT TO TELETYPE
	TSF
	JMP .-1
	CLA CLL
	JMP I TYPEXX

/ OUTPUT EITHER CR/LF COMBINATION OR SPACES
/ DEPENDING ON WHETHER OUTPUT DEVICE IS TTY OR NOT

CRSP,	0
	JMS I (OTYPE)
	SZA CLA
	JMP .+3
	JMS CRLF	/TTY, OUTPUT CR/LF COMBO
	JMP I CRSP

	TAD (" )	/NON-TTY DEVICE
	JMS I (XXPUT)	/OUTPUT SPACES INSTEAD
	TAD (" )
	JMS I (XXPUT)
	JMP I CRSP

PAGE
/ OUTPUT A SIXBIT MESSAGE

TYPMESS, 0
	CLA CLL
	TAD I TYPMESS	/GET ADDR OF MESSAGE
	DCA TYPTR	/SAVE IN POINTER
	ISZ TYPMESS	/INCREMENT OVER RETURN
TYPM1,	TAD I TYPTR
	CLL RTR; RTR; RTR
	JMS TYPUT	/OUTPUT THE CHAR
	TAD I TYPTR
	JMS TYPUT	/THEN THE SECOND CHAR
	ISZ TYPTR	/INCREMENT THE POINTER
	JMP TYPM1

TYPUT,	0
	AND (77)	/JUST WANT SIXBIT CHAR
	TAD (" -":)
	SNA
	JMP I TYPMESS	/RETURN IF ':'
	TAD (":)	/RESTORE ASCII CHAR
	JMS I OUTIT	/OUTPUT TO PROPER PLACE
	JMP I TYPUT

TYPTR,	0
OUTIT,	0

/ A FIELD, RESET CURRENT ORIGIN FIELD

FIELDW,	TAD (-100)	/IS IT A FIELD?
	SPA
	JMP NOTXP	/NO, NOT EXPECTED
	DCA WD1
	TAD WD1
	AND (7)
	SZA CLA
	JMP NOTXP	/BAD CHAR, NOT EXPECTED
	TAD WD1
	AND (70)
	CLL RTR
	RAR
	DCA XFIELD	/UPDATE THE CURRENT FIELD
	JMS I (XXGET)	/GET ANOTHER CHAR
	TAD (-200)
	SZA
	JMP NEWWD	/IS NEW BINARY DATA WORD
NOTXP,	CLA		/DATA CHAR NOT EXPECTED
	TAD CHKSUM
	SNA CLA
	JMP LOADER	/NO CHECK SUM YET, IGNORE
BADCK,	JMS TYPMESS	/OUTPUT ERROR MESSAGE
	  BADINP
	JMS CRLF
	JMP START	/THEN RESTART

/ SOME MESSAGES

FIELDM,	SIXBIT "FIELD :"

SPMSP,	SIXBIT " - :"

BADINP,	SIXBIT "BAD INPUT IN FILE:"

NEQUAL,	SIXBIT "  N = :"

MAPVER,	SIXBIT "OS/8 MAP-V2:"

PAGE
/ NOW TO DEFINE SOME EQUIVALENCES FOR IOPACK

	OUBUF=5200	/OUTPUT BUFFER IN FIELD 1
	OUCTL=5210	/WRITE 12 PAGES, FIELD 1
	OUDEVH=7200	/OUTPUT DEVICE HANDLER

	INBUF=5200	/INPUT BUFFER IN FIELD 1
	INCTL=1210	/READ 12 PAGES, FIELD 1
	INRECS=INCTL%200
	INDEVH=6600	/INPUT DEVICE HANDLER

PAUSE
 FILE:"

NEQUAL,	SIXBIT "  N = :"

MAPVER,	SIXBIT "OS/8 MAP-V2:"

PAGE
/ NOW TO DEFINE SOME EQUIVALENCES FOR IOPACK

	OUBUF=5200	/OUTPUT BUFFER ITAD CHAR
	DCA I RUBDX
	STA
	DCA RUBCT
	JMP DINDEX	/RETURN TO DISPLAY

INSRT,	CLA		/PUT NEW CHAR IN HIGH ORDER HALF OF WORD

	TAD CHAR
	AND (0077
	DCA CHAR
	TAD I RUBDX
	AND (7700
	TAD CHAR
	DCA I RUBDX
	DCA RUBCT
	TAD RUBDX
	CIA
	TAD RUBXR
	TAD (3
	SMA
	JMP .+3
	CLA


	DCA RUBDX
	CLA
	JMP DINDEX	/RETURN TO DISPLAY


CHKUP1,	0
	CLA
	TAD CHAR	/TEST INPUT FOR A RUBOUT
	TAD (-377
	SNA CLA
	JMP QMARK	/YES, GO PROCESS ANOTHER RUBOUT

	TAD RUBDX	/WHERE TO RETURN TO?

	SNA CLA
	JMP I CHKUP1	/RETURN TO DISPLAY
	TAD CHAR	/TEST INPUT FOR A SPACE
	TAD (-240
	SZA
	JMP CHNAME	/NOT A SPACE, RETURN
	DCA CHAR 	/YES, CHANGE SPACE TO BLANK
	JMP CHNAME

CHKUP3,	0		/DON'T PROCESS TOO MANY RUBOUTS

	CLA
	TAD RUBXR
	IAC
	CIA
	TAD RUBDX