<div id='wikitext'>
<pre><b> File: WOISAM.01 of Tape: Various/Decus/decus-2</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
	LAP
IBUF,	BLOCK 200/START OF MAIN BUFFER
	BLOCK 177
IBUFE,	BLOCK 1/END OF BUFFER
	CPAGE 6
	EAP
/
/
/
/INDEX SEQUENTIAL PUT ONLY ROUTINES
/
/
/VERSION 01
/
/THERE ARE THREE ENTRIRS TO THIS ROUTINE
/
/PUTOP WILL OPEN AN OUTPUT FILE ON THE DEVICE SPECIFIED
/	WITH AN EXTENSION .DA ASSUMED
/
/PUTX WILL PUT THE INFO FROM 10400 ON UP INTO THE BUFFER
/
/PUTCL WILL CLOSE THE FILE TO ALL ADDL OUTPUT
/
/THE CALLS ARE OF THE FORM:
/	CALL PUTOP(&#039;DEVICE&#039;,&#039;FILNAM&#039;,RECORDLENGTH)
/	CALL PUTX
/	CALL PUTCL
/
/
/	USE WITH CAUTION
/
/
ENTRY	PUTOP	/OPEN A PUT ONLY FILE
ENTRY	PUTX	/PUT A RECORD OF DATA ON THE FILE
ENTRY	PUTCL	/CLOSE THE FILE
/
/
/
/
OPDEF	CIFZ	6202	/CHANGE TO IF 0
OPDEF	CDFZ	6201	/CHANGE TO DF 0
OPDEF	CDF1	6211	/CHANGE TO DF 1
OPDEF	TADI	1400	/TAD IND
OPDEF	DCAI	3400	/DCA IND
OPDEF	JMPI	5400	/JMP IND
OPDEF	JMSI	4400	/JMS IND
/
/
SPACE,	0		/NO OF FREE BLOCKS LEFT
MBASE,	0		/ABS START OF DATA FILE
/
/
IXYZ1,	COMMN	100	/TO FORCE ERROR
IXYZ2,	COMMN	100	/IF NOT TWO PAGES OF
IXYZ3,	COMMN	1	/TWO PAGES MIN
/
/
LOSTR,	IBUF#		/ADD OF START OF DATA
MNWDS,	7777		/SKIPS AFTER WC OVFLO
MNREC,	7777		/SKIPS AFTER RC OVFLO
X77,	XTAG#		/START OF ARGS
S541,	541		/LOADER LOC OF CLOSE
S75,	75		/LOC OF PAGE NO
PUTCL,	BLOCK 2		/CLOST THE FILE
	TAD (7770
	DCA PUTOP
MRPUT,	TAD (1747
	CDF1
	DCAI S400	/AND PUT SOME 999(19)&#039;S FOR EOF&#039;S
	CALL 0,PUTX	/AND PUT IT THERE
	ISZ PUTOP
	JMP MRPUT
	DCA IBUFE	/ZERO THE FWD POINTER
	JMS RWROT	/AND WRITE THE BLOCK
	INC IMRK	/AND BUMP BLK CNT BY 1
	CDFZ
	TADI S121	/SAVE 00121
	DCA PUTOP
	TADI S763	/AND 00763
	DCA PUTOP#
	TAD IMRK	/PUT BLK CNT IN 00763
	DCAI S763
	TAD DEV		/AND SETUP 553-555
DTAG1,	DCA DEVDF
	TAD DEV#
	DCA RWROT
	TAD (552
	DCA 10
	JMS GETWD
	JMS GETWD
	TADI S75
	SNA
	JMS EOF#
	DCAI 10
	TAD NAME	/AND PUT NAME IN 00000-00002
DTAG2,	DCA DEVDF
	TAD NAME#
	DCA RWROT
	CLA CLL CMA
	DCA 10
	JMS GETWD
	JMS GETWD
	JMS GETWD
	TAD (0401	/TACK ON A DA EXTENSION
	DCAI 10
	TAD (757
	6202		/A CIF 0
DTAG3,	JMS I S541
	SKP		/SINCE A SKIP IF ERROR
	JMS EOF#
	CLA CLL CMA
	DCA MNREC
	CLA CLL CMA
	DCA MNWDS
	DCA MHAND	/AND RESET MHAND TO 0
	TAD PUTOP		/RESTORE 00121 AND 00763
	CDFZ
	DCAI S121
	TAD PUTOP#
	DCAI S763
	RETRN PUTCL
IMRK,	0		/REL BLK IN CORE NOW
S400,	400		/LOC OF COMMON BUFFER
S121,	121		/LOC OF HANDLER
S746,	746		/LOC OF ROOM LEFT
S663,	663		/LOC OF ???
S763,	763		/LOC OF CLOSE
PUTOP,	BLOCK 2		/OPEN AN OUTPUT FILE
	TAD (7774	/SET UP AN ISZ LOOP
	DCA PUTCL
	TAD X77
	DCA 10
MRNAM,	TAD I PUTOP	/GET THE ARGS
	DCA I 10
	INC PUTOP#
	ISZ PUTCL
	JMP MRNAM
XTAG,	CALL 2,OOPEN	/NOW OPEN THE FILE
DEV,	ARG 0
NAME,	ARG 0
	CDFZ		/AND GET THE ARGS
	TADI S663
	DCA MBASE	/SAVE THE FIRST BLK NO
	TADI S746
	DCA SPACE	/AND NO OF FREE BLOCKS
	TADI S121
	DCA MHAND	/AND THE ENTRY OF HANDLER
	DCAI LOSTR	/SET FREE TO 0
	CLA CLL IAC
	DCA IBUF	/SET START TO 1
	INC PUTOP#
	TAD LOSTR
	DCA 10
	TAD DTAG1
	TAD (5777
	DCA RWPAR	/GENERATE AN 42X0
	TAD I PUTOP	/GET THE NO OF WDS PER REC
	DCA PUTX
	TADI PUTX	/GET THE N WDS
	INC PUTOP#
	CMA IAC
	DCA MNWDS	/AND SAVE IT
	TAD MNWDS
	SMA		/GTR 0???
	JMS EOF#	/NOPE
	TAD (175
	SPA CLA		/LESS THAN 125(10)???
	JMS EOF#	/NOPE
	TAD MNWDS
	DCA I 10		/SET MINUS NO OF WDS
	DCA IMRK	/SET COUNTER
	DCA EOF#
	TAD (375
NOTYET,	TAD MNWDS
	SPA
	JMP GOTIT
	INC EOF#
	JMP NOTYET
GOTIT,	CLA CLL		/NOW SET THE NO RECS PER BLOCK
	TAD EOF#
	CMA IAC
	DCA MNREC
	TAD MNREC
	DCAI 10
	JMS RWROT	/AND WRITE THE HEADER
	JMS FRSET	/AND SET THE POINTERS
	RETRN PUTOP	/AND GO HOME
GPNT,	7777		/BUFFER POINTER
RCNT,	7777		/BUFFER COUBTER
FRSET,	0		/SET THE POINTERS
	INC IMRK	/BUMP RECPOINTER BY 1
	CLA CLL CMA
	TAD IMRK
	DCA IBUF
	TAD IMRK
	IAC
	DCA IBUFE
	ISZ SPACE	/AND CHECK FOR ENOUGH ROOM
	SKP
	JMS EOF#	/TOO TIGHT TO SURVIVE
	TAD LOSTR
	DCA GPNT
	TAD MNREC
	DCA RCNT
	JMPI FRSET	/AND RETURN
MSG1,	TEXT &#039;PUTX&#039;	/NASTY-GRAM
EOF,	TAD IBUF	/62X1 GOES HERE;DONT CARE WHAT NEXT
	CALL 1,ERROR	/TILT - YOU JUST LOST
	ARG MSG1
PUTX,	BLOCK 2		/PUT A LOGICAL RECORD ON THE FILE
	TAD MNWDS
	DCA FRSET
	TAD (377
	DCA 10
NCAR2,	CDF1		/GET A WORD
	TADI 10
	DCA I GPNT	/AND STORE IT
	INC GPNT
	ISZ FRSET
	JMP NCAR2
	ISZ RCNT	/STILL IN THIS BLOCK???
	JMP PUTDON	/YUP
	JMS RWROT	/AND WRITE THE BLOCK
	JMS FRSET
PUTDON,	RETRN PUTX	/THATS ALL FOLKS
	LAP		/LEAVE PAGING-WE NEED THE LAST TWO LOCS
RWROT,	0		/WRITE TWO PAGES
	TAD MBASE
	TAD IMRK
	DCA RW3
	TAD MHAND
	SNA CLA		/EVER OPENED???
	JMS EOF#	/NOPE
	CIFZ
	JMSI MHAND	/GO DO SOMETHING
RWPAR,	0		/WRITE 1 BLOCK
RW2,	IBUF		/FROM HERE IN CORE
RW3,	0		/AT THIS BLOCK NO
	JMS EOF#	/ERROR RETURN
	JMPI RWROT	/AND GO BACK
MHAND,	0		/ENTRY OF SYS HANDLER
GETWD,	0		/GET A WORD
DEVDF,	NOP		/CHANGET TO A CDF CALLING
	TADI RWROT
	CDFZ
	DCAI 10
	INC RWROT
	JMPI GETWD	/DO NOT RESTORE DF
	END
</pre>
<hr/>
</div>