Trailing-Edge
-
PDP-10 Archives
-
bb-k345a-sb
-
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]