Google
 

Trailing-Edge - PDP-10 Archives - scratch - 10,7/unscsp/factpr/factpr.mac
There are 6 other files named factpr.mac in the archive. Click here to see a list.
	SUBTTL	R CLEMENTS/RCC/CMF/PFC		%2(42) 12-MAR-79



;COPYRIGHT (C) 1974,1978,1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

VWHO==0
VFACTP==2
VMINOR==1
VEDIT==43

;+
;.AUTOPARAGRAPH.FLAG INDEX.FLAG CAPITAL.LC
;.TITLE ^PROGRAM ^LOGIC ^MANUAL FOR ^^FACTPR\\
;.SKIP 5;.CENTER;^^FACTPR\\
;.SKIP 1;.CENTER;^PROGRAM ^LOGIC ^MANUAL
;.SKIP 1;.CENTER;^VERSION 2
;.SKIP 5;^^
;***COPYRIGHT 1971, 1972, 1973, 1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
;.SKIP 5;.CENTER;ABSTRACT\\
;.SKIP 1

;<FACTPR IS A PROGRAM WHICH READS THE BINARY <FACT FILES
;WRITTEN BY <DAEMON, <LOGIN, <LOGOUT, ETC., AND WRITES AN
;<ASCII FILE WHICH CAN BE READ BY ANY <COBOL PROGRAM.  ^THERE
;IS A SAMPLE BILLING PROGRAM, <BILLER.CBL, WHICH READS THIS
;FILE AND GENERATES A SIMPLE SET OF BILLS.  ^THIS
;PROGRAM CAN BE USED ITSELF, OR COULD FORM THE PROTOTYPE OF
;A MORE COMPLEX BILLING SYSTEM.
;.PAGE.LEFT MARGIN 5.RIGHT MARGIN 55
;.SKIP 3
;^THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;BY ^DIGITAL ^EQUIPMENT ^CORPORATION.
;.SKIP 3
;^DIGITAL ^EQUIPMENT ^CORPORATION ASSUMES NO
;RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
;^DIGITAL ^EQUIPMENT ^CORPORATION.
;.SKIP 3
;^THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE
;FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
;INCLUSION OF ^DIGITAL ^EQUIPMENT ^CORPORATION'S
;COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY
;OTHERWISE BE PROVIDED FOR IN WRITING BY ^DIGITAL ^EQUIPMENT
;^CORPORATION.
;.LEFT MARGIN 0;.RIGHT MARGIN 60

;.PAGE;.SUBTITLE ^TABLE OF ^CONTENTS
;.CENTER;^TABLE OF ^CONTENTS
;.NOFILL.NOAUTOPARA.TAB STOPS 5,8.SKIP 2

;1.	^GENERAL ^INFORMATION
;2.	^REVISION ^HISTORY
;3.	^DEFINITIONS
;		^A^CS, <FLAG\S, <CHANNEL\S, ETC.
;		<FACT FILE FORMAT
;4.	^INITIALIZATION AND ^MAIN ^LOOP
;5.	^PROCESS ONE ^FILE
;6.	^CONVERT ONE ^ENTRY
;7.	^INPUT ^ROUTINES
;8.	^OUTPUT ^FORMATTING
;9.	^STORAGE

;.FILL.AUTOPARA
;.PAGE;.SUBTITLE ^GENERAL ^INFORMATION
;.CENTER;^GENERAL ^INFORMATION
;
;
;^ASSEMBLY ^INSTRUCTIONS:^^
;
;	.LOAD C.UNIVERSAL,FACTPR,SCAN/LIB
;
;-\\	^THEN <SSAVE ON <SYS:.


	SEARCH	C
	SALL

	TWOSEG


	LOC	137
	BYTE	(3)VWHO(9)VFACTP(6)VMINOR(18)VEDIT
	RELOC	400000
	SUBTTL	REVISION HISTORY

;+
;.PAGE;.SUBTITLE ^REVISION ^HISTORY
;.CENTER;^REVISION ^HISTORY
;.LM5.TS5.P-5.AUTOTAB;^^

;%1(3) FEB, 1972

;4	REMOVE WARNING STRINGS
;5	HANDLE UNIVERSAL DATE FORMAT FOR DATE75 PROJECT
;6	USE C.MAC
;7	IGNORE CCL START
;10	REMOVE UNUSED SYMVOLS
;11	OUTPUT TO DSK:, NOT LST:
;12	OUTPUT ERRORS TO TTY ALSO
;13	STANDARDIZE ERROR MESSAGES
;14	REPLACE ERROR EXITS WITH MESSAGES
;15	SPEED UP LINE HANDLING
;	AND SUPPRESS TRAILING SPACES
;16	HANDLE OVERFLOW ITEMS BY SETTING TO MAX VALUE
;17	ADD ITEMS 120, 260
;20	CHANGE CHANNEL AND AC NAMES TO BE MNEMONIC
;	CHANGE AC ASSIGNMENTS TO BE CONVENTIONAL
;21	ADD RECOGNITION OF CODE 231 FOR SPRINT 25JAN74 CMF
;22	FIX SO BRANCH TO DATIM FOR OLD/NEW DATE TIME TEST
;23	PASS OVER, BUT NOTICE, UNKNOWN ENTRY TYPES
;24	FIX CODE AT FILELP TO REJECT .SYS, ACCEPT .X??
;25	REMOVE CHECK THAT AVOIDS ODD/EVEN TEST FOR CUSTOMER CODES
;26	OUTPUT SIXBIT FACTPR.SEQ WHEN FT$SIX=1
;27	MORE CHECKS ON UNKNOWN ENTRIES
;30	READ *.FCT, RATHER THAN FACT.* IF FT$FCT=1
;31	ADD FT$CS2 FOR STANDARD CS2 OPTIONS
;32	TWO NEW TABLES FOR CUSTOMER DEFINED CODES
;33	CS2 OLD TYPE 100 LOGIN -- REMOVABLE IN TIME
;34	CORRECT CONVERSION OF SPOOLER RUNTINE - TICKS, NOT MILLISECS
;35	PROVIDE EXTRA WORD FOR END MARKER IN CASE OUTPUT LINE IS FULL
;	FIX VERPRT SPECIFICATION TO FIT IN LINE
;36	ADD OUTPUT OF FULL 502 ENTRY AND FACTPR VERSION IN CODE 000 ENTRY
;37	FIX 500 CODE COST CENTER, PRODUCT LINE OUTPUT
;40	USE C AS UNIVERSAL; STANDARDIZE FT NAMES
;	DEFAULT FT$SIX UNDER FT$CS2; DEFAULT MAXENT TO ^D25
;41	MAKE SPOOLER UNITS ONLY 27 BITS WIDE
;42	MAKE TWOSEG REENTRANT PROGRAM
;43	ADD SUPPORT FOR MOUNT ENTRY
	SUBTTL	DEFINITIONS

;.LM0.AUTOPAR;\\
;.PAGE;.SUBTITLE ^DEFINITIONS
;.CENTER;^DEFINITIONS^^

;+.CENTER

;ASSEMBLY SWITCHES

;
;<FT$CS2	ASSEMBLE FOR CS/2
;
;<FT$FCT	PROCESS *.FCT, NOT FACT.*
;
;<FT$SIX	PRODUCE SIXBIT OUTPUT, NOT ASCII
;-

IFNDEF FT$CS2, <FT$CS2==0>	;[31]
IFN    FT$CS2, <FT$FCT==1
		FT$SIX==1
		C$OWN==1B0	;[32] USED WITH CUSTOMER TABLE ENTRIES
		>
IFNDEF FT$FCT, <FT$FCT==0>	;[30]
IFNDEF FT$SIX, <FT$SIX==0>	;[26]
IFE FT$SIX , <TITLE	FACTPR - PREPROCESSOR FOR FACT FILES (ASCII)>
IFN FT$SIX , <TITLE  FACTSX - PREPROCESSOR FOR FACT FILES (SIXBIT)>
;+.CENTER

;ACCUMULATOR DEFINITIONS

;.END SELECT;.TAB STOPS 9,17,25,33

F=0	;FOR FLAGS

T1=1
T2=2
T3=3
T4=4

P1=5
P2=6
P3=7

BP=11	;OUTPUT BYTE POINTER
M=12	;FOR MESSAGES
N=13	;FOR NUMBERS
N1=N+1
R=15	;RADIX PRINT RADIX
CH=16	;OUTPUT CHARS

P=17	;PUSHDOWN STACK

					;&
;+.CENTER

;FLAGS IN LH OF F

;.END SELECT

L.TTY==(1B0)	;OUTPUT TO TTY: ALSO
L.NDTF==(1B1)	;NEW DATE-TIME FORMAT (ODD ENTRY)
L.LY==(1B2)	;LEAP YEAR
L.TEMP==(1B3)	;SEND DATA TO TEMP LINE

					;&
;+.CENTER

;DEVICE CHANNELS

;.END SELECT

SYS==1	;FILE DIRECTORY
FCT==2	;READ FACT FILE
ASC==3	;WRITE ASCII FILE
IFN FT$SIX,<
SIX==4	;[26] WRITE SIXBIT FILE
>

					;&

;+.CENTER

;MISC PARAMETERS

;.END SELECT

MINENT==3		;[27] LEGAL ENTRY MUST BE AT LEAST 3 WORDS
ND MAXENT,^D25		;[27] MAXIMUM NUMBER OF WORDS IN A FACT ENTRY
PDLL==40		;STACK LENGTH
LINLEN==^D120		;LENGTH OF OUTPUT PRINT LINE

					;&
;+.CENTER

;MACROS

;ERREX$ IDENT,TEXT	ISSUES ERROR "IDENT" WITH MESSAGE "TEXT"
;			AND EXIT THE TASK

	DEFINE	ERREX$	(ID$,TEXT$),<
E$$'ID$:	JRST	[OUTSTR	[ASCIZ \?FCR'ID$ TEXT$\]
			 JRST	ERR$XT]
>

;ERROR$	IDENT,TEXT	ISSUES AN ERROR MESSAGE AND PROCEEDS

	DEFINE	ERROR$(ID$,TEXT$),<
E$$'ID$:	OUTSTR	[ASCIZ \?FCR'ID$ TEXT$
\]
>

;WARN$	IDENT,TEXT	ISSUES A WARNING MESSAGE AND PROCEEDS

	DEFINE	WARN$(ID$,TEXT$),<
E$$'ID$:	OUTSTR	[ASCIZ \%FCR'ID$ TEXT$
\]
>

;MAX	AC,MAXIMUM	IF C(AC).GE.MAXIMUM, C(AC)=MAXIMUM-1

	DEFINE	MAX	(AC$,MAX$),<
	SKIPL	AC$
	CAXL	AC$,<MAX$>
	MOVX	AC$,<MAX$>-1
>

;-
	SUBTTL	FACT FILE DEFINITIONS

;+.PAGE;.SUBTTL ^FACT ^FILE ^DEFINITIONS
;-.CENTER;^FACT ^FILE ^DEFINITIONS

;THE FOLLOWING ARE THE DEFINITIONS AND CONVENTIONS
; OF THE FACT ENTRY TYPE CODES AND DATA.
;
;CODES 400-776 ARE RESERVED FOR CUSTOMERS, 1-377 ARE FOR DEC.
;CODE 777 IS THE EOF CODE.
;ENTRY CODES GO IN BITS 0-8 OF WORD 0 OF FACT ENTRY.

;FOR DEC'S ENTRIES, AN EVEN NUMBERED ENTRY HAS OLD FORMAT (12-24)
; DATE AND TIME WORD, AND TIME INFO MAY BE JIFSEC-DEPENDENT.
;FOR AN ODD-NUMBERED ENTRY, THE DATE AND TIME IS NEW (18-18) FORMAT,
; AND JIFSEC-DEPENDENCY IS ILLEGAL. THE CODES OTHERWISE MEAN THE
; SAME AS THE CORRESPONDING EVEN NUMBERED CODE (I.E., CODE-1).

;ARGUMENTS TO THE M.M MACRO ARE:
;	1 - THREE-LETTER ABBREVIATION FOR ENTRY TYPE
;	2 - CODE VALUE (OCTAL)
;	3 - UP TO SIX CHARACTERS, SIXBIT, FOR LISTING LABEL

;WORD 0 OF ALL FACT ENTRIES HAS THE FOLLOWING REQUIRED FORMAT:
;	BITS 0-8 ARE THE FACT TYPE CODE
;	BITS 9-17 ARE THE JOB NUMBER. THIS SHOULD NEVER BE ZERO. PLUG
;		IN THE REPORTING CUSP'S JOB IF NOTHING ELSE IS
;		APPROPRIATE, SO BILLING CAN BE INDIRECTED.
;	BITS 18-23 ARE THE TTY LINE NUMBER (BINARY 0-1023. OR
;		TWO SIXBIT CHARACTERS (OLD)). SAME COMMENT
;		AS FOR JOB NUMBER. -1 MEANS THE CTY. -2 MEANS DETACHED
;	BITS 30-35 ARE THE LENGTH OF THIS ENTRY
;
;WORD 1 IS THE (REQUIRED) PPN, IN THE DEC STANDARD
; FORMAT. THOSE INSTALLATIONS WHICH HAVE MODIFIED THE PPN SYSTEM
; ARE ON THEIR OWN, BUT THE 36 BIT VALUE IN JBTPPN  SHOULD
; APPEAR IN THIS WORD.
;
;WORD 2 IS THE DATE AND TIME WORD. DAEMON WILL FILL THIS IN FOR YOU
; IF YOU MAKE THE ENTRY VIA DAEMON UUO, FACT SUBFUNCTION, AND YOU
; SUPPLY A ZERO IN THIS WORD.
;
;THE REMAINDER OF THE ENTRIES ARE DESCRIBED ON THE NEXT FEW PAGES.
;THIS IS THE DEFINING MACRO OF ALL KNOWN FACT ENTRY TYPES.
;
;ORDER IS NOT SIGNIFICANT.
;
DEFINE M.FE <
;HEADER FOR A CKPNT ENTRY
M.M(CHK,200,CHK)
M.M(LGN,100,LOGIN)	;[33] HEADER FOR CS2 TYPE LOGIN
;HEADER FOR A LOGIN ENTRY
M.M(LGI,100,ON)
;HEADER FOR A LOGIN FAILURE
M.M(LGF,120,REFUSL)
;HEADER FOR A LOGOUT ENTRY
M.M(LGO,140,OFF)
;HEADER FOR SPACE'S DISK STATISTICS
M.M(SPC,160,SPACE)
;HEADER FOR SPRINT ENTRY
M.M(SPR,230,SPRINT)
;HEADER FOR AN ATTACH ENTRY
M.M(ATT,240,ATT)
;HEADER FOR SPOOLER STATISTICS
M.M(SPL,250,SPOOL)
;HEADER FOR AN MOUNT STATISTICS
M.M(MNT,270,MOUNT)		;[43]
;HEADER FOR AN ATTACH FAILURE
M.M(ATF,260,REFUSA)
;HEADER FOR SYSTEM RESTART
M.M(SRS,370,RESTRT)
;HEADER FOR SCHEDULED SHUTDOWN
M.M(SSD,372,SHUTDN)
;HEADER FOR HIATUS IN FACT FILE
M.M(HIA,377,HIATUS)
;END OF FACT-FILE CODE
M.M(EOF,777,ENDFIL)

;ALL CS2 CODES DEFINED HERE
IFN FT$CS2 ,<
;PRIVATE LOGIN CODE
M.M(CLG,500,.LOGIN)
;PRIVATE LOGIN FAILURE CODE
M.M(CGF,502,.LGFAI)
M.M(ZAP,640,ZAP)	;ENTRY FOR "ZAPPED" JOB
;MOUNT FILE STRUCTURE -RESERVED HERE
;M.M(MOU,400,MOUNT)
;DISMOUNT FILE STRUCTURE -RESERVED HERE
;M.M(DIS,440,DISMOU)
;PLEASE COMMAND DATA
M.M(PLE,520,PLEASE)
;FILE COMMAND DATA
M.M(FIL,522,FILE)
;REPMON SHORT AND LONG TERM EVENTS
M.M(STM,540,SHORT)
M.M(LTM,542,LONG)
>	;END CS2 PRIVATE CODES

>
DEFINE M.M(ABV$,VAL$,NAME$)<
FE.'ABV$==VAL$
>

	M.FE
				;ASSIGN THE FE. VALUES
;DESCRIPTIONS OF FACT ENTRIES....THIS LISTING IS THE OFFICIAL
; DEFINITION OF THESE ITEMS. (AND THUS THE "SIGN-OUT" PROCEDURE FOR
; DEC IN-HOUSE DEVELOPMENT CONSISTS OF UPDATING THIS SOURCE'S MASTER.)
;
;CODES		WORD	CONTENTS
;
;100 LGI	0-2	STANDARD
;		2	DATE/TIME, STANDARD
;
;120 LGF	0-2	STANDARD
;		3	ATTEMPTED PASSWORD
;		4	PPN OF JOB CONTROLLING PTY
;
;140 LGO	0-2	STANDARD
;		3	RUNTIME IN MILLISECONDS
;		4	KILO-CORE-TICKS, OR 
;			 FOR CODE 141, 100*KILO-CORE-SECONDS
;		5	DSK READS, IN 128 WORD BLOCKS
;		6	DSK WRITES, IN 128 WORD BLOCKS
;
;160 SPACE	0-2	STANDARD
;		3	STRUCTURE NAME IN SIXBIT
;		4	STATUS WORD FROM USER'S UFD .RBSTS
;		5	QUOTA FCFS - .RBQTF
;		6	LOGGED OUT QUOTA - .RBQTO
;		7	RESERVED QUOTA - .RBQTR
;		10	BLOCKS USED - .RBUSD
;		11	FREE ON STRUCTURE (ALL USERS) - .STTAL
;		12	SIXBIT IN, OUT, OR RECOMP - AS TYPED BY SPACE
;
;200 CHK	0-2	STANDARD
;		3	RUNTIME, IN MILLISECONDS
;		4	KILO-CORE TICKS (OR SECONDS*100) AS IN LGO
;		5	DSK READS
;		6	DSK WRITES
;		7	PROGRAM NAME CURRENTLY RUNNING (JBTPRG, SIXBIT)
;
;230 SPRINT		SEE SPOOL.
;		EXCEPT 12   BYTE(1)BATCH (8) 0 (27) CARDS
;240 ATT	0-2	STANDARD
;
;250 SPOOL	0-2	STANDARD
;		3	BYTE(12)QUE NAME SIXBIT(6)STATION NUMBER(18)SERIAL
;		4	SPOOLER RUNTIME
;		5	KILO-CORE-TICKS/SECONDS AS ABOVE
;		6	DSK READS
;		7	DSK WRTS
;		10	SPOOLED DEVICE PHYSICAL NAME IN SIXBIT
;		11	SPOOLER SEQUENCE NUMBER
;		12	(9)XXX (27)SPOOLER UNITS USED
;
;260 ATF		SAME AS 120=LGF
;
;270 MOUNT	LIKE SPOOL ENTRY
;	EXCEPT	0	JOB NO. IS UMOUNTER'S JOB NO. UNLESS THAT JOB LOGGED OFF
;		1	USER'S PPN OR OMOUNT'S IF OPERATOR COMMAND
;		3	QUE = 1ST LETTER OF CUSP (O OR U) CONCATENATED WITH
;		    1ST LETTER OF COMMAND (M OR D OR F). 'UF' IS NOT USED.
;	       10	THE DEVICE MOUNTED, DISMOUNTED OR USED IN A FILE COMMAND
;	       11	0
;	       12	F,,TIME:	F = 0 IF REQUEST FAILED; 1 IF SUCCESSFUL
;				TIME = TIME IN SECS. OMOUNT DEDICATED TO
;					THIS REQUEST
;
;377 HIATUS	HOPEFULLY OBSOLETE. A ONE-WORD NULL ENTRY CAUSED IN THE
;			PAST BY DISK LENGTH ERRORS
;
;370 RESTART		UNDEFINED, WILL CONTAIN SERIAL AND STATION AND
;			AND THE WHY-RESTART DATA
;
;372 SHUTDN		ALSO UNDEFINED SO FAR
;
;777 ENDFIL		A ONE-WORD ENTRY, CONTAINING EXACTLY THE OCTAL
;			VALUE 777000000000 AND MARKING THE END
;			OF THE FACT FILE.
;CUSTOMER DEFINED CODES DESCRIBED HERE

;THESE ARE FOR CS/2 AND CAN BE REPLACED OR CHANGED BY ANY
;CUSTOMER

;400 MOUNT	0-2	STANDARD
;		3	STRUCTURE NAME,SIXBIT
;		4	UNIT NAME

;440 DISMOUNT	0-2	STANDARD
;		3-4	AS IN MOUNT

;500 .LOGIN	0-2	STANDARD
;		3	VERSION # OF ORIGINATING CUSP
;		4	LH: 3 CHARACTER COST CENTER
;		4	RH: 1 CHAR ACTIVITY CODE, 2 DIGIT PRODUCT LINE CODE
;		5	5 DIGIT DISCRETE PROJECT NUMBER

;502 .LGFAI	0-2	STANDARD
;		3	LOGIN VERSION #
;		4	SIXBIT FAILURE CODE
;		5	FAILURE DATA, FREE JOBS, CLASS N, ETC.
;			PRINT AS OCTAL UNTIL FULLY DEFINED


;520 PLEASE	0-2	STANDARD
;		3	TIME OF PLEASE REQUEST IN MILLISECS.
;		4	TIME OPERATER ANSWERED REQUEST IN MILLESECS 
;		5	TIME OF COMPLETION IN MILLISECS SINCE MIDNIGHT

;522 FILE	0-2	STANDARD
;		3-5	AS IN PLEASE

;540 SHORT	0-2	STANDARD
;		3	NUMBER GOOD EVENTS DURING INTERVAL
;		4	NUMBER BAD EVENTS DURING INTERVAL

;542 LONG	0-2	STANDARD
;		3-4	AS IN SHORT

;641 ZAP	0-2	STANDARD

;(OLD FOR HISTORICAL REASONS ONLY. NOT THE RIGHT WAY)
;100 LOGIN	0-2	STANDARD [33] CS2 OVERRIDE UNTIL 500 IMPLEMENTED
;		3	LH: ACTIVITY CODE, PRODUCT LINE IN SIXBIT
;		3	RH: COST CENTER IN SIXBIT
;		4	DISCRETE PROJECT, LEFT JUSTIFIED SIXBIT [33]
	SUBTTL	INITIALIZE

;STARTS HERE

FACTPR:	JFCL			;IGNORE CCL START
	RESET
	MOVE	P,PDP
	MOVEI	F,0

	INIT	SYS,14
	SIXBIT	/DSK/
	XWD	0,SYSB
	ERREX$	COD,Can't OPEN Directory
	INIT	FCT,14
	SIXBIT	/DSK/
	XWD	0,FCTB
	ERREX$	COI,Can't OPEN Input
	INIT	ASC,0
	SIXBIT	/DSK/
	XWD	ASCB,0
	ERREX$	COO,Can't OPEN Output
IFN FT$SIX,<
	INIT	SIX,14	;[26] OPEN SIXBIT FILE
	SIXBIT	/DSK/		;[26]
	XWD	SIXB,0		;[26]
	ERREX$	COS,CAN'T OPEN SIXBIT OUTPUT
>
	MOVX	T1,%LDMFD
	GETTAB	T1,
	  MOVE	T1,[1,,1]
	MOVEM	T1,MFDPPN
	MOVSI T1,'SYS'
	DEVPPN	T1,
	  MOVE	T1,MFDPPN
	MOVEM T1,SYSPP
	INBUF	SYS,0
	INBUF	FCT,0
	OUTBUF	ASC,0
IFN FT$SIX,<
	OUTBUF	SIX,0		;[26]
	MOVE	T1,['FACTPR']
	MOVSI	T2,'SEQ'
	SETZB	T3,T4
	ENTER	SIX,T1		;[26] ENTER FACTPR.SEQ
	  ERREX$ CES,CAN'T ENTER SIXBIT OUTPUT
	MOVSI	T2,'ERR'	;USE ASCII FILE FOR ERRORS
>
IFE FT$SIX, <
	MOVSI	T2,'TXT'
>
	MOVE	T1,['FACTPR']
	SETZB	T3,T4
	ENTER	ASC,T1
	  ERREX$ CEO,Can't ENTER Output
	MOVX	T1,%CNSTS
	GETTAB	T1,
	  MOVEI	T1,0	;ERROR RETURN
	MOVEI	T2,^D60
	TXNE	T1,ST%CYC
	MOVEI	T2,^D50
	MOVEM	T2,JIFSEC
	MOVE	T1,[SIXBIT /FACT/]
	MOVEM	T1,FILE		;[30] SET DEFAULT FILE NAME
	MOVSI	T2,'SYS'	;FIRST DUMP FACT.SYS
	MOVEM	T2,EXTEN
IFE FT$FCT, <	;DON'T LOOK FOR FACT.SYS IF FT$FCT
	PUSHJ	P,DUMP
>
	MOVE	T1,SYSPP
	MOVSI	T2,'UFD'	;NOW GET ANY OTHER FACT.XXX
	MOVEI	T3,0
	MOVE	T4,MFDPPN		;LOOK IN MFD
	LOOKUP	SYS,T1
	  ERREX$ CLD,Can't LOOKUP Directory
	SETOM	LASTV		;[31] SET SO WILL PRINT FIRST VERSION
	SETZM	UNKNOWN		;CLEAR COUNT (AND FLAG) OF UNKNOWN ENTRIES

FILELP:	PUSHJ	P,SYSRD
	  JFCL
	MOVE	P1,T1
	MOVEM	P1,FILE		;[30] SET FILE NAME
	PUSHJ	P,SYSRD
	  JRST	EOJ		;END OF THE JOB
	HLRZ	T2,T1
IFN FT$FCT, <
	CAIE	T2,'FCT'	;[30] ALL .FCT ARE PROCESSED
>
IFE FT$FCT, <
	CAIE	T2,'SYS'
	CAME	P1,[SIXBIT /FACT/]
>
	JRST	FILELP
	HRLZM	T2,EXTEN
	PUSHJ	P,DUMP		;FOUND ONE. GO DUMP IT
	JRST	FILELP		;SEARCH FOR MORE

EOJ:	CLOSE	ASC,		;CLOSE OUTPUT
	RELEAS	ASC,		;RELEASE IT
IFN FT$SIX,<
	CLOSE	SIX,0		;[26]
	RELEASE SIX,0		;[26]
>
	SKIPE	UNKNOW		;TELL USER IF UNKNOWNS ENCOUNTERED
	WARN$	(UNK,Unknown codes seen)
	EXIT			;MAYBE THIS SHOULD DO SOME MORE?
	SUBTTL	LOOP OVER ENTRIES IN A FILE

;+
;.PAGE;.SUBTITLE ^LOOP ^OVER ^ENTRIES IN A ^FILE
;.CENTER;^LOOP ^OVER ^ENTRIES IN A ^FILE
;-

DUMP:	PUSHJ	P,.SAVE3##	;SAVE SOME ACS
	OUTSTR	[ASCIZ \Processing file \]
	MOVE	T1,FILE
	PUSHJ	P,TYPSIX
	OUTSTR	[ASCIZ \.\]
	HLLZ	T1,EXTEN
	PUSHJ	P,TYPSIX
	OUTSTR	CRLFM

	MOVE	T1,FILE		;[30]LOOKUP THE FILE
	HLLZ	T2,EXTEN
	MOVEI	T3,0
	MOVE	T4,SYSPP
	LOOKUP	FCT,T1
	  JRST	DUMPX1
	ANDX	T3,RB.CRD!RB.CRT
	ROT	T3,-^D12
	ANDX	T2,RB.CRX
	LSH	T2,-^D15
	LSHC	T2,^D12
	LSH	T3,^D13
	LSHC	T2,^D11
	MOVEM	T2,FILDAT

	DATE	T1,
	MOVEM	T1,RUNDAT
	MSTIME	T1,
	MOVEM	T1,RUNTIM
	MOVX	T1,%CNSER
	GETTAB	T1,
	  MOVEI	T1,0
	MOVEM	T1,APRSNL

	PUSHJ	P,STRTLN
	MOVEI	P2,42
	PUSHJ	P,CNVITM	;"000   "
	PUSHJ	P,CNVITN	;EXTENSION
	PUSHJ	P,CNVITN	;PROJECT
	PUSHJ	P,CNVITN	;PROGRAMMER
	PUSHJ	P,CNVITN	;DATE OF FILE
	PUSHJ	P,CNVITN	;TIME OF FILE
	PUSHJ	P,CNVITN	;APR SERIAL NUMBER
	PUSHJ	P,CNVITN	;DATE OF RUN
	PUSHJ	P,CNVITN	;TIME OF RUN
	PUSHJ	P,CNVITN	;FILE NAME
	PUSHJ	P,CNVITN	;[36] FACTPR VERSION #
	JRST	DMPEOL		;GO END LINE
NXTENT:	SETZM	ENTRY		;CLEAR DATA TABLE FOR THE ENTRY
	MOVE	T1,[XWD ENTRY,ENTRY+1]
	BLT	T1,ENTRY+MAXENT-1
	MOVE	T1,[POINT 36,LINE-1,35]
	MOVEM	T1,LINEBP
	PUSHJ	P,FCTRD		;READ HEADER OF ENTRY
	  JRST	E$$NEM		;GO HANDLE EOF FROM FILE
	MOVEM	T1,ENTRY
	JUMPE	T1,NXTENT	;[27] BYPASS ZERO WORDS
	LDB	T1,FET1+CODEP
	CAIN	T1,FE.EOF	;[27]
	JRST	BADENT		;[27] POSSIBLE END-OF-FILE
	TLZ	F,L.NDTF
	CAIN	T1,FE.HIA
	JRST	CUSTEN		;SKIP ODD/EVEN TEST IF HIATUS
IFE	FT$CS2, <
	CAIL	T1,400		;[25]
	JRST	CUSTEN		;[25] CUSTOMER ENTRY
>	;END FT$CS2
	TRZE	T1,1		;SEE IF ODD
	TLO	F,L.NDTF	;YES--NEW DATE FORMAT
CUSTEN:	MOVSI	T2,-FETABL		;SEARCH FOR THIS TYPE CODE
DMP5L:	HLRZ	T3,FETAB(T2)		;GET A CODE
	CAMN	T1,T3		;MATCH?
	JRST	DMP5F		;YES
	AOBJN	T2,DMP5L		;NO. LOOP THRU TABLE
	MOVEM	T1,LASTUN		;[23] SAVE UNKNOWN CODE
	AOS	UNKNOW		;COUNT UNKNOWNS
	JUMPE	T1,BADENT	;[27] CODE 0 IS UNDEFINED
	HRRZI	P3,1(T2)	;[36] GET INDEX TO UNKNOWN ENTRY
	SKIPA
DMP5F:	HRRZ	P3,FETAB(T2)		;GET THE INDEX
	LDB	P1,FET1+SIZEP
	CAIG	P1,MAXENT
	CAIGE	P1,MINENT	;[C27]
	JRST	BADENT		;[27] BAD FORM IF SIZE .L. 3 OR .GE. MAXENT
	MOVNS	P1
	HRLZ	P1,P1
	JRST	DUMP03
DUMP02:	PUSHJ	P,FCTRD		;READ DATA FOR THIS ENTRY
	  JRST	E$$NEM		;GO HANDLE EOF FROM FILE
	MOVEM	T1,ENTRY(P1)
DUMP03:	AOBJN	P1,DUMP02
	PUSHJ P,CNVENT		;CONVERT A FACT ENTRY
DMPEOL:	PUSHJ	P,ENDLIN
IFE FT$SIX ,<
	MOVSI	BP,-LINLEN
DMP4L:	SKIPN	CH,LINE(BP)
	JRST	DUMP04
	PUSHJ	P,ASCWR		;NO. LIST IT.
	AOBJN	BP,DMP4L	;LOOP THRU END OF LINE
DUMP04:	SKIPE	HGHCHR		;SEE IF SOMETHING
	PUSHJ	P,CRLF		;YES--END OF LINE
	JRST	NXTENT		;NOW GO ON FOR MORE FACT ENTRIES
>	;END FT$SIX

IFN FT$SIX, <
	MOVSI	BP,-LINLEN
	SKIPN	CH,LINE(BP)
	JRST	NXTENT		;NOTHING TO PROCESS
	HRRZ	T1,HGHCHR
	SUBI	T1,LINE-1
	HRRZ	P1,T1	;SAVE # OF CHARACTERS IN RECORD
	PUSHJ	P,OUTSIX	;WRITE HEADER
	SKIPA			;FALL IN
DMP4L:	TLNN	T1,770000	;WORD FULL?
	MOVE	T1,[POINT 6,P1]	;YES, RESET POINTER
	SKIPN	CH,LINE(BP)
	JRST	FINSIX		;0 MARKS END OF DATA
	SUBI	CH,40		;CONVERT TO SIXBIT
	IDPB	CH,T1
	TLNN	T1,770000	;BUFFER WORD FULL?
	PUSHJ	P,OUTSIX	;YES, SEND IT
	AOBJN	BP,DMP4L
	JRST	NXTENT

FINSIX:	IDPB	CH,T1
	TLNE	T1,770000
	JRST	FINSIX		;LOOP 'TIL WORD FILLED
	PUSHJ	P,OUTSIX
	JRST	NXTENT
>	;END FT$SIX
BADENT:	MOVE	N,ENTRY
	CAMN	N,[XWD 777000,0]
	JRST	ENDDMP
	TLO	F,L.TTY
E$$BFW:
IFE FT$CS2, <
	MOVEI	M,[ASCIZ /%FCRBFW Bad fact word: /]
>
IFN FT$CS2 , <
	MOVEI	M,[ASCIZ /000%FCRBFW BAD FACT WORD: /]
>
	PUSHJ	P,MSG
	MOVE	T1,ENTRY
	PUSHJ	P,OCTPRT
	PUSHJ	P,CRLF
	JRST	NXTENT


	WARN$	(NEM,No EOF marker in file)
	POPJ	P,		;RETURN

ENDDMP:	PUSHJ	P,FCTRD		;READ REST OF FILE
	  POPJ	P,0		;EXIT FROM DUMP
	JUMPE	T1,ENDDMP	;OK IF JUST ZEROS
	WARN$	(JAE,Junk after end marker)
	POPJ	P,		;RETURN
	SUBTTL	CONVERT ONE ENTRY

;+
;.PAGE;.SUBTITLE ^CONVERT ^ONE ^ENTRY
;.CENTER;^CONVERT ^ONE ^ENTRY
;-

CNVENT:	PUSHJ	P,.SAVE2##	;SAVE SOME ACS
	PUSHJ	P,STRTLN	;FIRST, START THE LINE
	MOVEI	P2,0
	PUSHJ	P,CNVITM	;CODE
	PUSHJ	P,CNVITN	;JOB NUMBER
	PUSHJ	P,CNVITN	;TTY
	PUSHJ	P,CNVITN	;LENGTH OF ENTRY
	PUSHJ	P,CNVITN	;PROJECT NUMBER
	PUSHJ	P,CNVITN	;PROGRAMMER NUMBER
	PUSHJ	P,CNVITN	;DATE-TIME
	MOVEI	P1,@XLATAB-1(P3)	;GET THE TRANSLATION LIST
CNVEL1:	SKIPGE	P2,0(P1)		;[32] STANDARD ITEM?
	JRST	CNVE8		;NO. CHECK FOR END
	PUSHJ	P,CNVITM	;YES, GO CONVERT THIS ONE
	AOJA	P1,CNVEL1	;AND LOOP TO SEE IF MORE

CNVE8:	CAMN	P2,[-1]		;[32] -1 MARKS END OF LIST
	POPJ	P,
IFN FT$CS2, <
	PUSHJ	P,C$VITM	;[32] USE CUSTOMER SUPPLIED TABLES
	AOJA	P1,CNVEL1	;[32] AND GET NEXT
>	;END FT$CS2
IFE FT$CS2, <	POPJ	P,0	>

CNVITN:	ADDI	P2,1		;GO TO NEXT ENTRY
CNVITM:	HLRZ	N,FET2(P2)	;GET CHARACTERS TO SKIP OVER
	ADD	N,[POINT 36,LINE-1,35]
	MOVEM	N,LINEBP	;FOR OUTPUT CHARACTER ROUTINE "OUCH"
	LDB	T1,FET1(P2)	;GET THE RAW DATUM FROM FACT ENTRY
	HRRZ	N,FET2(P2)	;AND THE CONVERSION ROUTINE'S ADDRESS
	PJRST	0(N)		;GO DO IT

IFN FT$CS2, <
C$VITM:	HLRZ	N,FET4(P2)	;[32] GET CHARACTERS TO SKIP OVER
	ADD	N,[POINT 36,LINE-1,35]
	MOVEM	N,LINEBP	;[32] FOR "OUCH"
	LDB	T1,FET3(P2)	;[32] GET THE RAW DATUM
	HRRZ	N,FET4(P2)	;[32] AND CONVERSION ROUTINES'S  ADDRESS
	PJRST	0(N)		;[32] GO DO IT.
>	;END FT$CS2
STRTLN:	MOVEI	CH," "		;FIRST, BLANK THE PRINT LINE
	MOVEM	CH,LINE
	MOVE	N,[LINE,,LINE+1]
	BLT	N,LINE+LINLEN-1
	SETZM	HGHCHR
	TLO	F,L.TEMP
	POPJ	P,

ENDLIN:	MOVEI	CH,0
	SKIPE	HGHCHR
	IDPB	CH,HGHCHR	;CLEAR NEXT ENTRY
	TLZ	F,L.TEMP
	POPJ	P,0		;THROUGH WITH THIS ENTRY
;THIS IS A TABLE OF BYTE POINTERS TO ITEMS IN THE FACT ENTRY BLOCK
;THE USE MADE OF THE DATA IS DETERMINED BY THE NEXT TABLE,FET2.
;THE INDEX INTO THIS TABLE IS HELD IN AC "P2" IN THE CONVERT-
; ITEM ROUTINE (CNVITM)
;
FET1:!
	PHASE	0		;[32]
CODEP:	POINT 9,ENTRY+0,8	;0 CODE
	POINT 9,ENTRY+0,17	;1 JOB NUMBER
	POINT 12,ENTRY+0,29	;2 TTY NUMBER IN SOME FORMAT
SIZEP:	POINT 6,ENTRY+0,35	;3 POINTER TO THE LENGTH IN WORDS OF ENTRY
	POINT 18,ENTRY+1,17	;4 PROJECT NUMBER
	POINT 18,ENTRY+1,35	;5 PROGRAMMER NUMBER
	POINT 36,ENTRY+2,35	;6 DATE AND TIME
	POINT 36,ENTRY+3,35	;7 RUNTIME, MILLISECONDS
	POINT 36,ENTRY+4,35	;10 RUNTIME, TICKS, SPOOLERS
	POINT 12,ENTRY+3,11	;11 QUE NAME
	POINT 6,ENTRY+3,17	;12 STATION NUMBER
	POINT 18,ENTRY+3,35	;13 APR SERIAL NUMBER
	POINT 36,ENTRY+4,35	;14 KILO CORE TICKS
	POINT 36,ENTRY+4,35	;15 KILO CORE SECONDS*100
	POINT 36,ENTRY+5,35	;16 KILO CORE TICKS
	POINT 36,ENTRY+5,35	;17 KILO CORE SECONDS*100
	POINT 36,ENTRY+5,35	;20 DISK BLOCKS READ
	POINT 36,ENTRY+6,35	;21 DISK BLOCKS READ
	POINT 36,ENTRY+6,35	;22 DISK BLOCKS WRITTEN
	POINT 36,ENTRY+7,35	;23 DISK BLOCKS WRITTEN
	POINT 36,ENTRY+7,35	;24 PROGRAM NAME
	POINT 36,ENTRY+10,35	;25 SPOOLED DEVICE NAME
	POINT 36,ENTRY+11,35	;26 SEQUENCE NUMBER
	POINT 27,ENTRY+12,35	;27 SPOOLER UNITS USED
	POINT 36,ENTRY+3,35	;30 SPACE STRUCTURE NAME
	POINT 36,ENTRY+4,35	;31 SPACE STATUS WORD FROM UFD
	POINT 36,ENTRY+5,35	;32 SPACE FCFS QUOTA
	POINT 36,ENTRY+6,35	;33 SPACE QTA OUT
	POINT 36,ENTRY+7,35	;34 SPACE QTA RSRVD
	POINT 36,ENTRY+10,35	;35 SPACE USED BLOCKS
	POINT 36,ENTRY+11,35	;36 SPACE STRUCTURE FREE
	POINT 36,ENTRY+12,35	;37 SPACE IN/OUT/RECOMP SIXBIT
BADPAS:	POINT 36,ENTRY+3,35	;40 FAILING PASSWORD
CNTPPN:	POINT 36,ENTRY+4,35	;41 CONTROLLING PPN
	POINT 18,[[ASCIZ /000/]],35	;42 FILE IDENT
	POINT 18,EXTEN,17	;43 EXTENSION
	POINT 18,SYSPP,17	;44 PROJECT
	POINT 18,SYSPP,35	;45 PROGRAMMER
	POINT 15,FILDAT,24	;46 FILE DATE
	POINT 11,FILDAT,35	;47 FILE TIME
	POINT 18,APRSNL,35	;50 APR SERIAL
	POINT 15,RUNDAT,35	;51 RUN DATE
	POINT 36,RUNTIM,35	;52 RUN TIME
	POINT 36,FILE,35	;53 FILE NAME
	POINT 36,.JBVER,35	;54 FACTPR VERSION #
	POINT 18,ENTRY+12,17	;[43] 55 MOUNT FLAGS
	POINT 18,ENTRY+12,35	;[43] 56 MOUNT TIME USED BY OPERATOR
OCT3:	POINT 36,ENTRY+3,35
OCT4:	POINT 36,ENTRY+4,35
OCT5:	POINT 36,ENTRY+5,35
OCT6:	POINT 36,ENTRY+6,35
OCT7:	POINT 36,ENTRY+7,35
FETL==.
	DEPHASE
;THIS TABLE DIRECTS THE CONVERSION OF A PARTICULAR ITEM IN
; A FACT ENTRY BLOCK. IT PARALLELS TABLE FET1
;
;LEFT HALF IS COLUMNS TO SKIP BEFORE PRINTING, I.E., COLUMN NUMBER-1
;RIGHT HALF IS THE ADDRESS OF THE CONVERSION ROUTINE.
;NOTE THAT THE CONVERSION ROUTINES KNOW HOW MANY COLUMNS THEY SHOULD USE

	RADIX 10
FET2:
	PHASE 0		;[32]
	XWD	0,OCTP3		;0 CODE
	XWD	3,DECP3		;1 JOB NUMBER
	XWD	6,TTYCNV	;2 TTY NUMBER IN SOME FORMAT
	XWD	0,CPOPJ		;3 LENGTH
	XWD	9,OCTP6		;4 PROJECT NUMBER
	XWD	15,OCTP6	;5 PROGRAMMER NUMBER
	XWD	21,DATIM	;6 DATE AND TIME
	XWD	42,MST7		;7 RUNTIME, MILLISECONDS
	XWD	42,TICK7	;10 [34] RUNTIME, TICKS, SPOOLERS
	XWD	99,SIXBP2	;11 QUE NAME
	XWD	40,DECP2	;12 STATION NUMBER
	XWD	34,DECP6	;13 APR SERIAL NUMBER
	XWD	49,KCT11	;14 KILO CORE TICKS
	XWD	49,KCS11	;15 KILO CORE SECONDS
	XWD	49,KCT11	;16 KILO CORE TICKS
	XWD	49,KCS11	;17 KILO CORE SECONDS*100
	XWD	60,DECM8	;20 DISK BLOCKS READ
	XWD	60,DECM8	;21 DISK BLOCKS READ
	XWD	68,DECM8	;22 DISK BLOCKS WRITTEN
	XWD	68,DECM8	;23 DISK BLOCKS WRITTEN
	XWD	76,SIXBP6	;24 PROGRAM NAME
	XWD	76,SIXBP6	;25 SPOOLED DEVICE NAME
	XWD	82,DECM6	;26 SEQUENCE NUMBER
	XWD	88,DECP11	;27 SPOOLER UNITS USED
	XWD	76,SIXBP6	;30 SPACE STR NAME
	XWD	82,OCTP12	;31 SPACE UFD STATUS WORD
	XWD	34,DECP11	;32 SPACE QTA FCFS
	XWD	45,DECP11	;33 SPACE QTA OUT
	XWD	56,DECM8	;34 SPACE RSRVD
	XWD	64,DECP11	;35 SPACE BLKS USED
	XWD	94,DECP11	;36 SPACE STR FREE
	XWD	105,SIXBP6	;37 SPACE IN/OUT/RECOMP
BADPAS:	XWD	42,SIXBP6	;40 PASSWORD
CNTPPN:	XWD	54,OCTP12	;41 CONTROLLING PPN
	XWD	0,ASCIT		;42 ASCIZ STRING
	XWD	6,SIXBP3	;43 EXTENSION
	XWD	9,OCTP6		;44 PROJECT
	XWD	15,OCTP6	;45 PROGRAMMER
	XWD	21,LDATE	;46 FILE DATE
	XWD	28,HR2MIN	;47 FILE TIME
	XWD	34,DECP6	;50 APR SERIAL
	XWD	42,LDATE	;51 RUN DATE
	XWD	49,HR2MST	;52 RUN TIME
	XWD	55,SIXBP6	;53 FILE NAME
				;5 SPARE COL
	XWD	66,OCTP12	;54 VERSION #
	XWD	88,DECP4	;[43] 55 MOUNT FLAGS
	XWD	92,DECP7	;[43] 56 MOUNT TIME USED BY OPERATOR
OCT3:	XWD	42,OCTP12	;PRINT WORD 3 IN OCTAL
OCT4:	XWD	54,OCTP12
OCT5:	XWD	66,OCTP12
OCT6:	XWD	78,OCTP12
OCT7:	XWD	90,OCTP12

IFN <.-FETL>,<PRINTX	? TABLES DONT MATCH>

	DEPHASE
	RADIX 8
IFN FT$CS2, <
FET3:
	PHASE 0		;SO OUR SYMBOLS ARE RELATIVE TO 0
VERSIO:	POINT 36,ENTRY+3,35	;VERSION NUMBER WORD
COSTC:	POINT 18,ENTRY+4,17	;[37] LH HAS COST CENTER
ACODE:	POINT 18,ENTRY+4,35	;[37] RH HAS ACTIVITY CODE, PRODUCT LINE
DISPRJ:	POINT 36,ENTRY+5,35	;LOGIN DISCRETE PROJECT NUMBER
REQTIM:	POINT 36,ENTRY+3,35	;REQUEST TIME
OPRTIM:	POINT 36,ENTRY+4,35	;OPERATOR ACTION TIME
ENDTIM:	POINT 36,ENTRY+5,35	;COMPLETION TIME
FAILCD:	POINT 36,ENTRY+4,35	;SIXBIT TYPE CODE
NCLASS:	POINT 9,ENTRY+5,8	;[36]
LOGCLS:	POINT 9,ENTRY+5,17	;[36]
LOGMAX:	POINT 9,ENTRY+5,26	;[36]
FREE:	POINT 9,ENTRY+5,35	;[36]
COST:	POINT 18,ENTRY+3,35	;[33] OLD STYLE COST CENTER STORAGE
PL:	POINT 18,ENTRY+3,17	;[33] OLD STYLE PROD. LINE STORAGE
DISPJ:	POINT 36,ENTRY+4,35	;[33]
	DEPHASE
>	;END FT$CS2
IFN FT$CS2, <
;CUSTOMER CONVERSION TABLE

RADIX 10
FET4:
	PHASE 0	;SO RELATIVE TO 0
VERSIO:	XWD	107,VERPRT	;PRINT VERSION #
COSTC:	XWD	34,SIXBP3	;[37] LOGIN COST CENTER
ACODE:	XWD	37,SIXBP3	;[37] ACTIVITY CODE+PRODUCT LINE
DISPRJ:	XWD	40,SIXBP6	;LOGIN DISRETE PROJECT
REQTIM:	XWD	42,MST7		;REQUEST TIME
OPRTIM:	XWD	49,MST7		;OPR ACTION TIME
ENDTIM:	XWD	56,MST7		;OPR COMPLETION TIME
FAILCD:	XWD	42,SIXBP6	;SIXBIT LWQFAI TYPE CODE
NCLASS:	XWD	54,DECP3	;[36] PRINT LOGIN CLASS #
LOGCLS:	XWD	57,DECP3	;[36] PRINT LOGGED IN IN CLASS
LOGMAX:	XWD	60,DECP3	;[36] SYSTEM LOGMAX
FREE:	XWD	63,DECP3	;[36] FREE JOBS IN SYSTEM
COST:	XWD	34,SIXBP3	;[33]
PL:	XWD	37,SIXBP3	;[33]
DISPJ:	XWD	40,SIXBP6	;[33]
	DEPHASE
RADIX 8
>	;END FT$CS2
;ALL FACT ENTRY BLOCKS ARE ASSUMED TO HAVE ITEMS 0 THRU 4, AND EITHER
;5 OR SIX AS APPROPRIATE (CODE EVEN OR ODD RESPECTIVELY).
;THE FOLLOWING TABLES DETERMINE WHAT OTHER DATA IS TO BE CONVERTED
;AND OUTPUT FOR EACH FACT ENTRY TYPE
;

DEFINE M.M(ABV$,VAL$,NAME$)<
IFDEF T.'ABV$,<	EXP T.'ABV$>
IFNDEF T.'ABV$,<	EXP T.LGI>;	MINIMAL LISTING
>

XLATAB:	M.FE;			;TRANSLATION TABLE
UNKCOD:	T.UNK			;THIS MUST FOLLOW XLATAB
				;TREAT AS OCTAL IF UNKNOWN
T.LGI:	-1

T.LGO:	7
	14
	20
	22
	-1

T.CHK:	7
	14
	20
	22
	24
	-1

T.SPR:
T.SPL:	11
	12
	13
	10
	16
	21
	23
	25
	26
	27
	-1

T.MNT:	11
	12
	13
	10
	16
	21
	23
	25
	26
	55
	56
	-1

T.SPC:	30
	31
	32
	33
	34
	35
	36
	37
	-1

T.ATF:
T.LGF:	BADPAS	;E+3 SIXBIT FOR PASSWORD
	CNTPPN		;E+4, OCTAL FOR PPN
	-1

T.UNK:	OCT3
	OCT4
	OCT5
	OCT6
	OCT7
	-1
IFN FT$CS2 ,<
;DEFINE SPECIAL CS2 ENTRIES

T.CLG:	C$OWN!VERSIO
	C$OWN!COSTC
	C$OWN!ACODE
	C$OWN!DISPRJ
	-1

;[33] TEMPORARY CARRYOVER
T.LGN:	C$OWN!COST	;[33]
	C$OWN!PL	;[33]
	C$OWN!DISPJ	;[33]
	-1
T.CGF:	C$OWN!VERSIO
	C$OWN!FAILCD
	C$OWN!NCLASS	;[36]
	C$OWN!LOGCLS	;[36]
	C$OWN!LOGMAX	;[36]
	C$OWN!FREE	;[36]
	-1

T.PLE:
T.FIL:	C$OWN!REQTIM
	C$OWN!OPRTIM
	C$OWN!ENDTIM
	-1

;ZAP NOT NEEDED SINCE MINIMUM ONLY

;SHORT AND LONG NOT YET USED IN ACCOUNTING

>	;END FT$CS2
	SUBTTL	INPUT ROUTINE

;+
;.PAGE;.SUBTITLE ^INPUT ^ROUTINES
;.CENTER;^INPUT ^ROUTINES
;-

DUMPX1:	TLO	F,L.TTY
	TLZ	T2,-1		;CLEAR JUNK
	JUMPE	T2,E$$FNF	;IF NOT FOUND, SPECIAL MESSAGE
	ERROR$	(CLI,Can't LOOKUP input)
	POPJ	P,
	ERROR$	(FNF,File not found)
	POPJ	P,

SYSRD:	SOSLE	SYSB+2
	JRST	SYSOK
	IN	SYS,0
	  JRST	SYSOK
	POPJ	P,0
SYSOK:	ILDB	T1,SYSB+1
CPOPJ1:	AOS	0(P)
CPOPJ:	POPJ	P,0

FCTRD:	SOSLE	FCTB+2
	JRST	FCTOK
	IN	FCT,0
	  JRST	FCTOK
	POPJ P,0
FCTOK:	ILDB	T1,FCTB+1
	JRST CPOPJ1

ERR$XT:	OUTSTR	CRLFM
	RESET
	MONRT.
	EXIT
	SUBTTL	OUTPUT FORMATTING

;+
;.PAGE;.SUBTITLE ^OUTPUT ^FORMATTING
;.CENTER;^OUTPUT ^FORMATTING
;-

HR2MIN:	IMULI	T1,^D60*^D1000	;CONVERT TO MILLI-SECS
HR2MST:	IDIVI	T1,^D1000	;CONVERT TO SECS
HR2OUT:	MAX	T1,^D1000*^D3600
	IDIVI	T1,^D60*^D60
	PUSHJ	P,DECP2
	MOVE	T1,T2
	PJRST	MINOUT

TICK7:	IDIV	T1,JIFSEC	;[34] CONVERT TO SECONDS
	MOVE	T3,JIFSEC	;[34]
	LSH	T3,-1		;[34] JIFSEC/2 FOR ROUNDING
	CAIL	T2,(T3)		;[34]
	ADDI	T1,1		;[34] ROUND TO NEAREST SECOND
	PJRST	HR3OUT		;[34]

MST7:	IDIVI	T1,^D1000	;TO SECONDS
	CAIL	T2,^D500
	ADDI	T1,1		;ROUND TO NEAREST SECOND
				;AND PRINT IN SEVEN COLUMNS
HR3OUT:	MAX	T1,^D1000*^D3600
	IDIVI	T1,^D60*^D60
	PUSHJ	P,DECP3
	MOVE	T1,T2
MINOUT:	IDIVI	T1,^D60
	PUSHJ	P,DECP2
	MOVE	T1,T2
	PJRST	DECP2
KCT11:	TLNE	F,L.NDTF	;IF NEW FORMAT ENTRY,
	JRST	KCS11		; GO HANDLE IN SEC, NOT TICK FORMAT
	IDIV	T1,JIFSEC
	ASH	T2,1
	CAML	T2,JIFSEC
	ADDI	T1,1
	JRST	DECP11

KCS11:	IDIVI	T1,^D100
	CAIL	T2,^D50
	ADDI	T1,1
	JRST	DECP11

DECM8:	MAX	T1,^D100000000
	PJRST	DECP8

DECM6:	MAX	T1,^D1000000
	PJRST	DECP6
TICDAY:	IMULI	T1,^D1000
	IDIV	T1,JIFSEC
MSTOUT:	SKIPGE T1
	MOVEI T1,0		;PROTECT AGAINST NEGATIVE VALUES
	IDIV	T1,[EXP ^D60000*^D60]
	MOVE	N,T1
	PUSHJ	P,DECP2
	MOVE	T1,T2
	IDIVI	T1,^D60000
	MOVE	N,T1
	PUSHJ	P,DECP2
	MOVE	N,T2
	IDIVI	N,^D1000
	JRST	DECP2

DECP11:	CAMG	T1,[^D9999999999]
	PUSHJ P,ZEROUT
DECP10:	CAMG	T1,[^D999999999]
	PUSHJ P,ZEROUT
DECP9:	CAMG	T1,[^D99999999]
	PUSHJ P,ZEROUT
DECP8:	CAMG	T1,[^D9999999]
	PUSHJ	P,ZEROUT
DECP7:	CAMG	T1,[^D999999]
	PUSHJ	P,ZEROUT
DECP6:	CAIG	T1,^D99999
	PUSHJ	P,ZEROUT
DECP5:	CAIG	T1,^D9999
	PUSHJ	P,ZEROUT
DECP4:	CAIG	T1,^D999
	PUSHJ	P,ZEROUT
DECP3:	CAIG	T1,^D99
	PUSHJ	P,ZEROUT
DECP2:	CAIG	T1,11
	PUSHJ	P,ZEROUT
DECPRT:	SKIPA	R,[12]
OCTPRT:	MOVEI	R,10
	MOVEI	CH,"-"
	SKIPGE	T1
	PUSHJ	P,OUCH
	MOVE	N,T1
RDXPRT:	IDIVI	N,(R)
	MOVMS	N1
	HRLM	N1,0(P)
	SKIPE	N
	PUSHJ	P,RDXPRT
	HLRZ	CH,0(P)
	ADDI	CH,"0"
	PJRST	OUCH
TTYCNV:	TRNE	T1,4000		;EXTEND BIT 24 INTO SIGN
	ORCMI	T1,7777		; ..
	JUMPGE	T1,TTYCN1	;IF PLUS, TREAT AS OCTAL NUMBER
	MOVEI	T2,'DET'
	TRNE	T1,1		;CTY OR DET?
	MOVEI	T2,'CTY'
	HRRZ	T1,T2
	JRST	SIXBP3

TTYCN1:	CAIGE	T1,2000		;OLD SIXBIT HACK?
	JRST	OCTP3		;NO. ASSUME OCTAL NUMBER
TTYCN3:	TRNN	T1,77		;YES. MAKE IT 3 DIGITS
	LSH	T1,-6

TTYCN2:	TRO	T1,'000'		;MAKE SIXBIT
	JRST	SIXBP3		;AND PRINT IT

SIXBP5:	SKIPA	BP,[360600,,T1]
SIXBP4:	MOVE	BP,[300600,,T1]
	JRST	SIXBPL
SIXBP3:	SKIPA	BP,[220600,,T1]
SIXBP2:	MOVE	BP,[140600,,T1]
	JRST	SIXBPL
SIXBP6:	MOVE	BP,[XWD	440600,T1]
SIXBPL:	ILDB	CH,BP
	ADDI	CH," "
	PUSHJ	P,OUCH
	TLNE	BP,770000
	JRST	SIXBPL
	POPJ	P,0

TYPSIX:	MOVE	T2,T1		;POSITION INPUT
TYPSX1:	MOVEI	T1,0		;CLEAR RESULT
	LSHC	T1,6		;GET NEXT CHAR
	ADDI	T1," "		;CONVERT TO SIXBIT
	OUTCHR	T1		;OUTPUT IT
	JUMPN	T2,TYPSX1	;LOOP
	POPJ	P,		;RETURN
DATIM:	TLNN	F,L.NDTF	;SEE IF NEW OR OLD
	JRST	ODATIM		;OLD FORMAT
	PUSHJ	P,.CNTDT##	;CONVERT
	PUSH	P,T1		;SAVE TIME
	MOVE	T1,T2		;GET DATE
	PUSHJ	P,LDATE		;OUTPUT DATE
	POP	P,T1		;RESTORE TIME
	IDIVI	T1,^D1000	;CHANGE TO SEC
	CAIL	T2,^D500		;  ROUNDING
	ADDI	T1,1		;     ..
	PJRST	HR2OUT		;OUTPUT HOURS-MINS-SEC

ODATIM:	PUSH	P,T1		;SAVE WHOLE WORD
	LDB	T1,[POINT 12,0(P),11]	;GET DATE FIELD
	PUSHJ	P,LDATE
	POP	P,T1		;GET BACK DAY AND TIME
	TLZ	T1,777700	;CLEAR OUT DAY
	IDIV	T1,JIFSEC
	ASH	T2,1
	CAML	T2,JIFSEC	;ROUND UP?
	ADDI	T1,1		; YES
	PJRST	HR2OUT		;AND OUTPUT

LDATE:	IDIVI	T1,^D31*^D12	;GET YEAR-1964
	TRNN	T1,3		;LEAP YEAR?
	TLO	F,L.LY		;YES. REMEMBER IT
	PUSH	P,T2		;SAVE DAY
	ADDI	T1,^D1964
	PUSHJ	P,DECP4		;PRINT YEAR
	POP	P,T2
	IDIVI	T2,^D31		;MONTH NUMBER TO T2, DAY NUMBER TO C.
	MOVE	T1,DAYTAB(T2)	;FIRST OF THE MONTH TO T1
	ADDI	T1,1(T3)		;LET JAN 1 BE ONE.
	MOVEI	T4,1		;MIGHT NEED A LEAP YEAR
	CAIGE	T2,2		;IF JAN OR FEB, NO FUDGE
	MOVEI	T4,0		; ..
	TLZE	F,L.LY		;LEAP YEAR?
	ADDI	T1,(T4)		;YES. ADD A DAY IF APPROPRIATE.
	PUSHJ	P,DECP3		;OUTPUT DAY NUMBER, 3 DIGITS
	POPJ	P,

	RADIX	10
DAYTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334
	RADIX	8
ASCIT:	MOVE	M,T1
MSG:	HRLI	M,440700
MSG1:	ILDB	CH,M
	JUMPE	CH,CPOPJ
	PUSHJ	P,OUCH
	JRST	MSG1

CRLF:	JSP	M,MSG
CRLFM:	ASCIZ /
/
IFN FT$CS2, <	;[31]
VERPRT:	CAMN	T1,LASTV
	POPJ	P,	;SUPPRESS IF SAME AS LAST
	MOVEM	T1,LASTV	;SAVE FOR LATER COMPARE AND ENTER OCTP12
;	PJRST	OCTP12
>

OCTP12:	MOVE	BP,[440300,,T1]
	JRST	OCTPL

OCTP6:	SKIPA	BP,[220300,,T1]
OCTP3:	MOVE	BP,[110300,,T1]
OCTPL:	ILDB	CH,BP
	ADDI	CH,"0"
	PUSHJ	P,OUCH
	TLNE	BP,770000
	JRST	OCTPL
	POPJ	P,0

ZEROUT:	MOVEI	CH,"0"


OUCH:	TLNE	F,L.TTY
	OUTCHR	CH
	CAIN	CH,.CHLFD
	TLZ	F,L.TTY
	TLNN	F,L.TEMP
	PJRST	ASCWR
	IDPB	CH,LINEBP	;PUT IN LINE BUFFER
	CAIN	CH," "
	POPJ	P,
	PUSH	P,CH		;SAVE CH
	MOVE	CH,LINEBP
	CAMLE	CH,HGHCHR
	MOVEM	CH,HGHCHR	;KEEP BYTE POINTER TO HIGHEST CHARACTER
	POP	P,CH		;RESTORE IT
	POPJ	P,0
ASCWR:	SOSLE	ASCB+2
	JRST	ASCOK
	OUT	ASC,0
	  JRST	ASCOK
	CLOSE	ASC,
	ERREX$	(DOE,Device OUTPUT error)

ASCOK:	IDPB	CH,ASCB+1
	POPJ	P,0

;[26] TO END OF PAGE

IFN FT$SIX,<
OUTSIX:	SOSLE	SIXB+2
	JRST	SIXOK
	OUT	SIX,0
	  JRST	SIXOK
	CLOSE	SIX,
	ERREX$	(SOE,Sixbit output error)

SIXOK:	IDPB	P1,SIXB+1
	POPJ	P,0
>
;STORAGE AND STUFF

;CONVERT CODES TO SMALL INDECES

DEFINE M.M(ABV$,VAL$,NAME$)<
X..==X..+1
X.'ABV$==X..
	XWD FE.'ABV$,X.'ABV$
>
X..==0

FETAB:	M.FE
FETABL==.-FETAB
	XLIST	;LITERALS
	LIT
	LIST

PDP:	XWD	-PDLL,PDL-1

	RELOC

PDL:	BLOCK PDLL+1

SYSB:	BLOCK	3
ASCB:	BLOCK	3
IFN FT$SIX,<
SIXB:	BLOCK	3		;[26]
>
FCTB:	BLOCK	3

MFDPPN:	BLOCK	1
SYSPP:	BLOCK	1
JIFSEC:	BLOCK	1

FILE:	BLOCK	1		;[30] STORE FILE NAME
EXTEN:	BLOCK	1
FILDAT:	BLOCK	1
APRSNL:	BLOCK	1
RUNDAT:	BLOCK	1
RUNTIM:	BLOCK	1
UNKNOW:	BLOCK	1		;[23] COUNT AND FLAG FOR UNKNOWN ENTRIES
LASTUN:	BLOCK	1		;[23] LAST UNDEFINED CODE SEEN
LASTV:	BLOCK	1		;[31] LAST VERSION # PRINTED

LINEBP:	BLOCK	1			;POINTER INTO THE OUTPUT STRING
LINE:	BLOCK	LINLEN+1		;THE ACTUAL OUTPUT LINE TEXT GOES HERE.
				;[35] MAKE SPACE FOR ZERO MARKER IF LINE FULL
HGHCHR:	BLOCK	1		;LOCATION OF HIGHEST NON-BLANK

ENTRY:	BLOCK	MAXENT

	END	FACTPR		;&.SK2;[END <FACTPR.PLM]