Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50277/tapact.mac
There are no other files named tapact.mac in the archive.
TITLE TAPACT - U OF O DECTAPE ACCOUNTING - 4(11)-2
SUBTTL D. THOMSON - 2 FEB 73
VWHO==2 ;WHO LAST MODIFIED THIS CUSP
VTAPAC==4 ;MAJOR VERSION #
VMINOR==0 ;MINOR VERSION #
VEDIT==11 ;EDIT #
.JBVER==137
LOC .JBVER
BYTE (3)VWHO(9)VTAPAC(6)VMINOR(18)VEDIT
RELOC
;AC DEFINITIONS
F=0
LNGMOD==400000
A=1
B=2
C=3
D=4
CH=6
T=7
N1=11
N2=12
W=13
WORD0=14
WORD2=15
P=17
;DEFINITIONS FROM TAPE.MAC
SYSTOP==^D500 ;LIMIT OF SYSTEMS BLOCK
RENTOP==^D5000 ;LIMIT OF RENTAL BLOCK
;MISC DEFINITIONS
IN==1 ;I/O CHANNEL FOR INPUT
OUT==2 ;I/O CHANNEL FOR OUTPUT
DTACOD==500 ;ACCOUNTING CODE FOR DTA ENTRIES
DTALEN==4 ;LENGTH OF DTA RECORDS IN ACCT.SYS
L.CTY==200000 ;CTY FLAG IN GETLCH WORD
C.CR==15 ;ASCII CARRIAGE RETURN
.JBREN==124 ;SET UP REENTER ADDRESS TO ALLOW
LOC .JBREN ; LONG DIALOG
EXP DIALOG
RELOC
;INITIALIZATION
DIALOG: TLOA F,LNGMOD ;SET DIALOG MODE FLAG
TAPACT: TLZ F,LNGMOD ;CLEAR DIALOG MODE FLAG
RESET ;RESET THE WORLD
MOVE P,[IOWD 20,PDL] ;SET UP PDL
PUSHJ P,TTYNUM ;GET BINARY TTY # IN RH OF N1
MOVE W,[DTACOD_11,,DTALEN];GET SKELETON HEADER WORD
DPB N1,[POINT 12,W,29];STORE TTY #
PJOB A, ;GET OUR JOB NUMBER
DPB A,[POINT 9,W,17];PUT IN BITS 6-17 OF HEADER
MOVEM W,WORD0 ;STORE HEADER WORD
DATE W, ;GET TODAY'S DATE
MOVEM W,D ;SAVE DATE
ROT W,-^D12 ;ROTATE INTO BITS 0-11
TIMER B, ;GET CURRENT TIME IN TICKS
IOR W,B ;PUT IN BITS 12-35
MOVEM W,WORD2 ;STORE DATE AND TIME IN PERMANENT AC
TLNN F,LNGMOD ;SKIP IF IN DIALOG MODE
JRST MAKFIL ;ELSE GO MAKE UP FILE NAME
OUTSTR [ASCIZ /OUTPUT FILE NAME: /]
PUSHJ P,SIXIN ;GET USER SUPPLIED FILE NAME
JRST A,MAKFL2 ;GO ENTER GIVEN FILE
;USE DATE TO DETERMINE CORRECT FILENAME
MAKFIL: MOVE A,D ;RESTORE DATE TO A
IDIVI A,^D<12*31> ;CONVERT DATE
IDIVI B,^D31 ;MONTH-1 IN B;DAY-1 IN C
CAIN C,^D24 ;SKIP IF NOT THE 25TH
JRST MAKFL1 ;ELSE USE FILENAME 'FACT '
CAIG C,^D24 ;SKIP IF PAST THE 25TH
SOS B ;ELSE BACK UP A MONTH
SKIPA A,MONTAB(B) ;PICK UP CORRECT FILENAME AND SKIP
MAKFL1: MOVE A,['FACT '] ;PICK UP FILENAME
MAKFL2: PUSHJ P,ENTER ;GO ENTER OUTPUT FILE (NAME IN A)
PUSHJ P,LOOKUP ;GO LOOKUP INPUT FILE SYS:TAPE.SYS
;FILE PROCESSING
READ: PUSHJ P,GETBUF ;GET A BUFFER
JRST FINISH ;EOF - GO FINISH UP
NEXT: HRRZ T,(A) ;GET TAPE #
JUMPE T,FINISH ;JUMP IF PAST LAST TAPE
SKIPGE (A) ;SKIP IF NOT IN USE
CAIG T,SYSTOP ;SKIP IF ABOVE START #
JRST SKIPS ;ELSE SKIP THIS TAPE
CAIL T,RENTOP ;SKIP UNLESS PAST RENTAL BLOCK
JRST FINISH ;ALL DONE
MOVE W,WORD0 ;PICK UP HEADER WORD FOR ENTRY
PUSHJ P,WRDOUT ;WRITE IT OUT
MOVE W,1(A) ;PICK UP OWNER'S PPN
PUSHJ P,WRDOUT ;WRITE IT OUT
MOVE W,WORD2 ;PICK UP CURRENT DATE
PUSHJ P,WRDOUT ;WRITE IT OUT
HRRZ W,T ;PICK UP TAPE # IN RIGHT HALF
HLL W,2(A) ;CREATION DATE IN LH
PUSHJ P,WRDOUT ;WRITE IT OUT(NOTE THAT BIT 0 IS THE
; RELEASE FLAG AND MUST BE ZERO)
SKIPS: ADD A,[1,,3] ;INCREMENT INPUT BUFFER POINTER
JUMPL A,NEXT ;JUMP IF MORE IN BUFFER
JRST READ ;ELSE GO READ ANOTHER BUFFER
;HERE ON INPUT FILE EOF
FINISH: SETO W, ;LOAD FACT FILE EOF WORD
PUSHJ P,WRDOUT ;PUT IN FILE
CLOSE OUT, ;CLOSE OUTPUT FILE
CLOSE IN, ;CLOSE INPUT FILE
OUTSTR [ASCIZ /
--DONE--/]
EXIT 1, ;THEN CALL IT QUITS
;DISK I/O SUBROUTINES
;SUBROUTINE TO INIT AND LOOKUP INPUT FILE
;USES AC'S A-D
LOOKUP: INIT IN,13 ;INIT DISK FOR IMAGE BINARY INPUT
SIXBIT /SYS/
XWD 0,IBUF ;INPUT ONLY
JRST IOERR1 ;ERROR RETURN.
MOVE A,['TAPE '] ;SET TO LOOKUP
MOVSI B,'SYS' ; INPUT FILE
SETZB C,D
LOOKUP IN,A ;LOOKUP INPUT
JRST IOERR3 ;ERROR RETURN
POPJ P, ;O.K. RETURN
;ROUTINE TO INIT AND ENTER OUTPUT FILE
;ENTER WITH FILENAME IN A - USES A-D
ENTER: INIT OUT,13 ;INIT DISK, BINARY WORD MODE
'SYS '
OBUF,,0
JRST IOERR1 ;?CAN'T GET DISK
MOVSI B,'DTA' ;FILENAME ALREADY IN A
SETZB C,D
ENTER OUT,A ;ENTER OUTPUT FILE
JRST IOERR4 ;?CAN'T ENTER FILE
OUTPUT OUT, ;SET UP BUFFER RING
POPJ P, ;AND RETURN
;SUBROUTINE TO READ FROM INPUT FILE
;USES AC'S A,B
;NO RETURN ON ERROR
GETBUF: IN IN, ;READ A BLOCK
JRST SETBUF ;GOT IT
STATZ IN,740000 ;IS IT EOF?
JRST IOERR2 ;NO SUCH LUCK.
POPJ P, ;GIVE NON-SKIP(EOF) RETURN
SETBUF: MOVE A,IBUF+1 ;GET ADR OF BUFFER IN A
AOS A ;INCREMENT TO POINT TO FIRST WORD
HRLI A,-^D<128/3> ;PUT -# OF ENTRIES IN BUFFER IN LH
AOS (P) ;SET FOR SKIP RETURN
POPJ P, ;RETURN
;SUBROUTINE TO WRITE A WORD FROM AC W TO DISK
;USES NO AC'S; W IS PRESERVED
WRDOUT: SOSL OBUF+2 ;SKIP IF BUFFER FULL
JRST WRD1 ;ELSE CONTINUE BELOW
OUT OUT, ;WRITE OUT BUFFER
JRST WRDOUT ;GO TRY AGAIN
JRST IOERR5 ;ERROR RETURN
WRD1: IDPB W,OBUF+1 ;STORE WORD IN OUTPUT BUFFER
POPJ P, ;RETURN
;TTY I/O AND MISC. ROUTINES
;ROUTINE TO INPUT A DECIMAL # FROM THE TTY
;RETURNS # IN N1, USES CH,N1
DECIN: SETZ N1, ;STANDARD TTY INPUT ROUTINE
INCHWL CH
CAIN CH,15
JRST DECIN1
IMULI N1,12
ADDI N1,-"0"(CH)
JRST DECIN+1
DECIN1: INCHRW CH ;PICK UP LEFT OVER <LF>
POPJ P, ; AND RETURN
;SUBROUTINE TO READ SIXBIT FILENAME FROM TTY TO A
;USES CH,N1,B - RETURNS VALUE IN A
SIXIN: MOVEI N1,6 ;MAX OF 6 CHARS
MOVE B,[POINT 6,A] ;POINTER TO RESULT
SETZ A, ;ZERO OUT RESULT
SIX1: INCHWL CH ;GET CHAR
CAIN CH,C.CR ;SKIP UNLESS CARRIAGE RETURN
JRST SIX2 ;IN WHICH CASE GO FINISH UP
SUBI CH," " ;CONVERT TO SIXBIT
IDPB CH,B ;STORE CHAR IN A
SOJGE N1,SIX1 ;LOOP UNLESS TOO MANY CHARS
SIXERR: OUTSTR [ASCIZ /?BAD FILENAME - TRY AGAIN: /]
CLRBFI ;DELETE GARBAGE TYPED AHEAD
JRST SIXIN ;GO TRY AGAIN
SIX2: INCHWL CH ;PICK UP EXTRA <LF>
JUMPE A,SIXERR ;DON'T ALLOW NULL FILENAME
POPJ P, ;RETURN
;ROUTINE TO PRINT A DECIMAL NUMBER IN AC N1
;USES N1,N2,CH
DECPRT: IDIVI N1,^D10 ;STANDARD DECIMAL PRINT ROUTINE
HRLM N2,(P)
SKIPE N1
PUSHJ P,DECPRT
HLRZ CH,(P)
ADDI CH,"0"
OUTCHR CH
POPJ P,
;SUBROUTINE TO RETURN BINARY TTY # IN N1
;USES ONLY AC N1
TTYNUM: GETLIN N1, ;GET SIXBIT TTY NAME
JUMPE N1,TTYN1 ;JUMP IF DETACHED
SETO N1, ;SET FOR GETLCH ON THIS TTY LINE
GETLCH N1 ;RETURNS FLAGS IN LH, TTY # IN RH
TLNE N1,L.CTY ;IS THIS THE CTY?
HRRI N1,-1 ;YES-MAKE IT -1
POPJ P, ;RETURN WITH TTY # IN RH
TTYN1: HRRI N1,-2 ;DETACHED BECOMES -1
POPJ P, ;RETURN
;ERROR ROUTINES
IOERR1: OUTSTR [ASCIZ /?DEVICE DSK NOT AVAILABLE/]
EXIT
IOERR2: OUTSTR [ASCIZ /?ERROR READING TAPE.SYS/]
EXIT
IOERR3: OUTSTR [ASCIZ /?INPUT FILE SYS:TAPE.SYS NOT FOUND/]
EXIT ;AND QUIT
IOERR4: OUTSTR [ASCIZ /?ENTER FAILED FOR OUTPUT FILE/]
EXIT ;QUIT
IOERR5: OUTSTR [ASCIZ /?ERROR WRITING OUTPUT FILE/]
EXIT
;STORAGE AREAS AND CONSTANTS
MONTAB: 'JAN025' ;OUTPUT FILENAMES
'FEB025'
'MAR025'
'APR025'
'MAY025'
'JUN025'
'JUL025'
'AUG025'
'SEP025'
'OCT025'
'NOV025'
'DEC025'
IBUF: BLOCK 3 ;BUFFER HEADER FOR INPUT FILE
OBUF: BLOCK 3 ;BUFFER HEADER FOR DISK OUTPUT FILE
PDL: BLOCK 20 ;PUSH DOWN LIST
END TAPACT