A large commit.

[pdp8.git] / sw / os8 / v3d / sources / devext / dectapes / dectape1 / savecb.pa

/SAVECB.PA	DEMONSTRATION PROGRAM TO INCREASE THE NUMBER OF SAVE ARGUMENTS
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f	/SAVCB.PA  INCREASES THE NUMBER OF SAVE ARGUMENTS         JULY 1978
/	MEMORY LOCATIONS UTILIZED
/	0000-1177	/PROGRAM CODE
/	1200-1377	/TTY INPUT BUFFER
/	1400-1577	/ORIGINAL CCB BUFFER
/	1600-1710	/ADJUSTED CCB BUFFER
/	1710-1777	/PROGRAM CODE


	/PAGE ZERO
	*0
REDERR,	JMS I [CRLF	/ILLEGAL INPUT ERROR
	JMS I [PRMSG
	TEXT	/INPUT?/
	JMP I ERR
	*10
LXR,	1177		/AUTO INDEX FOR INPUT STORAGE
CXR,	0		/AUTO INDEX
XR,	1377
NXR,	1577
TX,	0
	*20
SHNDLR,	7607
ERR,	7605
TEMP,	0		/INPUT NUMBER STORAGE
TMP1,	0		/INPUT NUMBER STORAGE
DIGFLG,	0		/NUMBER PRESENT FLAG
TEMP1,	0		/INPUT FIELD STORAGE
TEMP2,	0		/INPUT ADDRESS STORAGE
CMND,	0
CHARID,	0		/
DLID,	0		/DELIMITER STORAGE
FIRST1,	0		/STORAGE FOR SEGMENT FIELD INPUT
FIRST2,	0		/STORAGE FOR SEGMENT ADDRESS INPUT
CNT,	0		/SEGMENT COUNTER
FLD,	0		/USED IN CCB FIELD PRINTING
TMP,	0		/TEMPORARY STORAGE-TEXT PRINTING
TCB,	0		/PRMSG CALL I.D.
ORG,	0		/ORIGIN STORAGE
COUNT,	-110
BUMP,	-2		/USED AS TEST IN LOAD LOOP
RBFLG,	0
SEGCNT,	-4
\f
	*200
START,	CDF 0
	CIF 10		/CALL COMMAND DECODER
	JMS I [200
	5
	2326		/SV. EXTENSION---ASSUMED INPUT
	CIF 0
	CDF 10
	TAD I [7620	/STARTING BLOCK OF FILE
	CDF 0
	DCA STFLE	/SET UP LOADING OF CCB BLOCK
LOAD,	JMS I [7607	/LOAD CCB
	0101
LOC,	1400		/INTO 1400
STFLE,	0		/STARTING BLOCK OF FILE
	JMP REDERR	/
	TAD I XR	/MOVE CCB UP TO 1600
	DCA I NXR
	ISZ COUNT	/ALL DONE?
	JMP .-3
	JMS I (VERMSG	/PRINT CCB WRITING INFO
CONT,	JMS CRLF	/INITIALIZE LINE
	JMS IDCHAR	/PRINT INPUT SIGNAL CHARACTER
REATTY,	KSF		/WAITING FOR FLAG TO DISAPPEAR
	JMP .-1
	JMS I [CTCTST	/...CTRL/C?
	TAD [203	/NO-RE-INSTATE CHARACTER
	JMS I [RBLFT	/TEST FOR LINE FEED,RUBOUT
	TAD [225
	DCA TEMP	/STORE CHARACTER
	KCC		/CLEAR KEYBOARD,AC
	TAD TEMP
	JMS I [TYPIT
	TAD TEMP
	TAD [-215	/IS IT THE END OF THE LINE?
	SNA
	JMP I [SAVE1
	TAD [-63	/IS IT THE END OF INPUT(@)?
	SNA
	JMP I [SAVE
	CLL CLA
	TAD TEMP
	DCA I LXR	/STORE AWAY CHARACTER
	TAD LXR
	TAD [-1110
	SNA CLA		/TEST FOR LINE OVERFLOW
	JMP I [BARG
	JMP REATTY


CRLF,	0		/CARRAIGE RETURN--LINE FEED ROUTINE
	CLL CLA
	TAD [215
	JMS I [TYPIT
	TAD [212
	JMS I [TYPIT
	JMP I CRLF
IDCHAR,	0		/PRINT A #, IT SIGNALS INPUT TIME
	CLA
	DCA RBFLG	/INITIALIZE RUBOUT FLAG
	DCA TEMP1	/INITIALIZE INPUT STORAGE WORD
	TAD [243
	JMS I [TYPIT
	JMP I IDCHAR
TYCCB,	JMS CRLF
	TAD [211
	JMS I [TYPIT
	TAD [1377	/ROUTINE TO TYPE OUT CCB INFO
	DCA CXR
	TAD I CXR	/ADJUST SEGMENT INFO
	CLL RAL
	STL RAR
	DCA CNT		/NUMBER OF SEGS
	JMS I [PRMSG
	TEXT /START=/
RTRN1,	TAD I CXR	/GET CIF CDF OF STARTING FIELD
	AND [174
	DCA FLD		/STORE IT
	TAD FLD
	AND [104		/ISOLATE BANK BITS
	CLL RTR		/SWITCH THEM AROUND
	RAR
	SZL
	TAD [4
	CLL RTR
	TAD [260
	JMS I [TYPIT
	TAD FLD		/TIME TO TYPE FIELDS
	AND [70
	CLL RTR
	RAR
	TAD [260
	JMS I [TYPIT
TYORG,	TAD I CXR
	JMS I [PWORD	/PROCESS ORIGIN WORD
	TAD [211	/PRINT ATAB TO SEPARATE HEADINGS
	JMS I [TYPIT
TYJSW,			/SET TYCCB CALL FLAG
	JMS I [PRMSG	/PRINT JSW HEADING
	TEXT /JSW=/
RTRN2,	TAD I CXR
	JMS I [PWORD	/PRINT JSW
	JMS CRLF
	JMS CRLF
TYSEGS,	
	JMS I [PRMSG
	TEXT /CORE SEGMENTS:/
	JMS CRLF
	JMS CRLF
	JMP I [SEGSM2	/PROCESS SEGMENTS
\f	*400
PRINT,	JMS PRWD
	ISZ PRMSG	/GET MORE TEXT
	SKP
PRMSG,	0		/ROUTINE TO PRINT TEXT
	CLA
	TAD I PRMSG
	SZA
	JMP PRINT
	TSF
	JMP .-1
	ISZ PRMSG	/TYCCB RETURN
	JMP I PRMSG
PRWD,	0		/ROUTINE TO ISOLATE AND PRINT TEXT CHARS
	DCA TMP		/SAVE PACKED SIX BIT CHARS
	TAD TMP
	BSW		/POSITION FIRST CHAR FOR PRINTING
	JMS PCHAR	/PRINT IT
	TAD TMP		/ISOLATE SECOND CHARACTER
	JMS PCHAR	/PRINT IT
	JMP I PRWD
PCHAR,	0	/ROUTINE FOR CONVERTING TEXT CHARS TO ASCII
	AND [77		/ISOLATE SIX BITS
	SNA 
	JMP I PCHAR
	TAD [240	/CONVERSION TO ASCII
	AND [77
	TAD [240
	JMS TYPIT	/PRINT CHARACTER
	JMP I PCHAR
TYPIT,	0		/ROUTINE TO PRINT CHARACTERS
	TLS
	TSF
	JMP .-1
	CLA
	JMS CTCTST	/TEST FOR CONTROL/C
	CLL CLA
	JMP I TYPIT
CTCTST,	0		/SEE IF USER WANTS OUT, CTRL/C...
	TAD [200
	KSF
	STA
	KRS
	TAD [-203	/IS IT A CTRL/C?
	SNA
CTLC,	JMP I ERR	/ CTRL/C MEANS GETOUT...
	JMP I CTCTST	/RETURN
RBLFT,	0
	TAD [-377	/IS IT A DELETE?

	SNA
	JMP I [DELETE
	TAD [377-212	/IS IT A LINE FEED?
	SNA

	JMP I [LFEED
	TAD [212-225
	SZA		/IS IT A CTRL/U?
	JMP I RBLFT
	TAD [225
	JMS I [TYPIT
	JMP I [NEXTLN

SSTADR,	TAD TEMP1	/ADJUST FIELD
	CLL RTR		/TRANSFORM FOR CDF--"37" TO "174"
	RTR
	BSW
	SZL
	TAD [4
	TAD [6203
	DCA I [1401	/STORE STARTING FIELD CDF CIF
	TAD TEMP2
	DCA I [1402	/STORE AWAY STARTING ADDRESS
	JMP ENDTST
SSBITS,	TAD TEMP2
	DCA I [1403	/STORE AWAY JSW
ENDTST,	TAD LXR		/TEST FOR END OF INPUT LINE
	CIA
	TAD CXR
	SMA CLA
	JMP TESTE	/TEST FOR CR/LF OR @
	JMP I [SDFLG
DASH,	TAD TEMP1	/ROUTINE TO PROCESS TRIPLET
	CIA CLL CML
	TAD FIRST1
	SZA CLA		/ARE THE FIELDS THE SAME?
	JMP I [BARG	/NO ERROR
	TAD TEMP2
	AND [7600
	TAD [200
	DCA TEMP2
	TAD TEMP2
	CIA
	TAD FIRST2
	SZL CLA		/ISI UPPER LIMIT > LOWER LIMIT?
	JMP I [BARG	/NO ERROR
	TAD [1403	/SET INDEX REGISTER
	DCA XR
	STA
	TAD I [1400		/INITIALIZE SEGMENT COUNTER
	DCA COUNT
	JMP I [FLDTST	/PROCESS SEGMENT
TESTE,	TAD TEMP	/TEST FOR WHETHER END OF LINE OR INPUT
ENTST,	TAD [-215		/WAS IT ACARRAIGE RETURN?
	SNA
	JMP I [NEXTLN		/YES PREPARE FOR NEXT LINE
	TAD [215-"@		/WAS IT EXIT TIME?
	SNA
	JMP I [WRCCB		/EXIT ROUTINE
	JMP REDERR	/ILLEGAL INPUT
PWORD,	0	/ROUTINE TO PROCESS ORIGIN OR JSW WORDS
	DCA ORG
	TAD ORG
	BSW		/PROCESS HIGHER BIT FIRST
	JMS SECT2
	TAD ORG		/NOW PROCESS LOWER BITS
	JMS SECT2
	JMP I PWORD
SECT2,	0	/ROUTINE TO PRINT DOUBLE DIGIT
	DCA TEMP1
	TAD TEMP1
	AND [70		/ISOLATE HIGHER DIGIT
	CLL RTR
	RAR
	TAD [260
	JMS I [TYPIT
	TAD TEMP1
	AND [7		/ISOLATE LOWER DIGIT
	TAD [260
	JMS I [TYPIT
	JMP I SECT2

\f
	*600
GTNM,	DCA DIGFLG	/RESET DIGIT FLAG
	DCA TEMP1	/CLEAR FIELD STORAGE
	DCA TEMP2	/CLEAR ADDRESS STORAGE
GETNUM,	TAD I CXR	/ROUTINE TO ORGANIZE LINE INPUT
	TAD [-270	/TEST FOR NUMBER
	CLL
	TAD [10
	SNL
	JMS NOTNUM	/NO NUMBER
	DCA TMP1	/STORE NUMBER
	ISZ DIGFLG	/SET NUMBER FLAG
	JMS ROT		/ORGANIZE ARGUMENT INTO TWO WORDS
	JMS ROT		/TEMP1 FOR THE FIELD
	JMS ROT		/TEMP2 FOR ADDRESS
	TAD TEMP2
	TAD TMP1	/TAD IN NEW DIGIT
	DCA TEMP2
	JMP GETNUM
SDFLG,	TAD CHARID	/ADD DELIMITER
	DCA DLID	/STORE IT
	TAD TEMP2	/STORE PRESENT ADDRESS AWAY
	AND [7600
	DCA FIRST2
	TAD TEMP1	/STORE FIELD ALSO
	AND [37
	DCA FIRST1
	JMP GTNM
\f
ROT,	0		/ROUTINE TO ROTATE FIELD AND ADDRESS
	TAD TEMP2	/ADDRESS REGISTER
	CLL RAL		/MOVE POTENTIAL FIELD BIT INTO LINK
	DCA TEMP2	/NOW READY FOR NEW INPUT - TMP1
	TAD TEMP1
	RAL		/STORE FIELD BITS
	DCA TEMP1
	JMP I ROT
NOTNUM,	0
	CLL
	TAD [260	/CONVERT TO ASCII
	DCA CHARID
	TAD DIGFLG
	SNA CLA
	JMS ACORS	/IF NO DIGIT,MUST BE A COMMAND
	TAD DLID	/PROCESS INPUT NUMBER
	SNA		/ZERO INDICATES FIRST NUMBER
	JMP SDFLG	/PREPARE FOR NEXT NUMBER
	TAD [-"-	/IS IT A DASH?
	SNA
	JMP I [DASH	/PROCESS TRIPLET
	TAD ["--",	/IS IT A COMMA?
	SNA
	JMP SDFLG	/GET SECOND NUMBER
	TAD [",-";	/IS IT A SEMI-COLON?
	SNA
	JMP I [SSTADR	/PROCESS START ADDRESS
	TAD [";-"=	/IS IT AN EQUALS
	SNA CLA
	JMP I [SSBITS	/PROCESS JSW
	JMP SDFLG
ACORS,	0	/TEST FOR ADD,SUB,OR CHANGE
	TAD CHARID
	TAD [-"T	/IS IT A TYPE INST?
	SNA
	JMP I [TYCCB	/IF SO PROCESS IT
	TAD ["T-"A	/IS IT AN ADDITION?
	SNA
	JMP CEND
	TAD ["A-"S	/IS IT A DELETION?
	SZA CLA
	JMP SDFLG	/TEST FOR @ OR CR/LF
	IAC
CEND,	DCA CMND	/STORE COMMAND FLAG

	JMP GTNM
SAVE1,	JMS I [CRLF	/PROCESS END OF LINE
SAVE,	TAD [1177	
	DCA CXR		/POINT TOWARD START OF LINE
	TAD LXR		/WAS THEIR ANY INPUT?
	CIA
	TAD CXR
	SNA CLA		/IF LXR EQUALS CXR, THERE WAS NONE
	JMP I [TESTE	/TEST FOR CR/LF OR @
	DCA I LXR	/SET DELIMITER
	JMP I [GETNUM	/GET INPUT
\f
ATEST,	CLA
	TAD CMND	/WHAT IS THE COMMAND?
	SZA CLA		/IF NOT THE ADD COMMAND...
	JMP I [BARG	/THEN ERROR RETURN
	TAD COUNT	/IS IT TO BE ADDED ON THE END?
	SZA CLA	/IF COUNT IS ZERO, YES...
	TAD [-2		/PUSH BACK INDEX TO SAVE LAST SEGMENT
	TAD XR
	DCA XR
	TAD XR		/ADDITION CODE
	AND [77		/ISOLATE WHERE WE ARE IN THE CCB
	TAD [1600	/REFERENCE SAME LOCATION IN ADD BUFFER
	DCA NXR		/STORE FOR MOVE
	TAD FIRST2	/STORE INPUT'S ORIGIN
	DCA I NXR
	JMS I [SEGADJ	/ADJUST SECOND WORD FOR CCB
	DCA I NXR
	STA
	DCA BUMP	/SET ADD INDICATOR
	JMP I [MOVE	/MOVE CCB
STEST,	STA		/DELETION PROCESSOR

	TAD CMND
	SZA CLA		/IS A DELETION?
	JMP I [BARG	/IF NOT ERROR
	TAD XR		/SET BACK POINTER FOR DELETION
	TAD [176	/ADD 200 TO REFERENCE 1600 BUFFER
	DCA NXR
	IAC		/SET DELETION PARAMETER
	DCA BUMP
	JMP I [MOVE	/MOVE CCB
	PAGE
\f

	*1000
	/ROUTINE TO PROCESS CCB SEGMENTS FOR TYPING
SEGSM2,	TAD [-4
	DCA SEGCNT
SEGS,	TAD I CXR	/GET FIRST SEGMENT
	DCA TMP1
	TAD I CXR	/GET SECOND WORD OF SEGMENT
	DCA FLD
	JMS TFIELD
	JMS I [SECT2
	TAD TMP1	/TYPE ORIGIN OF SEGMENT
	JMS I [PWORD	/TYPE IT
	TAD [255	/TYPE HYPHEN
	JMS I [TYPIT
	JMS TFIELD	/TYPE FIELD
	JMS I [SECT2
	TAD FLD		/CALCULATE HIGHER LIMIT
	AND [3700	/ISOLATE NUMBER OF PAGES
	TAD [-100	/MINUS A PAGE TO BE REPLACED BY 
	CLL RAL
	TAD [177	/A PAGE FULL OF LOCATIONS
	TAD TMP1
	JMS I [PWORD
	ISZ CNT		/IS THAT ALL THE SEGS?
	JMP .+5		/NO ... CONTINUE
	JMS I [CRLF
	TAD [1177
	DCA LXR		/RESET INPUT POINTER
	JMP I [CONT	/
	ISZ SEGCNT	/IS THAT THE FOURTH SEGMENT?
	JMP .+4		/NO...CONTINUE
	JMS I [CRLF
	JMS I [CRLF
	JMP I [SEGSM2
	TAD [",
	JMS I [TYPIT
	TAD [240
	JMS I [TYPIT
	JMP SEGS
FLDTST,	ISZ COUNT	/IS THAT ALL THE SEGS?
	SKP CLA
	JMP I [ATEST	/IF SO PROCESS COMMAND
	TAD I XR		/SEARCH FOR FIELD ETC.	PAGE
	DCA TMP		/STORE SEGMENT ORIGIN
	TAD I XR
	DCA FLD		/STORE SEGMENT'S SECOND WORD
	JMS TFIELD	/ADJUST FIELD...
	CIA		/RETURNS WITH FIELD IN AC
	TAD TEMP1	/IS IT THE SAME FIELD AS INPUT?
	SPA 		/OR IS IT LESS THAN FIELD OF INPUT?		
	JMP FLDTST	/NEITHER...
	SZA CLA		/IF IT IS LESS THAN INPUT'S FIELD
	JMP I [ATEST	/IT SHOULD BE AN ADD
	TAD FIRST2		/TEST INPUT'S ORIGIN
	CIA		/IS IT LESS THAN OR EQUAL TO SEGMENT'S ORIGIN?
	TAD TMP
	SNA
	JMP I [STEST	/IF EQUAL TEST FOR DELETION
	SMA CLA
	JMP I [ATEST	/IF LESS TEST FOR ADDITION
	JMP FLDTST	/OTHERWISE CHECK NEXT SEGMENT
TFIELD,	0	/ROUTINE TO TRANSFORM FIELDS FOR TYPING
	TAD FLD
	AND [76
	CLL RTR
	SZL		/ISOLATE BANK BIT "A"
	TAD [40
	CLL RAR
	SZL		/ISOLATE BANK BIT "B"
	TAD [10
	JMP I TFIELD
SEGADJ,	0		/ROUTINE TO ORGANIZE CCB SEGMENT SECOND WORD
	TAD FIRST2	/CALCULATE NUMBER OF PAGES
	CIA
	TAD TEMP2	/BY DIFFERENCING THE INPUT ADDRESSES
	AND [7600
	CLL RAR		/AND HALVING INTO PAGES
	DCA FIRST2	/STORE FOR CCB LOAD

	TAD TEMP1	/ADD IN FIELD
	JMS CCBFLD	/RE-ORGANIZE IT FOR CCB
	TAD FIRST2	/COMBINE FIELD AND PAGES FOR CCB SEGMENT
	JMP I SEGADJ
CCBFLD,	0		/ROUTINE TO CHANGE FIELD INTO CCB FORM
	CLL RTR		/STARTS WITH A '37' IN AC
	RTR
	SZL		/TEST FOR B BANK BIT
	TAD [400
	CLL RAR
	SZL		/TEST FOR A BANK BIT
	TAD [100
	CLL RTR
	RTR
	RAR		/RETURN WITH A '76' IN AC
	JMP I CCBFLD
MOVE,	JMS MOVA	/MOVE TIME
	TAD BUMP	/IF YES, RESET SEGMENT NUMBER
	TAD I [1400
	DCA I [1400
REMOVE,	TAD [1403	/REPLACE ORIGINAL SEGS
	DCA NXR
	TAD [1603		/WITH UPDATED ONES
	DCA XR
	TAD I [1400
	DCA COUNT		/SET COUNT TO THE NUMBER OF SEGS
	JMS MOVA
	JMP I [ENDTST
MOVA,	0
	TAD COUNT	/WAS THE SEGMENT ADDED ON THE END?
	SNA CLA
	JMP I MOVA	/IF SO, RETURN
	TAD I XR	/MAKE THE MOVE
	DCA I NXR
	TAD I XR	/BE SURE TO GET BOTH WORDS
	DCA I NXR
	ISZ COUNT	/IS THAT ALL THE SEGMENTS?
	JMP .-5		/IF NO, CONTINUE
	JMP I MOVA
NEXTLN,	CLL CLA		/ROUTINE TO ACCEPT NEW INPUT LINE
	DCA DIGFLG	/ZERO DIGIT FLAG
	DCA DLID	/CLEAR DELIMITER STORAGE
	TAD [1177	/RESET INPUT POINTER
	DCA LXR
	JMP I [CONT	/CONTINUE INPUT CODE
	PAGE
\f	*1710
	/LOCATIONS 1600-1710 ARE USED AS THE CORE CONTROL BLOCK BUFFER
DELETE,			/TTY DELETION COMMAND
	CLL CLA
	TAD LXR
	TAD [-1177	/WAS THERE INPUT?
	SNA CLA
	JMP RBSPCL	/NO INPUT--PREPARE FOR SOME...
	TAD ["\		/PRINT ERASE DELIMITER
	ISZ RBFLG	/TEST TO SEE IF THIS IS THE FIRST RUBOUT
	JMS I [TYPIT	/IT IS
	CLA CMA		/SET RUBOUT FLAG
	DCA RBFLG
	CMA
	TAD LXR
	DCA TX		/PRINT ERASED CHARACTER
	TAD I TX
	JMS I [TYPIT
BACKUP,	CLA CMA
	TAD LXR
	DCA LXR
	KCC
	JMP I [REATTY
RBSPCL,	ISZ RBFLG	/HAVE ANY CHARACTERS BEEN ERASED?
	JMP I [CONT		/NO...PREPARE FOR INPUT
	TAD ["\
	JMS I [TYPIT
	DCA DIGFLG	/RESET DIGFLG
	JMP I [CONT
LFEED,	JMS I [CRLF
	TAD [243	/TYPE I.D.(#) CHARACTER
	JMS I [TYPIT
	TAD [1177
	DCA NXR
	JMP .+3
FEEDER,	TAD I NXR
	JMS I [TYPIT
	TAD LXR
	CIA
	TAD NXR
	SZA CLA
	JMP FEEDER
	KCC
	JMP I [REATTY
BARG,	JMS I [PRMSG
	TEXT /BAD ARGS/ 
	JMP I [NEXTLN
SEGNO,	0
	TAD I [1400	/ACCES NUMBER OF SEGMENTS
	CLL RAL		/ADJUST EXTENDED MEM BIT
	STL RAR
	TAD [32
	SPA CLA		/ARE THERE MORE THAN 32?
	JMP REDERR
	JMP I SEGNO
	PAGE

\f
	*2000

VERMSG,	0
	JMS I [PRMSG
	TEXT / ATTENTION! THE NEW CCB WILL BE WRITTEN DIRECTLY ONTO /
	JMS I [CRLF
	JMS I [PRMSG
	TEXT /THE SPECIFIED INPUT FILE.(SEE SOURCE CODE)/
	JMP I VERMSG

WRCCB,	JMS I [SEGNO		/DID WE EXCEED SEGMENT LIMIT?
	JMS I [7607	/WRITE CCB
	4201
	1200		/FROM 1200
	37		/TO BLOCK '37'
	JMP REDERR
	TAD I (STFLE
	DCA WRFLE
	JMS I [7607
	4101
	1400
WRFLE,	0
	JMP REDERR
	JMP I ERR