TITLE TAPE ACCOUNTING - V5(11)-2 - U/O MODIFIED
SUBTTL L K SALMONSON  AUG 70  B A VAN NATTA/BAV 1-MAR-71  D THOMSON/DAT 8 MAR 73

	VWHO==2		;WHO LAST MODIFIED THIS CUSP
	VTAPE==5	;MAJOR VERSION #
	VMINOR==0	;MINOR VERSION #
	VEDIT==11	;EDIT #

	.JBVER==137
	LOC .JBVER	;PUT IN VERSION #
	BYTE	(3)VWHO(9)VTAPE(6)VMINOR(18)VEDIT
	RELOC

IFNDEF	FACTSW,<FACTSW==-1>	;DEFAULT IS TO DO ACCOUNTING
				;IF THIS SWITCH IS ON THE FOLLOWING CODE
				;CODE IS GENERATED: ACCOUNTING,^C TRAPPING,
				;AND NO-RESTART CODE.
PASS:	SIXBIT /SYSTEM/	;FOR SYSTEMS BLOCK
SYSTOP:	^D500		;LIMIT OF SYSTEMS BLOCK
RENTOP:	^D5000		;LIMIT OF RENTING BLOCK
SYSPP:	XWD 1,2

	T=0	;AC'S
	T1=1
	PP=2
	DATE=3
	L=4
	F=5
	  EOD=400000
	P=6
	A=7
	B=10
	C=11
	D=12
	E=13
	W=14
	H=15

INUSE=400000	;FLAGS IN LH OF ENTRY
BUY=200000

OPDEF OUTCHR [TTCALL 1,L]
OPDEF OUTSTR [TTCALL 3,]
OPDEF INCHWL [TTCALL 4,L]
OPDEF CLRBFI [TTCALL 11,]

  MLON

STACK:	XWD -10,.
	BLOCK 10
IN:	BLOCK 3
OUT:	BLOCK 3
DUMP:	IOWD 176,BUFFER
	 0
BUFFER:	BLOCK 176
IFN	FACTSW,<
INTBLK:	EXP	EXIT	;JOB INTERRUPT BLOCK FOR ^C'S
	EXP	2
	0
	0
>
START:	CALLI 0			;RESET
IFN FACTSW,<
	MOVEI	T1,INTBLK	;SET UP JOB INTERRUPT BLOCK
	MOVEM	T1,.JBINT##	;  TO INTERCEPT ^C'S
	MOVEI	T1,NOSTRT	;RESET STARTING ADDRESS SO
	HRRM	T1,.JBSA##	;  PROGRAM CANNOT BE RESTARTED
>
	OUTSTR	[ASCIZ /REPLY G, R, T, M, E, OR H/]
CLOSE:	CLOSE 1,			;CLOSE CHAN 1
PROMPT:	OUTSTR [BYTE (7) 15,12,12, 52]
	CLRBFI			;CLEAR COMMAND BUFFER
	MOVE P,STACK		;SETUP PDP
	PUSHJ P,SKIPS		;GET 1ST CHAR OF COMMAND
	CAIN L,15		;ANYTHING?
	JRST PROMPT		;NO, TRY AGAIN
	PUSHJ P,SIXIN		;GET COMMAND IN SIXBIT
	JUMPE T,WHATQ		;SOMETHING FOUND?
	MOVSI T1,COMTAB-COMDIS	;YES, SETUP SEARCH OF TABLE
	CAME T,COMTAB(T1)	;IS THIS IT?
	AOBJN T1,.-1		;NO, COUNT AND TRY AGAIN
	JUMPG T1,WHATQ		;FOUND?
	TLZ T1,-1		;YES, PICK UP ROUTING
	ROT T1,-2
	HRRZ T,COMDIS(T1)
	SKIPL T1
	HLRZ T,COMDIS(T1)
	PUSHJ P,SKIP		;GET 1ST CHAR OF A POSSIBLE ARG
	JRST @T

COMTAB:	SIXBIT /A     ADD/
	SIXBIT /D     DELETE/
	SIXBIT /G     GIVE/
	SIXBIT /R     RELEAS/
	SIXBIT /T     TYPE/
	SIXBIT /L     LIST/
	SIXBIT /M     MOVE/
	SIXBIT /C     CHANGE/
	SIXBIT /E     EXIT/
	SIXBIT /H     HELP/
COMDIS:	XWD  ADD,DELETE
	XWD  GIVE,RELEAS
	XWD  TYPE,LIST
	XWD  MOVE,CHANGE
	XWD  EXIT,HELP

WHATQ:	OUTSTR [ASCIZ / ?/]
	JRST PROMPT

BAD:	OUTSTR [ASCIZ /?HORRIBLE DISK ERROR/]
				;FALL INTO EXIT ROUTINE

	;HERE ON EXIT COMMAND
EXIT:	CLRBFI			;CLEAR INPUT BUFFER (HACK,HACK)
	CALLI	12		;***** EXIT *****

IFN FACTSW,<	;HERE IF USER TRIES TO RESTART US
NOSTRT:	OUTSTR	[ASCIZ /%TAPE MAY ONLY BE STARTED WITH THE R TAPE COMMAND/]
	JRST	EXIT		;NO RESTARTS ALLOWED
>
ADD:	JSP F,RANGES		;CALL COROUTINE TO FIND 1ST ENTRY
	CAIN W,(T1)		;DID WE HIT IT ON THE NOSE?
	AOJA W,RANGE		;YES, TRY NEXT ENTRY
	IDPB W,OUT+1		;NO, INSERT IT
	IBP  OUT+1
	IDPB DATE,OUT+1
	SOJG C,.+4		;TIME TO OUTPUT THIS BLOCK?
	OUTPUT 1,		;YES
	MOVE C,OUT+2		;SETUP COUNT FOR IT
	IDIVI C,3
	AOJA W,RANGE		;REENTER COROUTINE FOR NEXT ENTRY

DELETE:	JSP F,RANGES		;CALL COROUTINE TO FIND 1ST ENTRY
	CAIE W,(T1)		;DID WE HIT IT?
	AOJA W,RANGE		;NO, TRY NEXT NUMBER
IFN FACTSW,<
	SKIPG	0(A)		;YES, SKIP IF TAPE NOT IN USE
	PUSHJ	P,FACTD		;IF IN USE GO WRITE FACT ENTRY
>
	IBP  A			;SKIP OVER IT
	IBP  A
	AOJA W,RANGEM		;PICK UP NEXT IN COROUTINE

RANGES:	PUSHJ P,DECIN		;GET FIRST NUMBER
	MOVE W,T		;INTO AC W
	PUSHJ P,SKIP		;GET NEXT SIGNIFICANT CHAR
	CAIN L,15		;NOTHING?
	JRST RANGER		;YES, ONLY A SINGLE ENTRY BEING ADDED
	CAIE L,"-"		;DELIMITER HAD BETTER BE A DASH
	JRST WHATQ
	PUSHJ P,DECINS		;SKIP OVER IT AND GET OTHER NUMBER
	PUSHJ P,NULL		;MAKE SURE THAT'S ALL
RANGER:	CALLI PP,24		;ADD AND DELTE COMMANDS ARE
	JFCL			;POSSIBLE SKIP RETURN(JACCT SET)
	CAMN PP,SYSPP		; RESTRICTED IN USAGE
	CAMGE T,W		;SECOND NUMBER BETTER BE HIGHER
	JRST WHATQ
	CAIL T,^D100000		;5 DIGITS IS MAXIMUM # IN TAPE FILE
	JRST WHATQ
	MOVE H,T		;HOLD HIGHER NUMBER IN AC H
	PUSHJ P,LOOKUP		;OPEN FILE
	INIT 1,13		;AND SUPERSEDE IT
	SIXBIT /SYS/
	XWD OUT,0
	JRST BAD
	MOVE T,['TAPE  ']
	MOVSI T+1,'SYS'
	MOVE T+2,[<333>B8]
	SETZ T+3,
	ENTER 1,T
	JRST BAD
	MOVEI DATE,0		;NEW TAPES HAVE ZERO DATE
	OUTPUT 1,		;OUTPUT BLOCK
	MOVE C,OUT+2		;AND SETUP COUNT FOR IT
	IDIVI C,3
RANGEM:	SOJG B,RANGED		;ARE WE OUT OF INPUT?
	PUSHJ P,GETBUF		;YES, GET ANOTHER BUFFER
	CAMG W,H		;DON'T SENSE EOF NOW IF PAST NUMBER
	JUMPL F,(F)		;IF EOF EXIT COROUTINE
RANGED:	ILDB T1,A		;PICK UP TAPE NUMBER
RANGE:	CAMG W,H		;ARE WE PAST HIGH NUMBER?
	JRST .RANGE		;NO
	JUMPG F,RANGEN		;YES, OUTPUT ENTRY IF NOT EOF
	MOVE T,['TAPE  ']	;USE FILE NAME 'TAPE.SYS'
	MOVSI T+1,'SYS'
	MOVSI T+2,333000	;CORECT FOR LEVEL D
	SETZ T+3,
	RENAME 1,T
	JRST BAD
	JRST PROMPT		;GO PROMPT FOR NEXT COMMAND

.RANGE:	JUMPL F,(F)		;EXIT COROUTINE IF EOF
	JUMPE T1,(F)		;IT'S EOF IF ZERO NUMBER
	CAIG W,(T1)		;ARE WE TO ENTRY YET?
	JRST (F)		;YES, EXIT COROUTINE
RANGEN:	IDPB T1,OUT+1		;PUT ENTRY IN NEW FILE
	ILDB T,A
	IDPB T,OUT+1
	ILDB T,A
	IDPB T,OUT+1
	SOJG C,RANGEM		;COUNT ENTRIES IN OUTPUT BLOCK
	JRST RANGEM-3		;OUTPUT ANOTHER BLOCK


LOOKUP:	TLZ  F,-1		;ZERO FLAGS
	INIT 2,13		;OPEN INPUT FILE
	SIXBIT /SYS/

	XWD 0,IN
	JRST BAD
	MOVE T,['TAPE  ']
	MOVSI T+1,'SYS'
	SETZB T+2,T+3
	LOOKUP 2,T
SETEOD:	TLO F,EOD		;FLAG END OF FILE
	MOVEI B,0		;ZERO COUNT OF ENTRIES IN BUFFER
	POPJ P,

GETBUF:	IN  2,			;GET A BUFFER
	SKIPA A,IN+1		;GOT IT, PICK UP BYTE POINTER
	JRST [STATZ 2,740000	;ERROR?
	      JRST BAD
	      JRST SETEOD]	;NO, EOF
	MOVE T,IN+2		;SETUP COUNT OF ENTRIES IN BUFFER
	IDIVI T,3
	MOVE B,T		;IN AC B
	POPJ P,
MOVE:	SETOM MOVFLG#		;INDICATE MOVE COMAND
	CAIN L,15		;IS THERE AN ARG?
	JRST WHATQ		;NO??
	SKIPA
GIVE:	SETZM MOVFLG
	CAIN L,15		;IS THERE AN ARG?
	TDZA T,T		;NO, ZERO AND SKIP OVER
	PUSHJ P,DECIN		;YES, GET IT
	PUSHJ P,NULL		;MAKE SURE THAT'S ALL
	MOVE H,T		;HOLD NUMBER IN AC H
	SKIPE MOVFLG		;SKIP IF NOT MOVE COMMAND
	PUSHJ P,PJPG		;GET PROJECT,PROGRAMMER #
GIVE1:	OUTSTR [ASCIZ /PROTECTION?	/]
	CLRBFI
	PUSHJ P,SKIPS
	SKIPN E,MOVFLG		;SKIP AND SET E=-1 IF MOVE COMD
	MOVEI E,055		;DEFAULT PROTECTION?
	CAIN L,15
	JRST GIVE4		;YES
	MOVEI E,0
GIVE2:	CAIL L,"0"
	CAILE L,"7"
	JRST GIVE3
	LSH E,3
	IORI E,-60(L)
	INCHWL
	JRST GIVE2
GIVE3:	JUMPE E,GIVE1		;TRY AGAIN IF NOTHING VALID
	PUSHJ P,SKIP		;MAKE SURE THAT'S ALL
	CAIN L,15
	CAILE E,777		;AND THE PROTECTION IS VALID
	JRST GIVE1		;NO, TRY AGAIN
GIVE4:	SKIPE MOVFLG		;SKIP IF NOT A MOVE COMMAND
	JRST MOVE1		;FIND THE TAPE REQUESTED
	OUTSTR [ASCIZ /DO YOU WISH TO RENT THIS TAPE?	/]
	CLRBFI
	TRO E,INUSE		;SET INUSE BIT NOW FOR THIS PROSPECT
	PUSHJ P,SKIPS
	CAIE L,15
	CAIN L,"N"
	JRST GIVE5
	CAIN L,"Y"
	JRST GIVE7
	PUSHJ P,SIXIN		;MAYBE IT'S SYSTEMS
	CAMN T,PASS
	CAML H,SYSTOP
	JRST GIVE4		;NO, TRY AGAIN
MOVE1:	MOVEI W,1		;SET TAPE TO FIND FIRST
	JRST GIVE8
GIVE5:	OUTSTR [ASCIZ /DO YOU WANT TO PURCHASE A TAPE? /]
	CLRBFI
	PUSHJ P,SKIPS
	CAIE L,15
	CAIN L,"N"
	JRST GIVE6
	CAIE L,"Y"
	JRST GIVE5		;TRY AGAIN
	OUTSTR [ASCIZ /SEE ACCOUNTING (250-J CC) TO PURCHASE THIS TAPE/]
	JRST BUYING
GIVE6:	OUTSTR [ASCIZ /DO YOU WANT A NUMBER FOR A TAPE YOU ALREADY OWN? /]
	CLRBFI
	PUSHJ P,SKIPS
	CAIE L,"Y"
	JRST WHATQ		;WHAT'S HE DOING IF NOT RENT OR PUCHASE?
	OUTSTR [ASCIZ /SEE PROGRAM RECEPTION TO HAVE YOUR TAPE NUMBERED/]
BUYING:	MOVE W,RENTOP		;SET TAPE TO FIND FIRST
	TROA E,BUY		;SET BUY BIT AND SKIP OVER
GIVE7:	MOVE W,SYSTOP		;SET TAPE TO FIND FIRST
GIVE8:	PUSHJ P,UPDATE		;OPEN FILE FOR UPDATE AND READ FIRST BLOCK
	JUMPL F,NO
	JUMPN H,GIVE9		;WERE WE GIVEN AN EXPLICIT NUMBER?
	SKIPLE T1,BUFFER(A)	;NO, LOOK FOR A FREE ENTRY
	JRST YES		;FOUND
	ADD A,[XWD 3,3]
	JUMPL A,.-3
	ADDI F,1		;NO FREE ENTRY IN THIS BLOCK
	AOBJN P,READ		; SO TRY NEXT BLOCK

GIVE9:	MOVE W,H		;LOOK FOR THE GIVEN NUMBER
	PUSHJ P,FIND
	JUMPL F,NO		;NOT FOUND
	CAIE W,(T1)
	JRST NO
	CAME PP,BUFFER+1(A)	;SAME PROJ,PROG?
	JUMPL T1,NO		;OR AVAILABLE?
YES:	SKIPL MOVFLG		;SKIP IF MOVE COMMAND
	JRST YES1
	JUMPG T1,NO		;MUST BE INUSE AND HIS
	SKIPL E			;SKIP IF NEGITIVE
	DPB E,[POINT 9,BUFFER(A),17]	;INSERT NEW PROTECTION
	MOVE	PP,PRJPRG	;GET PROJ,PROG #
	JUMPE	PP,YESSIR	;JUMP IF NOT TO BE CHANGED
IFN FACTSW,<
	PUSHJ	P,FACT		;GO APPEND ENTRY TO FACT.SYS
>
	MOVEM PP,BUFFER+1(A)	;CHANGE THE PROJ,PROG #
	HRLZM DATE,BUFFER+2(A)	;THIS IS A CREATION
	JRST YESSIR
YES1:	MOVE T,RENTOP		;FOUND THE ENTRY AND IT'S OK
	TRNE E,BUY		;EXCEPT IF IT'S NOT IN THE RIGHT
	MOVSI T,1		;BLOCK OF ENTRIES
	TLZ  T1,-1
	CAML T1,T
	JRST NO			;NOT ACCEPTABLE
	HRLM E,BUFFER(A)		;PUT IN STATUS
	MOVEM PP,BUFFER+1(A)
	HLLZ T,BUFFER+2(A)	;HAS ENTRY BEEN REFERENCED BEFORE?
	SKIPN  T
	HRLZM DATE,BUFFER+2(A)	;NO, PUT DATE IN LH
	SKIPE  T
	HRRM DATE,BUFFER+2(A)	;YES, PUT DATE IN RH
YESSIR:	HRRZ T,BUFFER(A)	;TELL THE GUY THE NUMBER
	OUTSTR [BYTE (7) 15,12,40,43]
	PUSHJ P,DECTT
	USETO 1,(F)		;AND WRITE MODIFIED BLOCK OUT
	OUTPUT 1,DUMP
	JRST CLOSE
NO:	OUTSTR [ASCIZ /NOPE/]	;TELL HIM NO!
	JRST CLOSE

PJPG:	SETZM PRJPRG
	OUTSTR [ASCIZ/PROJ,PROG # ?   /]
	CLRBFI
	PUSHJ P,OCTGET		;GET PROJECT #
	CAIN L,15		;A CR ?
	POPJ P,			;YES SO RETURN
	HRLM T,PRJPRG#		;SAVE IN THE LEFT HALF
	CAIE L,","		;SEPARATER BEST BE A COMMA
	JRST WHATQ		;IT'S NOT!
	PUSHJ P,OCTGET		;SKIP OVER AND GET PROGRAMMER #
	HRRM T,PRJPRG		;SAVE IT IN THE RIGHT HALF
	PUSHJ P,NULL		;MAKE SURE THAT'S ALL
	POPJ P,				;RETURN

RELEAS:	PUSHJ P,DECIN		;GET NUMBER
	PUSHJ P,NULL
	MOVE W,T
	PUSHJ P,UPDATE		;FIND IT
	CAIE W,(T1)
	JRST NO
	CAMN PP,SYSPP		;ARE WE PRIVILEGED?
	JRST RELOK		;YES
	CAML W,RENTOP		;IS IT A RENTED TAPE
	JRST NOREL		;CAN'T RELEASE OWNED TAPE # THIS WAY
	CAME PP,BUFFER+1(A)	;AND SAME PROJ,PROG?
	JRST NO
RELOK:
IFN FACTSW,<
	PUSHJ	P,FACT		;GO APPEND ENTRY TO FACT.SYS
>
	HRRZS BUFFER(A)		;RELEASE THE TAPE
	SETZM BUFFER+2(A)
	JRST YESSIR

NOREL:	OUTSTR [ASCIZ /% PLEASE RELEASE OWNED TAPE VIA FORM AT PROGRAM RECEPTION
/]
	JRST CLOSE
;**** THIS ROUTINE INSERTED AT U OF O. D. THOMSON/DAT 12-JUN-72 ****
IFN FACTSW,<
;ROUTINE TO APPEND ENTRY TO FACT.SYS WHEN A TAPE IS RELEASED OR MOVED
;TO ANOTHER PROJ,PROG #. THIS RTN BOMBS T1.
;ENTER AT "FACT" WITH A=INDEX INTO BUFFER. ENTER AT "FACTD" WITH
;A=POINTER INTO BUFFER.
FACTD:	SKIPA	T1,A		;PICK UP POINTER TO ENTRY AND SKIP
FACT:	MOVEI	T1,BUFFER(A)	;PICK UP POINTER TO ENTRY
	PUSH	P,T		;SAVE T
	HRRZ	T,0(T1)		;GET TAPE # AND MAKE SURE IT'S RENTED
	CAMG	T,RENTOP	;MUST BE BELOW TOP OF RENTAL BLOCK
	CAMG	T,SYSTOP	;AND ABOVE SYSTEMS BLOCK
	JRST	FACTX		;NOPE. RESTORE AC AND EXIT
	MOVE	T,FCTHED	;PICK UP HEADER WORD
	MOVEM	T,ENTRY+1	;STORE HEADER WORD
	PJOB	T,		;GET JOB #
	DPB	T,[POINT 9,ENTRY+1,17];PUT IN BITS 9-17 OF HEADER WORD
	GETLIN	T,		;GET SIXBIT TTY NAME
	JUMPE	T,FACT1		;JUMP IF DETACHED
	SETO	T,		;SET TO GET OUR TTY LINE CHARACTERISTICS
	GETLCH	T		;RETURNS LINE # IN RH
	TLNE	T,L.CTY		;IS THIS THE CTY?
	HRRI	T,-1		;YES - MAKE IT -1
	SKIPA
FACT1:	HRRI	T,-2		;HERE IF DETACHED - MAKE IT -2
	DPB	T,[POINT 12,ENTRY+1,29];PUT IN BITS 18-29 OF HEADER WORD
	MOVE	T,1(T1)		;GET OLD PPN
	MOVEM	T,ENTRY+2	;STORE PPN IN SECOND WORD
	TIMER	T,		;GET TIME OF DAY IN CLOCK TICKS
	MOVEM	T,ENTRY+3	;STORE IN LOW 24 BITS OF 3RD WORD
	CALLI	T,14		;GET DATE IN DEC FORMAT
	ROT	T,-^D12		;PUT IN HIGH 12 BITS
	IORM	T,ENTRY+3	;  OF 3RD WORD
	HLL	T,2(T1)		;GET CREATION DATE IN LH
	HRR	T,0(T1)		;GET TAPE ID IN RH
	TLO	T,RELFLG	;SET RELEASE FLAG (BIT 0 OF 4TH WORD)
	MOVEM	T,ENTRY+4	;PUT IN 4TH WORD
	MOVEI	T,D.FACT	;DAEMON FUNCTION TO WRITE FACT FILE ENTRY
	MOVEM	T,ENTRY		;GOES IN WORD ZERO OF ENTRY
	MOVE	T,[XWD 5,ENTRY]	;SIZE,,ADDRESS OF ENTRY FOR DAEMON
	DAEMON	T,		;CALL DAEMON TO WRITE FACT FILE ENTRY
	JRST	FCTERR		;?ERROR RETURN
FACTX:	POP	P,T		;RESTORE T
	POPJ	P,		;*** EXIT ***
FCTERR:	OUTSTR	[ASCIZ /?ACCOUNTING SYSTEM FAILURE. PLEASE TRY AGAIN LATER./]
	JRST	CLOSE		;DON'T LET HIM DO IT IF DAEMON NOT THERE
;STORAGE AND CONSTANTS FOR FACT ROUTINE

ENTRY:	BLOCK	5		;SPACE FOR DAEMON RECORD
FCTHED:	XWD	500000,4	;BITS 0-11 = TRANSACTION CODE FOR ENTRY
				;  BITS 33-35 = LENGTH OF ENTRY
	RELFLG==400000		;FLAG FOR RELEASED TAPES
	D.FACT==3		;DAEMON CODE TO WRITE FACT FILE RECORD
	L.CTY==200000		;BIT IN GETLCH WORD - 1 IF LINE IS CTY
>			;END U/O INSERTION - END FACTSW CONDITIONAL
UPDATE:	INIT 1,17		;INIT FILE IN DUMP MODE
	SIXBIT /SYS/
	 0
	JRST BAD
	MOVE T,['TAPE  ']
	MOVSI T+1,'SYS'
	SETZB T+2,T+3
	LOOKUP 1,T
	JRST BAD
	MOVEI A,10		;TRY TO ENTER 8 TIMES
ACCESS:
	SETZ	T+3,
	ENTER 1,T
	SKIPA T+3,[1]		;SLEEP FOR ONE SEC
	JRST READPP
	TRNN T+1,7774		;IF FILE WAS BEING UPDATED
	SOSG  A			;AND WE HAVE'NT USED UP OUR TRIES
	JRST CANT		;TELL HIM WE CAN'T
	CALLI T+3,31		;SLEEP
	JRST ACCESS
READPP:	CALLI PP,24		;SET PROJ,PROG
	JFCL			;IN CASE OF SKIP RETURN WHEN JACCT SET
	CALLI DATE,14		; AND DATE
	MOVEI F,1		;START AT FIRST BLOCK
READ:	MOVSI A,-175		;POINT TO BUFFER
	USETI 1,(F)
	IN  1,DUMP
	JRST FIND		;GO FIND NUMBER IN AC W
	STATZ 1,740000
	JRST BAD
	JRST SETEOD		;EOF

FIND:	MOVE T1,BUFFER(A)
	CAIG W,(T1)
	POPJ P,
	ADD A,[XWD 3,3]
	JUMPL A,FIND
	AOJA F,READ		;END OF BLOCK, TRY NEXT BLOCK

CANT:	OUTSTR [ASCIZ /?CAN'T UPDATE ACCOUNTING FILE/]
	CALLI 12		;EXIT

SIXIN:	MOVSI T1,440600		;POINT TO AC T
	MOVEI T,0
	CAIL L,"A"
	CAILE L,"Z"
	POPJ P,
	SUBI L,40
	TLNE T1,770000
	IDPB L,T1
	INCHWL
	JRST SIXIN+2
TYPE:	CAIN L,15		;AN ARG?
	JRST TALL		;NO, TYPE ALL OF HIS
	PUSHJ P,DECIN		;GET THE NUMBER
	PUSHJ P,NULL
	MOVE W,T
	PUSHJ P,LOOKUP
TYPER:	SOJG B,.+3
	PUSHJ P,GETBUF
	JUMPL F,PROMPT
	ILDB T1,A
	JUMPE T1,PROMPT
	ILDB PP,A
	ILDB DATE,A
	CAIE W,(T1)
	JRST TYPER
	CALLI E,24
	JFCL			;POSSIBLE SKIP RETURN(JACCT SET)
	CAMN PP,E
	PUSHJ P,TYPES
	JRST PROMPT

TALL:	PUSHJ P,LOOKUP
	CALLI E,24		;GET PROJ,PROG
	JFCL			;POSSIBLE SKIP RETURN(JACCT SET)
TALLER:	SOJG B,.+3
	PUSHJ P,GETBUF
	JUMPL F,PROMPT
	ILDB T1,A
	JUMPE T1,PROMPT
	ILDB PP,A
	ILDB DATE,A
	JUMPG T1,TALLER
	CAMN PP,E
	PUSHJ P,TYPES
	JRST TALLER

TYPES:	OUTSTR [BYTE (7) 15,12,40,43]
	MOVEI T,(T1)
	MOVE C,T1
	PUSHJ P,DECTT
	OUTSTR [ASCIZ / </]
	HLLZ T,C
	TLZ  T,777000
	MOVEI T1,0
	ROTC T,14
	LSH T1,4
	ROTC T,3
	LSH T,-4
	ROTC T,-16
	IOR T,[ASCII /000/]
	OUTSTR  T
	OUTSTR [ASCIZ />	/]
	HLRZS DATE
	IDIVI DATE,^D31
	MOVEI T,1(DATE+1)
	PUSHJ P,DECTT
	OUTSTR [ASCIZ /-/]
	IDIVI DATE,^D12
	OUTSTR DATETB(DATE+1)
	OUTSTR [ASCIZ /-/]
	MOVEI T,^D64(DATE)
	PUSHJ P,DECTT
	MOVEI T,(C)
	CAMGE T,SYSTOP
	POPJ P,
	MOVEI T1,[ASCIZ /	RENTED./]
	TLNE C,BUY
	MOVEI T1,[ASCIZ /	PURCHASED./]
	OUTSTR (T1)
	POPJ P,


DECTT:	IDIVI T,12
	JUMPE T,.+4
	HRLM T1,(P)
	PUSHJ P,.-3
	HLRZ T1,(P)
	MOVEI L,60(T1)
	OUTCHR
	POPJ P,
OCTGET:	PUSHJ P,SKIPS
	CAIN L,15
	POPJ P,
	MOVEI T,-60(L)
	CAIL T,12
	JRST WHATQ
OCT2:	INCHWL
	CAIL L,"0"
	CAILE L,"7"
	POPJ P,
	LSH T,3
	ADDI T,-60(L)
	JRST OCT2

NULL:	PUSHJ P,SKIP
	CAIE L,15
	JRST WHATQ
	POPJ P,
SKIPS:	INCHWL
SKIP:	CAIN L," "
	JRST .-2
	CAIN	L,3		;USER TYPED ^C?
	JRST	EXIT		;YES-GO DIE
	POPJ P,
DECINS:	PUSHJ P,SKIPS
DECIN:	MOVEI T,-60(L)
	CAIL T,12
	JRST WHATQ
DECINL:INCHWL
	CAIL L,"0"
	CAILE L,"9"
	POPJ P,
	IMULI T,12
	ADDI T,-60(L)
	JRST	DECINL

DATETB:	ASCIZ /JAN/
	ASCIZ /FEB/
	ASCIZ /MAR/
	ASCIZ /APR/
	ASCIZ /MAY/
	ASCIZ /JUN/
	ASCIZ /JUL/
	ASCIZ /AUG/
	ASCIZ /SEP/
	ASCIZ /OCT/
	ASCIZ /NOV/
	ASCIZ /DEC/
LIST:	CALLI PP,24		;LIST IS RESTRICTED
	JFCL			;POSSIBLE SKIP RETURN(JACCT SET)
	CAME PP,SYSPP
	JRST WHATQ
	PUSHJ P,LOOKUP
	INIT 1,0		;INIT DSK FOR LISTING
	SIXBIT /DSK/
	XWD OUT,0
	JRST WHATQ
	MOVE T,[SIXBIT /TAPE/]
	MOVSI T+1,(SIXBIT /LST/)
	MOVEI T+2,0
	MOVE T+3,SYSPP
	ENTER 1,T
	JRST WHATQ
	OUTPUT 1,
J1==T+2
J2==T+3
	SETZB D,H
	JSP J1,LCHRS
	SIXBIT /NUMBER"(PROJ,PROG"6PROTECTION"BCREATED"NUSED!/
	JSP J1,LCRLF
LISTER:	JSP J1,LCRLF
	SOJG B,.+3
	PUSHJ P,GETBUF
	JUMPL F,LSKIPD
	ILDB W,A
	JUMPE W,LSKIPD
	MOVEI T,(W)
	JUMPG W,LAVAIL
	JUMPN D,LSKIPD
.LISTR:	PUSHJ P,LDEC
	JSP J1,LCHRS
	SIXBIT /"(!/
	ILDB T,A
	MOVSS  T
	JSP J1,LOCT
	MOVEI L,","
	JSP J2,LCHAR
	MOVSS  T
	JSP J1,LOCT
	JSP J1,LCHRS
	SIXBIT /"4!/
	HLRZ T,W
	ANDI T,133
LPRW:	JSP J2,LSPACE
	JSP J2,LCHAR
	TRZE T,200
	MOVEI L,"R"
	JSP J2,LCHAR
	TRZE T,100
	MOVEI L,"W"
	JSP J2,LCHAR
	LSH T,3
	JUMPN T,LPRW
	JSP J1,LCHRS
	SIXBIT /"B!/
	ILDB W,A
	PUSHJ P,LDATE
	JSP J1,LCHRS
	SIXBIT /"N!/
	HRLZS W
	SKIPE W
	PUSHJ P,LDATE
	JRST LISTER

LAVAIL:	SKIPN D
	SKIPA D,T
	HRLM W,D
	IBP  A
	IBP  A
	JRST LISTER+1
LSKIPD:	MOVEI T,(D)
	PUSHJ P,LDEC
	TLNN D,-1
	JRST .LSKPD
	JSP J1,LCHRS
	SIXBIT / - !/
	HLRZ T,D
	PUSHJ P,LDEC
.LSKPD:	JSP J1,LCHRS
	SIXBIT / AVAILABLE!/
	MOVEI T,(W)
	MOVEI D,0
	JSP J1,LCRLF
	SKIPE W
	JUMPGE F,.LISTR
	JRST CLOSE

LCHRS:	HRLI J1,440600
	ILDB L,J1
	SOJE L,1(J1)
	SOJE L,LTAB
	ADDI L,42
	JSP J2,LCHAR
	JRST LCHRS+1
LTAB:	ILDB E,J1
	JSP J2,LSPACE
	CAMGE H,E
	JRST LCHAR
	JRST LCHRS+1
LCRLF:	MOVEI L,15
	JSP J2,LCHAR
	MOVEI L,12
	JSP J2,LCHAR
	MOVEI H,0
	JRST (J1)
LSPACE:	MOVEI L," "
LCHAR:	SOSG OUT+2
	OUTPUT 1,
	IDPB L,OUT+1
	MOVEI L," "
	AOJA H,(J2)
LOCT:	MOVSI T1,220300
	ILDB L,T1
	JUMPE L,.-1
LOCTA:	ADDI L,"0"
	JSP J2,LCHAR
	TLNN T1,770000
	JRST (J1)
LOCTL:	ILDB L,T1
	JRST LOCTA
LDEC:	IDIVI T,12
	JUMPE T,.+4
	HRLM T1,(P)
	PUSHJ P,.-3
	HLRZ T1,(P)		;THIS IS CORECT
	MOVEI L,60(T1)
	JSP J2,LCHAR
	POPJ P,
LDATE:	HLRZ T,W
	IDIVI T,^D31
	HRLM T,W
	MOVEI T,1(T1)
	PUSHJ P,LDEC
	MOVEI L,"-"
	JSP J2,LCHAR
	HLRZ T,W
	IDIVI T,^D12
	LDB L,[POINT 7,DATETB(T1),6]
	JSP J2,LCHAR
	LDB L,[POINT 7,DATETB(T1),13]
	JSP J2,LCHAR
	LDB L,[POINT 7,DATETB(T1),20]
	JSP J2,LCHAR
	MOVEI L,"-"
	JSP J2,LCHAR
	ADDI T,^D64
	JRST LDEC
CHANGE:	PUSHJ P,DECIN		;GET TAPE NUMBER
	PUSHJ P,NULL		;MAKE SURE EXACTLY ONE NUMBER
	MOVE W,T		;
	PUSHJ P,UPDATE		;FIND THE TAPE
	CAIE W,(T1)		;FOUND IT?
	JRST NO			;NO??
	CAME PP,SYSPP		;SKIP IF PRIVILEGED
	JRST NO			;NOT PRIVILEGED!?!?!?
	PUSHJ P,PJPG		;GET PROJ,PROG #
	MOVE PP, PRJPRG
IFN FACTSW,<
	PUSHJ	P,FACT		;GO WRITE FACT FILE ENTRY
>
	MOVEM PP,BUFFER+1(A)	;PUT NEW PPN IN THE BUFFER
	CALLI	DATE,14		;GET DATE
	HRLZM	DATE,BUFFER+2(A);PUT NEW DATE IN BUFFER
	JRST YESSIR		;WRITE OUT THE BUFFER

HELP:	CALLI PP,24
	JFCL			;POSSIBLE SKIP RETURN(JACCT SET)
	CAMN PP,SYSPP
	OUTSTR MESS1
	CAME PP,SYSPP
	OUTSTR MESS2
	JRST PROMPT

MESS1:	ASCIZ /
ADD # - #	ADDS THE INDICATED RANGE OF TAPE ENTRIES
		TO THE ACCOUNTING FILE.
DELETE # - #	DELETES THE INDICATED RANGE OF ENTRIES.
RELEAS #	RELEASES THE TAPE FROM ANY OWNERSHIP.
CHANGE #	CHANGES THE OWNERSHIP OF A TAPE.  THE
		PROGRAM WILL ASK FOR THE NEW
		PROJECT,PROGRAMMER NUMBER
LIST		CREATES A FILE  TAPE.LST  TELLING THE
		STATUS OF EVERY ENTRY IN THE ACCOUNTING.
EXIT		EXITS TO THE MONITOR./
;
MESS2:	ASCIZ/
THE COMMANDS ARE:

G=GIVE.		GIVES YOU AN AVAILABLE TAPE.  THEN
		IT ASKS FOR THE PROTECTION AND WHETHER
		YOU WANT TO RENT OR PURCHASE IT.

M=MOVE.		REQUIRES AN ARGUMENT (TAPE #). ALLOWS
		YOU TO MOVE A TAPE TO ANOTHER PROJECT,PROGRAMMER 
		NUMBER AND RESPECIFY THE PROTECTION.
		TO LEAVE THE TAPE UNDER THE SAME PROJ,PROJ
		NUMBER,CHANGING ONLY THE THE PROTECTION,
		RESPOND WITH A CARRIAGE RETURN WHEN ASKED
		FOR THE PROJ,PROG NUMBER

R=RELEASE.	REQUIRES AN ARGUMENT (TAPE #).  ALLOWS
		YOU TO RELEASE A RENTED TAPE.

T=TYPE.		WITH AN ARGUMENT, WILL TYPE THE STATUS
		OF A SPECIFIC TAPE.  IF NO ARGUMENT,
		TYPES THE STATUS OF ALL YOUR TAPES.
E=EXIT.		RETURNS YOU TO MONITOR MODE./

	END  START