Trailing-Edge
-
PDP-10 Archives
-
KS10_APT_INSTALL_TAPE
-
uetp/lib/cmlbad.mac
There is 1 other file named cmlbad.mac in the archive. Click here to see a list.
TITLE ADMLIB LIBRARY OF MODULES FOR ADMINISTRATION PROGS.
SUBTTL C.MITCHELL 1977
SEARCH CMLBSM ;FOR VERSION NUMBER
;;THE FOLLOWING IS A LIBRARY OF MODULES WHICH ARE USED BY
;;VARIOUS SYSTEM ADMINISTRATION PROGRAMS. THE IDEA IS THAT
;;EACH MAIN FUNCTION SHOULD BE MADE MODULAR SO THAT A NEW
;;SYSTEM ADMINISTRATION PROGRAM CAN BE QUICKLY WRITTEN TO
;;READ OR MODIFY STANDARD FILES, ETC. THE CONSTRUCTION OF
;;THIS LIBRARY SHOULD BE THAT OF A STANDARD LIBRARY SO THAT
;;ONLY THOSE MODULES WHICH ARE REQUIRED ARE LOADED.
;;ORDER IS IMPORTANT!!!
ADMLBV==1 ;VERSION NUMBER OF THIS FILE
IFN <ADMLBV-CMSYMV>,<PRINTX <MISMATCHED UNIVERSAL AND ADMLIB!>>
PRGEND
TITLE EXIT EXIT TO MONITOR
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY .EXIT,.EXIT1
;HERE TO EXIT TO MONITOR. CALL PROGRAM DEPENDENT ROUTINE
;"CLSUP" TO TIDY UP ANYTHING SPECIFIED IN THE PROGRAM,
;AND CLOSES ALL FILES. FINALLY IT EXITS TO MONITOR AND
;WILL NOT ALLOW A CONTINUE.
.EXIT: HRROI T2,[ASCIZ /TO MONITOR/]
PUSHJ P,CRMNOI## ;MAKE SOME NOISE
PUSHJ P,CRGTCM## ;GET CONFIRMATION
PJRST CPOPJ1## ;BAD. GIVE A SKIP RETURN
.EXIT1: PUSHJ P,CLSUP## ;PROGRAM DEPENDENT ROUTINE
SETOM T1 ;CLOSE ALL FILES
CLOSF
PUSHJ P,JSERPJ## ;COULD NOT CLOSE UP.
HALTF ;EXIT TO MONITOR
JRST .-1 ;NO CONTINUES
PRGEND
TITLE DISABL DISABLE WHEEL PRIVILEDGES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY .DSABL,.DSAB1
;HERE TO DISABLE WHEEL PRIVILEDGES. ENTER AT .DSABL IF
;CONFIRMATION REQUIRED. ELSE ENTER AT .DSAB1.
.DSABL: HRROI T2,[ASCIZ /WHEEL PRIVILEDGES/]
PUSHJ P,CRMNOI## ;MAKE SOME NOISE
PUSHJ P,CRGTCM## ;GET CONFIRMATION
PJRST CPOPJ1## ;BAD CONFIRMATION. CONVENTIONAL RETURN
AOS (P) ;GIVE SKIP RETURN WHEN DONE
.DSAB1: PJRST DISWHL## ;ALL THERE IS TO DO!
PRGEND
TITLE ENABLE ENABLE WHEEL PRIVILEDGES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY .ENABL,.ENAB1
;ROUTINE TO ENABLE WHEEL PRIVILEDGES. ENTER AT .ENABLE
;IF CONFIRMATION REQUIRED. ELSE ENTER AT .ENAB1.
.ENABL: HRROI T2,[ASCIZ /WHEEL PRIVILEDGES/]
PUSHJ P,CRMNOI## ;MAKE SOME NOISE
PUSHJ P,CRGTCM## ;GET CONFIRMATION
PJRST CPOPJ1## ;BAD. RETURN SKIP
AOS (P) ;SKIP RETURN
.ENAB1: PUSHJ P,ENBWHL## ;TURN ON!
JFCL ;FREAK OUT!!
POPJ P, ;**** OFF!!!
PRGEND
TITLE HELP PRINT HELP FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY .HELP,.HELP1
;COMMAND TO TYPE HELP FILE. LOOKS FOR A FILE WITH EXTENSION
;"HLP" ON DEVICE "HLP:" AND PRINTS IT. LOCATION "HELPNM##"
;SHOULD CONTAIN THE NAME OF THE HELP FILE.
.HELP: HRROI T2,[ASCIZ /for this program/]
PUSHJ P,CRMNOI## ;MAKE A LOT OF NOISE!!
PUSHJ P,CRGTCM## ;GET CONFIRMATION
PJRST CPOPJ1## ;BAD
AOS (P) ;GIVE SKIP AT END
.HELP1: MOVX A,<GJ%OLD> ;MUST EXIST
HRRI A,[ASCIZ /HLP:/] ;ON DEVICE HELP
SETZM B ;NO DIRECTORY
HRROI C,HELPNM## ;GET FILENAME
HRRZI D,[ASCIZ /HLP/] ;EXTENSION
PUSHJ P,GTJCLS## ;SET UP
MOVE T1,[.NULIO,,.NULIO]
MOVEM T1,GTJBLK+.GJSRC ;NO INPUT
MOVEI T1,GTJBLK## ;POINT TO BLOCK
HRROI T2,[ASCIZ //] ;NONAME
GTJFN ;GET JFN FOR IT
ERROR CPOPJ##,<UNABLE TO FIND HELP FILE>
HRRZ INP,T1 ;SAVE JFN
PUSHJ P,OPFLIA## ;OPEN FOR INPUT
ERROR CPOPJ##,<UNABLE TO READ HELP FILE>
HLPLP1: PUSHJ P,JBIN## ;GET CHAR
JRST EOF ;OK
HRRZ T1,T2 ;COPY CHAR
PBOUT ;TYPE IT
JRST HLPLP1 ;DO ALL
;HERE ON EOF
EOF: PUSHJ P,CIFLLJ## ;CLOSE UP
JFCL ;NO ERRORS
HRROI T1,[ASCIZ /
[END OF HELP FILE]
/]
PSOUT
POPJ P, ;OK
PRGEND
TITLE RNGOUT OUTPUT TO FILE AND RING WITH STARS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY RNGOUT
;ROUTINE TO OUTPUT CHARACTER TO FILE AND RING FILE WITH
;STARS. ENTER WITH CHARACTER TO OUTPUT IN T2.
RNGOUT: SKIPN FFSEEN## ;START OF PAGE?
JRST RNGLP1 ;NO
PUSH P,T2 ;SAVE CHARACTER
PUSH P,T4 ;AND BYTE POINTER
PUSHJ P,LAYSTP## ;START PAGE
POP P,T4 ;RESTORE POINTER
POP P,T2 ;AND CHARACTER
SETZM FFSEEN## ;NO FORM FEED
RNGLP1: CAIN T2,15 ;CR?
POPJ P, ;IGNORE
CAIN T2,12 ;LF?
JRST RNGLF ;YES
CAIN T2,14 ;FORM-FEED?
JRST RNGFF ;YES
CAIN T2,11 ;TAB?
JRST RNGTAB ;YES
AOSL T1,TABSTP## ;INCREMENT TABS
MOVNI T1,^D8 ;RESET
MOVEM T1,TABSTP## ;RESAVE IT
IDPB T2,RNGBP## ;SAVE CHARACTER
POPJ P, ;DO NEXT
;HERE ON FORM FEED
RNGFF: PUSHJ P,RNGEOF## ;PRETEND EOF
JRST RNGRES## ;RESET
;HERE ON TAB
RNGTAB: AOSG TABSTP## ;INCREMENT COUNT
JRST SIMSPC ;SIMULATE WITH SPACE
MOVNI T2,^D8 ;RESET
MOVEM T2,TABSTP## ;SAVE IT
POPJ P, ;GET NEXT CHARACTER
SIMSPC: MOVEI T2," " ;SEND SPACE
IDPB T2,T4 ;WRITE IT
JRST RNGTAB ;GO ROUND
PAGE
;HERE TO FINISH OFF LINE
FINLIN::MOVEI T2,0 ;MAKE ASCIZ
IDPB T2,RNGBP## ;SAVE IT
HRROI T2,BUFFER## ;POINT TO STRING
PJRST OTSTST## ;PRINT IT WITH STARS
;HERE TO FINISH OFF PAGE
FINPAG::SKIPG LINES## ;ANY LINES TO THROW?
JRST RNGCOM ;FINISH OFF
FINPG2: PUSHJ P,BLANK## ;THROW A LINE
SOSLE LINES## ;DECREMENT COUNT
JRST FINPG2 ;KEEP ON
PJRST RNGCOM ;FINISH OFF
;HERE ON LINE FEED
RNGLF: PUSHJ P,FINLIN ;FINISH OFF LINE FIRST
SOSL LINES## ;DECREMENT LINES
JRST RNGRS1## ;DO NEXT
RNGCOM: SETOM FFSEEN## ;SEEN FORM FEED
PJRST LAYFFO## ;FINISH OFF
PRGEND
TITLE RNGEOF RING A FILE WITH STARS-DEAL WITH EOF
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY RNGEOF
;ROUTINE TO DEAL WITH EOF WHEN RINGING WITH STARS.
RNGEOF: SKIPE FFSEEN## ;JUST SEEN FORM FEED?
POPJ P, ;NOTHING TO DO
PUSHJ P,FINLIN## ;FINISH LINE
PJRST FINPAG## ;FINISH PAGE
PRGEND
TITLE LAYOUT PRINT ACCORDING TO BIT MAP
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYOUT
;ROUTINE TO PRINT A LAYOUT ACCORDING TO A BIT MAP.
;ENTER WITH "A" POINTING TO A TABLE. THE LEFT HALF
;SHOULD CONTAIN BITS AND THE RIGHT HALF SHOULD
;CONTAIN DISPATCHES. PERFORMS THE FOLLOWING FUCTIONS:-
;IF LY%PNT=1 ;PRINT STRING POINTED TO BY DISPATCH
;IF LY%PST=1 ;PRINT STRING RINGED WITH "*"
;IF LY%RTN=1 ;PUSHJ TO ROUTINE IN DISPATCH.
LAYOUT: MOVE T1,(A) ;GET TABLE ENTRY
JUMPE T1,CPOPJ1## ;ALL DONE
TLNN T1,LY%PNT ;STRING?
JRST NTSTG ;NO
HRRO T2,T1 ;POINT TO IT
PUSHJ P,STGOUT## ;PRINT IT
PUSHJ P,CRLF## ;NEW LINE
JRST STGCOM ;DO NEXT
NTSTG: TLNN T1,LY%PST ;STRING WITH STARS?
JRST NTSTR ;NO
HRRO T2,(A) ;POINT TO STRING
PUSHJ P,OTSTST## ;PRINT IT
JRST STGCOM ;DO NEXT
NTSTR: TLNN T1,LY%HDR ;DO HEADER?
JRST NTHDR ;NO
HRROI T2,(T1) ;POINT TO NEW HEADER
MOVEM T2,TITLE## ;SAVE IT
PUSHJ P,LAYSTP## ;START PAGE
JRST STGCOM ;DONE
NTHDR: TLNN T1,LY%CST ;CENTRE ALIGN BETWEEN STARS?
JRST NTCST ;NO
HRRO T2,(A) ;POINT TO STRING
PUSHJ P,OTSTCA## ;DO IT
JRST STGCOM ;DONE
NTCST: TLNE T1,LY%RTN ;DO ROUTINE?
PUSHJ P,(T1) ;DO IT
STGCOM: AOJA A,LAYOUT ;DO NEXT
PRGEND
TITLE LAYNMA LAYOUT ROUTINE TO PRINT NAME AND ADDRESS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYNMA,LAYNMI
;ROUTINE TO PRINT NAME AND ADDRESS FOR USE IN THE
;"LAYOUT" ROUTINE IN CONJUNCTION WITH THE NEWSLETTER.
;ROUTINE "LAYNMI" SHOULD BE CALLED TO INITIALISE THE
;NAME AND ADDRESS. SUBSEQUENTLY, EACH CALL TO "LAYNMA"
;WILL RESULT IN ONE LINE BEING WRITTEN OF WIDTH "PAGWID"
;STARTING AND FINISHING WITH AN "*" WITH ONE LINE OF
;THE NAME AND ADDRESS.
LAYNMI: SETZM LAYFLG## ;INITIALISE FLAG
POPJ P, ;THAT'S ALL
LAYNMA: SKIPE LAYFLG## ;FIRST TIME?
JRST LAYADR## ;PRINT ADDRESS
HRRZ T1,CADR(BUF) ;POINT TO ADDRESS BLOCK
HRRZI T1,AADR(T1) ;POINT TO ADDRESS
HRLI T1,440700 ;MAKE BYTE POINTER
MOVEM T1,LAYFLG## ;SAVE IT
PJRST LAYNAM## ;PRINT NAME
PRGEND
TITLE LAYNAM LAYOUT ROUTINE TO PRINT NAME
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYNAM
;"LAYOUT" ROUTINE TO PRINT NAME CENTRE-ALIGNED BETWEEN
;"*" OF WIDTH "PAGWID".
LAYNAM: PUSH P,OUTP ;SAVE JFN
HRROI OUTP,LAYSPC## ;POINT TO FREE SPACE
MOVE T2,BUF ;POINT TO OUR ENTRY
PUSHJ P,PNTPEP## ;WRITE IT IN CORE
POP P,OUTP ;RESTORE JFN
HRROI T2,LAYSPC## ;POINT TO GENERATED STRING
PJRST OTSTCA## ;OUTPUT IT CENTER ALIGNED IN STARS!
PRGEND
TITLE LAYADR LAYOUT PRINT ADDRESS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYADR
;ROUTINE TO PRINT ADDRESS FOR "LAYOUT" ROUTINE. ENTER WITH
;BYTE POINTER TO ADDRESS IN "LAYFLG". PRINTS ONE LINE
;OF THE ADDRESS FOR EACH CALL, CENTRE-ALIGNED WITHIN STARS.
LAYADR: MOVEI T2,LAYSPC## ;POINT TO FREE SPACE
HRLI T2,440700 ;MAKE BYTE POINTER
MOVE T3,LAYFLG## ;GET POINTER TO ADDRESS
LAYAD1: ILDB T1,T3 ;GET BYTE
CAIN T1,15 ;CR?
JRST LAYAD1 ;IGNORE IT
JUMPE T1,LAYAD3 ;IGNORE ZERO
CAIN T1,12 ;LF?
JRST LAYAD2 ;YES
IDPB T1,T2 ;SAVE IT
MOVEM T3,LAYFLG## ;SAVE BYTE POINTER
JRST LAYAD1 ;DO NEXT
LAYAD2: MOVEM T3,LAYFLG## ;RESAVE BYTE POINTER
LAYAD3: MOVEI T1,0 ;MAKE ASCIZ
IDPB T1,T2 ;SAVE IT
HRROI T2,LAYSPC## ;POINT TO STRING
PJRST OTSTCA## ;PRINT IT
PRGEND
TITLE LAYEDN LAYOUT PRINT EDITION NUMBER
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYEDN
;ROUTINE TO PRINT EDITION NUMBER CENTRE-ALIGNED BETWEEN
;STARS.
LAYEDN: PUSH P,OUTP ;SAVE JFN
HRROI OUTP,LAYSPC## ;WHERE TO BUILD MESSAGE
HRROI T2,[ASCIZ /EDITION NUMBER /]
PUSHJ P,STGOUT## ;WRITE IT
MOVE T2,EDNUM## ;GET IT
MOVX T3,<^D10> ;DECIMAL
PUSHJ P,NUMOUT## ;WRITE IT
POP P,OUTP ;RESTORE JFN
HRROI T2,LAYSPC## ;POINT TO STRING
PJRST OTSTCA## ;WRITE IT
PRGEND
TITLE LAYEDT LAYOUT PRINT EDITION DATE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYEDT
;ROUTINE TO PRINT EDITION DATE.
LAYEDT: PUSH P,OUTP ;SAVE JFN
HRROI OUTP,LAYSPC## ;POINT TO OPEN SPACE
HRROI T2,[ASCIZ /PUBLICATION DATE /]
PUSHJ P,STGOUT## ;PRINT IT
MOVE T2,DATE## ;GET DATE
PUSHJ P,DTONPT## ;PRINT IT
POP P,OUTP ;RESTORE JFN
HRROI T2,LAYSPC## ;POINT TO STRING
PJRST OTSTCA## ;WRITE IT
PRGEND
TITLE LAYFFO LAYOUT FINISH PAGE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYFFO,LAYTHR
;ROUTINE TO FINISH CURRENT PAGE DURING "LAYOUT" ROUTINES.
LAYFFO: PUSHJ P,BLANK## ;PRINT A BLANK LINE
PUSHJ P,STARS## ;PRINT SOME STARS
LAYTHR: PJRST FFOUT## ;AND A FORM FEED
PRGEND
TITLE LAYSTP LAYOUT START PAGE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY LAYSTP
;ROUTINE TO START A NEW PAGE DURING LAYOUT. ENTER WITH
;POINTER TO TITLE IN "TITLE".
LAYSTP: PUSHJ P,STARS## ;PRINT STARS
PUSHJ P,BLANK## ;PRINT BLANK LINE
HRRO T2,TITLE## ;POINT TO TITLE
PUSHJ P,OTSTCA## ;PRINT IT
PUSHJ P,BLANK## ;BLANK LINE
PUSHJ P,STARS## ;PRINT STARS
PUSHJ P,BLANK## ;BLANK LINE
PJRST RNGRES## ;RESET VALUES
PRGEND
TITLE RNGRES RESET PAGE WHEN OUTPUTTING WITH STARS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY RNGRES,RNGRS1
;ROUTINE TO SET UP TO OUTPUT A FILE RINGED WITH STARS!
RNGRES: MOVE T1,LENGTH## ;GET LENGTH
MOVEM T1,LINES## ;SAVE IT
RNGRS1: MOVNI T1,^D8 ;RESET TABS
MOVEM T1,TABSTP## ;SAVE VALUE
MOVE T1,[440700,,BUFFER##] ;WHERE TO ASSEMBLE LINE
MOVEM T1,RNGBP## ;SAVE IT
POPJ P,
PRGEND
TITLE BLANK PRINT A BLANK LINE RINGED WITH STARS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY BLANK
;ROUTINE TO PRINT A BLANK LINE RINGED WITH STARS.
;WIDTH IS C(WIDTH).
BLANK: HRROI T2,[ASCIZ //] ;NOTHING TO PRINT
PJRST OTSTCA## ;SO DO IT
PRGEND
TITLE STARS PRINT ROW OF STARS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY STARS
;ROUTINE TO PRINT A ROW OF STARS. WIDTH IS C(WIDTH)
STARS: MOVE T2,[440700,,OTLNBF##] ;WHERE TO BUILD IT
MOVEI T1,"*" ;WHAT TO PRINT
MOVE T3,WIDTH## ;GET NUMBER TO PRINT
STAR1: IDPB T1,T2 ;SAVE ONE
SOJG T3,STAR1 ;DO ALL
MOVEI T1,0 ;MAKE ASCIZ
IDPB T1,T2 ;FINISH IT
HRROI T2,OTLNBF## ;POINT TO BUFFER
PUSHJ P,STGOUT## ;PRINT IT
PJRST CRLF## ;AND A NEW LINE
PRGEND
TITLE OTSTCA OUTPUT STRING CENTRE-ALIGNED WITH STARS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OTSTCA
;ROUTINE TO OUTPUT A STRING, CENTRE-ALIGNED SURROUNDED
;WITH STARS. ENTER WITH T2 POINTING TO STRING.
OTSTCA: PUSHJ P,CALNST## ;CENTRE ALIGN IT
PJRST OTSTST## ;OUTPUT IT
PRGEND
TITLE CALNST CENTRE ALIGN A LINE--ALOW FOR STARS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY CALNST
;ROUTINE TO CENTRE-ALIGN A STRING ALLOWING FOR STARS
;ON EACH SIDE. ENTER WITH T2 POINTING TO STRING. RETURN
;+1 ALWAYS WITH T2 POINTING TO STRING.
CALNST: MOVE T1,WIDTH## ;GET WIDTH
SUBI T1,4 ;ALLOW FOR STARS
MOVEM T1,WIDTH## ;RESAVE IT
PUSHJ P,CALIGN## ;CENTRE-ALIGN IT
MOVEI T1,4 ;READJUST
ADDM T1,WIDTH## ;DO IT
POPJ P, ;OK
PRGEND
TITLE CALIGN CENTRE ALIGN A STRING.
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY CALIGN
;ROUTINE TO CENTRE ALIGN A STRING. ENTER WITH T2 POINTING
;TO THE STRING. RETURN +1 WITH T2 POINTING TO THE NEW
;STRING 0F WIDTH C(WIDTH).
CALIGN: HLRZ T1,T2 ;GET BITS IN BYTE POINTER
CAIN T1,777777 ;DEFAULT?
HRLI T2,440700 ;MAKE IT GOOD
PUSH P,T2 ;SAVE POINTER
SETZM T3 ;RESET COUNT
CALIG1: ILDB T1,T2 ;COUNT CHARACTERS
JUMPE T1,CALIG2 ;FINISHED
AOJA T3,CALIG1 ;DO ALL
CALIG2: MOVE T1,WIDTH## ;GET PAGE WIDTH
SUB T1,T3 ;ALLOW FOR STRING
ASH T1,-1 ;HALVE IT
MOVE T4,[440700,,OTLNBF##] ;POINT TO BUFFER
JUMPLE T1,CALIG4 ;LONG LINE--NO SPACES
MOVEI T3," " ;SET FOR SPACES
CALIG3: IDPB T3,T4 ;SAVE IT
SOJG T1,CALIG3 ;DO ALL
CALIG4: POP P,T3 ;GET POINTER TO STRING
MOVE T2,WIDTH## ;MAX SIZE
CALIG5: ILDB T1,T3 ;GET CHARACTER
IDPB T1,T4 ;PUT IT DOWN
JUMPE T1,CALIG6 ;FINISHED
SOJG T2,CALIG5 ;DO ALL
CALIG6: MOVEI T3,0 ;MAKE ASCIZ
IDPB T3,T4 ;DO IT
MOVEI T2,OTLNBF## ;POINT TO STRING
HRLI T2,440700 ;MAKE BYTE POINTER
POPJ P,
PRGEND
TITLE OTSTST OUTPUT A STRING BETWEEN STARS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OTSTST
;ROUTINE TO OUTPUT A STRING BETWEEN STARS OF WIDTH C(WIDTH).
;ENTER WITH T2 POINTING TO STRING.
OTSTST: PUSH P,T2 ;SAVE POINTER
HRROI T2,[ASCIZ /* /] ;START OFF RIGHT
PUSHJ P,STGOUT## ;PRINT IT
POP P,T2 ;POINT TO STRING
MOVE T3,WIDTH## ;GET MAX SIZE
SUBI T3,4 ;ADJUST FOR STARS
MOVEI T4,0 ;END ON ZERO
PUSHJ P,JSOUT## ;PRINT IT
JFCL ;NO ERRORS
LDB T4,T2 ;GET LAST BYTE
SKIPE T4 ;IF ZERO-FUDGE IT
JUMPE T3,OTSTS1 ;ALL DONE
AOS T3 ;GIVE EXTRA SPACE
HRROI T2,SPCBUF## ;POINT TO SPACES
PUSHJ P,JSOUT## ;PRINT THEM
JFCL ;NO ERRORS
OTSTS1: HRROI T2,[ASCIZ / */]
PUSHJ P,STGOUT## ;PRINT IT
PJRST CRLF## ;NEW LINE
PRGEND
TITLE GENNMF GENERATE STRING FROM FIRSTNAM & LASTNAME
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY GENNMF,GENNMO
;ROUTINE TO GENERATE A STRING SUITABLE FOR A FILENAME FROM
;A PERSON'S NAME. ENTER WITH BUF POINTING TO NAME BLOCK. RETURN
;WITH T1 POINTING TO A STRING OF FORM "LASTNAME-FIRSTNAME" OF
;THE NAME. ENTER AT "GENNMO" WITH BUF POINTING TO DIRECTORY TO
;GENERATE NAME BASED ON THE OWNER. IF NO OWNER, RETURNED STRING
;IS THE DIRECTORY NAME.
GENNMO: SKIPE DOWN(BUF) ;GET OWNER
JRST GENNM1 ;OK
HRROI T1,DNMB(BUF) ;POINT TO DIRECTORY NAME
POPJ P, ;RETURN
GENNM1: PUSH P,BUF ;SAVE POINTER
HRRZ BUF,DOWN(BUF) ;POINT TO OWNER
PUSHJ P,GENNMF ;GENERATE IT
POP P,BUF ;RESTORE POINTER
POPJ P, ;OK
GENNMF: HRROI T1,OTLNBF## ;WHERE TO GENERATE IT
HRROI T2,CNAM(BUF) ;LASTNAME
SETZM T3 ;LONG STRING
SOUT ;COPY IT
MOVEI T2,"-" ;HYPHEN
BOUT ;WRITE IT
HRROI T2,CFST(BUF) ;THEN FIRST NAME
SETZM T3 ;LONG STRING
SOUT ;WRITE IT
HRROI T1,OTLNBF## ;POINT TO STRING
POPJ P, ;DONE
PRGEND
TITLE INIHEP INITIALISE THE HEAP
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY INIHEP
;ROUTINE TO INITIALISE THE HEAP. THE HEAP IS AN AREA OF
;CORE STARTING AT END OF CORE. LOCATION "NXTBUF" IS
;USED AS A POINTER TO THE NEXT FREE LOCATION ON THE
;HEAP AND HEPLEN CONTAINS LENGTH OF THE HEAP.
;ROUTINES USING THE HEAP SHOULD RESPECT THIS LOCATION
INIHEP: HLRZ T1,.JBSA## ;GET PROGRAM BREAK
MOVEM T1,NXTBUF## ;SAVE IT
MOVEM T1,HEAP## ;TWICE
SUBI T1,HEPTOP ;GET NEGATIVE LENGTH
MOVEM T1,HEPLEN## ;SAVE IT
POPJ P, ;OK
PRGEND
TITLE USFLRD READ A DLUSER-TYPE FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USFLRD
;ROUTINE TO READ A "DLUSER" TYPE FILE INTO CORE. THE FILE
;WHICH IS SIMILAR TO THAT OUTPUT BY DLUSER, IS READ INTO A
;LARGE BUFFER IN CORE. LINKS ARE MADE THROUGH IT TO FACILITATE
;REFERENCING.
USFLRD: PUSHJ P,PLFLRD## ;FIRST READ "PEOPLE" FILE
POPJ P, ;ERROR
PUSHJ P,USFLIS## ;GET FILESPEC AND OPEN FILE
POPJ P, ;COULD NOT
PUSHJ P,USFLIP## ;READ IT INTO CORE
POPJ P, ;ERROR
PUSHJ P,CIFLLJ## ;CLOSE UP
JFCL
PJRST CPOPJ1## ;OK
PRGEND
TITLE USFLIS GET INPUT FILESPEC FOR DIRECTORY FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USFLIS
;HERE TO GET INPUT SPECIFICATION FOR "DLUSER" TYPE FILE.
;OPENS FILE FOR INPUT ASCII MODE.
USFLIS: HRROI T1,[ASCIZ /"DLUSER" FORMAT FILESPEC: /]
MOVX A,<GJ%OLD> ;MUST EXIST
SETZM B ;FROM OUR DIRECTORY
HRROI C,[ASCIZ /USERNAMES/]
HRRZI D,[ASCIZ /TXT/]
PUSHJ P,CCGTFL## ;GET IT
HRRZ INP,T2 ;COPY IT
PJRST OPFLIA## ;OPEN FOR INPUT ASCII
PRGEND
TITLE USFLIP INPUT DLUSER-TYPE FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USFLIP
;ROUTINE TO INPUT "DLUSER"-TYPE FILE INTO CORE.
USFLIP: MOVEI T1,DMXUSR ;MAX NUMBER OF USERS
MOVEM T1,USNMTB## ;INITIALISE TABLE OF USER NAMES
SETZM USCHNS## ;NO START YET
USIPL1: PUSHJ P,USRCLD## ;READ ALL RECORDS
ERROR CPOPJ##,<ERROR WHILST READING "DLUSER" FILE>
PJRST CPOPJ1## ;OK
PRGEND
TITLE USRCLD READ RECORDS FROM THE "DLUSER" FILE INTO CORE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USRCLD
;ROUTINE TO READ RECORDS FROM THE "DLUSER" FILE INTO CORE.
USRCLD: SKIPL HEPLEN## ;FILLED HEAP?
ERROR CPOPJ##,<FILLED HEAP>
MOVE BUF,NXTBUF## ;GET NEXT FREE LOCATION
MOVE T1,BUF ;COPY IT
MOVEI T2,DSPC(T1) ;UPPER LIMIT
PUSHJ P,BLTCLR## ;CLEAR SPACE FIRST
USRCL1: PUSHJ P,JBIN## ;GET A CHARACTER
JRST RDRCEF## ;EOF?
CAIN T2,"#" ;TYPE?
JRST USRCTP ;YES
CAIE T2,"&" ;NEW STYLE DLUSER?
CAIN T2,"!" ;OR OUR NAME MARKER?
JRST USRCNM ;YES
CAIN T2,"*" ;OWNER?
JRST USRCOW ;YES
CAIE T2,"$" ;DOLLAR?
JRST USRCL1 ;IGNORE IT
PUSHJ P,JFLIN## ;GET NUMBER
POPJ P, ;BAD
MOVEM T2,DNCN(BUF) ;SAVE IT
PUSHJ P,JFLIN## ;GET NEXT
POPJ P, ;BAD
MOVEM T2,DNCP(BUF) ;SAVE IT
PUSHJ P,JFLIN## ;GET NEXT
POPJ P, ;BAD
MOVEM T2,DPCN(BUF) ;SAVE IT
PUSHJ P,JFLIN## ;GET NEXT
POPJ P, ;BAD
MOVEM T2,DPCP(BUF) ;SAVE IT
PUSHJ P,JFLIN## ;GET NEXT
POPJ P, ;BAD
MOVEM T2,DDSK(BUF) ;SAVE IT
JRST USRCL1 ;GET NEXT
PAGE
;HERE WHEN WE HAVE A TYPE MARKER
USRCTP: HRROI T2,NAMBUF## ;WHERE TO PUT IT
MOVEI T3,^D39 ;MAX CHARACTERS
PUSHJ P,RDUPCR## ;READ IT
PJRST RDRCEF## ;BAD?
MOVEI T1,TYPTAB## ;LOOK IT UP
HRROI T2,NAMBUF## ;POINT TO STRING
TBLUK ;FIND IT
TXNN T2,TL%EXM ;MATCH?
JRST [SETZM T1
JRST SAVTYP] ;NONE YET
HRRZ T1,(T1) ;GET INDEX
MOVE T1,(T1) ;A LONG WAY BUT...
SAVTYP: MOVEM T1,DTYP(BUF) ;SAVE IT
JRST USRCL1 ;LOOK FOR NEXT ITEM
;HERE TO CHECK VALID TYPE
CHKTYP: SKIPN USNCHK## ;NO CHECKS?
SKIPE DTYP(BUF) ;VALID?
POPJ P, ;YES
HRROI T2,[ASCIZ /
UNKNOWN OR BAD TYPE FOR /]
PUSHJ P,STGOUT## ;TELL HIM
PUSHJ P,PNDRNM## ;ALL
PUSHJ P,CRLF## ;THROW LINE
PUSHJ P,ESTTYP## ;GET NEW TYPE
MOVEM T2,DTYP(BUF) ;SAVE IT
SETOM USCHFG## ;SOMETHING CHANGED
POPJ P, ;DONE
PAGE
;HERE WHEN WE HAVE A DIRECTORY MARKER
USRCNM: HRRZI T2,DNMB(BUF) ;MAKE A BYTE POINTER
HRLI T2,440700 ;TO POINT TO NAME
MOVEM T2,DNAM(BUF) ;SAVE IT
MOVEI T3,^D39 ;MAX SIZE
PUSHJ P,RDUPCR## ;READ UP TO CARRIAGE RETURN
PJRST RDRCEF## ;ERROR?
HRROI T1,DNMB(BUF) ;POINT TO NAME
PUSHJ P,JSTNAM## ;ONLY THE NAME WANTED
PUSHJ P,USSCNS ;READ UP TO SPACE MARKING PASSWORD
PJRST RDRCEF## ;ERROR?
HRRZI T2,DPSB(BUF) ;MAKE A BYTE POINTER
HRLI T2,440700 ;TO POINT TO PASSWORD
MOVEM T2,DPAS(BUF) ;SAVE IT
MOVEI T3,^D39 ;MAX SIZE
PUSHJ P,RDUPCR## ;READ PASSWORD
PJRST RDRCEF## ;BAD?
MOVSI D,-<.CDLLD-.CDLIQ+1> ;NUMBER OF PARAMETERS
HRRI D,DWOR(BUF) ;WHERE TO PUT IT ALL
USRCL2: PUSHJ P,USSCNS ;POSITION TO BEGINNING OF NUMBER
PJRST RDRCEF## ;ERROR?
MOVEI T3,10 ;OCTAL
PUSHJ P,JNIN## ;READ A NUMBER
JRST [CAIE T3,IFIXX3 ;OVERFLOW?
PJRST RDRCEF## ;NO--ERROR
JRST .+1]
MOVEM T2,(D) ;SAVE RESULT
AOBJN D,USRCL2 ;DO ALL
PUSHJ P,CHKTYP ;CHECK TYPE
PUSHJ P,CHKOWN ;CHECK OWNER
MOVEI D,DSPC(BUF) ;WHERE TO LOAD GROUPS
PUSHJ P,LODGRP ;LOAD USER GROUPS
PJRST RDRCEF## ;BAD?
MOVEM D,DUGP(BUF) ;SAVE POINTER
ADD D,(D) ;POINT TO FREE AREA
AOS D ;+1
PUSHJ P,LODGRP ;LOAD DIRECTORY GROUPS
PJRST RDRCEF## ;ERROR?
MOVEM D,DDGP(BUF) ;SAVE POINTER
ADD D,(D) ;UPDATE POINTER
AOS D
SUB D,NXTBUF## ;HOW LONG DID WE GO?
ADDM D,NXTBUF## ;A BIT STRANGE BUT..
ADDM D,HEPLEN## ;WE MUST DO IT
MOVE T2,DNUM(BUF) ;GET NUMBER
SKIPE PNT,USCHNS## ;POINT TO START OF CHAIN
PUSHJ P,USFNNO## ;FIND WHERE TO PUT IT
SKIPA T1,USCHNS## ;OK--POINT TO CHAIN AGAIN
ERROR USRCLD,<TWO DIRECTORIES WITH THE SAME NUMBER>
PUSHJ P,LINKIN## ;LINK IT IN
MOVEM T1,USCHNS## ;SAVE NEW START
PUSHJ P,USINTB## ;PUT IN TABLES
POPJ P, ;COULD NOT
JRST USRCLD ;GET NEXT
PAGE
;HERE WHEN WE HAVE FOUND AN ASTERISK. AN OWNER'S NAME
;FOLLOWS.
USRCOW: HRROI T2,NAMBUF## ;MAKE A BYTE POINTER
MOVEI T3,^D39 ;MAX SIZE FOR NAME
PUSHJ P,RDUPSP## ;GET STRING
PJRST RDRCEF## ;BAD
HRROI T2,FSTBUF## ;MAKE BYTE POINTER
MOVEI T3,^D39 ;MAX SIZE FOR NAME
PUSHJ P,RDUPCR## ;GET STRING
PJRST RDRCEF## ;BAD
JRST USRCL1 ;GET NEXT
;HERE TO CHECK FOR VALID OWNER
CHKOWN: PUSHJ P,PLFNDN## ;SEE IF IT IS A VALID NAME
SKIPA OUTP,[.PRIOU] ;NO
JRST USRCN1 ;OK
SKIPN USNCHK## ;NO CHECKS?
PUSHJ P,CHKSYS## ;OR SYSTEM DIRECTORY?
POPJ P, ;FORGET IT
HRROI T2,[ASCIZ /
UNKNOWN OWNER OF /]
PUSHJ P,STGOUT## ;TELL HIM
PUSHJ P,PNDRNM## ;TYPE DIRECTORY NAME
HRROI T2,[ASCIZ / (/]
PUSHJ P,STGOUT## ;PRINT IT
PUSHJ P,PNTNAM## ;PRINT OWNER
HRROI T2,[ASCIZ /)
/]
PUSHJ P,STGOUT## ;FINISH OFF
HRROI T1,[ASCIZ /NEW OWNER: /]
PUSHJ P,OWNER1## ;ASK HIM
SETOM USCHFG## ;WE HAVE CHANGED SOMETHING
USRCN1: MOVEM T2,DOWN(BUF) ;SAVE POINTER
POPJ P, ;OK
PAGE
;ROUTINE TO LOOK FOR A SPACE
USSCNS: PUSHJ P,JBIN## ;GET A CHARACTER
POPJ P, ;BAD
CAIE T2," " ;SPACE?
JRST USSCNS ;NO
PJRST CPOPJ1## ;OK
;HERE TO LOAD USER AND DIRECTORY GROUPS
LODGRP: PUSHJ P,USSCNS ;LOOK FOR SPACE
POPJ P, ;BAD
MOVEI P1,1(D) ;ADDRESS OF GROUP BLOCK PLUS 1
MOVEI T3,^D10 ;DECIMAL
LODGP1: PUSHJ P,JNIN## ;INPUT NUMBER
JRST LODGP2 ;END OF LIST
MOVEM T2,(P1) ;SAVE IT
JUMPE T2,LODGP2 ;END OF LIST
AOJA P1,LODGP1 ;DO NEXT
LODGP2: SUB P1,D ;GET LENGTH
MOVEM P1,(D) ;SAVE IT
PJRST CPOPJ1## ;SKIP HOME
PRGEND
TITLE PLFLRD READ "PEOPLE" FILE INTO CORE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLFLRD
;HERE TO READ THE "PEOPLE" FILE INTO CORE.
PLFLRD: PUSHJ P,PLFLIS## ;GET FILESPEC
POPJ P, ;COULD NOT
PUSHJ P,PLFLIP## ;READ IT
POPJ P, ;COULD NOT
PUSHJ P,CIFLLJ## ;CLOSE UP
JFCL
PJRST CPOPJ1## ;OK
PRGEND
TITLE PLFLIS GET INPUT FILESPEC FOR "PEOPLE" FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLFLIS
;ROUTINE TO GET FILESPEC AND OPEN FILE FOR READING THE
;"PEOPLE" FILE.
PLFLIS: HRROI T1,[ASCIZ /"PEOPLE" FORMAT FILESPEC: /]
MOVX A,<GJ%OLD> ;MUST EXIST
SETZM B ;FROM OUR DIRECTORY
HRROI C,[ASCIZ /CIRCULATION/]
HRRZI D,[ASCIZ /TXT/]
PUSHJ P,CCGTFL## ;READ IT
HRRZ INP,T2 ;COPY JFN
PJRST OPFLIA## ;OPEN IT
PRGEND
TITLE PLFLIP INPUT "PEOPLE" FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLFLIP
;ROUTINE TO INPUT "PEOPLE FILE INTO CORE
PLFLIP: MOVEI T1,ADRMAX ;MAXIMUM NUMBER OF ADDRESSES
MOVEM T1,ADRTAB## ;SET UP TABLE
MOVEM T1,CODTAB## ;AND CODE TABLE
MOVEI T1,PEPMAX ;MAXIMUM NUMBER OF PEOPLE
MOVEM T1,PLNMTB## ;SET UP TABLE
PUSHJ P,ADRI## ;READ ADDRESSES
POPJ P, ;BAD OR EOF
PUSHJ P,PLRCLD## ;GET NAME ETC.
POPJ P, ;BAD
PJRST CPOPJ1## ;OK
PRGEND
TITLE ADRI READ ADDRESSES FROM FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY ADRI
;ROUTINE TO READ ADDRESSES FROM "PEOPLE" FILE
ADRI: PUSHJ P,JBIN## ;GET A CHARACTER
PJRST RDRCEF## ;BAD
CAIN T2,"!" ;START OF NAMES?
JRST ADRFNN ;ALL DONE
CAIE T2,"*" ;START OF ADDRESS?
JRST ADRI ;LOSE IT
SKIPL HEPLEN## ;ROOM?
ERROR CPOPJ##,<HEAP FULL>
HRRZ BUF,NXTBUF## ;POINT TO SPACE
HRROI T2,ALOC(BUF) ;POINT TO BUFFER FOR LOCATION
MOVEI T3,^D39 ;MAX NUMBER OF CHARACTERS
PUSHJ P,RDUPCR## ;GET STRING
PJRST RDRCEF## ;BAD
ADILP3: PUSHJ P,JBIN## ;GET CHARACTER
PJRST RDRCEF## ;ERROR
CAIE T2,"%" ;START OF CODE?
JRST ADILP3 ;NO
HRROI T2,ACOD(BUF) ;POINT TO BUFFER
MOVEI T3,4 ;UP TO 4 CHARACTERS
PUSHJ P,RDUPCR## ;GET IT
PJRST RDRCEF## ;ERROR
ADILP4: PUSHJ P,JBIN## ;GET BYTE
PJRST RDRCEF## ;ERROR
CAIE T2,"&" ;ADDRESS?
JRST ADILP4 ;NO
HRROI T2,AADR(BUF) ;WHERE TO PUT IT
MOVEI T3,^D199 ;MAX SIZE
ADILP5: MOVEI T4,12 ;END ON LF
PUSHJ P,JSIN## ;GET STRING
PJRST RDRCEF## ;ERROR
PUSH P,T2 ;SAVE BYTE POINTER
PUSHJ P,JBIN## ;GET CHARACTER
JRST [POP P,T2
PJRST RDRCEF##] ;BAD
CAIE T2,"&" ;MORE?
JRST ADRDUN ;NO
POP P,T2 ;RESTORE BYTE POINTER
JRST ADILP5 ;LOOP UP
PAGE
;HERE WHEN ADDRESS DONE.
ADRDUN: POP P,T2 ;RESTORE BYTE POINTER
SETZM T3 ;MAKE ASCIZ
IDPB T3,T2 ;DO IT
PUSHJ P,ADRIN## ;PUT IT IN CORRECT PLACE
ERROR ADRI,<IGNORING ADDRESS>
MOVEI T1,ASPC ;UPDATE COUNTERS
ADDM T1,HEPLEN##
ADDM T1,NXTBUF## ;TO BE CLEAN
JRST ADRI ;GET NEXT
;HERE WHEN WE HAVE READ ALL THE ADDRESSES
ADRFNN: PUSHJ P,JBKJFN## ;BACKUP THE POINTER
ERROR CPOPJ##,<NAMES MAY BE MISSING FROM THE FILE!>
PJRST CPOPJ1## ;OK
PRGEND
TITLE ADRIN PUT NEW ADDRESS IN TABLE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY ADRIN
;ROUTINE TO PUT NEW ADDRESS IN TABLES.
ADRIN: HRLI T2,ALOC(BUF) ;POINT TO LOCATION NAME
HRRI T2,ALOC(BUF) ;BOTH SIDES
MOVEI T1,ADRTAB## ;ADDRESS OF TABLE
TBADD ;ADD IT
ERJMP .+2 ;ERROR
JRST CODUPD ;OK
MOVEI T1,400000 ;GET ERROR CODE
GETER ;GET IT
HRRZS T2 ;JUST THE CODE
CAIN T2,TADDX1 ;FULL?
ERROR CPOPJ##,<LOCATION TABLE FULL>
CAIN T2,TADDX2 ;ALREADY THERE?
ERROR CPOPJ##,<LOCATION ALREADY IN TABLE>
POPJ P, ;RETURN
;HERE TO INCLUDE NEW CODE IN TABLE
CODUPD: HRLI T2,ACOD(BUF) ;POINT TO CODE
HRRI T1,ALOC(BUF) ;AND WHOLE BLOCK
MOVEI T1,CODTAB## ;POINT TO TABLE
TBADD ;PUT IT IN
ERJMP .+2 ;ERROR
PJRST CPOPJ1## ;OK
HRROI T2,ACOD(BUF) ;FAILED--DELETE LOCATION ALSO
MOVEI T1,ADRTAB## ;POINT TO LOCATION TABLE
TBLUK ;LOOK IT UP
MOVE T2,T1 ;MUST BE THERE
MOVEI T1,ADRTAB## ;SO DELETE IT
TBDEL
ERROR CPOPJ##,<DUPLICATE CODES ENCOUNTERED--ADDRESS IGNORED>
PRGEND
TITLE PLRCLD READ CIRCULATION LIST RECORDS INTO CORE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLRCLD
;ROUTINE TO READ CIRCULATION LIST ENTRIES IN TO CORE.
PLRCLD: SETZM BUF ;NOT STARTED YET
MOVEI T1,INTTAB## ;SET UP INTERESTS
PUSHJ P,SETT36## ;SET IT
POPJ P, ;COULD NOT
MOVEI T1,CLSTAB## ;SET UP CLASSIFICATION
PUSHJ P,SETT36## ;SET IT
POPJ P, ;COULD NOT
PLRCL1: PUSHJ P,JBIN## ;GET CHARACTER
PJRST RDRCEF## ;EOF?
CAIN T2,"!" ;START OF ENTRY?
JRST PLRCNM ;YES
JUMPE BUF,PLRCL1 ;LOOP UP
CAIN T2,"#" ;INTEREST?
JRST PLRCIN ;YES
CAIE T2,"@" ;CLASSIFICATION?
JRST PLRCL1 ;NO
HRROI T2,NAMBUF## ;WHERE TO PUT IT
MOVEI T3,^D39 ;MAX SIZE
PUSHJ P,RDUPCR## ;READ IT
PJRST RDRCEF## ;BAD
MOVEI T1,CLSTAB## ;AND CLASS TABLE
PUSHJ P,FNDDEF## ;FIND IT
POPJ P, ;BAD
IORM T2,CCLS(BUF) ;SET BIT
JRST PLRCL1 ;LOOP UP
;HERE WHEN WE HAVE FOUND AN INTEREST
PLRCIN: HRROI T2,NAMBUF## ;WHERE TO PUT IT
MOVEI T3,^D39 ;MAX SIZE
PUSHJ P,RDUPCR## ;READ IT
PJRST RDRCEF## ;BAD
MOVEI T1,INTTAB## ;POINT TO TABLE
PUSHJ P,FNDDEF## ;GET IT
POPJ P, ;BAD
IORM T2,CINT(BUF) ;SET INTEREST
JRST PLRCL1 ;GET NEXT
PAGE
;HERE WHEN WE HAVE AN ENTRY
PLRCNM: SKIPL HEPLEN## ;ROOM?
ERROR CPOPJ##,<HEAP FULL>
MOVE BUF,NXTBUF## ;POINT TO FREE SPACE
MOVE T1,BUF ;COPY POINTER
MOVEI T2,CSPC(BUF) ;UPPER LIMIT
PUSHJ P,BLTCLR## ;CLEAR UP FIRST
HRROI T2,CNAM(BUF) ;WHERE TO PUT NAME
MOVEI T3,NMLEN*5-1 ;MAX LENGTH
PUSHJ P,RDUPSP## ;READ IT
PJRST RDRCEF## ;BAD
HRROI T2,CFST(BUF) ;NOW FOR FIRST NAME
MOVEI T3,NMLEN*5-1 ;MAX LENGTH
PUSHJ P,RDUPCR## ;READ IT
PJRST RDRCEF## ;BAD
PLRCN1: PUSHJ P,JBIN## ;GET A CHARACTER
PJRST RDRCEF## ;BAD
CAIE T2,"%" ;FOUND LOCATION?
JRST PLRCN1 ;NO
HRROI T2,NAMBUF## ;AND ADDRESS
MOVEI T3,^D39 ;MAX SIZE
PUSHJ P,RDUPCR## ;READ IT
PJRST RDRCEF## ;BAD
PUSHJ P,PLFNDL## ;CHECK IT
PUSHJ P,CHKLOC ;GET NEW ONE
MOVEM T2,CADR(BUF) ;SAVE POINTER
PUSHJ P,PLINTB## ;PUT IN TABLES
POPJ P, ;FAILED
MOVEI T1,CSPC ;UPDATE THINGS
ADDM T1,NXTBUF## ;TWO OF THEM
ADDM T1,HEPLEN## ;FOR SAFETY
JRST PLRCL1 ;GET NEXT
;HERE TO GET NEW LOCATION WHEN FILE VERSION UNRECOGNISED.
CHKLOC: HRROI T2,[ASCIZ /
UNKNOWN LOCATION FOR /]
PUSHJ P,STGOUT## ;TELL HIM
MOVE T2,BUF ;POINT TO BLOCK
PUSHJ P,PNTPEP## ;PRINT NAME
PUSHJ P,CRLF## ;NEW LINE
PJRST PLPRLC## ;GET NEW LOCATION
PRGEND
TITLE PLINTB PUT PEOPLE DETAILS IN TABLES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLINTB
;ROUTINE TO PUT ENTRIES FROM "PEOPLE" ENTRY INTO TABLES.
PLINTB: MOVEI T1,PLNMTB## ;POINT TO NAME TABLE
HRLI T2,CNAM(BUF) ;POINT TO NAME
HRR T2,BUF ;MAKE ENTRY
TBADD ;PUT IT IN
ERJMP .+2 ;ERROR
PJRST CPOPJ1## ;OK
MOVEI T1,400000 ;GET ERROR
GETER
HRRZS T2 ;JUST ERROR
CAIE T2,TADDX2 ;ALREADY THERE?
ERROR CPOPJ##,<NAME TABLE FULL>
MOVEI T1,PLNMTB## ;POINT TO TABLE
HRROI T2,CNAM(BUF) ;FIND ENTRY
TBLUK ;MUST BE THERE
HRRZ T1,(T1) ;GET POINTER
PLTBL1: HRRZ T2,(T1) ;END OF CHAIN?
JUMPE T2,PLTBL2 ;YES
HRRZ T1,(T1) ;MOVE ON
JRST PLTBL1 ;KEEP ON
PLTBL2: HRRM BUF,(T1) ;MAKE LINK
HRLZM T1,(BUF) ;BOTH WAYS
PJRST CPOPJ1## ;OK
PRGEND
TITLE USINTB PUT DIRECTORY IN TABLES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USINTB
;ROUTINE TO PUT DIRECTORY NAME IN TABLES. ENTER WITH
;BUF POINTING TO DIRECTORY. RETURN +1 IF ERROR, OR SKIP
;IF OK.
USINTB: MOVEI T1,USNMTB## ;POINT TO TABLE
HRLI T2,DNMB(BUF) ;POINT TO NAME
HRR T2,BUF ;BUILD ENTRY
PUSHJ P,NMITAB## ;PUT IT IN
ERROR CPOPJ##,<NAME TABLE FULL>
POPJ P,
PJRST CPOPJ1## ;OK
PRGEND
TITLE PNDRLS LIST SPECIFIED DIRECTORIES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRLS
;ROUTINE TO LIST DIRECTORIES. ENTER WITH A=0 IF PASSWORD
;NOT REQUIRED, OR -1 OTHERWISE. ROUTINE ASKS FOR
;SPECIFICATION OF DIRECTORIES TO BE PRINTED AND THEN
;PRINTS THEM.
PNDRLS: HRROI T1,[ASCIZ /LIST SPECIFICATIONS: /]
MOVEI T2,LSTTAB ;AND KEY WORDS
PUSHJ P,CDSRGS## ;SAVE PARAMETERS
PUSHJ P,CDSETP## ;SET UP
LSTLS1: MOVE T2,CMDT2## ;GET POINTER TO TABLE
PUSHJ P,CDGKEY## ;LOOK IT UP
JRST LSTLS1 ;REPARSE
ERROR PNDRLS,<NOT VALID>
HRRZ T2,(T2) ;GET DISPATCH
PUSHJ P,(T2) ;AND DISPATCH
JRST LSTLS1 ;REPARSE
JRST PNDRLS ;DO NEXT
LSTTAB: LSTSIZ,,LSTMAX
TB (.LSNMR,EXIT-FROM-LISTING)
TB (.LSNAM,NAME-OF-DIRECTORY)
TB (.LSOWN,OWNER-OF-DIRECTORY)
TB (.LSTYP,TYPE-OF-DIRECTORIES)
LSTSIZ==.-LSTTAB-1
LSTMAX==LSTSIZ+1
PAGE
;HERE TO TYPE DIRECTORY WITH GIVEN NAME
.LSNAM: PUSHJ P,USGTNM## ;GET NAME
ERROR CPOPJ1##,<NAME MUST BE SPECIFIED>
ERROR CPOPJ1##,<UNKNOWN NAME>
PUSHJ P,PNDRDR## ;LIST IT
PJRST CPOPJ1## ;SKIP HOME
;HERE TO TYPE DIRECTORIES OF A GIVEN TYPE
.LSTYP: HRROI T2,[ASCIZ /DIRECTORY TYPE/]
PUSHJ P,CRMNOI## ;MAKE NOISE
MOVEI T2,TYPTAB## ;POINT TO TYPE TABLES
PUSHJ P,CRGKEY## ;GET IT
ERROR CPOPJ1##,<BAD DIRECTORY TYPE>
PUSHJ P,CRGTCM## ;AND CONFIRMATION
ERROR CPOPJ1##,<BAD CONFIRMATION>
HRRZ T2,(T2) ;GET TYPE INDEX
MOVE B,(T2) ;AND TYPE
MOVE PNT,USCHNS## ;POINT TO CHAIN OR DIRECTORIES
.LSSC1: MOVE BUF,PNT ;COPY POINTER
PUSH P,B ;SAVE TYPE
CAMN B,DTYP(BUF) ;SATISFIED?
PUSHJ P,PNDRDR## ;YES--PRINT IT
POP P,B ;RESTORE TYPE
PUSHJ P,MOVEUP## ;GET NEXT
PJRST CPOPJ1## ;AT END
JRST .LSSC1 ;DO ALL
;HERE TO FINISH UP
.LSNMR: PUSHJ P,CRGTCM## ;GET CONFIRMATION
JFCL
PJRST T1POPJ## ;GO UP ONE
PAGE
;HERE TO LIST ALL DIRECTORIES OWNED BY SOMEBODY
.LSOWN: PUSHJ P,PLGTNM## ;GET NAME
POPJ P, ;REPARSE
ERROR CPOPJ1##,<UNKNOWN NAME>
HRRZ B,BUF ;POINT TO OWNER BLOCK
MOVE PNT,USCHNS## ;AND START OF CHAIN
.LSOW1: MOVE BUF,PNT ;POINT TO DIRECTORY
PUSH P,B ;SAVE B
CAMN B,DOWN(BUF) ;OWNED BY HIM?
PUSHJ P,PNDRDR## ;YES--PRINT IT
POP P,B ;RESTORE POINTER TO OWNER
PUSHJ P,MOVEUP## ;DO NEXT
PJRST CPOPJ1## ;DONE
JRST .LSOW1 ;DO NEXT
PRGEND
TITLE PNDRDR LIST DIRECTORY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRDR
;ROUTINE TO LIST DETAILS OF DIRECTORY. ENTER WITH A=0 IF
;PASSWORD NOT REQUIRED, OR -1 OTHERWISE.
PNDRDR: HRROI T2,[ASCIZ /
********************** DIRECTORY ENTRY **************************
/]
PUSHJ P,STGOUT## ;START OFF RIGHT
PUSHJ P,PNDRNM## ;PRINT DIRECTORY NAME
PUSHJ P,CRLF##
PUSHJ P,PNDRTP## ;AND TYPE
PUSHJ P,CRLF##
JUMPE A,NOPAS ;NO PASSWORD?
PUSHJ P,PNDRPW## ;YES
PUSHJ P,CRLF##
NOPAS: PUSHJ P,PNDROW## ;OWNER
PUSHJ P,CRLF##
PUSHJ P,PNDRNO## ;NUMBER
PUSHJ P,CRLF##
PUSHJ P,PNDRWS## ;WORKING STOREAGE
PUSHJ P,CRLF##
PUSHJ P,PNDRPS## ;PERMANENT STOREAGE
PUSHJ P,CRLF##
PUSHJ P,PNDRGN## ;GENERATION RETENTION COUNT
PUSHJ P,CRLF##
PUSHJ P,PNDRDP## ;DIRECTORY PROTECTION
PUSHJ P,CRLF##
PUSHJ P,PNDRFP## ;FILE PROTECTION
PUSHJ P,CRLF##
PUSHJ P,PNDRLG## ;LAST LOGGED IN
PUSHJ P,CRLF##
PUSHJ P,PNDCHG## ;CHARGES
PUSHJ P,CRLF##
PUSHJ P,PNDRMD## ;MODE WORD
PUSHJ P,CRLF##
PUSHJ P,PNDRCP## ;CAPABILITIES
PUSHJ P,CRLF##
PUSHJ P,PNDRGP## ;GROUPS
PUSHJ P,CRLF##
PJRST CRLF## ;OK
PRGEND
TITLE PNDRNM PRINT DIRECTORY NAME
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRNM
;ROUTINE TO PRINT NAME OF DIRECTORY. ENTER WITH "BUF"
;POINTING TO DIRECTORY BLOCK.
PNDRNM: HRROI T2,[ASCIZ /DIRECTORY: /]
PUSHJ P,STGOUT## ;PRINT FIRST BIT
HRROI T2,DNMB(BUF) ;POINT TO NAME
PJRST STGOUT## ;PRINT STRING
PRGEND
TITLE PNDRTP PRINT DIRECTORY TYPE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRTP
;ROUTINE TO PRINT DIRECTORY TYPE. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRTP: HRROI T2,[ASCIZ /TYPE: /]
PUSHJ P,STGOUT## ;START OFF RIGHT
HRRZ T2,DTYP(BUF) ;POINT TO BLOCK
HRRZ T2,TYPLNK(T2) ;AND TYPE STRING
HLRO T2,(T2) ;POINT TO STRING
PJRST STGOUT## ;OK
PRGEND
TITLE PNDRPW PRINT DIRECTORY PASSWORD
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRPW
;ROUTINE TO PRINT PASSWORD. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRPW: HRROI T2,[ASCIZ /PASSWORD: /]
PUSHJ P,STGOUT## ;START OFF
HRROI T2,DPSB(BUF) ;AND PASSWORD
PJRST STGOUT## ;DO IT
PRGEND
TITLE PNDROW PRINT OWNER OF DIRECTORY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDROW
;ROUTINE TO PRINT OWNER OF DIRECTORY. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDROW: HRROI T2,[ASCIZ /OWNER: /]
PUSHJ P,STGOUT## ;START OFF
HRRZ T2,DOWN(BUF) ;POINT TO OWNER
JUMPE T2,CPOPJ## ;NONE
PJRST PNTPEP## ;PRINT IT
PRGEND
TITLE PNDRNO PRINT DIRECTORY NUMBER
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRNO
;ROUTINE TO PRINT DIRECTORY NUMBER. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRNO: HRROI T2,[ASCIZ /DIRECTORY NUMBER: /]
PUSHJ P,STGOUT## ;START OFF
MOVE T2,DNUM(BUF) ;GET IT
MOVEI T3,10 ;OCTAL
PJRST NUMOUT## ;PRINT IT
PRGEND
TITLE PNDRWS PRINT WORKING STORAGE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRWS
;ROUTINE TO PRINT WORKING STOREAGE. ENTER WITH BUF POINTING
;TO DIRECTORY.
PNDRWS: HRROI T2,[ASCIZ /WORKING LIMIT: /]
PUSHJ P,STGOUT##
MOVE T2,DWOR(BUF) ;GET IT
MOVEI T3,^D10 ;DECIMAL
PJRST NUMOUT## ;PRINT IT
PRGEND
TITLE PNDRPS PRINT PERMANENT LIMIT
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRPS
;ROUTINE TO PRINT PERMANENT LIMIT. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRPS: HRROI T2,[ASCIZ /PERMANENT LIMIT: /]
PUSHJ P,STGOUT##
MOVE T2,DPER(BUF) ;GET IT
MOVEI T3,^D10 ;DECIMAL
PJRST NUMOUT## ;PRINT IT
PRGEND
TITLE PNDRGN PRINT GENERATION RETENTION COUNT
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRGN
;ROUTINE TO PRINT GENERATION RETENTION COUNT. ENTER WITH BUF
;POINTING TO DIRECTORY BLOCK.
PNDRGN: HRROI T2,[ASCIZ /GENERATION RETENTION COUNT: /]
PUSHJ P,STGOUT##
HRRZ T2,DRET(BUF) ;GET IT
MOVEI T3,^D10 ;DECIMAL
PJRST NUMOUT## ;DO IT
PRGEND
TITLE PNDRDP PRINT DIRECTORY PROTECTION
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRDP
;ROUTINE TO PRINT DIRECTORY PROTECTION. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRDP: HRROI T2,[ASCIZ /DIRECTORY PROTECTION: /]
PUSHJ P,STGOUT## ;START OFF
HRRZ T2,DDPT(BUF) ;GET IT
MOVEI T3,10 ;OCTAL
PJRST NUMOUT## ;PRINT IT
PRGEND
TITLE PNDRFP PRINT FILE PROTECTION
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRFP
;ROUTINE TO PRINT FILE PROTECTION .ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRFP: HRROI T2,[ASCIZ /FILE PROTECTION: /]
PUSHJ P,STGOUT##
HRRZ T2,DPRT(BUF) ;GET IT
MOVEI T3,10 ;OCTAL
PJRST NUMOUT## ;PRINT IT
PRGEND
TITLE PNDRLG PRINT DATE OF LAST LOGIN
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRLG
;ROUTINE TO PRINT DATE OF LAST LOGIN. ENTER WITH BUF
;POINTING TO DIRECTORY BLOCK.
PNDRLG: HRROI T2,[ASCIZ /LAST LOGIN DATE: /]
PUSHJ P,STGOUT## ;TELL HIM
MOVE T2,DLLG(BUF) ;GET DATE
PJRST DATEOT## ;PRINT IT
PRGEND
TITLE PNDCHG PRINT CHARGES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDCHG
;ROUTINE TO PRINT CHARGES. ENTER WITH BUF POINTING TO DIRECTORY
;BLOCK.
PNDCHG: HRROI T2,[ASCIZ /CHARGES (NCN,NCP,PCN,PCP,DSK): /]
PUSHJ P,STGOUT## ;TELL HIM
MOVE T2,DNCN(BUF) ;NON-PEAK CONNECT CHARGE
MOVX T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
PUSHJ P,JFLOUT## ;PRINT IT
POPJ P, ;BAD
MOVEI T2,"," ;PRINT COMMA
PUSHJ P,JBOUT## ;DO IT
POPJ P, ;BAD
MOVE T2,DNCP(BUF) ;NON-PEAK CPU CHARGE
MOVX T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
PUSHJ P,JFLOUT## ;PRINT IT
POPJ P, ;BAD
MOVEI T2,"," ;PRINT COMMA
PUSHJ P,JBOUT## ;DO IT
POPJ P, ;BAD
MOVE T2,DPCN(BUF) ;PEAK CONNECT CHARGE
MOVX T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
PUSHJ P,JFLOUT## ;PRINT IT
POPJ P, ;BAD
MOVEI T2,"," ;PRINT COMMA
PUSHJ P,JBOUT## ;DO IT
POPJ P, ;BAD
MOVE T2,DPCP(BUF) ;PEAK CPU TIME
MOVX T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
PUSHJ P,JFLOUT## ;PRINT IT
POPJ P, ;BAD
MOVEI T2,"," ;PRINT COMMA
PUSHJ P,JBOUT## ;DO IT
POPJ P, ;BAD
MOVE T2,DDSK(BUF) ;GET DISK CHARGE
MOVX T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
PUSHJ P,JFLOUT## ;PRINT IT
POPJ P, ;BAD
POPJ P, ;OK
PRGEND
TITLE PNDRMD PRINT MODE WORD
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRMD
;ROUTINE TO PRINT MODE WORD. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRMD: HRROI T2,[ASCIZ /MODE WORD:-
/]
PUSHJ P,STGOUT## ;START OFF
MOVE D,DMOD(BUF) ;GET MODE WORD
JUMPE D,NOMOD ;NO BITS
HRROI T2,[ASCIZ / FILES ONLY
/]
TXNE D,CD%DIR ;ARE WE?
PUSHJ P,STGOUT## ;YES
HRROI T2,[ASCIZ / ALPHANUMERIC ACCOUNTS
/]
TXNE D,CD%ANA ;ARE WE?
PUSHJ P,STGOUT## ;YES
HRROI T2,[ASCIZ / REPEAT LOGIN MESSAGES
/]
TXNE D,CD%RLM ;DO WE?
PUSHJ P,STGOUT## ;YES
POPJ P,
;HERE IF NOTHING
NOMOD: HRROI T2,[ASCIZ / ** NO BITS SET **
/]
PJRST STGOUT## ;TELL HIM
PRGEND
TITLE PNDRCP PRINT CAPABILITIES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRCP
;ROUTINE TO PRINT CAPABILITIES. ENTER WITH BUF POINTING
;TO DIRECTORY BLOCK.
PNDRCP: HRROI T2,[ASCIZ /
CAPABILITIES
/]
PUSHJ P,STGOUT## ;TELL HIM
MOVE A,DCAP(BUF) ;GET BITS
MOVEI B," " ;PREFIX WITH A TAB
MOVEI D,CAPTAB## ;POINT TO TABLE
PUSHJ P,PNTBIT## ;PRINT THEM
JFCL ;IGNORE ERRORS
POPJ P, ;RETURN
PRGEND
TITLE PNDGRP PRINT DIRECTORY GROUPS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNDRGP
;ROUTINE TO PRINT GROUPS FOR A DIRECTORY. ENTER WITH BUF
;POINTING TO DIRECTORY.
PNDRGP: HRROI T2,[ASCIZ /
USER GROUPS: /]
PUSHJ P,STGOUT
MOVE D,DUGP(BUF) ;POINT TO USER GROUPS
PUSHJ P,PNTGRP ;PRINT IT
HRROI T2,[ASCIZ /
DIRECTORY GROUPS: /]
PUSHJ P,STGOUT## ;TELL HIM
MOVE D,DDGP(BUF) ;POINT TO GROUP LIST
PUSHJ P,PNTGRP ;PRINT IT
PJRST CRLF## ;FINISH UP
;HERE TO PRINT A GROUP LIST
PNTGRP: MOVEI C,^D10 ;A COUNT
PNTGP1: AOS D ;LOOK AT NEXT GROUP
MOVE T2,(D) ;GET IT
JUMPE T2,CPOPJ## ;FINISHED
MOVEI T3,^D10 ;DECIMAL
PUSHJ P,NUMOUT## ;PRINT IT
PUSHJ P,SPCOUT## ;AND A SPACE
SOJG C,PNTGP1 ;DO NEXT
PUSHJ P,CRLF## ;NEW LINE
JRST PNTGRP ;RESET
PRGEND
TITLE PLPRLS LIST SPECIFIED PEOPLE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLPRLS
;ROUTINE TO LIST ENTRIES FROM THE "PEOPLE" FILE. ASKS
;FOR SPECIFICATIONS OF PRINTOUT AND THEN PRINTS THEM.
PLPRLS: HRROI T1,[ASCIZ /LIST SPECIFICATIONS: /]
MOVEI T2,LSTTAB ;POINT TO TABLE
PUSHJ P,CDSRGS## ;SAVE ARGS
PUSHJ P,CDSETP## ;SET UP AND INITIALISE
LSTLS1: MOVE T2,CMDT2## ;GET POINTERS TO TABLE
PUSHJ P,CDGKEY## ;GET COMMAND
JRST LSTLS1 ;REPARSE
ERROR PLPRLS,<NOT VALID>
HRRZ T2,(T2) ;GET DISPATCH
PUSHJ P,(T2) ;DO IT
JRST LSTLS1 ;REPARSE
JRST PLPRLS ;DO NEXT
LSTTAB: LSTSIZ,,LSTMAX
TB (.LSADR,ADDRESS)
TB (.LSNMR,EXIT-FROM-LISTING)
TB (.LSINT,INTERESTED-PEOPLE)
TB (.LSNAM,NAME)
LSTSIZ==.-LSTTAB-1
LSTMAX==LSTSIZ+1
PAGE
;HERE TO LIST PERSON BY NAME
.LSNAM: PUSHJ P,PLGTNM## ;GET NAME
POPJ P, ;REPARSE
ERROR CPOPJ1##,<UNKNOWN PERSON>
PUSHJ P,PLPRPR## ;PRINT HIM
PJRST CPOPJ1## ;OK
;HERE TO LIST AN ADDRESS
.LSADR: PUSHJ P,PLADLC## ;GET LOCATION
POPJ P, ;REPARSE
ERROR CPOPJ1##,<UNKNOWN ADDRESS>
PUSHJ P,PLADPR## ;LIST IT
PJRST CPOPJ1## ;OK
;HERE TO FINISH UP
.LSNMR: PUSHJ P,CRGTCM## ;GET CONFIRMATION
JFCL
PJRST T1POPJ## ;RETURN
PAGE
;LIST PEOPLE WITH INTERESTS
.LSINT: HRROI T2,[ASCIZ /INTERESTED IN/]
PUSHJ P,CRMNOI## ;MAKE NOISE
MOVEI T2,INTTAB## ;POINT TO TABLE
PUSHJ P,CRGKEY## ;GET IT
ERROR CPOPJ1##,<UNKNOWN INTEREST>
PUSHJ P,CRGTCM## ;GET CONFIRMATION
PJRST CPOPJ1## ;BAD
HRRZ P1,(T2) ;GET ADDRESS OF BIT
MOVE P1,(P1) ;GET BIT
MOVEI D,PLNMTB## ;LOOK AT NAMES
PUSHJ P,SETTBD## ;SET UP D
PJRST CPOPJ1## ;NONE
.LSIN1: HRRZ BUF,(D) ;POINT TO ENTRY
.LSIN2: PUSH P,D ;SAVE POINTER
TDNE P1,CINT(BUF) ;INTERESTED?
PUSHJ P,PLPRPS## ;YES
POP P,D ;RESTORE POINTER
HRRZ BUF,CLOC(BUF) ;FOLLOW CHAIN
JUMPN BUF,.LSIN2 ;FOR MULTIPLES
AOBJN D,.LSIN1 ;DO ALL
PJRST CPOPJ1## ;ALL DONE
PRGEND
TITLE PLPRPR LIST A PERSON'S DETAILS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLPRPR,PLPRPS,PLPRIN
;ROUTINE TO LIST A PERSON'S DETAILS.
PLPRPR: PUSHJ P,PLPRPS ;NAME AND ADDRESS
PJRST PLPRIN ;AND OTHER DETAILS
;ROUTINE TO PRINT NAME AND ADDRESS
PLPRPS: PUSHJ P,CRLF## ;START AFRESH
HRROI T2,[ASCIZ / NAME: /]
PUSHJ P,STGOUT## ;PRINT IT
MOVE T2,BUF ;COPY POINTER
PUSHJ P,PNTPEP## ;PRINT NAME
PUSH P,BUF ;SAVE POINTER
HRRZ BUF,CADR(BUF) ;GET ADDRESS OF ADDRESS
PUSHJ P,PLADPR## ;PRINT ADDRESS
POP P,BUF ;RESTORE POINTER
POPJ P, ;OK
;ROUTINE TO PRINT PERSON'S OTHER DETAILS
PLPRIN: HRROI T2,[ASCIZ / CLASSIFICATION:
/]
PUSHJ P,STGOUT## ;TELL HIM
MOVE A,CCLS(BUF) ;GET BITS
MOVEI B," " ;PREFIX WITH A TAB
MOVEI D,CLSTAB## ;POINT TO TABLE
PUSHJ P,PNTBIT## ;PRINT THEM
JFCL ;IGNORE ERRORS
HRROI T2,[ASCIZ / INTERESTS:
/]
PUSHJ P,STGOUT## ;PRINT IT
MOVE A,CINT(BUF) ;GET BITS
MOVEI B," " ;TAB PREFIX
MOVEI D,INTTAB## ;POINT TO TABLE
PUSHJ P,PNTBIT## ;PRINT THEM
JFCL ;IGNORE ERRORS
PJRST CRLF## ;NEW LINE
PRGEND
TITLE PLADPR PRINT AN ADDRESS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLADPR
;ROUTINE TO PRINT AN ADDRESS
PLADPR: PUSHJ P,CRLF## ;START AFRESH
HRROI T2,[ASCIZ / LOCATION: /]
PUSHJ P,STGOUT## ;TELL HIM
HRROI T2,ALOC(BUF) ;POINT TO IT
PUSHJ P,STGOUT## ;DO IT
PUSHJ P,CRLF## ;NEW LINE
HRROI T2,[ASCIZ / CODE: /]
PUSHJ P,STGOUT## ;TELL HIM
HRROI T2,ACOD(BUF) ;WRITE IT
PUSHJ P,STGOUT## ;PRINT IT
PUSHJ P,CRLF## ;NEW LINE
HRROI T2,[ASCIZ / ADDRESS:
/]
PUSHJ P,STGOUT## ;TELL HIM
MOVE T3,[440700,,AADR(BUF)] ;POINT TO ADDRESS
ADPLP1: ILDB T2,T3 ;GET CHAR
JUMPE T2,CRLF## ;ALL DONE
CAIN T2,15 ;CR?
JRST ADPLP1 ;IGNORE IT
CAIN T2,12 ;LF?
JRST ADPLP2 ;YES
PUSHJ P,CHROUT## ;TYPE IT
JRST ADPLP1 ;GET NEXT
ADPLP2: HRROI T2,[ASCIZ /
/]
PUSH P,T3 ;SAVE BYTE POINTER
PUSHJ P,STGOUT## ;NEW LINE
POP P,T3 ;RESTORE BYTE POINTER
JRST ADPLP1 ;DO NEXT
PRGEND
TITLE PNTNAM PRINT A NAME OF A PERSON
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNTNAM
;ROUTINE TO PRINT A NAME. ENTER WITH FIRST NAME IN "FSTBUF"
;AND LAST NAME IN "NAMBUF".
PNTNAM: HRROI T2,FSTBUF## ;POINT TO IT
PUSHJ P,STGOUT## ;PRINT IT
PUSHJ P,SPCOUT## ;A SPACE
HRROI T2,NAMBUF## ;AND LAST NAME
PJRST STGOUT## ;DO IT
PRGEND
TITLE PNTPEP PRINT A NAME FROM A RECORD
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNTPEP
;ROUTINE TO PRINT A "PEOPLE" NAME ENTRY. ENTER WITH T2
;POINTING TO ENTRY.
PNTPEP: PUSH P,T2 ;SAVE POINTER
HRROI T2,CFST(T2) ;POINT TO FIRST NAME
PUSHJ P,STGOUT## ;PRINT IT
PUSHJ P,SPCOUT## ;PRINT A SPACE
POP P,T2 ;GET POINTER AGAIN
HRROI T2,CNAM(T2) ;AND POINT TO SECOND NAME
PJRST STGOUT## ;PRINT IT
PRGEND
TITLE PLGTNM GET A RECOGNISED NAME
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLGTNM
;ROUTINE TO GET A RECOGNISED NAME. ENTER ALREADY INITIALISED
;RETURN +1 FOR REPARSE, SKIP FOR ERROR, OR DOUBLE SKIP IF OK
;WITH BUF POINTING TO ENTRY.
PLGTNM: PUSHJ P,OWNER2## ;GET IT
POPJ P, ;REPARSE
PJRST CPOPJ1## ;BAD
MOVE BUF,T2 ;POINT TO IT
PJRST CPOPJ2## ;DOUBLE SKIP
PRGEND
TITLE PLADLC GET A RECOGNISED ADDRESS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLADLC
;ROUTINE TO GET RECOGNISED ADDRESS. ENTER ALREADY INITIALISED
;RETURN +1 FOR REPARSE. SKIP FOR ERROR, OR DOUBLE SKIP IF OK
;WITH BUF POINTING TO ADDRESS BLOCK.
PLADLC: HRROI T2,[ASCIZ /ADDRESS ID/]
PUSHJ P,CRMNOI## ;MAKE NOISE
MOVEI T2,ADRTAB## ;POINT TO TABLE
PUSHJ P,CRGKEY## ;FIND IT
PJRST CPOPJ1## ;BAD
PUSHJ P,CRGTCM## ;GET CONFIRMATION
PJRST CPOPJ1## ;BAD
HRRZ BUF,(T2) ;GET DISPATCH
PJRST CPOPJ2## ;OK
PRGEND
TITLE PEPLST GET A LIST OF PEOPLE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PEPLST
;ROUTINE TO GET A LIST OF PEOPLE. ENTER WITH "C" CONTAINING
;AN "AOBJN" POINTER FOR A LIST, AND "B" CONTAINING AN "AOBJN"
;POINTER FOR A SECOND LIST. "T1" SHOULD POINT TO A PROMPT.
;THE ROUTINE ASKS FOR EITHER NAMES OR CLASSIFICATIONS AND FILLS
;THE LIST POINTED TO BY "C" WITH THE ADDRESSES OF EACH IN-CORE
;BLOCK. IF AN ENTRY ALREADY EXISTS IN THE LIST POINTED TO BY
;"C" OR "B" IT IS NOT REPEATED. RETURN +1 ALWAYS.
PEPLST: PUSHJ P,CDSRGS## ;SAVE PROMPT
PEPER1: PUSHJ P,CDSETP## ;SET UP AND INITIALISE
PEPRP1: MOVEI T2,PEPTAB ;ALL OR NOTHING
MOVEI T3,PLNMTB## ;NAMES
PUSHJ P,CDDKEY## ;GET IT
JRST PEPRP1 ;REPARSE
ERROR PEPER1,<BAD NAME OR OPTION>
HRRZ T1,(T2) ;GET DISPATCH
CAMGE T1,HEAP## ;ON THE HEAP?
JRST (T1) ;EXECUTE ROUTINE
PUSHJ P,OWNER3## ;GET FULL DETAILS
JRST PEPRP1 ;REPARSE
JRST PEPER1 ;BAD
PUSHJ P,INLIST ;PUT IT IN
JRST PEPER1 ;GET NEXT
;HERE AT END
ENDLST: PUSHJ P,CDGTCM## ;GET CONFIRMATION
JRST PEPRP1 ;REPARSE
JRST PEPER1 ;BAD
POPJ P, ;OK
ALORNN: HRROI T2,[ASCIZ /WITH CLASSIFICATION/]
PUSHJ P,CRMNOI## ;MAKE NOISE
MOVEI T2,CLSTAB## ;CLASSIFICATION
PUSHJ P,CDGKEY## ;GET IT
JRST PEPRP1 ;REPARSE
ERROR PEPER1,<BAD CLASSIFICATION>
PUSHJ P,CDGTCM## ;GET CONFIRMATION
JRST PEPRP1 ;REPARSE
JRST PEPER1 ;ERROR
HRRZ T1,(T2) ;GET DISPATCH
MOVE T1,(T1) ;GET BIT
MOVEI D,PLNMTB## ;SET UP D
PUSHJ P,SETTBD## ;DO IT
JRST PEPER1 ;NONE!!
ALORN1: HRRZ T2,(D) ;POINT TO IT
ALORN2: PUSH P,D ;SAVE POINTER
PUSH P,T1 ;AND BIT
TDNE T1,CCLS(T2) ;GOOD?
PUSHJ P,INLIST ;YES-- PUT HIM IN
POP P,T1 ;GET BIT BACK
POP P,D ;RESTORE D
HRRZ T2,CLOC(T2) ;FOLLOW CHAIN
JUMPN T2,ALORN2 ;FOR MULTIPLES
AOBJN D,ALORN1 ;DO ALL
JRST PEPER1 ;ALL DONE
PAGE
;ALL OR NOTHING TABLE
PEPTAB: PEPSIZ,,PEPMAX
TB (ALORNN,ALL-PEOPLE)
TB (ENDLST,END-OF-LIST)
PEPSIZ==.-PEPTAB-1
PEPMAX==PEPSIZ+1
;ROUTINE TO PUT ENTRY IN LIST. ENTER WITH ADDRESS IN T2 AND
;WITH "C" AND "B" POINTING TO LISTS. ROUTINE PUTS ENTRY IN
;LIST "C" IF NOT ALREADY IN EITHER
INLIST: SKIPN T1,B ;LOOK AT OTHER LIST FIRST
JRST INLST1 ;NONE
INLSL1: SKIPN (T1) ;END?
JRST INLST1 ;YES
CAMN T2,(T1) ;MATCH?
POPJ P, ;RETURN
AOBJN T1,INLSL1 ;DO ALL
INLST1: MOVE T1,C ;REAL LIST
INLSL2: CAMN T2,(T1) ;MATCH?
POPJ P, ;YES
SKIPN (T1) ;SOMETHING THERE?
JRST PUTIN ;NO
AOBJN T1,INLSL2 ;DO ALL
ERROR CPOPJ##,<LIST FULL>
;HERE TO PUT IT IN
PUTIN: MOVEM T2,(T1) ;SAVE ADDRESS
POPJ P, ;OK
PRGEND
TITLE OWNER ROUTINE TO GET A RECOGNISED NAME
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OWNER,OWNER1
;ROUTINE TO GET OWNER OF A DIRECTORY.
OWNER: HRROI T1,[ASCIZ /OWNER: /]
OWNER1: PUSHJ P,CDSRGS## ;SAVE ARGS
OWNRP1: PUSHJ P,CDSETP## ;SET UP AND INITIALISE
OWNRP2: PUSHJ P,OWNER2## ;GET NAME
JRST OWNRP2 ;REPARSE
JRST OWNRP1 ;UNKNOWN
POPJ P, ;RETURN
PRGEND
TITLE OWNER2 GET A RECOGNISED NAME
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY OWNER2,OWNER3
;ROUTINE TO GET A RECOGNISED NAME. ENTER ALREADY INITIALISED.
;RETURN +1 FOR REPARSE, SKIP FOR ERROR, OR DOUBLE SKIP WITH
;T2 POINTING TO ENTRY.
OWNER2: HRROI T2,[ASCIZ /LAST NAME/]
PUSHJ P,CRMNOI## ;MAKE NOISE
MOVEI T2,PLNMTB## ;POINT TO TABLE
PUSHJ P,CRGKEY## ;LOOK IT UP
ERROR CPOPJ1##,<NO SUCH NAME>
OWNER3: HRRZ T1,(T2) ;GET DISPATCH
SKIPE (T1) ;UNIQUE?
JRST OWNLP1 ;NO
PUSH P,T1 ;SAVE IT
HRRZ T2,(P) ;FOLLOW IT
HRROI T2,CFST(T2) ;POINT TO FIRST NAME
PUSHJ P,CDMNOI## ;PRINT IT
OWNLP4: PJRST T1POPJ## ;REPARSE
POP P,T2 ;RESTORE POINTER
OWNLP2: PUSHJ P,CRGTCM## ;GET CONFIRMATION
JFCL
PJRST CPOPJ2## ;DOUBLE SKIP HOME
PAGE
;HERE WHEN MORE THAN ONE FIRST NAME
OWNLP1: HRRZ T4,T1 ;COPY POINTER
HRROI T2,[ASCIZ /FIRST NAME/]
PUSHJ P,CRMNOI## ;MAKE NOISE
MOVEI T1,FSTMAX ;SET UP FIRST NAME TABLE
MOVEM T1,FSTTAB## ;FOR RECOGNITION
OWNLP3: HRRZ T2,T4 ;BUILD ENTRY
HRLI T2,CFST(T4) ;AND TABLE
MOVEI T1,FSTTAB## ;POINT TO TABLE
TBADD ;ADD IT
ERJMP .+1 ;FULL, OR SOMETHING
HRRZ T4,(T4) ;FOLLOW CHAIN
JUMPN T4,OWNLP3 ;DO ALL
MOVEI T2,FSTTAB## ;POINT TO IT
PUSHJ P,CRGKEY## ;FIND ENTRY
ERROR CPOPJ1##,<BAD NAME>
HRRZ T2,(T2) ;POINT TO IT
JRST OWNLP2 ;GET IT
PRGEND
TITLE ESTTYP FIND TYPE OF DIRECTORY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY ESTTYP
;ROUTINE TO GET TYPE OF DIRECTORY. RETURN +1 ALWAYS
;WITH DIRECTORY TYPE CODE IN T2.
ESTTYP: HRROI T1,[ASCIZ /DIRECTORY TYPE: /]
MOVEI T2,TYPTAB## ;POINT TO POSSIBLE TYPES
PUSHJ P,CCKYCM## ;GET IT
HRRZ T2,(T2) ;GET POINTER TO TYPE
MOVE T2,(T2) ;GET TYPE
POPJ P, ;OK
PRGEND
TITLE CHKSYS CHECK DIRECTORY FOR "SYSTEM"
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY CHKSYS
;ROUTINE TO SEE IF DIRECTORY BELONGS TO THE SYSTEM.
;ENTER WITH "BUF" POINTING TO DIRECTORY BLOCK.
;RETURN +1 IF SYSTEM DIRECTORY OR SKIP IF NOT
CHKSYS: MOVE T1,DTYP(BUF) ;GET TYPE
TXNN T1,TYP%US ;USER?
POPJ P, ;SYSTEM DIRECTORY
PJRST CPOPJ1## ;USER DIRECTORY
PRGEND
TITLE PLFNDN FIND VALID USER NAME
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLFNDN
;ROUTINE TO FIND VALID USER NAME. ENTER WITH LAST NAME
;IN "NAMBUF" AND FIRST NAME IN "FSTBUF". RETURN NON-SKIP
;IF NAME IS UNKNOWN, OR SKIP IF KNOWN WITH T2 POINTING
;TO THE NAME ENTRY.
PLFNDN: MOVEI T1,PLNMTB## ;POINT TO NAMES
HRROI T2,NAMBUF## ;AND OUR NAME
TBLUK ;FIND IT
TXNN T2,TL%EXM ;MATCH?
POPJ P, ;NO
HRRZ T2,(T1) ;POINT TO IT
FNDNM1: PUSH P,T2 ;SAVE POINTER
HRROI T1,FSTBUF## ;POINT TO FIRST NAME
HRROI T2,CFST(T2) ;AND THIS FIRST NAME
STCMP ;COMPARE
POP P,T2 ;RESTORE POINTER
JUMPE T1,CPOPJ1## ;ZERO SAYS MATCH
HRRZ T2,(T2) ;FOLLOW CHAIN
JUMPN T2,FNDNM1 ;FOLLOW IT
POPJ P, ;NO MATCH
PRGEND
TITLE PLFNDL FIND LOCATION
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLFNDL,PLFNDC
;ROUTINE TO FIND VALID LOCATION. ENTER WITH LOCATION
;IN "NAMBUF". RETURN NON-SKIP IF NAME IS UNKNOWN, OR SKIP
;IF KNOWN WITH T2 POINTING TO THE ADDRESS ENTRY.
;ENTER WITH CODE IN "NAMBUF" FOR CODE LOOKUP.
PLFNDC: SKIPA T1,[CODTAB##] ;POINT TO CODES
PLFNDL: MOVEI T1,ADRTAB## ;POINT TO TABLE
HRROI T2,NAMBUF## ;AND LOCATION
TBLUK ;FIND IT
TXNN T2,TL%EXM ;MATCH
POPJ P, ;NO
HRRZ T2,(T1) ;GET POINTER
PJRST CPOPJ1## ;SKIP HOME
PRGEND
TITLE PLPRCL GET A PERSON'S CLASS.
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLPRCL
;ROUTINE TO GET THE CLASSIFICATION OF A PERSON.
;ENTER WITH EXISTING BITS IN T3. RETURN WITH UPDATED
;BITS IN T3.
PLPRCL: HRROI T1,[ASCIZ /SET CLASSIFICATION: /]
MOVEI T2,CLSTAB## ;POINT TO TABLE
PUSHJ P,SETBIT## ;SET BITS
POPJ P, ;OK
PRGEND
TITLE PLPRLN GET A PERSON'S INTERESTS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLPRLN
;ROUTINE TO SET INTERESTS FOR A PERSON. ENTER WITH EXISTING
;INTERESTS IN T3. RETURN +1 ALWAYS WITH NEW SELECTION IN T3.
PLPRLN: HRROI T1,[ASCIZ /SET INTEREST: /]
MOVEI T2,INTTAB## ;POINT TO TABLE
PUSHJ P,SETBIT## ;SET BITS
POPJ P, ;OK
PRGEND
TITLE PLPRLC GET LOCATION OF PERSON
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PLPRLC
PLPRLC: HRROI T1,[ASCIZ /LOCATION: /]
MOVEI T2,ADRTAB## ;POINT TO TABLE
PUSHJ P,CCKYCM## ;GET IT WITH CONFIRMATION
HRRZ T2,(T2) ;GET DISPATCH
POPJ P, ;RETURN
PRGEND
TITLE USGTNM GET NAME OF DIRECTORY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USGTNM
;ROUTINE TO INPUT NAME OF DIRECTORY. USES TABLE USNMTB
;FOR RECOGNITION. RETURN +1 IF "ALL-USERS" TYPED, SKIP IF
;ERROR, OR DOUBLE SKIP IF OK WITH "BUF" POINTING TO
;THE INCORE BUFFER.
USGTNM: HRROI T2,[ASCIZ /EXISTING DIRECTORY NAME/]
PUSHJ P,CDMNOI## ;MAKE NOISE
PJRST T1POPJ## ;REPARSE
MOVEI T2,EVRYTB ;OR EVERYBODY
MOVEI T3,USNMTB## ;POINT TO TABLE
PUSHJ P,CDDKEY## ;GET ENTRY
PJRST T1POPJ## ;REPARSE
PJRST CPOPJ1## ;ERROR
HRRZ BUF,(T2) ;POINT TO BUFFER
PUSHJ P,CDGTCM## ;GET CONFIRMATION
PJRST T1POPJ## ;REPARSE
PJRST CPOPJ1## ;BAD
JUMPE BUF,CPOPJ## ;EVERBODY
PJRST CPOPJ2## ;OK
;TABLE FOR "ALL-USERS"
EVRYTB: EVRSIZ,,EVRMAX
TB (0,ALL-USERS)
EVRSIZ==.-EVRYTB-1
EVRMAX==EVRSIZ+1
PRGEND
TITLE USLOCN FIND DIRECTORY IN FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USLOCN
;ROUTINE TO SEARCH IN-CORE DATA BASE FOR DIRECTORY
;WITH NAME CORRESPONDING TO THAT IN "NAMBUF". RETURN
;SKIP IF FOUND WITH "BUF" POINTING TO IT. RETURN NON-SKIP
;IF NOT FOUND
USLOCN: MOVE BUF,USCHNS## ;POINT TO START OF CHAIN
LOCLP1: HRROI T1,NAMBUF## ;POINT TO OUR NAME
HRROI T2,DNMB(BUF) ;POINT TO DIRECTORY NAME
PUSHJ P,MTCHSG## ;MATCH?
SKIPA ;NO
PJRST CPOPJ1## ;YES-SKIP HOME
HRRZ BUF,PLOC(BUF) ;DOWN THE CHAIN
JUMPN BUF,LOCLP1 ;DO NEXT
POPJ P, ;ERROR
PRGEND
TITLE USFNNO FIND DIRECTORY FROM NUMBER
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY USFNNO
;ROUTINE TO SEARCH THROUGH THE IN-CORE DATA BASE FOR
;DIRECTORY WHOSE NUMBER CORRESPONDS TO THAT IN T2.
;RETURNS SKIP IF MATCH FOUND WITH "PNT" POINTING TO
;DIRECTORY BLOCK. RETURN NON-SKIP IF NO MATCH FOUND
;WITH "PNT" POINTING TO DIRECTORY BEFORE THE PLACE
;WHERE IT WOULD BE.
USFNNO: MOVE T4,DNUM(PNT) ;GET NUMBER
CAMN T4,T2 ;MATCH?
JRST CPOPJ1## ;YES
CAML T4,T2 ;THERE YET?
JRST NOMTCH ;YES-NO MATCH
PUSHJ P,MOVEUP## ;MOVE UP
POPJ P, ;CANNOT
JRST USFNNO ;OK
NOMTCH: PUSHJ P,BACKUP## ;BACKUP POINTER
JFCL
POPJ P, ;OK
PRGEND
TITLE STRUCT ASK FOR A STRUCTURE--SAVE IS IN "STRID"
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY STRUCT
;HERE TO GET STRUCTURE AND SAVE ID IN "STRID"
;ENTER WITH PROMPT IN T1. RETURN +1 ALWAYS.
STRUCT: PUSHJ P,CDSRGS## ;SAVE ARG
STRUC2: PUSHJ P,CDSETP## ;SET UP
STRUC1: PUSHJ P,CDGDEV## ;GET IT
JRST STRUC1 ;REPARSE
ERROR STRUC2,<BAD STRUCTURE NAME>
PUSHJ P,CDGTCM## ;GET CONFIRMATION
JRST STRUC1 ;REPARSE
ERROR STRUC2,<BAD CONFIRMATION>
MOVEM T2,STRID## ;SAVE IT
POPJ P,
PRGEND
TITLE DIRSPC ROUTINE TO BUILD FULL DIRECTORY SPEC.
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY DIRSPC
;ROUTINE TO BUILD FULL DIRECTORY SPEC FROM JUST THE NAME.
;ENTER WITH STRUCTURE ID IN "STRID" AND JFN IN T1.
;RETURN +1 ALWAYS.
DIRSPC: PUSH P,OUTP ;A KLUDGE
HRRO OUTP,T1 ;WHERE TO PUT IT
MOVE T2,STRID## ;WRITE STRUCTURE ID
PUSHJ P,PNTDEV## ;PRINT IT
PUSHJ P,COLOUT## ;PRINT COLON
MOVEI T2,"<" ;DO IT PROPERLY
PUSHJ P,CHROUT## ;SEND IT
HRROI T2,DNMB(BUF) ;POINT TO NAME
PUSHJ P,STGOUT## ;WRITE IT
MOVEI T2,">" ;FINISH OFF
PUSHJ P,CHROUT## ;PROPERLY
SETZM T2 ;MAKE ASCIZ
IDPB T2,OUTP ;FINISH OFF
POP P,OUTP ;RESTORE OUTPUT
POPJ P, ;FINISHED
PRGEND
TITLE DEFNWD GET NEW DEFAULT FOR DIRECTORY
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY DEFNWD
;ROUTINE TO GET NEW DIRECTORY SPEC. ENTER VIA "PUSHJ" WITH
;T2 POINTING TO A TABLE OF OPTIONS WITH THEIR DISPATCHES
;POINTING TO A "DEFDIR" BLOCK. THE ROUTINE COMPLETES THE
;COMMAND (SUCH AS "DEFINE NEW DIRECTORY FOR COMPONENTS")
;AND THEN CALLS "DIRGET" TO GET THE NEW SPEC AND UPDATE THE
;"DEFDIR" BLOCK. RETURN +1 IF REPARSE NECCESSARY, SKIP IF
;BAD, OR DOUBLE SKIP IF OK.
DEFINE DEFDIR(A,B)<
PHASE 0
DE%STR: A ;DEFAULT STRUCTURE
DE%DIR: B ;DEFAULT DIRECTORY
DE%STS: BLOCK 10 ;HWERE TO PUT NEW STRUCTURE
DE%DRS: BLOCK 20 ;WHERE TO PUT NEW DIRECTORY
DEPHASE>
DEFNWD: PUSH P,T2 ;SAVE OPTION TABLE
HRROI T2,[ASCIZ /NEW STRUCTURE AND DIRECTORY FOR/]
PUSHJ P,CRMNOI## ;MAKE NOISE
POP P,T2 ;POINT TO TABLE
PUSHJ P,CRGKEY## ;GET IT
ERROR CPOPJ1##,<BAD COMMAND>
PUSHJ P,CRGTCM## ;GET CONFIRMATION
PJRST CPOPJ1## ;BAD
HRRZ T2,(T2) ;GET DISPATCH
HRROI T1,[ASCIZ /NEW DIRECTORY SPEC: /]
PUSHJ P,DIRGET## ;GET IT
PJRST CPOPJ2## ;OK
PRGEND
TITLE DIRGET GET DIRECTORY SPECIFICATIONS IN "DEFDIR" FORMAT
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY DIRGET
;ROUTINE TO ASK FOR A DIRECTORY AND RETURN FULL DETAILS.
;ENTER WITH T1 POINTING TO PROMPT, T2 POINTING TO A "DEFDIR"
;BLOCK. RETURN +1 ALWAYS
DIRGET: PUSH P,T2 ;SAVE ADDRESS OF BLOCK
PUSHJ P,CCGTDR## ;GET DIRECTORY
MOVE T1,(P) ;WHERE TO PUT DIRECTORY
HRROI T1,DE%DRS(T1) ;POINT TO IT
PUSH P,T1 ;SAVE POINTER
DIRST ;WRITE IT
JFCL ;MUST BE OK
POP P,T2 ;RESTORE POINTER
HRLI T2,440700 ;MAKE BYTE POINTER
MOVE T3,(P) ;POINT TO STRUCTURE SPACE
MOVEI T3,DE%STS(T3) ;POINT TO IT
HRLI T3,440700 ;MAKE BYTE POINTER
DIRFL1: ILDB T1,T2 ;GET A CHARACTER
CAIN T1,"<" ;START OF DIRECTORY?
MOVEI T1,0 ;PUT ZERO
IDPB T1,T3 ;WRITE IT
JUMPN T1,DIRFL1 ;DO ALL
POP P,T1 ;POINT TO DIRECTORY STRING
MOVEI T2,DE%STS(T1) ;WHERE WE HAVE PUT THE STRING
MOVEM T2,DE%STR(T1) ;SAVE IT
MOVEI T2,DE%DRS(T1) ;AND FOR THE DIRECTORY
MOVEM T2,DE%DIR(T1) ;SAVE IT
HRROI T1,DE%DRS(T1) ;MAKE POINTER
PJRST JSTNAM## ;GET JUST THE DIRECTORY NAME
PRGEND
TITLE MOVEUP ROUTINES TO ADVANCE AND DEADVANCE POINTERS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY MOVEUP,BACKUP
;ROUTINE TO ADVANCE THROUGH A CHAIN. ENTER WITH "PNT"
;POINTING TO A CHAIN. RETURN SKIP IF OK, OR NON-SKIP IF
;AT END.
MOVEUP: PUSH P,PNT ;SAVE OUR POINTER
HRRZ PNT,(PNT) ;ADVANCE
JUMPE PNT,[POP P,PNT
POPJ P,] ;REACHED END
POP P,(P) ;JUNK ENTRY
PJRST CPOPJ1## ;SKIP HOME
;ROUTINE TO MOVE BACKWARDS THROUGH A CHAIN. ENTER WITH
;"PNT" POINTING TO AN ELEMENT OF A CHAIN. RETURN SKIP IF OK
;AND NON-SKIP IF AT START OF CHAIN
BACKUP: HLRZ PNT,(PNT) ;GO BACK
JUMPE PNT,CPOPJ## ;START OF CHAIN
PJRST CPOPJ1## ;OK
PRGEND
TITLE SETT36 SET UP A TABLE FOR THE "FNDDEF" ROUTINE.
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY SETT36
;ROUTINE TO SET UP A TABLE FOR THE "FNDDEF" ROUTINE. ENTER
;WITH T1 POINTING TO AN AREA OF CORE OF SIZE ^D40+^D36*^D9
;WORDS LONG. THIS IS INITIALISED TO CONTAIN A LOOKUP TABLE
;WITH 3 ENTRIES OF "NO", "EXIT", AND "LIST" TO CONFORM
;WITH THE TABLE REQUIRED BY THE "PNTBIT" ROUTINE. THE REST
;OF THE ENTRIES ARE EMPTY. THE REST OF THE WORDS ARE CLEARED.
SETT36: PUSH P,T1 ;SAVE POINTER
MOVEI T2,^D40+^D36*^D9(T1) ;CLEAR UP FIRST
PUSHJ P,BLTCLR## ;CLEAR IT
MOVE T1,(P) ;POINT TO TABLE
MOVEI T2,^D40 ;MAX SIZE
MOVEM T2,(T1) ;SAVE IT
MOVE T2,[[ASCIZ /NO/],,0]
TBADD ;PUT IN "NO"
ERJMP SETERR ;BAD
MOVE T1,(P) ;POINT TO TABLE
MOVE T2,[[ASCIZ /EXIT-CHANGES/],,1]
TBADD ;PUT IN EXIT
ERJMP SETERR ;BAD
MOVE T1,(P) ;POINT TO TABLE
MOVE T2,[[ASCIZ /LIST-ENTRIES/],,2]
TBADD ;PUT IN LIST
ERJMP SETERR ;BAD
POP P,T1 ;RESTORE POINTER
PJRST CPOPJ1## ;OK
SETERR: POP P,T1 ;RESTORE POINTER
ERROR CPOPJ##,<COULD NOT SET UP TABLE>
PRGEND
TITLE FNDDEF FIND AN ENTRY IN A TABLE OR DEFINE ONE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY FNDDEF
;ROUTINE TO LOOK UP AN ENTRY IN A TABLE OR DEFINE IT
;IF IT IS NOT THERE. THE IDEA IS THAT A SKELETON TABLE
;CAN BE SET UP WITH 39 ENTRIES. THREE OF THESE ENTRIES
;ARE FOR "NO", "LIST", AND "EXIT". THE OTHER 36 ENTRIES
;ARE DEFINED BY THIS ROUTINE AND A BIT IS ALLOCATED
;REPRESENTING THIS ENTRY. SUBSEQUENT CALLS TO THIS ROUTINE
;WILL RETURN THE BIT. ENTER WITH T1 POINTING TO A TABLE
;AS DESCRIBED IN ROUTINE "SETT36". THE ASCIZ STRING TO BE
;ENTERED SHOULD BE IN "NAMBUF". RETURN +1 IF ERROR,
;OR SKIP WITH BIT RETURNED IN T2.
FNDDEF: PUSH P,T1 ;SAVE POINTER
HRROI T2,NAMBUF## ;POINT TO STRING
TBLUK ;FIND IT
TXNN T2,TL%EXM ;MATCH?
PUSHJ P,DEFNEW ;DEFINE IT
HRRZ T1,(T1) ;GET DISPATCH
MOVE T2,(T1) ;GET BIT
POP P,T1 ;RESTORE POINTER
PJRST CPOPJ1## ;OK
;HERE TO DEFINE NEW ENTRY.
DEFNEW: HRRZ T3,-1(P) ;GET POINTER TO TABLE
MOVEI T3,^D40(T3) ;POINT TO BIT MAP
HRLI T3,-^D35 ;MAKE AOBJN POINTER
DEFNW1: SKIPN (T3) ;IN USE?
JRST DEFNW2 ;NO
AOBJN T3,DEFNW1 ;LOOK AT ALL
JRST DEFN1 ;FULL
DEFNW2: HLRE T2,T3 ;GET COUNTER
MOVX T1,1B0 ;SET BIT
LSH T1,(T2) ;MOVE IT
MOVEM T1,(T3) ;SAVE IT
HLRE T2,T3 ;GET COUNT AGAIN
IMULI T2,-10 ;FIND PLACE FOR STRING
HRRZ T1,-1(P) ;ADD IN BASE
ADD T2,T1 ;FOR STRING
HRROI T1,NAMBUF## ;POINT TO STRING
HRLI T2,^D39 ;MAX SIZE
PUSH P,T3 ;SAVE POINTER TO BIT
PUSH P,T2 ;AND STRING
PUSHJ P,COPSTG## ;COPY IT
JFCL ;TRUDGE ON
POP P,T2 ;GET ADDRESS OF STRING
HRLZS T2 ;IN LEFT HALF
POP P,T1 ;RESTORE POINTER TO BIT
HRR T2,T1 ;GET BIT POINTER
MOVE T1,-1(P) ;POINT TO TABLE
TBADD ;PUT IT IN
ERJMP .+2 ;OK
POPJ P, ;OK
DEFN1: POP P,(P) ;ADJUST STACK
ERROR T1POPJ##,<TABLE FULL>
PRGEND
TITLE SETBIT SET OR CLEAR BITS ACCORDING TO COMMANDS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY SETBIT
;ROUTINE TO SET OR CLEAR BITS ACCORDING TO COMMANDS.
;ENTER WITH T1 POINTING TO PROMPT, T2 POINTING TO A
;COMMAND TABLE AND T3 CONTAINING BITS SET SO FAR. THE
;RIGHT HALF OF THE TABLE POINTED TO BY T2 SHOULD
;POINT TO A WORD CONTAINING BITS TO BE SET OR
;CLEARED ACCORDING TO THE COMMANDS. THE TABLE SHOULD
;ALSO CONTAIN ENTRIES FOR "EXIT" WITH DISPATCH POINTING
;TO 1, "LIST BITS SET" POINTING TO 2 AND "NO" POINTING
;TO ZERO. RETURN +1 ALWAYS WITH BITS SET IN T2.
SETBIT: PUSHJ P,CDSRGS## ;SAVE ARGS
PUSH P,T3 ;SAVE BITS SO FAR.
PUSH P,[0] ;NEGATIVE FLAG
SETBT1: PUSHJ P,CDSETP## ;SET UP AND INITIALISE
SETZM (P) ;NOT NEGATIVE
SETBT4: MOVE T2,CMDT2## ;GET POINTER TO TABLE
PUSHJ P,CDGKEY## ;LOOK IT UP
JRST SETBT4 ;REPARSE
ERROR SETBT1,<BAD FORMAT>
HRRZ T1,(T2) ;GET ENTRY
JUMPE T1,[SETOM (P)
JRST SETBT4] ;FLAG "NO"
PUSHJ P,CDGTCM## ;GET CONFIRMATION
JRST SETBT4 ;REPARSE
ERROR SETBT1,<BAD CONFIRMATION>
CAIN T1,1 ;CODE 1?
PJRST [POP P,(P)
POP P,T3
POPJ P,]
CAIN T1,2 ;CODE 2?
JRST SETBT3 ;LIST CAPABILITIES
MOVE T1,(T1) ;GET BITS
IORM T1,-1(P) ;SET BITS
SKIPE (P) ;SHOULD WE?
ANDCAM T1,-1(P) ;NO
JRST SETBT1 ;DO NEXT
PAGE
;HERE TO LIST BITS SET SO FAR
SETBT3: MOVE A,-1(P) ;GET BITS
MOVEI B," " ;PRINT A TAB FIRST
MOVE D,CMDT2## ;POINT TO TABLE
PUSHJ P,PNTBIT## ;PRINT BITS SO FAR
JFCL ;IGNORE ERRORS
MOVEM A,-1(P) ;SAVE BITS
JRST SETBT1 ;GET NEXT COMMAND
PRGEND
TITLE PNTBIT PRINT BITS SET SO FAR
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY PNTBIT
;ROUTINE TO PRINT BITS SET. ENTER WITH BITS IN "A" AND
;WITH "D" POINTING TO COMMAND TABLE AS DESCRIBED FOR "SETBIT".
;"B" SHOULD CONTAIN THE CHARACTER TO BE PRINTED FIRST.
;RETURN +1 ON OUTPUT ERRORS, SKIP IF OK. IF "B" CONTAINS
;A TAB A FREE CRLF IS OUTPUT BEFORE AND AFTER THE LIST.
PNTBIT: PUSHJ P,SETTBD## ;SET UP D
PJRST PNTBT3 ;NOTHING TO DO
CAIE B," " ;TAB?
JRST PNTBT1 ;NO
PUSHJ P,WTNEWL## ;THROW A LINE FIRST
POPJ P, ;ERROR
PNTBT1: HRRZ T1,(D) ;GET POINTER TO BITS
CAIG T1,2 ;REAL BITS?
JRST PNTBT2 ;NO
TDNN A,(T1) ;ANY BITS SET?
JRST PNTBT2 ;NO
MOVE T2,B ;GET NEW CHARACTER
PUSHJ P,JBOUT## ;PRINT IT
POPJ P, ;BAD
HLRO T2,(D) ;POINT TO STRING
SETZM T3 ;LONG STRING
PUSHJ P,JSOUT## ;PRINT IT
POPJ P, ;BAD
PUSHJ P,WTNEWL## ;AND NEW LINE
POPJ P, ;BAD
PNTBT2: AOBJN D,PNTBT1 ;DO ALL
PNTBT3: CAIE B," " ;TAB?
PJRST CPOPJ1## ;OK
PJRST WTNEWL## ;FINISH UP
PRGEND
TITLE SETTBD SET UP D TO POINT TO A COMMAND TABLE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY SETTBD
;ROUTINE TO SET UP TO TO MAKE AN "AOBJN" POINTER
;FOR A COMMAND TABLE. ENTER WITH D POINTING TO THE
;TABLE. RETURN WITH "AOBJN" POINTER IN D. RETURN +1
;IF TABLE EMPTY OR SKIP IF SOMETHING THERE.
SETTBD: PUSH P,D ;SAVE POINTER
HLRZ D,(D) ;GET LENGTH
MOVNI D,(D) ;MAKE NEGATIVE
HRLZS D ;IN LEFT HALF
HRR D,(P) ;POINT TO TABLE
POP P,(P) ;JUNK ORIGINAL
TLNN D,777777 ;ANYTHING THERE?
POPJ P, ;NO
AOJA D,CPOPJ1## ;SKIP HOME
PRGEND
TITLE RDUPSP READ UNTIL WE FIND A SPACE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY RDUPSP
;ROUTINE TO READ UNTIL WE FIND A SPACE. ENTER WITH
;POINTER FOR OUTPUT IN T3 AND MAX NUMBER OF CHARACTERS
;IN T3. RETURN +1 IF ERROR, OR SKIP IF OK.
RDUPSP: MOVEI T4,40 ;END ON SPACE
PUSHJ P,JSIN## ;GET IT
POPJ P, ;ERROR
MOVEI T3,0 ;DELETE SPACE
DPB T3,T2 ;LOSE IT
PJRST CPOPJ1## ;OK
PRGEND
TITLE RDUPCR READ UP TO CR.
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY RDUPCR
;ROUTIN TO READ UP TO NEXT CARRIAGE RETURN. ENTER WITH
;OUTPUT POINTER IN T2 AND MAX NUMBER OF CHARACTERS IN
;T3. RETURN +1 IF ERROR OR SKIP IF OK.
RDUPCR: MOVEI T4,15 ;END ON CR.
PUSHJ P,JSIN## ;GET IT
POPJ P, ;BAD
MOVEI T3,0 ;LOSE CR
DPB T3,T2 ;OVERWRITE IT
PJRST CPOPJ1## ;OK
PRGEND
TITLE WTSPAC WRITE A SPACE IN OUTPUT FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY WTSPAC
;ROUTINE TO WRITE A SPACE IN A FILE. RETURN +1 IF ERROR
;OR SKIP IF OK.
WTSPAC: MOVEI T2," " ;SEND SPACE
PJRST JBOUT## ;SEND IT
PRGEND
TITLE WTNEWL WRITE CRLF TO FILE
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY WTNEWL
;ROUTINE TO SEND CRLF TO A FILE. RETURN +1 IF ERROR
;OR SKIP IF OK.
WTNEWL: HRROI T2,[ASCIZ /
/]
SETZM T3 ;LONG STRING
PJRST JSOUT## ;WRITE IT
PRGEND
TITLE RDRCEF CHECK INPUT ERRORS
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY RDRCEF
;ROUTINE TO CHECK INPUT ERRORS. RETURN +1 IF BAD ERROR,
;SKIP IF END OF FILE. PRINTS ERROR MESSAGE.
RDRCEF: PUSHJ P,GSTSIN## ;GET STATUS
PJRST JSERPJ## ;BAD ERROR
PJRST CPOPJ1## ;EOF
PJRST JSERPJ## ;ERROR
PRGEND
TITLE CAPTAB TABLE OF CAPABILITIES
SUBTTL C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.
SEARCH MONSYM,MACSYM,CMLBSM
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
ENTRY CAPTAB
;TABLE OF CAPABILITIES
CAPTAB: CAPSIZ,,CAPMAX
TB ([SC%CNF],CONFIDENTIAL)
TB ([SC%CTC],CONTROL-C-TRAPPING)
TB ([SC%ENQ],ENQ-DEQ)
TB (1,EXIT-FROM-CAPABILITY-MODS)
TB ([SC%FRZ],FREEZE)
TB ([SC%GTB],GETAB-MONITOR-TABLES)
TB ([SC%IPC],IPCF)
TB (2,LIST-CAPABILITIES)
TB ([SC%LOG],LOG-FUNCTIONS)
TB ([SC%MNT],MAINTENANCE)
TB ([SC%MMN],MAP-RUNNING-MONITOR)
TB (0,NO)
TB ([SC%OPR],OPERATOR)
TB ([SC%MPP],PAGE-PRIV-MAPPING)
TB ([SC%SDV],SPECIAL-DEVICE-HANDLING)
TB ([SC%SUP],SUPERIOR-MAPPINGS)
TB ([SC%WHL],WHEEL)
CAPSIZ==.-CAPTAB-1
CAPMAX==CAPSIZ+1
PRGEND
END