File BMCOPY.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/ BEAM COPY PROGRAM
	*100
MSG,	AMSG
NGETLN,	ANGLN
ERR,	0
DTIO,	ADTIO
SEARCH,	ASEARC
BN,	0
ID,	0
PTR,	0
CHR2,	0
CHR,	0
/
/
	IBUF=PROGEN
	OBUF=IBUF+1205
	BFR=OBUF+603
/
/
/
	*200
	TLS
	KRB
ISTART,	CLA CLL
	TAD (ISTART)	/SET ERROR
	DCA ERR
	TAD (MSG01)	/BEAM COPY__INPUT UNIT:
	JMS I MSG
	JMS I NGETLN	/GET UNIT NO
	RTR		/STORE UNIT NO
	RTR
	AND (7000)
	DCA UNIT
	TAD (MSG02)	/INPUT ID:
	JMS I MSG
	JMS I NGETLN	/GET ID NO
	DCA ID
	TAD (IBUF-1)	/SET CORE ADDRESS
	DCA LOC
	TAD (1000)	/SET BLOCK NO
	DCA BLOCK
	TAD (-1205)	/SET LENGTH OF TRANSFER
	DCA LENGTH
	JMS I DTIO
	TAD ID		/SET ID FOR SEARCH
	JMS I SEARCH
	 NOP
	JMP ERR1
	TAD BN		/SET BLOCK FOR READ
	DCA BLOCK
	TAD (-603)	/SET LENGTH OF TRANSFER
	DCA LENGTH
	TAD (OBUF-1)	/SET CORE ADDRESS
	DCA LOC
	JMS I DTIO	/READ BEAM DATA INPUT
OSTART,	TAD (OSTART)	/SET ERROR
	DCA ERR
	TAD (MSG05)	/OUTPUT UNIT:
	JMS I MSG
	JMS I NGETLN	/GET UNIT NO
	RTR		/STORE UNIT NO
	RTR
	AND (7000)
	DCA UNIT
	TAD (MSG06)	/OUTPUT ID
	JMS I MSG
	JMS I NGETLN
	DCA ID		/STORE ID NO
	TAD (IBUF-1)	/SET CORE ADDRESS
	DCA LOC
	TAD (1000)	/SET BLOCK
	DCA BLOCK
	TAD (-1205)	/SET LENGTH
	DCA LENGTH
	JMS I DTIO	/READ DIRECTORY - OUTPUT
	TAD ID
	JMS I SEARCH
	 JMP ERR2
	 JMP .+2
	 JMP ERR3
	CLA CLL CMA RAL	/SET AC=-2
	TAD 10
	DCA 10
	TAD I 10	/GET LAST BLOCK NO
	TAD (3)
	DCA BN
	TAD ID
	DCA I 10	/STORE AS NEXT BLOCK NO
	TAD BN
	DCA I 10
	DCA I 10	/CLEAR NEXT BLOCK NO
	IAC
	JMS I DTIO	/WRITE NEW DIRECTORY
	TAD BN
	DCA BLOCK
	TAD (OBUF-1)	/SET BUFFER
	DCA LOC
	TAD (-603)	/SET LENGTH
	DCA LENGTH
	JMS I DTIO	/WRITE NEW BEAM
	TAD (MSG09)
	JMS I MSG	/__DONE(Y OR N)?:
	JMS GETC
	TAD (-331)
	SNA CLA
	JMP 7600
	JMP ISTART
/
/
/
	PAGE
ASEARC,	0
	CIA	/SET SEARCH ID
	DCA SID
	TAD LOC
	DCA 10	/SET BUFFER POINTER
	TAD (-502)	/SET COUNTER
	DCA 11
SLOOP,	TAD I 10
	SNA
	JMP EXIT2	/BLOCK NO IS 0 - END DIRECTORY
	TAD SID
	SNA CLA
	JMP EXIT3	/ID FOUND - EXIT NORMAL
	ISZ 10
	ISZ 11
	JMP SLOOP
	JMP EXIT1	/END OF DIRECTORY AREA
EXIT3,	ISZ ASEARC	/NORMAL RETURN
	TAD I 10
	DCA BN
EXIT2,	ISZ ASEARC	/ERROR2 RETURN
EXIT1,	JMP I ASEARC	/ERROR1 RETURN
SID,	0
/
/
/
ADTIO,	0
	TAD UNIT
	DCA UNIT
	JMS IDTAPE
UNIT,	0
BLOCK,	0
LENGTH,	0
LOC,	0
	ERROR
	JMP I ADTIO
ERROR,	CLA CLL
	TAD (MSG03)	/DECTAPE ERROR
	JMS I MSG
	JMP I ERR
/
/
ERR1,	TAD (MSG04)	/ID NOT FOUND
	JMS I MSG
	JMP I ERR
/
ERR2,	TAD (MSG07)	/DIRECTORY FULL
	JMS I MSG
	JMP I ERR
/
ERR3,	TAD (MSG08)	/ID USED ALREADY
	JMS I MSG
	JMP I ERR
/
/
/
ANGLN,	0
	TAD (BFR-1)
	DCA 12
NXTCR,	JMS GETC	/GET CHARACTER
	DCA CHR
	TAD CHR
	TAD (-215)	/IS IT CR
	SNA
	JMP LININ	/YES
	TAD (215-377)	/RO?
	SZA CLA
	JMP STR
	CLA CMA
	TAD 12
	DCA 12
	JMP NXTCR
STR,	TAD CHR		/OK CHR - STORE IT
	TAD (-260)
	DCA I 12
	JMP NXTCR
LININ,	DCA CHR
	TAD 12
	CIA
	DCA PTR
	TAD (BFR-1)
	DCA 12
NLOOP,	TAD 12		/CHECK BUFFER POSITION
	TAD PTR
	SMA CLA
	JMP OUT
	CLL CLA
	TAD CHR		/MULTIPLY BY 10.
	RAL
	DCA CHR
	TAD CHR
	RTL
	TAD CHR
	TAD I 12	/ADD THIS DIGIT
	DCA CHR
	JMP NLOOP
OUT,	TAD CHR
	JMP I ANGLN
/
/
GETC,	0
	KSF
	JMP .-1
	KRB
	TLS
	JMP I GETC
/
/
/
/
	PAGE
AMSG,	0
	TAD (-1)
	DCA 13
NXTM,	TAD I 13
	DCA CHR2
	TAD CHR2
	RTR CLL
	RTR
	RTR
	AND (77)
	JMS PTRC
	TAD CHR2
	AND (77)
	JMS PTRC
	JMP NXTM
PTRC,	0
	DCA CHR
	TAD CHR
	SNA
	JMP I AMSG
	TAD (-37)
	SNA CLA
	JMP CRLF
	TAD CHR
	TAD (240)
	AND (277)
	TAD (40)
	JMS PRTCH
	JMP I PTRC
CRLF,	TAD (215)
	JMS PRTCH
	TAD (212)
	JMS PRTCH
	JMP I PTRC
/
PRTCH,	0
	TSF
	JMP .-1
	TLS
	CLA CLL
	JMP I PRTCH
/
/
	PAGE
MSG01,	TEXT /___BEAM COPY__INPUT UNIT: /
MSG02,	TEXT /_INPUT ID: /
MSG03,	TEXT /____DECTAPE ERROR!!!__/
MSG04,	TEXT /_ID NOT FOUND_/
MSG05,	TEXT /_OUTPUT UNIT: /
MSG06,	TEXT /_OUTPUT ID: /
MSG07,	TEXT /_DIRECTORY FULL_/
MSG08,	TEXT /_ID ALREADY USED_/
MSG09,	TEXT /__DONE(Y OR N)? : /
/
	PAGE
ID7400,	7400
IDTAPE,	0
	CLA
	TAD I IDTAPE
	DCA IDCODE
	ISZ IDTAPE
	TAD IDCODE
ID0200,	AND ID7400
	TAD ID0010
	DTCA DTXA
	DTLB
	TAD IDWC
	DCA I IDCA
IDSERR,	RTL
	RAL
	CLA CML
	TAD ID0200
IDCONT,	SNL
	TAD ID0400
	DTXA
	DTSF DTRB
	JMP .-1
	SPA
	JMP IDSERR
	DTRA
	RTL
RTL
	SZL CLA
	TAD ID0002
	TAD I IDWC
	CMA
	TAD I IDTAPE
	CMA
	SZA CLA
	JMP IDCONT
	SZL
	JMP IDCONT+1
	ISZ IDTAPE
	TAD I IDTAPE
	DCA I IDWC
	ISZ IDTAPE
	TAD I IDTAPE
	DCA I IDCA
	TAD IDCODE
	DTLB
	IAC
	AND IDCODE
	RTL CLL
	RTL
	TAD ID0130
	DTXA
	DTSF DTRB
	JMP .-1
	ISZ IDTAPE
	SMA
	ISZ IDTAPE
	SPA CLA
	TAD IDCODE
	RTR
	SNL CLA
	JMP .+3
	TAD I IDTAPE
	DCA IDTAPE
	DTRA
	AND ID0200
	TAD ID0002
	DTXA
	JMP I IDTAPE
IDWC,	7754

IDCA, 7755 ID0010, 10 ID0400, 400 ID0130, 130 ID0002, 2 IDCODE, 0 / / / / PROGEN, 0
$$$

/ BEAM TRANSFER PROGRAM / *100 MSG, AMSG NGETLN, ANGETLN ERR, 0 DTIO, ADTIO SEARCH, ASEARC BN, 0 ID, 0 CHR, 0 IBUF=1000 OBUF=IBUF+1205 BFR=OBUF+603 / / / MAIN PROGRAM *200 TLS 6036 ISTART, CLA CLL TAD (ISTART) /SET ERROR DCA ERR TAD (MSG01) /"__BEAM COPY__INPUT UNIT: " JMS I MSG JMS I NGETLN /GET UNIT NO RTR RTR AND (777) DCA UNIT /STORE UNIT NO TAD (MSG02) /"INPUT ID: " JMS I MSG JMS I NGETLN /GET INPUT ID DCA ID TAD (IBUF-1) /SET CORE ADDRESS DCA LOC TAD (1000) /SET BLOCK NO DCA BLOCK TAD (-1205) DCA LENGTH /SET LENGTH JMS I DTIO /READ DIRECTORY TAD ID /SET FOR ID SEARCH JMS I SEARCH NOP JMP ERR1 TAD BN /SET BLOCK TO READ DCA BLOCK TAD (-603) /SET LENGTH DCA LENGTH TAD (OBUF-1) /SET BUFFER DCA LOC JMS I DTIO /READ IN BEAM DATA OSTART, TAD (OSTART) /SET ERROR DCA ERR TAD (MSG05) /"_OUTPUT UNIT: " JMS I MSG JMS I NGETLN /GET OUTPUT UNIT RTR RTR AND (777) DCA UNIT /STORE UNIT TAD (MSG06) /"OUTPUT ID: " JMS I MSG JMS I NGETLN /GET ID DCA ID TAD (IBUF-1) /SET BUFFER DCA LOC TAD (1000) /SET FOR OUTPUT DIRECTORY DCA BLOCK TAD (-1205) /SET LENGTH DCA LENGTH JMS I DTIO /READ DIRECTORY TAD ID JMS I SEARCH /FIND ID JMP ERR2 /DIRECTORY FULL JMP .+2 /ID NOT FOUND IN DIRECTORY JMP ERR3 /ID ALREADY IN DIRECTORY CLA CLL CMA RAL /AC=-2 TAD 10 DCA 10 TAD I 10 /GET LAST BLOCK NO TAD (3) /SET TO FREE AREA ISZ 10 DCA BN /STORE NEW BLOCK NO TAD BN DCA I 10 TAD ID DCA I 10 /STORE NEW ID DCA I 10 /MARK NEW DIRECTORY END IAC /SET FOR WRITE JMS I DTIO /WRITE DIRECTORY TAD BN /SET BLOCK NO DCA BLOCK TAD (OBUF-1) /SET BUFFER DCA LOC TAD (-603) /SET LENGTH DCA LENGTH IAC /SET FOR WRITE JMS I DTIO /WRITE DATA JMP ISTART /GO BACK TO BEGINNING / / *400 ASEARC, 0 CIA /SET SEARCH ID DCA SID TAD LOC /SET BUFFER POINTER DCA 10 TAD (-502) /SET COUNTER DCA 11 SLOOP, TAD I 10 /GET BLOCK NO SNA JMP EXIT2 /END OF DIRECTORY DCA BN /SAVE CURRENT BLOCK NO TAD I 10 /COMPARE ID WITH THIS ENTRY'S TAD SID SMA CLA JMP EXIT3 /FOUND ID MATCH ISZ 11 /NOT FOUND - CHECK POSITION JMP SLOOP JMP EXIT1 /OUT OF DIRECTORY SPACE EXIT3, IS / BEAM TRANSFER PROGRAM / *100 MSG, AMSG NGETLN, ANGETLN ERR, 0 DTIO, ADTIO SEARCH, ASEARC BN, 0 ID, 0 CHR, 0 IBUF=1000 OBUF=IBUF+1205 BFR=OBUF+603 / / / MAIN PROGRAM *200 TLS 6036 ISTART, CLA CLL TAD (ISTART) /SET ERROR DCA ERR TAD (MSG01) /"__BEAM COPY__INPUT UNIT: " JMS I MSG JMS I NGETLN /GET UNIT NO RTR RTR AND (777) DCA UNIT /STORE UNIT NO TAD (MSG02) /"INPUT ID: " JMS I MSG JMS I NGETLN /GET INPUT ID DCA ID TAD (IBUF-1) /SET CORE ADDRWQS QAA LOC TAD (1000) /SET BLOCK NO DCA BLOCK TAD (-1205) DCA LENGTH /SET LENGTH JMS I DTIO /READ DIRECTORY TAD ID /SET FOR ID SEARCH JMS I SEARCH NOP JMP ERR1 TAD BN /SET BLOCK TO READ DCA BLOCK TAD (-603) /SET LENGTH DCA LENGTH TAD (OBUF-1) /SET BUFFER DCA LOC JMS I DTIO /READ IN BEAM DATA OSTART, TAD (OSTART) /SET ERROR DCA ERR TAD (MSG05) /"_OUTPUT UNIT: " JMS I MSG JMS I NGETLN /GET OUTPUT UNIT RTR RTR AND (777) DCA UNIT /STORE UNIT TAD (MSG06) /"OUTPUT ID: " JMS I MSG JMS I NGETLN /GET ID DCA ID TAD (IBUF-1) /SET BUFFER DCA LOC TAD (1000) /SET FOR OUTPUT DIRECTORY DCA BLOCK TAD (-1205) /SET LENGTH DCA LENGTH JMS I DTIO /READ DIRECTORY TAD ID JMS I SEARCH /FIND ID JMP ERR2 /DIRECTORY FULL JMP .+2 /ID NOT FOUND IN DIRECTORY JMP ERR3 /ID ALREADY IN DIRECTORY CLA CLL CMA RAL /AC=-2 TAD 10 DCA 10 TAD I 10 /GET LAST BLOCK NO TAD (3) /SET TO FREE AREA ISZ 10 DCA BN /STORE NEW BLOCK NO TAD BN DCA I 10 TAD ID DCA TAD (-337) /CHECK FOR _ SNA CLA JMP CRLF TAD CHR TAD (240) AND (277) TAD (40) JMS PRTCH JMP I PRTC CRLF, TAD (215) JMS PRTCH TAD (212) JMS PRTCH JMP I PRTC / / PRTCH, 0 TSF JMP .-1 TLS JMP I PRTCH / / / / *BFR+30 MSG01, TEXT /__BEAM COPY__INPUT UNIT: / MSG02, TEXT /_INPUT ID: / MSG05, TEXT /_OUTPUT UNIT: / MSG06, TEXT /_OUTPUT ID: / MSG03, TEXT /__DECTAPE ERROR!!!!____/ MSG04, TEXT /_ID NOT FOUND / MSG07, TEXT /_DIRECTORY FULL? MSG08, TEXT /_ID ALREADY USED/ / / PAGE ID7400, 7400 IDTAPE, 0 CLA TAD I DTAPE DCA IDCODE ISZ IDTAPE TAD IDCODE ID0200, AND ID7400 TAD ID0010 DTCA DTXA DTLB TAD IDWC DCA I IDCA IDSERR, RTL RAL CLA CML TAD ID0200 IDCONT, SNL TAD ID0400 DTXA DTSF DTRB JMP .-1 SPA JMP I DSERR DTRA RTL RTL SZL CLA TAD ID0002 TAD I IDWC CMA TAD I IDTAPE CMA SZA CLA JMP IDCONT SZL JMP IDCONT+1 ISZ IDTAPE



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search