Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50277/tape.mac
There are 50 other files named tape.mac in the archive. Click here to see a list.
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