/	OS/8 DECODING PROGRAM

/	LAST EDIT:	08-JUL-1992	22:00:00	CJL

/	PROGRAM TO  DECODE  OS/8  FILES  FROM "PRINTABLE" ASCII FORMAT TO BINARY-IMAGE
/	FORMAT.  INTERMEDIATE  "ASCII"  CONVERSION  SHOULD  BE HARMLESS AS LONG AS ALL
/	PRINTING DATA CHARACTERS ARE NOT MODIFIED.

/	DISTRIBUTED BY CUCCA AS "K12DEC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.

/	WRITTEN BY:

/	CHARLES LASNER (CJL)
/	CLA SYSTEMS
/	72-55 METROPOLITAN AVENUE
/	MIDDLE VILLAGE, NEW YORK 11379-2107
/	(718) 894-6499

/	USAGE:

/	THIS PROGRAM OPERATES ON "PRINTABLE"  ASCII  FILES  WHICH HAVE BEEN CREATED BY
/	ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES.  THE ENCODING FORMAT ALLOWS
/	FOR SOME INNOCUOUS CONTENT MODIFICATION SUCH AS  EXTRANEOUS  WHITE  SPACE  AND
/	EXTRA <CR>/<LF> PAIRS, BUT RIGOROUSLY VALIDATES CERTAIN ASPECTS OF THE FORMAT,
/	SUCH AS A TRAILING CHECKSUM.

/	CERTAIN IMBEDDED COMMANDS ARE USED SUCH AS (REMARK .........) WHICH ALLOWS FOR
/	COMMENTARY LINES WITHIN THE FILE FOR IDENTIFICATION PURPOSES.  THE (FILE ) AND
/	(END )  COMMANDS  CONTAIN  THE  SUGGESTED  FILENAME FOR THE DESCENDANT DECODED
/	FILE.
/	WHEN CREATING THE DESCENDANT DECODED FILE,  THE  USER  MAY  SPECIFY EITHER THE
/	IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
/	OR A SPECIFIED DEVICE: 

/	.RUN DEV DECODE		INVOKE PROGRAM.
/	*INPUT			INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
/	*DEV:OUTPUT.EX<INPUT	INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
/	*DEV:<INPUT		INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
/	*DEV:<INPUT=NNNN/I	**** SPECIAL IMAGE TRANSFER MODE **** INPUT IS DECODED
/				INTO  RECORD 0000-[NNNN-1] ON DEVICE DEV:.  THE  =NNNN
/				VALUE SHOULD BE CAREFULLY CHOSEN LARGE ENOUGH TO WRITE
/				ALL  DATA  RECORDS,  BUT  NEED NOT BE STATED  EXACTLY.
/				(THE ENCODE PROGRAM  REQUIRES PRECISE STATEMENT OF THE
/				LENGTH  IN IMAGE TRANSFER ENCODING MODE.    ****  NOTE
/				****  THIS  METHOD  VIOLATES ALL OS/8 DEVICE STRUCTURE
/				AND  IS  MEANT  FOR TRANSFER OF COMPLETE DEVICE IMAGES
/				ONLY;  USE WITH CARE!
/	*DEV:<INPUT=NNNN/I/1	**** SPECIAL IMAGE TRANSFER  MODE **** SAME AS REGULAR
/				IMAGE MODE EXCEPT ONLY THE FIRST  HALF  OF THE DATA IS
/				USED.  NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
/				BECAUSE IT IS USED TO CALCULATE THE APPROX.  1/2 VALUE
/				ACTUALLY  USED  IN  THIS HALF OF THE OVERALL TRANSFER.
/				THIS  MODE  SHOULD  BE USED WITH FILES CREATED FOR THE
/				EXPRESS PURPOSE  OF  TRANSMISSION BY HALVES ONLY;  USE
/				WITH CARE!
/	*DEV:<INPUT=NNNN/I/2	**** SPECIAL IMAGE  TRANSFER MODE **** SAME AS REGULAR
/				IMAGE MODE EXCEPT ONLY THE SECOND  HALF OF THE DATA IS
/				USED.  NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
/				BECAUSE IT IS USED TO CALCULATE THE STARTING RECORD OF
/				THE APPROX.  1/2 VALUE ACTUALLY USED IN  THIS  HALF OF
/				THE OVERALL TRANSFER.    THIS MODE SHOULD BE USED WITH
/				FILES CREATED FOR THE EXPRESS PURPOSE OF  TRANSMISSION
/				BY HALVES ONLY;  USE WITH CARE!  NOTE THAT  THERE MUST
/				BE TWO  FILES  CREATED,  ONE  USING /I/1 AND THE OTHER
/				USING  /I/2 TO  COMPLETELY  TRANSFER  A  DEVICE  IMAGE
/				UNLESS /I IS USED ALONE!
/	*OUTPUT.EX<INPUT$	INPUT IS  DECODED  INTO  OUTPUT.EX ON DSK:  (DEFAULT).
/				THE <ESC> CHARACTER  WAS  USED  TO  TERMINATE THE LINE
/				(THIS IS SIGNIFIED BY $).  THIS CAUSES PROGRAM EXIT.
/	.			PROGRAM EXITS NORMALLY.
/	INPUT  FILE  ASSUMES  .EN  EXTENSION;  THERE IS NO ASSUMED  OUTPUT  EXTENSION.
/	IMAGE TRANSFER MODE DOESN'T USE OUTPUT FILENAMES, AS THE TRANSFER DESTROYS THE
/	OS/8 FILE STRUCTURE (POSSIBLY PRESENT) ON THE DEVICE.

/	PROGRAM EXIT IS THE NORMAL  OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
/	KEYBOARD DURING THE COMMAND, OR ENDING  THE  COMMAND  INPUT LINE WITH AN <ESC>
/	CHARACTER.

/	THIS PROGRAM  SUPPORTS  A PROPER SUBSET OF THE ASCII ENCODING SCHEME DISCUSSED
/	BY CHARLES LASNER  AND  FRANK  DA  CRUZ.  THE SCHEME USED IS FIVE-BIT ENCODING
/	WITH COMPRESSION, (AS OPPOSED  TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR
/	VERSIONS).

/	RESTRICTIONS:

/	A)	SUPPORTS ONLY ONE DECODABLE FILE PER ENCODED FILE.

/	B)	IGNORES ALL (END ) COMMANDS.

/	C)	<CR> <LF> < ALWAYS INDICATES ENCODED DATA LINES;  NO CHECK IS MADE FOR
/		WHETHER THE > IS ON THE SAME LINE AS THE <.

/	D) 	PDP-8 GENERATED CHECKSUM DATA MUST  BE  THE  FINAL DATA IN THE FILE IN
/		THE  PROPER  FORMAT:    ZCCCCCCCCCCCC  WHERE  CCCCCCCCCCCC    IS   THE
/		TWELVE-CHARACTER PDP-8 CHECKSUM DATA.

/	IF THE ENCODED FILE IS PASSED THROUGH ANY  INTERMEDIARY  PROCESS THAT MODIFIES
/	THE CONTENTS IN A WAY THAT INTERFERES WITH ANY  OF  THE  ABOVE,  THIS DECODING
/	PROGRAM  WILL  FAIL.   IT IS THE USER'S RESPONSIBILITY TO  EDIT  OUT  UNWANTED
/	CHANGES TO THE ENCODED FILE.  ALL OTHER ASPECTS OF THE  PROTOCOL  ARE  OBEYED,
/	SUCH AS IMBEDDED <FF>, EXTRA <CR> <LF>, OR TRAILING SPACES HAVE NO  EFFECT  ON
/	THE RELIABILITY OF THE DECODING PROCESS, ETC.
/	ERROR MESSAGES.

/	ANY MESSAGE  PRINTED  IS A FATAL ERROR MESSAGE.  ALL MESSAGES ARE THE STANDARD
/	OS/8 "USER" ERROR  MESSAGES OF THE FORM:  USER ERROR X AT AAAAA WHERE X IS THE
/	ERROR NUMBER AND AAAAA  IS  THE  PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
/	THE FOLLOWING USER ERRORS ARE DEFINED:

/	ERROR NUMBER		PROBABLE CAUSE

/	0			TOO MANY OUTPUT FILES.

/	1			NO INPUT FILE OR TOO MANY INPUT FILES.

/	2			IMBEDDED OUTPUT FILENAME FORMAT ERROR.

/	3			I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.

/	4			ERROR WHILE FETCHING FILE HANDLER.

/	5			ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.

/	6			OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.

/	7			ERROR WHILE CLOSING THE OUTPUT FILE.

/	8			I/O ERROR WHILE DECODING FILE DATA OR BAD DATA.

/	ASSEMBLY INSTRUCTIONS.

/	IT IS  ASSUMED  THE  SOURCE  FILE  K12DEC.PAL  HAS  BEEN  MOVED AND RENAMED TO
/	DSK:DECODE.PA.

/	.PAL DECODE<DECODE	ASSEMBLE SOURCE PROGRAM
/	.LOAD DECODE		LOAD THE BINARY FILE
/	.SAVE DEV DECODE=0	SAVE THE CORE-IMAGE FILE
/	DEFINITIONS.

	CLOSE=	4			/CLOSE OUTPUT FILE
	DECODE=	5			/CALL COMMAND DECODER
	ENTER=	3			/ENTER TENTATIVE FILE
	EQUWRD=	7646			/EQUALS PARAMETER HERE IN TABLE FIELD
	FETCH=	1			/FETCH HANDLER
	IHNDBUF=7200			/INPUT HANDLER BUFFER
	INBUFFE=6200			/INPUT BUFFER
	INFILE=	7617			/INPUT FILE INFORMATION HERE
	INQUIRE=12			/INQUIRE ABOUT HANDLER
	NL0001=	CLA IAC			/LOAD AC WITH 0001
	NL0002=	CLA CLL CML RTL		/LOAD AC WITH 0002
	NL4000=	CLA CLL CML RAR		/LOAD AC WITH 4000
	NL7776=	CLA CLL CMA RAL		/LOAD AC WITH 7776
	NL7777=	CLA CMA			/LOAD AC WITH 7777
	OHNDBUF=6600			/OUTPUT HANDLER BUFFER
	OUTBUFF=5600			/OUTPUT BUFFER
	OUTFILE=7600			/OUTPUT FILE INFORMATION HERE
	PRGFLD=	00			/PROGRAM FIELD
	RESET=	13			/RESET SYSTEM TABLES
	SBOOT=	7600			/MONITOR EXIT
	SWAL=	7643			/A-/L SWITCHES HERE IN TABLE FIELD
	SWY9=	7645			/Y-/9 SWITCHES HERE IN TABLE FIELD
	TBLFLD=	10			/COMMAND DECODER TABLE FIELD
	TERMWRD=7642			/TERMINATOR WORD
	USERROR=7			/USER SIGNALLED ERROR
	USR=	7700			/USR ENTRY POINT
	USRFLD=	10			/USR FIELD
	WIDTH=	107-2			/69 DATA CHARACTERS PER LINE (TOTAL 71)
	WRITE=	4000			/I/O WRITE BIT
	*0				/START AT THE BEGINNING

	*10				/DEFINE AUTO-INDEX AREA

XR1,	.-.				/AUTO-INDEX NUMBER 1
XR2,	.-.				/AUTO-INDEX NUMBER 2

	*20				/GET PAST AUTO-INDEX AREA

BUFPTR,	.-.				/OUTPUT BUFFER POINTER
CCNT,	.-.				/CHECKSUM COUNTER
CHKSUM,	ZBLOCK	5			/CHECKSUM TEMPORARY
CHRCNT,	.-.				/CHARACTER COUNTER
CSUMTMP,.-.				/CHECKSUM TEMPORARY
DANGCNT,.-.				/DANGER COUNT
DATCNT,	.-.				/DATA COUNTER
DSTATE,	.-.				/DATA STATE VARIABLE
IDNUMBE,.-.				/INPUT DEVICE NUMBER
IMSW,	.-.				/IMAGE-MODE SWITCH
INITFLA,.-.				/INITIALIZE INPUT FLAG
INPUT,	.-.				/INPUT HANDLER POINTER
INRECOR,.-.				/INPUT RECORD
FCHKSUM,ZBLOCK	5			/FILE CHECKSUM
FNAME,	ZBLOCK	4			/OUTPUT FILENAME
GWTMP1,	.-.				/GETWORD TEMPORARY
GWTMP2,	.-.				/GETWORD TEMPORARY
GWVALUE,.-.				/LATEST WORD VALUE
ODNUMBE,.-.				/OUTPUT DEVICE NUMBER
OUTPUT,	.-.				/OUTPUT HANDLER POINTER
OUTRECO,.-.				/OUTPUT RECORD
PUTEMP,	.-.				/OUTPUT TEMPORARY
PUTPTR,	.-.				/OUTPUT POINTER
THIRD,	.-.				/THIRD BYTE TEMPORARY

/	STATE TABLE.

P,	SCANIT				/0000 LOOKING FOR "(" OR "<"
	FNDCOMMAND			/0001 FOUND "(" AND NOW LOOKING FOR ")"
	FNDCEND				/0002 FOUND ")" AND NOW LOOKING FOR <CR>
	FNDCR				/0003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
	STORDATA			/4000 FOUND "<" AND PROCESSING 69 DATA BYTES
	ENDATA				/4001 FOUND 69 DATA BYTES AND NOW LOOKING FOR ">"
	ENDCR				/4002 FOUND ">" AND NOW LOOKING FOR <CR>
	FNDCR/ENDLF			/4003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
	PAGE				/START AT THE USUAL PLACE

BEGIN,	NOP				/HERE IN CASE WE'RE CHAINED TO
	CLA				/CLEAN UP
START,	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	DECODE				/WANT COMMAND DECODER
	"E^100+"N-300			/.EN IS DEFAULT EXTENSION
	CDF	TBLFLD			/GOTO TABLE FIELD
	TAD I	(TERMWRD)		/GET TERMINATOR WORD
	SPA CLA				/SKIP IF <CR> TERMINATED THE LINE
	DCA	EXITZAP			/ELSE CAUSE EXIT LATER
	DCA	IMSW			/CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
	TAD I	(OUTFILE)		/GET FIRST OUTPUT FILE DEVICE WORD
	SNA				/SKIP IF FIRST OUTPUT FILE PRESENT
	JMP	TSTMORE			/JUMP IF NOT THERE
	AND	[17]			/JUST DEVICE BITS
ODNULL,	DCA	ODNUMBER		/SAVE OUTPUT DEVICE NUMBER
	TAD I	(OUTFILE+5)		/GET SECOND OUTPUT FILE DEVICE WORD
	SNA				/SKIP IF THERE
	TAD I	(OUTFILE+12)		/ELSE GET THIRD OUTPUT FILE DEVICE WORD
	SZA CLA				/SKIP IF BOTH NOT PRESENT
	JMP I	(OUTERR)		/ELSE COMPLAIN
	TAD I	(INFILE)		/GET FIRST INPUT FILE DEVICE WORD
	SNA				/SKIP IF PRESENT
	JMP I	(INERR)			/JUMP IF NOT
	AND	[17]			/JUST DEVICE BITS
	DCA	IDNUMBER		/SAVE INPUT DEVICE NUMBER
	TAD I	(INFILE+2)		/GET SECOND INPUT FILE DEVICE WORD
	SZA CLA				/SKIP IF ONLY ONE INPUT FILE
	JMP I	(INERR)			/ELSE COMPLAIN
	TAD I	(INFILE+1)		/GET FIRST INPUT FILE STARTING RECORD
	DCA	INRECORD		/SET IT UP
	CDF	PRGFLD			/BACK TO OUR FIELD
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	RESET				/RESET SYSTEM TABLES
	TAD	(IHNDBUFFER+1)		/GET INPUT BUFFER POINTER+TWO-PAGE BIT
	DCA	IHPTR			/STORE IN-LINE
	TAD	IDNUMBER		/GET INPUT DEVICE NUMBER
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	FETCH				/FETCH HANDLER
IHPTR,	.-.				/WILL BE BUFFER POINTER+TWO-PAGE BIT
	JMP I	(FERROR)		/FETCH ERROR
	TAD	IHPTR			/GET RETURNED ADDRESS
	DCA	INPUT			/STORE AS INPUT HANDLER ADDRESS
	JMS I	(GEOFILE)		/GET OUTPUT FILE INFORMATION
	TAD	(OHNDBUFFER+1)		/GET BUFFER POINTER+TWO-PAGE BIT
	DCA	OHPTR			/STORE IN-LINE
	TAD	ODNUMBER		/GET OUTPUT DEVICE NUMBER
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	FETCH				/FETCH HANDLER
OHPTR,	.-.				/WILL BE BUFFER POINTER+TWO-PAGE BIT
	JMP I	(FERROR)		/FETCH ERROR
	TAD	OHPTR			/GET RETURNED ADDRESS
	DCA	OUTPUT			/STORE AS OUTPUT HANDLER ADDRESS
	TAD	IMSW			/GET IMAGE-MODE SWITCH
	SNA CLA				/SKIP IF SET
	JMP	NOIMAGE			/JUMP IF NOT

/	IF /2 IS SET,  THE  DATA  STARTS  HALF-WAY  INTO THE IMAGE.  OTHER IMAGE MODES
/	START AT RECORD 0000.

	CDF	TBLFLD			/GOTO TABLE FIELD
	TAD I	[SWY9]			/GET /Y-/9 SWITCHES
	AND	(200)			/JUST /2 SWITCH
	SNA CLA				/SKIP IF SET
	JMP	IMAGE1			/JUMP IF /1 OR NEITHER /1, /2 SET
	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	CLL RAR				/%2
IMAGE1,	DCA	OUTRECORD		/STORE STARTING OUTPUT RECORD
	CDF	PRGFLD			/BACK TO OUR FIELD
	SKP				/DON'T ENTER FILE NAME
NOIMAGE,JMS I	(FENTER)		/ENTER THE TENTATIVE FILE NAME
	DCA	DSTATE			/SET INITIAL DATA STATE
	JMS I	(CLRCHKSUM)		/CLEAR OUT CHECKSUM
	JMS I	(DECODIT)		/GO DO THE ACTUAL DECODING
	JMP I	(PROCERR)		/ERROR WHILE DECODING
	TAD	IMSW			/GET IMAGE-MODE SWITCH
	SZA CLA				/SKIP IF CLEAR
	JMP	EXITZAP			/JUMP IF SET
	TAD	ODNUMBER		/GET OUTPUT DEVICE NUMBER
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	CLOSE				/CLOSE OUTPUT FILE
	FNAME				/POINTER TO FILENAME
OUTCNT,	.-.				/WILL BE ACTUAL COUNT
	JMP I	(CLSERR)		/CLOSE ERROR
EXITZAP,JMP	START			/**** <ESC> TERMINATION **** 0000
	JMP I	(SBOOT)			/EXIT TO MONITOR
/	COMES HERE TO TEST FOR NULL LINE.

TSTMORE,TAD I	(OUTFILE+5)		/GET SECOND OUTPUT FILE DEVICE WORD
	SNA				/SKIP IF PRESENT
	TAD I	(OUTFILE+12)		/ELSE GET THIRD OUTPUT FILE DEVICE WORD
	SZA CLA				/SKIP IF NO OUTPUT FILES
	JMP I	(OUTERR)		/ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT 
	TAD I	(INFILE)		/GET FIRST OUTPUT FILE DEVICE WORD
	SZA CLA				/SKIP IF NO INPUT FILES
	JMP	ODNULL			/JUMP IF INPUT WITHOUT OUTPUT
	CDF	PRGFLD			/BACK TO OUR FIELD
	JMP	EXITZAP			/MIGHT BE LAST TIME, SO GO THERE FIRST

	PAGE
/	ERROR WHILE PROCESSING INPUT FILE.

PROCERR,NL0002				/SET INCREMENT
	SKP				/DON'T USE NEXT

/	ERROR WHILE CLOSING THE OUTPUT FILE.

CLSERR,	NL0001				/SET INCREMENT
	SKP				/DON'T CLEAR IT

/	OUTPUT FILE TOO LARGE ERROR.

SIZERR,	CLA				/CLEAN UP
	TAD	[3]			/SET INCREMENT
	SKP				/DON'T USE NEXT

/	ENTER ERROR.

ENTERR,	NL0002				/SET INCREMENT
	SKP				/DON'T USE NEXT

/	HANDLER FETCH ERROR.

FERROR,	NL0001				/SET INCREMENT

/	I/O ERROR WHILE PROCESSING (FILE ) COMMAND.

NIOERR,	IAC				/SET INCREMENT

/	FORMAT ERROR WHILE PROCESSING (FILE ) COMMAND.

CHARERR,IAC				/SET INCREMENT

/	INPUT FILESPEC ERROR.

INERR,	IAC				/SET INCREMENT

/	OUTPUT FILESPEC ERROR.

OUTERR,	DCA	ERRNUMBER		/STORE ERROR NUMBER
	CDF	PRGFLD			/ENSURE OUR FIELD
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	USERROR				/USER ERROR
ERRNUMB,.-.				/WILL BE PASSED ERROR NUMBER
DECODIT,.-.				/DECODING ROUTINE
	TAD	OUTRECORD		/GET STARTING RECORD OF TENTATIVE FILE
	DCA	PUTRECORD		/STORE IN-LINE
	DCA I	(OUTCNT)		/CLEAR ACTUAL FILE LENGTH
	NL7777				/SETUP THE
	DCA	INITFLAG		/INITIALIZE FLAG
	TAD	(GWLOOP)		/INITIALIZE THE
	DCA I	(GWNEXT)		/DECODE PACK ROUTINE
PUTNEWR,TAD	POUTBUFFER/(OUTBUFFER)	/SETUP THE
	DCA	PUTPTR			/OUTPUT BUFFER POINTER
PUTLOOP,JMS I	(GETWORD)		/GET A WORD
	DCA I	PUTPTR			/STORE IT
	ISZ	PUTPTR			/BUMP TO NEXT
	TAD	PUTPTR			/GET THE POINTER
	TAD	(-2^200-OUTBUFFER)	/COMPARE TO LIMIT
	SZA CLA				/SKIP IF AT END
	JMP	PUTLOOP			/KEEP GOING
	ISZ	DANGCNT			/TOO MANY RECORDS?
	SKP				/SKIP IF NOT
	JMP I	(SIZERROR)		/NOT ENOUGH SPACE AVAILABLE
	JMS I	OUTPUT			/CALL OUTPUT HANDLER
	2^100+WRITE			/WRITE LATEST RECORD
POUTBUF,OUTBUFFER			/OUTPUT BUFFER ADDRESS
PUTRECO,.-.				/WILL BE LATEST RECORD NUMBER
DECERR,	JMP I	DECODIT			/I/O ERROR
	ISZ	PUTRECORD		/BUMP TO NEXT RECORD
	NOP				/JUST IN CASE
	ISZ I	(OUTCNT)		/BUMP ACTUAL LENGTH
	JMP	PUTNEWRECORD		/GO DO ANOTHER ONE

/	GOOD RETURN HERE.

DECBMP,	ISZ	DECODIT			/BUMP TO GOOD RETURN
	JMP I	DECODIT			/RETURN
/	OS/8 FILE UNPACK ROUTINE.

GETBYTE,.-.				/GET A BYTE ROUTINE
	SNA CLA				/INITIALIZING?
	JMP I	PUTC			/NO, GO GET NEXT BYTE
	TAD	INRECORD		/GET STARTING RECORD OF INPUT FILE
	DCA	GETRECORD		/STORE IN-LINE
GETNEWR,JMS I	INPUT			/CALL I/O HANDLER
	2^100				/READ TWO PAGES INTO BUFFER
	INBUFFER			/BUFFER ADDRESS
GETRECO,.-.				/WILL BE LATEST RECORD NUMBER
	JMP I	GETBYTE			/INPUT ERROR!
	TAD	(INBUFFER)		/SETUP THE
	DCA	BUFPTR			/BUFFER POINTER
GETLOOP,DCA	THIRD			/CLEAR THIRD BYTE NOW
	JMS	PUTONE			/OBTAIN AND SEND BACK FIRST BYTE
	JMS	PUTONE			/OBTAIN AND SEND BACK SECOND BYTE
	TAD	THIRD			/GET THIRD BYTE
	JMS	PUTC			/SEND IT BACK
	TAD	BUFPTR			/GET THE POINTER
	TAD	(-2^200-INBUFFER)	/COMPARE TO LIMIT
	SZA CLA				/SKIP IF AT END
	JMP	GETLOOP			/KEEP GOING
	ISZ	GETRECORD		/BUMP TO NEXT RECORD
	JMP	GETNEWRECORD		/GO DO ANOTHER ONE

PUTONE,	.-.				/SEND BACK A BYTE ROUTINE
	TAD I	BUFPTR			/GET LATEST WORD
	AND	(7400)			/JUST THIRD-BYTE NYBBLE
	CLL RAL				/MOVE UP
	TAD	THIRD			/GET OLD NYBBLE (IF ANY)
	RTL;RTL				/MOVE UP NYBBLE BITS
	DCA	THIRD			/SAVE FOR NEXT TIME
	TAD I	BUFPTR			/GET LATEST WORD AGAIN
	JMS	PUTC			/SEND BACK CURRENT BYTE
	ISZ	BUFPTR			/BUMP TO NEXT WORD
	JMP I	PUTONE			/RETURN

PUTC,	.-.				/SEND BACK LATEST BYTE ROUTINE
	AND	(177)			/KEEP ONLY GOOD BITS
	TAD	(-"Z!300)		/COMPARE TO <^Z>
	SNA				/SKIP IF NOT ASCII <EOF>
	JMP	GETEOF			/JUMP IF ASCII MODE <EOF>
	TAD	("Z&37)			/RESTORE THE CHARACTER
	ISZ	GETBYTE			/BUMP PAST <EOF> RETURN
GETEOF,	ISZ	GETBYTE			/BUMP PAST I/O ERROR RETURN
	JMP I	GETBYTE			/RETURN TO MAIN CALLER
	PAGE
/	GET A DECODED WORD ROUTINE.

GETWORD,.-.				/GET A WORD ROUTINE
	JMP I	GWNEXT			/GO WHERE YOU SHOULD GO

GWNEXT,	.-.				/EXIT ROUTINE
	SNL				/SKIP IF CHECKSUM PREVENTED
	JMS I	(DOCHECK)		/ELSE DO CHECKSUM
	JMP I	GETWORD			/RETURN TO MAIN CALLER

/	COMES HERE TO PROCESSED COMPRESSED DATA.

GWX,	JMS I	(GETCHR)		/GET NEXT CHARACTER
	JMS I	(GWORD0)		/GET 12-BIT WORD
	JMS I	(DOCHECK)		/INCLUDE IN CHECKSUM
	DCA	GWVALUE			/SAVE AS COMPRESSED VALUE
	TAD	GWTMP2			/GET LATEST CHARACTER
	AND	[7]			/ISOLATE BITS[9-11]
	CLL RTR;RTR			/BITS[9-11] => AC[0-2]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS	GBIHEXBINARY		/GET A CHARACTER
	CLL RTL;RTL			/BITS[7-11] => AC[3-7]
	TAD	GWTMP1			/ADD ON BITS[0-2]
	JMS I	(DOCHECK)		/INCLUDE IN CHECKSUM
	CLL RTR;RTR			/BITS[0-7] => AC[4-11]
	SNA				/SKIP IF NOT 256
	TAD	[400]			/000 => 256
	CIA				/INVERT FOR COUNTING
	DCA	GWTMP1			/SAVE AS REPEAT COUNTER
GWXLUP,	TAD	GWVALUE			/GET THE VALUE
	STL				/PREVENT CHECKSUMMING IT
	JMS	GWNEXT			/RETURN IT TO THEM
	ISZ	GWTMP1			/DONE ENOUGH?
	JMP	GWXLUP			/NO, KEEP GOING
/	COMES HERE TO INITIATE ANOTHER DATA GROUP.

GWLOOP,	JMS I	(GETCHR)		/GET LATEST FILE CHARACTER
	TAD	(-"Z!200)		/COMPARE TO EOF INDICATOR
	SNA				/SKIP IF OTHER
	JMP	GWZ			/JUMP IF IT MATCHES
	TAD	(-"X+"Z)		/COMPARE TO COMPRESSION INDICATOR
	SNA CLA				/SKIP IF OTHER
	JMP	GWX			/JUMP IF IT MATCHES
	TAD	PUTEMP			/GET THE CHARACTER BACK
	JMS I	(GWORD0)		/GET A 12-BIT WORD
	JMS	GWNEXT			/RETURN IT
	JMS I	(GWORD1)		/GET NEXT 12-BIT WORD
	JMS	GWNEXT			/RETURN IT
	JMS I	(GWORD2)		/GET NEXT 12-BIT WORD
	JMS	GWNEXT			/RETURN IT
	JMS I	(GWORD3)		/GET NEXT 12-BIT WORD
	JMS	GWNEXT			/RETURN IT
	JMS I	(GWORD4)		/GET NEXT 12-BIT WORD
	JMS	GWNEXT			/RETURN IT
	JMP	GWLOOP			/KEEP GOING

/	COMES HERE WHEN EOF INDICATOR FOUND.

GWZ,	TAD	(FCHKSUM-1)		/SETUP THE
	DCA	XR1			/CHECKSUM POINTER
	JMS I	(GETCHR)		/GET NEXT CHARACTER
	JMS I	(GWORD0)		/GET A 12-BIT WORD
	DCA I	XR1			/STORE IT
	JMS I	(GWORD1)		/GET NEXT WORD
	DCA I	XR1			/STORE IT
	JMS I	(GWORD2)		/GET NEXT WORD
	DCA I	XR1			/STORE IT
	JMS I	(GWORD3)		/GET NEXT WORD
	DCA I	XR1			/STORE IT
	JMS I	(GWORD4)		/GET NEXT WORD
	DCA I	XR1			/STORE IT
	TAD	(CHKSUM-1)		/POINT TO
	DCA	XR1			/CALCULATED CHECKSUM
	TAD	(FCHKSUM-1)		/POINT TO
	DCA	XR2			/FILE CHECKSUM
	TAD	[-5]			/SETUP THE
	DCA	CCNT			/COMPARE COUNT
	CLL				/CLEAR LINK FOR TEST
GWCMPLP,RAL				/GET CARRY
	TAD I	XR1			/GET A CALCULATED WORD
	TAD I	XR2			/COMPARE TO FILE WORD
	SZA CLA				/SKIP IF OK
	JMP I	(DECERR)		/ELSE COMPLAIN
	ISZ	CCNT			/DONE ALL?
	JMP	GWCMPLP			/NO, KEEP GOING
/	THE CHECKSUM IS OK, CHECK IF FILE ENDED IN A PLAUSIBLE PLACE.

	TAD	PUTPTR			/GET OUTPUT POINTER
	TAD	(-OUTBUFFER-4)		/COMPARE TO LIMIT
	SMA SZA CLA			/SKIP IF GOOD VALUE
	JMP I	(DECERROR)		/JUMP IF NOT

/	THE FILE ENDED OK, THERE WERE POSSIBLY A  FEW  CHARACTERS  LEFTOVER BECAUSE OF
/	ALIGNMENT  CONSIDERATIONS.    THEY  SHOULD  BE  IGNORED SINCE OS/8  FILES  ARE
/	MULTIPLES OF WHOLE RECORDS.

	JMP I	(DECBMP)		/RETURN WITH ALL OK

GBIHEXB,.-.				/GET BINARY VALUE OF BIHEXADECIMAL CHARACTER
	CLA				/CLEAN UP
	TAD	GBIHEXBINARY		/GET OUR CALLER
	DCA	BIHEXBINARY		/MAKE IT THEIRS
	JMS I	(GETCHR)		/GET A CHARACTER
	SKP				/DON'T EXECUTE HEADER!

BIHEXBI,.-.				/CONVERT BIHEXADECIMAL TO BINARY
	TAD	(-"A!200)		/COMPARE TO ALPHABETIC LIMIT
	SMA				/SKIP IF LESS
	TAD	("9+1-"A)		/ELSE ADD ON ALPHABETIC OFFSET
	TAD	(-"0+"A)		/MAKE IT BINARY, NOT ASCII
	DCA	GWTMP2			/SAVE IT
	TAD	GWTMP2			/GET IT BACK
	JMP I	BIHEXBINARY		/RETURN

	PAGE
/	GET  WORD[0]  ROUTINE.	  AC  MUST  ALREADY  CONTAIN THE FIRST  BI-HEXADECIMAL
/	CHARACTER.

GWORD0,	.-.				/GET 12-BIT WORD[0]
	JMS I	(BIHEXBINARY)		/CONVERT PASSED VALUE TO BINARY
	CLL RTR;RTR;RTR			/BITS[7-11] => AC[0-4]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	CLL RTL				/BITS[7-11] => AC[5-9]
	TAD	GWTMP1			/ADD ON BITS[0-4]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	RTR;RAR				/BITS[7-8] => AC[10-11]
	AND	[3]			/ISOLATE BITS[10-11]
	TAD	GWTMP1			/ADD ON BITS[0-9]
	CLL				/CLEAR LINK
	JMP I	GWORD0			/RETURN

/	GET  WORD[1] ROUTINE.  GWORD0 MUST HAVE BEEN CALLED LAST, SO  GWTMP2  CONTAINS
/	THE PREVIOUS CHARACTER.

GWORD1,	.-.				/GET 12-BIT WORD[1]
	TAD	GWTMP2			/GET PREVIOUS CHARACTER
	AND	[7]			/ISOLATE BITS[9-11]
	CLL RTR;RTR			/BITS[9-11] => AC[0-2]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	CLL RTL;RTL			/BITS[7-11] => AC[3-7]
	TAD	GWTMP1			/ADD ON BITS[0-2]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	CLL RAR				/BITS[7-10] => AC[8-11]
	TAD	GWTMP1			/ADD ON BITS[0-7]
	CLL				/CLEAR LINK
	JMP I	GWORD1			/RETURN
/	GET  WORD[2]  ROUTINE.	GWORD1 MUST HAVE BEEN CALLED LAST, SO GWTMP2  CONTAINS
/	THE PREVIOUS CHARACTER.

GWORD2,	.-.				/GET 12-BIT WORD[2]
	TAD	GWTMP2			/GET PREVIOUS CHARACTER
	RAR;CLA RAR			/BIT[11] => AC[0]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	CLL RTL;RTL;RTL			/BITS[7-11] => AC[1-5]
	TAD	GWTMP1			/ADD ON BIT[0]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	CLL RAL				/BITS[7-11] => AC[6-10]
	TAD	GWTMP1			/ADD ON BITS[0-5]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	AND	(20)			/ISOLATE BIT[7]
	CLL RTR;RTR			/BIT[7] => AC[11]
	TAD	GWTMP1			/ADD ON BITS[0-10]
	CLL				/CLEAR LINK
	JMP I	GWORD2			/RETURN

/	GET  WORD[3]  ROUTINE.   GWORD2 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
/	THE PREVIOUS CHARACTER.

GWORD3,	.-.				/GET 12-BIT WORD[3]
	TAD	GWTMP2			/GET PREVIOUS CHARACTER
	CLL RTR;RTR;RAR			/BITS[8-11] => AC[0-3]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	CLL RTL;RAL			/BITS[7-11] => AC[4-8]
	TAD	GWTMP1			/ADD ON BITS[0-3]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	RTR				/BITS[7-9] => AC[9-11]
	AND	[7]			/ISOLATE BITS[9-11]
	TAD	GWTMP1			/ADD ON BITS[0-8]
	CLL				/CLEAR LINK
	JMP I	GWORD3			/RETURN
/	GET WORD[4]  ROUTINE.	 GWORD3 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
/	THE PREVIOUS CHARACTER.

GWORD4,	.-.				/GET 12-BIT WORD[4]
	TAD	GWTMP2			/GET PREVIOUS CHARACTER
	AND	[3]			/ISOLATE BITS[10-11]
	CLL RTR;RAR			/BITS[10-11] => AC[0-1]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	CLL RTL;RTL;RAL			/BITS[7-11] => AC[2-6]
	TAD	GWTMP1			/ADD ON BITS[0-1]
	DCA	GWTMP1			/SAVE FOR NOW
	JMS I	(GBIHEXBINARY)		/GET NEXT CHARACTER IN BINARY
	TAD	GWTMP1			/ADD ON BITS[0-6] TO BITS[7-11]
	CLL				/CLEAR LINK
	JMP I	GWORD4			/RETURN

DOCHECK,.-.				/CHECKSUM ROUTINE
	DCA	CSUMTMP			/SAVE PASSED VALUE
	TAD	(CHKSUM-1)		/SETUP THE
	DCA	XR1			/INPUT POINTER
	TAD	(CHKSUM-1)		/SETUP THE
	DCA	XR2			/OUTPUT POINTER
	TAD	[-5]			/SETUP THE
	DCA	CCNT			/SUM COUNT
	TAD	CSUMTMP			/GET THE VALUE
	CLL RAR				/ADJUST FOR OPENING ITERATION
CSUMLUP,RAL				/GET CARRY
	TAD I	XR1			/ADD ON A WORD
	DCA I	XR2			/STORE BACK
	ISZ	CCNT			/DONE ALL YET?
	JMP	CSUMLUP			/NO, KEEP GOING
	TAD	CSUMTMP			/GET LATEST VALUE
	JMP I	DOCHECK			/RETURN

	PAGE
GETCHR,	.-.				/GET A VALID CHARACTER ROUTINE
GETMORE,TAD	INITFLAG		/GET INITIALIZE FLAG
	JMS I	[GETBYTE]		/GET A CHARACTER
	JMP I	(DECERR)		/I/O ERROR
	JMP I	(DECERR)		/<EOF>
	DCA	PUTEMP			/SAVE THE CHARACTER
	DCA	INITFLAG		/CLEAR INITIALIZE FLAG
	TAD	DSTATE			/GET DATA STATE
	SPA				/SKIP IF NOT ONE OF THE DATA-ORIENTED STATES
	TAD	(4004)			/ADD ON DATA-ORIENTED STATES OFFSET
	TAD	(JMP I	P)		/SETUP JUMP INSTRUCTION
	DCA	.+1			/STORE IN-LINE
	.-.				/AND EXECUTE IT

/	LOOKING FOR OPENING CHARACTER.

SCANIT,	TAD	PUTEMP			/GET THE CHARACTER
	TAD	(-"<!200)		/COMPARE TO OPENING DATA CHARACTER
	SNA				/SKIP IF NO MATCH
	JMP	FNDATA			/JUMP IF IT MATCHES
	TAD	(-"(+"<)		/COMPARE TO OPENING COMMAND CHARACTER
	SNA CLA				/SKIP IF NO MATCH
	ISZ	DSTATE			/INDICATE LOOKING FOR END OF COMMAND
	JMP	GETMORE			/KEEP GOING

/	FOUND OPENING COMMAND CHARACTER.

FNDCOMM,TAD	PUTEMP			/GET THE CHARACTER
	TAD	(-")!200)		/COMPARE TO CLOSING COMMAND CHARACTER
	SNA CLA				/SKIP IF NO MATCH
	ISZ	DSTATE			/INDICATE LOOKING FOR <CR>
	JMP	GETMORE			/KEEP GOING

/	FOUND CLOSING COMMAND CHARACTER.

FNDCEND,TAD	PUTEMP			/GET THE CHARACTER
	TAD	(-"M!300)		/COMPARE TO <CR>
	SNA CLA				/SKIP IF NO MATCH
	ISZ	DSTATE			/INDICATE LOOKING FOR <LF>
	JMP	GETMORE			/KEEP GOING

/	FOUND <CR> AFTER COMMAND.

FNDCR,	TAD	PUTEMP			/GET THE CHARACTER
	TAD	(-"J!300)		/COMPARE TO <LF>
	SNA CLA				/SKIP IF NO MATCH
	DCA	DSTATE			/RESET TO SCANNING STATE
	JMP	GETMORE			/KEEP GOING
/	FOUND OPENING DATA CHARACTER.

FNDATA,	TAD	(-WIDTH)		/SETUP THE
	DCA	DATCNT			/DATA COUNTER
	NL4000				/SETUP THE
	DCA	DSTATE			/NEW STATE
	JMP	GETMORE			/KEEP GOING

/	PROCESSING ONE OF 69 DATA CHARACTERS.

STORDAT,TAD	PUTEMP			/GET THE CHARACTER
	TAD	[-140]			/SUBTRACT UPPER-CASE LIMIT
	SPA				/SKIP IF LOWER-CASE
	TAD	[40]			/RESTORE UPPER-CASE
	TAD	(100)			/RESTORE THE CHARACTER
	DCA	PUTEMP			/SAVE IT BACK
	TAD	PUTEMP			/GET IT AGAIN
	TAD	(-"Z!200-1)		/SUBTRACT UPPER LIMIT
	CLL				/CLEAR LINK FOR TEST
	TAD	("Z-"A+1)		/ADD ON RANGE
	SZL CLA				/SKIP IF NOT ALPHABETIC
	JMP	ALPHAOK			/JUMP IF ALPHABETIC
	TAD	PUTEMP			/GET THE CHARACTER
	TAD	(-"9!200-1)		/ADD ON UPPER LIMIT
	CLL				/CLEAR LINK FOR TEST
	TAD	("9-"0+1)		/ADD ON RANGE
	SNL CLA				/SKIP IF OK
	JMP	GETMORE			/IGNORE IF NOT
ALPHAOK,TAD	PUTEMP			/GET THE CHARACTER
	ISZ	DATCNT			/DONE 69 CHARACTERS?
	SKP				/SKIP IF NOT
	ISZ	DSTATE			/ADVANCE TO NEXT STATE
	JMP I	GETCHR			/RETURN

/	PROCESSED 69 DATA CHARACTERS; NOW LOOKING FOR ENDING DATA CHARACTER.

ENDATA,	TAD	PUTEMP			/GET THE CHARACTER
	TAD	(-">!200)		/COMPARE TO ENDING DATA VALUE
	SNA CLA				/SKIP IF NO MATCH
	ISZ	DSTATE			/ELSE ADVANCE TO NEXT STATE
	JMP	GETMORE			/KEEP GOING

/	FOUND ENDING DATA CHARACTER; NOW LOOKING FOR <CR>.

ENDCR,	TAD	PUTEMP			/GET THE CHARACTER
	TAD	(-"M!300)		/COMPARE TO <CR>
	SNA CLA				/SKIP IF NO MATCH
	ISZ	DSTATE			/ELSE ADVANCE TO NEXT STATE
	JMP	GETMORE			/KEEP GOING
/	FOUND ENDING DATA CHARACTER AND <CR>; NOW LOOKING FOR <LF>.

/ENDLF,	TAD	PUTEMP			/GET THE CHARACTER
/	TAD	(-"J!300)		/COMPARE TO <LF>
/	SNA CLA				/SKIP IF NO MATCH
/	DCA	DSTATE			/RESET TO SCANNING STATE
/	JMP	GETMORE			/KEEP GOING

CLRCHKS,.-.				/CLEAR CALCULATED CHECKSUM ROUTINE
	DCA	CHKSUM+0		/CLEAR LOW-ORDER
	DCA	CHKSUM+1		/CLEAR NEXT
	DCA	CHKSUM+2		/CLEAR NEXT
	DCA	CHKSUM+3		/CLEAR NEXT
	DCA	CHKSUM+4		/CLEAR HIGH-ORDER
	JMP I	CLRCHKSUM		/RETURN

	PAGE
GEOFILE,.-.				/GET OUTPUT FILE ROUTINE
	TAD	ODNUMBER		/GET OUTPUT DEVICE NUMBER
	SZA CLA				/SKIP IF NOT ESTABLISHED YET
	JMP	GOTOD			/JUMP IF DETERMINED ALREADY
	TAD	("D^100+"S-300)		/GET BEGINNING OF "DSK"
	DCA	DEVNAME			/STORE IN-LINE
	TAD	("K^100)		/GET REST OF "DSK"
	DCA	DEVNAME+1		/STORE IN-LINE
	DCA	RETVAL			/CLEAR HANDLER ENTRY WORD
	CDF	PRGFLD			/INDICATE OUR FIELD
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	INQUIRE				/INQUIRE ABOUT HANDLER
DEVNAME,ZBLOCK	2			/WILL BE DEVICE DSK
RETVAL,	.-.				/BECOMES HANDLER ENTRY POINT WORD
	HLT				/DSK: NOT IN SYSTEM IS IMPOSSIBLE!
	TAD	DEVNAME+1		/GET DEVICE NUMBER FOR DSK:
	AND	[17]			/JUST DEVICE BITS
	DCA	ODNUMBER		/STORE OUTPUT DEVICE
GOTOD,	CDF	TBLFLD			/BACK TO TABLE FIELD
	TAD I	(OUTFILE+1)		/GET OUTPUT FILE FIRST NAME WORD
	SNA				/SKIP IF PRESENT
	JMP	GFLNAME			/JUMP IF NOT
	DCA	FNAME			/MOVE TO OUR AREA
	TAD I	(OUTFILE+2)		/GET SECOND NAME WORD
	DCA	FNAME+1			/MOVE IT
	TAD I	(OUTFILE+3)		/GET THIRD NAME WORD
	DCA	FNAME+2			/MOVE IT
	TAD I	(OUTFILE+4)		/GET EXTENSION WORD
	DCA	FNAME+3			/MOVE IT
GEOFXIT,CDF	PRGFLD			/BACK TO OUR FIELD
	JMP I	GEOFILE			/RETURN

/	WE  MUST  TAKE  THE  FILENAME  FROM  THE IMBEDDED (FILE ) COMMAND.   THE  ONLY
/	EXCEPTION IS IF WE ARE DOING AN IMAGE TRANSFER.

GFLNAME,TAD I	(SWAL)			/GET /A-/L SWITCHES
	AND	(10)			/JUST /I BIT
	SZA CLA				/SKIP IF NOT SET
	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	SNA				/SKIP IF SET TO SOMETHING
	JMP	DOFLNAME		/JUMP IF PARAMETERS NOT SET
	CMA				/INVERT IT
	DCA	DANGCNT			/STORE AS DANGER COUNT
	ISZ	IMSW			/SET IMAGE-MODE SWITCH
	TAD I	[SWY9]			/GET /Y-/9 SWITCHES
	AND	(600)			/JUST /1, /2 SWITCHES
	SNA				/SKIP IF EITHER SET
	JMP	GEOFXIT			/JUMP IF NEITHER SET
	AND	[400]			/JUST /1 SWITCH
	SNA CLA				/SKIP IF /1 SET
	JMP	IM2			/JUMP IF /2 SET
	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	CLL RAR				/%2
	JMP	IMCOMMON		/CONTINUE THERE
IM2,	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	CLL RAR				/%2
	CIA				/SUBTRACT PART 1 VALUE
	TAD I	[EQUWRD]		/FROM EQUALS PARAMETER
IMCOMMO,CMA				/INVERT IT
	DCA	DANGCNT			/STORE AS DANGER COUNT
	JMP	GEOFXIT			/EXIT THERE

DOFLNAM,CDF	PRGFLD			/BACK TO OUR FIELD
	NL7777				/SETUP THE
	DCA	INITFLAG		/INPUT FILE INITIALIZATION
	JMS I	(SCNFILE)		/SCAN OFF "(FILE"

/	HAVING FOUND THE (FILE ) COMMAND, WE MUST FIND THE FILENAME.

/	ZERO OUT THE FILENAME AREA.

	TAD	(-10)			/SETUP THE
	DCA	CHRCNT			/CLEAR COUNTER
	TAD	(ONAME-1)		/SETUP THE
	DCA	XR1			/POINTER
	JMS I	(CLRNAME)		/CLEAR THE NAME BUFFER

/	SETUP FOR SCANNING THE NAME PORTION.

	TAD	(-6)			/SETUP THE
	DCA	CHRCNT			/SCAN COUNT
	TAD	(ONAME-1)		/SETUP THE
	DCA	XR1			/POINTER
FNCAGN,	JMS I	(GETAN)			/GET A CHARACTER
	JMP	GOTSEPARATOR		/GOT "."; GOTO NEXT FIELD
	DCA I	XR1			/STASH THE CHARACTER
	ISZ	CHRCNT			/DONE ALL YET?
	JMP	FNCAGN			/NO, KEEP GOING

/	THROW AWAY EXTRA NAME CHARACTERS.

TOSSNAM,JMS I	(GETAN)			/GET A CHARACTER
	JMP	GOTSEPARATOR		/GOT "."; GOTO NEXT FIELD
	JMP	TOSSNAME		/KEEP GOING

/	COMES HERE AFTER "." FOUND.

GOTSEPA,JMS I	(CLRNAME)		/CLEAR OUT THE REMAINING NAME FIELD
	NL7776				/SETUP THE
	DCA	CHRCNT			/SCAN COUNT
EXCAGN,	JMS I	(GETAN)			/GET A CHARACTER
	JMP I	[CHARERROR]		/GOT "."; COMPLAIN
	DCA I	XR1			/STASH THE CHARACTER
	ISZ	CHRCNT			/DONE ENOUGH YET?
	JMP	EXCAGN			/NO, KEEP GOING
/	TOSS ANY EXTRA EXTENSION CHARACTERS.

TOSSEXT,JMS I	(GETAN)			/GET A CHARACTER
	JMP I	[CHARERROR]		/GOT "."; COMPLAIN
	JMP	TOSSEXTENSION		/KEEP GOING

/	COMES HERE WHEN TRAILING ")" IS FOUND.

GOTRPAR,JMS I	(CLRNAME)		/CLEAR ANY REMAINING EXTENSION CHARACTERS
	TAD I	(ONAME)			/GET THE FIRST CHARACTER
	SNA CLA				/SKIP IF SOMETHING THERE
	JMP I	[CHARERROR]		/COMPLAIN IF NONE THERE
	TAD	(ONAME-1)		/SETUP POINTER
	DCA	XR1			/TO NAME CHARACTERS
	TAD	(FNAME-1)		/SETUP POINTER
	DCA	XR2			/TO PACKED NAME AREA
	TAD	(-4)			/SETUP THE
	DCA	CHRCNT			/MOVE COUNT
CHRLOOP,TAD I	XR1			/GET FIRST CHARACTER
	CLL RTL;RTL;RTL			/MOVE UP
	TAD I	XR1			/ADD ON SECOND CHARACTER
	DCA I	XR2			/STORE THE PAIR
	ISZ	CHRCNT			/DONE YET?
	JMP	CHRLOOP			/NO, KEEP GOING
	JMP I	GEOFILE			/YES, RETURN

	PAGE
SCNFILE,.-.				/SCAN "(FILE" ROUTINE
MATAGN,	JMS	GETNSPC			/GET A CHARACTER
	TAD	(-"(!200)		/COMPARE TO "("
	SZA CLA				/SKIP IF IT MATCHES
	JMP	MATAGN			/JUMP IF NOT
	JMS	GETNSPC			/GET NEXT CHARACTER
	TAD	(-"F!300)		/COMPARE TO "F"
	SZA CLA				/SKIP IF IT MATCHES
	JMP	MATAGN			/JUMP IF NOT
	JMS	GETNSPC			/GET NEXT CHARACTER
	TAD	(-"I!300)		/COMPARE TO "I"
	SZA CLA				/SKIP IF IT MATCHES
	JMP	MATAGN			/JUMP IF NOT
	JMS	GETNSPC			/GET NEXT CHARACTER
	TAD	(-"L!300)		/COMPARE TO "L"
	SZA CLA				/SKIP IF IT MATCHES
	JMP	MATAGN			/JUMP IF NOT
	JMS	GETNSPC			/GET NEXT CHARACTER
	TAD	(-"E!300)		/COMPARE TO "E"
	SZA CLA				/SKIP IF IT MATCHES
	JMP	MATAGN			/JUMP IF NOT
	JMP I	SCNFILE			/RETURN

CLRNAME,.-.				/NAME FIELD CLEARING ROUTINE
	TAD	CHRCNT			/GET CHARACTER COUNTER
	SNA CLA				/SKIP IF ANY TO CLEAR
	JMP I	CLRNAME			/ELSE JUST RETURN
	DCA I	XR1			/CLEAR A NAME WORD
	ISZ	CHRCNT			/COUNT IT
	JMP	.-2			/KEEP GOING
	JMP I	CLRNAME			/RETURN

GETNSPC,.-.				/GET NON-<SPACE> CHARACTER
GETNAGN,JMS	GETCHAR			/GET A CHARACTER
	TAD	(-" !200)		/COMPARE TO <SPACE>
	SNA CLA				/SKIP IF OTHER
	JMP	GETNAGN			/JUMP IF IT MATCHES
	TAD	PUTEMP			/GET THE CHARACTER BACK
	JMP I	GETNSPC			/RETURN

GETCHAR,.-.				/GET A CHARACTER ROUTINE
	CLA				/CLEAN UP
	TAD	INITFLAG		/GET INITIALIZE FLAG
	JMS I	[GETBYTE]		/GET A CHARACTER
	JMP I	(NIOERROR)		/COMPLAIN IF AN ERROR
	JMP I	[CHARERROR]		/COMPLAIN IF <EOF> REACHED
	TAD	[-140]			/COMPARE TO LOWER-CASE LIMIT
	SPA				/SKIP IF LOWER-CASE
	TAD	[40]			/RESTORE ORIGINAL IF UPPER-CASE
	AND	(77)			/JUST SIX-BIT
	DCA	PUTEMP			/SAVE IN CASE WE NEED IT
	DCA	INITFLAG		/CLEAR INITIALIZE FLAG
	TAD	PUTEMP			/GET IT BACK
	JMP I	GETCHAR			/RETURN
GETAN,	.-.				/GET ALPHANUMERIC ROUTINE
	JMS	GETNSPC			/GET A NON-<SPACE> CHARACTER
	TAD	(-".!200)		/COMPARE TO "."
	SNA				/SKIP IF OTHER
	JMP I	GETAN			/TAKE FIRST RETURN IF IT MATCHES
	TAD	(-")+".)		/COMPARE TO ")"
	SNA				/SKIP IF OTHER
	JMP I	(GOTRPAREN)		/TAKE DEDICATED RETURN IF IT MATCHES
	TAD	(-":+"))		/SUBTRACT UPPER LIMIT
	CLL				/CLEAR LINK FOR TEST
	TAD	(":-"0)			/ADD ON RANGE
	SZL CLA				/SKIP IF NOT NUMERIC
	JMP	GETANOK			/JUMP IF NUMERIC
	TAD	PUTEMP			/GET THE CHARACTER BACK
	TAD	(-"[!300)		/SUBTRACT UPPER LIMIT
	CLL				/CLEAR LINK FOR TEST
	TAD	("[-"A)			/ADD ON RANGE
	SNL CLA				/SKIP IF ALPHABETIC
	JMP I	[CHARERROR]		/ELSE COMPLAIN
GETANOK,TAD	PUTEMP			/GET GOOD ALPHANUMERIC CHARACTER
	ISZ	GETAN			/BUMP TO SKIP RETURN
	JMP I	GETAN			/RETURN

ONAME,	ZBLOCK	10			/OUTPUT NAME FIELD

FENTER, .-.                     	/FILE ENTER ROUTINE
	TAD	(FNAME)			/POINT TO
	DCA	ENTAR1			/STORED FILENAME
	DCA	ENTAR2			/CLEAR SECOND ARGUMENT
	TAD	ODNUMBER		/GET OUTPUT DEVICE NUMBER
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	[USR]			/CALL USR ROUTINE
	ENTER				/ENTER TENTATIVE FILENAME
ENTAR1,	.-.				/WILL POINT TO FILENAME
ENTAR2,	.-.				/WILL BE ZERO
	JMP I	(ENTERR)		/ENTER ERROR
	TAD	ENTAR2			/GET RETURNED EMPTY LENGTH
	IAC				/ADD 2-1 FOR OS/278 CRAZINESS
	DCA	DANGCNT			/STORE AS DANGER COUNT
	TAD	ENTAR1			/GET RETURNED FIRST RECORD
	DCA	OUTRECORD		/SETUP OUTPUT RECORD
        JMP I   FENTER          	/RETURN
	PAGE

	$				/THAT'S ALL FOLK!
