1	! &
	! &
	!			U N I W R I . B 2 S &
	! &
	!	Writes various types of magtapes from RSTS files &
	!	By: Larry Walker and Scott Matsumoto &
	! &
	!	Developed at: &
	!		Lawrence University &
	!		P.O. Box 599 &
	!		Appleton, WI  54911 &
	! &
	!	      M o d i f i c a t i o n    H i s t o r y &
	! &
	!	By:	Scott Matsumoto &
	!	Date:	June 2, 1980 &
	!	Reason:	Change input of records from an INPUT LINE &
	!		type input to Native RSTS Block I/O style. &
	! &
	! &
	!	By:	Larry Walker &
	!	Date:	July 22, 1980 &
	! &
	!	Reason:	Add wild-carding to the File-Request code. &
	! &
	! &
	!	By:	Larry Walker &
	!	Date:	August 2, 1980 &
	! &
	!	Reason: Write Block-Count in Trailer Label. &
	!		( to make IBM OS/360 happy) &
	! &
	! &
	!	By:	Larry Walker &
	!	Date:	August 12, 1980 &
	! &
	!	Reason: Move the XLATE from FNDUMP% to FNPUT.REC%, to &
	!		make sure that padded blanks get converted. &
	!
5	EXTEND
7	ON ERROR GOTO 19000 &
\	DIM RTN%(30%), ARG%(30%) &
\	JUNK% = FNINIT% &

10	PRINT 'Write-Command'; &
\	INPUT LINE CMD$ &
\	CMD$ = CVT$$(CMD$, 255%) &

20	IF      CMD$ = 'SET' 	THEN JUNK% = FNSET% &
	ELSE IF CMD$ = 'LOAD'	THEN JUNK% = FNLOAD% &
	ELSE IF CMD$ = 'REWIND'	THEN JUNK% = FNREWIND% &
	ELSE IF CMD$ = 'HELP'	THEN JUNK% = FNHELP% &
	ELSE IF CMD$ = 'DEBUG'	THEN JUNK% = FNDEBUG% &
	ELSE IF CMD$ = 'EOT'	THEN JUNK% = FNEOT% &
	ELSE	JUNK% = FNFILE.RQST% &

30	PRINT &
\	GOTO 10 &
100	DEF FNSET% &
\	IF DEBUG% THEN PRINT 'Entering FNSET%' &

110	INPUT 'Recording Density <800>'; INP% &
\	IF      INP% = 800%  OR  INP% = 0% &
			THEN MO.DE% = 12% &
	ELSE IF INP% = 1600% &
			THEN MO.DE% = 8448% &
	ELSE GOTO 110 &

120	INPUT 'File Headers/Trailers <YES>'; INP$ &
\	INP$ = LEFT( CVT$$(INP$, 255%), 1%) &
\	IF      INP$ = ""   OR   INP$ = 'Y' &
		THEN FILE.HDRS% = YES% &
	ELSE IF INP$ = 'N' &
		THEN FILE.HDRS% = NO% &
	ELSE GOTO 120 &

130	INPUT 'Output Record Type <FIXED>'; INP$ &
\	INP$ = LEFT( CVT$$(INP$, 255%), 3%) &
\	IF      INP$ = ""   OR   INP$ = 'FIX' &
			THEN OUT.REC.TYPE% = FXD% &
	ELSE IF INP$ = 'VAR' &
			THEN OUT.REC.TYPE% = VAR% &
	ELSE GOTO 130 &

140	INPUT 'Output Character Code <EBCDIC>'; INP$ &
\	INP$ = CVT$$(INP$, 255%)
142	IF INP$ = ""   OR   INP$ = 'EBCDIC' &
	   THEN ASCII.CODE% = NO% &
\		XL$ = EBCDIC$ &
\		GOTO 149
146	IF INP$ = 'ASCII' &
	   THEN ASCII.CODE% = YES% &
\		GOTO 149 &

149	! CONTINUE &

190	IF DEBUG% THEN PRINT 'Leaving FNSET%'
199	FNEND &
200	DEF FNLOAD% &
\	IF DEBUG% THEN PRINT 'Entering FNLOAD%' &

202	JUNK% = FNREWIND% &

204	OPEN TAPE.DEV$ AS FILE TAPE.CHAN%, &
		 RECORDSIZE MAX.RECL%, MODE MO.DE% &
\	FIELD #TAPE.CHAN%, MAX.RECL% AS BUF$ &
\	FIELD #TAPE.CHAN%,	4% AS F1$, &
				6% AS F2$, &
			       70% AS SKIP$ &

208	INPUT ' Should tape have a Label (Y/N)'; INP$ &
\	INP$ = LEFT( CVT$$(INP$, 255%), 1%)
210	IF INP$ = 'N' &
	   THEN FILE.HDRS% = NO% &
	   ELSE INPUT 'Tape label name '; VOL.SER$ &
\		VOL.SER$ = XLATE(VOL.SER$, XL$)   UNLESS ASCII.CODE% &
\		LSET F2$ = VOL.SER$ &
\		HDR$ = 'VOL1' &
\		HDR$ = XLATE(HDR$, XL$)   UNLESS ASCII.CODE% &
\		LSET F1$ = HDR$ &
\		JUNK$ = STRING$(70%, 32%)	! 70 spaces &
\		JUNK$ = XLATE(JUNK$, XL$)   UNLESS ASCII.CODE% &
\		LSET SKIP$ = JUNK$ &
\		PUT #TAPE.CHAN%, COUNT 80% &

290	IF DEBUG% THEN PRINT 'Leaving FNLOAD%'
299	FNEND &
300	DEF FNFILE.RQST% &
\	LOCK.LRECL% = NO% &
\	IF DEBUG% THEN PRINT 'Entering FNFILE.RQST%' &

302	JUNK% = FNPARSE.CMD%
310	RTN$ = SYS(CHR$(6%) + CHR$(-23%) + DSRD.FILE$)	! F.S.S. &
\	CHANGE RTN$ TO RTN% &
\	FLAG1% = RTN%(27%) + SWAP%(RTN%(28%)) &
\	FLAG2% = RTN%(29%) + SWAP%(RTN%(30%)) &
	&

320	ARG%(J%) = 0%	      FOR J% =  0% TO 30%	! Zero to start &
\	ARG%(0%) = 30% &
\	ARG%(1%) = 6% &
\	ARG%(2%) = 17% &
\	ARG%(J%) = RTN%(J%)   FOR J% =  5% TO  6%	! Get PPN &
\	ARG%(J%) = RTN%(J%)   FOR J% =  7% TO 10%	! Get name &
\	ARG%(J%) = RTN%(J%)   FOR J% = 11% TO 12%	! Get extension &
\	ARG%(J%) = RTN%(J%)   FOR J% = 23% TO 25%	! Get device &

330	IF FLAG1% < 0% THEN GOTO 340		! Go do wild-cards case.
332		ARG%(3%), ARG%(4%) = 255% &
\		CHANGE ARG% TO ARG$ &
\		RTN$ = SYS( ARG$ )		! Straight directory look-up. &
\		CHANGE RTN$ TO RTN% &
\		OUT.FILE.ID$ = FNMAKE.ID$   IF OUT.FILE.ID$ = "" &
\		IF FILE.HDRS% THEN JUNK% = FNHDR.TYPE% &
			      ELSE JUNK% = FNNO.HDR.TYPE%
335		GOTO 350 &

340	FOR I% = 0% TO 32767%	! Do wild-carded case. &
\	   ARG%(3%) = I% &
\	   ARG%(4%) = SWAP%(I%) &
\	   CHANGE ARG% TO ARG$ &
\	   RTN$ = SYS(ARG$)	! Wild-card directory look-up &
\	   CHANGE RTN$ TO RTN% &
\	   OUT.FILE.ID$ = FNMAKE.ID$ &
\	   IF FILE.HDRS% THEN JUNK% = FNHDR.TYPE% &
			 ELSE JUNK% = FNNO.HDR.TYPE%
345	NEXT I% &

350	! Come back from error routine here &
	! (When we run out of files from this wild-carded file-spec) &
	&

390	IF DEBUG% THEN PRINT 'Leaving FNFILE.RQST%'
399	FNEND &
400	DEF FNHDR.TYPE% &
\	IF DEBUG% THEN PRINT 'Entering FNHDR.TYPE%' &

402	GOTO 408   IF LOCK.LRECL% &
\	IF OUT.REC.TYPE% = FXD% &
	   THEN	INPUT 'LRECL'; LRECL% &
\		INPUT 'Blocking Factor'; BLK.FCTR% &
\		BLK.SIZE% = BLK.FCTR% * LRECL% &

404	IF OUT.REC.TYPE% = VAR% &
	   THEN INPUT 'Maximum record length'; LRECL% &
\		INPUT 'Maximum block length'; BLK.SIZE% &

406	IN.LRECL% = LRECL% &
\	IN.LRECL% = IN.LRECL% + 2%	! Compensate for the <CR><LF>. &
\	BUFFERSIZE% = 1024%		! Start with a minimum of 1024 bytes. &
		      - ( IN.LRECL% > 1024% ) ! Yields -1% or 0% &
		      * ( ( IN.LRECL% - 1% ) / 512% ) * 512% &
					! Add additional bytes over 1024 &
					! in multiples of 512. &
	&
\	IF FLAG1% < 0%  THEN		! Wild-carded case only &
		INPUT ' Lock these'; ANS$ &
\		IF LEFT(CVT$$(ANS$,255%), 1%) = 'Y' &
		   THEN LOCK.LRECL% = YES%
408	! By-pass inputs to here &

410	DSRD.FILE$ = FNMAKE.FILE.NAM$ &
\	OPEN DSRD.FILE$ FOR INPUT AS FILE IN.CHAN%, &
				RECORDSIZE BUFFERSIZE% &
\	FIELD #IN.CHAN%, BUFFERSIZE% AS BUFFER$ &
\	LSET BUFFER$ = " " &

420	JUNK% = FNWRITE.FILE.LABELS%('HDR') &
\	JUNK% = FNWRITE.EOF% &

450	NUM.RECS = 0		! (Moved here because of multi-vol data-sets) &
\	JUNK% = FNDUMP% &
\	IF EOT% AND NOT EOF% &
	   THEN JUNK% = MAGTAPE(5%, 1%, TAPE.CHAN%)	! Backspace tape &
\		JUNK% = FNWRITE.EOF% &
\		JUNK% = FNWRITE.FILE.LABELS%('EOV') &
\		JUNK% = FNWRITE.EOF%   FOR II% = 1% TO 2%	! Write EOT &
\		PRINT ' Tape volume full; please load another tape' &
\		PRINT ' (Hit RETURN when ready)'; &
\		GET #0% &
\		JUNK% = FNLOAD% &
\		JUNK% = FNWRITE.FILE.LABELS%('HDR') &
\		JUNK% = FNWRITE.EOF% &
\		EOT% = NO% &
\		PUT #TAPE.CHAN%, COUNT BLK.LEN%		! Re-write buffer(s) &
\		JUNK% = FNDUMP% &

460	JUNK% = FNWRITE.EOF% &
\	JUNK% = FNWRITE.FILE.LABELS%('EOF') &
\	JUNK% = FNWRITE.EOF% &
\	CLOSE #IN.CHAN% &

490	IF DEBUG% THEN PRINT 'Leaving FNHDR.TYPE%'
499	FNEND &
500	DEF FNDUMP% &
\	IF DEBUG% THEN PRINT 'Entering FNDUMP%' &

502	IF FLAG1% < 0% &
	   THEN PRINT &
\		PRINT 'Now writing '; OUT.FILE.ID$ &

504	EOF% = NO% &
\	NUM.BLKS = 0 &
\	OFFSET = 0% &
\	B.LOCK = 1 &

510	EOF% = FNGET.REC% &
\	WHILE NOT EOF% &
\	   JUNK% = FNPUT.REC% &
\	   NUM.RECS = NUM.RECS + 1 &
\	   GOTO 590   IF EOT%		! FNEND if End-of-Tape &
\	   EOF% = FNGET.REC%
540	NEXT &

550	IF LEN(BLK$) > 0%		! (Flush the buffer, if needed) &
	   THEN JUNK% = FNWRITE.A.BLOCK% &

590	PRINT NUM.RECS; ' Records written' &
\	IF DEBUG% THEN PRINT 'Leaving FNDUMP%'
599	FNEND &
	&
	&
	&

600	DEF FNPUT.REC% &

610	REC.LEN% = LEN(REC$) &

620	IF OUT.REC.TYPE% = FXD% &
	   THEN REC$ = REC$ + STRING$( LRECL%-REC.LEN%, 32%)	! Blank fill &
	&
	   ELSE REC.LEN% = REC.LEN% + 4% &
\		REC$ = CVT%$(REC.LEN%) + &
		       '00' + REC$		! Add Record Desc. Word &

625	REC$ = XLATE(REC$, XL$)  UNLESS ASCII.CODE% &
\	BLK$ = BLK$ + REC$ &

630	IF LEN(BLK$)+LRECL% > BLK.SIZE% &
	   THEN JUNK% = FNWRITE.A.BLOCK% &

699	FNEND &
700	DEF FNNO.HDR.TYPE% &
\	IF DEBUG% THEN PRINT 'Entering FNNO.HDR.TYPE%' &
	&

710	GOTO 725   IF LOCK.LRECL% &
\	IF OUT.REC.TYPE% = FXD% &
	   THEN INPUT 'LRECL'; LRECL% &
\		INPUT 'Blocking Factor'; BLK.FCTR% &
\		BLK.SIZE% = BLK.FCTR% * LRECL% &

720	IF OUT.REC.TYPE% = VAR% &
	   THEN INPUT 'Maximum record length'; LRECL% &
\		INPUT 'Maximum block size'; BLK.SIZE% &

720	IN.LRECL% = LRECL% &
\	IN.LRECL% = IN.LRECL% + 2%	! Compensate for the <CR><LF>. &
\	BUFFERSIZE% = 1024%		! Start with a minimum of 1024 bytes. &
		      - ( IN.LRECL% > 1024% ) ! Yields -1% or 0% &
		      * ( ( IN.LRECL% - 1% ) / 512% ) * 512% &
					! Add additional bytes over 1024 &
					! in multiples of 512. &
	&
\	IF FLAG1% < 0% THEN		! Wlid-carded case only &
		INPUT ' Lock these'; ANS$ &
\		IF LEFT(ANS$,1%) = 'Y' &
		   THEN LOCK.LRECL% = YES%
725	! By-pass input to here &

730	DSRD.FILE$ = FNMAKE.FILE.NAM$ &
\	OPEN DSRD.FILE$ FOR INPUT AS FILE IN.CHAN%, &
				RECORDSIZE BUFFERSIZE% &
\	FIELD #IN.CHAN%, BUFFERSIZE% AS BUFFER$ &
\	LSET BUFFER$ = " " &
	&
\	NUM.RECS = 0		! (Moved here because of multi-vol data-sets) &
\	JUNK% = FNDUMP% &

750	JUNK% = FNWRITE.EOF%
760	CLOSE IN.CHAN% &

790	IF DEBUG% THEN PRINT 'Leaving FNNO.HDR.TYPE%'
799	FNEND &
800	DEF FNINIT% &
\	IF DEBUG% THEN PRINT 'Entering FNINIT%' &

802	NO% = 0% &
\	YES% = -1% &
\	FXD% = -1% &
\	VAR% = -2% &
\	TAPE.CHAN% = 1% &
\	IN.CHAN% = 2% &
\	VOL.SER% = YES% &
\	FILE.HDRS% = YES% &
\	TAPE.DEV$ = 'MT0:' &
\	OUT.REC.TYPE% = FXD% &
\	ASCII.CODE% = NO% &
\	CR$ = CHR$(13%) &
	&
\	EOF% = NO% &
\	EOT% = NO% &
\	DEBUG% = NO% &

810	MAX.RECL% = 8480%			! (MUST BE MULTIPLE OF 512%) &

815	FOR I%=1% TO 256% &
\	   READ A% &
\	   EBCDIC$ = EBCDIC$ + CHR$(A%) &
\	NEXT I% &

820	! This is the ASCII-to-EBCDIC XLATE table: &

821	DATA  0 , 1 , 2 , 3 , 55 , 46 , 47 , 48 , 22 , 5
822	DATA  37 , 11 , 12 , 13 , 14 , 15 , 16 , 17 , 18 , 0
823	DATA  60 , 61 , 50 , 38 , 24 , 25 , 63 , 39 , 34 , 0
824	DATA  53 , 0 , 64 , 90 , 127 , 123 , 91 , 108 , 80 , 125
825	DATA  77 , 93 , 92 , 78 , 107 , 96 , 75 , 97 , 240 , 241
826	DATA  242 , 243 , 244 , 245 , 246 , 247 , 248 , 249 , 122 , 94
827	DATA  76 , 126 , 110 , 111 , 124 , 193 , 194 , 195 , 196 , 197
828	DATA  198 , 199 , 200 , 201 , 209 , 210 , 211 , 212 , 213 , 214
829	DATA  215 , 216 , 217 , 226 , 227 , 228 , 229 , 230 , 231 , 232
830	DATA  233 , 173 , 0 , 189 , 95 , 109 , 121 , 129 , 130 , 131
831	DATA  132 , 133 , 134 , 135 , 136 , 137 , 145 , 146 , 147 , 148
832	DATA  149 , 150 , 151 , 152 , 153 , 162 , 163 , 164 , 165 , 166
833	DATA  167 , 168 , 169 , 77 , 79 , 93 , 0 , 7 , 0 , 0
834	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
835	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
836	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
837	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
838	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
839	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
840	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
841	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
842	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
843	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
844	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
845	DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
846	DATA  0 , 0 , 0 , 0 , 0 , 0 &

847	XL$ = EBCDIC$		! EBCDIC output is the default &
\	ASCII.CODE% = NO% &

890	PRINT &
\	PRINT 'UNIWRI 2.5 Tape Writer' &
\	IF DEBUG% THEN PRINT 'Leaving FNINIT%' &

899	FNEND &
900	DEF FNPARSE.CMD% &
\	IF DEBUG% THEN PRINT 'Entering FNPARSE.CMD%' &

910	P1% = INSTR(1%, CMD$, '=') &
\	IF P1% = 0% THEN OUT.FILE.ID$ = "" &
		    ELSE OUT.FILE.ID$ = LEFT(CMD$, P1%-1%) &
	! OUT.FILE.ID$ gets everything up to the '='. &

920	P2% = INSTR(P1%, CMD$, '/') &
\	P2% = LEN(CMD$)+1%   IF P2% = 0% &
\	DSRD.FILE$ = MID(CMD$, P1%+1%, P2%-P1%-1%) &
	! DSRD.FILE$ gets everything from the '=' to &
	! the '/' or to the end of CMD$.  (This allows &
	! for switches, implemented below). &
	&

930	SLASH% = INSTR(P2%, CMD$, '/') &
\	WHILE SLASH% &
\		SWITCH$ = MID(CMD$, SLASH%+1%, 1%) &
\		DELIM% = INSTR(SLASH%+1%, CMD$, '/') &
\		DELIM% = LEN(CMD$)+1%   IF DELIM% = 0% &
	&
\		N$ = MID(CMD$, SLASH%+3%, DELIM%-SLASH%-3%) &
\		N% = VAL(N$) &
	&
		! CASE-OF Structure follows: &

940		IF SWITCH$ = '?' &
		   THEN JUNK% = YES%		! Dummy: no switches yet &
	&
		! End of CASE-OF Structure &

980		SLASH% = INSTR(SLASH%+1%, CMD$, '/') &
\	NEXT &
	&

990	IF DEBUG% THEN PRINT 'OUT.FILE.ID$ = '; OUT.FILE.ID$ &
\		       PRINT 'DSRD.FILE$ = '; DSRD.FILE$ &
\		       PRINT 'Leaving FNPARSE.CMD%' &

999	FNEND &
1000	DEF FNDEBUG% &
\	DEBUG% = NOT DEBUG% &
\	FNEND &
	&
	&
	&

1100	DEF FNEOT% &
	&
\	JUNK% = FNWRITE.EOF% &
\	JUNK% = FNWRITE.EOF% &

1199	FNEND &
	&
	&
	&

1200	DEF FNREWIND% &
	&
\	CLOSE TAPE.CHAN% &
\	OPEN TAPE.DEV$ AS FILE TAPE.CHAN%, RECORDSIZE MAX.RECL% &
\	JUNK% = MAGTAPE(3%, 0%, TAPE.CHAN%) &
\	CLOSE TAPE.CHAN% &

1299	FNEND &
	&
	&
	&

1300	DEF FNHELP% &

1301	PRINT 'Commands:' &
\	PRINT '   LOAD		Rewinds and loads a tape.  Writes a Vol-Ser' &
\	PRINT '		label, if desired.' &
\	PRINT '   SET		Selects characteristics.  If SET is not used,' &
\	PRINT '		the default is IBM SL.' &
\	PRINT "   REWIND	Rewinds the tape (but doesn't reload it)." &
\	PRINT '   EOT		Writes a tape-mark (after all files desired' &
\	PRINT '		have been written).  CNTL-Z also writes a' &
\	PRINT '		tape-mark before exiting.' &
\	PRINT &
\	PRINT "   data.set.name = filnam.ext	Writes 'filnam.ext' to the" &
\	PRINT '				tape with the given data-set-name.' &
\	PRINT '				For use with labeled tapes.  If the' &
\	PRINT "				'data.set.name =' is ommitted, the" &
\	PRINT '				file-name will be used on the tape.' &
\	PRINT &
\	PRINT "   filnam.ext	Writes 'filnam.ext' to the tape.  For use" &
\	PRINT '		with unlabeled tapes.' &
\	PRINT &
\	PRINT '		Both of the above support normal RSTS wild-carding.' &
\	PRINT &
\	PRINT '   NOTE: All files on one tape must be written in one run' &
\	PRINT '		of UNIWRI.' &

1399	FNEND &
1400	DEF FNWRITE.FILE.LABELS%( LBL$ ) &

1402	FIELD #TAPE.CHAN%,	 4% AS F1$,	! Label &
				17% AS F2$,	! Data Set Identifier &
				20% AS SKIP1$, &
				 6% AS D.ATE$,	! Creation Date &
				 7% AS SKIP$, &
				 6% AS BLK.CNT$,! Block Count &
				20% AS SKIP2$
1404	LSET F1$ = LBL$ + '1' &
\	LSET F2$ = OUT.FILE.ID$ &
\	TO.DAY = SWAP%(CVT$%(MID(SYS(CHR$(6%)+CHR$(-3%)),27%,2%))) + 70000. &
\	RSET D.ATE$ = NUM1$(TO.DAY) &
\	IF LBL$ = 'HDR' &
		THEN LSET BLK.CNT$ = '000000' &
		ELSE RSET BLK.CNT$ = NUM1$( NUM.BLKS )
1406	LSET SKIP1$ = STRING$(33%, 32%)		! Fill with spaces &
\	LSET SKIP2$ = STRING$(20%, 32%) &
\	LSET BUF$ = XLATE(BUF$, XL$)   UNLESS ASCII.CODE% &

1408	PUT #TAPE.CHAN%, COUNT 80% &

1410	FIELD #TAPE.CHAN%,	 4% AS F1$,	! Label &
				 1% AS F2$,	! Record format &
				 5% AS F3$,	! Block length &
				 5% AS F4$,	! Record length &
				65% AS SKIP$
1412	LSET F1$ = LBL$ + '2' &
\	LSET F2$ = 'F' &
\	RSET F3$ = NUM1$( BLK.SIZE% ) &
\	RSET F4$ = NUM1$( LRECL% ) &
\	LSET SKIP$ = STRING$(65%, 32%)		! Fill with spaces &
\	LSET BUF$ = XLATE(BUF$, XL$)   UNLESS ASCII.CODE% &

1414	PUT #TAPE.CHAN%, COUNT 80% &

1499	FNEND &
	&
	&
	&

1500	DEF FNWRITE.EOF% = MAGTAPE(2%, 0%, TAPE.CHAN%) &
1600	DEF FNWRITE.A.BLOCK% &

1602	BLK.LEN% = LEN(BLK$)	! Save length (FNDUMP% may rewrite) &

1604	IF OUT.REC.TYPE% = FXD% &
	   THEN LSET BUF$ = BLK$ &
	&
	   ELSE BLK.LEN% = BLK.LEN% + 4% &
\		JUNK$ = '00' &
\		JUNK$ = XLATE(JUNK$, XL$)  UNLESS ASCII.CODE% &
\		LSET BUF$ = CVT%$(BLK.LEN%) + JUNK$ + &
			    BLK$	! Add Block Desc. Word &

1608	PUT #TAPE.CHAN%, COUNT BLK.LEN% &
	! Check STATUS and set EOT% (if needed) &
\	EOT% = YES%  IF ((MAGTAPE(7%, 0%, TAPE.CHAN%) AND 128%) <> 0%) &
\	BLK$ = "" &
\	NUM.BLKS = NUM.BLKS + 1 &

1699	FNEND &
9999	GOTO 32767 &

15000	! &
	! &
	!		R e t r i e v e    a    L o g i c a l &
	!			      R e c o r d &
	! &
	! &
	DEF* FNGET.REC% &
\	FNGET.REC% = 0%			! Initialize the function. &
\	CR% = INSTR( OFFSET, BUFFER$, CR$ ) &
\	IF CR% = 0%			! Can't find a <CR>. &
	    THEN &
	    TEMP = OFFSET / 512.	! See how much has been used. &
\	    TEMP% = INT( TEMP ) &
\	    OFFSET = ( TEMP - TEMP% ) * 512% &
					! Calculate the fractional part. &
\	    B.LOCK = B.LOCK + TEMP% &
\	    LSET BUFFER$ = " " &
\	    GET #IN.CHAN%, BLOCK B.LOCK &
\	    CR% = INSTR( OFFSET, BUFFER$, CR$ ) &
					! If at first you don't succeed... &
\	    IF CR% = 0% &
		THEN &
		FNGET.REC% = -1% &
\		GOTO 15020 &

15010	FIELD #IN.CHAN%, OFFSET AS REC$, &
			 CR% - OFFSET - 1% AS REC$ &
\	OFFSET = CR% + 1% &

15020	FNEND &
16000	DEF FNMAKE.ID$ &
\	EXT$ = RAD$(RTN%(11%) + SWAP%(RTN%(12%))) &
\	NAM$ = RAD$(RTN%( 7%) + SWAP%(RTN%( 8%))) + &
	       RAD$(RTN%( 9%) + SWAP%(RTN%(10%))) &
	&
\	FNMAKE.ID$ = NAM$ + "." + EXT$ &

16099	FNEND &
	&

16100	DEF FNMAKE.FILE.NAM$ &
	&
\	EXT$ = RAD$(RTN%(11%) + SWAP%(RTN%(12%))) &
\	NAM$ = RAD$(RTN%( 7%) + SWAP%(RTN%( 8%))) + &
	       RAD$(RTN%( 9%) + SWAP%(RTN%(10%))) &
\	IF (FLAG2% AND 8192%)  AND  (FLAG2% >= 0%)	! Device present &
		THEN DEV$ = CHR$(  RTN%(23%) )		! and valid ? &
			  + CHR$(  RTN%(24%) ) &
			  + NUM1$( RTN%(25%) ) &
			  + ":" &
		ELSE DEV$ = "" &

16110	IF (FLAG1% AND 1024%)				! PPN present ? &
	   THEN PPN$ = "[" + NUM1$( RTN%(6%) ) + &
		       "," + NUM1$( RTN%(5%) ) + "]" &
	   ELSE PPN$ = "" &

16120	FNMAKE.FILE.NAM$ = DEV$ + PPN$ + NAM$ + "." + EXT$ &

16199	FNEND &
19000	! &
	! &
	!	   G e n e r a l     E r r o r    R o u t i n e &
	! &
	! &

19030	IF ERR=11 AND ERL=10 &
	   THEN JUNK% = MAGTAPE(2%, 0%, TAPE.CHAN%)   FOR II%=1% TO 2% &
\		CLOSE TAPE.CHAN% &
\		RESUME 32767 &

19040	IF ERR = 11% AND  ERL = 15000%		! The end of the disk file. &
		THEN &
		FNGET.REC% = -1%	! Set the EOF flag. &
\		RESUME 15020%		! Return to the FNEND. &

19050	IF ERR = 5% &
	    THEN &
	    PRINT "Can't find file: "; DSRD.FILE$   IF ERL=332 &
\	    RESUME 350 &

19999	E.RROR$ = RIGHT( SYS( CVT%$( 1545% ) + CHR$( ERR ) ), 3% ) &
\	PRINT "* * *    U n e x p e c t e d     E r r o r    * * *" &
\	PRINT CVT$$( E.RROR$, 4% ) &
\	PRINT "Error occured at line";ERL;"." &
\	RESUME 32767 &

32767	END