Trailing-Edge
-
PDP-10 Archives
-
de-10-omona-v-mc9
-
react.mac
There are 15 other files named react.mac in the archive. Click here to see a list.
TITLE REACT - HANDLES ADMINISTRATIVE CONTROL FILES 30-JUN-75 V31(154)
SUBTTL R CLEMENTS/DJB/TCK/DLC/MFTT/BAH
VREACT==31
VEDIT==154
VMINOR==0
VWHO==0
;. . . EDIT HISTORY . . .
;
;VERSION 27:(UP TO EDIT LEVEL 6)
; EDIT 4 - ADDS LOCKOUT TO PREVENT SUPERSEDING BY TWO USERS
; AT THE SAME TIME. ALSO ADDS WARNING WHEN THE
; PPN TABLE IS ALMOST FULL.
; AREAS AFFECTED: HAVPPN, RCE, WCOM1
; EDIT 5 - CHANGES REACT TO ALLOW WRITING QUOTA.SYS TO A
; SPECIFIED STRUCTURE. AREAS AFFECTED: RC1
; EDIT 6 - INHIBITS CLOSE OF A FILE WHEN WRITE ERROR EXISTS.
; AREAS AFFECTED: WRERR
;EDIT 7 - ADD SUPPORT FOR VM. DEFINE THE USE OF THE PLACE WORD
; TO BE:
; 1 BITS 0-8 MAX PHYSICAL LIMIT
; 2 BITS 9-17 MAX VIRTUAL LIMIT
; THIS EDIT IS NOT MARKED IN THE LISTING. IT AFFECTS:
; 1 THE INSERT COMMAND
; 2 THE CHANGE COMMAND
; 3 THE LIST AND TYPE COMMAND
; THE NAME OF PLCWRD AND PLCTAB HAS BEEN CHANGED TO RESP.
; CORWRD AND CORTAB
; NOTE: THIS EDIT CHANGES THE VERSION NUMBER OF ACCT.SYS FILES
; TO LEVEL 3
; EDIT 8 - ADD D COMMAND ALLOWING THE DEFINITION OF A DEFAULT VALUE
; FOR THE CORE LIMITS AND IPCF QUOTA
; EDIT 9 - USE THE RIGHT HAND SIDE OF THE CORWRD FOR IPCF QUOTA
; BITS 1826 MAX SEND QUOTA
; BITS 27-35 MAX RECEIVE QUOTA
;EDIT 10 -ADD TWO NEW WATCH BITS:
; P.WVER WATCH VERSION
; P.WMTA WATCH MTA
;EDIT 11 -ADD RH10/RSO4 TO LIST OF CONTROLLERS
;EDIT 12 -EDIT 4 INTRODUCED A PROBLEM , WHEN EVER SETSRC HAS
; USED TO SET NEW FOR INSTANCE THEN IT WILL COMPLAIN
; FILE CURRENTLY OPEN.CURE DO LONG LOOKUP
;EDIT 13 -EDIT 12 CAUSED DTA INPUT TO WORK DUE TO CHANGED LOOKUP
;EDIT 14 -INSERT DID NOT USE DEFAULT FOR CORWRD
;EDIT 15 -GIVE NO SPOOL PRIVILIGE AS A DEFAULT IF FTSPOOL IS DEFINED .NE 1
;EDIT 16 -MAKE SET WATCH MTA STANDARD DEFAULT
;EDIT 17 -IF DSK:A.SYS IS READ CHECK IF PPN IS THAT OF USER
;EDITS STARTING EDIT LEVEL 134
;EDIT 134 INSERT THE RPO4 AS KONT TYPE RP
;EDIT 135 REMOVED BY EDIT 144.
;EDIT 136 ADD QUESTION FOR ENQ/DEQ QUOTAS FOR 6.02 AND UPDATE ACCT.SYS
; FORMAT NUMBERS.
;EDIT 137 ALLOW STR SPEC OF THE FORM SYSN (SYSA, SYSB, ETC.)
;EDIT 140 CHANGE THE DEFINITION OF DEFAULT PAGE AND IPCF
; VALUES FROM ABSOLUTE DEFINITIONS TO IFNDEF DEFINITIONS
; MAKING CHANGES IN THIS VALUES MORE EASY
;EDIT 141 WARN FOR ZERO STRUCTURE NAMES ANS NAMES WITH MORE THAN
; 5 CHARACTERS
;EDIT 142 CORE AND IPCF LIMIT QUESTIONS DO NOT OBSERVE THE REACT
; CONVENTION THAT AN ALTMODE ESCAPES TO SUBSTITUTING DEAFULTS
; FOR REMAINING ATTRIBUTES
;EDIT 143 PRINT IPCF AND VM LIMITS IN DECIMAL AND NOT IN OCTAL
;EDIT 144 REMOVE EDIT 135.
;EDIT 145 ADD MORE CHECKING FOR TABLE OVERFLOW.
;EDIT 146 ADD CODE TO CONVERT FORMAT 3 FILES TO FORMAT 4 (6.02-STYLE)
;EDIT 147 FINISH CONVERSION TO 6.02 REACT BY ADDING SCHEDULER TYPE.
; AFFECTS (CHANGES) EDITS 136, 146.
;EDIT 150 CLEANS UP EDIT 147 BUGS, AND MAKES THIS VERSION 31.
;EDIT 151 FIX ILL MEM REF IF CONTROL-Z TYPED DURING INSERT.
;EDIT 152 ALLOW CHARGE NUMBER OF ACCT.SYS (CHGTAB-WORD 14) TO BE
; INTERPRETED AS SIXBIT. SETTING DEFCHG TO 0 ALLOWS OCTAL
; INTERPRETATION AS BEFORE. DEFAULT WILL BE SIXBIT.
;EDIT 153 STANDARDIZE ERROR MESSAGES.
;EDIT 154 TAKE OUT WARNING IF PPN TABLE IS AT LEAST 90% FULL (EDIT 4).
; REPLACE IT WITH A MESSAGE THAT ALWAYS REPORTS THE NUMBER OF
; PPN'S USED AND MAXIMUM NUMBER ALLOWED. AREA AFFECTED: RCE.
LOC 137
BYTE (3)VWHO(9)VREACT(6)VMINOR(18)VEDIT
RELOC
F=0 ;CONTAINS VARIOUS FLAG BITS
A=1 ;A,B,N AND X ARE WORK ACS,
B=2 ; AND MUST BE KEPT IN THAT ORDER
N=3
X=4
C=5 ;A TEMP AC
BTS=6
BP=10 ;BYTE POINTER FOR WORD ASSEMBLY
WD=11 ;WORD
CH=12 ;CHARACTER
M=13 ;MESSAGE ADDRESSES
P=17 ;PUSHDOWN POINTER
;CHARACTER DEFINITIONS:
.CHTAB=11 ;A HORIZONTAL TAB
.CHLF=12 ;A LINE FEED
.CHSPC=40 ;A SPACE
.CHCOM=54 ;A COMMA
DEFINE CALL(R)
< PUSHJ P,R
>
DEFINE RETURN
< POPJ P,
>
DEFINE SAVE(LIST)
< IRP LIST,<
PUSH P,LIST
>> ;END OF IRP AND DEFINE SAVE
DEFINE RESTORE(LIST)
< IRP LIST,<
POP P,LIST
>> ;END OF IRP AND DEFINE RESTORE
;I/O CHANNEL ASSIGNMENTS
INFIL==1
OUTFIL==2
TTYFIL==3
AUXFIL==4 ;FOR AUXILIARY LISTING
;DEVICE CHARACTERISTIC BITS
DV.DSK=200000 ;**[13] DEVICE IS A DISK
;THE PARAMETER NPAIRS SETS THE MAXIMUM NUMBER OF
;PROJECT-PROGRAMMER PAIRS (A TABLE SIZE)
IFNDEF BIGREACT,<BIGREACT==0>
IFN BIGREACT,<NPAIRS==^D1100>
IFNDEF NPAIRS,<NPAIRS==^D500>
IFDEF INHOUSE,<
NPAIRS==^D3000
FTSPOOL==-1
>
IFNDEF FTSPOOL,<FTSPOOL==0>
DEFCHG==1 ;[152] ACCT.SYS CHGTAB INTERPRETATION, =0 IF OCTAL, =1 IF SIXBIT
DEFPRG==777777 ;DEFAULT PROGRAMMER NUMBER FOR QUOTA FILES
IFNDEF DFMXVM,<DFMXVM==^D511> ;MAX # OF VM PAGES
IFNDEF DFMXPP,<DFMXPP==^D511> ;MAX # OF PHYSICAL PAGES
IFNDEF DEFSND,<DEFSND==2> ;DEFAULT SEND QUOTA
IFNDEF DEFRCV,<DEFRCV==5> ;DEFAULT RECEIVE QUOTA
UNIPRG==777776 ;NUMBER TO CREATE UNIQUE PPN AT LOGIN
ALLPRG==0 ;WILD CARD FOR ALL ENTRIES
WACCOD==157000 ;ACCESS CODE FOR PROTECTED WRITE
STDXPD==777777 ;STANDARD EXPIRATION DATE
ACCFOR==4 ;[136] FORMAT VERSION NUMBER FOR CURRENT FORM OF ACCT.SYS
AC1FOR==0 ;FORMAT VERSION NUMBER FOR AUXACC.SYS
QUOFOR==0 ;FORMAT VERSION NUMBER FOR QUOTA.SYS
STRFOR==0 ;FORMAT VERSION NUMBER FOR STRLST.SYS
EXTERN .JBREN,.JBSA,.JBFF
;CALLI ADDRESSES
DEVCHR==4
GETDAT==14
GETPPN==24
GETTAB==41
CNFTBL==11 ;CONFIGURATION TABLE
STATES==17 ;STATES WORD
LEVDF==(7B9) ;DISK SERVICE FIELD
;DEVCHR BITS
DV.DIR==(1B15)
;BITS IN F (RIGHT HALF)
AUXF2==1 ;SYNC FOR AUXF
AUXF==2 ;AUXILIARY I/O LISTING DEVICE
LCODF==4 ;LIST CODE, IN T AND L COMMANDS
DOTF==10
TYOF==20
BKALTF==40 ;LAST BREAK WAS AN ALTMODE
PROTF==100 ;DISTINGUISH W FROM U COMMAND
STRF==200 ;SET IF STRLST.SYS READ
ACC1F==400 ;SET IF AUXACC.SYS READ
SIGNF==2000 ;SET IF NUMBER BEING PRINTED HAS SIGN BIT ON
QUOTF==1000 ;SET IF QUOTA.SYS READ
OLDF==4000 ;SET IF READING PREVIOUS FORM OF FILE
PPNRDF==10000 ;SET IF CALL TO PPNGET ALLOWS =
SHTSPT==20000 ;SET IF SIXBIT ROUTINE STOPS AT NULL
CBIT==40000 ;SET IF C REQUEST RATHER THAN K REQUEST
;PARAMETERS
MAXENT==16 ;MAXIMUM ALLOWABLE SIZE OF ENTRY BLOCK
DEFCHG==1 ;[152] ACCT.SYS CHGTAB INTERPRETATION, =0 IF OCTAL, =1 IF SIXBIT
SIGN==400000
OKSIGN==777776 ;SMALLEST LEGAL NUMBER IN PPN WHICH REPRESENTS A SPECIAL CHAR
ENTSTD==16 ;STANDARD SIZE OF ACCT SYS ENTRY
QENSTD==4 ;STANDARD SIZE OF QUOTA SYS ENTRY
MAXFS==9 ;MAXIMUM NUMBER OF FILE STRUCTURES PER JOB
AC1BLK==5 ;WORDS PER BLOCK IN AUXACC.SYS ENTRY
OPQPTB==16 ;GETTAB TABLE FOR OPQ PPN
OPQPIN==4 ;INDEX IN TABLE FOR OPQ PPN
ST.SRO==400000 ;SOFTWARE READ ONLY BIT IN STATUS BITS (FOR AUXACC)
ST.NCR==200000 ;NO CREATE BIT IN STATUS BITS
LF==12
MLON
DEFINE MSG (A) <
MOVEI M,[ASCIZ \A\]
PUSHJ P,MESSAG
>
;INDECES IN ACCT.SYS ENTRY
PPNWRD==0 ;PROJECT PROGRAMMER NUMBER
CODWRD==1 ;PASSWORD
PRVWRD==2 ;PRIVILEGE WORD
NM1WRD==3 ;1ST HALF USERS NAME
NM2WRD==4 ;2ND HALF USERS NAME
TIMWRD==5 ;TIMES MAY LOGIN
;PLCWRD==6 ;PLACE WORD UNTIL VERSION 3 ACCT.SYS FILES (UNUSED)
CORWRD==6 ;VIRTUAL CORE IN PAGES,,PHYSICAL CORE IN PAGES LIMIT
PROWRD==7 ;DEC USER PROFILE BITS
PR2WRD==10 ;CUSTOMER USER PROFILE BITS
CRNWRD==11 ;NAME OF CUSP TO RUN
CRDWRD==12 ;DEVICE FROM WHICH TO RUN CUSP
CRPWRD==13 ;DIRECTORY FROM WHICH TO RUN CUSP
CHGWRD==14 ;CHARGE NUMBER
XPDWRD==15 ;EXPIRATION DATE OF PASSWORD (LH OF WORD)
SIXWRD==15 ;RH OF WORD 15 CONTAINS NEW FIELDS FOR 6.02
;BITS IN RH OF DEC USER PROFILE WORD
P.PWBT==1 ;=1 IF PASSWORD REQUIRED FOR BATCH
P.PWTS==2 ;=1 IF PASSWORD REQUIRED FOR TIMESHARING
P.PWAL==P.PWBT!P.PWTS
P.NMBT==4 ;=1 IF NAME REQUIRED FOR BATCH
P.NMTS==10 ;=1 IF NAME REQUIREDPFOR TIMESHARING
P.NMAL==P.NMBT!P.NMTS
P.LGBT==20 ;=1 IF MAY LOGIN UNDER BATCH
P.LGBS==40 ;=1 IF MAY LOGIN AS SUBJOB UNDER BATCH JOB OVER PTY
P.LGRM==100 ;=1 IF MAY LOGIN AT REMOTE (HARDWIRED) TTY
P.LGDS==200 ;=1 IF MAY LOGIN OVER DATA SET TTY
P.LGRO==400 ;=1 IF MAY LOGIN AT REMOTE OPR OR CTY
P.LGLC==1000 ;=1 IF MAY LOGIN AT LOCAL TTY
P.LGNO==0 ;MAY LOGIN NOWHERE
P.LGAL==P.LGBT!P.LGBS!P.LGRM!P.LGDS!P.LGRO!P.LGLC
;NOTE THAT CTY AND OPR MAY ALWAYS LOGIN
;BITS IN LH OF DEC USER PROFILE WORD
P.WDAY==400000 ;WATCH BIT - DAY ARG
P.WRUN==200000 ;WATCH BIT - RUN ARG
P.WWAT==100000 ;WATCH BIT - WAIT ARG
P.WRED==40000 ;WATCH BIT - READ ARG
P.WWRT==20000 ;WATCH BIT - WRITE ARG
;NOTE THE NEXT BITS ARE DISJOINT FROM PREVIOUS ONES
P.WVER==200 ;WATCH BIT - VERSION NUMBER
P.WMTA==100 ;WATCH BIT - MAGTAPE
P.WNON==0 ;NO BITS
P.WALL==P.WDAY!P.WRUN!P.WWAT!P.WRED!P.WWRT!P.WVER!P.WMTA
P.SPCR==10000 ;=1 IF SPOOL CDR
P.SPCP==4000 ;=1 IF SPOOL CDP
P.SPTP==2000 ;=1 IF SPOOL PTP
P.SPPL==1000 ;=1 IF SPOOL PLT
P.SPLP==400 ;=1 IF SPOOL LPT
;NOTE: BITS 200 AND 100 ARE USED BY WATCH BITS!!!!
P.SPNO==0 ;NO DEVICES
P.SPAL==P.SPCR!P.SPLP!P.SPCP!P.SPTP!P.SPPL
SUBTTL STARTUP
INTERNAL REACT
REACT: CALLI 0 ;INITIALIZE
SETZM UPDF ;START WITH A BLANK HISTORY
MOVEI A,RST ;SETUP A REENTRY WHICH SAVES TABLE
MOVEM A,.JBREN
MOVE P,PDP ;SETUP PUSHDOWN
MOVE A,[XWD OPQPIN,OPQPTB]
CALLI A,GETTAB ;GET OPQPPN
JRST .+2 ;NOT THERE
MOVEM A,OPQPPN
MOVE A,[XWD STATES,CNFTBL] ;INDEX FOR STATES WORD
CALLI A,GETTAB ;GET STATES WORD
SETZ A,
MOVE B,[XWD 1,1] ;LEVEL C DEFAULT SYS PPN
TLNE A,LEVDF ;SKIP IF LEVEL C
MOVE B,[XWD 1,4] ;LEVEL D DEFAULT SYS PPN
MOVSI A,(SIXBIT .SYS.)
DEVPPN A, ;FIND OUT SYS PPN
MOVE A,B ;CANT, USE DEFAULT
MOVEM A,SYSPPN ;SAVE FOR LATER
PUSHJ P,CLRTAB ;ZERO THE PROJ-PROG TABLE
SETZ F, ;CLEAR ALL FLAGS
RST: MOVEI M,SMSG ;STARTING MESSAGE "FOR HELP..."
ANDI F,STRF+ACC1F+QUOTF ;KEEP ONLY FILE TYPE
PUSHJ P,TTYGET
AOSG HELPFM ;SKIP IF ALREADY TYPED THE MESSAGE
PUSHJ P,MESSAG ;OUTPUT THE MESSAGE
RELEASE TTYFIL, ;PREVENT LOSS DUE TO RESET
EOC: MOVE P,PDP ;RESET PUSHDOWN LIST POINTER
CLOSE TTYFIL, ;GET REMAINING TYPE OUT
SKIPN UPDF ;UPDATING FILE AND FILE STILL OPEN
RESET ;NO RESET THE BUFFER WORLD
PUSHJ P,TTYGET
MOVEI M,STARMS ;SAY "*"
PUSHJ P,MESSAG
TRZ F,AUXF+AUXF2 ;INITIALIZE FOR NEW COMMAND
SETZM CLR ;CLEAR THE TEMPORARIES FOR A COMMAND
MOVE A,[XWD CLR,CLR+1]
BLT A,CLREND-1
SUBTTL COMMAND SCANNER
TYI: PUSHJ P,TTI ;GET A CHARACTER
CAIG CH,40
JRST EOC ;NULL COMMAND
MOVSI BP,-NCOMM ;AND LOOK IT UP IN COMMAND TABLE
CRLOOP: HLRZ A,CTAB(BP) ;THE CHARACTER
HRRZ B,CTAB(BP) ;AND ITS ADDRESS
CAMN A,CH
JRST 0(B) ;DISPATCH TO THE COMMAND
AOBJN BP,CRLOOP
COMERR: JSP M,RC2 ;NOT FOUND IN TABLE. COMPLAIN
ASCIZ /%NOT A VALID COMMAND
/
DEFINE CTM(A)<IRP A,< XWD "A",A'COM>>
;THE COMMAND TABLE
CTAB: CTM <A,C,D,E,H,I,K,L,P,Q,R,S,T,U,W,Z>
NCOMM=.-CTAB
;CLRTAB IS CALLED DURING START UP,Z COMMAND AND R COOMAND
;(AAL FLAVOURS). THIS CODE FREES UP UPDF WHEN SET
CLRTAB: SKIPN UPDF ;UPDATING IN EFFECT?
JRST CLRTA0 ;NOPE ALL SET
RELEAS INFIL, ;(YES) RELEASE THE CHANNEL
SETZM UPDF ;ZAP THE INTERLOCK
CLRTA0: SETZM CODTAB ;THIS ROUTINE CLEARS ALL PROJ-PROGS
SETZM CURNAM ;CLEAR REMEMBERED INPUT FILE NAME
SETZM CUREXT ;AND EXIT TO GUARD AGAINST CLOBBERING IT
MOVE A,[XWD CODTAB,CODTAB+1]
BLT A,CODEND-1
POPJ P,0
TTYGET: INIT TTYFIL,0 ;SETUP THE TTY
SIXBIT /TTY/
XWD TYOB,TYIB
ECOM: CALLI 12 ;THAT SHOULDNT HAPPEN
POPJ P,0
SUBTTL HELP TEXT
SALL
HELPMS: ASCIZ \
COMMANDS ARE TYPED AS A LETTER, OPTIONALLY A SPACE AND SOME
ARGUMENTS, AND A CARRIAGE RETURN. ARGUMENTS N,PROJ
AND PROG ARE OCTAL NUMBERS UP TO 377777. THE COMMANDS ARE:
H ;PRINTS THIS TEXT
R DEV:FILE.EXT[PROJ,PROG] ;READ ACCOUNTING FILE (ACCT.SYS)
A DEV:FILE.EXT[PROJ,PROG] ;READ AUXILLIARY ACCOUNTING FILE
; (AUXACC.SYS)
Q DEV:FILE.EXT[PROJ,PROG] ;READ QUOTA FILE (QUOTA.SYS -
; PRIVATE FILE STRUCTURES ONLY)
S DEV:FILE.EXT[PROJ,PROG] ;READ FILE STRUCTRURE LIST FILE
; (STRLST.SYS)
W DEV:FILE.EXT[PROJ,PROG] ;WRITE NEW FILE PROTECTED
U DEV:FILE.EXT[PROJ,PROG] ;UNPROTECTED WRITE, AS ABOVE
L DEV:FILE.EXT ;LIST ALL PEOPLE ON DEV
L DEV:FILE.EXT,N,N ;LIST A PARTICULAR ENTRY'S CODE
L DEV:FILE.EXT,*,N ;LIST ALL OF A PROGRAMMER'S ENTRIES
L DEV:FILE.EXT,N,* ;LIST ALL OF A PROJECT'S ENTRIES
L DEV:FILE.EXT,NAME ;LIST A FILE STRUCTURE (STRLST)
T N,N ;LIKE L, BUT ON TTY
T NAME ;FOR STR IN STRLST
I PROJ,PROG ;INSERT OR CHANGE AN ENTRY
; REACT WILL ASK FOR CODE, NAME, ETC.
; INSERTING AN AUXACC ENTRY, STATUS BITS INCLUDE
; R OR 400000000000 FOR (SOFTWARE) READ ONLY FOR THIS STR
; W OR 0 FOR WRITE ENABLE
; N OR 200000000000 FOR NO CREATE FOR THIS STR
; R OR 0 FOR CREATE
; USE LETTERS ONLY OR TYPE IN THE WORD IN OCTAL
I NAME ;INSERT FILE STRUCTURE IN STRLST
I PROJ,PROG=P1,P2 ;COPIES ENTRY FOR P1,P2 INTO PROJ,PROG
K PROJ,PROG ;DELETE AN ENTRY
K NAME ;DELETE A FILE STR ENTRY FROM STRLST
C PROJ,PROG ;CHANGE PART OF AN ENTRY
C NAME ;CHANGE PART OF AN STRLST ENTRY
P ;PURGE EXPIRED PROJ,PROG'S FROM FILE
Z ;ZERO OUT BUFFER COMPLETELY
D ;DEFINE DEFAULTS (ONLY CORE NOW)
E ;EXIT
SPECIAL CHARACTERS FOR PPNS:
* WILD CARD FOR ALL ENTRIES
# CREATE UNIQUE PPN AT LOGIN
% DEFAULT ENTRY IF USER'S ENTRY NOT FOUND
\
HCOM: MOVEI M,HELPMS
PUSHJ P,MESSAG
JRST EOC
SUBTTL PROCESS READ COMMANDS
SCOM: TRZ F,ACC1F+QUOTF+OLDF
TRO F,STRF
MOVE WD,[SIXBIT .STRLST.] ;DEFAULT FILE NAME
MOVEI C,STRFOR
JRST RCOM1
ACOM: TRZ F,STRF+QUOTF+OLDF
TRO F,ACC1F
MOVE WD,[SIXBIT .AUXACC.] ;DEFAULT FILE NAME
MOVEI C,AC1FOR
JRST RCOM1
QCOM: TRZ F,STRF+ACC1F+OLDF
TRO F,QUOTF
MOVE WD,[SIXBIT .QUOTA.] ;DEFAULT FILE NAME
MOVEI C,QUOFOR
JRST RCOM1
RCOM: TRZ F,STRF+ACC1F+QUOTF+OLDF
MOVE WD,[SIXBIT .ACCT.] ;DEFAULT FILE NAME
MOVEI C,ACCFOR
RCOM1: MOVEM C,CURVER ;REMEMBER THE CURRENT VERSION
PUSHJ P,CLRTAB ;HERE ON A READ COMMAND. WIPE OLD DATA.
MOVEM WD,CURNAM ;SET DEFAULT FILE NAME
MOVSI WD,(SIXBIT .SYS.)
MOVEM WD,EXT ;AND SYS AS DEFAULT EXT
PUSHJ P,FILSPC ;WHERE TO READ
CAIL CH,40
JRST FILERR
SKIPN A,DEV
MOVSI A,(SIXBIT .SYS.)
MOVEM A,RC1 ;REMEMBER THE INPUT DEVICE
MOVEM A,B ;COPY FOR OPEN OPERATOR
MOVEI N,DIB ;INPUT SIDE
CALLI A,DEVCHR ;WHAT IS THE DEVICE?
TLNE A,DV.DSK ;IS DEVICE A DISK
SETOM UPDF ;(YES) REMEMBER UPDATE MODE
SKIPE UPDF ;IF A DISK THEN
HRLI N,DUO ;GET DUMMY OUT FOR UPDATE MODE
RCOM2: MOVEI A,14 ;OPEN IN BINARY
OPEN INFIL,A ;OPEN THE DEVICE
JRST RERR1 ;NO SUCH DEVICE
SKIPN A,FILE ;SKIP IF FILE SPECIFIED
MOVE A,CURNAM ;USE DEFAULT NAME
MOVEM A,CURNAM ;SAVE CURRENT FILE OPEN
MOVEM A,NAME1 ;**[12] NAME TO LOOK UP
HLLZ B,EXT
MOVEM B,NAME2 ;**[12]EXTENSION OF FILE
MOVEM B,CUREXT ;AND CURRENT EXT
HRLZ X,PROJ ;PROJECT SPECIFIED
HRR X,PROG ;PROGRAMMER SPECIFIED
JUMPN X,HAVPPN ;JUMP IF SOMETHING WAS SPECIFIED
;[137] MOVSI N,(SIXBIT .SYS.)
;[137] CAMN N,RC1 ;NO, SKIP IF DEVICE IS NOT SYS
HLRZ N,RC1 ;[137] SKIP IF DEVICE IS NOT SOME KIND
CAIN N,(SIXBIT .SYS.);[137] SYS (SYSA, SYSB, ETC.)
MOVE X,SYSPPN ;FOR SYS OR QUOTA FILE DEFAULT IS SYS PPN
HAVPPN: MOVEM X,SAVPPN ;SAVE PPN
MOVEM X,NAME0 ;PPN PART OF BLOCK
SETZB C,NAME3 ;**[12] ZAP THESE WORDS
SETZM NAME4 ;**[12] THEY WILL BE FILLED ARE UNUSED!!
SKIPE UPDF ;SKIP IF NON DISK FILE
JRST LKPDSK ;**[13]0YES DO LONG LOOKUP
LOOKUP INFIL,A ;**[13] DO A SHORT LOOKUP
JRST RERR ;**[13] YOU BLEW IT
JRST LKP1 ;**[13] ALL IS OKAY DO NOT UPDATE
LKPDSK: LOOKUP INFIL,NAME ;**[12] GET THE FILE SPECIFIED
JRST RERR ;AT ISNT THERE. GO SEE WHY.
;HAVPPN+4 ADDED 3 INSTRUCTIONS [4] SPR#10-10015
CALLI A,GETPPN ;[17] GET OUR PPN
JFCL ;[17]
MOVE X,SAVPPN ;[4] ENTER FILE TO PREVENT
CAME X,NAME0 ;**[12] FOUND IN THE RIGHT PLACE
CAMN A,NAME0 ;[17] IS IT OURS
SKIPA ;[17] ALL IS OKAY
JRST WRNDIF ;**[12] WARN THE USER
ENTER INFIL,NAME ;[4]**[12] MORE THAN ONE SUPERSEDING
JRST WERR ;[4] JOB AT A TIME
LKP1: SETZM LASTPK ;CLEAR INDEX TO PACKS TABLE
MOVSI A,-NPAIRS
SUBTTL READ ACCT OR QUOTA FILE
PUSHJ P,READ
JRST RCE ;EOF - EMPTY FILE
HRRE B,CH ;B=SIZE OF ENTRIES
HLRZS CH ;FORMAT VERSION NUMBER FROM FILE
CAME CH,CURVER ;COMPARE WITH CURRENT TYPE
TRO F,OLDF ;CHECK FOR PREVIOUS TYPE
CAMG CH,CURVER ;SKIP IF NOT PREVIOUS TYPE
JRST RC3
MSG <?FILE IS NOT CURRENT OR PREVIOUS FORMATS>
JRST RCE
RC3: TRNE F,STRF ;SEE IF WE READ STRLST
JRST SCL ;YES
TRNE F,ACC1F ;NO SKIP IF AUXACC.SYS
JRST ACL
JUMPLE B,FMTERR ;COUNT MUST BE PLUS
CAILE B,MAXENT ;AND REASONABLY SIZED
JRST FMTERR
MOVEM B,ENTSIZ ;SAVE SIZE OF AN ENTRY
HRRZ B,ROLDTB(CH) ;GET ADDR OF CONVERSION ROUTINE FOR THIS TYPE
IFG QUOFOR,<
TRNE F,QUOTF ;WHEN QUOTA.SYS NEEDS CONVERSION,
HRRZ B,QOLDTB(CH) ;CONVERT THAT INSTEAD IF Q
>
MOVEM B,ROLD ;AND SAVE
RCL: PUSHJ P,READBK ;READ A BLOCK OF DATA ( PPN)
JRST RCE ;NON-SKIP MARKS THE END OF TABLE
MOVE B,ENTRY+PPNWRD ;GET PPN
CAMN B,OPQPPN
JRST RCL ;OR OPQPPN
HRROI B,ENTRY-1
ADD B,ENTSIZ
MOVN C,ENTSIZ
TRNE F,OLDF
PUSHJ P,@ROLD ;CONVERT OLD FORM TO NEW
JRST POPLST(C)
POP B,XPDTAB(A)
POP B,CHGTAB(A)
POP B,CRPTAB(A)
POP B,CRDTAB(A)
POP B,CRNTAB(A)
POP B,PR2TAB(A)
POP B,PROTAB(A)
POP B,CORTAB(A)
POP B,TIMTAB(A)
POP B,NAMTB2(A)
POP B,NAMTB1(A)
POP B,PRVTAB(A)
POP B,CODTAB(A)
POP B,PPTAB(A)
POPLST=.
AOBJN A,RCL ;LOOP FOR MORE
OVFR: RELEASE INFIL, ;RELEASE INPUT DEVICE FOR OVERFLOW
OVF: MOVEI M,OVFMSG ;THE TABLE HAS BEEN OVERFLOWN
RC2: TRZ F,AUXF+AUXF2
PUSHJ P,MESSAG ;THIS IS A COMMON ENTRY FOR ERRORS
JRST EOC ;RESTART WITH *
;SAME CODE FOR QUOTA FILE.
;PPN GOES IN PPTAB
;RESERVED QUOTA GOES IN CODTAB
;FCFS QUOTA GOES IN PRVTAB
;QUOTA OUT GOES IN NAMTB1
SUBTTL CONVERT OLD ACCT FILE ENTRY TO NEW
;LIST OF ROUTINES TO CONVERT OLD ACCT.SYS FORMS TO CURRENT FORMAT
;INDEXED BY FORMAT VERSION NUMBER
ROLDTB: ROLD0
ROLD1
ROLD2 ;CONVERT TO VERSION 3
ROLD3 ;CONVERT TO VERSION 4
;SUBROUTINE TO CONVERT OLD ACCT.SYS ENTRY TO NEW
;THIS ROUTINE CONVERTS FORMAT TYPE 0 TO TYPE 1
ROLD0: MOVN X,C ;X=+SIZE OF ENTRY
CAIGE X,4 ;IF SIZE LE 3 EXIT
JRST ROLD0X
SUBI B,1
CAIN X,4
AOJA C,ROLD0X ;IF SIZE=4, MAKE C -3 AND EXIT
MOVE M,[XWD ENTRY+4,ENTRY+3]
BLT M,ENTRY-2(X)
AOJA C,ROLD0X
;SUBROUTINE TO CONVERT FORMAT TYPE 1 TO FORMAT TYPE 2
ROLD0X:
ROLD1: MOVN X,C ;X=+SIZE OF ENTRY
SETZM ENTRY(X) ;CLEAR ALL NEW ENTRIES
HRLZI C,ENTRY(X)
HRRI C,ENTRY+1(X)
BLT C,ENTRY+ENTSTD-1
MOVE B,ENTRY+PPNWRD ;PICK UP PPN
MOVE C,STDPRO ;STANDARD PROFILE
TRNE B,-10 ;SKIP IF PROGRAMMER LT 10
TLNN B,-10 ;SKIP IF PROJECT GE 10
TRZ C,P.LGRM!P.LGDS ;FOR PROJ OR PROG LT 10 NO REMOTE OR DATA SET
MOVEM C,ENTRY+PROWRD
MOVEI C,STDXPD ;STANDARD EXPIRATION DATE
HRLM C,ENTRY+XPDWRD
ROLD2: MOVSI C,P.WMTA ;MAGTAPE WATCH BIT
IORM C,ENTRY+PROWRD ;SET THE WATCH MTA BIT AS A DEFAULT
MOVE C,DEFPAG ;GET DEFAULTS FOR CORE
MOVEM C,ENTRY+CORWRD ;AND STORE IT IN THE TABLE
HRROI B,ENTRY+ENTSTD-1
ROLD3: HRRZ C, SIXDEF ;[147] SET DEFAULT ENQ/DEQ QUOTA
HRRM C, ENTRY+SIXWRD ;[147] AND SCHEDULER TYPE
MOVNI C, ENTSTD ;[147] FIX UP C,
RETURN ;[146] AND POP BACK
SUBTTL READ STRLST FILE
SCL: PUSHJ P,READ ;READ SIZE OF ENTRY=NUMBER OF WORDS THAT FOLLOW
JRST RCE ;EOF - ALL DONE
JUMPE CH,SCL ;IGNORE ZEROS
JUMPL CH,FMTERR ;MUST BE POSITIVE
MOVEM CH,ENTSIZ
SUBI CH,4 ;COMPUTE NUMBER OF UNITS=(N-4)/2
LSH CH,-1 ;DIVIDE BY 2
MOVE B,LASTPK
HRL CH,B ;LH=INDEX OF ENTRY IN TABLES
MOVEM CH,PRVTAB(A) ;RH=NUMBER OF UNITS
PUSHJ P,READBK ;READ THE REST OF THE ENTRY
JRST RCE
HRROI B,ENTRY+3
POP B,NAMTB2(A) ;SECOND HALF OF NAME OF OWNER
POP B,NAMTB1(A) ;FIRST HALF OF NAME OF OWNER
POP B,PPTAB(A) ;PPN OF OWNER
POP B,CODTAB(A) ;FILE STRUCTURE NAME
MOVE B,LASTPK
MOVEI C,4
SCL1: HRROI N,ENTRY+1(C)
POP N,TIMTAB(B) ;TYPE WORD
POP N,DSKTAB(B) ;UNIT ID
ADDI C,2
AOS B,LASTPK ;BUMP INDEX TO TABLES
CAIL B,NPAIRS ;CHECK FOR OVERFLOW
JRST OVFR
CAMGE C,ENTSIZ
JRST SCL1 ;LOOP FOR ALL UNITS THIS ENTRY
AOBJN A,SCL ;LOOP FOR ALL ENTRIES
JRST OVFR ;OVERFLOW
SUBTTL READ AUXACC FILE
ACL: PUSHJ P,READ ;READ FIRST WORD
JRST RCE ;EOF - ALL DONE
JUMPE CH,ACL
CAME CH,[-1] ;SHOULD BE -1, WHICH MARKS START OF ENTRY
JRST FMTERR
PUSHJ P,READ ;READ SIZE OF THIS ENTRY=WORDS THAT FOLLOW
JRST RCE
JUMPLE CH,FMTERR
MOVEM CH,ENTSIZ
MOVEI C,-1(CH)
IDIVI C,AC1BLK ;RH=NUMBER OF STRS=(N-1)/AC1BLK
MOVE B,LASTPK
HRL C,B ;LH=INDEX TO TABLES
MOVEM C,PRVTAB(A)
PUSHJ P,READBK ;READ THE REST OF THE ENTRY
JRST RCE
MOVE C,ENTRY+PPNWRD ;PPN
MOVEM C,PPTAB(A)
HRRZ C,PRVTAB(A)
JUMPE C,ACL2 ;JUMP IF NO STRS IN ENTRY
MOVEI C,1
ACL1: HRROI N,ENTRY+4(C)
POP N,DSKTAB(B) ;STATUS BITS
POP N,TIMTAB(B) ;QUOTA OUT
POP N,NAMTB2(B) ;FIRST COME, FIRST SERVED QUOTA
POP N,NAMTB1(B) ;RESERVED QUOTA
POP N,CODTAB(B) ;STR NAME
ADDI C,AC1BLK
AOS B,LASTPK ;BUMP INDEX TO TABLES
CAIL B,NPAIRS ;CHECK FOR OVERFLOW
JRST OVFR
CAMGE C,ENTSIZ
JRST ACL1 ;LOOP FOR ALL FILE STRS THIS ENTRY
ACL2: AOBJN A,ACL ;LOOP FOR ALL ENTRIES
JRST OVFR
SUBTTL READ ERRORS
RERR: PUSHJ P,CK11 ;GO DECIPHER LOOKUP FAILURE
JSP M,RC2 ;AND COMPLAIN, THEN RESTART
ASCIZ /?CAN'T READ THAT FILE
/
OVFMSG: ASCIZ /?TABLE OVERFLOW
/
;RCE CHANGED ROUTINE [154] TO REPORT ACTUAL COUNT OF ENTRIES AND
;MAXIMUM ALLOWED (NPAIRS).
RCE: MSG (<[>) ;START MESSAGE
HRRZS A ;ISOLATE ACTUAL NUMBER OF ENTRIES
TDNE A,1 ;IF FILE IS EMPTY, NO HEADER WORD WAS READ
SOJ A, ;HEADER WORD WAS COUNTED...SUBTRACT IT
CALL DECPNT ; AND PRINT IT
MSG < OUT OF >
MOVEI A,NPAIRS ;GET MAXIMUM ENTRIES ALLOWED
CALL DECPNT ;AND PRINT IT
MSG < ENTRIES ARE USED]
>
JRST EOC
FMTERR: JSP M,RC2
ASCIZ /?FORMAT BAD ON INPUT FILE
/
SUBTTL READ SUBROUTINES
READ: SOSLE DIB+2 ;A STANDARD READ ROUTINE
JRST RDOK
INPUT INFIL,0
STATZ INFIL,740000
JRST RDERR
STATZ INFIL,20000 ;EOF?
POPJ P,0 ;YES. NON-SKIP
RDOK: ILDB CH,DIB+1
CPOPJ1: AOS 0(P) ;SKIP RETURN ON NON-EOF
POPJ P,0
RDERR: JSP M,RC2 ;COMPLAIN OF READ ERROR
ASCIZ /?READ ERROR
/
RERR1: JSP M,RC2 ;ANOTHER ERROR MESSAGE
ASCIZ /?DEVICE NOT AVAILABLE/
READBK: MOVEI C,1
READB1: PUSHJ P,READ
POPJ P,0 ;EOF
MOVEM CH,ENTRY-1(C)
CAMGE C,ENTSIZ
AOJA C,READB1
JRST CPOPJ1
SUBTTL PROCESS WRITE COMMANDS
UCOM: TROA F,PROTF ;MARK UNPROTECTED WRITE
WCOM: TRZ F,PROTF ;ORDINARY (IE, READ PROTECTED) WRITE
SKIPE RC1 ;SKIP IF NO DEVICE WAS READ
JRST WCOM1 ;OK
SKIPN CURNAM ;IF NO DEVICE, SKIP IF A FILE WAS READ
JRST NOREDM ;NO, NO FILE WAS READ, ERROR
WCOM1: TRNE F,STRF
JRST .+3
SKIPN PPTAB
JRST EMPMSG ;COMPLAIN IF TABLE EMPTY
MOVE WD,CUREXT ;AND CURRENT EXT
MOVEM WD,EXT
PUSHJ P,FILSPC
CAIL CH,40
JRST FILERR
SKIPN A,DEV
MOVE A,RC1 ;DEFAULT IS INPUT DEVICE
MOVEM A,WC1
;WCOM1+14 INSERTED 1 INSTRUCTION [4] SPR#10-10015
SKIPE UPDF ;NO RELEASE IF NON DISK FILE
RELEAS INFIL,0 ;[4] ALLOW OPENING ON ANOTHER CHAN
SETZM UPDF ;FREE THE UPDATE CHANNEL
INIT OUTFIL,14 ;SETUP THE OUTPUT DEVICE
WC1: 0 ;FILLED IN FROM JUST ABOVE HERE
XWD DOB,0
JRST WERR ;GO COMPLAIN CANT GET DEVICE
SKIPN A,FILE ;SKIP IF FILE SPECIFIED
MOVE A,CURNAM ;CURRENT NAME IS DEFAULT
MOVEM A,FILE ;SAVE FILE NAME FOR RENAME FOR W
HLLZ B,EXT
MOVEI N,0
HRLZ X,PROJ
HRR X,PROG
SKIPN X ;SKIP IF PPN SPECIFIED
MOVE X,SAVPPN ;NO, USE SAME PPN AS READ
ENTER OUTFIL,A ;PUT FILE IN DIRECTORY OF DEVICE
JRST WERR ;CANT DO IT. COMPLAIN
MOVE CH,[XWD ACCFOR,ENTSTD]
TRNE F,QUOTF
MOVE CH,[XWD QUOFOR,QENSTD] ;MAY BE DIFFERENT IF QUOTA FILE
TRNE F,STRF
HRLZI CH,STRFOR
TRNE F,ACC1F
HRLZI CH,AC1FOR
PUSHJ P,WRITE
TRNE F,STRF
JRST SWCON
TRNE F,ACC1F
JRST AWCON
MOVSI A,-NPAIRS ;COUNT THROUGH TABLE
SUBTTL WRITE ACCT OR QUOTA FILE
WCL: MOVE CH,PPTAB(A)
PUSHJ P,WRITE ;OUTPUT THE PROJ-PROG
MOVE CH,CODTAB(A)
PUSHJ P,WRITE ;OUTPUT THE CODE
MOVE CH,PRVTAB(A)
PUSHJ P,WRITE
MOVE CH,NAMTB1(A)
PUSHJ P,WRITE
TRNE F,QUOTF
JRST WCA ;STOP NOW IF QUOTA FILE
MOVE CH,NAMTB2(A)
PUSHJ P,WRITE
MOVE CH,TIMTAB(A)
PUSHJ P,WRITE
MOVE CH,CORTAB(A)
PUSHJ P,WRITE
MOVE CH,PROTAB(A)
PUSHJ P,WRITE
MOVE CH,PR2TAB(A)
PUSHJ P,WRITE
MOVE CH,CRNTAB(A)
PUSHJ P,WRITE
MOVE CH,CRDTAB(A)
PUSHJ P,WRITE
MOVE CH,CRPTAB(A)
PUSHJ P,WRITE
MOVE CH,CHGTAB(A)
PUSHJ P,WRITE
MOVE CH,XPDTAB(A)
PUSHJ P,WRITE
WCA: SKIPE PPTAB(A) ;WAS THIS THE END?
AOBJN A,WCL ;LOOP FOR MORE
WCE: CLOSE OUTFIL,0 ;DONE WITH FILE
STATZ OUTFIL,740000
JRST WRERR ;IT LOST SOMEHOW. COMPLAIN
MOVE A,FILE
HLLZ B,EXT
HRLZ X,PROJ
HRR X,PROG
SKIPN X ;SKIP IF PPN SPECIFIED
MOVE X,SAVPPN ;NO, USE PPN READ
MOVSI N,WACCOD ;ACCESS CODE FOR PROTECTED WRITE
TRZN F,PROTF ;UNLESS A U COMMAND,
RENAME OUTFIL,A ; DO THE RENAME
JFCL
STATZ OUTFIL,740000 ;AND SEE IF THAT WORKED
JRST WRERR ;NOPE. COMPLAIN
RELEAS OUTFIL,0 ;DONE AT LAST
JRST EOC ;GO FOR NEXT COMMAND IF ANY
SUBTTL WRITE STRLST FILE
SWCON: MOVSI A,-NPAIRS ;GET READY FOR ALL ENTRIES
SWCL: SKIPN B,CODTAB(A)
JRST SW1 ;NO ENTRY HERE
MOVE N,PRVTAB(A)
MOVEI CH,4(N)
ADDI CH,(N) ;SIZE OF ENTRY=4+2*NO OF UNITS
PUSHJ P,WRITE ;OUTPUT IT
MOVE CH,B ;FILE STRUCTURE NAME
PUSHJ P,WRITE
MOVE CH,PPTAB(A) ;OWNER'S PPN
PUSHJ P,WRITE
MOVE CH,NAMTB1(A) ;FIRST HALF OF OWNER'S NAME
PUSHJ P,WRITE
MOVE CH,NAMTB2(A) ;SECOND HALF OF OWNER'S NAME
PUSHJ P,WRITE
HLRZ B,N
HRRZ N,N
SW2: MOVE CH,DSKTAB(B) ;NEXT UNIT ID
PUSHJ P,WRITE
MOVE CH,TIMTAB(B) ;NEXT TYPE WORD
PUSHJ P,WRITE
AOS B
SOJG N,SW2 ;LOOP FOR ALL UNITS THIS ENTRY
SW1: AOBJN A,SWCL ;LOOP FOR ALL ENTRIES
JRST WCE
SUBTTL WRITE AUXACC FILE
AWCON: MOVSI A,-NPAIRS ;GET READY FOR ALL ENTRIES
AWCL: SKIPN B,PPTAB(A) ;SKIP IF MORE ENTRIES TO DO
JRST WCE
SETO CH, ;SET TO -1
PUSHJ P,WRITE ;-1 MARKS BEGINNING OF ENTRY (NEEDED BY LOGIN)
HRRZ N,PRVTAB(A) ;NUMBER OF FILE STRUCTURES
IMULI N,AC1BLK
MOVEI CH,1(N) ;SIZE OF ENTRY=AC1BLK*NO OF STRS+1
PUSHJ P,WRITE
MOVE CH,B ;PPN
PUSHJ P,WRITE
HLRZ B,PRVTAB(A) ;FIRST INDEX IN TABLES
HRRZ N,PRVTAB(A) ;NUMBER OF FILE STRUCTURES
JUMPE N,AW1 ;JUMP IF NO STRS IN ENTRY
AW2: MOVE CH,CODTAB(B) ;FILE STRUCTURE NAME
PUSHJ P,WRITE
MOVE CH,NAMTB1(B) ;RESERVED QUOTA
PUSHJ P,WRITE
MOVE CH,NAMTB2(B) ;FIRST COME, FIRST SERVED QUOTA
PUSHJ P,WRITE
MOVE CH,TIMTAB(B) ;QUOTA OUT
PUSHJ P,WRITE
MOVE CH,DSKTAB(B) ;STATUS BITS
PUSHJ P,WRITE
AOS B
SOJG N,AW2 ;LOOP FOR ALL FILE STRUCTURES THIS ENTRY
AW1: AOBJN A,AWCL ;LOOP FOR ALL ENTRIES
JRST WCE
SUBTTL WARNINGS
;THIS WARNING(WRNDIF) NOTES YOU THAT THE FILE BEING MODIFIED
;IS FOUND IN A PPN AREA WHICH DIFFERS FROM THE SPECIFIED ONE.
;E.G. SET NEW WITH SETSRC AND UPDATE ACCT.SYS
;THEN ACCT.SYS WILL BE FOUND ON 1,,4 BUT SYSPPN
;WILL BE 1,,5 CAUSING AN UPDATE ERROR TO HAPPEN
;SO: USE PPN WHERE FILE WAS FOUND AND WARN THE USER
WRNDIF: MSG <%WARNING: FILE WAS FOUND IN DIFFERENT DISK AREA
THE AREA IS: >
MOVE A,NAME0 ;GET THE PPN
CALL PRPPN ;PRINT THE PPN
MSG <
A LOOKUP WAS DONE FOR:>
MOVE A,RC1 ;GET DEVICE
CALL SIXBPS ;NO SPACES
MOVEI CH,":" ;DELIMITER FOR DEVICE
CALL TYO ;PRINT IT
MOVE A,NAME1 ;FILE NAME
CALL SIXBPS ;PRINT IIT
MOVEI CH,"." ;PRINT DELIMITING
CALL TYO ;PERIOD
HLLZ A,NAME2 ;GET EXTENSION
CALL SIXBPS ;PRINT IT
MOVE A,SAVPPN ;GET EXPECTED PPN
CALL PRPPN ;PRINT IT
MSG <
A RETRY WILL BE DONE USING DSK AS DEVICE NAME.
DO YOU WANT TO PROCEED? (Y OR N)>
CALL YESNO ;GET THE ANSWER
JRST DIFYES ;(YES) GO ON
RELEAS INFIL, ;(NO) FORGET THE FILE
SETZM UPDF ;FREE UPDATE FLAG
JRST EOC ;AND RETRY
DIFYES: MOVE A,NAME0 ;GET THE REAL PPN
HLRZM A,PROJ ;STORE PROJECT
HRRZM A,PROG ;AND PROGRAMMER
MOVSI B,(SIXBIT /DSK/) ;TAKE THE GENERIC NAME
MOVEM B,RC1 ;NO SYS PROBLEMS!!
RELEAS INFIL, ;RELEASE THE FILE
MOVE N,[DUO,,DIB] ;BUFFER HEADERS
JRST RCOM2 ;AND RETRY
SUBTTL WRITE ERRORS
WERR: PUSHJ P,CK11 ;DECIPHER WRITE FAILURE
JSP M,RC2 ;MAKE GENERAL COMPLAINT AND RESTART
ASCIZ /%CAN'T WRITE ON THAT FILE
/
WRITE: SOSLE DOB+2 ;A STANDARD WRITE ROUTINE
JRST WROK
OUTPUT OUTFIL,0
STATZ OUTFIL,740000
JRST WRERR
WROK: IDPB CH,DOB+1
POPJ P,0
;WRERR INSERTED 1 INSTRUCTION [6] SPR#10-10128
WRERR: RESET OUTFIL,0 ;[6] IF WRITE ERR DON'T CHANGE
JSP M,RC2 ;A STANDARD ERROR ROUTINE
ASCIZ /%WRITE ERROR
/
;THIS ROUTINE IS FOR HUMAN ENGINEERING
;IT TRIES TO MAKE AN INTELLIGENT COMMENT ABOUT AN ENTER OR
;LOOKUP FAILURE - SUCH AS READING SYS FROM PROJECT NOT 1,2
CK11: HRREI A,-1(A+1) ;GET THE FAILURE CODE
JUMPLE A,NSFM ;NO SUCH FILE
CAIE A,1
JRST FMODM ;FILE BEING MODIFIED
MOVEI M,PROTM ;OTHERWISE, PROTECTION FAILURE
PUSHJ P,MESSAG
MOVE A,RC1 ;TRY TO SEE WHY
HRLZ B,PROJ
HRR B,PROG
CAME A,[SIXBIT /SYS/] ;IF READING SYS, OR
CAMN B,[XWD 1,2] ;READING DSK: [1,2]
SKIPA ;YES
POPJ P,0 ;NO. GIVE UP
CALLI A,GETPPN ;SEE IF USER IS 1,2
CAMN A,[XWD 1,2]
POPJ P,0 ;HE IS. DONT COMPLAIN
MOVEI M,MSG11 ;HE ISNT 1,2. TELL HIM SO
JRST MESSAG ;TYPE, THEN POPJ.
;SOME ERROR MESSAGES
MSG11: ASCIZ /?YOU ARE NOT LOGGED IN AS 1,2
/
PROTM: ASCIZ /?PROTECTION FAILURE
/
NSFM: JSP M,RC2
ASCIZ /?NO SUCH FILE
/
FMODM: JSP M,RC2
ASCIZ /?FILE CURRENTLY BEING MODIFIED BY ANOTHER JOB/
NOREDM: JSP M,RC2
ASCIZ /%NO FILE WAS READ
/
SUBTTL PROCESS LIST/TYPE COMMANDS
LCOM: MOVSI WD,(SIXBIT .LST.)
MOVEM WD,EXT
PUSHJ P,FILSPC
TROA F,AUXF2 ;LIST ON A DEVICE
TCOM: TRZ F,AUXF2 ;LIST ON TTY
TRNE F,STRF
JRST SLCOM
SKIPN PPTAB ;LIST COMMAND ENTERS HERE
JRST EMPMSG ;COMPLAIN IF TABLE EMPTY
CAIL CH,40
PUSHJ P,PPNGET
TRNE F,ACC1F+QUOTF
JRST LC3 ;DONT CARE ABOUT CODES IF NOT ACCT SYS
TRZ F,LCODF
MSG <LIST CODES?>
PUSHJ P,YESNO
TRO F,LCODF
LC3: TRNE F,AUXF2
JRST LCPRT ;REQUEST FOR AUXILIARY LISTING DEVICE
PUSHJ P,CRLF ;TTY. TYPE CRLF
LC2: MOVSI X,-NPAIRS ;SET TO COUNT THROUGH TABLE
LLOOP: MOVE A,PPTAB(X) ;GET PROJPROG
JUMPE A,LEND ;IF ZERO, THATS ALL
HRLZ B,NUM1 ;GET REQUESTED PROJ
HRR B,NUM2 ;AND PROG
JUMPE B,LYES ;IF BOTH ZERO, LIST ALL
CAMN B,A ;LIST IF THIS WAS REQUESTED
JRST LYES
TLNE B,-1 ;IS PROJ REQUESTED ZERO?
JRST LC1 ;NO
CAIN B,0(A) ;YES. LIST IF PROGRAMMER MATCHES
JRST LYES ;YES.
LC1: MOVSS B ;SEE IF PROJECT MATCHES
MOVSS A
TLNE B,-1 ;WAS PROG REQUESTED ZERO?
JRST LCNO ;NO. THIS # DOESNT GET LISTED
CAIN B,0(A) ;CHECK THE PROJECT
JRST LYES ;MATCH
LCNO: AOBJN X,LLOOP ;COUNT THROUGH TABLE
LEND: TRZE F,AUXF ;END OF TABLE. AUX DEV?
RELEAS AUXFIL,0 ;RELEASE AUX DEV IF IN USE
JRST EOC ;NEXT COMMAND
ZCOM: PUSHJ P,CLRTAB ;ZERO TABLE COMMAND
JRST EOC
SUBTTL LIST/TYPE STRLST FILE
SLCOM: SETZM WD
CAIL CH,40
PUSHJ P,SIXAN ;SEE IF SPECIAL FILE STRUCTURE REQUESTED
MOVEM WD,NUM1
TRNE F,AUXF2 ;SKIP IF TTY IS OUTPUT DEVICE
JRST LCPRT ;AUXILLIARY DEVICE - GET READY
PUSHJ P,CRLF
SL1: MOVSI X,-NPAIRS ;STRLST.SYS
SL2: SKIPN A,CODTAB(X) ;NEXT FILE STRUCTURE NAME
JRST SLEND ;NONE HERE
SKIPE NUM1 ;IF NUM1=0, LIST ALL
CAMN A,NUM1 ;ELSE MUST BE THIS FILE STRUCTURE TO LIST
CAIA ;SKIP
JRST SLEND ;DONT DO THIS ONE
PUSHJ P,TSIXPT
HLRZ A,PPTAB(X) ;OWNER'S PROJECT
PUSHJ P,TOCTPT
HRRZ A,PPTAB(X) ;OWNER'S PROGRAMMER
PUSHJ P,TOCTPT
MOVE A,NAMTB1(X) ;FIRST HALF OF OWNER'S NAME
PUSHJ P,SIXBPT
MOVE A,NAMTB2(X) ;SECOND HALF OF OWNER'S NAME
PUSHJ P,TSIXPT
MOVN B,PRVTAB(X) ;LH=-NUMBER OF UNITS (AFTER SWAPPED)
HLL B,PRVTAB(X) ;RH=INDEX TO TABLES (AFTER SWAPPED)
MOVSS B
JRST SL4 ;SKIP TABS ON FIRST LINE
SL3: MOVEI A,5 ;TAB OVER TO LINE UP UNDER UNIT ID COLUMN
PUSHJ P,TAB
SOJG A,.-1
SL4: MOVE A,DSKTAB(B) ;NEXT UNIT ID
PUSHJ P,TSIXPT
LDB CH,CLSBYT ;CLASS OF PACK
PUSHJ P,RDXPT1
PUSHJ P,TAB
LDB CH,KONBYT ;KONTROLLER TYPE
MOVE A,KONTYP(CH)
PUSHJ P,TSIXPT
LDB CH,TYPBYT ;UNIT TYPE
PUSHJ P,RDXPT1
PUSHJ P,CRLF
AOBJN B,SL3 ;LOOP FOR ALL UNITS THIS ENTRY
PUSHJ P,CRLF ;EXTRA LINE
SLEND: AOBJN X,SL2 ;LOOP FOR ALL ENTRIES
JRST LEND
SUBTTL SETUP LISTING DEVICE
LCPRT: SKIPN N,DEV ;AUXILIARY DEVICE LISTING ROUTINES
MOVSI N,(SIXBIT /LPT/)
MOVEM N,LCP1
CALLI N,DEVCHR ;GET CHARACTERISTICS OF LISTING DEVICE
INIT AUXFIL,0 ;GET THE AUX DEVICE
LCP1: 0 ;FILLED IN FROM JUST ABOVE HERE
XWD AOB,0
JRST LCERR1 ;AUX DEV NOT AVAIL
SKIPN A,FILE ;SKIP IF FILE NAME SPECIFIED
MOVE A,CURNAM ;CURRENT NAME IS DEFAULT
HLLZ B,EXT
CAMN B,CUREXT ;SKIP IF NOT SAME EXT AS INPUT FILE
CAME A,CURNAM ;SKIP IF SAME NAME
JRST LCP2 ;OK, DIFFERENT FILE
TLNE N,DV.DIR ;SKIP IF NOT DIRECTORY DEVICE
JRST LCERR3 ;ABOUT TO OVERWRITE INPUT FILE, DONT ALLOW
LCP2: MOVEI N,0
HRLZ X,PROJ
HRR X,PROG
ENTER AUXFIL,A
JRST LCERR2 ;CANT ENTER. GO COMPLAIN
TRO F,AUXF
MOVEI M,HEADING ;FIND APPROPRIATE HEADING
TRNE F,STRF
MOVEI M,SHEADING
TRNE F,ACC1F
MOVEI M,AHEADING
TRNE F,QUOTF
MOVEI M,QHEADING
PUSHJ P,AUXMSG ;A HEADING FOR BEAUTY
TRNE F,STRF
JRST SL1
JRST LC2
LCERR1: JSP M,RC2
ASCIZ /?LISTING DEVICE NOT AVAILABLE
/
LCERR2: JSP M,RC2
ASCIZ /?CAN'T ENTER LISTING FILE
/
LCERR3: JSP M,RC2
ASCIZ /%PLEASE DONT OVERWRITE THE INPUT FILE
/
SUBTTL LIST/TYPE ACCT FILE
AUXMSG: HRLI M,440700 ;SOME I/O FOR AUXILIARY DEVICE
AUXML: ILDB CH,M
JUMPE CH,CPOPJ
PUSHJ P,AUXTYO
JRST AUXML
AUXTYO: SOSG AOB+2
OUTPUT AUXFIL,0
IDPB CH,AOB+1
POPJ P,0
;HERE TO OUTPUT A LISTING ITEM
LYES: HLRZ A,PPTAB(X)
PUSHJ P,TOCTPT ;PRINT THE PROJECT
HRRZ A,PPTAB(X)
PUSHJ P,TOCTPT ;THE PROGRAMMER
TRNE F,QUOTF
JRST QYES1
TRNE F,ACC1F
JRST AYES1
MOVE A,NAMTB1(X)
PUSHJ P,SIXBPT
MOVE A,NAMTB2(X)
PUSHJ P,SIXBPT
PUSHJ P,TAB
MOVE A,PRVTAB(X)
PUSHJ P,OCT12
PUSHJ P,TAB
MOVE A,CODTAB(X)
TRNN F,LCODF
MOVEI A,0
PUSHJ P,SIXBPT
PUSHJ P,TAB
MOVE A,TIMTAB(X)
PUSHJ P,OCT12
PUSHJ P,CRLF ;LINE IS NOW SO BIG TAKES 2 LINES
PUSHJ P,TAB
LDB A,[POINT 9,CORTAB(X),8] ;GET PHYS # OF PAGES
CALL DECPNT ;PRINT AMOUNT IN DECIMAL
CALL COMMA ;PRINT A COMMA
CALL COMMA ;AND ANOTHER ONE
LDB A,[POINT 9,CORTAB(X),17] ;GET VIRTUAL # OF PAGES
CALL DECPNT ;AND PRINT IT IN DECIMAL
CALL SPACE ;MAKE SOME ROOM
LDB A,[POINT 9,CORTAB(X),26] ;GET SEND QUOTA
CALL DECPNT ;PRINT IT DECIMAL
CALL COMMA ;SEPERATE
CALL COMMA ;SEPERATE
LDB A,[POINT 9,CORTAB(X),35] ;GET RECEIVE QUOTA
CALL DECPNT ;AND PRINT IT
PUSHJ P,TSIXPT
MOVE A,PROTAB(X)
PUSHJ P,OCT12
PUSHJ P,TAB
SKIPN A,CRDTAB(X)
JRST NOLCRD
PUSHJ P,SIXBPS
MOVEI CH,":"
PUSHJ P,TYO
NOLCRD: SKIPE A,CRNTAB(X)
PUSHJ P,SIXBPS
IFE DEFCHG,<
SKIPN C,CRPTAB(X)
JRST NOLCRP
MOVEI CH,"["
PUSHJ P,TYO
HLRZ A,C
PUSHJ P,OCTPNT
PUSHJ P,COMMA
HRRZ A,C
PUSHJ P,OCTPNT
MOVEI CH,"]"
PUSHJ P,TYO
NOLCRP: PUSHJ P,TAB
SKIPN C,CHGTAB(X)
JRST NOLCHG
HLRZ A,C
PUSHJ P,OCTPNT
PUSHJ P,COMMA
NOLCHG: HRRZ A,C
PUSHJ P,TOCTPT
> ;[152] END IFE ON DEFCHG
IFN DEFCHG,<
PUSHJ P,TAB
MOVE A,CHGTAB(X) ;[152] PUT CHARGE NAME IN A FOR SIXBPT ROUTINE
PUSHJ P,SIXBPT ;[152] CONVERT TO SIXBIT
> ;[152] END OF IFN ON DEFCHG
PUSHJ P, CRLF ;LINE IS NOW SO BIG IT TAKES 3 LINES
PUSHJ P, TAB
HLRZ C,XPDTAB(X) ;C=EXPIRATION DATE
IDIVI C,^D31
MOVEI A,1(BTS) ;A=DAY
PUSHJ P,DECPNT
PUSHJ P,SPACE
IDIVI C,^D12 ;C=YEAR, BTS=MONTH
MOVE A,MONTAB(BTS)
PUSHJ P,SIXBPS
PUSHJ P,SPACE
MOVEI A,^D64(C)
PUSHJ P,DECPNT
PUSHJ P, TAB ;[147] PRINT SCHEDULER TYPE
LDB A, SCDTYP ;[147] IT LIVES IN LH OF RH OF XPDTAB
PUSHJ P, DECPNT ;[147] IN DECIMAL
PUSHJ P, TAB ;[136] PRINT ENQ/DEQ QUOTA
LDB A, ENQDEQ ;[147] IT LIVES IN RH OF RH OF XPDTAB
PUSHJ P,DECPNT ;[136] IN DECIMAL
PUSHJ P,CRLF
PUSHJ P,CRLF ;BLANK LINE TO SEPARATE ENTRIES
JRST LCNO ;LOOP THROUGH FOR MORE ENTRIES
SUBTTL LIST/TYPE AUXACC FILE
AYES1: MOVN C,PRVTAB(X) ;LH=-NO. OF STRS (AFTER SWAPPED)
HLL C,PRVTAB(X) ;RH=INDEX TO TABLES (AFTER SWAPPED)
MOVSS C
JUMPGE C,AL5 ;JUMP IF NO STRS IN ENTRY
JRST AL4 ;DONT DO TABS ON FIRST LINE
AL3: PUSHJ P,TAB
PUSHJ P,TAB
AL4: MOVE A,CODTAB(C) ;FILE STRUCTURE NAME
PUSHJ P,TSIXPT
MOVE A,NAMTB1(C) ;RESERVED QUOTA
PUSHJ P,TDECPT
MOVE A,NAMTB2(C) ;FIRST COME, FIRST SERVED QUOTA
PUSHJ P,TDECPT
MOVE A,TIMTAB(C) ;QUOTA OUT
PUSHJ P,TDECPT
MOVE A,DSKTAB(C) ;STATUS BITS
PUSHJ P,OCTPNT
PUSHJ P,CRLF
AOBJN C,AL3 ;LOOP FOR ALL STRS THIS ENTRY
AL5: PUSHJ P,CRLF
JRST LCNO
QYES1: MOVE A,CODTAB(X) ;RESERVED QUOTA
PUSHJ P,TDECPT
MOVE A,PRVTAB(X) ;FIRST COME, FIRST SERVED QUOTA
PUSHJ P,TDECPT
MOVE A,NAMTB1(X) ;QUOTA OUT
PUSHJ P,DECPNT
PUSHJ P,CRLF
JRST LCNO
SUBTTL PURGE EXPIRED PPN'S FROM ACCT FILE
PCOM: TRNE F,ACC1F+QUOTF+STRF
JRST ONLYR ;MAY ONLY PURGE ACCT.SYS
CALLI WD,GETDAT ;GET TODAYS DATE
MOVSI X,-NPAIRS
TRZ F,CBIT ;BORROW THIS BIT, SET WHEN FIRST PPN TYPED
PLOOP: SKIPN PPTAB(X) ;SKIP IF MORE ENTRIES
JRST EOC ;ALL DONE
HLRZ A,XPDTAB(X) ;A=EXPIRATION DATE
CAML A,WD ;SKIP IF EXPIRED (EX DATE LT TODAY)
JRST PKEEP ;OK, KEEP IT
MOVEI M,PMESM
TRON F,CBIT ;SKIP IF SOMEBODY ALREADY PURGED
PUSHJ P,MESSAG ;NO, TYPE HEADER
HLRZ A,PPTAB(X) ;PROJECT NUMBER
PUSHJ P,OCTPNT
PUSHJ P,COMMA
HRRZ A,PPTAB(X)
PUSHJ P,OCTPNT
PUSHJ P,CRLF
PUSHJ P,MOVMCT
JRST PLOOP ;CHECK NEW NUMBER MOVED INTO THAT SLOT
PKEEP: AOBJN X,PLOOP
JRST EOC
ONLYR: JSP M,RC2
ASCIZ /%P ONLY DEFINED FOR ACCT.SYS
/
PMESM: ASCIZ /
PURGED:
/
SUBTTL PROCESS C OR K COMMAND
SUBTTL DEFINE DEFAULTS
DCOM: CALL FLUSHL ;FLUSH REST OF INPUT LINE
TRZE F,BKALTF ;IF IT WAS ENDED BY ALTMODE
CALL CRLF ;THEN ADD A CRLF
MSG <DEFINE DEFAULTS:
>
;NOTE: THE GCORE ROUTINE ALSO GETS THE IPCF DATA ITS OUTPUT IS:
; 0-8 MAX PHYS LIMIT
; 9-17 MAX VIRT LIMIT
; 18-26 IPCF SEND QUOTA
; 27-35 IPCF RECEIVE QUOTA
CALL GCORE ;GET THE CORE DATA
MOVEM WD,DEFPAG ;AND SET THE DEFAULT WORD
JRST EOC ;BACK TO THE DISPATCHER
CCOM: TROA F,CBIT
KCOM: TRZ F,CBIT
TRNE F,STRF
JRST SKCOM
SKIPN PPTAB ;KILL AN ENTRY
JRST EMPMSG ;COMPLAIN IF TABLE EMPTY
PUSHJ P,PPNGET
MOVSI X,-NPAIRS ;SEARCH FOR THE REQUESTED ITEM
HRRZ A,NUM2 ;PROG
HRL A,NUM1
JUMPE A,KLOSS ;IF IT ISNT THERE, COMPLAIN
CAMN A,PPTAB(X)
JRST KYES ;FOUND IT
AOBJN X,.-2
KLOSS: MOVEI M,KMESS ;NOT FOUND. COMPLAIN
PUSHJ P,MESSAG
JRST EOC
DEFINE MOVMAC(A)<
HRLI B,A+1(X)
HRRI B,A(X)
BLT B,A+NPAIRS-2>
KYES: TRNE F,CBIT ;SKIP IF K
JRST CYES ;C COMMAND
TRNE F,ACC1F
JRST AKYES
PUSHJ P,MOVMCT ;MOVMAC ALL TABLES
JRST EOC
EMPMSG: JSP M,RC2
ASCIZ /%BUT THE BUFFER IS EMPTY!
/
KMESS: ASCIZ /%THAT PROJ-PROG ISN'T THERE
/
SUBTTL DELETE AN ACCT OR QUOTA FILE ENTRY
;SUBROUTINE TO DELETE AN ENTRY BY MOVING ALL TABLES PAST THE ENTRY DOWN ONE PLACE
MOVMCT: MOVMAC PPTAB
SETZM PPTAB+NPAIRS-1 ;MAKE SURE LAST ENTRY NOT COPIED
MOVMAC CODTAB
MOVMAC PRVTAB
MOVMAC NAMTB1
TRNE F,QUOTF
POPJ P, ;QUIT IF QUOTA FILE
MOVMAC NAMTB2
MOVMAC TIMTAB
MOVMAC CORTAB
MOVMAC PROTAB
MOVMAC PR2TAB
MOVMAC CRNTAB
MOVMAC CRDTAB
SUBTTL DELETE AN STRLST OR AUXACC FILE ENTRY
MOVMAC CRPTAB
MOVMAC CHGTAB
MOVMAC XPDTAB
POPJ P,
SKCOM: PUSHJ P,SIXAN ;GET STR TO DELETE
MOVSI X,-NPAIRS
CAMN WD,CODTAB(X)
JRST SKYES ;FOUND IT
AOBJN X,.-2
MOVEI M,SKMESS ;NO SUCH THING
PUSHJ P,MESSAG
JRST EOC
SKYES: TRNE F,CBIT ;SKIP IF K COMMAND
JRST CYES ;C COMMAND
SETZM CODTAB(X)
JRST EOC
SKMESS: ASCIZ .%THAT FILE STRUCTURE ISN'T THERE
.
AKYES: MOVMAC PPTAB
MOVMAC PRVTAB
JRST EOC
SUBTTL PROCESS C COMMAND
;HERE TO CHANGE A PART OF AN ENTRY - X=PTR TO ENTRY
CYES: MOVEM X,CSAVPT ;SAVE PTR TO ENTRY
MOVE X,[XWD -RCNALN,RCNALS+1]
TRNE F,QUOTF
MOVE X,[XWD -QCNALN,QCNALS+1]
TRNE F,ACC1F
MOVE X,[XWD -ACNALN,ACNALS+1]
TRNE F,STRF
MOVE X,[XWD -SCNALN,SCNALS+1]
MOVEM X,CSAVX
CYES1: MSG <CHANGE: >
PUSHJ P,SIXAN ;GET FIELD TO CHANGE
JUMPE WD,EOC ;GIVE UP IF NOTHING THERE
MOVE X,CSAVX
PUSHJ P,FNDVAL
PUSHJ P,ARGQUE
JUMPE A,CYES4
HRRZ N,CSAVX ;PTR TO BEGINNING OF TABLE
MOVE N,-1(N) ;PTR TO ARGS THAT ASK FOR THEIR OWN ARGS
CAIG N,(X) ;SKIP IF NOT IN THAT GROUP
JRST CYES3 ; THAT ALWAYS REQUEST THEIR OWN ARGS
CAIE CH,LF
TRNE F,BKALTF
JRST CYES2
JRST CYES3
CYES2: MSG <ARGS: >
CYES3: MOVE X,CSAVPT ;RESTORE PTR TO ENTRY
PUSHJ P,(A)
CYESX: TRNN F,BKALTF
JRST CYES1
JRST EOC
CYES4: PUSHJ P,JBK ;IGNORE REST OF LINE
JRST CYES1 ;THEN TRY AGAIN
SUBTTL ROUTINES TO CHANGE AN ACCT FILE ENTRY
DEFINE RCNALM (A)<
IRP A,<XWD SIXBIT \ A\,A'RCD>>
RCNALS: RCNNAR
RCNALM <COD,PRI,NAM,COR,WAT,SPO,LOG,CUS,CHG,EDQ,SCD>
RCNNAR=.
RCNALM <TIM,PSR,XPD,NON,HEL>
RCNALN=.-RCNALS-1
CODRCD: PUSHJ P,SIXBRD
EXCH WD,CODTAB(X)
CAMN WD,CODTAB(X)
POPJ P,
MOVE A,WD ;A=OLD CODE
PUSHJ P,SIXBPT ;TYPE IT
MOVEI M,OLDCOD
JRST MESSAG
PRIRCD: PUSHJ P,OCTRD
MOVEM N,PRVTAB(X) ;STORE NEW PRIVILEGES WORD
POPJ P,
NAMRCD: PUSHJ P,SIXBR2 ;GET NAME IN ENTRY
HRROI A,ENTRY+NM2WRD
POP A,NAMTB2(X)
POP A,NAMTB1(X)
POPJ P,
NAMSCD==NAMRCD
TIMRCD: PUSHJ P,GETLTM ;GET LEGAL LOGIN TIMES
MOVEM WD,TIMTAB(X) ;STORE IN ENTRY
POPJ P,
CORRCD: CALL GCORE ;GET THE CORE PARAMETERS
MOVEM WD,CORTAB(X) ;STORE IN ENTRY
POPJ P,
WATRCD: MOVSI BTS,P.WALL
ANDCAM BTS,PROTAB(X) ;CLEAR PRESENT WATCH BITS
PUSHJ P,GETWAT ;GET NEW WATCH SETTING
JRST LOGRCX ;STORE IN PROWRD
SPORCD: MOVSI BTS,P.SPAL
ANDCAM BTS,PROTAB(X) ;CLEAR CURRENT SPOOL BITS
PUSHJ P,GETSPL ;GET NEW SPOOL BITS
JRST LOGRCX ;STORE IN PROWRD
LOGRCD: MOVEI BTS,P.LGAL
ANDCAM BTS,PROTAB(X)
PUSHJ P,GETLOG ;GET NEW LEGAL TTYS FOR LOGIN
POPJ P, ;NO CHANGE
LOGRCX: MOVE X,CSAVPT ;RESTORE PTR TO ENTRY
IORM BTS,PROTAB(X) ;STORE BITS
POPJ P,
CUSRCD: PUSHJ P,FILSPC ;READ CUSP TO RUN
MOVE A,FILE
MOVEM A,CRNTAB(X)
MOVE A,DEV
MOVEM A,CRDTAB(X)
HRLZ A,PROJ
HRR A,PROG
MOVEM A,CRPTAB(X)
POPJ P,
CHGRCD: PUSHJ P,GETCHG
MOVEM A,CHGTAB(X)
POPJ P,
SCDRCD: PUSHJ P, DECRD ;[147] GET SCHEDULER TYPE (0-511)
CAILE N, ^D511 ;[147] CHECK IT
SETZM N ;[147] TAKE DEFAULT (0)
DPB N, SCDTYP ;[147] PUT IT AWAY
POPJ P,
EDQRCD: PUSHJ P,DECRD ;[136] GET ENQ/DEQ QUOTA
DPB N, ENQDEQ ;[147] PUT IT AWAY
POPJ P,
PSRRCD: MOVEI BTS,P.PWAL!P.NMAL
ANDCAM BTS,PROTAB(X)
PUSHJ P,GETPSR
JRST LOGRCX
XPDRCD: PUSHJ P,GETXPD
HLLM WD,XPDTAB(X)
POPJ P,
NONRCD: POP P,(P)
JRST EOC ;ALL DONE
NONQCD==NONRCD
NONSCD==NONRCD
NONACD==NONRCD
HELRCD: MSG <CHANGE REQUESTS: >
SKIPA B,CSAVX ;B=PTR TO LIST OF REQUESTS
HELRC1: PUSHJ P,COMMA
HLLZ A,(B) ;A=NEXT REQUEST
PUSHJ P,SIXBPS ;TYPE IT
AOBJN B,HELRC1 ;LOOP FOR ALL REQUESTS
JRST CRLF
HELACD==HELRCD
HELSCD==HELRCD
HELQCD==HELRCD
SUBTTL CHANGE STRLST FILE ENTRY
DEFINE SCNALM (A)<IRP A,<XWD SIXBIT \ A\,A'SCD>>
SCNALS: SCNNAR
SCNALM <OWN,NAM,UNI,CLA,KON,UTP>
SCNNAR==.
SCNALM <NON,HEL>
SCNALN==.-SCNALS-1
OWNSCD: PUSHJ P,SIPPGT ;GET NEW PPN
JRST OWNSC1
MOVEM A,PPTAB(X) ;STORE IN ENTRY
POPJ P,
OWNSC1: MOVEI M,IERRM
JRST MESSAG
UNISCD: PUSHJ P,SIXAN ;GET OLD UNIT NAME
PUSHJ P,SFNUNI ;SEARCH FOR OLD UNIT ID
JRST NOOLDU ;NO SUCH UNIT
PUSHJ P,SIXAN ;GET NEW UNIT NAME
MOVEM WD,DSKTAB(C)
POPJ P,
KONSCD: PUSHJ P,SIXAN ;GET UNIT NAME
PUSHJ P,SFNUNI ;FIND IN ENTRY
JRST SCDFAI ;NOT THERE
MOVE B,C
PUSHJ P,SIKTGT ;GET KONTROLLER TYPE
JRST SCDFAI
POPJ P,
UTPSCD: PUSHJ P,SIXAN ;GET UNIT NAME
PUSHJ P,SFNUNI ;FIND IN ENTRY
JRST SCDFAI ;NO SUCH UNIT
PUSHJ P,OCTRD
MOVE B,C
DPB N,TYPBYT ;STORE UNIT TYPE
POPJ P,
CLASCD: PUSHJ P,SIXAN ;GET UNIT NAME
PUSHJ P,SFNUNI ;FIND IN ENTRY
JRST SCDFAI ;NO SUCH ENTRY
PUSHJ P,OCTRD ;READ CLASS TYPE
MOVE B,C
DPB N,CLSBYT ;STORE IN ENTRY
POPJ P,
NOOLDU: MOVE BTS,WD ;SAVE UNIT
MSG <%>
MOVE A,WD
PUSHJ P,JBK
PUSHJ P,SIXBPS ;TYPE IT FOR USERS BENEFIT
MSG < IS NOT IN ENTRY, ADD IT? >
PUSHJ P,YESNO
JRST .+2 ;YES
JRST JBK
MOVE A,X ;A=PTR TO OLD ENTRY WHICH IS US
PUSHJ P,STMVUN ;MOVE TO END OF TABLE TO MAKE ROOM
JRST NOLDUE ;JUMP IF NOT ENOUGH ROOM IN TABLES
AOS M,LASTPK ;COUNT UNIT TO BE ADDED
CAILE M,NPAIRS ;SKIP IF ROOM FOR THAT TOO
JRST NOLDUE ;NO, OVERFLOW
AOS PRVTAB(X) ;INCREMENT NUMBER OF UNITS
MOVEM BTS,DSKTAB(B) ;STORE NEW NAME
SETZM TIMTAB(B) ;CLEAR OTHER STUFF
JRST JBK
NOLDUE: MSG <%OVERFLOW, CAN'T ADD>
JRST JBK
SUBTTL CHANGE AN AUXACC FILE ENTRY
DEFINE ACNALM(A)<IRP A,<XWD SIXBIT \ A\,A'ACD>>
ACNALS: ACNNAR
ACNALM <STR,RES,FCF,OUT,STA>
ACNNAR=.
ACNALM <NON,HEL>
ACNALN==.-ACNALS-1
STRACD: PUSHJ P,SIXAN ;GET STR NAME
PUSHJ P,AFNSTR ;FIND IT IN ENTRY
JRST NOOLDS ;NO SUCH STR IN ENTRY
PUSHJ P,SIXAN ;GET NEW NAME
MOVEM WD,CODTAB(C)
POPJ P,
RESACD: PUSHJ P,SIXAN ;GET STR NAME
PUSHJ P,AFNSTR ;FIND IT IN ENTRY
JRST ACDFAI ;NO SUCH STR IN ENTRY
PUSHJ P,DECRD ;GET NEW QUOTA
MOVEM N,NAMTB1(C)
POPJ P,
FCFACD: PUSHJ P,SIXAN ;GET STR NAME
PUSHJ P,AFNSTR ;FIND IT IN ENTRY
JRST ACDFAI
PUSHJ P,DECRD ;GET NEW QUOTA
MOVEM N,NAMTB2(C)
POPJ P,
OUTACD: PUSHJ P,SIXAN ;GET STR NAME
PUSHJ P,AFNSTR ;FIND IT IN ENTRY
JRST ACDFAI ;NO SUCH STR IN ENTRY
PUSHJ P,DECRD ;GET NEW QUOTA
MOVEM N,TIMTAB(C)
POPJ P,
STAACD: PUSHJ P,SIXAN ;GET STR NAME
PUSHJ P,AFNSTR ;FIND IN IN ENTRY
JRST ACDFAI ;NO SUCH STR IN ENTRY
PUSHJ P,GETSTT ;GET STATUS BITS
MOVEM N,DSKTAB(C)
POPJ P,
SCDFAI:
ACDFAI: PUSHJ P,ARGQUE ;DIDNT FIGURE IT OUT
JRST JBK
NOOLDS: MOVE BTS,WD
MSG <%>
MOVE A,WD
PUSHJ P,JBK ;CLEAR REST OF LINE
PUSHJ P,SIXBPS ;TYPE WHAT WE READ FOR USERS BENEFIT
MSG < IS NOT AN ENTRY, ADD IT? >
PUSHJ P,YESNO
JRST .+2 ;YES
POPJ P,
MOVE M,X ;OLD ENTRY=US
PUSHJ P,AIMVST ;MOVE ENTRY TO END OF TABLES TO MAKE ROOM
JRST NOOLDE ;NO ROOM TO MOVE ENTRY, CANT ADD
AOS M,LASTPK ;BUMP POINTER TO FIRST FREE IN TABLE
CAILE M,NPAIRS ;SKIP IF STILL ROOM
JRST NOOLDE ;NO, NO MORE ROOM
AOS PRVTAB(X) ;INCREMENT NUMBER OF STRS
MOVEM BTS,CODTAB(B)
SETZM NAMTB1(B)
SETZM NAMTB2(B)
SETZM TIMTAB(B)
SETZM DSKTAB(B)
POPJ P,
NOOLDE: MSG <%TABLE OVERFLOW, CAN'T ADD
>
POPJ P,
;SUBROUTINE TO FIND AN NAME IN A VARIABLE LENGTH TABLE
;ARGS X=PTR TO MAIN ENTRY
; WD=NAME TO LOOK FOR
;ERROR RETURN NO SUCH NAME IN THE ENTRY
;OK RETURN C=INDEX OF NAME IN ENTRY
;ENTER AT SFNUNI TO SEARCH STRLST
;ENTER AT AFNSTR TO SEARCH AUXACC
SFNUNI: SKIPA N,[CAME WD,DSKTAB(C)] ;LOOK IN DSKTAB FOR STRLST
AFNSTR: MOVE N,[CAME WD,CODTAB(C)] ;LOOK IN CODTAB FOR AUXACC
HRRZ C,PRVTAB(X) ;C=NUMBER OF NAMES IN ENTRY
MOVNS C
HRLZS C ;LH C = - NUMBER OF NAMES
HLR C,PRVTAB(X) ;RH C = BEGINNING OF NAMES
XCT N ;COMPARE NAME WITH NEXT IN ENTRY
AOBJN C,.-1 ;NOT THE SAME, KEEP TRYING
JUMPL C,CPOPJ1 ;EXIT IF FOUND ONE
POPJ P, ;SIGH
SUBTTL CHANGE QUOTA FILE ENTRY
DEFINE QCNALM (A)<
IRP A,<XWD SIXBIT \ A\,A'QCD>>
QCNALS: QCNNAR
QCNALM <RES,FCF,OUT>
QCNNAR=.
QCNALM <NON,HEL>
QCNALN=.-QCNALS-1
SUBTTL INSERT ACCT FILE ENTRY
ICOM: TRNE F,STRF
JRST SICOM
PUSHJ P,PPNIGT
SKIPE A,NUM1 ;SKIP IF NO PROJ SPECIFIED
CAIN A,UNIPRG ;OR IF UNIQUE PROG NUMBER SPECIFIED
JRST IERR ;NO GOOD
SKIPN A,NUM2 ;SKIP IF PROG SPECIFIED
JRST IERR ;NO GOOD
HRL A,NUM1 ;GET PROJ
TRNE F,ACC1F+QUOTF ;SKIP IF NOT AUXACC OR QUOTA FILE
JRST AICOM
CAMN A,OPQPPN ;OR OPQ PPN
JRST NOOPQP
MOVEM A,ENTRY+PPNWRD
SETZM ENTRY+CORWRD
MOVE B,[XWD ENTRY+CORWRD,ENTRY+CORWRD+1]
BLT B,ENTRY+ENTSTD-1
MOVE B,STDPRV
TLNN A,-2 ;SKIP IF NOT PROJECT 1
SETO B, ;ALL PRIVILEGES FOR PROJECT 1
MOVEM B,ENTRY+PRVWRD
MOVE B,STDTIM
MOVEM B,ENTRY+TIMWRD
IFN FTSPOOL,<
MOVSI B,200 ;**[15] SET NO SPOLL PRIVILIGE
MOVEM B,ENTRY+PRVWRD ;**[15] SET IT AS A STANDARD
>
MOVE B,STDPRO
TLNE A,-10 ;SKIP IF PROJ LT 10
TRNN A,-10 ;SKIP IF PROG GE 10
TRZ B,P.LGRM!P.LGDS ;NO REMOTE OR DATA SET IF EITHER LT 10
TLO B,P.WMTA ;WATCH MAGTAPE
MOVEM B,ENTRY+PROWRD
MOVSI A,STDXPD ;STANDARD EXPIRATION DATE
HLLM A,ENTRY+XPDWRD
HRRZ A, SIXDEF ;[147] SET UP 6.02 DEFAULTS
HRRM A, ENTRY+SIXWRD ;[147] FOR ALTMODE ENTRY
CAIN CH,"=" ;SKIP IF NOT PPN=PPN FORM
JRST ICOM1
MOVE B,DEFPAG ;**[14] GET DEFAULT DAT
MOVEM B,ENTRY+CORWRD ;**[14] AND STORE IT
MSG <NAME:>
PUSHJ P,SIXBR2 ;2 WORDS TO ENTRY+NM1,NM2WRD
MSG <CODE:>
PUSHJ P,SIXBRD
MOVEM WD,ENTRY+CODWRD
PUSHJ P,ALTCK
MSG <PRIVILEGE WORD:>
PUSHJ P,OCTRD
SKIPE N ;LEAVE DEFAULT VALUE
MOVEM N,ENTRY+PRVWRD
PUSHJ P,ALTCK
PUSHJ P,GETLTM ;GET LOGIN TIMES
MOVEM WD,ENTRY+TIMWRD
PUSHJ P,ALTCK
MSG <CORE: >
CALL GCORE ;GET THE CORE DATA IN WD
MOVEM WD,ENTRY+CORWRD
PUSHJ P,ALTCK ;SEE IF WANTS DEFAULT FROM HERE ON
MSG <WATCH (TYPE ARGS): >
PUSHJ P,GETWAT ;GET WATCH BITS
JUMPE BTS,NOWATS ;**[16] NO WATCH BITS REQUESTED
MOVSI M,P.WMTA ;**[16] IF YOU SPECIFY IT THEN YOU DO IT
ANDCAM M,ENTRY+PROWRD ;**[16] ZAP THE DEFAULT
NOWATS: IORM BTS,ENTRY+PROWRD
PUSHJ P,ALTCK ;NO RETURN IF DEFAULTS FROM HERE ON
MSG <SPOOL (TYPE DEVICES): >
PUSHJ P,GETSPL ;GET SPOOL BITS
IORM BTS,ENTRY+PROWRD
PUSHJ P,ALTCK ;NO RETURN IF DEFAULTS FROM HERE ON
MSG <LOGIN (TYPE TTY TYPES): >
PUSHJ P,GETLOG
JRST IDFLOG ;JUMP IF NONE SPECIFIED, USE DEFAULT
MOVE M,[P.WMTA,,P.LGAL] ;**[16] LEAVE DEFAULTS ALONE
ANDCAM M,ENTRY+PROWRD ;CLEAR DEFAULT
IORM BTS,ENTRY+PROWRD ;AND STORE AS SPECIFIED
IDFLOG: PUSHJ P,ALTCK
MOVEI BTS,P.PWAL!P.NMAL
ANDCAM BTS,ENTRY+PROWRD
PUSHJ P,GETPSR
IORM BTS,ENTRY+PROWRD
PUSHJ P,ALTCK
MSG <CUSP TO RUN: >
PUSHJ P,FILSPC
HRLZ A,PROJ
HRR A,PROG
MOVEI B,ENTRY+CRNWRD-1
PUSH B,FILE
PUSH B,DEV
PUSH B,A
PUSHJ P,ALTCK ;NO RETURN IF DEFAULTS FROM HERE ON
MSG <CHARGE NUM: >
PUSHJ P,GETCHG
MOVEM A,ENTRY+CHGWRD
PUSHJ P,GETXPD
HLLM WD,ENTRY+XPDWRD
PUSHJ P, ALTCK ;NO RETURN IF DEFAULTS FROM HERE ON
MSG <SCHEDULER TYPE: > ;[147] GET SCHEDULER TYPE
PUSHJ P, DECRD ;[147] IN DECIMAL
DPB N, SCDPTR ;STORE IT
PUSHJ P, ALTCK ;NO RETURN IF DEFAULTS FROM HERE ON
MSG <ENQ/DEQ QUOTA: > ;[136] GET ENQ/DEQ QUOTA
PUSHJ P, DECRD ;[147] IN DECIMAL
DPB N, EDQPTR ;[147] AND PUT IT AWAY
JRST INSDO
ICOM1: PUSHJ P,PPNGET ;GET PPN TO BE EQUAL TO
HRLZ A,NUM1
HRR A,NUM2
PUSHJ P,TABLST ;FIND OLD IN TABLE
JRST IERR1 ;CANT FIND WHAT WE ARE LOOKING FOR
MOVEI A,ENTRY ;COPY ALL VALUES INTO NEW ENTRY
PUSH A,CODTAB(M)
PUSH A,PRVTAB(M)
PUSH A,NAMTB1(M)
PUSH A,NAMTB2(M)
PUSH A,TIMTAB(M)
PUSH A,CORTAB(M)
PUSH A,PROTAB(M)
PUSH A,PR2TAB(M)
PUSH A,CRNTAB(M)
PUSH A,CRDTAB(M)
PUSH A,CRPTAB(M)
PUSH A,CHGTAB(M)
PUSH A,XPDTAB(M)
INSDO: SKIPE TIMTAB+NPAIRS-1 ;[145] IF LAST ENTRY NOT ZERO,
JRST OVF ;[145] THIS WILL CAUSE TABLE OVERFLOW
MOVSI X,-NPAIRS ;FIND WHERE IT GOES IN TABLE
MOVE A,ENTRY+PPNWRD
ILOOP: SKIPE PPTAB(X) ;IF END,
CAMG A,PPTAB(X) ;OR GREATER THAN THIS ONE
JRST IHERE ;IT GOES HERE
AOBJN X,ILOOP ;COUNT SOME MORE
JRST OVF ;TABLE OVERFLOW
IHERE: CAME A,PPTAB(X) ;INSERT HERE. SAME P-P AS OLD ONE?
JRST IH1 ;NO. HAVE TO EXPAND TABLE
MOVE A,CODTAB(X) ;LIST OLD CODE IN CASE OPR
; WANTS TO RESTORE IT
CAMN A,ENTRY+CODWRD ;BUT DONT LIST IF SAME
JRST ISTOR1
PUSHJ P,SIXBPT
MOVEI M,OLDCOD
PUSHJ P,MESSAG
JRST ISTOR1 ;GO PUT IN DATA
HRERR: JSP M,INSL1
ASCIZ /%DECIMAL NUMBERS FROM 0 TO 35 PLEASE
/
NOOPQP: JSP M,RC2
ASCIZ /%MAY NOT INSERT QUEUE COMMAND AREA PPN
/
DEFINE INSMAC(A)<
MOVEI N,A
PUSHJ P,INSSUB
>
IH1: INSMAC CODTAB
INSMAC PPTAB
INSMAC PRVTAB
INSMAC TIMTAB
INSMAC NAMTB1
INSMAC NAMTB2
INSMAC CORTAB
INSMAC PROTAB
INSMAC PR2TAB
INSMAC CRNTAB
INSMAC CRDTAB
INSMAC CRPTAB
INSMAC CHGTAB
INSMAC XPDTAB
ISTOR1: HRROI A,ENTRY+ENTSTD-1
POP A,XPDTAB(X)
POP A,CHGTAB(X)
POP A,CRPTAB(X)
POP A,CRDTAB(X)
POP A,CRNTAB(X)
POP A,PR2TAB(X)
POP A,PROTAB(X)
POP A,CORTAB(X)
POP A,TIMTAB(X)
POP A,NAMTB2(X)
POP A,NAMTB1(X)
POP A,PRVTAB(X)
POP A,CODTAB(X)
POP A,PPTAB(X)
JRST EOC ;DONE THIS INSERT
INSSUB: MOVEI C,NPAIRS-2(N)
ADDI N,(X)
INSSB1: MOVE B,(C)
MOVEM B,1(C)
CAIGE N,(C)
SOJA C,INSSB1
POPJ P,
IERRP: TRZ F,PPNRDF
IERR: JSP M,RC2
IERRM: ASCIZ /%PROJ AND PROG MUST BE FROM 1 TO 377777 OCTAL
/
OLDCOD: ASCIZ / WAS THE OLD CODE FOR THAT NUMBER
/
IERR1: JSP M,RC2
ASCIZ /%ENTRY TO BE COPIED IS NOT IN TABLES
/
ALTCK: TRNN F,BKALTF
POPJ P,0
POP P,0(P)
JRST INSDO
SUBTTL ROUTINES TO GET NEW ACCT ENTRY VALUES
;SUBROUTINE TO GET LEGAL LOGIN TIMES
;VALUES WD=TIMES WORD
GETLTM: MSG <ALL TIMES?>
SETZ WD,
PUSHJ P,YESNO
SOJA WD,CPOPJ ;YES
MSG <0800-1700?>
PUSHJ P,YESNO
IOR WD,PRIME
TRNE F,BKALTF
POPJ P,
MSG <ALL NON-PRIME?>
PUSHJ P,YESNO
ORCM WD,PRIME
TRNE F,BKALTF
POPJ P,
MOVEI M,[ASCIZ \TYPE HOURS IN DECIMAL:
0-23 MEAN HOURS STARTING AT 0000 THROUGH 2300 ON WEEKDAYS.
24-35 MEAN TWO-HOUR SHIFTS STARTING AT 0000,0200,ETC.,
ON WEEKENDS. TYPE EXTRA CR WHEN THROUGH.
\]
INSL1: PUSHJ P,MESSAG
INSL2: MOVEI N,0
PUSHJ P,TTI
CAIGE CH,40
POPJ P,
INSL3: CAIL CH,60
CAILE CH,71
JRST HRERR
IMULI N,12
ADDI N,-60(CH)
PUSHJ P,TTI
CAILE CH,40
JRST INSL3
CAILE N,^D35
JRST HRERR
MOVSI A,SIGN
MOVNS N
LSH A,0(N)
IOR WD,A
JRST INSL2
;SUBROUTINE TO GET WATCH ARGS AND CONVERT TO BITS
;VALUES BTS=WATCH BITS
GETWAT: MOVE X,[XWD -WARGLN,WARGLS]
JRST GETSP1
;SUBROUTINE TO GET DEVICES TO BE SPOOLED AND CONVERT TO BITS
;VALUES BTS=BITS FOR DEVICES TO BE SPOOLED
GETSPL: MOVE X,[XWD -SPLALN,SPLALS]
GETSP1: SETZ BTS,
GETSP2: PUSHJ P,GARGL
JFCL ;DONT CARE IF NONE SPECIFIED
JUMPN N,GETSP2 ;LOOP TIL NO ERRORS
MOVSS BTS ;SPOOL BITS GO IN LH
POPJ P,
;SUBROUTINE TO GET TTYS WHERE MAY LOGIN
;VALUS BTS=BITS FOR TTY TYPES
GETLOG: MOVE X,[XWD -TARLN,TARLS]
SETZ BTS,
GETLG1: PUSHJ P,GARGL ;GET ARGS (SET BITS IN BTS)
POPJ P, ;EXIT IF NONE SPECIFIED
JUMPN N,GETLG1 ;LOOP TIL NO ERRORS
JRST CPOPJ1 ;SKIP RETURN IF SOME SPECIFIED
;SUBROUTINE TO GET PASSWORD AND NAME REQUIREMENTS
;VALUES BTS=BITS
GETPSR: SETZ BTS,
MSG <PSW FOR TS? >
PUSHJ P,YESNO
TRO BTS,P.PWTS ;YES, SET BIT
TRNE F,BKALTF
POPJ P,
TRNN BTS,P.PWTS ;SKIP IF PASSWORD REQUIRED FOR TS
JRST NOPWTS ;NO, DONT NEED NAME EITHER
MSG <NAME FOR TS? >
PUSHJ P,YESNO
TRO BTS,P.NMTS ;YES, SET BIT
TRNE F,BKALTF
POPJ P,
NOPWTS: MSG <PSW FOR BATCH? >
PUSHJ P,YESNO
TRO BTS,P.PWBT ;YES, SET BIT
TRNE F,BKALTF
POPJ P,
TRNN BTS,P.PWBT
POPJ P,
MSG <NAME FOR BATCH? >
PUSHJ P,YESNO
TRO BTS,P.NMBT
POPJ P,
;SUBROUTINE TO GET CHARGE NUMBER
;VALUES A=CHARGE NUMBER
GETCHG:
IFE DEFCHG,<
SETZM NUM2
PUSHJ P,PPNGET
HRLZ A,NUM1
HRR A,NUM2
> ;[152] END OF IFE ON DEFCHG
IFN DEFCHG,<
PUSHJ P,SIXBRD
MOVEM WD,A
> ;[152] END OF IFN ON DEFCHG
POPJ P,
;SUBROUTINE TO GET EXPIRATION DATE OF PASSWORD
;VALUES LH WD=EXPIRATION DATE
GETXPD: MSG <EXP DATE (DD MON YY): >
PUSHJ P,DECRD ;GET DAY
SETZ WD, ;PRESUME NOTHING SPECIFIED
SKIPN A,N ;SAVE DAY, SKIP IF SPECIFIED
JRST GETXPX ;NONE SPECIFIED, USE DEFAULT
PUSHJ P,SIXAN ;WD=MONTH
MOVSI B,-^D12
CAME WD,MONTAB(B)
AOBJN B,.-1 ;FIND MONTH IN TABLE
JUMPGE B,MONERR ;NOT AN ENGLISH MONTH
PUSHJ P,DECRD ;GET YEAR IN N
MOVEI WD,-^D64(N)
IMULI WD,^D12
ADDI WD,(B) ;MONTH-1
IMULI WD,^D31
GETXPX: ADDI WD,-1(A)
MOVSS WD
TRNN WD,-1 ;SKIP IF OVERFLOWED FIELD
POPJ P, ;NO, JUST EXIT
MSG <%DATE FIELD OVERFLOW, USING MAX
>
MOVSI WD,-1
POPJ P,
MONERR: PUSHJ P,JBK ;IGNORE REST OF LINE
MSG <%ILLEGAL MONTH
>
JRST GETXPD
SUBTTL GET THE CORE LIMITS
;GCORE RETURNS THE CORE LIMITS IN REGISTER WD
;IF IT DETECTS ANY WRONGDOINGS IT WILL USE
;THE DEFAULT VALUE AND WARN THE USER
GCORE: MSG <CORE(MAX # OF PHYSICAL PAGES,MAX # OF VIRTUAL PAGES):>
MOVE WD,DEFPAG ;GET DEFAULT VALUE
MOVEM WD,LHAND ;AND SET UP THE RESULT
CALL GPAIR ;GET A PAIR
JRST GCORE ;RETRY IT HE WILL LEARN IT
HRLM WD,LHAND ;VALUE DEFINED! THE LEFT HAND
TRNE F,BKALTF ;ALTMODE TYPED?
JRST GIPCF0 ;YES QUIT
;NEXT GET IPCF DATA
GIPCF: MSG <IPCF(MAX # OF SENDS,MAX # OF RECEIVES):>
CALL GPAIR ;GET A PAIR OF OCTALS
JRST GIPCF ;GIVE ANOTHER CHANCE
HRRM WD,LHAND ;COMPLETE WD
GIPCF0: MOVE WD,LHAND ;DEAAULT DESIRED
RETURN ;GO BACK
;GPAIR GETS A PAIR OF OCTAL VALUES
;THE PAIR IS RANGE CHECKED USING THE VALUES OF DEFVA1 AND DEFVA2
;FOR RESPECTIVELY THE LEFT AND RIGHT HAND SIDE
;IF THE VALUE GIVEN EXCEDDS THIS VALUE THE DEFAULT WILL BE TAKEN
;GPAIR HAS 3 RETURNS:
;CPOPJ INPUT WAS WRONG RETYPE
;CPOPJ1 A CORRECT NEW VALUE WAS TYPED
;CPOPJ2 USER ASKED DEFAULT VALUE BY TYPING CR
GPAIR: CALL DECRD ;READ AN DECIMAL NUMBER
SAVE N ;SAVE THE VALUE
CALL CHKMAX ;CHECK AGAINST MAX VALUE
CALL FNDDEL ;FIND A DELIMITER IN THE INPUT STRING
CAIE CH,.CHCOM ;IS IT A COMMA?
JRST BADDEL ;NO A BAD DELIMITER SCREAM AND TAKE DEFAULT
CALL DECRD ;READ IN DECIMAL PHYS AMOUNT
CALL FLUSHC ;FLUSH DEPENDING ON .CH
CALL CHKMAX ;SEE IF VALUE IS REASONABLE
RESTORE WD ;GET THE FIRST VALUE BACK
LSH WD,^D9 ;GET IT IN THE LEFT PART
ADD WD,N ;ADD RIGHT PART
JRST CPOPJ1 ;GIVE A SKIP RETURN
CHKMAX: CAIG N,777 ;BIGGER THAN NINE BITS
RETURN ;ONLY RETURN IF OAKY
RESTORE N ;GET RID OF CALL RETURN
MSG <%MAX VALUE POSSIBLE=511>
JRST BADDE1 ;TELL HIM TO CHANGE HIS MIND
BADDEL: CAIE CH,.CHLF ;A LINE FFED
TRNE F,BKALTF ;ALTMODE SEEN
SKIPA ;THEN OKAY
JRST BADDE0 ;NO A BAD DELIMITER
POP P,N ;POP OFF SAVED N
CPOPJ2: AOS (P) ;SET FOR DOUBLE SKIP
JRST CPOPJ1 ;AND SKIP RETURN
BADDE0: MSG <%BAD DELIMITER A , WAS EXPECTED>
BADDE1: MSG < RETYPE THE LINE
>
CALL FLUSHL ;FLUSH DEPENDIND ON .CH AND .F
RESTORE N ;CLEAN THE STACK
RETURN
;SUBROUTINE TO GET ARGS AND CONVERT THEM TO BITS IN BTS
;ARGS X=AOBJN PTR TO TABLE OF ARGS
;VALUES N=NUMBER OF ILLEGAL ARGS
; BTS=BITS CORRESPONDING TO ARGS TYPED (SET WITH IOR)
GARGL: SETZ N,
HRROS (P) ;NOTE NOTHING SPECIFIED YET
GARGL1: PUSH P,X ;SAVE AOBJN PTR TO TABLE OF LEGAL ARGS
PUSHJ P,SIXAN ;GET NEXT ARG TYPED
JUMPE WD,GARGL2
HRRZS -1(P) ;NOTE SOMETHING SPECIFIED
PUSHJ P,FNDVAL ;FIND IN LIST OF ARGS
PUSHJ P,ARGQUE ;NOT THERE
IOR BTS,A ;INCLUDE NEW BITS FOR THIS ARG
GARGL2: POP P,X ;RESTORE PTR TO LIST OF ARGS
CAIE CH,LF ;SKIP IF END OF LINE
TRNE F,BKALTF ;ALTMODE WILL DO
JRST .+2 ;ALL DONE FOR NOW
JRST GARGL1 ;LOOP FOR ALL ARGS TYPED
SKIPL (P) ;SKIP IF NOTHING SPECIFIED
AOS (P) ;SKIP RETURN IF SOMETHING SPECIFIED
POPJ P,
;SUBROUTINE TO FIND AN ARG IN A LIST AND RETURN A VALUE CORRESPONDING TO THE ARG
;ARGS WD=ARG
; X=AOBJN PTR TO LIST
;VALUES A=VALUE FROM LIST IF ARG FOUND
; X=PTR TO TABLE ENTRY
;RETURN CPOPJ IF NOT ON LIST OR MORE THAN 1 MATCH ON ABBREVIATION
; CPOPJ1 IF OK
FNDVAL: HLLZ A,WD ;A=1ST 3 CHARS
PUSHJ P,GETMSK ;GET MASK IN C FOR CHARS IN A
TRO C,-1
FNDVL1: XOR A,(X)
TLNN A,-1 ;SKIP IF NOT EXACT MATCH
JRST CPOPJ1 ;EXACT - A=BITS FROM TABLE
AND A,C ;CHECK IF ABBREVIATION
TLNE A,-1 ;SKIP IF YES
JRST FNDVL2
CAIE B,0 ;SKIP IF 1ST ABBREVIATION
TLOA B,-1 ;NO, MORE THAN 1 IS NO GOOD
HRRZ B,X ;SAVE ADDR OF THIS MATCH
FNDVL2: HLLZ A,WD
AOBJN X,FNDVL1 ;TRY NEXT ARG
JUMPLE B,CPOPJ ;NO EXACT MATCHES, EXIT IF NOT EXACTLY 1 ABBREV
MOVE X,B
HRRZ A,(B) ;OK, USE THAT ONE
JRST CPOPJ1
;SUBROUTINE TO CREATE A MASK IN C FOR CHARS IN A
;ARGS A=SIXBIT CHARS LEFT JUSTIFIED
;VALUES C=MASK OF ALL ONES IN NON-ZERO CHAR POSITIONS
GETMSK: SETZB C,B ;FIRST ASSUME NO CHARS
JUMPE A,CPOPJ ;SEE, WE WERE RIGHT
TLO C,770000 ;NO, AT LEAST 1 CHAR
PUSH P,A
GETMS1: LSH A,6 ;GET RID OF THE CHAR WE KNOW ABOUT
JUMPE A,APOPJ ;EXIT IF THATS ALL
ASH C,-6 ;MUST BE ANOTHER
JRST GETMS1
APOPJ: POP P,A
POPJ P,
;SUBROUTINE TO TYPE ?ARG FOR ILLEGAL ARG
ARGQUE: PUSH P,CH ;NEED TO SAVE TERMINATOR
MOVEI CH,"?"
PUSHJ P,TYO
MOVE A,WD ;TYPE UNINTELLIGIBLE ARG
PUSHJ P,SIXBPT
PUSHJ P,CRLF
SETZ A,
POP P,CH
AOJA N,CPOPJ
SUBTTL TABLES
DEFINE WARGLM (A,B)<
XWD SIXBIT \ A\,P.W'B>
WARGLS: WARGLM ALL,ALL
WARGLM DAY,DAY
WARGLM RUN,RUN
WARGLM WAI,WAT
WARGLM REA,RED
WARGLM WRI,WRT
WARGLM VER,VER
WARGLM MTA,MTA
WARGLM NON,NON
WARGLN=.-WARGLS
DEFINE SPARGM (A,B)<
XWD SIXBIT \ A\,P.SP'B>
SPLALS: SPARGM ALL,AL
SPARGM CDR,CR
SPARGM LPT,LP
SPARGM CDP,CP
SPARGM PTP,TP
SPARGM PLT,PL
SPARGM NON,NO
SPLALN=.-SPLALS
DEFINE TARGLM (A,B)<
XWD SIXBIT \ A\,P.LG'B>
TARLS: TARGLM ALL,AL
TARGLM BAT,BT
TARGLM BSJ,BS
TARGLM REM,RM
TARGLM DAT,DS
TARGLM ROP,RO
TARGLM LOC,LC
TARGLM NON,NO
TARLN=.-TARLS
SUBTTL INSERT STRLST ENTRY
SICOM: PUSHJ P,SIXAN ;GET NAME OF FILE STRUCTURE TO INSERT
JUMPE WD,SICOM0 ;MUST BE NONZERO
TRNN WD,77 ;MORE THAN 5 CHARACTERS?
JRST SICO0 ;(NO) ALL IS FINE
SICOM0: MSG <%ZERO NAME OR MORE THAN 5 CHARACTERS IN NAME IS ILLEGAL
>
JRST EOC ;NEXT COMMAND
SICO0: MOVEM WD,ENTRY+1
CAIN CH,"=" ;SKIP IF NOT NAME=NAME FORM
JRST STRI2 ;SKIP OVER FIRST FEW QUESTIONS
MOVEI M,[ASCIZ .PROJ,PROG: .]
PUSHJ P,MESSAG
PUSHJ P,SIPPGT ;GET OWNERS PPN
JRST IERR
MOVEM A,ENTRY
MOVEI M,[ASCIZ .NAME: .]
PUSHJ P,MESSAG
PUSHJ P,SIXBR2 ;OWNER'S NAME TO ENTRY+NM1,NM2WRD
MOVEI M,[ASCIZ .NUMBER OF UNITS: .]
PUSHJ P,MESSAG
PUSHJ P,DECRD ;NUMBER OF UNITS
MOVEM N,ENTRY+2
STRI2: MOVSI X,-NPAIRS
MOVE A,ENTRY+1 ;SEE IF ALREADY EXIST
STRI3: CAMN A,CODTAB(X)
JRST SIHERE ;YES
AOBJN X,STRI3
MOVSI X,-NPAIRS ;NO, LOOK FOR A HOLE
STRI4: SKIPN CODTAB(X)
JRST SIHERE ;FOUND ONE
AOBJN X,STRI4
JRST OVF ;NO SUCH LUCK
SIHERE: MOVEM A,CODTAB(X) ;FILE STRUCTURE NAME
CAIN CH,"=" ;SKIP IF NOT NAME=NAME FORM
JRST STRIA
MOVE B,LASTPK ;CURRENT INDEX TO TABLES
MOVE A,ENTRY+2 ;NUMBER OF UNITS
HRL B,A ;LH B=NUMBER OF UNITS
ADDI A,(B) ;A=NEW INDEX
CAILE A,NPAIRS ;SKIP IF ROOM
JRST OVF ;NO, NOTE OVERFLOW
MOVSM B,PRVTAB(X) ;STORE POINTER TO UNITS IN TABLES
MOVE A,ENTRY
MOVEM A,PPTAB(X) ;PPN
MOVE A,ENTRY+NM1WRD
MOVEM A,NAMTB1(X) ;FIRST HALF OF OWNER'S NAME
MOVE A,ENTRY+NM2WRD
MOVEM A,NAMTB2(X) ;SECOND HALF OF OWNER'S NAME
HLRZ A,B ;A=NUMBER OF UNITS
SIH2: MOVEI M,[ASCIZ .UNIT ID: .]
PUSHJ P,MESSAG
PUSHJ P,SIXAN ;GET NEXT UNIT ID
MOVEM WD,DSKTAB(B)
SIH3: MOVEI M,[ASCIZ .KONT TYPE: .]
PUSHJ P,MESSAG
PUSHJ P,SIKTGT ;GET KONTROLLER TYPE
JRST SIH3 ;WHAT?
MOVEI M,[ASCIZ .UNIT TYPE: .]
PUSHJ P,MESSAG
PUSHJ P,OCTRD ;GET UNIT TYPE (E.G. RP01 OR RP02)
DPB N,TYPBYT
MOVEI M,[ASCIZ .CLASS: .]
PUSHJ P,MESSAG
PUSHJ P,OCTRD ;GET CLASS OF UNIT
DPB N,CLSBYT
AOS B,LASTPK
SOJG A,SIH2 ;LOOP FOR NUMBER OF UNITS SPECIFIED
JRST EOC
STRIA: PUSHJ P,SIXAN ;GET NAME TO BE EQUAL TO
MOVSI A,-NPAIRS
CAME WD,CODTAB(A)
AOBJN A,.-1
JUMPGE A,IERR1 ;JUMP IF NOT IN TABLE
MOVE B,PPTAB(A) ;PPN
MOVEM B,PPTAB(X) ;NEW PPN
MOVE B,NAMTB1(A) ;1ST WORD OF NAME
MOVEM B,NAMTB1(X) ;NEW 1ST WORD
MOVE B,NAMTB2(A)
MOVEM B,NAMTB2(X)
PUSHJ P,STMVUN ;MOVE UNIT TABLES TO END OF TABLES
JRST OVF ;OVERFLOW IF NO ROOM
JRST EOC
STMVUN: HRRZ N,PRVTAB(A) ;NUMBER OF UNITS
MOVE C,LASTPK ;C=CURRENT INDEX TO TABLES
ADD C,N ;C=NEW INDEX
CAILE C,NPAIRS ;SKIP IF ROOM
POPJ P, ;NO, GIVE OVERFLOW RETURN
HRL N,LASTPK ;INDEX TO TABLES
HRRZ C,N ;C=NUMBER OF UNITS
HLRZ A,PRVTAB(A) ;A=OLD INDEX TO TABLES
MOVEM N,PRVTAB(X)
HLRZ B,N ;B=NEW INDEX
SIH4: MOVE WD,DSKTAB(A) ;NEXT UNIT ID
MOVEM WD,DSKTAB(B)
MOVE WD,TIMTAB(A) ;UNIT PARAMETERS
MOVEM WD,TIMTAB(B)
ADDI A,1
AOS B,LASTPK
SOJG C,SIH4 ;LOOP FOR ALL UNITS IN STR
JRST CPOPJ1 ;GIVE OK RETURN
SIPPGT: PUSHJ P,PPNGET ;OWNER'S PROJECT, PROGRAMMER NUMBER
HRLZ A,NUM1
HRR A,NUM2
TLNE A,-1
TRNN A,-1
POPJ P,
JRST CPOPJ1
SIKTGT: PUSHJ P,SIXAN ;GET KONTROLLER TYPE
MOVSI N,-NKONT ;AND GET A VALUE TO CORRESPOND
CAME WD,KONTYP(N) ;BY LOOKING IT UP IN THE TABLE
AOBJN N,.-1
JUMPGE N,CPOPJ
DPB N,KONBYT
JRST CPOPJ1
SUBTTL INSERT AUXACC ENTRY
AICOM: TLNN A,-1 ;MAY NOT ACCEPT PROJECT 0
JRST IERR
MOVSI X,-NPAIRS
AILOOP: SKIPE PPTAB(X) ;IF END
CAMG A,PPTAB(X) ;OR GREATER THAN THIS ONE
JRST AIHERE ;PUT IT HERE
AOBJN X,AILOOP
JRST OVF
AIHERE: TRNE F,QUOTF
JRST QIHERE
CAMN A,PPTAB(X) ;SKIP IF MUST EXPAND
JRST AIH1 ;PPN ALREADY IN TABLE
INSMAC PPTAB ;EXPAND PP TABLE
INSMAC PRVTAB ;AND POINTER TABLE
AIH1: MOVEM A,PPTAB(X) ;A=NEW PPN
CAIN CH,"=" ;SKIP IF NOT PPN=PPN FORM
JRST AIH3
MSG <NUM STRS: >
PUSHJ P,DECRD
MOVE C,N ;RH=N=NUMBER OF FILE STRUCTURES
MOVE B,LASTPK ;LH=INDEX TO TABLES
ADD N,B ;N=NEW VALUE OF LASTPK=NEW FIRST FREE
CAILE N,NPAIRS ;SKIP IF ROOM FOR THIS ENTRY
JRST OVF ;NO, COMPLAIN ABOUT OVERFLOW
HRL C,B
MOVEM C,PRVTAB(X)
HRRZS C ;C=NUMBER OF FILE STRUCTURES
AIH2: JUMPE C,EOC ;JUMP IF NO MORE STRS IN LIST
MSG <STR NAME: >
PUSHJ P,SIXAN
MOVEM WD,CODTAB(B) ;FILE STRUCTURE NAME
MSG <RESRVD: >
PUSHJ P,DECRD
MOVEM N,NAMTB1(B) ;RESERVED QUOTA
MSG <FCFS: >
PUSHJ P,DECRD
MOVEM N,NAMTB2(B) ;FIRST COME, FIRST SERVED QUOTA
MSG <QUOTA OUT: >
PUSHJ P,DECRD
MOVEM N,TIMTAB(B) ;QUOTA OUT
MSG <STATUS BITS: >
PUSHJ P,GETSTT
MOVEM N,DSKTAB(B) ;STATUS BITS (FOR SETSRC FUNCTION OF STRUUO)
AOS B,LASTPK
SOJA C,AIH2 ;LOOP FOR NUMBER OF STRS SPECIFIED
AIH3: PUSHJ P,PPNGET ;GET PPN TO BE EQUAL TO
HRLZ A,NUM1
HRR A,NUM2
PUSHJ P,TABLST
JRST IERR1 ;OLD PPN IS NOT IN TABLE
PUSHJ P,AIMVST ;MOVE TO END OF TABLES
JRST OVF ;NO ROOM TO INSERT NEW ENTRY
JRST EOC
AIMVST: HRRZ C,PRVTAB(M) ;RH=NUMBER OF STRS
MOVE B,LASTPK
MOVE A,B ;A=OLD FIRST FREE SPOT IN TABLES
ADD A,C ;+NUMBER OF NEW = NEW FIRST FREE
CAILE A,NPAIRS ;SKIP IF ROOM
POPJ P, ;NO, EXIT NOW
HRL C,B ;LH=INDEX TO TABLES FOR NEW
HLRZ A,PRVTAB(M) ;A=INDEX TO TABLES FOR OLD
MOVEM C,PRVTAB(X)
HRRZS C ;C=NUMBER OF STRS
AIH4: JUMPE C,CPOPJ1 ;JUMP IF NO MORE STRS
MOVE M,CODTAB(A)
MOVEM M,CODTAB(B)
MOVE M,NAMTB1(A)
MOVEM M,NAMTB1(B)
MOVE M,NAMTB2(A)
MOVEM M,NAMTB2(B)
MOVE M,TIMTAB(A)
MOVEM M,TIMTAB(B)
MOVE M,DSKTAB(A)
MOVEM M,DSKTAB(B)
ADDI A,1
AOS B,LASTPK
SOJA C,AIH4
SUBTTL INSERT QUOTA ENTRY
QIHERE: SKIPE PRVTAB+NPAIRS-1 ;[145] IF THIS IS NON-ZERO, INSERTING
JRST OVF ;[145] WILL CAUSE TABLE OVERFLOW
CAMN A,PPTAB(X) ;SKIP IF MUST EXPAND
JRST QIH1
INSMAC PPTAB
INSMAC CODTAB
INSMAC PRVTAB
INSMAC NAMTB1
QIH1: MOVEM A,PPTAB(X) ;A=NEW PPN
CAIN CH,"=" ;SKIP IF NOT PPN=PPN FORM
JRST QIH2
MSG <RESRVD: >
PUSHJ P,QGTRSV ;GET RESERVED QUOTA
MSG <FCFS: >
PUSHJ P,QGTFCF ;GET FCFS QUOTA
MSG <QUOTA OUT: >
PUSHJ P,QGTQUO ;GET QUOTA OUT
JRST EOC
QGTRSV: PUSHJ P,DECRD
MOVEM N,CODTAB(X)
POPJ P,
QGTFCF: PUSHJ P,DECRD
MOVEM N,PRVTAB(X)
POPJ P,
QGTQUO: PUSHJ P,DECRD
MOVEM N,NAMTB1(X)
POPJ P,
RESQCD==QGTRSV
FCFQCD==QGTFCF
OUTQCD==QGTQUO
QIH2: PUSHJ P,PPNGET ;GET PPN TO BE EQUAL TO
HRLZ A,NUM1
HRR A,NUM2
PUSHJ P,TABLST
JRST IERR1 ;OLD NOT IN TABLES
MOVE A,CODTAB(M)
MOVEM A,CODTAB(X)
MOVE A,PRVTAB(M)
MOVEM A,PRVTAB(X)
MOVE A,NAMTB1(M)
MOVEM A,NAMTB1(X)
JRST EOC
TABLST: MOVSI M,-NPAIRS
CAME A,PPTAB(M)
AOBJN M,.-1
JUMPL M,CPOPJ1
POPJ P,
GETSTT: SETZ N,
PUSHJ P,SSP ;GET 1ST CHAR OF RESPONSE
CAIL CH,"0" ;SKIP IF NOT OCTAL NUMBER
CAILE CH,"7" ;SKIP IF OCTAL NUMBER
JRST GETST2 ;NOT OCTAL NUMBER
JRST OCTRD1 ;OCTAL NUMBER
GETST1: PUSHJ P,TTI
GETST2: CAIGE CH,40 ;SKIP UNLESS BREAK CHAR
POPJ P,
CAIE CH,"W" ;W IS WRITE ENABLE
CAIN CH,"C" ;C IS CREATE
JRST GETST1
CAIN CH,"R" ;R IS (SOFTWARE) READ ONLY
JRST RSTAT
CAIN CH,"N" ;N IS NO CREATE
JRST NSTAT
PUSHJ P,JBK ;READ AND IGNORE REST OF LINE
MSG <?
STATUS BITS: >
JRST GETSTT
RSTAT: TLO N,ST.SRO ;SET READ ONLY BIT
JRST GETST1
NSTAT: TLO N,ST.NCR ;SET NO CREATE BIT
JRST GETST1
SUBTTL I/O SUBROUTINES
TTI: TRZE F,TYOF
OUTPUT TTYFIL,0
SOSG TYIB+2 ;THE BASIC TYI ROUTINE
INPUT TTYFIL,0
ILDB CH,TYIB+1
JUMPE CH,TTI
CAIN CH,32 ;[151] CNTRL-Z?
JRST [SKIPN UPDF ;[151] YUP
JRST [RESET
EXIT ]
JRST EOC]
CAIN CH,15
JRST TTI
CAIE CH,175
CAIN CH,176
MOVEI CH,33
CAIL CH,140
CAILE CH,172
SKIPA
SUBI CH,40 ;TURN LOWER CASE TO UPPER
CAIL CH,40 ;BREAK?
CPOPJ: POPJ P,0
TRZ F,BKALTF ;YES.
CAIN CH,33 ;ALTMODE?
TRO F,BKALTF ;YES. REMEMBER.
POPJ P,0
CRLF: MOVEI M,CRMSG ;TYPE A CARRET LINEFEED
MESSAG: HRLI M,440700 ;THE STANDARD MESSAGE PRINTER
MSG1: ILDB CH,M
JUMPE CH,CPOPJ
PUSHJ P,TYO
JRST MSG1
OCT12: MOVEI C,14
OCTPL: MOVEI B,0
ROTC A,3
MOVEI CH,60(B)
PUSHJ P,TYO
SOJG C,OCTPL
POPJ P,0
TSIXPT: PUSHJ P,SIXBPT ;OUTPUT SIXBIT IN A FOLLOWED BY TAB
JRST TAB
TOCTPT: PUSHJ P,OCTPNT ;OUTPUT OCTAL NUMBER IN A FOLLOWED BY TAB
JRST TAB
TDECPT: PUSHJ P,DECPNT ;OUTPUT DECIMAL NUMBER IN A FOLLOWED BY TAB
JRST TAB
;PRINT A PPN PASSED IN ACCU A
PRPPN: PUSH P,A ;SAVE THE PPN
MOVEI CH,"[" ;GET CHAR
CALL TYO ;TOO DELIMIT THE PAIR
HLRZS A ;GET PROJECT
CALL OCTPNT ;PRINT IT
CALL COMMA ;PRINT A COMMA
POP P,A ;GET THE PPN BACK
HRRZS A ;GET PROGRAMMER NUMBER
CALL OCTPNT ;PRINT IT
MOVEI CH,"]" ;FOLLOWED BY THE
CALL TYO ;PROPER DELIMITER
RETURN
DECPNT: SKIPA B,[12]
OCTPNT: MOVEI B,10
MOVEM B,RADIXX
TRZ F,SIGNF
TLZN A,400000 ;SKIP IF SIGN BIT, ALWAYS CLEAR FOR DIVIDE
JRST RDXPNT
TRO F,SIGNF ;REMEMBER THAT SIGN BIT
JUMPE A,SPOCT ;BUT IF NOTHING ELSE, DOESN'T COME OUT RIGHT
RDXPNT: IDIV A,RADIXX
HRLM B,0(P)
SKIPE A
PUSHJ P,RDXPNT
HLRZ CH,0(P)
TRZE F,SIGNF ;SKIP IF NO SIGN BIT
ADDI CH,4 ;IF SO KLUDGE IT
RDXPT1: ADDI CH,60
TYO: TRNE F,AUXF
JRST AUXTYO ;AUXILIARY LIST DEV
SOSG TYOB+2 ;ORDINARY TYPE OUT
OUTPUT TTYFIL,0
IDPB CH,TYOB+1
TRO F,TYOF
POPJ P,0
SPOCT: JSP M,MESSAG
ASCIZ .400000000000.
CRMSG: ASCIZ /
/
SPACE: MOVEI CH," "
JRST TYO
COMMA: MOVEI CH,","
JRST TYO
TAB: MOVEI CH,11
JRST TYO
SIXBPS: TROA F,SHTSPT
SIXBPT: TRZ F,SHTSPT
MOVE M,[XWD 440600,A]
SIXBPL: ILDB CH,M
TRNE F,SHTSPT
JUMPE CH,CPOPJ
ADDI CH,40
PUSHJ P,TYO
TLNE M,770000
JRST SIXBPL
POPJ P,0
PPNIGT: TROA F,PPNRDF ;ALLOW = FOR TERMINATOR
PPNGET: TRZ F,PPNRDF ;DONT ALLOW =
PUSHJ P,OCTSPC ;LOOK FOR SPECIAL PPN CHARACTERS
JRST IERRP ;ILLEGAL NUMBER
MOVEM N,NUM1 ;STORE PROJ
SETZM NUM2 ;CLEAR PROG IN CASE NONE SPECIFIED
CAIGE CH,40 ;SKIP IF NOT TERMINATED BY A BREAK CHAR
POPJ P, ;ALL DONE
PUSHJ P,OCTSPC ;LOOK FOR SPECIAL PPN CHARS
JRST IERRP ;ILLEGAL NUMBER
TRZ F,PPNRDF
MOVEM N,NUM2
CAIE CH,"="
JRST JBK
POPJ P,
OCTSPC: PUSHJ P,SSP ;GET FIRST NON-BLANK CHAR
MOVSI N,-SPCHRL ;PTR TO TABLE OF SPECIAL CHARS
HLL CH,SPCHRT(N) ;SET UP CH FOR NEXT COMPARE
CAME CH,SPCHRT(N) ;SKIP IF FOUND A CHARACTER
AOBJN N,.-2 ;NO, KEEP LOOKING
JUMPGE N,OCTSP1 ;JUMP IF NOT A SPECIAL CHAR
HLRZ N,CH ;PICK UP INTENDED VALUE
PUSHJ P,TTI ;READ TERMINATOR
JRST CPOPJ1 ;AND GIVE OK RETURN
OCTSP1: SETZ N, ;START WITH A 0
HRRZS CH ;RESTORE THE ORIGINAL CHAR
PUSHJ P,OCTRDC ;READ OCTAL NUMBER
JUMPL N,CPOPJ ;NEGATIVE IS ILLEGAL
CAIL N,SIGN ;SKIP IF NOT TOO BIG
CAIL N,OKSIGN ;BUT SPECIAL NUMBERS ARE OK
JRST CPOPJ1 ;OK
POPJ P, ;ILLEGAL NUMBER
SPCHRT: XWD DEFPRG,"%" ;% IS DEFAULT NUMBER
XWD UNIPRG,"#" ;# IS CREATE UNIQUE PPN WHEN LOGIN
XWD ALLPRG,"*" ;* IS WILD CARD FOR ALL NUMBERS
SPCHRL==.-SPCHRT
OCTRD: MOVEI N,0
PUSHJ P,SSP
SKIPA
OCTRDL: PUSHJ P,TTI
OCTRDC: TRNN F,PPNRDF ;SKIP IF ALLOWING = BE TERMINATOR
JRST OCTRD1
CAIN CH,"="
POPJ P,
OCTRD1: CAIN CH,"]" ;SKIP IF NOT ]
POPJ P, ;EXIT
CAILE CH,67
JRST OCTERR
CAIGE CH,60
POPJ P,0
LSH N,3
TRO N,-60(CH)
JRST OCTRDL
DECRD: MOVEI N,0
PUSHJ P,SSP
SKIPA
DECRDL: PUSHJ P,TTI
CAILE CH,71
JRST DECERR
CAIGE CH,60
POPJ P,0
IMULI N,12
ADDI N,-60(CH)
JRST DECRDL
SIXAN: MOVEI WD,0
MOVE M,[XWD 440600,WD]
PUSHJ P,SSP
SKIPA
SIXANL: PUSHJ P,TTI
CAIG CH,132
CAIGE CH,60
POPJ P,0
CAIGE CH,101
CAIG CH,71
SKIPA
POPJ P,0
SUBI CH,40
TLNE M,770000
IDPB CH,M
JRST SIXANL
;SSP IS CALLED TO FIND A NONBLANK IN THE INPUT STREAM
;FNDDEL IS CALLED WITH A CHARACTER IN CH AND SERVES THE SAME PURPOSE
SSP: CALL TTI ;GET A CHARCTER
FNDDEL: CAIE CH,.CHSPC ;IF IT IS A SPACE
CAIN CH,.CHTAB ;OR A TAB THEN
JRST SSP ;GET ANOTHER CHARACTER
RETURN ;ELSE RETURN
;FLUSHL GET RID OF THE REST OF A LINE LEAVE F FLAG SET BKALTF
FLUSHL: SOSG TYIB+2 ;STILL CHARACTERS
RETURN ;(NO) NO INPUT WAIT
ILDB CH,TYIB+1 ;GET A CHARACTER
FLUSHC: CAIN CH,.CHLF ;OR A LINE FEED THEN
RETURN ;ALL IS OVER
CAIE CH,175 ;ANY FORM OF ALTMODE
CAIN CH,176 ;OR THIS ONE
JRST CRLF0 ;THEN TYPE CRLF
CAIN CH,33 ;OR THE OTHER ONE
JRST CRLF0 ;NEW LINE
JRST FLUSHL ;ELSE FLUSH MORE
CRLF0: TRO F,BKALTF ;SET ALTMODE FLAG
JRST CRLF ;CARRIAGE RETURN LINE FEED
OCTERR: JSP M,RC2
ASCIZ /?BAD OCTAL NUMBER/
DECERR: JSP M,RC2
ASCIZ /?BAD DECIMAL NUMBER/
FILSPC: SETZM DEV
SETZM FILE
SETZM PROJ
SETZM PROG
TRZ F,DOTF
FILSPL: PUSHJ P,SIXAN
CAIE CH,":"
JRST FILSP1
MOVEM WD,DEV
JRST FILSPL
FILSP1: CAIE CH,"."
JRST FILSP2
TRO F,DOTF
MOVEM WD,FILE
JRST FILSPL
FILSP2: CAIE CH,"["
JRST FILSP3
TRNE F,DOTF
MOVEM WD,EXT
TRNN F,DOTF
MOVEM WD,FILE
PUSH P,NUM1
PUSH P,NUM2
PUSHJ P,PPNGET
MOVE WD,NUM1
MOVEM WD,PROJ
MOVE WD,NUM2
MOVEM WD,PROG
POP P,NUM2
POP P,NUM1
JBK1: CAIL CH,40
CAIN CH,","
POPJ P,
PUSHJ P,TTI
JRST JBK1
FILSP3: CAIL CH,40
CAIN CH,","
CAIA
JRST FILERR
TRNE F,DOTF
MOVEM WD,EXT
TRNN F,DOTF
MOVEM WD,FILE
POPJ P,0
FILERR: JSP M,RC2
ASCIZ /?BAD FILE NAME SYNTAX/
SIXBRI: MOVEI WD,0
MOVE M,[XWD 440600,WD]
SIXBRL: PUSHJ P,TTI
CAIG CH,137
CAIGE CH,40
POPJ P,0
SUBI CH,40
IDPB CH,M
TLNE M,770000
JRST SIXBRL
JRST CPOPJ1
SIXBRD: PUSHJ P,SIXBRI
POPJ P,0
SIXBRJ: PUSH P,WD
PUSHJ P,SIXBRI
SKIPA
JRST .-2
POP P,WD
POPJ P,0
SIXBR2: PUSHJ P,SIXBRI
JRST SIXB2A
MOVEM WD,ENTRY+NM1WRD
PUSHJ P,SIXBRI
JRST SIXB2B
MOVEM WD,ENTRY+NM2WRD
JRST SIXBRJ
SIXB2A: MOVEM WD,ENTRY+NM1WRD
SETZM ENTRY+NM2WRD
JRST JBK
SIXB2B: MOVEM WD,ENTRY+NM2WRD
POPJ P,0
YESNO: PUSHJ P,TTI
CAIE CH,"Y"
AOSA 0(P)
PUSHJ P,TTI
JBK: CAIL CH,40
JRST .-2
POPJ P,0
SUBTTL DATA AND STORAGE
PDP: IOWD 20,PDPBLK ;PUSHDOWN POINTER
SMSG: ASCIZ /
FOR HELP TYPE "H<CAR RET>"
/
STARMS: ASCIZ /
*/
DEFINE MONMAC (A)<
IRP A,<SIXBIT \A\>>
MONTAB: MONMAC <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
KONBYT: POINT 6,TIMTAB(B),26
TYPBYT: POINT 3,TIMTAB(B),32
CLSBYT: POINT 3,TIMTAB(B),35
KONTYP: SIXBIT .DR.
SIXBIT .FH.
SIXBIT .DP.
SIXBIT .MF.
SIXBIT .FS.
SIXBIT .RP. ;RH10 RPO4 COMBINATION
NKONT=.-KONTYP
HEADING: ASCIZ /
PROJ PROG NAME PRIV CODE TIMES
CORE(PHYS,,VIRT) IPCF(SEND,,RECV.) PROFILE CUSP CHG
EXPIRES SCD TYPE ENQ-DEQ
/
SHEADING: ASCIZ .
STR PROJ PROG NAME UNIT CLASS KONT U TYPE
.
AHEADING: ASCIZ .
PROJ PROG STR RESRVD FCFS Q OUT STATUS
.
QHEADING: ASCIZ .
PROJ PROG RESRVD FCFS Q OUT
.
DEFPAG: BYTE (9) DFMXPP,DFMXVM,DEFSND,DEFRCV
STDTIM: -1 ;DEFAULT LOGIN TIMES
STDPRV: 0 ;DEFAULT JOB PRIVILEGES
STDPRO: P.LGAL!P.PWAL
PRIME: XWD 1776,0 ;PRIME TIME
MFDPPN: XWD 1,1
OPQPPN: XWD 3,3
HELPFM: -1
SCDTYP: POINT 9, SIXTAB(X), 26 ;[147] SCHEDULER TYPE
ENQDEQ: POINT 9, SIXTAB(X), 35 ;ENQ/DEQ QUOTA
SCDPTR: POINT 9, ENTRY+SIXWRD, 26 ;SCHEDULER TYPE
EDQPTR: POINT 9, ENTRY+SIXWRD, 35 ;ENQ/DEQ QUOTA
SIXDEF: XWD 0, 000777 ;DEFAULT 6.02 ENTRY VALUES
RC1: Z ;SIXBITNAME OF INPUT DEVICE
UPDF: Z ;UPDATE FLAG SET WHEN NOT RELEASED
;INPUT DEVICE
;NAME FIELD FOR LOOKUPS AND ENTERS OF ACCOUNTING FILES
NAME: NAMLEN ;**[12] LENGTH OF THE BLOCK
NAME0: Z ;**[12] PPN FIELD
NAME1: Z ;**[12] NAME FIELD
NAME2: Z ;**K12] EXTENSION FIELD
NAME3: Z ;UNUSED
NAME4: Z ;UNUSED
NAMLEN=.-NAME-1
XLIST ;LITERALS
LIT
LIST ;LITERALS
CSAVX: BLOCK 1
CSAVPT: BLOCK 1
ENTSIZ: BLOCK 1
RADIXX: BLOCK 1
ROLD: BLOCK 1
PDPBLK: BLOCK 20 ;PUSHDOWN STORAGE
CLR: ;FOLLOWING LOCATIONS CLEARED AT EACH COMMAND
;SCRATCH PAD
LHAND: Z ;SEE ABOVE
ENTRY: BLOCK AC1BLK*MAXFS+1
FILE: BLOCK 1 ;FILE NAME FOR I/O
EXT: BLOCK 1 ;FILE EXTENSION
PROJ: BLOCK 1 ;PROJECT NUMBER
PROG: BLOCK 1 ;PROGRAMMER NUMBER
NUM1: BLOCK 1 ;FIRST NUMERIC ARGUMENT
NUM2: BLOCK 1 ;SECOND NUMERIC ARGUMENT
DEV: BLOCK 1 ;DEVICE NAME
CLREND: ;END OF CLEARED ITEMS
CURVER: BLOCK 1 ;VERSION WE GIVE NOW TO FILES
CURNAM: BLOCK 1
CUREXT: BLOCK 1
SAVPPN: BLOCK 1 ;PPN OF INPUT FILE
SYSPPN: BLOCK 1 ;SYS PPN
TYIB: BLOCK 3 ;HEADER FOR TYPEIN
TYOB: BLOCK 3 ;HEADER FOR TYPE OUT
DIB: BLOCK 3 ;HEADER FOR DATA INPUT
DOB: BLOCK 3 ;HEADER FOR DATA OUTPUT
AOB: BLOCK 3 ;HEADER FOR AUXILIARY LISTING OUTPUT
DUO: BLOCK 3 ;FOR UPDATE MODE ON INFIL
CODTAB: BLOCK NPAIRS+1 ;THE PASSWORDS
PPTAB: BLOCK NPAIRS+1 ;THE PROJ-PROG PAIRS
PRVTAB: BLOCK NPAIRS+1
DSKTAB: BLOCK NPAIRS+1
TIMTAB: BLOCK NPAIRS+1
NAMTB1: BLOCK NPAIRS+1
NAMTB2: BLOCK NPAIRS+1
CORTAB=DSKTAB
PROTAB: BLOCK NPAIRS+1
PR2TAB: BLOCK NPAIRS+1
CRNTAB: BLOCK NPAIRS+1
CRDTAB: BLOCK NPAIRS+1
CRPTAB: BLOCK NPAIRS+1
CHGTAB: BLOCK NPAIRS+1
XPDTAB: BLOCK NPAIRS+1
SIXTAB=XPDTAB
LASTPK: BLOCK 1
CODEND: ;END OF THE TABLES (FOR CLEARING)
END REACT