COMMENT ⊗   VALID 00019 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	PALX BINARY FILE FORMAT
C00004 00003		TITLE	11LOAD	CONSOLE 11/40 LOADER   JBR/REG
C00005 00004	MACROS - GETFIL,CRLF,HASPAR,D11CLR,D11RD,D11WR,D11WRB,D11MAC,D11CON
C00007 00005	MORE MACROS - CONC,CALLIT,CMD,SECOND
C00009 00006	BEG,PAT,BEGL,MAIN,COMMAND DISPATCH
C00012 00007	XTEND, BUCKY
C00014 00008	EXPLN, GORAID, XIT
C00015 00009	LDBIN - LOAD BINARY FILE SUBROUTINE, BYTOBP, FTCH11, STOR11
C00019 00010	LDSYMS, OLDSYMS - SUBROUTINES TO LOAD/OVERLAY SYMBOLS
C00023 00011	DDDT, DDT, DDTL, OVER, MERGE, NODDT, INSERT, ZR
C00026 00012	LOAD, DLOAD, WRBIN
C00032 00013	WBOOT
C00036 00014	GRONK	GRAB the 11 and RELOAD it
C00040 00015	RAD50,RDB,RDW,GETNUM,OCTTYP,DECTYP
C00046 00016	FILSCN, LUPFL, ENTFL, INITFL, GETSIX, SIXTYP
C00055 00017	GET WORD FROM DKIC FILE INTO I
C00057 00018	THINGS HAVING TO DO WITH THE SIZE OF THE 11'S CORE:  SETSIZ
C00061 00019	LPDL←←30
C00063 ENDMK
C⊗;
;PALX BINARY FILE FORMAT
;
;B => BYTE, W => WORD (LOW BYTE THEN HIGH BYTE)
;
;	.
;	.
;	.
;****************
;*B	1
;*B	0	(ERROR IF NOT 0)
;*W	# BYTES OF DATA + 6	(6 => JUMP BLOCK)
;*W	ADDRESS			(JUMP ADDRESS)
;*B	DATA
;*	.
;*	.
;*	.
;*B	DATA
;*B	CHECKSUM (SUM FROM INITIAL 1 THROUGH CHECKSUM = 0 IN LOW 8 BITS)
;****************
;	REPEAT
;	.
;	.
;	.
;	2
;****************
;*	SIXBIT SYMBOL
;*	BITS,,VALUE
;****************
;	REPEAT
;	0
	TITLE	11LOAD	CONSOLE 11/40 LOADER   JBR/REG

A←1
B←2
C←3
D←4
E←5
G←6
T←7
TT←10
I←11
J←12
K←13
L←14
M←15
N←16
P←17

DKIC←←1
DKOC←←2

NKCOR←←=28		;KL10 CONSOLE 11/40 HAS 2 MF11UPs = 28K WORDS
TOPCOR←←NKCOR*=1024*2-1	;HIGHEST BYTE ADDRESS IN CORE
DDTTOP←←100000
DDTBEG←←DDTTOP-22000

DEVPRV←←400

	Extern	.JBREL,.JBFF
;MACROS - GETFIL,CRLF,HASPAR,D11CLR,D11RD,D11WR,D11WRB,D11MAC,D11CON

DEFINE GETFIL $ (LE,STR,LH,CH,BUF,BYTE)
<ZZ←←.
IFDIF <STR><><OUTSTR [ASCIZ /$STR$/]>
	PUSHJ P,FILSCN	;INPUT FILE SPECS
IFIDN <LE> <L> <LH,,LUP>
IFIDN <LE> <E> <LH,,ENT>
	JRST [	CRLF		;ALT TYPED
		JRST MAIN]
	JRST [	OUTSTR [ASCIZ /??	
/]				;GARBAGE TYPED
		CLRBFI
		JRST ZZ]
	INIT CH,10
	'DSK   '
IFIDN <LE> <E> <BUF,,> IFIDN <LE> <L> <BUF>
	JRST INITL
IFIDN <LE> <L> <LOOKUP CH,LUP
	JRST [	PUSHJ P,LUPFL
		JRST ZZ]>
IFIDN <LE> <E> <ENTER CH,ENT
	JRST [	PUSHJ P,ENTFL
		JRST ZZ]>
	MOVEI A,BYTE
	DPB A,[300600,,BUF+1]
>

DEFINE CRLF <
	OUTSTR [BYTE (7) 15,12]
>
;MORE MACROS - CONC,CALLIT,CMD,SECOND

DEFINE	CONC ! (A,B)
<A!B>

DEFINE	CBAR <0,>
DEFINE	CFOO ! (A,B,C)<DEFINE CBAR()<0,<B
C>>>
DEFINE	CBAZ(A)<CFOO(\CBAR,<A>)>

NLOSES←←0

DEFINE	CALLIT ! (FOO,ERR)<
IFDEF HICAL,<PRINTS /HICAL DEFINED TOO SOON
/>
	PUSHJ P,FOO
CONC(LL,\NLOSES)::
CBAZ([ASCIZ/ERR/])
NLOSES←←NLOSES+1
>

DEFINE	BAR1 <0,>
DEFINE	FOO1 ! (A,B,C)<DEFINE BAR1 <0,<B
C>>>
DEFINE	BAZ1(A)<FOO1(\BAR1,<A>)>
DEFINE	SECOND(A,B)<B>

DEFINE	CMD(CHR,TEXT)<
	"CHR"
	BAZ1(<OUTSTR [ASCIZ πCHR	TEXT
π]>)>

DEFINE	BAR2 <0,>
DEFINE	FOO2 ! (A,B,C)<DEFINE BAR2 <0,<B
C>>>
DEFINE	BAZ2(A)<FOO2(\BAR2,<A>)>

DEFINE	XCMD(NAME,TEXT)<
	SIXBIT /NAME/
	BAZ2(<OUTSTR [ASCIZ πNAME	TEXT
π]>)>
;BEG,PAT,BEGL,MAIN,COMMAND DISPATCH

PAT:
PATCH:	BLOCK 100

BEG:	JFCL		;IN CASE STARTED IN RPG MODE
	RESET
	MOVE P,[-LPDL,,PDL-1]
	MOVEI A,400000+<<TOPCOR+1>/4>-1
	CORE2 A,
	JRST 4,.
	PUSHJ P,ZR
	SETOM JMPBLF
	SETOM PROGSA
	SETOM DDTSA
	OUTSTR [ASCIZ /
TYPE ? FOR HELP/]
MAIN:
BEGL:	PTJOBX [0 ↔ 'DON   ']
	SETZM OVERLF
	MOVE P,[-LPDL,,PDL-1]
	RELEAS DKIC,
	CLOSE DKOC,
	RELEAS DKOC,
	OUTSTR [ASCIZ /
*/]
INBEG:	INCHRW A
	TRNE A,600
	JRST CMCMD		;CONTROL OR META BIT ON IN COMMAND
	CAIE A,15
	CAIN A,12
	JRST INBEG
	CAIL A,"a"
	CAILE A,"z"
	CAIA
	SUBI A,40
	MOVSI B,-NCMDS
CMDSL:	CAME A,CMDCTB(B)
	AOBJN B,CMDSL
	JUMPGE B,CMDHUH
	PUSHJ P,@CMDDTB(B)
	JRST BEGL

CMDHUH:	OUTSTR [ASCIZ /  ??/]
	JRST BEGL

CMCMD:	ANDI A,177
	CAIL A,"A"
	CAILE A,"Z"
	CAIA
	JRST CMCMD1
	CAIL A,"a"
	CAILE A,"z"
	JRST CMDHUH
	ANDCMI A,40
CMCMD1:	MOVSI B,-NCMCMD
CMCMDL:	CAME A,CMCMDT(B)
	AOBJN B,CMCMDL
	JUMPGE B,CMDHUH
	PUSHJ P,@CMCMDD(B)
	JRST BEGL

CMDCTB:	CMD(?,EXPLAIN THESE COMMANDS)
	CMD(N,LOAD WITHOUT DEBUGGER OR SYMBOLS)
	CMD(L,<LOAD PROGRAM (BINARY FILE) WITH DDT AND SYMBOLS>)
	CMD(D,JUST LOAD DDT)
	CMD(M,<MERGE (DON'T CLEAR CORE) ADDING SYMBOLS>)
;	CMD(I,<INSERT (DON'T CLEAR CORE) REPLACING SYMBOLS>)
	CMD(O,<OVERLAY (NO DDT, NO SYMBOLS, DON'T CLEAR CORE)>)
	CMD(H,<HAVE BUG, WILL UNRAVEL>)
	CMD(X,EXIT)
	CMD(A,SIMULATE BUCKY X)
	CMD(W,WRITE OUT BIN FILE)
	CMD(C,WRITE BINARY AS OCTAL CHARACTERS)
	CMD(B,<Write a DT-bootable file>)

NCMDS←←.-CMDCTB

CMDDTB:	EXPLN
	NODDT
	LOAD
	DDT
	MERGE
;	INSERT
	OVER
	GORAID
	XIT
	BUCKY
	WRBIN
	WRCHR
	WBOOT
	GRONK

CMCMDT:	"X"
NCMCMD←←.-CMCMDT

CMCMDD:	XTEND
;XTEND, BUCKY

BUCKY:	OUTSTR [ASCIZ /N EXTENDED COMMAND /]
	JRST XTEND6

XTEND:	OUTSTR [ASCIZ /TENDED COMMAND /]
XTEND6:	PUSHJ P,GETSIX		;GET SYL IN J SEP IN I
	CAIN I,175
	POPJ P,
	MOVEM I,SEP
	JUMPE J,CPOPJ
	MOVE A,J		;SIXBIT TO A
	MOVEI J,0
	TLNN K,770000		;K WAS BP INTO J USED BY GETSIX
	JRST XTEND1		;NAME IS 6 CHARS LONG
	MOVEI I,77
XTEND0:	IDPB I,K		;MAKE A MASK OF UNUSED BITS
	TLNE K,770000
	JRST XTEND0		;MORE BITS TO DO
XTEND1:	MOVSI B,-NXCMDS
XTEND2:	MOVE C,XCMDS(B)
	CAMN A,C
	JRST XTENDF		;EXACT MATCH
	ANDCAM J,C		;TURN OFF BITS IN NEW CANDIDATE NOT SPECIFIED IN A
	CAMN A,C
	JRST XTEND3		;PARTIAL MATCH
XTEND4:	AOBJN B,XTEND2
	JUMPL I,XTEND5		;FOUND EXACTLY ONE PARTIAL MATCH
	OUTSTR [ASCIZ /UNKNOWN COMMAND
/]
	POPJ P,

XTEND3:	JUMPL I,[OUTSTR [ASCIZ /AMBIGUOUS COMMAND
/]
		POPJ P,]
	TLO I,400000(B)		;INDICATE THERE HAS ALREADY BEEN A PARTIAL MATCH
	JRST XTEND4

XTEND5:	HLRZ B,I
	ANDI B,377777
XTENDF:	JRST @XCMDTB(B)

XCMDS:	XCMD(DDT,JUST LOAD DDT)
	XCMD(LOAD,LOAD WITH DDT)
	XCMD(GRONK,GRONK 11-40 VIA DTELOD UUO)
NXCMDS←←.-XCMDS

XCMDTB:	DDDT
	DLOAD
	GRONK
;EXPLN, GORAID, XIT

EXPLN:	OUTSTR [ASCIZ /
/]
	SECOND (\BAR1)
	OUTSTR [ASCIZ /TYPE CNTL-META C TO RETURN TO COMMAND MODE
TYPE <ANY BUCKY> X TO ENTER EXTEND MODE COMMANDS:
/]
	SECOND (\BAR2)
	JRST BEGL

GORAID:	SKIPN A,JOBDDT↑
	JRST GORAI1
	JSR @-6(A)
	JRST BEGL

GORAI1:	OUTSTR [ASCIZ / - NO RAID/]
	JRST BEGL

XIT:	PTJOBX [0 ↔ SIXBIT /DON/]
	EXIT
;LDBIN - LOAD BINARY FILE SUBROUTINE, BYTOBP, FTCH11, STOR11

;LOAD BINARY FILE (RETURNS ON FINDING JUMP BLOCK)
;JUMP ADDRESS STORED IN JMPBLF
LDBIN:	SKIPN OVERLF		;DON'T CLOBBER STARTING ADDRESS IF OVERLAYING
	SETOM JMPBLF
LOWCAL:	IFN NLOSES,<PRINTS /LOWCAL DEFINED TOO LATE
/>
LDLP:	MOVEI K,0
LDLP1:	CALLIT(RDB,SEARCHING FOR 1 AT BEGINNING OF BLOCK)
	CAIE I,1
	JRST LDLP1
	CALLIT(RDB,READING BYTE AFTER INITIAL 1)
	JUMPN I,[	OUTSTR [ASCIZ /INITIAL 1 NOT FOLLOWED BY 0
/]
			JRST BEGL]
	CALLIT(RDW,READING NUMBER OF BYTES WORD)	;NUMBER OF BYTES OF DATA + 6
	CAIN I,6
	JRST JUMPB
	MOVEI A,-6(I)		;NUMBER OF BYTES OF DATA
	CALLIT(RDW,READING ADDRESS WORD)	;ADDRESS OF FIRST BYTE
	MOVE B,I		;ADDRESS OF FIRST BYTE IN BLOCK
	ADDI I,-1(A)		;ADDRESS OF LAST BYTE IN BLOCK
	CAIG I,TOPCOR
	CAILE B,TOPCOR
	JRST [	OUTSTR [ASCIZ /ATTEMPT TO LOAD FILE ABOVE TOP OF CORE
/]
		JRST BEGL]
LDLP1A:	PUSHJ P,BYTOBP
LDLP1B:	CALLIT(RDB,READING DATA BYTE)
	IDPB I,D
	SOJG A,LDLP1B
LDLP2E:	MOVEI B,LDLP
LDLP3:	CALLIT(RDB,READING CHECKSUM)
	TRNE K,377
	JRST [	OUTSTR [ASCIZ /CHECKSUM ERROR
/]
		JRST BEGL]
	JRST (B)

JUMPB:	CALLIT(RDW,READING JUMP BLOCK ADDRESS)
	SKIPN OVERLF		;DON'T CLOBBER STARTING ADDRESS IF OVERLAYING
	MOVEM I,JMPBLF
	MOVEI B,CPOPJ
	JRST LDLP3

;CONVERT BYTE ADDRESS IN B TO ILDB TYPE BYTE POINTER IN D
BYTOBP:	PUSH P,C
	MOVE C,B
	IDIVI C,4
	MOVE D,BYTOBT(D)
	ADDI D,(C)
	POP P,C
	POPJ P,

BYTOBT:	441000,,400000
	341000,,400000
	241000,,400000
	141000,,400000

;B HAS BYTE ADDRESS, C GETS WORD DATA
FTCH11:	PUSH P,D
	PUSH P,A
	PUSHJ P,BYTOBP
	ILDB C,D		;GET THE EVEN BYTE
	ILDB A,D		;GET THE ODD BYTE
	LSH A,8
	ADDI C,(A)
	POP P,A
	POP P,D
	POPJ P,

;A HAS WORD DATA, B HAS BYTE ADDRESS
STOR11:	PUSH P,D
	PUSH P,C
	PUSHJ P,BYTOBP
	IDPB A,D		;STORE LOW 8 BITS
	LDB C,[POINT 8,A,27]
	IDPB C,D		;STORE HIGH 8 BITS
	POP P,C
	POP P,D
	POPJ P,
;LDSYMS, OLDSYMS - SUBROUTINES TO LOAD/OVERLAY SYMBOLS

;OLSYMS:	D11TRA SMTOPR		;Overlay symbols
;	MOVE C,SMTOPR+1
;	JRST LDSYM3
LDSYMS:	MOVEI B,DDTBEG-2	;Load symbols (at end of old table)
	PUSHJ P,FTCH11		;GET POINTER TO FIRST WORD OF LAST SYMBOL INTO C
LDSYM3:	MOVEI B,DDTBEG-4
	MOVE A,PROGSA
	PUSHJ P,STOR11
	MOVEI G,(C)		;BYTE ADDRESS OF FIRST WORD OF LAST SYM
	SUBI C,DDTBEG-6
	IDIVI C,<=16*6+4>	;COMPUTE - NUMBER OF 16 SYM BLOCKS AWAY
	IMULI C,<=16*6+4>
	ADDI C,DDTBEG-6
;	LSH C,-1		;WORD ADDRESS
	IDIVI D,6		;- # SYMBOLS FROM END OF BLOCK
	MOVN D,D
	MOVEI E,1
	LSH E,-1(D)		;BIT FOR LAST SYMBOL
;	LSH G,-1		;WORD ADDRESS OF FIRST WORD OF LAST SYMBOL WRITTEN
	MOVEI D,(G)
	MOVEI B,-2(C)
	PUSH P,C
	PUSHJ P,FTCH11		;HALF-KILLED BITS
	MOVE M,C
	POP P,C
	ADDI B,2
	PUSH P,C
	PUSHJ P,FTCH11
	MOVE N,C		;REGISTER BITS
	POP P,C
LDSYM2:	CALLIT(RDB,SEARCHING FOR INITIAL 2)
	CAIE I,2
	JRST LDSYM2
SYML0:	LSH E,1
	TRNE E,200000		;DONE WITH THIS BLOCK OF 16?
	JRST SYMB		;YES
	SUBI D,3*2
SYML1:	CALLIT(RDB,READING SYMBOL NAME)
	JUMPE I,SYMDN
	PUSH P,I
	CALLIT(RDB,READING SYMBOL VALUE)
	EXCH I,(P)
	PUSHJ P,RAD50		;CONVERT I INTO T AND TT
	MOVEI B,(D)
	MOVE A,T
	PUSHJ P,STOR11
	ADDI B,2
	MOVE A,TT
	PUSHJ P,STOR11
	ADDI B,2
	POP P,I
	MOVE A,I
	PUSHJ P,STOR11
	TLNE I,4000		;REGISTER FLAG
	IORM E,N
	TLNE I,20000		;HALF-KILLED FLAG
	IORM E,M
	MOVEI G,(D)		;BYTE ADDRESS OF FIRST WORD OF LAST SYMBOL WRITTEN
	JRST SYML0

SYMB:	MOVEI B,-2(C)		;BYTE ADDRESS OF HALF KILLED WORD THIS BLOCK
	MOVE A,M
	PUSHJ P,STOR11
	ADDI B,2		;BYTE ADDRESS OF REGISTER WORD
	MOVE A,N
	PUSHJ P,STOR11
	MOVEI C,-2(D)		;BYTE ADDRESS OF REGISTER WORD OF NEXT BLOCK
	SETZB M,N
	MOVEI D,-10(C)		;BYTE ADDRESS OF FIRST SYMBOL OF NEXT BLOCK
	AOJA E,SYML1
HICAL:
SYMDN:	MOVEI B,-2(C)
	MOVE A,M
	PUSHJ P,STOR11
	ADDI B,2
	MOVE A,N
	PUSHJ P,STOR11
	OUTSTR [ASCIZ/SYMBOLS START AT /]
	MOVE D,G
	PUSHJ P,OCTTYP
	OUTSTR [ASCIZ/.
/]
	MOVEI B,DDTBEG-2
	MOVE A,G
	JRST STOR11
;DDDT, DDT, DDTL, OVER, MERGE, NODDT, INSERT, ZR

;JUST LOAD DDT
DDDT:	OUTCHR ["D"]
DDT:	OUTSTR [ASCIZ /DT ALONE
/]
	SETZM NOSYMS		;DDT ALONE GETS DDT SYMBOLS
DDTL:	INIT DKIC,10
	'DSK   '
	IBUF
	JRST 4,.
	MOVSI A,'DDT'
	MOVSI B,'BIN'
	MOVEI C,0
	MOVE D,[' KLSYS']
	LOOKUP DKIC,A
	JRST [	OUTSTR [ASCIZ /
DEBUGGER NOT FOUND???/]
		JRST BEGL]
	PUSHJ P,ZR		;ZERO CORE
	PUSHJ P,LDBIN
	MOVE A,JMPBLF
	MOVEM A,DDTSA
	SKIPN OVERLF
	MOVEM A,PROGSA
	SKIPN NOSYMS
	PUSHJ P,LDSYMS
	MOVEI A,340
	MOVEI B,DDTTOP-12	;STORE 340 IN DDTST
	PUSHJ P,STOR11
	POPJ P,



;OVERLAY BINARY WITHOUT DDT OR SYMBOLS
OVER:	OUTSTR [ASCIZ /VERLAY /]
	SETOM OVERLF
	JRST OVERE

;LOAD BINARY WITHOUT DDT OR SYMBOLS
NODDT:	OUTSTR [ASCIZ /ODDT /]
OVERE:	MOVEI A,0
	DSKPPN A,		;GET CURRENT DSK PPN
	MOVEM A,SAVPPN
	GETFIL (L,BIN FILE - ,'BIN',DKIC,IBUF,=36)
	SKIPN OVERLF		;DON'T CLEAR CORE FOR OVERLAY
	PUSHJ P,ZR		;ZERO CORE
	PUSHJ P,LDBIN		;LOAD BIN FILE AND RETURN
	MOVE A,JMPBLF
	SKIPN OVERLF
	MOVEM A,PROGSA
	POPJ P,

MERGE:	OUTSTR [ASCIZ /ERGE, ADDING SYMBOLS, /]
	SETOM OVERLF
	PUSHJ P,OVERE
	JRST LDSYMS		;LOAD SYMBOLS AND RETURN

;INSERT:	OUTSTR [ASCIZ /NSERT, REPLACING SYMBOLS, /]
;	SETOM OVERLF
;	PUSHJ P,OVERE
;	JRST OLSYMS		;OVERLAY SYMBOLS AND RETURN

ZR:	SETZM 400000
	MOVE A,[400000,,400001]
	BLT A,400000+<<TOPCOR+1>/4>-1
	POPJ P,
;LOAD, DLOAD, WRBIN

;LOAD WITH DDT AND SYMBOLS
DLOAD:	OUTCHR ["L"]
LOAD:	OUTSTR [ASCIZ /OAD /]
LOADE:	GETFIL (L,BIN FILE - ,'BIN',DKIC,IBUF,=36)
	IOPUSH DKIC,1		;SAVE ACROSS THE NEXT FEW CALLS
	JRST 4,.		;  FAILURE?
	SETOM NOSYMS		;DON'T WANT DDT'S SYMBOLS
	PUSHJ P,DDTL		;GET DDT IN CORE
	MOVE A,JMPBLF
	MOVEM A,DDTSA		;DDT'S STARTING ADDRESS
	IOPOP DKIC,1		;GET CHANNEL BACK
	JRST 4,.		;  FAILURE?
	PUSHJ P,LDBIN		;LOAD CODE PART OF BINARY FILE
	MOVE A,JMPBLF
	MOVEM A,PROGSA		;PROGRAM'S STARTING ADDRESS
	PUSHJ P,LDSYMS		;LOAD SYMBOLS INTO DEBUGGER
	MOVE A,DDTSA
	MOVEM A,JMPBLF		;START AT DEBUGGER FOR LOAD
	POPJ P,

WRCHR:	OUTSTR	[asciz/HARACTER WRITE AS OCTAL HALFWORDS /]
	SETOM	WCHRMD#
	GETFIL	(E,TEXT FILE -,'TXT',DKOC,OBUF,7)
	JRST	WRBIN0

WRBIN:	OUTSTR [ASCIZ /RITE /]
	GETFIL (E,BIN FILE - ,'BIN',DKOC,OBUF,=36)
	SETZM	WCHRMD#		;binary, not character mode.
WRBIN0:	MOVE A,[-<TOPCOR+1>/4,,400000]
WRBIN1:	SKIPN (A)
	AOBJN A,WRBIN1
	JUMPGE A,WRBINE		;EMPTY CORE IMAGE
	MOVE B,A		;SAVE POINTER TO FIRST NON-ZERO WORD
	MOVEI A,400000+<<TOPCOR+1>/4>-1	;LAST WORD OF CORE IMAGE
WRBIN2:	SKIPN (A)
	SOJA A,WRBIN2
	SUBI A,-1(B)		;LENGTH OF BLOCK IN PDP10 WORDS
WRBIN3:	MOVE C,A
	CAIL A,40000/4
	MOVEI A,40000/4		;STUPID TCDP CANT LOAD MORE THAN 100000 BYTE BLOCKS
	SUB C,A
	PUSH P,C
	PUSHJ P,WRBLOK
	POP P,A			;AMOUNT LEFT TO DO
	JUMPN A,WRBIN3
WRBIND:	SKIPE	WCHRMD		;character mode?
	JRST	WREOF		;yes, end now.
	MOVEI K,0
	MOVEI I,1
	PUSHJ P,CPUT
	MOVEI I,0
	PUSHJ P,CPUT
	MOVEI I,6
	PUSHJ P,CPUT
	MOVEI I,0
	PUSHJ P,CPUT
	MOVE C,PROGSA
	PUSHJ P,WCPUT
	MOVN K,K
	LDB I,[POINT 8,K,35]
	PUSHJ P,PUT
	MOVEI I,0
	PUSHJ P,PUT
WREOF:	RELEAS DKOC,
	POPJ P,

WRBINE:	OUTSTR [ASCIZ /EMPTY CORE IMAGE SAVED
/]
	JRST WRBIND

WRBLOK:	LSH A,2			;NUMBER OF BYTES OF DATA ...
	MOVE D,A
	MOVEI C,6(A)		; ... +6
	SKIPE	WCHRMD		;character mode?
	JRST	WRBLK0
	MOVEI K,0
	MOVEI I,1		;header is 1,
	PUSHJ P,CPUT
	MOVEI I,0		;0,
	PUSHJ P,CPUT
	PUSHJ P,WCPUT		;and the byte count
	MOVEI C,-400000(B)
	LSH C,2			;STARTING BYTE ADDRESS
	PUSHJ P,WCPUT
	HRLI B,441000		;MAKE BYTE POINTER TO DATA
WRBIN4:	ILDB I,B
	PUSHJ P,CPUT
	SOJG D,WRBIN4
	IBP B			;MAKE B POINT AT NEXT WORD IF AT END OF WORD
	MOVN K,K
	LDB I,[POINT 8,K,35]
	JRST PUT

;code to write an 11 core image as 18-bit octal halfwords.

WRBLK0:	MOVEI	C,-400000(B)
	LSH	C,2		;starting byte address
	HRLI	B,441000
WRBLK1:	ILDB	I,B			;first byte
	ILDB	K,B			;second
	DPB	K,[Point 8,I,27]	;store second left of first
	PUSH	P,I
	PUSHJ	P,SPACES
	POP	P,I
	PUSHJ	P,PUTOCT		;print it as octal
	MOVEI	I,","
	PUSHJ	P,PUT
	MOVEI	I,","
	PUSHJ	P,PUT
	ILDB	I,B			;third byte
	ILDB	K,B			;fourth byte
	DPB	K,[Point 8,I,27]	;place fourth to the left of the third
	PUSH	P,I
	PUSHJ	P,PUTOCT
	POP	P,I
	PUSHJ	P,SPACES
	MOVEI	I,11			;write a tab
	PUSHJ	P,PUT
	MOVEI	I,";"
	PUSHJ	P,PUT
	MOVE	I,C
	PUSHJ	P,PUTOCT
	ADDI	C,4
	MOVEI	I,15
	PUSHJ	P,PUT
	MOVEI	I,12
	PUSHJ	P,PUT
	SUBI	D,4
	JUMPG	D,WRBLK1
	IBP	B
	POPJ	P,

PUTOCT:	PUSH	P,I+1
	PUSHJ	P,PUTOC1
	POP	P,I+1
	POPJ	P,

PUTOC1:	IDIVI	I,10
	PUSH	P,I+1
	SKIPE	I
	PUSHJ	P,PUTOC1
	POP	P,I
	ADDI	I,"0"
	JRST	PUT

SPACES:	HRRZ	I,I
	JUMPE	I,SPAC1		;special for zero
	MOVEI	K,0		;count number of spaces needed
SPAC0:	TRNE	I,700000
	JRST	SPAC2
	LSH	I,3
	AOJA	K,SPAC0

SPAC1:	MOVEI	K,5
SPAC2:	JUMPE	K,CPOPJ
	MOVEI	I," "
	PUSHJ	P,PUT
	SOJG	K,.-2	
	POPJ	P,

WCPUT:	LDB I,[POINT 8,C,35]
	PUSHJ P,CPUT
	LDB I,[POINT 8,C,27]
CPUT:	ADD K,I
	JRST PUT
;WBOOT

;in general, load an -11 core image.
;	Dump the file via the Boot Command
;	Load the file into the -11 via αX Gronk Command

;Write a file for the DTBOOT UUO.

INT10X=100000	;INT10 bit in the TO11 byte count.
DTLOAD==<BYTE(4)4>			;the DTBOOT LOAD Code.
DTSTRT==<BYTE(4)2>			;the DTBOOT Start Code

WBOOT:	OUTSTR	[ASCIZ/ootable file.   Write a DT-Bootable file.  /]
	GETFIL	(E,L11 File - ,'L11',DKOC,OBUF,=18)

	SETZB	I,WBBUF
	MOVE	A,[WBBUF,,WBBUF+1]
	BLT	A,WBBUF+177
	MOVSI	A,-400		;first write 200 words of nulls
	PUSHJ	P,PUT
	AOBJN	A,.-1

	MOVE	A,[-<TOPCOR+1>/4,,400000]
	SKIPN	(A)
	AOBJN	A,.-1
	JUMPGE	A,WBEMPT
	MOVE	B,A		;SAVE POINTER TO FIRST NON-ZERO WORD
	MOVEI	A,400000+<<TOPCOR+1>/4>-1	;LAST WORD OF CORE IMAGE
	SKIPN	(A)
	SOJA	A,.-1
	SUBI	A,-1(B)		;LENGTH OF BLOCK IN PDP10 WORDS
	SETZM	WBIND#
WBOOT3:	MOVE	C,A
	CAIL	A,1000		;DTBOOT can only handle one page at a time
	MOVEI	A,1000
	SUB	C,A
	PUSH	P,C
	MOVEI	C,-400000(B)		;  KL address of this xfer
	LSH	C,2
	MOVN	I,A			;-wc
	LSH	I,1			;convert to PDP-11 word count
	ANDI	I,7777			;convert to 12 bits of word count.
	IORI	I,INT10X		;set INT10 in TO11BC
	DPB	I,[POINT 20,C,19]	;
	IOR	C,[DTLOAD]		;The DTBOOT Load Code
	MOVE	I,WBIND
	MOVEM	C,WBBUF(I)
	AOS	WBIND
	PUSHJ	P,WBBLOK		;write one boot block.
	POP	P,A			;AMOUNT LEFT TO DO
	JUMPN	A,WBOOT3
	HRRZ	C,PROGSA		;write the start block
	IOR	C,[DTSTRT]		;the DTBOOT Start Code
	MOVE	K,WBIND
	MOVEM	C,WBBUF(K)
	SETOM	WBBUF+1(K)		;-1 to signal: NO MORE
	USETO	DKOC,1
	MOVSI	A,-400
	MOVE	B,[POINT 18,WBBUF]
	ILDB	I,B
	PUSHJ	P,PUT
	AOBJN	A,.-2
WBEOF:	RELEAS	DKOC,
	POPJ	P,

WBBLOK:	LSH	A,1		;NUMBER OF Words OF DATA ...
	MOVE	D,A
	HRLI	B,441000	;MAKE BYTE POINTER TO DATA
WRBLO1:	ILDB	I,B
	ILDB	K,B
	DPB	K,[POINT 8,I,27]
	PUSHJ	P,PUT
	SOJG	D,WRBLO1
	IBP	B		;MAKE B POINT AT NEXT WORD IF AT END OF WORD
	POPJ	P,

WBEMPT:	OUTSTR	[ASCIZ/There is no -11 Core image.
/]
	JRST	WBEOF

;These must be adjacent, in order.  See also GRONK.
GRNKND:	0
GRNKAD:	0			;starting address for in-core 11-image.
WBBUF:	BLOCK	200
;GRONK	GRAB the 11 and RELOAD it

Comment $
The DTELOD UUO requires that we packetize the data that we wish to load.
Each packet must reside within one page of KL10 memory.  We make our
packets precisely one page in length.

Each packet contains a length (in pdp-11 words), an 11 address, and
it implies a -10 address.
$


OPDEF	DTELOD	[CALLI 400127]

GRONK:	OUTSTR	[ASCIZ/  Reload the 11 via DTELOD UUO.    /]
	MOVSI	A,DEVPRV
	SETPRV	A,
	TLNN	A,DEVPRV
	JRST	NOGRNK
	GETFIL	(L,L11 File - ,'L11',DKIC,IBUF,=36)
	MOVSI	A,-200			;-wc of header record
	MOVEI	K,0			;accumulate total word count.
GRNK1:	PUSHJ	P,GETINR		;read the 200-word header.
	JRST	GNKUEF			;unexpected eof
	MOVEM	I,WBBUF(A)		;store as arg to the UUO
	JUMPE	I,GRNK2			;zero is unimportant.
	CAMN	I,[-1]
	JRST	GRNK2			;-1 ends list.
	MOVE	B,I
	AND	B,[BYTE(4)17]		;keep only the record type
	CAMN	B,[DTSTRT]		;start address?
	JRST	GRNK2			;yes.  no words to count.
	CAME	B,[DTLOAD]		;load command?
	JRST	GNKBFF			;bad file format.
	LDB	B,[POINT 12,I,19]	;this records's word count
	IOR	B,[777777,,770000]	;extend the sign
	LDB	C,[POINT 8,K,25]	;"page number" from old word count.
	SUB	K,B			;count words.
	LDB	B,[POINT 8,K,25]	;"page number" from new word count.
	CAMG	B,C			;have we crossed a page boundary?
	JRST	GRNK2			;nope.
	CAIN	B,1(C)			;is this precisely one page higher?
	TRNE	K,1777			;yes.  Does count end with zeros?
	JRST	GNKBFF			;bad data.
GRNK2:	AOBJN	A,GRNK1
	MOVE	A,.JBREL
	TRO	A,1777
	ADDI	A,1
	MOVEM	A,GRNKAD		;this is the address for the 11-image.
	LSH	K,-1			;convert -11 wc to -10 words.
	PUSH	P,K			;save it.
	ADD	K,.JBREL
	CORE	K,
	HALT	.-1
	HRRZ	K,GRNKAD
	MOVSI	K,1(K)
	MOVS	K,K
	SETZM	@GRNKAD
	BLT	K,@.JBREL
	POP	P,K
	MOVN	K,K
	MOVS	K,K
	HRR	K,GRNKAD
GRNK3:	PUSHJ	P,GETINR
	JRST	GNKUEF
	MOVEM	I,(K)
	AOBJN	K,GRNK3
	HRRZM	K,GRNKND
	RELEAS	DKIC,
	OUTSTR	[ASCIZ/11-Image is loaded into 10-memory.
/]
	OUTSTR	[ASCIZ/Next, we gronk the 11 via DTELOD
/]
	MOVEI	A,3
	SLEEP	A,
	MOVEI	A,GRNKAD
	DTELOD	A,
	JRST	DTLDER
	OUTSTR	[ASCIZ/According to the system, we're done now.
/]
GRNK4:	MOVE	A,GRNKAD
	SUBI	A,1
	CORE	A,
	JFCL
	POPJ	P,

NOGRNK:	OUTSTR	[ASCIZ/You can't do this without DEVPRV
/]
	POPJ	P,

DTLDER:	OUTSTR	[ASCIZ/According to the system, you lose.
/]
	HALT	GRNK4

GNKUEF:	OUTSTR	[ASCIZ/Unexpected End of file in L11 file.
/]
GRNBAD:	RELEAS	DKIC,
	POPJ	P,

GNKBFF:	OUTSTR	[ASCIZ/Bad Data in file's header record.
/]
	JRST	GRNBAD
;RAD50,RDB,RDW,GETNUM,OCTTYP,DECTYP

;RAD50 CONVERTS SIXBIT IN I TO TWO RADIX 50 RIGHT ADJUSTED
;16 BIT BYTES IN T AND TT
RAD50:	SETZB T,TT
	MOVEI K,6
R50L:	MOVEI J,0
	ROTC I,6
	IMULI TT,50
	PUSHJ P,R50
	ADDI TT,(J)
	CAIE K,4
	SOJG K,R50L
	JUMPE K,CPOPJ
	EXCH T,TT
	SOJA K,R50L

R50:	CAILE J,72
	JRST POPJ1
	CAIN J,4
	JRST [MOVEI J,33 ↔ POPJ P,]
	CAIN J,16
	JRST [MOVEI J,34 ↔ POPJ P,]
	CAIGE J,41
	CAIGE J,32
	CAIGE J,20
	JRST POPJ1
	SUBI J,40
	JUMPGE J,CPOPJ
	ADDI J,40+16
	POPJ P,

;RDB READS A BYTE (I) AND ADDS IT INTO THE CHECKSUM (K)
RDB:	PUSHJ P,GETIN
	ADD K,I
	POPJ P,

;RDW READS TWO BYTES AND MAKES A WORD (LOW ORDER BYTE FIRST)
;USES RDB SO CHECKSUM IS COMPUTED
RDW:	PUSHJ P,RDB
RDW1:	PUSH P,I
	PUSHJ P,RDB
	LSH I,8
	IOR I,(P)
	SUB P,[1,,1]
	POPJ P,

;DIRECT RETURN IF GARBAGE TYPED, SKIP IF ALT, SKIP TWICE IF OK NUMBER (IN A)
;RETURNS DELIMITER IN B, NUMBER OF DIGITS IN C
GETNUM:	SETZM MINUSF
	MOVEI A,0
GETNM1:	INCHWL B
	CAIN B,"-"
	JRST [SETOM MINUSF ↔ JRST GETNM1]
	CAIN B,15
	JRST GETNM1
	CAIN B,12
	JRST GETNMX
	CAIN B,175
	JRST POPJ1
	CAIL B,"0"
	CAILE B,"7"
	POPJ P,
	LSH A,3
	ADDI A,-"0"(B)
	AOJA C,GETNM1

GETNMX:	SKIPGE MINUSF
	MOVNS A
POPJ2:	AOS (P)
	JRST POPJ1

OCTTYP:	PUSH P,G
	MOVEI G,10
	JRST DECTY

DECTYP:	PUSH P,G
	MOVEI G,=10
DECTY:	PUSH P,D
	PUSH P,E
	PUSHJ P,DECTY1
	POP P,E
	POP P,D
	POP P,G
	POPJ P,

DECTY1:	IDIVI D,(G)
	HRLM E,(P)
	SKIPE D
	PUSHJ P,DECTY1
	HLRZ E,(P)
	ADDI E,"0"
	OUTCHR E
	POPJ P,

LOSADR:
FOR N←0,NLOSES-1,1<CONC (LL,\N)
>
LOSTBL:	SECOND(\CBAR)
;FILSCN, LUPFL, ENTFL, INITFL, GETSIX, SIXTYP

;READ FILE SPECS FROM TTY INTO BLOCK - FILSCN
;WORD AFTER CALL IS DEFAULT EXTENSION,,BLK ADDRESS.
;DOESNT SKIP IF ALT MODE TYPED.
;SKIPS ONCE IF SYNTAX ERROR, TWICE IF OK.
FILSCN:	MOVE L,@(P)
	HLLZM L,1(L)	;SET UP DEFAULT EXTENSION
	AOS (P)
	MOVE I,SAVPPN
	MOVEM I,3(L)	;INITIALIZE TO CURRENT DSK PPN
	PUSHJ P,GETSIX	;SYMBOL IN J, SEPARATOR IN I
	CAIN I,175	;ALT MODE
	POPJ P,
	AOS (P)
	MOVEM J,(L)
	CAIN I,"."
	JRST FILSCX	;GET EXTENSION
	CAIN I,"["
	JRST FILSCP	;GET PPN
	CAIN I,12
POPJ1:	AOS (P)
CPOPJ:	POPJ P,

FILSCX:	PUSHJ P,GETSIX
	HLLZM J,1(L)
	CAIN I,12
	JRST POPJ1
	CAIE I,"["
	POPJ P,
FILSCP:	PUSHJ P,GETSIX
	JUMPE J,FILSP3
FILSP1:	TLNE J,77	;RIGHT ADJUST
	JRST FILSP2
	LSH J,-6
	JRST FILSP1

FILSP2:	HLLM J,3(L)	;STORE PROJ NUMBER
FILSP3:	CAIN I,","
	JRST FILSP4	;GET PROGRAMMER NAME
FILSP8:	CAIN I,"]"
	JRST FILSP5	;DONE
	CAIN I,12
	AOS (P)
	POPJ P,

FILSP4:	PUSHJ P,GETSIX
	JUMPE J,FILSP8
FILSP6:	TLNE J,77
	JRST FILSP7
	LSH J,-6
	JRST FILSP6

FILSP7:	HLRM J,3(L)
	JRST FILSP8

FILSP5:	PUSHJ P,GETSIX
	CAIN I,12
	JRST POPJ1
	JRST FILSP5

LUPFL:	OUTSTR [ASCIZ /LOOKUP FAILED - /]
	MOVEI L,LUP
FILNOU:	MOVE I,(L)
	PUSHJ P,SIXTYP
	OUTCHR ["."]
	MOVE I,1(L)
	PUSHJ P,SIXTY3
	OUTCHR ["["]
	MOVE I,3(L)
	PUSHJ P,SIXTY3
	OUTCHR [","]
	MOVS I,3(L)
	PUSHJ P,SIXTY3
	OUTSTR [ASCIZ /]
/]
	POPJ P,

ENTFL:	OUTSTR [ASCIZ /ENTER FAILED - /]
	MOVEI L,ENT
	JRST FILNOU

;GET SIXBIT SYLLABLE IN J WITH SEPARATOR IN I
GETSIX:	MOVE K,[440600,,J]
	MOVEI J,0
GETSX1:	INCHWL I
	CAIN I,15
	JRST GETSX1
	CAIL I,"0"
	CAILE I,"9"
	JRST GETSX2	;NOT NUM
	JRST GETSX3	;NUMBER
GETSX2:	CAIL I,"a"
	CAILE I,"z"
	JRST GETSX4	;NOT LOWER CASE
	JRST [	SUBI I,40	;LOWER CASE
		JRST GETSX3]
GETSX4:	CAIL I,"A"
	CAILE I,"Z"
	POPJ P,
GETSX3:	SUBI I,40
	TLNE K,770000
	IDPB I,K
	JRST GETSX1

;TYPE I IN SIXBIT (6 CHARS WORTH)
SIXTYP:	MOVE J,[440600,,I]
SIXTY1:	ILDB K,J
	ADDI K,40
	OUTCHR K
	TLNE J,770000
	JRST SIXTY1
	POPJ P,

;TYPE LEFT 3 CHARS OF I
SIXTY3:	MOVE J,[440600,,I]
SIXTY4:	ILDB K,J
	ADDI K,40
	OUTCHR K
	TLNE J,500000
	JRST SIXTY4
	POPJ P,

INITL:	OUTSTR [ASCIZ /CAN'T INIT DSK - LOSEY, LOSEY
/]
	JRST 4,.
;GET WORD FROM DKIC FILE INTO I
;SKIP RETURNS UNLESS EOF

ZZ←←0
DEFINE GETGEN $ (DKIC,GETIN,IBUF)
<
GETIN$R:SOSG IBUF+2
	IN DKIC,
	JRST GETIN$1
	STATZ DKIC,20000	;EOF?
	POPJ P,			;YES
	JRST 4,.		;NO
GETIN$1:ILDB I,IBUF+1
	JRST POPJ1

GETIN:	PUSHJ P,GETIN$R
	JRST GETEOF
	POPJ P,

GETIN$B:	PUSHJ P,GETIN
IFG ZZ,<JRST GTINB1>
IFE ZZ,<ZZ←←ZZ+1
GTINB1:	LSH I,=24
	ASH I,-=24
	POPJ P,>
>

GETGEN (DKIC,GETIN,IBUF)

GETEOF:	OUTSTR [ASCIZ /
EOF ON INPUT
/]
	CLOSE DKOC,
	MOVE T,P
EOF1:	HRRZ A,(T)
	CAIL A,LOWCAL
	CAIL A,HICAL
	SOJA T,EOF1
	MOVSI B,-NLOSES
EOF2:	CAME A,LOSADR(B)
	AOBJN B,EOF2
	JUMPGE B,[	OUTSTR [ASCIZ /LOSS NOT FOUND/]
			JRST 4,.]
	OUTSTR @LOSTBL(B)
	OUTSTR [ASCIZ /
/]
	JRST BEGL

PUT:	SOSG OBUF+2
	OUT DKOC,
	JRST PUT1
	JRST 4,.
PUT1:	IDPB I,OBUF+1
	POPJ P,
;THINGS HAVING TO DO WITH THE SIZE OF THE 11'S CORE:  SETSIZ
COMMENT ⊗

SETSIZ:	MOVE T,D
	IMULI T,=2048
	MOVEM T,HCOR
	SETZM LOWAD
	MOVEM T,HIAD
	LSH T,-1		;HCOR/2
	MOVEM T,HCOR2
	HRLM T,FILBPT+1
	SUBI T,1		;<HCOR-2>/2 (OREG)
	HRRM T,RDOREG
	HRRM T,WROREG
	SUBI T,1		;<HCOR-4>/2 (IREG)
	HRRM T,WRIREG
	HRRM T,RDIREG
	HRRM T,WRBOTH
	MOVE TT,T
	LSH TT,1
	HRRM TT,INIRTN+5
	SUBI T,1		;<HCOR-6>/2 (TTY FLAG)
	HRRM T,WR10FL
	HRRM T,RD10FL
	HRLM T,ZERCOR+1
	SUBI T,1		;<HCOR-10>/2 (Pristine symbol table top)
	HRRM T,SMTOPW
	HRRM T,SMTOPR
	SUBI T,6		;<HCOR-24>/2 (Initialization routine)
	TRO T,400000
	HRRM T,INIT11
	LSH T,1
	HRRM T,INIADR+1
	HRLM T,CLKVEC+1
	MOVE T,HCOR2
	SUBI T,14001		;<HCOR-30002>/2
	HRRM T,SYMADR
	SUBI T,1		;<HCOR-30004>/2
	HRRM T,STADR
	SUBI T,1
	LSH T,1			;HCOR-30006
	MOVEM T,SYMEND
	MOVE T,D
	MOVEI I,0
	MOVE J,[POINT 6,I]
	IDIVI T,=10
	ADDI T,'  0'
	IDPB T,J
	ADDI TT,'  0'
	IDPB TT,J
	MOVEI K,'  K'
	IDPB K,J
	MOVEM I,DDTEXT
	POPJ P,

HCOR:	0			;1st NXM address
HCOR2:	0			;HCOR/2
⊗
LPDL←←30
PDL:	BLOCK LPDL
SAVPPN:	0		;HAS CURRENT DSK PPN
LUP:	BLOCK 4
ENT:	BLOCK 4
IBUF:	BLOCK 3
OBUF:	BLOCK 3
JMPBLF:	-1
PROGSA:	-1		;PROGRAM'S STARTING ADDRESS
MINUSF:	0
LCHRET:	0		;-1 => JUST GOT CR
DDTSA:	0		;DDT'S STARTING ADDRESS
OVERLF:	0		;-1 FOR OVERLAY
NOSYMS:	0		;-1 FOR NO SYMS LOADED AT DDTL
WORD:	0
SEP:	0

END	BEG