Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50535/phi.mac
There are no other files named phi.mac in the archive.
TITLE PHI - PROGRAM FOR HIERARCHICAL INFORMATION
; R.J.HORNE
; COMPUTER CENTRE
; MIDDLESEX POLYTECHNIC
; BOUNDS GREEN ROAD
; LONDON N11 2NQ
; FIRST RELEASED SEPTEMBER 1980
; LATEST VERSION OCTOBER 1982
; EXPLANATION OF SOME TERMS USED:
; A "NODE" IS OTHERWISE KNOWN AS A "SECTION" AND HAS TITLE
; AND/OR TEXT, AND IS LINKED TO OTHER NODES IN THE TREE.
; A "VIRTUAL" NODE IS A NODE WHICH HAS AN INDIRECT FILE SPEC
; INSTEAD OF TEXT. A "REAL" NODE IS ONE WHICH DOESNT.
; A 'GLOBAL' TREE IS A TREE WHICH INCLUDES ALL NODES IN ALL FILES
; REFERENCED FROM VIRTUAL NODES. GLOBAL SEARCHES SEARCH GLOBAL
; TREES.
IFNDEF TRELEN,<TRELEN==3000> ; LENGTH OF TREE ARRAY
IFNDEF TXTLEN,<TXTLEN==5000> ; INITIAL LENGTH OF TEXT ARRAY
IFNDEF CORINC,<CORINC==500> ; INCREMENT (NO. WORDS) FOR
; EXTENDING TEXT ARRAY
IFNDEF DOCPPN,<DOCPPN==5,,14> ; PPN FOR DOC: AREA
IFNDEF SUBJ0,<SUBJ0==SIXBIT/0/> ; SUBJECT NAME FOR TOP LEVEL
; HELP FILE. SHOULD BE SIXBIT
; BLANK (OCTAL 0) IF NONE.
IFNDEF MXFLEV,<MXFLEV==10> ; MAX. LEVEL OF GOING DOWN THROUGH
; INDIRECT FILE SPECS(I.E. @FILE
; CONSTRUCTIONS IN NODE TEXT)
IFNDEF LENSST,<LENSST==24> ; LENGTH OF ARRAY 'SRCSTR' FOR
; SEARCH STRING
IFNDEF PVAL,<PVAL==-1> ; VIRTUAL NODES WITH A 'PRINT VALUE'
; LE PVAL WILL HAVE THEIR FILES PRINTED IN A P OR L COMMAND
IFNDEF NFLBFS,<NFLBFS==6> ; NUMBER OF BUFFERS FOR READING
; AND WRITING FILES
IFNDEF NPRBFS,<NPRBFS==3> ; NUMBER OF BUFFERS FOR PRINTING
; (TO LPT OR DSK).
IFNDEF APPEND,<APPEND==1> ; DETERMINES HOW DESCENDANT SUBJECT
; FILES ARE READ IN: IF APPEND=0 THEY OVERWRITE, IF 1 THEY
; ARE APPENDED TO ANCESTOR SUBJECTS. (IF APPEND=1 PROGRAM IS
; FASTER BUT TAKES MORE CORE).
IFNDEF LOG,<LOG==0> ; IF NON-ZERO, LOGGING FACILITY IS AVAILABLE.
; (MSGS SENT TO A PROCESS WHICH HAS PID
; 'IPCFR', IF RUNNING).
IFN LOG,<
EXTERNAL IPCGPD,IPCCH,IPCTX,IPCSN,IPCDEC
INTERNAL IPCBLK
INTERNAL OCTOUT,DECOUG
>
SEARCH MACS
SEARCH UUOSYM
; REGISTERS
F=0 ; FLAGS
NEXLOC=1 ; REL. ADR. OF NEXT AVAILABLE LOCN. IN TREE.
CH=2
LEVEL=3 ; WORK REGISTER FOR STORING LEVEL NUMBERS IN
; TREE PRINTING AND SEARCHING COMMANDS.
NEXTTX=4 ; BYTE POINTER FOR NEXT AVAILABLE LOCN IN TEXT ARRAY
S1=5 ; "HIGHER LEVEL" WORK REGISTERS
S2=6
S3=7
S4=10
T1=11 ; "LOWER LEVEL" WORK REGISTERS
T2=12
T3=13
T4=14
WORK=16 ; GENERAL WORK REGISTER. ASSUMED PRESERVED BY
; ROUTINES UNLESS OTHERWISE STATED.
SP=17 ; STACK POINTER
.FLAG==0
DEFINE X(A)
< IFG .FLAG-^D35, <PRINTX ***too many flags
PASS2
END >
A==1B<.FLAG>
.FLAG==.FLAG+1 >
; MASKS FOR F (REG.0):
; FLAGS PRESERVED BETWEEN COMMANDS
X EOF ; END-OF-FILE, MUST BE FIRST FLAG, I.E. BIT 0
X SUPVER ; SUPPRESS VERIFICATION FOR NEXT COMMAND, I.E. THE
; PRINTING OF TITLE AND/OR TEXT FOR A NODE WHEN
; A CRLF OR ESC IS TYPED.
X SUPGUI ; SUPPRESS USER-GUIDANCE MSG. (SUPGUI WILL BE
; SWITCHED OFF BY ANY COMMAND OTHER THAN A LF
; OR A CRLF/ESC OCCURING WHILE VERIFICATION SUPPRESSED).
X GUIDE ; GUIDE USER BY PRINTING WAFFLE AFTER EACH VERIFICATION
X BELL ; BELL IN 'PAUSE' MSG (ALSO MSG IS SHORTENED
; IF BELL IS OFF).
X COREMS ; PRINT CORE MESSAGES
X UNDERL ; UNDERLINE TITLES
X TTYPR ; PRINTING IS TO TTY
X CCL ; CCL MODE
X MOD ; MODIFICATON MODE
X SRCGLB ; WHETHER CURRENT SEARCH IS GLOBAL (ON) OR
; LOCAL (OFF)
X SRCNM ; WILL BE SET AFTER SEARCH RETURNS A 'NO-MATCH'
; 'WORK FLAGS' (NOT SAVED BETWEEN COMMANDS):
X FLAG ; FOR LOCAL USE ONLY IN MAIN PROGRAM
X PRTX ; PRINT TEXT WITH NODE
X PRPTH ; PRINT PATH VECTOR WITH NODE
X PRSEP ; WHEN PRINTING TREE SEPARATE NODES ACCORDING
; TO VALUES IN FFLEV AND NBL, AND INDENT START
; ACCORDING TO LEVEL.
X SUPUND ; SUPPRESS UNDERLINING OF TITLES (WILL BE
; SWITCHED ON EXCEPT FOR P COMMAND)
X SRCTIT ; WHETHER A SEARCH COMMAND SPECIFIED TITLES OR
; TITLES+TEXT TO BE SEARCHED
X MTCH ; RETURNED BY PROCS 'TESTND' AND 'MATCH'
X YANK ; FOR USE IN 'CRTTRE'
X PRNF1 ; ) FOR USE IN 'PRNODE'
X PRNF2 ; )
X TSTNF1 ; FOR USE IN 'TESTND'
X EXTALL ; FILE EXTENSION ALLOWED IN CALL TO 'RDSUBG'
X VER ; TRUE WHILE DOING A VERIFY COMMAND
X NOSUBJ ; NO SUBJECT SPECIFIED IN PHI COMMAND LINE
X NEWSUB ; NEW SUBJECT (SET BY FNDFIL)
X GLOBP ; FOR PASSING TO 'GLOBNX'
.FLAG==0
; MASKS FOR FLAG WORDS IN COMTYP AND SWTYP TABLES
X CMMOD ; MODIFICATION TYPE COMMAND (ONLY IN COMTYP TABLE)
X CMNEWL ; NEWLINE REQUIRED IN HELP PRINTOUT
X SWCHNG ; SWITCH FLIPPING COMMAND (ONLY IN SWTYP TABLE)
DEL1=="("
DEL2==")"
ARGDEL=="/" ; DELIMETER FOR COMMAND ARGS
BCKSPC==10 ; BACKSPACE CHARACTER
TAB==11 ; TAB CHARACTER
LF==12 ; LINE FEED CHARACTER
CR==15 ; CARRIAGE RETURN CHARACTER
RUBOUT==177 ; RUBOUT CHARACTER
CRLF==BYTE(7)CR,LF
ESC==33 ; ESCAPE CHARACTER
FORMFD==14 ; FORM-FEED CHARACTER
SEP==","
QUOTE==42 ; DOUBLE QUOTE
STRTM=="~" ; TEXT STRING TERMINATOR (IN ARRAY & ON DISC)
; (TWIDDLE CHARACTER)
STRDIV=="^" ; TEXT STRING DIVIDOR (TEXT AFTER THIS CHAR WILL
; ONLY BE PRINTED IF TEXT MODE SWITCHED ON)
; (CIRCUMFLEX CHARACTER)
GTSYM==76 ; 'GREATER THAN' SYMBOL
CHAN==5 ; CHANNEL NO. FOR PRINTING NODES (TO TTY, DSK OR LPT)
CHANPH==1 ; CHANNEL NO. FOR READING/WRITING .PHI FILES
OPDEF PRCHR [1B8] ; IMMEDIATE MODE 'OUTCHR' FOR PRINTING
; TO TTY,DSK OR LPT.
OPDEF PRSTR [2B8] ; 'OUTSTR' FOR TTY,DSK OR LPT
DEFINE NASTY (N)
< [ MOVEI T1,N
JRST NASTEY ] >
DEFINE DEPST (ADR,N)
< MOVEI T1,ADR
MOVEI T2,N
CALL DEPSTR >
; MACRO TO 'SEND' A CHAR TO LOGGING PROGRAM IF LOGGING
; FACILITY AVAILABLE
DEFINE IPCCHX (C)
<
IFN LOG,<
WHENSK <SKIPN IPCBLK>,
< PUSH SP,C
CALL IPCCH
ADJSP SP,-1 >
> ; END OF IFN LOG
>
; DEFINITION OF NODE
NODLEN=3 ; LENGTH OF STRUCTURE
ANCDES=0 ; OFFSET FOR FIELD CONTAINING ANC. AND DES.
LINKS=1 ; OFFSET FOR FIELD CONTAINING LEFT & RIGHT LINKS
TXTOFF=2 ; OFFSET FOR "TEXT" FIELD
; MACROS FOR GETTING AND STORING POINTERS IN NODES.
DEFINE GTPREV (R,S)
< HLRZ R,TREE-1+LINKS(S) >
DEFINE GTNEXT (R,S)
< HRRZ R,TREE-1+LINKS(S) >
DEFINE GTDES (R,S)
< HRRE R,TREE-1+ANCDES(S) >
DEFINE GTANC (R,S)
< HLRZ R,TREE-1+ANCDES(S) >
DEFINE STPREV (R,S)
< HRLM R,TREE-1+LINKS(S) >
DEFINE STNEXT (R,S)
< HRRM R,TREE-1+LINKS(S) >
DEFINE STDES (R,S)
< HRRM R,TREE-1+ANCDES(S) >
DEFINE STANC (R,S)
< HRLM R,TREE-1+ANCDES(S) >
DEFINE GTTEXT (R,S)
< MOVE R,TREE-1+TXTOFF(S) >
DEFINE STTEXT (R,S)
< MOVEM R,TREE-1+TXTOFF(S) >
DEFINE CLNODE (S)
< SETZM TREE-1(S)
SETZM TREE-1+1(S)
SETZM TREE-1+2(S)
>
TWOSEG
STACK: BLOCK 100
ENDSTK:
TREE: BLOCK TRELEN
ENDTRE:
FRELST: Z ; CONTAINS ADDRESS OF FREE LIST (LIST OF DEAD SPACE
; IN TREE).
PRBUFA: Z ; TO CONTAIN START ADR OF WHERE BUFFERS FOR PRINTING
; (TO TTY, LPT OR DSK) ARE TO GO.
FLBUFA: Z ; TO CONTAIN START ADR OF WHERE BUFFERS FOR READING
; OR WRITING FILES ARE TO GO.
; TEXT ARRAY WILL COME AFTER BUFFERS, NEXTTX WILL CONTAIN
; POINTER TO NEXT AVAILABLE LOCN IN TEXT ARRAY,
; INITIALISED TO START OF TEXT ARRAY.
LASTTX: Z ; WILL CONTAIN BYTE POINTER TO END OF TEXT ARRAY
TEMP2: Z
TEMP3: Z
PROT: Z ; FOR LOCAL SAVING OF PROTECTION CODES
ICOL: Z ; FOR COUNTING CHARS WRITTEN IN A LINE
NLINES: Z ; NO. OF LINES ON CURRENT TTY PAGE
TTYPAG: Z ; NO. OF LINES TO BE PRINTED ON TTY BEFORE PAUSING
LPTPAG: Z ; PAGE SIZE FOR PRINTING TO LPT OR DSK
SAVESP: Z ; FOR SAVING STACK POINTER IN MAIN LOOP
SAVEF: Z ; FOR SAVING F IN MAIN LOOP
SAVEFF: Z ; FOR SAVING FFLEV IN MAIN LOOP
SAVENB: Z ; FOR SAVING NBL IN MAIN LOOP
SAVEIN: Z ; FOR SAVING INDNTC IN MAIN LOOP
CNODE: Z ; "CURRENT" NODE (NEVER VIRTUAL, EXCEPT IN MODIFICATION MODE,
; OR IF FILE IN INDIRECT FILE SPEC DOESNT EXIST)
CLEVEL: Z ; LEVEL OF CURRENT NODE (MUST ALWAYS BE UPDATED WHEN
; CNODE IS UPDATED )
CFILE: Z ; INDEX FOR CURRENT FILE INTO SUBJECT STACK
; HAS VALUES 0,1,2... (MAX VALUE ALLOWED IS MXFLEV-1)
CROOT: Z ; REL. ADR. OF ROOT NODE OF CURRENT SUBJECT FILE
CVER: Z ; REL. ADR. OF LAST NODE VERIFIED
PATH: BLOCK 30 ; WORK SPACE TO STORE A COMPUTED PATH VECTOR
ENDPTH:
LPATH: Z ; WORK SPACE TO CONTAIN LENGTH OF A PATH VECTOR
YNKNOD: Z ; TO CONTAIN A NODE THAT HAS BEEN 'YANKED' OUT OF TREE
; VARIABLES FOR STORING CURRENT SEARCH STATUS:
; (SEE ALSO FLAGS SRCTIT, SRCGLB, SRCNM)
SRCCHR: Z ; TO CONTAIN FIRST CHAR OF STRING, OR 0 IF NO CURRENT
; SEARCH DEFINED
SRCSTR: BLOCK LENSST ; TO CONTAIN CHARS 2 TO END OF SEARCH STRING
; TERMINATED BY NULL
SRCIFS: Z ; INDEX OF FILE IN WHICH SEARCH WAS DEFINED
SRCNS: Z ; REL. ADR. OF NODE AT WHICH SEARCH WAS DEFINED
SRCIFL: Z ; INDEX OF FILE IN WHICH LAST MATCH OCCURRED (OR =
; SRCIFS IF NO MATCH)
SRCNL: Z ; REL. ADR. OF NODE AT WHICH LAST MATCH OCCURRED (OR =
; SRCNS IF NO MATCH)
SRCLEV: Z ; GLOBAL LEVEL OF 'LAST SEARCH NODE' RELATIVE TO START NODE
; SUBJECT STACK:
DEV: BLOCK MXFLEV ; TO CONTAIN DEVICE NAME FOR FILES (OR 'DSK' IF
; READING FROM THE DEFAULT AREAS)
SUBJ: BLOCK MXFLEV ; TO CONTAIN SUBJECT NAMES
EXTA: BLOCK MXFLEV ; TO CONTAIN FILE EXTENSIONS
PPNA: BLOCK MXFLEV ; TO CONTAIN PPNS OF SUBJECT FILES (OR 0 IF OWN PPN
; OR -1 IF OWN PPN AND CURRENT PATH)
SFD1A: BLOCK MXFLEV ; TO CONTAIN SFD NAME 1 OF SUBJECT FILES (OR 0)
SFD2A: BLOCK MXFLEV ; TO CONTAIN SFD NAME 2 OF SUBJECT FILES (OR 0)
CNODEA: BLOCK MXFLEV ; TO STORE REL. ADR. OF A VIRTUAL NODE JUST BEFORE
; MOVING DOWN TO A LOWER LEVEL FILE.
NODFLG: BLOCK MXFLEV ; NODE FLAGS - BITS 0 AND 1 WILL BE SET FOR
; A NODE WITH AN INDIRECT FILE SPEC, JUST BEFORE
; BEFORE READING IN NEW FILE, TO INDICATE WHETHER
; NODE HAS 'PREV' AND 'NEXT' NODES.
ROOTND: BLOCK MXFLEV ; REL. ADR. OF ROOT NODE
ROOTIT: BLOCK MXFLEV ; BYTE POINTERS TO TITLES OF ROOT NODES (I.E. TO
; STARTS OF TEXT STRINGS FOR SUBJECTS
DEVICE: Z ; ) THESE ARE WORK VARIABLES (FOR PASSING VALUES
SUBJEC: Z ; ) TO AND FROM ROUTINES)
EXT: Z ; )
PPN: Z ; )
SFD1: Z ; )
SFD2: Z ; )
PVIRT: Z ; ) (SET FOR A VIRTUAL NODE - IT IS 'PRINT VALUE')
SIZE: Z ; TO CONTAIN SIZE IN WORDS OF INPUT .PHI FILE
FFLEV: Z ; LOWEST LEVEL (I.E. HIGHEST LEVEL NO.) FOR WHICH A NODE
; IS TO BE PRECEEDED BY A FORM-FEED IN TREE PRINTING
NBL: Z ; NO. OF LINEFEEDS TO BE PRINTED BEFORE A NODE OF LEVEL
; 'FFLEV+1' WHEN PRINTING A TREE. (SUCCESSIVELY LOWER
; LEVELS HAVE ONE LESS UNTIL NO LINEFEED).
INDNTC: Z ; INDENTATION FACTOR (I.E. NO. COLS/LEVEL)
LEVNT: Z ; FOR USE BY PRNODE: IF A NODE WITH NO TEXT IS PRINTED,
; LEVNT IS SET TO ITS LEVEL, SO THAT IF THE NEXT NODE TO
; BE PRINTED IS OF A LOWER LEVEL, ANY FORMFEED PRECEEDING
; IT WILL BE REPLACED BY CRLF'S.
MAXLEV: Z ; FOR USE IN VARIOUS COMMANDS
SBTNOD: Z ; DEFINES NODE AT TOP OF A SUB-TREE WHICH THE '+' COMMAND
; OPERATES WITHIN
SBTFIL: Z ; INDEX INTO SUBJECT STACK FOR FILE CONTAINING THE ABOVE NODE
NODBAR: Z ; USED AS AN INPUT ARG TO 'NEXTND', 'GLOBNX', 'NEXTRT'
; SPECIFIES A NODE WHICH BARS FURTHER PROGRESS IN A CALL
; TO THESE PROCS. I.E. DEFINES A SUB-TREE WITH THIS NODE
; AT THE TOP WITHIN WHICH THESE PROCS WILL OPERATE
ICBAR: Z ; USED AS INPUT ARG TO 'NEXTND', 'GLOBNX', 'NEXTRT'
; INDEX INTO SUBJECT STACK FOR FILE IN WHICH THE ABOVE
; NODE EXISTS.
INDNT: Z ; WORK VARIABLE FOR USE BY 'PRMAP'
UFDBUF: BLOCK 3 ; BCB FOR READING UFD
ITXBUF: BLOCK 3 ; BCB FOR INPUT TEXT
OTXBUF: BLOCK 3 ; BCB FOR OUTPUT TEXT
OPRBUF: BLOCK 3 ; BCB FOR PRINT FILE
ARGBLK: BLOCK 5 ; FOR USE IN LOOKUPS AND ENTERS (AND DSKCHR)
FLPBLK: BLOCK 6 ; FOR USE IN FILOP CALLS
FLPATH: BLOCK 6 ; FOR USE IN LOOKUPS AND ENTERS
IFN LOG,<
IPCBLK: BLOCK 22 ; FOR USE BY IPCF PROCS
>
CCTRAP: 4,,STOP ; INTERRUPT BLOCK FOR CTRL/C TRAPPING
ER.ICC
BLOCK 2
LOC 41
CALL UUOH ; CALL UUO HANDLER
LOC 134
CCTRAP ; ADDRESS OF INTERRUPT BLOCK FOR CTRL/C TRAPPING
RELOC 400000
; COMMAND TABLE
; THE ARGUMENTS TO X IN EACH ENTRY ARE AS FOLLOWS:
; 1. COMMAND CHARACTER
; 2. FLAG WORD
; 3. DISPATCH ADDRESS
; 4. TEXT TO BE PRINTED IN 'HELP' COMMAND
DEFINE TABLE
< X <>,CMNEWL,FINCOM,<
***Miscellaneous commands:>
X E,CMNEWL,STOP,(Exit)
X ?,0,XMAP,(Where am I?)
X H,0,XHELP,(Help!)
X <>,CMNEWL,FINCOM,<
***Print commands:>
X P,CMNEWL,XPRINT,(P, P/DSK, P/LPT - Print current section & sub-tree)
X L,CMNEWL,XLST,(L, L/DSK, L/LPT - List titles of current section & sub-tree)
X C,CMNEWL,XCUR,(Print current section)
X <>,CMNEWL,FINCOM,<
***Move commands:
number,n - move to n'th immediate descendant>
X O,CMNEWL,XROOT,(to top of subject)
X 0,0,XROOT,(to top of subject)
X U,0,XUP,(Up to ancestor)
X R,CMNEWL,XRSTRT,(Re-start at top)
X N,0,XNEXT,(Move to next node at same level)
X +,CMNEWL,XNXTND,(Move to next node in tree)
X B,0,XBACK,(Back a node at same level)
X J,CMNEWL,XJUMP,(Jump up)
X ',0,XSRCTI,(Search in titles)
X F,0,XSRCTE,(search in titles and text)
X G,CMNEWL,XGLOBS,(GF, G' start global search)
X <>,CMNEWL,FINCOM,<
***Switch changing and value setting commands:>
X /,CMNEWL,XSWITCH,(for list of commands type /H)
X <>,CMNEWL!CMMOD,FINCOM,<
***File updating commands:>
X W,CMNEWL!CMMOD,XWRITE,(Write subject to disk)
X M,CMMOD,XMODY,(Modify node, M/ - Edit text for node)
X X,CMNEWL!CMMOD,XADDX,(Add a single eXtra node)
X D,CMMOD,XDELET,(DN - Delete current node. DT - also subtree)
X Y,CMNEWL!CMMOD,XYANK,(Yank current node out of tree)
X A,CMMOD,XADD,(Add new sub-tree)
>
DEFINE X(A,B,C,D) <"A">
COMS: TABLE
ENDCOM:
DEFINE X(A,B,C,D) <B>
COMTYP: TABLE
DEFINE X(A,B,C,D) <C>
COMADR: TABLE
DEFINE X(A,B,C,D) <MSG "D">
COMHLP: TABLE
; SWITCH TABLE (FOR SWITCH CHANGING AND VALUE SETTING COMMANDS)
; ARGS TO X IN EACH ENTRY ARE:
; 1. COMMAND CHARACTER
; 2. FLAG WORD
; 3. DISPATCH ADDRESS (OR SWITCH TO BE FLIPPED IF SWCHNG
; IS SET IN FLAG WORD)
; 4. TEXT TO BE PRINTED IN /H COMMAND
DEFINE TABLE
< X G,SWCHNG!CMNEWL,GUIDE,(user guidance)
X S,0,XSEP,(separation values a.b)
X I,CMNEWL,XINDNT,(indentation factor n)
X P,0,XPAGE,(TTY page size, /PL: LPT page size)
X U,SWCHNG!CMNEWL,UNDERL,(title underlining)
X M,0,XMODON,(modification mode)
X B,SWCHNG,BELL,(bell in pause msg)
X H,CMNEWL,XSWHLP,(print this help text)
>
DEFINE X(A,B,C,D) <"A">
SWCOMS: TABLE
ENDSWC:
DEFINE X(A,B,C,D) <B>
SWTYP: TABLE
DEFINE X(A,B,C,D) <C>
SWADR: TABLE
DEFINE X(A,B,C,D) <MSG " D">
SWHLP: TABLE
PHI: TXZA F,CCL ; CLEAR CCL FLAG AND SKIP
TXO F,CCL ; CCL ENTRY - SET CCL FLAG
RESET
SETZM CCTRAP+2 ; TO ALLOW CTRL/C TRAPPING
MOVE SP,[STACK-ENDSTK,,STACK-1]
IFN LOG,<
PUSH SP, [[ASCIZ/IPCFR/]]
CALL IPCGPD ; GET PID OF LOGGING PROGRAM
ADJSP SP,-1
WHENSK <SKIPN IPCBLK>,
< CALL IPCTX ; HERE IF LOGGING PROG RUNNING
ASCIZ /***PHI / >
> ; END IFN LOG
WHENSK <SKPON CCL>,
< RESCAN ; IF CCL
INCHWL CH
CALL RD6NAM ; SKIP OVER COMMAND 'PHI'
>,
< MSGN <subject? >
INCHWL CH >
SETZ F, ; INITIALISE FLAGS TO 0
SETF GUIDE ; SWITCH ON USER GUIDANCE
SETF BELL ; SWITCH ON BELL IN PAUSE MSG
SETF UNDERL ; SWITCH ON TITLE UNDERLINING
SETOM CFILE ; INITIALISE CFILE TO -1
MOVEIM 1,FFLEV,T1
MOVEIM 2,NBL,T1
MOVEIM 3,INDNTC,T1 ; INITIALISE INDENTATION FACTOR
SETZM TTYPAG
; NOW SEE IF ON A VDU, AND IF SO RE-SET TTYPAG TO 22
MOVNI T3,1
TRMNO. T3, ; GETS UDX INTO T3
JFCL
MOVE T1,[2,,T2]
MOVEI T2,.TOTRM
TRMOP. T1, ; GET TERMINAL TYPE INTO T1
JFCL
MOVEI T2,^D22
CAMN T1,[SIXBIT/VDU/] ; ON A VDU?
MOVEM T2,TTYPAG ; YES
CAMN T1,[SIXBIT/7009/] ; OR A 7009?
MOVEM T2,TTYPAG ; YES
MOVEIM ^D60,LPTPAG,T1
MOVEI NEXLOC,1
SETZM FRELST
SETZM SRCCHR ; NO CURRENT SEARCH
MOVEI T1,1 ; REL. ADR. OF ROOT NODE FOR TOP LEVEL SUBJ FILE
MOVEM T1,SBTNOD ; DEFINE CURRENT 'SUB-TREE' AS WHOLE TREE
SETZM SBTFIL
WHLSKP <CAIE CH,"/">,
< IPCCHX CH ; SEND CHAR TO LOGGING PROG
CALL SWITCH
INCHWL CH ; RETURN 1
SKIPA ; RETURN 2
JRST STOP ; RETURN 3
JRST >
CALL INITXT ; ALLOCATE SPACE FOR ALL BUFFERS AND DEFINE TEXT
; ARRAY TO BE AFTER THIS. SETS NEXTTX, LASTTX, PRBUFA
; AND FLBUFA.
; NOW SKIP OVER ANY BLANKS
WHLSKP <CAIE CH," ">,
< INCHWL CH
JRST >
DO
< PUSH SP, [[ INCHWL CH
RETURN ]]
UNSETF EXTALL ; FILE EXTENSION NOT ALLOWED
CALL RDSUBG
ADJSP SP,-1
JUMPN T1, [MSGN <SYNTAX ERROR>
JRST STOP ]
MOVE T1,SUBJECT
JUMPN T1,SUBJRD ; SUBJECT NAME WAS READ
CAIE CH,"*"
JRST [ MOVEMM [SIXBIT/DOC/],DEVICE,T1 ; NO SUBJECT SPECIFIED
MOVEMM [SUBJ0],SUBJEC,T1
SETOM PPN
SETZM SFD1
SETZM SFD2
SETF NOSUBJ
JRST SUBJRD ]
CALL GETLFE ; SKIP TO LF OR ESC
MSGN <Subjects generally available in PHI form ->
MSGN <>
MOVEMM FLBUFA,.JBFF,T1
OPEN 1, [13
SIXBIT/DSKB/
0,,UFDBUF ; USE UFDBUF FOR BCB SPACE
]
JRST ERROPN
MOVEMM [DOCPPN],ARGBLK,T1
MOVEMM [SIXBIT/UFD/],ARGBLK+1,T1
SETZM ARGBLK+2
MOVEMM [1,,1],ARGBLK+3,T1
LOOKUP 1,ARGBLK
JRST [MSGN<ERROR IN LOOKUP FOR DOC UFD>
EXIT ]
MOVEI S1,1 ; CHANNEL NO.
MOVEI S2,UFDBUF ; BUFFER ADDRESS
MOVEI WORK,9 ; COUNT FOR NUMBER OF PLACES LEFT IN A LINE
DO
< CALL GETCH ; READ A WORD FROM THE UFD
SKPON EOF
SKIPN CH
JRST OUTUFD ; EOF OR NULL WORD
MOVE S3,CH
CALL GETCH ; READ THE FILE EXTENSION
SKPOFF EOF
JRST [MSGN <EOF ON UFD>
EXIT ]
HLLZ S4,CH
WHENSK <CAME S4, [SIXBIT/PHI/] >,
< UNLJMP <JUMPG WORK, >,
< MSGN <>
MOVEI WORK,9 >
MOVE T1,S3
CALL WR6BIT
OUTCHR [TAB]
SOS WORK >
JRST >
OUTUFD: MSGN <
PHI can also be used to examine subjects on HLP, though these subjects
are not divided into sub-sections. Type HELP * for a list of them.
>
IFN SUBJ0, <
MSGN <Typing PHI on its own will get you to the top level of the
'PHI documentation system'. From there you can browse through all the
information available in PHI or HELP form.
> >
MSGN<To examine the full documentation for the PHI program,
type PHI as subject name.
subject? >
RELEASE 1,
INCHWL CH
JRST >
SUBJRD: WHENSK <CAIE CH,"-">,
< SETF COREMS ; SWITCH ON CORE MSGS
CALL CORMSG
INCHWL CH >
WHLSKP <CAIE CH,"/">,
< IPCCHX CH ; SEND CHAR TO LOGGING PROG
CALL SWITCH
INCHWL CH ; RETURN 1
SKIPA ; RETURN 2
JRST [ CALL GETLFE ; RETURN 3
JRST READSU ]
JRST >
READSU:
IFN LOG,<
WHENSK <SKIPN IPCBLK>,
< PUSH SP, [[ PUSH SP,T3
CALL IPCCH
ADJSP SP,-1
RETURN ]]
MOVE T1,SUBJEC
CALL WR6BIG
ADJSP SP,-1
CALL IPCTX
ASCIZ / / >
> ; END IFN LOG
MOVEM NEXTTX,ROOTIT
MOVEM NEXLOC,ROOTND
AOS CFILE
CALL FNDFIL ; FIND INPUT FILE
JUMPE T1, [ SKPOFF NOSUBJ ; FILE NOT FOUND
MSGN <type PHI followed by subject name,
or type PHI * to get list of subjects available>
SKPON NOSUBJ
MSGN <subject not found>
JRST STOP ]
JUMPG T1,ERRF ; ERROR OTHER THAN 'FILE NOT FOUND'
WHENSK <SKPOFF NEWSUB>,
< MOVE T1,EXT
WHENSK <CAMN T1,[SIXBIT/PHI/]>,
< MOVE S1,DEVICE ; NOT A .PHI FILE - SET UP TITLE
; FOR IT
SETZM S2 ; ENSURES A NULL AFTER STRING
PUSH SP,CH ; SAVE CH
DEPST S1,6
MOVEI CH,":"
CALL DEPCH
MOVE S1,SUBJEC
DEPST S1,6
MOVEI CH,"."
CALL DEPCH
MOVE S1,EXT
DEPST S1,6
DEPST [BYTE(7) STRDIV,CR,LF], 7
POP SP,CH >
CALL READIN >
CALL ROOT ; MOVE TO ROOT NODE
CALL STORFS ; STORE FILE SPEC IN SUBJECT STACK
CALL OPNTTY
SUBTTL MAIN COMMAND LOOP
DO
< MOVEM SP,SAVESP ; SAVE STACK POINTER
MOVEMM FFLEV,SAVEFF,T1 ; SAVE FFLEV
MOVEMM NBL,SAVENB,T1 ; SAVE NBL
MOVEMM INDNTC,SAVEIN,T1 ; SAVE INDNTC
SETZM NLINES
SETF SUPUND
SKPON TTYPR
CALL OPNTTY
CAIN CH,LF
JRST FINCOM ; IGNORE LF
UNSETF VER
CAIE CH,CR ; CR?
CAIN CH,ESC ; ...OR ESC?
JRST [ TXZE F,SUPVER ; YES, SKIP IF SUPVER OFF;
; SWITCH OFF ANYWAY
JRST FINCOM ; IF VERIFICATION SUPPRESSED
UNSETF SUPGUI
JRST XVER ]
UNSETF SUPVER
UNSETF SUPGUI
CAIN CH," "
JRST FINCOM ; IGNORE BLANK
CAIN CH,"."
JRST FINCOM ; IGNORE DOT
CAIN CH,32 ; CTRL/Z?
JRST STOP ; YES
UPCASE CH
MOVE T2, [COMS-ENDCOM,,0] ; SET UP A COUNTER-MODIFIER
DO
< CAMN CH,COMS(T2)
JRST [
IFN LOG,<
WHENSK <SKIPN IPCBLK>,
< CALL IPCTX
ASCIZ /:/
PUSH SP,CH
CALL IPCCH
ADJSP SP,-1 >
> ; END IFN LOG
MOVE T1,COMTYP(T2)
TXNE T1,CMMOD ; NOT MODIFICATION COMMAND?
SKPOFF MOD ; ...OR MODIF MODE ALREADY ON?
JRST @COMADR(T2) ; YES - GO AND DO IT
MSGN <***not in modification mode>
JRST SKIPEL ]
AOBJN T2, >
CALL DECIN ; TRY FOR A NUMBER
SKIPE T2
JRST XDES ; NUMBER READ
MSGN <EH?>
JRST SKIPEL
XSWITCH: CALL SWITCH
JRST FINSV
JRST FINSV2
JRST SKIPEL
XWRITE: CALL GETFS ; SETS DEVICE,SUBJECT,EXT,PPN,SFD1,SFD2
DEFINE X (EXT1,EXT2)
< SETZM PROT
MOVEMM FLBUFA,.JBFF,T1
DEFFL2 CHANPH,0,DEVICE,0,ITXBUF,SUBJECT,[SIXBIT/EXT2/],
PROT,ARGBLK,PPN,SFD1,SFD2,FLPATH,NFLBFS
; - SEE IF EXT2 FILE EXISTS
JUMPG T1, [MSGN <FILE .'EXT2 CANNOT BE DELETED - >
JRST ERRWR ]
UNLJMP <JUMPE T1,>,
< SETZM ARGBLK
RENAME 1,ARGBLK ; DELETE THE EXT2 FILE
JRST [MSGN <ERROR IN DELETING THE .'EXT2 FILE>
JRST ERRWR ] >
SETZM PROT
MOVEMM FLBUFA,.JBFF,T1
DEFFL2 CHANPH,0,DEVICE,0,ITXBUF,SUBJECT,[SIXBIT/EXT1/],
PROT,ARGBLK,PPN,SFD1,SFD2,FLPATH,NFLBFS
; - TO SEE IF EXT1 FILE ALREADY EXISTS
JUMPG T1,ERRWR
UNLJMP <JUMPE T1,>,
< MOVEMM SUBJECT,ARGBLK,T1 ; FILE DOES EXIST
MOVEMM [SIXBIT/EXT2/], ARGBLK+1, T1
SETZM ARGBLK+2
SETZM ARGBLK+3
MSGN <renaming file >
MOVE T1,SUBJECT
CALL WR6BIT
MSG ".'EXT1 as "
CALL WR6BIT
MSG ".'EXT2"
RENAME 1,ARGBLK ; RENAME FILE EXT1 TO EXT2
JRST ERRWR >,
< SETZM PROT >
>
X PHI,QHI
MOVEMM FLBUFA,.JBFF,T1
DEFFL2 CHANPH,0,DEVICE,OTXBUF,0,SUBJECT,EXT,PROT,ARGBLK,
PPN,SFD1,SFD2,FLPATH,NFLBFS
JUMPGE T1,ERRWR
MSGN <writing to >
CALL PRFS
MOVEI S3,1 ; CHANNEL NUMBER FOR WRITING .PHI FILE
MOVEI S4,OTXBUF ; BCB ADDRESS
UNSETF TTYPR
CALL WRPHI
RELEASE CHANPH,
JRST FINSV
ERRWR: CALL FILERR ; HERE IF ERROR IN WRITING FILE
MSGN <please choose a new subject name
(and device, extension and path if reqd): >
DO
< CALL GETLFE
PUSH SP, [[ INCHWL CH
RETURN ]]
INCHWL CH
SETF EXTALL ; FILE EXTENSIONS ALLOWED
CALL RDSUBG
ADJSP SP,-1
SKIPN T1
SKIPN SUBJECT
JRST ERRWR1
CAIE CH,CR
JRST ERRWR1 ; NEXT CHAR NOT CR
CALL STORFS ; UPDATE FILE DETAILS
MOVEI CH,"W" ; SIMULATE ANOTHER "W"
JRST FINCM2
ERRWR1: MSGN<syntax error - try again: >
JRST >
XROOT: MOVE T1,CNODE
CAMN T1,CROOT
JRST [ MSGN <(already at top of subject)>
MSGN <> ; IN CASE OP TYPED
JRST FINSV ]
CALL ROOT
JRST FINCOM
XUP: MOVE T1,CNODE
SKIPN CFILE
CAME T1,CROOT
SKIPA
JRST [ MSGN <Already at top of tree>
MSGN <>
JRST SKIPEL ]
WHENSK <CAME T1,CROOT>,
< SOS CFILE ; IF AT ROOT NODE
CALL UPFILE >
GTANC T1,T1
JUMPLE T1,NASTY 1 ; UGH!
MOVEM T1,CNODE
CALL SETLEV
JRST FINCOM
XJUMP: SKIPN CFILE
JRST [ MSGN <no ancestor subjects>
MSGN <>
JRST SKIPEL ]
SOS CFILE
CALL UPFILE
JRST FINCOM
XRSTRT: WHENSK <SKIPN CFILE>,
< SETZM CFILE ; SO WE WILL GET TOP LEVEL SUBJECT
CALL UPFILE >,
< MOVE T1,CNODE ; ALREADY IN TOP LEVEL FILE
CAMN T1,CROOT ; AT ROOT NODE?
JRST [ MSGN <(Already at top of tree)> ; YES
MSGN <> ; IN CASE RP TYPED
JRST FINSV ]
CALL ROOT >
JRST FINCOM
XDES: MOVE WORK,T1 ; NO. OF IMM. DES. REQD.
IFN LOG,<
WHENSK <SKIPN IPCBLK>,
< CALL IPCTX
ASCIZ /:/
PUSH SP,WORK
CALL IPCDEC
ADJSP SP,-1 >
> ; END IFN LOG
CALL NFIND
JUMPE T1, [ MSGN <***sub-section not found>
JRST SKIPEL ]
AOS CLEVEL
CALL MAKCUR
JRST FINCM2
XBACK: MOVE T2,CNODE
GTPREV T1,T2
JUMPN T1, [ CALL MAKCUR ; O.K. MAKE IT CURRENT NODE
JRST FINCOM ]
CAMN T2,CROOT
SKIPN CFILE
JRST XBACKE
MOVE T1,CFILE ; HERE IF AT ROOT NODE BUT THERE ARE HIGHER
; LEVEL FILES WE CAN MOVE UP TO
MOVE T2,NODFLG-1(T1) ; GET NODE FLAGS
TXNN T2,1B0 ; BIT 0 SET? I.E. ANY PREV NODE?
JRST XBACKE ; NO
SOS CFILE ; YES - MOVE UP TO HIGHER FILE
CALL UPFILE
GTPREV T1,T1
JUMPLE T1,NASTY 2 ; AAAARGH!
CALL MAKCUR
CALL SETLEV
JRST FINCOM
XBACKE: MSGN <No preceeding node at same level>
JRST SKIPEL
XNEXT: MOVE T2,CNODE
GTNEXT T1,T2
JUMPN T1, [ CALL MAKCUR ; O.K. MAKE IT CURRENT NODE
JRST FINCOM ]
CAMN T2,CROOT
SKIPN CFILE
JRST XNEXTE
MOVE T1,CFILE ; HERE IF AT ROOT NODE BUT THERE ARE HIGHER
; LEVEL FILES WE CAN MOVE UP TO
MOVE T2,NODFLG-1(T1) ; GET NODE FLAGS
TXNN T2,1B1 ; BIT 1 SET? I.E. ANY NEXT NODE?
JRST XNEXTE ; NO
SOS CFILE ; YES - MOVE UP TO HIGHER FILE
CALL UPFILE
GTNEXT T1,T1
JUMPLE T1,NASTY 3 ; OH DEAR!
CALL MAKCUR
CALL SETLEV
JRST FINCOM
XNEXTE: MSGN <No next node at same level>
JRST SKIPEL
XGLOBS: INCHWL CH
UPCASE CH
SETF FLAG ; TO SAY IT WAS 'G'
SETF SRCTIT
CAIN CH,"'"
JRST XSRC
UNSETF SRCTIT
CAIN CH,"F"
JRST XSRC
MSGN <G command must be followed by ' or F>
JRST SKIPEL
XSRCTI: TXOA F,SRCTIT ; SET SRCTIT AND SKIP
XSRCTE: UNSETF SRCTIT
UNSETF FLAG ; TO SAY IT WAS ' OR F COMMAND
XSRC: SETOM MAXLEV ; NO LIMIT TO DEPTH OF SEARCH
INCHWL CH
UNLJMP
< CAIE CH,CR
CAIN CH,ESC
JRST >,
< UPCASE CH ; HERE IF DEFINING NEW SEARCH STRING
MOVEM CH,SRCCHR
IPCCHX CH
SETF SRCGLB ; SET GLOBAL MODE
SKPON FLAG ; WERE WE RIGHT?
UNSETF SRCGLB ; NO, IT IS LOCAL
MOVEMM CFILE,SRCIFS,T1
MOVEMM CNODE,SRCNS,T1 ; STORE REL. ADR. OF START NODE
SETZM LEVEL
MOVE S4,[POINT 7,SRCSTR]
UNTILJ
< INCHWL CH
CAIE CH,CR
CAIN CH,ESC
JRST >,
< UPCASE CH
CAMN S4, [POINT 7,SRCSTR+LENSST-1,27]
JRST [ MSGN <SEARCH STRING TOO LONG>
SETZM SRCCHR
JRST SKIPEL ]
IDPB CH,S4
IPCCHX CH
JRST >
PUSH SP,CH ; SAVE LAST CH READ FROM TTY
SETZ CH,
IDPB CH,S4 ; DEPOSIT A NULL CHARACTER
MOVE S1,CNODE ; S1 WILL BE NODE WE ARE CURRENTLY
; LOOKING AT
SETZM SRCIFL ; SET TO 0 DURING SEARCH SO THAT 'UPFILE'
; WILL NOT ERASE THE CURRENT SEARCH IF
; WE GO ABOVE LAST SEARCH NODE FILE
MOVEMM SRCIFS,ICBAR,T1 ; SET BAR TO START NODE
MOVEMM SRCNS,NODBAR,T1
>,
< SKPOFF FLAG ; HERE IF RESUMING A SEARCH
JRST [ MSGN <string must be specified in G' or GF command>
JRST SKIPEL ]
SKIPN SRCCHR
JRST [ MSGN <no search string currently defined>
JRST SKIPEL ]
PUSH SP,CH ; SAVE LAST CH READ FROM TTY
MOVE T1,CFILE
WHENSK <CAMN T1,SRCIFL>,
< CAMG T1,SRCIFL ; HERE IF NOT IN FILE CONTAINING
; LAST SEARCH NODE
JRST NASTY 4 ; SHOULD NOT BE ABOVE IT
MOVEMM SRCIFL,CFILE,T1
CALL UPFILE >
MOVEMM SRCNL,CNODE,T1 ; MOVE TO LAST SEARCH NODE
CALL SETLEV ; UPDATE CLEVEL
MOVE LEVEL,SRCLEV
MOVE S1,CNODE
SETZM SRCIFL ; SET TO 0 DURING SEARCH SO THAT 'UPFILE'
; WILL NOT ERASE THE CURRENT SEARCH IF
; WE GO ABOVE LAST SEARCH NODE FILE
MOVEMM SRCIFS,ICBAR,T1 ; SET BAR TO START NODE
MOVEMM SRCNS,NODBAR,T1
SKPON SRCNM
JRST XSRCLP ; SORRY ABOUT THIS MR DIJKSTRA!
>
DO
< ; CONTINUE LOOKING IN CURRENT FILE
DO
< MOVE T1,S1
CALL TESTND
WHENSK <SKPON MTCH>,
< GTTEXT T1,S1 ; HERE IF MATCHED
MSGN <>
CALL PRTIT ; PRINT TITLE
MSGN <..OK? >
SKPOFF GUIDE
msg "(type Y if this is the one you want) "
CLRBFI
INCHRW T1
UPCASE T1
CAIN T1,"Y"
JRST [ MSG "es
"
JRST XSRCM ] >
XSRCLP: MOVE T1,S1
CALL NEXTND
MOVE S1,T2
SKIPE T2
CAMN T2,CROOT
SKIPA ; SKIP OUT OF LOOP IF NEXT NODE IS
; SEARCH START OR ROOT NODE
JRST >
; HERE WHEN WE REACH START NODE OR ROOT NODE
SKPON SRCGLB ; GLOBAL SEARCH?
JRST XSRCNM ; NO
; TRY NEXT FILE
MOVE S1,CROOT ; SET S1 TO ROOT NODE
MOVE T2,CFILE
CAMN T2,SRCIFS ; IN FILE CONTAINING START NODE?
MOVE S1,SRCNS ; YES - RESET S1 TO START NODE
MOVE T1,S1
CALL NEXTRT ; FIND NEXT FILE
JUMPE T2,XSRCNM ; IF NO MORE
MOVE S1,CROOT
SKPOFF SRCTIT ; TITLES ONLY?
JRST XSRCLP ; YES - APOLOGIES AGAIN TO DIJKSTRA
; AND ALL FANS OF STRUCTURED PROGRAMMING. WE ARE
; JUMPING BACK INTO THE LOOP AT XSRCLP BECAUSE
; WE HAVE ALREADY LOOKED AT THE TITLE OF THIS ROOT
; NODE IN THE ANCESTOR FILE.
JRST >
XSRCNM: MSGN <***can't find >
OUTCHR SRCCHR
MOVE T1,[POINT 7,SRCSTR]
UNTILJ
< ILDB T2,T1
JUMPE T2, >,
< UPCASE T2
OUTCHR T2
JRST >
MSGN <>
MOVEMM SRCIFS,SRCIFL,T1 ; ) SET LAST NODE TO START NODE
MOVEMM SRCNS,SRCNL,T1 ; )
MOVEMM SRCNS,CNODE,T1 ; SET CURRENT NODE TO START NODE
CALL SETLEV
SETF SRCNM ; SO THAT IF USER RE-STARTS THE SEARCH
; WE WILL TEST THE 'LAST SEARCH NODE' FIRST
SETZM SRCLEV
MOVE T1,CNODE
CAMN T1,CVER ; WAS CURRENT NODE LAST ONE VERIFIED?
SETF SUPVER ; YES, SO SUPPRESS VERIFICATION THIS TIME
JRST XSRCE
XSRCM: MOVEM S1,SRCNL ; SET MATCHED NODE TO BE LAST SEARCH NODE
MOVEM S1,CNODE ; ..AND CURRENT NODE
CALL SETLEV
MOVEMM CFILE,SRCIFL,T1
MOVEM LEVEL,SRCLEV
UNSETF SRCNM
CALL INDFS ; TEST WHETHER VIRTUAL NODE
WHENSK <SKIPN SUBJEC>,
< MOVE T1,S1 ; IT IS VIRTUAL
CALL DNFILE ; MOVE DOWN TO DESCENDANT FILE
>
XSRCE: POP SP,CH
JRST FINCM2
XPRINT: UNSETF SUPUND ; SWITCH OFF SUPPRESSION OF UNDERLINING
TXZA F,FLAG ; UNSET FLAG AND SKIP
XLST: SETF FLAG
SETZM LEVEL
SETOM MAXLEV ; NO LEVEL LIMIT
MOVEI T1,777777
MOVEM T1,LEVNT ; SET TO A LARGE VALUE
UNSETF PRSEP
INCHWL CH
WHENSK <CAIE CH,ARGDEL>,
< MOVEMM [CHAN,,.FOWRT],FLPBLK,T1 ; CHANNEL NO. AND CODE
SETZM FLPBLK+.FOIOS ; STORE MODE
HRLZI T1,OPRBUF
MOVEM T1,FLPBLK+.FOBRH ; STORE BCB ADDRESS
HRLZI T1,NPRBFS
MOVEM T1,FLPBLK+.FONBF ; STORE NO. OF BUFFERS
MOVEI T1,ARGBLK
MOVEM T1,FLPBLK+.FOLEB ; STORE ADR OF ENTER BLOCK
MOVE T1,CFILE
MOVEMM SUBJ(T1),ARGBLK,T1 ; FILENAME
MOVEMM [SIXBIT/LST/],ARGBLK+1,T1 ; EXTENSION
SETZM ARGBLK+2
SETZM ARGBLK+3
DO
< INCHWL CH
CALL RD6NAM ; READ ARGUMENT
CAME T1,[SIXBIT/DSK/]
CAMN T1,[SIXBIT/LPT/]
UNSETF TTYPR ; UNSET TTYPR FLAG IF DSK OR LPT
CAME T1,[SIXBIT/DSK/]
CAMN T1,[SIXBIT/LPT/]
MOVEM T1,FLPBLK+.FODEV ; STORE DEVICE NAME
WHENSK <CAME T1,[SIXBIT/ADD/]>,
< MOVEI T2,.FOAPP ; CODE FOR APPEND
HRRM T2,FLPBLK ; STORE CODE
SETF PRSEP ; TO ENSURE FORMFEED AT START
>
CAIN CH,ARGDEL ; SKIP OUT IF NO MORE ARGS
JRST >
MOVEMM PRBUFA,.JBFF,T1
MOVE T1,[6,,FLPBLK]
FILOP. T1,
JRST [ MOVEM T1,ARGBLK+1
CALL FILERR ; PRINT ERROR MSG
JRST SKIPEL ]
>
PUSH SP,CH ; SAVE LAST CHAR READ FROM TTY
SETF PRTX ; SWITCH ON TEXT PRINTING
SETF PRPTH ; SWITCH ON PATH PRINTING
SKPOFF FLAG
UNSETF PRTX ; L COMMAND - SWITCH OFF TEXT PRINTING
PUSH SP,CNODE
CALL PRNODE ; PRINT CURRENT NODE
ADJSP SP,-1
SETF PRSEP ; SWITCH ON NODE SEPARATION
WHENSK <SKPON FLAG>,
< SETZM FFLEV ; HERE IF L COMMAND
SETZM NBL >,
< WHENSK <SKPON TTYPR>,
< SETZM FFLEV ; HERE IF PRINTING TO TTY IN P COMMAND
SETZM INDNTC > >
MOVEMM CFILE,ICBAR,T1
MOVE T1,CNODE ; REL. ADR. OF CURRENT NODE
MOVEM T1,NODBAR
SETF GLOBP ; SO THAT 'P VALUES' WILL BE LOOKED AT IN GLOBNX
WHLSKP
< CALL GLOBNX
SKIPG T2 >,
< PUSH SP,T2 ; ADDRESS OF NODE TO BE PRINTED
CALL PRNODE ; PRINT THE NODE
POP SP,T1 ; RETRIEVE NODE ADR. FOR NEXT TIME ROUND
JRST >
POP SP,CH ; RESTORE LAST CHAR READ FROM TTY
MOVEMM SAVEIN,INDNTC,T1
MOVEMM SAVENB,NBL,T1
MOVEMM SAVEFF,FFLEV,T1
RELEASE CHAN,
CALL OPNTTY ; IN CASE WE WERE PRINTING TO LPT OR DSK
JRST SKIPEL
XCUR: SETZ LEVEL,
MSGN <>
SETF PRTX
SETF PRPTH
UNSETF PRSEP
PUSH SP,CNODE
CALL PRNODE
JRST SKIPEL
XADD: TXZA F,FLAG ; UNSET FLAG AND SKIP
XADDX: SETF FLAG
MOVE T1,CNODE
GTDES T1,T1
SETZ T2,
CLRBFI ; CLEAR ANYTHING TYPED AFTER THE COMMAND
UNLJMP <JUMPE T1, >,
< MSGN <Where to insert? - type 0 (for start), number,
or press return (for end):
>
INCHWL CH
CALL DECIN ; TRY FOR A NUMBER
MOVNI T4,1
SKIPE T2 ; SKIP IF NOT A NUMBER
MOVE T4,T1 ; WAS A NUMBER
MOVE T2,T4
CLRBFI >
MOVE T1,CNODE
CALL WHDES ; SETS T3 TO REL. ADR. OF NODE WHICH
; WILL BE PREVIOUS TO ONE ADDED (OR 0)
SKIPGE T3
JRST [ MSGN <can't do that - there are only >
MOVE T1,T2
CALL DECOUT
MSG " immediate descendants of current section"
JRST SKIPEL ]
MOVE S2,T3
WHENSK <SKPOFF FLAG>,
< PUSH SP,CNODE ; HERE IF "A" COMMAND - STACK ANCESTOR
; NODE FOR NEW TREE
MSGN <enter tree to be inserted:>
MSGN <>
CALL CRTTRE
POP SP,T1
CAIE CH,CR ; CR...
CAIN CH,ESC ; ...OR ESC?
SKIPA ; YES
JRST ERROR ; NO
JRST SKIPEL >,
< ; HERE IF "X" COMMAND
CALL CRTNOD ; RETURNS T1 AS NODE ADR.
MOVE S1,T1
MOVE T2,CNODE ; ANCESTOR
MOVE T3,S2 ; PREVIOUS NODE
CALL INSLST ; INSERT THE NEW NODE
MOVE T1,S1
CALL SETPTH ; SETS UP A PATH VECTOR IN "PATH"
MSGN <section >
MOVEI S3,CHAN ; CHANNEL NO.
MOVEI S4,OPRBUF ; BCB
PUSH SP,S1 ; SAVE S1
CALL PRPATH ; PRINT PATH VECTOR
POP SP,S1 ; RESTORE S1
OUT CHAN,
SKIPA ; O.K.
JRST [ MSGN<ERROR IN OUT MONITOR CALL>
EXIT ] ; AAAAAAAAARGH!
MSG " created"
CALL RDNOD ; READ TITLE/TEXT
JRST FINCOM >
XDELET: INCHWL CH
UPCASE CH
MOVE S1,CNODE
CAMN S1,CROOT ; DON'T DELETE THE ROOT NODE!
JRST INVAL
WHENSK <CAIE CH,"T">,
< MOVE T1,S1
CALL REMNOD
CALL FRETRE >,
< CALL DELNOD >
CALL ROOT
JRST FINCOM
XMODY: INCHWL CH
MOVE S1,CNODE
WHENSK <CAIN CH,"/">,
< CLRBFI
CALL RDNODM
JRST FINCOM >
CLRBFI ; HERE IF M/ COMMAND
GTTEXT S1,S1 ; GET TEXT POINTER
MOVE S2,NEXTTX ; POINTER FOR NEW STRING
CALL EDIT ; EDITS FROM OLD STRING TO NEW STRING
WHENSK <CAIN CH,"Q">,
< MOVE T1,CNODE ; HERE IF EDIT WAS NOT ABANDONED
STTEXT NEXTTX,T1 ; STORE POINTER TO NEW TEXT
MOVE NEXTTX,S2 ; RESET POINTER TO NEXT FREE
; TEXT LOCATION.
>
JRST FINCOM
XYANK: MOVE T1,CNODE
CAMN T1,CROOT ; DON'T YANK THE ROOT NODE!
JRST INVAL
MOVEM T1,YNKNOD
CALL REMNOD ; REMOVE NODE FROM TREE
CALL ROOT
JRST FINCOM
XMAP: CALL PRMAP
SETF SUPGUI ; SUPPRESS USER-GUIDANCE MSG
JRST FINSV
XHELP: MSGN <For full documentation, run the program again and >
MSG "type PHI for subject name"
MSGN <There follows a brief list of available commands - >
MOVE T4,[COMS-ENDCOM,,0] ; SET UP COUNTER-MODIFIER
DO
< MOVE T1,COMTYP(T4) ; GET FLAGS
TXNE T1,CMMOD ; MODIFICATION TYPE COMMAND?...
SKPOFF MOD ; ...AND MODIFICATION MODE OFF?
SKIPA ; NO - CONTINUE
JRST XHELP1 ; YES - DONT PRINT COMMAND
WHENSK <TXNN T1,CMNEWL>,
< MSGN <> >,
< MSG " " >
OUTCHR COMS(T4)
OUTCHR [" "]
XCT COMHLP(T4)
XHELP1: AOBJN T4, >
MSGN <
Pressing RETURN (alone or after most commands) prints title and text
for current section, together with a list of sub-sections. Typing ESCAPE
(or ALTMODE) does the same except that text for section is not printed.>
JRST SKIPEL ; IGNORE ANY OTHER COMMANDS ON LINE (IN
; CASE 'HELP' WAS TYPED)
XVER: PUSH SP,CH ; SAVE CH (CR OR ESC)
SETF VER
MOVEMM CNODE,CVER,T1
UNSETF PRTX ; SWITCH TEXT PRINTING MODE OFF
CAIN CH,CR
SETF PRTX ; CR READ - SWITCH ON TEXT PRINTING MODE
SETZ LEVEL,
MOVEI S3,CHAN
MOVEI S4,OPRBUF
PRSTR [CRLF]
UNSETF PRSEP
SETF PRPTH
PUSH SP,CNODE
CALL PRNODE
ADJSP SP,-1
MOVE T1,CNODE
GTDES T1,T1 ; GET DESCENDANT OF CURRENT NODE
UNLJMP <JUMPE T1,>,
< PRSTR [CRLF] ; HERE IF THERE ARE DESCENDANTS
PRSTR [CRLF]
PRSTR [ASCIZ/sub-sections:/]
CALL PRLIST ; PRINT IMMEDIATE DESCENDANTS
>,
< MOVE T1,CNODE ; HERE IF NO DESCENDANTS
CAME T1,CROOT ; ROOT NODE?
JRST XVER1 ; NO
SKPOFF MOD ; MODIFICATION MODE OFF?
JRST XVER1 ; NO
SKIPE CFILE ; HIGHEST LEVEL FILE?
JRST XVER1 ; NO
MSGN <(end of subject)>
JRST STOP
XVER1: >
POP SP,CH ; RESTORE CH (CR OR ESC)
JRST FINCOM
XNXTND: UNSETF FLAG
INCHWL CH
CAIN CH,"="
JRST [ MOVEMM CNODE,SBTNOD,T1 ; += COMMAND
MOVEMM CFILE,SBTFIL,T1
SETF SUPVER
MSGN <sub-tree defined>
JRST FINCOM ]
WHENSK <CAIE CH,GTSYM>,
< SETF FLAG
INCHWL CH >
MOVEMM SBTNOD,NODBAR,T1
MOVEMM SBTFIL,ICBAR,T1
SETZM LEVEL
MOVEIM 777777,MAXLEV,T1 ; SET MAXLEV TO HIGH VALUE SO
; THERE IS NO LIMIT. (WE CANNOT SET
; MAXLEV TO -1 BECAUSE WE MIGHT
; BE MOVING UP TREE, SO LEVEL
; MIGHT BECOME -1).
MOVE T1,CNODE
UNSETF GLOBP
SKPOFF FLAG
CALL NEXTRT
SKPON FLAG
CALL GLOBNX
JUMPE T2, [ MSGN <end of sequence>
JRST FINSV2 ]
MOVEM T2,CNODE
CALL SETLEV
JRST FINCM2
ERROR: MSGN <SYNTAX ERROR>
JRST SKIPEL
NOYANK: MSGN <NO YANKED NODE SET>
JRST SKIPEL
INVAL: MSGN <OH NO YOU DON'T!>
JRST SKIPEL
RESTOR: ; GET HERE BY JUMPING OUT OF PROC 'PUTCH' IF SOMETHING OTHER
; THAN A SPACE WAS TYPED IN RESPONSE TO A PAUSE MESSAGE.
MOVEM T1,CH
MOVE T1,CNODE ; GET CURRENT NODE
GTDES T2,T1
SKIPE T2 ; ANY DESCENDANTS?
JRST RESTO1 ; YES
CAME T1,CROOT ; ROOT NODE?
JRST RESTO1 ; NO
SKPOFF MOD ; MODIFICATION MODE OFF?
JRST RESTO1 ; NO
SKIPE CFILE ; HIGHEST LEVEL FILE?
JRST RESTO1 ; NO
JRST STOP ; STOP BECAUSE SINGLE NODE FILE AT TOP
; SUBJECT LEVEL NOT IN MODIFICATION MODE
RESTO1: MOVEMM SAVEFF,FFLEV,T1
MOVEMM SAVENB,NBL,T1
MOVEMM SAVEIN,INDNTC,T1
CALL OPNTTY
CAIE CH,CR ; WAS CR TYPED?
JRST FINCM2 ; NO - TREAT CH AS COMMAND
JRST FINCOM
FINSV: SETF SUPVER
JRST FINCOM
FINSV2: SETF SUPVER
JRST FINCM2
SKIPEL: CLRBFI ; CLEAR ANYTHING TYPED BY USER
FINCOM: INCHSL CH
JRST [ SKPOFF GUIDE ; HERE IF NO LINE TYPED
CALL PRGUIDE ; PRINT GUIDE MSG
MSGN <*> ; GIVE PROMPT
INCHWL CH
JRST FINCM2 ]
FINCM2: MOVE SP,SAVESP ; RESTORE STACK POINTER (IN CASE ERRORS
; CAUSED A JUMP OUT OF THE MYSTERIOUS DEPTHS
JRST >
ALTEND FULLUP, <MSGN <TREE ARRAY FULL> >
ALTEND TXTEXC, <MSGN <TEXT ARRAY EXCEEDED> ; SHOULDNT HAPPEN!
>
ALTEND TXTEOF, <MSGN <END-OF-FILE WHILE READING TEXT> >
ALTEND ERROPN, <MSGN <ERROR IN OPENING CHANNEL> >
ALTEND NASTEY, <MSGN <***PHI ERROR NUMBER >
CALL DECOUT
MSG " - PLEASE CONTACT SYSTEMS GROUP (ON 01-368-1299 x248)
AND TELL THEM THE ERROR NUMBER" >
ALTEND ERRF, <CALL FILERR>
STOP: SETZM CCTRAP+2 ; IN CASE WE TYPED SEVERAL CTRL/C'S
CLRBFI
IFN LOG,<
SKIPE IPCBLK ; LOGGING PROG RUNNING?
CALL IPCSN ; YES - SEND IPCF PACKET
>
EXIT
SUBTTL MISC PROCS
PROC INITXT
; ALLOCATES SPACE FOR BUFFERS THEN DEFINES TEXT ARRAY TO BE AFTER
; THIS. SETS NEXTTX AND LASTTX TO POINT TO START AND END OF TEXT ARRAY.
; SETS PRBUFA AND FLBUFA TO INDICATE WHERE BUFFERS TO START.
; .JBSA AND .JBFF ARE NOT ALTERED.
MOVEI T1, [ 0
SIXBIT/DSK/ ]
DEVSIZ T1,
JRST INITX9 ; ERROR
HRRZ T4,T1 ; BUFFER SIZE FOR DSK
MOVE T3,T4 ; WILL BE MAX OF BUFFER SIZES FOR DSK, TTY
; AND LPT
MOVEI T1, [ 0
SIXBIT/TTY/ ]
DEVSIZ T1,
JRST INITX9 ; ERROR
HRRZS T1 ; BUFFER SIZE FOR TTY
CAMLE T1,T3
MOVE T3,T1 ; UPDATE MAX
MOVEI T1, [ 0
SIXBIT/LPT/ ]
DEVSIZ T1,
JRST INITX9
HRRZS T1 ; BUFFER SIZE FOR LPT
CAMLE T1,T3
MOVE T3,T1 ; UPDATE MAX
IMULI T3,NPRBFS ; MULTIPLY BY NO. OF BUFFERS
IMULI T4,NFLBFS ; MULTIPLY BY NO. OF BUFFERS
HLRZ T1,.JBSA
MOVEM T1,PRBUFA
ADD T1,T3 ; ALLOW SPACE FOR PRINT BUFFERS
MOVEM T1,FLBUFA
ADD T1,T4 ; ALLOW SPACE FOR FILE BUFFERS
MOVE NEXTTX, [POINT 7,0]
HRR NEXTTX,T1 ; MAKE NEXTTX POINT TO START OF TEXT ARRAY
ADDI T1,TXTLEN-1 ; ALLOCATE INITIAL TEXT ARRAY LENGTH
MOVE T2,T1
HRLI T2,010700 ; SO IT POINTS TO LAST BYTE IN WORD
MOVEM T2,LASTTX ; MAKE LASTTX POINT TO END OF TEXT ARRAY
HRRZ T2,.JBREL
CAMG T1,T2
RETURN
CORE T1,
JRST [ MSGN <Unsuccessful attempt to get more core>
JRST STOP ]
RETURN
INITX9: MSGN <Failure of DEVSIZ UUO, please contact systems group>
JRST STOP
PROC EXTEND ; ARGS: IN: T1, IO: LASTTX
; EXTENDS TEXT ARRAY BY NO. OF WORDS IN T1.
HRRZ T2,LASTTX
ADD T1,T2
HRRM T1,LASTTX
HRRZ T2,.JBREL
CAMG T1,T2
RETURN
CORE T1,
JRST [ MSGN <UNSUCCESSFUL ATTEMPT TO GET MORE CORE>
JRST STOP ]
SKPOFF COREMS
CALL CORMSG
RETURN
PROC REDUCE ; ARGS: IN: LASTTX
; REDUCES CORE IF POSSIBLE
HRRZ T1,LASTTX
HRRZ T2,.JBREL
SUBI T2,1000 ; SUBTRACT ONE PAGE
CAMLE T1,T2
RETURN ; CAN'T REDUCE CORE
CORE T1,
JRST [ MSGN <?CORE UUO failed while reducing core>
JRST STOP ]
SKPOFF COREMS
CALL CORMSG
RETURN
PROC CORMSG
HRRZ T1,.JBREL
AOS T1
IDIVI T1,1000
MSGN <(core >
CALL DECOUT
MSG "P, last text address "
HRRZ T1,LASTTX
CALL OCTOUT
MSG ")"
RETURN
PROC OPNTTY ; OPENS TTY ON CHANNEL CHAN FOR PRINTING
; DOESNT USE ANY REGS
PUSH SP,T1
MOVEMM PRBUFA,.JBFF,T1 ; TELL MONITOR WHERE TO STICK ITS BUFFERS
POP SP,T1
OPEN CHAN,[0
SIXBIT/TTY/
OPRBUF,,0 ]
JRST [ MSGN<NASTY ERROR> ; SHOULDN'T HAPPEN!
EXIT ]
OUTBUF CHAN,1 ; TO REDUCE THE DISTANCE FROM THE END OF A
; PRINTING WITHIN WHICH CTRL/O CAUSES LOSS
; OF PROMPT.
; (N.B. NEVER CHANGE NO. OF BUFFERS TO BE
; GREATER THAN NPRBFS).
SETF TTYPR
RETURN
PROC PRFS ; ARGS:IN: DEVICE,SUBJECT,EXT,PPN,SFD1,SFD2
; PRINTS A FILE SPEC.
MOVE T1,DEVICE
CALL WR6BIT
MSG ":"
MOVE T1,SUBJECT
CALL WR6BIT
MSG "."
MOVE T1,EXT
CALL WR6BIT
WHENSK <SKIPGE PPN>,
< MSG "["
HLRZ T1,PPN ; PROJECT NUMBER
SKIPE T1
CALL OCTOUT
MSG ","
HRRZ T1,PPN ; PROGRAMMER NUMBER
SKIPE T1
CALL OCTOUT
MSG ","
MOVE T1,SFD1
SKIPE T1
CALL WR6BIT
MSG ","
MOVE T1,SFD2
SKIPE T1
CALL WR6BIT
MSG "]" >
RETURN
PROC SKPBCL ; ARGS: IO: CH
; SKIPS BLANKS/CR/LF/TABS
DO
< CAIN CH," "
JRST L1
CAIN CH,TAB
JRST L1
CAIN CH,LF ; LF
JRST L1
CAIE CH,CR ; CR
RETURN
L1: INCHWL CH
JRST >
PROC GETFS ; GETS A FILE-SPEC, I.E. DEVICE,SUBJECT ETC, FROM
; THE ARRAYS DEV,SUBJ, ETC.
MOVE T1,CFILE
MOVEMM DEV(T1),DEVICE,T2
MOVEMM SUBJ(T1),SUBJEC,T2
MOVEMM EXTA(T1),EXT,T2
MOVEMM PPNA(T1),PPN,T2
MOVEMM SFD1A(T1),SFD1,T2
MOVEMM SFD2A(T1),SFD2,T2
RETURN
PROC STORFS ; STORES A FILE SPEC, I.E. DEVICE,SUBJECT ETC,
; IN ARRAYS DEV,SUBJ, ETC.
MOVE T1,CFILE
MOVEMM DEVICE,DEV(T1),T2
MOVEMM SUBJEC,SUBJ(T1),T2
MOVEMM EXT,EXTA(T1),T2
MOVEMM PPN,PPNA(T1),T2
MOVEMM SFD1,SFD1A(T1),T2
MOVEMM SFD2,SFD2A(T1),T2
RETURN
PROC INDFS ; ARGS: IN: S1; OUT: DEVICE,SUBJEC,EXT,PPN,SFD1,SFD2,PVIRT
; (S1 IS NOT ALTERED)
; TESTS THE NODE WHOSE REL. ADR. IS IN S1, TO SEE IF IT
; IS AN INDIRECT FILE SPEC, AND IF SO IT SETS DEVICE ETC.
; IF NOT, OR IF ERRORS, SETS SUBJEC TO 0.
; IF 'MOD' IS ON, JUST RETURNS IMMEDIATELY WITH SUBJEC=0
SETZM SUBJEC
SKPOFF MOD
RETURN ; NO MORE CHECKING IF MODIFICATION MODE
PUSH SP,S2 ; SAVE S2
PUSH SP,CH ; SAVE CH
GTTEXT S2,S1 ; GET BYTE POINTER FOR TEXT FOR NODE
DO
< ILDB CH,S2
CAIN CH,STRTM
JRST INDFSR ; IF STRTM CHAR
CAIE CH,STRDIV ; SKIP OUT OF LOOP IF STRDIV CHAR
JRST >
ILDB CH,S2
CAIE CH,CR
JRST INDFSR ; IF NOT CR
ILDB CH,S2
CAIE CH,LF
JRST INDFSR ; IF NOT LF
ILDB CH,S2
CAIE CH,"@"
JRST INDFSR ; NO INDIRECT FILE SPEC
ILDB CH,S2
SETF EXTALL ; FILE EXTENSION ALLOWED
PUSH SP, [[ ILDB CH,S2
RETURN ]]
CALL RDSUBG
ADJSP SP,-1
SKIPN T1
SKIPN SUBJECT
JRST [ MSGN <***Error in indirect file specification>
JRST INDFSE ]
CAMN S1,CROOT
JRST [ MSGN <***Indirect file spec not allowed for top level section>
JRST INDFSE ]
GTDES T1,S1
SKIPE T1
JRST [ MSGN <***Indirect file spec not allowed for
section with descendants>
JRST INDFSE ]
SETZM PVIRT ; DEFAULT VALUE
WHENSK <CAIE CH,"/">,
< ILDB CH,S2
UPCASE CH
CAIE CH,"P"
JRST [ MSGN <***unrecognised switch after indirect file-spec>
JRST INDFSE ]
ILDB CH,S2
PUSH SP, [[ILDB CH,S2
RETURN ]]
CALL DECIG ; GET VALUE
ADJSP SP,-1
MOVEM T1,PVIRT >
CAIE CH,STRTM
JRST [ MSGN <***Extra stuff after indirect file specification>
JRST INDFSE ]
JRST INDFSR
INDFSE: SETZM SUBJEC ; HERE IF ERRORS
INDFSR: POP SP,CH ; RESTORE CH
POP SP,S2 ; RESTORE S2
RETURN
PROC SETLEV ; SETS CLEVEL TO LEVEL OF CNODE
MOVE T1,CNODE
SETZ T2,
DO
< GTANC T1,T1
SKIPE T1
AOJA T2, >
MOVEM T2,CLEVEL
RETURN
PROC SWITCH ; CALLED AFTER THE "/" HAS BEEN READ, TO INTERPRET A
; SWITCH OR VALUE SETTING COMMAND.
; CALL SWITCH
; RETURN 1 (NEXT CHAR NOT YET READ)
; RETURN 2 (NEXT CHAR IS IN CH)
; RETURN 3 (UNRECOGNISED SWITCH)
INCHWL CH
UPCASE CH
WHENSK <CAIN CH,CR>,
< IPCCHX CH >
; ... SEND CH TO LOGGING PROG IF RUNNING AND IF CH IS NOT CR
MOVE T2, [SWCOMS-ENDSWC,,0] ; SET UP COUNTER-MODIFIER
DO
< CAMN CH,SWCOMS(T2)
JRST [ MOVE T1,SWTYP(T2) ; GET FLAG WORD
TXNN T1,SWCHNG ; SWITCH FLIPPING COMMAND?
JRST @SWADR(T2) ; NO
TDC F,SWADR(T2) ; YES - FLIP THE SWITCH
JRST SWRET1 ]
AOBJN T2, >
MSGN <unrecognised switch or value setting command - />
OUTCHR CH
JRST SWRET3
XSEP: INCHWL CH
CALL DECIN
JUMPE T2, [ MSGN <separation values are >
MOVE T1,FFLEV
CALL DECOUT
MSG "."
MOVE T1,NBL
CALL DECOUT
JRST SWRET2 ]
MOVEM T1,FFLEV
INCHWL CH
CALL DECIN
MOVEM T1,NBL
JRST SWRET2
XINDNT: INCHWL CH
CALL DECIN
JUMPE T2, [ MSGN <indentation value is >
MOVE T1,INDNTC
CALL DECOUT
JRST SWRET2 ]
MOVEM T1,INDNTC
JRST SWRET2
XPAGE: INCHWL CH
UPCASE CH
CAIN CH,"L"
JRST XPAGEL ; /PL COMMAND
CAIN CH,"T"
INCHWL CH ; IGNORE "T" IN /PT
CALL DECIN
JUMPE T2, [ MSGN <TTY page size is >
MOVE T1,TTYPAG
CALL DECOUT
JRST SWRET2 ]
MOVEM T1,TTYPAG
JRST SWRET2
XPAGEL: INCHWL CH
CALL DECIN
JUMPE T2, [ MSGN <LPT page size is >
MOVE T1,LPTPAG
CALL DECOUT
JRST SWRET2 ]
MOVEM T1,LPTPAG
JRST SWRET2
XMODON: SETF MOD
MSGN <modification mode on>
JRST SWRET1
XSWHLP: MSGN <List of switch changing and value setting commands:>
MOVE T4, [SWCOMS-ENDSWC,,0] ; COUNTER-MODIFIER
DO
< MOVE T1,SWTYP(T4) ; GET FLAGS
WHENSK <TXNN T1,CMNEWL>,
< MSGN <> >,
< MSG " " >
OUTCHR ["/"]
OUTCHR SWCOMS(T4)
XCT SWHLP(T4)
AOBJN T4, >
JRST SWRET1
SWRET3: AOS 0(SP)
SWRET2: AOS 0(SP)
SWRET1: RETURN
PROC WHDES ; ARGS: IN: T1 IO:T2 OUT: T3
; FINDS REL. ADR. T3, OF A NODE WHOSE ANCESTOR IS T1,
; ACCORDING TO THE FOLLOWING RULES:
; IF T2 IS 0, SETS T3 TO 0 AND LEAVES T2
; IF T2 IS NEG SETS T3 TO LAST IMM. DES. OF T1 (OR 0
; IF NO IMM. DESCS.) AND T2 TO NO. OF DESCS.
; IF T2 IS POS SETS T3 TO T2'TH IMM. DES. OF T1 , AND
; LEAVES T2 (OR IF NOT FOUND, SETS T3 TO -1 AND T2
; TO NO. OF DESCS).
SETZ T3,
SKIPN T2
RETURN
GTDES T3,T1
MOVE T1,T2 ; NOW USE T1 TO STORE INITIAL VALUE OF T2
SETZ T2,
JUMPE T3,WHDES1 ; NO DESCENDANTS
DO
< AOS T2 ; INCREMENT DESC. NO.
CAMN T2,T1 ; IS THIS THE ONE REQD?
JRST WHDES1 ; YES
GTNEXT T4,T3 ; NO - TRY THE NEXT
JUMPE T4,WHDES1 ; END OF THE LINE - JUMP OUT
MOVE T3,T4
JRST >
WHDES1: CAME T2,T1
SKIPG T1
RETURN ; IF DESC FOUND, OR -1 WAS SPECIFIED
MOVNI T3,1 ; NOT FOUND
RETURN
PROC PRGUID ; PRINTS GUIDE MESSAGE FOR CURRENT NODE UNLESS SUPPRESSED
SKPOFF SUPGUI
RETURN
MSGN <>
MSGN < - type >
MOVE T1,CNODE
WHENSK <SKPON VER>,
< GTDES T2,T1 ; HERE IF JUST DONE A VERIFICATION COMMAND
SKIPE T2 ; SKIP IF NO DESCENDANTS
MSG "a number or " >
CAME T1,CROOT ; ROOT NODE?
MSG "O(to top of subject) or " ; NO
MSG "E(Exit) or ?(further options)"
RETURN
SUBTTL TREE MANIPULATION PROCEDURES
PROC CRTNOD ; ARGS: OUT:T1 IO:NEXLOC
; CREATES A NODE.
; T1 IS SET TO CONTAIN REL. ADR. OF NODE CREATED.
WHENSK <CAILE NEXLOC,ENDTRE-TREE+1-NODLEN>,
< MOVE T1,NEXLOC ; ALLOCATE SPACE AT NEXT AVAILABLE LOCN.
ADDI NEXLOC,NODLEN >,
< SKIPN FRELST ; TRY TO GET SPACE FROM FREE LIST
JRST FULLUP
MOVE T1,FRELST
GTNEXT T4,T1
MOVEM T4,FRELST >
CLNODE T1
RETURN
PROC INSLST ; ARGS: IN: T1/N, T2/A, T3/P
; INSERTS THE LIST WHOSE FIRST NODE IS IN 'N', AS
; DESCENDANT OF 'A', AFTER NODE 'P'.
; (IF P IS 0, INSERTION AT START).
; LEAVES DESCENDANT FIELDS OF NODES IN LIST UNCHANGED.
N=T1
A=T2
P=T3
X=T4
STPREV P,N ; LINK N TO P
; NOW SET X TO SUCCESSOR NODE, AND LINK A OR P TO N.
UNLJMP <JUMPE P,>,
< GTNEXT X,P
STNEXT N,P >,
< GTDES X,A
STDES N,A >
; NOW TRACE ALONG TO END OF LIST, RESETTING N TO LAST
; NODE IN LIST. SET ANC FIELDS. USE P AS WORK REG.
UNTILJ
< STANC A,N
GTNEXT P,N
JUMPE P, >,
< MOVE N,P
JRST >
; LINK END OF LIST TO TREE
STNEXT X,N ; LINK N TO X
SKIPE X
STPREV N,X ; IF X EXISTS, LINK IT TO N
RETURN
PROC REMNOD ; ARGS: IN: T1/N
; REMOVES NODE 'N' FROM TREE. THE PREV & NEXT
; FIELDS OF 'N' ARE SET TO 0, BUT THE DES FIELD
; IS LEFT UNCHANGED.
N=T1
NEXT=T2
PREV=T3
GTNEXT NEXT,N
GTPREV PREV,N
SETZ T4,
STPREV T4,N
STNEXT T4,N
UNLJMP <JUMPE PREV,>,
< STNEXT NEXT,PREV >,
< GTANC T4,N
STDES NEXT,T4 >
SKIPE NEXT
STPREV PREV,NEXT
RETURN
PROC FRETRE ; ARGS: IN: S1/ADDRESS OF FIRST NODE
NEXT=S3
DES=S4
UNTILJ
< GTNEXT NEXT,S1
GTDES DES,S1
MOVE T1,S1
CALL FRENOD
UNLJMP <JUMPE DES,>,
< PUSH SP,NEXT
MOVE S1,DES
CALL FRETRE
POP SP,NEXT >
JUMPE NEXT,>,
< MOVE S1,NEXT
JRST >
RETURN
PROC FRENOD ; ADDS NODE TO FREE LIST.
; REL. ADR. OF NODE IS IN T1.
MOVE T2,FRELST
STNEXT T2,T1
MOVEM T1,FRELST
RETURN
PROC DELNOD ; ARGS: IN: S1/N WORK: S-REGS.
; DELETES & FREES NODE 'N', MOVING ITS DESCENDANTS
; UP TO WHERE IT WAS.
N=S1
A=S2
P=S3
D=S4
GTANC A,N
GTPREV P,N
GTDES D,N
MOVE T1,N
CALL REMNOD ; REMOVE NODE 'N' FROM TREE
MOVE T1,N
CALL FRENOD ; FREE NODE 'N'
UNLJMP <JUMPE D,>,
< MOVE T1,D
MOVE T2,A
MOVE T3,P
CALL INSLST ; INSERT THE LIST OF DESCENDANTS INTO TREE
>
RETURN
SUBTTL PROCS FOR READING SUBJECT FILE SPECS
PROC RDSUBG ; ARGS: IO: CH, OUT: T1,DEVICE,SUBJECT,PPN,SFD1,SFD2
; REQUIRES ADR OF A RTN TO GET A CHAR INTO CH, ON
; TOP OF STACK.
; READS A SUBJECT SPECIFICATION. (STARTS WITH CHAR IN CH)
; SUBJECT NAME MAY OPTIONALLY BE PRECEEDED BY DEVICE:
; AND MAY OPTIONALLY BE FOLLOWED BY [PPN/PATH].
; IF THE FLAG 'EXTALL' IS SET, THEN A FILE-EXTENSION
; IS ALLOWED.
; T1 IS SET TO NON-ZERO IF SYNTAX ERROR.
; (IF NO SUBJECT IS SPECIFIED, SUBJECT RETURNED AS 0)
EXCH WORK,-1(SP)
MOVEMM [SIXBIT/DSK/],DEVICE,T1
SETZM SUBJECT
MOVEMM [SIXBIT/PHI/],EXT,T1
PUSH SP,WORK
CALL RD6NAG ; READ A NAME
ADJSP SP,-1
SKIPN T1
JRST RDSRET ; IF SUBJECT NAME BLANK
WHENSK<CAIE CH,":">,
< MOVEM T1,DEVICE
CALL (WORK)
PUSH SP,WORK
CALL RD6NAG
ADJSP SP,-1
JUMPE T1, [ SETO T1, ; SYNTAX ERROR
JRST RDSRET ]
>
MOVEM T1,SUBJECT
UNLJMP
< SKPOFF EXTALL
CAIE CH,"."
JRST >,
< CALL (WORK) ; HERE IF EXTALL SET AND A DOT READ
PUSH SP,WORK
CALL RD6NAG
ADJSP SP,-1
JUMPE T1, [ SETO T1, ; SYNTAX ERROR
JRST RDSRET ]
MOVEM T1,EXT >
PUSH SP,WORK
CALL RDPATG
ADJSP SP,-1
RDSRET: EXCH WORK,-1(SP)
RETURN
SUBTTL PROCS FOR READING INPUT FILE
PROC FNDFIL ; ARGS: IN: SUBJEC,PPN,SFD1,SFD2, IO: DEVICE,EXT
; FINDS FILE SPECIFIED (SUBJECT TO RULES ABOUT LOOKING
; ON DOC IF NOT ON OWN AREA ETC.) AND OPENS IT ON
; CHANNEL 1.
; IF FILE NOT FOUND OR OTHER ERRORS, SETS T1 TO ERROR
; CODE (0 MEANS NOT FOUND, OTHERWISE GT 0), OTHERWISE
; SETS T1 TO -1.
SETZM YNKNOD
UNSETF NEWSUB
SETZM PROT
CALL OPNPHI ; OPEN AND LOOKUP THE .PHI FILE
JUMPL T1,FILFND ; .PHI FILE FOUND
JUMPN T1,FNDERR ; ERROR OTHER THAN 'FILE NOT FOUND'
SKPOFF MOD ; SKIP IF NOT MODIFICATION MODE
JRST [ MSGN <Subject not found, assumed new.
You are now at the top level section.
Use M command to define text for it, or X command to add a sub-section.
Remember that nothing will be written to disk until you use a W command
>
CALL CRTNOD ; CREATE ROOT NODE, T1 WILL BE SET TO REL. ADR.
MOVEM T1,CROOT
STTEXT NEXTTX,T1 ; ..SET ITS TEXT POINTER,
MOVEI T2,STRTM ; ..AND SET UP EMPTY TEXT STRING
IDPB T2,NEXTTX ; FOR IT.
UNSETF GUIDE
SETOM T1
SETF NEWSUB
RETURN ]
MOVE T2,DEVICE
CAME T2,[SIXBIT/DSK/]
JRST FNDERR ; A SPECIFIC DEVICE WAS SPECIFIED
SKIPL PPN
JRST FNDERR ; PATH WAS SPECIFIED
MOVE T2,EXT
CAME T2,[SIXBIT/PHI/]
JRST FNDERR ; EXTENSION WAS SPECIFIED
; NOW TRY DOC: AREA
SETZM PROT
MOVEMM [SIXBIT/DOC/],DEVICE,T1
CALL OPNPHI
JUMPL T1,FILFND
JUMPN T1,FNDERR ; ERROR OTHER THAN 'FILE NOT FOUND'
; NOW TRY FOR HLP:SUBJECT.HLP
SETZM PROT
MOVEMM [SIXBIT/HLP/],DEVICE,T1
MOVEMM [SIXBIT/HLP/],EXT,T1
CALL OPNPHI
JUMPGE T1,FNDERR
FILFND: SETOM T1
RETURN
FNDERR: RELEASE CHANPH,
RETURN
PROC READIN ; READS .PHI FILE. TREE STARTS AT NEXLOC, TEXT AT NEXTTX.
; ARGS: IN: SUBJEC,PPN,SFD1,SFD2,DEVICE,EXT
; IF EXT IS NOT 'PHI', TREATS FILE AS A SINGLE
; NODE FILE WHOSE TITLE (AND STRDIV CHAR) IS ALREADY
; IN TEXT ARRAY JUST BEFORE NEXTTX POSN. (IF THERE IS NO TITLE
; THEN THE EFFECT WILL BE TO TREAT THE WHOLE TEXT READ IN
; AS TITLE).
; CFILE IS ASSUMED CORRECT FOR LEVEL OF FILE WE ARE
; READING IN.
; CROOT IS SET TO ROOT NODE
PUSH SP,CH ; SAVE LAST CHAR READ FROM TTY
MOVE T1,DEVICE
WHENSK <CAME T1,[SIXBIT/DSK/]>,
< MOVEI T1,1 ; CHANNEL NUMBER
MOVEM T1,ARGBLK
MOVE T1,[5,,ARGBLK]
DSKCHR T1, ; TO FIND OUT DEVICE NAME
SKIPA T1,[SIXBIT/DSK/] ; ERROR RETURN
MOVE T1,ARGBLK+4
MOVEM T1,DEVICE >
MSGN <(reading >
CALL PRFS
MSG ")"
IFN LOG,<
WHENSK <SKIPN IPCBLK>,
< CALL IPCTX
ASCIZ / (Reading /
PUSH SP, [[ PUSH SP,T3
CALL IPCCH
ADJSP SP,-1
RETURN ]]
MOVE T1,SUBJEC
CALL WR6BIG ; PUTS SUBJECT NAME INTO MSG BLOCK
ADJSP SP,-1
CALL IPCTX
ASCIZ /) / >
> ; END IFN LOG
MSGN <>
MOVEI S1,1 ; CHANNEL NO. FOR .PHI FILE
MOVEI S2,ITXBUF ; ...AND BCB ADDRESS
MOVE T1,SIZE ; GET NO. OF TEXT WORDS REQD.
AOS T1
HRRZ T2,LASTTX
HRRZ T3,NEXTTX
SUB T2,T3
SUB T1,T2 ; EXTRA NO. OF TEXT ARRAY WORDS REQD.
AOS T1 ; JUST TO BE SAFE!
SKIPLE T1
CALL EXTEND
MOVE T1,EXT
WHENSK <CAMN T1,[SIXBIT/PHI/]>,
< CALL RDNPHI >,
< CALL GETCH ; READ FIRST CHAR FROM .PHI FILE
SKPOFF EOF
JRST TXTEOF
CALL DECIP ; READ (AND IGNORE) FIRST NUMBER
SKPOFF EOF
JRST TXTEOF
CALL RDPHI >
RELEASE CHANPH,
POP SP,CH ; RESTORE LAST CHAR READ FROM TTY
RETURN
PROC RDPHI ; READS .PHI FILE FROM DISK
; ASSUMES FIRST VALUE HAS ALREADY BEEN READD.
; SETS CROOT TO ROOT NODE
SETZM LPATH
CALL CRTNOD ; CREATE ROOT NODE; RETURNS T1 AS REL. ADR.
; (WILL BE = NEXLOC)
MOVEM T1,CROOT
STTEXT NEXTTX,T1 ; STORE POINTER TO TEXT STRING IN ROOT NODE
CALL RDTX ; READ TEXT FOR ROOT NODE
; NOW READ IN THE REST OF THE TREE
DO
< ; FIRST SKIP OVER ANY CHARS WHICH ARE NULL OR ^A - ^Z
DO
< CALL GETCH
SKPOFF EOF
RETURN ; END OF FILE
CAIG CH,32 ; SKIP OUT IF NOT NULL OR ^A - ^Z
JRST >
CALL DECIP ; READ LEVEL NO.
SKPOFF EOF
JRST TXTEOF
MOVE T2,LPATH
AOS T2 ; T2 IS NOW LPATH+1
SKIPLE T1 ; LEVEL LE 0?
CAMLE T1,T2 ; ...OR GT LPATH+1?
JRST [ MSGN <?***INVALID LEVEL NUMBER ON INPUT FILE: > ; YES
CALL DECOUT
MSGN < - REMAINDER OF INPUT FILE IGNORED>
RETURN ]
MOVE S3,T1 ; STORE LEVEL NO.
CALL CRTNOD ; CREATES A NEW NODE AND SETS T1 TO
; ITS REL. ADR.
MOVE T2,CROOT ; SET ANC TO ROOT NODE
CAIE S3,1 ; LEVEL 1?
MOVE T2,PATH-2(S3) ; NO - RESET ANC
SETZ T3, ; SET PREV TO 0
CAMG S3,LPATH ; LEVEL EQ LPATH+1?
MOVE T3,PATH-1(S3) ; NO - REST PREV
MOVE S4,T1 ; STORE NODE ADR.
CALL INSLST ; INSERT NODE INTO TREE
MOVEM S3,LPATH
MOVEM S4,PATH-1(S3) ; PUT ADR. OF NEW NODE INTO PATH VECTOR
STTEXT NEXTTX,S4 ; SET TEXT POINTER FOR NODE
CALL RDTX ; READ TEXT
JRST >
PROC RDTX ; USED BY RDPHI TO READ A TEXT STRING
DO
< CALL GETCH
SKPOFF EOF
JRST TXTEOF
CAMN NEXTTX,LASTTX
JRST TXTEXC
IDPB CH,NEXTTX
CAIE CH,STRTM ; SKIP OUT OF LOOP IF TERMINATOR CHAR.
JRST >
RETURN
PROC OPNPHI ; OPENS INPUT FILE ON CHANNEL 1
MOVEMM FLBUFA,.JBFF,T1 ; TELL MONITOR WHERE TO STICK ITS BUFFERS
DEFFL2 CHANPH,0,DEVICE,0,ITXBUF,SUBJECT,EXT,PROT,
ARGBLK,PPN,SFD1,SFD2,FLPATH,NFLBFS
; NOW GET SIZE OF FILE IN WORDS
HLRE T2,ARGBLK+3
UNLJMP <JUMPGE T2,>,
< MOVN T2,T2 >,
< IMULI T2,200 >
MOVEM T2,SIZE
RETURN
PROC RDNPHI ; READS A NON-PHI FILE.
; SETS CROOT TO ROOT NODE.
CALL CRTNOD ; CREATE ROOT NODE. T1 RETURNED AS REL. ADR.
MOVEM T1,CROOT
MOVE T2,CFILE
MOVE T3,ROOTIT(T2) ; GET BYTE POINTER TO START OF TITLE
STTEXT T3,T1 ; ...AND STORE IT IN ROOT NODE
WHLSKP
< CALL GETCH
SKPOFF EOF >,
< CAMN NEXTTX,LASTTX
JRST TXTEXC ; SHOULDNT HAPPEN
IDPB CH,NEXTTX
JRST >
MOVEI CH,STRTM
IDPB CH,NEXTTX
RETURN
PROC FILERR ; PRINTS ERROR MESSAGE FOR FILE ERROR
; ERROR NUMBER ASSUMED IN ARGBLK+1
MSGN <File error >
HRRZ T1,ARGBLK+1
CALL OCTOUT
SKIPN T1
MSG " (file not found)"
CAIN T1,1
MSG" (ufd not found - maybe required disk needs to be specified)"
CAIN T1,2
MSG " (protection failure)"
CAIN T1,14
MSG " (disk quota exceeded)"
CAIN T1,23
MSG " (sub-file directory not found)"
RETURN
SUBTTL PROCS FOR PRINTING NODES, TREES ETC.
PROC PRNODE ; ARGS: IN: STACK(ADR), LEVEL (IF PRSEP IS ON)
; WORK: S-REGS, PRNF1,PRNF2 (FLAGS), CH
; PRINTS A NODE ACCORDING TO PRINTING MODE SPECIFIED BY
; THE FLAGS PRTX,PRPTH,PRSEP,UNDERL,SUPUND
; IF PRSEP IS ON, THE VALUES IN LEVEL, FFLEV, NBL AND INDNTC
; ARE ALSO USED.
MOVE S1,-1(SP) ; GET REL. ADR. OF NODE FROM STACK
MOVEI S3,CHAN ; CHANNEL NO.
MOVEI S4,OPRBUF ; BCB ADDRESS
MOVEIM 1,ICOL,T1
WHENSK <SKPON PRSEP>,
< MOVE S2,LEVEL ; HERE IF NODE SEPARATION REQD.
SUB S2,FFLEV
SUBI S2,1
PRSTR [CRLF]
UNLJMP <JUMPGE S2,>,
< WHENSK <CAMG LEVEL,LEVNT>,
< ; LAST NODE WAS HIGHER LEVEL WITH NO TEXT, SO DO
; NBL+1 CRLF'S INSTEAD OF FORMFEED
AOS S2,NBL
DO
< PRSTR [CRLF]
SOJG S2, > >,
< PRCHR FORMFD > >,
< SUB S2,NBL ; MAKE S2 -(NO. OF CRLF'S REQD),
UNTILJ <JUMPGE S2, >,
< PRSTR [CRLF]
AOJA S2, > >
MOVEIM 1,ICOL,T1
CALL INDENT ; INDENT ACCORDING TO LEVEL
>
WHENSK <SKPON PRPTH>,
< PUSH SP,S1 ; SAVE NODE ADR
MOVE T1,S1
CALL SETPTH
CALL PRPATH ; PRINT PATH VECTOR
POP SP,S1 ; RESTORE NODE ADR
>
GTTEXT S2,S1 ; GET BYTE PTR. FOR TEXT STRING
UNSETF PRNF1 ; FLAG TO INDICATE IF A STRDIV CHAR HAS BEEN READ
UNSETF PRNF2 ; FLAG TO INDICATE IF A CR HAS BEEN READ LAST
MOVEM LEVEL,LEVNT ; ASSUME FOR THE MOMENT NO TEXT
MOVEMM ICOL,TEMP2,T1 ; STORE COL. NO. OF START OF TITLE
DO
< ILDB CH,S2
CAIN CH,STRTM
JRST OUT1 ; STRING TERMINATOR ENCOUNTERED
WHENSK <CAIE CH,STRDIV>,
< WHENSK <SKPOFF PRNF1>,
< SKPOFF UNDERL ; HERE IF FIRST STRDIV CHAR
SKPOFF SUPUND
SKIPA
CALL UNDLNE ; UNDERLINE TITLE IF UNDERL
; AND NOT SUPUND.
SETF PRNF1
SKPON PRTX
JRST OUT1 ; JUMP OUT IF TEXT PRINTING OFF
PRSTR [CRLF] >,
< CALL PUTCH > >,
< WHENSK <CAIE CH," ">,
< WHENSK <SKPON TTYPR>,
< MOVE T1,ICOL
WHENSK <CAIG T1,^D73>,
< PRCHR CR ; HERE IF BLANK CHAR AFTER COL
; 73 WHILE OUTPUTING TO TTY.
MOVEI CH,LF >>>
CALL PUTCH
MOVEI T1,777777
SKPOFF PRNF1 ; HAS A STRDIV BEEN READ?
MOVEM T1,LEVNT ; YES - SO THIS NODE HAS TEXT, SET
; LEVNT TO LARGE VALUE.
UNLJMP < CAIN CH,LF
SKPON PRNF2
JRST >,
< CALL INDENT ; HERE IF LF DIRECTLY AFTER CR
> >
UNSETF PRNF2
CAIN CH,CR
SETF PRNF2 ; SET PRNF2 IF CR
JRST >
OUT1: WHENSK <SKPOFF PRNF1>,
< SKPOFF UNDERL ; HERE IF END OF STRING BUT NO STRDIV
; CHARACTER ENCOUNTERED.
SKPOFF SUPUND
SKIPA
CALL UNDLNE ; UNDERLINE TITLE IF UNDERL AND NOT
; SUPUND.
>
OUT CHAN,
RETURN ; O.K.
JRST [MSGN <ERROR IN OUT MONITOR CALL>
EXIT ]
PROC INDENT ; ARGS: IN: LEVEL, S3 AND S4 (FOR PUTCH),
; CH IS ONLY ARG USED AS WORK
SKIPG INDNTC
RETURN
UNLJMP <JUMPLE LEVEL,>,
< PUSH SP,LEVEL
IMUL LEVEL,INDNTC
MOVEI CH," "
DO
< CALL PUTCH ; OUTPUT A BLANK
SOJG LEVEL, >
POP SP,LEVEL >
RETURN
PROC SPACES ; ARGS: IN: T1, S3 AND S4 (FOR PUTCH), WORK: CH
; OUTPUTS SPACES, NUMBER OF SPACES IS IN T1.
MOVEI CH," "
DO
< PUSH SP,T1 ; SAVE T1
CALL PUTCH
POP SP,T1 ; RESTORE T1
SOJG T1, >
RETURN
PROC SPCS ; ARGS: IN: T1 (T2 - T4 LEFT UNCHANGED)
; PRINTS SPACES ON TTY, NUMBER OF SPACES IS IN T1
UNTILJ <JUMPLE T1,>,
< OUTCHR [" "]
SOJA T1, >
RETURN
PROC UNDLNE ; UNDERLINES TITLE
PUSH SP,CH ; SAVE CH
MOVEMM ICOL,TEMP3,T1 ; STORE COL. NO. OF END OF TITLE
PRSTR [CRLF]
MOVE T1,TEMP2 ; COL. NO. OF START OF TITLE
SOS T1
SKIPLE T1
CALL SPACES
MOVE T1,TEMP3
SUB T1,TEMP2 ; SET T1 TO NO. OF CHARS IN TITLE
UNTILJ <SOJL T1, >,
< PUSH SP,T1 ; SAVE T1
PRCHR "-"
POP SP,T1 ; RESTORE T1
JRST >
POP SP,CH ; RESTORE CH
RETURN
PROC SETPTH ; ARGS: IN: T1 OUT: PATH,LPATH
; SETS PATH VECTOR OF NODE WHOSE REL. ADR. IS IN T1
SETZM LPATH
CAMN T1,CROOT
RETURN ; RETURN IF ROOT NODE
GTANC T2,T1 ; GET ANCESTOR NODE INTO T2
; FIND ORDINAL NUMBER OF NODE AND STORE IN T3
MOVEI T3,1
UNTILJ
< GTPREV T1,T1
JUMPE T1, >,
< AOJA T3, >
; ORDINAL NUMBER OF NODE NOW IN T3
WHENSK <CAMN T2,CROOT>,
< PUSH SP,T3 ; HERE IF ANCESTOR NOT ROOT NODE. SAVE T3
MOVE T1,T2
CALL SETPTH ; SET PATH VECTOR FOR ANCESTOR NODE
POP SP,T3 ; RESTORE T3
>
AOS LPATH
MOVE T2,LPATH
CAILE T2,ENDPTH-PATH
JRST [ MSGN <Warning - too many levels for numbering of nodes>
RETURN ]
MOVEM T3,PATH-1(T2)
RETURN
PROC PRPATH ; PRINTS PATH IN PATH
; ARGS: IN: S3,S4 (FOR PUTCH), WORK: S1,CH
SKIPG LPATH
RETURN
MOVEI S1,1
WHLSKP <CAMLE S1,LPATH>,
< MOVEI CH,"."
CAIE S1,1
CALL PUTCH ; PRINT DOT IF NOT FIRST NUMBER
MOVE T1,PATH-1(S1) ; GET NUMBER
CALL DECOUP ; PRINT IT
AOJA S1, >
MOVEI CH," "
CALL PUTCH ; PRINT A BLANK
RETURN
PROC PRLIST ; PRINTS IMMEDIATE DESCENDANTS OF CURRENT NODE, WITH
; ORDINAL NUMBERS. WORK: S-REGS.
PUSH SP,F ; SAVE FLAGS
UNSETF PRPTH ; SWITCH OFF PATH VECTOR PRINTING
UNSETF PRTX ; SWITCH OFF TEXT PRINTING
UNSETF PRSEP ; SWITCH OFF SEPARATION
MOVE S1,CNODE
GTDES S1,S1
MOVEI S2,1
MOVEI S3,CHAN
MOVEI S4,OPRBUF
UNTILJ <JUMPE S1,>,
< PRSTR [CRLF] ; WE USE PRSTR SO THAT LINES WILL BE COUNTED
; IN 'PUTCH' (FOR PAUSE FACILITY)
MOVE T1,S2
CALL DECOUP
PRCHR " "
CAIG S2,^D9 ; DESCENDANT NUMBER GREATER THAN 9?
PRCHR " " ; NO - PRINT EXTRA SPACE
PUSH SP,S2 ; SAVE S2
PUSH SP,S1 ; REL. ADR. OF NODE TO BE PRINTED
CALL PRNODE ; (NO NEED TO SAVE S3 AND S4 BECAUSE
; PRNODE SETS THEM TO SAME VALUES AS
; THEY HAVE HERE)
POP SP,S1
POP SP,S2 ; RESTORE S2
GTNEXT S1,S1
AOJA S2, >
POP SP,F ; RESTORE FLAGS
RETURN
PROC PRMAP ; PRINTS A "MAP" OF WHERE WE ARE IN TREE
; (FOR USE BY "?" COMMAND)
; WORK: S REGS, CH
MOVE T1,CNODE
SKIPN CFILE ; IN TOP LEVEL FILE...
CAME T1,CROOT ; ...AND AT ROOT NODE?
SKIPA ; NO
JRST [ MSGN <At top of tree> ; YES
JRST PRMAPG ]
MSGN <Titles of sections to show where you are now:>
WHENSK <SKIPN CFILE>,
< SETZ S1, ; SUBJECT LEVEL COUNT
MOVE S2,CFILE ; NO. OF "J"'S TO PRINT
WHLSKP <CAML S1,CFILE>,
< UNLJMP <JUMPG S1, >,
< MSGN <R > >,
< MOVEI T1,"J"
MOVE T2,S2
MOVEI T3,5
CALL PRLETS >
MOVE T1,ROOTIT(S1) ; BYTE PTR TO START OF TITLE
CALL PRTIT ; PRINT TITLE
SOS S2
AOJA S1, >
IFN APPEND,<
MOVE T1,CNODE
CAME T1,CROOT ; AT ROOT NODE?
JRST PRMAP1 ; NO
MOVE T2,CFILE
MOVE T1,CNODEA-1(T2) ; GET VIRTUAL NODE WE CAME FROM
MOVE T3,ROOTND-1(T2) ; GET ROOT NODE OF ANC. FILE
GTANC T4,T1 ; GET ANC. OF VIRTUAL NODE
CAMN T4,T3 ; IS IT ROOT NODE?
JRST PRMAP1 ; YES (SO TITLE ALREADY PRINTED)
MSGN <U >
GTTEXT T1,T4 ; BYTE PTR. OF TITLE OF ANC. OF VIRT. NODE
CALL PRTIT ; PRINT TITLE
PRMAP1:
>
MSGN < Titles within current subject:> >
PUSH SP,F ; SAVE FLAGS
UNSETF PRTX ; SWITCH TEXT PRINTING OFF
UNSETF PRSEP ; SWITCH NUDE SEPARATION OFF
UNSETF PRPTH ; SWITCH OFF PATH PRINTING
SETZM INDNT
; NOW PUSH REL. ADRS. OF ANCESTOR NODES ONTO STACK
SETZM T2 ; TO COUNT NO. OF NODES PUSHED ONTO STACK
; (SHOULD BE EQUAL TO CLEVEL)
MOVE T1,CNODE
UNTILJ
< GTANC T1,T1
JUMPE T1, >,
< PUSH SP,T1
AOS T2
JRST >
CAME T2,CLEVEL
JRST NASTY 5 ; CLEVEL MUST BE INCORRECT
; NOW TAKE REL. ADRS. OF ANCESTOR NODES OFF STACK AND
; PRINT THEIR TITLES
SETZ S1, ; LEVEL COUNT
MOVE S2,CLEVEL ; NO. OF "U"'S TO PRINT
WHLSKP <CAML S1,CLEVEL>,
< UNLJMP <JUMPG S1,>,
< MSGN <O > >,
< MOVEI T1,"U"
MOVE T2,S2
MOVEI T3,5
CALL PRLETS >
POP SP,T2 ; GET REL. ADR. OF NODE OFF STACK
PUSH SP,S1 ; SAVE S1
PUSH SP,S2 ; SAVE S2
CALL PRND ; PRINT TITLE OF NODE
POP SP,S2 ; RESORE S2
POP SP,S1 ; RESTORE S1
MOVE T1,INDNTC
ADDM T1,INDNT ; ADD INDNTC TO INDNT
SOS S2
AOJA S1, >
; NOW DEAL WITH PREV, CURRENT AND NEXT NODES
MOVE T1,CNODE
GTPREV T2,T1 ; GET REL. ADR. OF PREVIOUS NODE
UNLJMP <JUMPE T2,>,
< MSGN <B > ; HERE IF THERE IS A PREV NODE
CALL PRND ; PRINT TITLE OF PREV NODE
>
MSGN <* >
MOVE T2,CNODE
CALL PRND ; PRINT TITLE OF CURRENT NODE
MOVE T1,CNODE
GTNEXT T2,T1
UNLJMP <JUMPE T2,>,
< MSGN <N > ; HERE IF THERE IS A NEXT NODE
CALL PRND ; PRINT TITLE OF NEXT NODE
>
POP SP,F ; RESTORE FLAGS
SKPOFF GUIDE
MSGN <
Type letter(s) on left to get to section required
(* indicates current section)>
PRMAPG:
SKPON GUIDE
RETURN
MOVE T1,CNODE
GTDES T1,T1
SKIPE T1 ; SKIP IF NO DESCENDANTS
MSGN <Press ESCAPE to get list of sub-sections of current section>
MSGN <For full list of PHI commands type H>
RETURN
PROC PRND ; FOR USE ONLY BY PROC PRMAP
; ARGS: IN: T2, INDNT, WORK: AS FOR PRNODE
; PRINTS TITLE (WITH SEC NO.) OF NODE WHOSE REL. ADR. IS
; IN T2, PRECEEDED BY INDENTATION OF INDNT SPACES.
MOVE T1,INDNT
CALL SPCS
PUSH SP,T2
CALL PRNODE
ADJSP SP,-1
RETURN
PROC PRTIT ; ARGS: IN: T1, WORK:CH
; PRINTS TITLE WHOSE BYTE PTR IS IN T1. (NO SEC NOS. OR
; INDENTATION).
UNTILJ
< ILDB CH,T1
CAIE CH,STRDIV
CAIN CH,STRTM
JRST >,
< OUTCHR CH
JRST >
RETURN
PROC PRLETS ; ARGS: IN: T1,T2,T3
; PRINTS THE CHARACTER IN T1, THE NUMBER OF TIMES SPECIFIED
; IN T2, FOLLOWED BY A SPACE. STARTS ON A NEW LINE.
; THEN IF NECESSARY PRINTS SPACES TO FILL OUT TO
; NUMBER OF COLUMNS SPECIFIED IN T3.
MSGN <>
UNTILJ <JUMPE T2, >,
< OUTCHR T1
SOS T3
SOJA T2, >
OUTCHR [" "]
SOS T3
MOVE T1,T3
CALL SPCS
RETURN
SUBTTL PROCS FOR MOVING FROM NODE TO NODE
PROC NEXTND ; ARGS: IN: T1,MAXLEV,ICBAR,NODBAR OUT:T2 IO:LEVEL
; FINDS THE 'NEXT NODE' IN THE TREE AFTER THE NODE WHOSE
; REL. ADR. IS IN T1. NODES ARE REGARDED AS BEING IN THE
; ORDER IN WHICH THEY WOULD BE PRINTED IN A P COMMAND.
; THE REL. ADR. OF THE NEXT NODE IS RETURNED IN T2,
; AND LEVEL IS UPDATED,
; OR IF THERE IS NO NEXT NODE, T2 WILL CONTAIN THE
; REL. ADR. OF THE ROOT NODE
; IF LEVEL=MAXLEV, DESCENDANTS OF T1 NODE ARE IGNORED.
; NODBAR AND ICBAR DEFINE THE TOP OF A SUB-TREE OUT
; OF WHICH WE ARE NOT ALLOWED TO MOVE (NODBAR IS REL. ADR.
; OF NODE, ICBAR IS FILE INDEX). IF ROUTINE WOULD GO
; OUTSIDE THIS SUB-TREE, IT JUST RETURNS WITH T2=0.
MOVE T3,CFILE
WHENSK <CAMN LEVEL,MAXLEV>,
< GTDES T2,T1
UNLJMP <JUMPE T2, >,
< AOS LEVEL
RETURN > >
SETZM T2
DO
< CAMN T1,NODBAR ; AT THE 'BAR' NODE?
CAME T3,ICBAR ; ...AND IN APPROPRIATE FILE?
SKIPA ; NO
RETURN ; YES (T2 WILL BE 0 HERE)
MOVE T2,T1
CAMN T2,CROOT
RETURN ; RETURN IF ROOT NODE
GTNEXT T2,T1
SKIPE T2
RETURN ; RETURN IF 'NEXT' POINTER NON-ZERO
GTANC T1,T1
SOS LEVEL
JRST >
PROC GLOBNX ; ARGS: AS FOR NEXTND (ALSO WORK: S-REGS) ALSO IN: GLOBP
; IF 'GLOBP' IS ON THEN IF A VIRTUAL NODE IS REACHED
; WE WILL ONLY DO DOWN TO FILE IF ITS 'P VALUE' IS LE PVAL
; (NOTE THAT MAXLEV AND LEVEL ARE 'GLOBAL' LEVELS)
; FINDS THE 'GLOBAL NEXT NODE' IN TREE AFTER THE
; (REAL) NODE WHOSE REL. ADR. IS IN T1 AND RETURNS T2
; AS REL. ADR. OF THIS NODE (WILL ALSO BE A REAL NODE).
; NOTE THAT IF THIS ROUTINE CAUSES THE CURRENT FILE TO BE
; CHANGED THEN THE CURRENT NODE WILL BE RESET.
CALL NEXTND
JUMPE T2,GLOBNR ; RETURN IF REACHED THE 'BAR' NODE
UNTILJ
< CAMN T2,CROOT
SKIPN CFILE
JRST >,
< SOS CFILE ; HERE IF ROOT NODE AND CFILE GT 0
CALL UPFILE ; UPFILE SETS T1 TO REL. ADR. OF VIRTUAL
; NODE IN ANCESTOR FILE
CALL NEXTND
JUMPE T2,GLOBNR ; RETURN IF REACHED THE 'BAR' NODE
JRST >
CAMN T2,CROOT ; AT TOP OF TREE?
RETURN ; YES
MOVE S1,T2 ; ARG FOR INDFS
CALL INDFS ; TEST FOR VIRTUAL NODE
MOVE T2,S1 ; RESTORE T2 VALUE
SKIPN SUBJEC ; VIRTUAL NODE?
JRST GLOBNR ; NO
MOVE T1,PVIRT ; YES - GET ITS 'P VALUE'
SKPOFF GLOBP
CAMG T1,[PVAL] ; WE DONT USE CAIG T1,PVAL BECAUSE PVAL
; MIGHT BE -1
SKIPA ; IF GLOBP OFF OR PVIRT LE PVAL
JRST GLOBNR
MOVE T1,S1
PUSH SP,T2 ; SAVE T2 IN CASE WE CANT READ FILE
CALL DNFILE ; MOVE DOWN TO DESCENDANT FILE
POP SP,T2 ; RESTORE T2
SKIPE T1 ; SKIP IF FILE WASNT READ
MOVE T2,CROOT ; RESET T2 TO ROOT NODE
GLOBNR: RETURN
PROC NEXTRT ; ARGS: AS FOR GLOBNX
; FINDS NEXT ROOT NODE IN GLOBAL TREE (SETS T2 TO REL.
; ADR. OF ROOT NODE)
; IF 'BAR NODE' IS REACHED, T2 RETURNED AS 0.
UNSETF GLOBP
DO
< CALL GLOBNX
SKIPE T2
CAMN T2,CROOT
RETURN ; IF AT ROOT NODE OR 'BAR' NODE
MOVE T1,T2
JRST >
PROC NFIND ; ARGS: IN: WORK/NUMBER OUT:T1/ADR
; FINDS THE N'TH IMMEDIATE DESCENDANT OF CURRENT NODE
; AND SETS T1 TO CONTAIN ITS REL. ADR.
; N IS VALUE (GT 0) IN REG.WORK ON ENTRY.
; IF FOUND, SETS REG.WORK TO 0 (IF NOT FOUND, REG.WORK WILL
; BE SOME VALUE GT 0, AND T1 WILL BE 0).
MOVE T2,CNODE
GTDES T1,T2
DO
< JUMPE T1,NFINDR ; END OF THE LINE - JUMP OFF
SOJE WORK,NFINDR
GTNEXT T1,T1
JRST >
NFINDR: RETURN
PROC MAKCUR ; MAKE NODE IN T1 THE CURRENT ONE UNLESS ZERO
; DOES NOT UPDATE CLEVEL
; CHECKS NEW NODE FOR AN INDIRECT FILE SPEC AND IF
; NECESSARY READS IN NEW FILE
UNLJMP <JUMPE T1,>,
< MOVEM T1,CNODE
MOVE S1,CNODE ; ARG FOR INDFS
CALL INDFS
WHENSK <SKIPN SUBJECT>,
< MOVE T1,CNODE
CALL DNFILE > >,
< MSGN <NOT FOUND>
SETF SUPVER >
RETURN
PROC ROOT ; MOVES TO ROOT NODE
MOVE T1,CROOT
MOVEM T1,CNODE
SETZM CLEVEL
RETURN
PROC UPFILE ; ARGS: OUT: T1, WORK: S REGS
; CALLED AFTER CFILE HAS BEEN DECREMENTED, TO MOVE UP TO
; FILE FOR THAT SUBJECT LEVEL
; CURRENT NODE IS RESET TO ROOT NODE
; T1 WILL BE SET TO REL. ADR. OF THE VIRTUAL NODE
; WHICH WE ORIGINALLY CAME DOWN FROM.
MOVE T1,CFILE
IFN APPEND,<
MOVE T2,ROOTND(T1)
MOVEM T2,CROOT
AOS T1
MOVE NEXLOC,ROOTND(T1)
MOVE NEXTTX,ROOTIT(T1)
>
IFE APPEND,<
MOVE NEXTTX,ROOTIT(T1) ; RECLAIM SPACE USED BY TITLE(S)
MOVEI NEXLOC,1
MOVEM NEXLOC,ROOTND(T1)
CALL GETFS
CALL FNDFIL
JUMPGE T1,ERRF ; SHOULDN'T HAPPEN!
CALL READIN
>
MOVE T1, [POINT 7,0,34] ; SET UP LH OF BYTE POINTER
HRR T1,NEXTTX ; AND RH
MOVEM T1,LASTTX ; DEFINE NEW END OF TEXT ARRAY
CALL REDUCE ; REDUCE CORE IF POSSIBLE
CALL ROOT
MOVE T2,CFILE
UNLJMP
< SKIPE SRCCHR
CAML T2,SRCIFL
JRST >,
< SETZM SRCCHR ; WE ARE MOVING ABOVE SEARCH START NODE
MSGN <(current search becomes undefined)> >
SETZM CVER
MOVE T1,CNODEA(T2)
RETURN
PROC DNFILE ; ARGS: IN: T1,DEVICE,SUBJEC,EXT,PPN,SFD1,SFD2
; WORK: S-REGS
; MOVES TO ROOT OF DESCENDANT FILE FROM 'VIRTUAL NODE'
; WHOSE REL. ADR. IS IN T1
; SETS T1 TO -1 IF O.K. ELSE 0 IF FILE NOT READ IN
PUSH SP,T1 ; SAVE T1
CALL FNDFIL
JUMPGE T1, [ MSGN <file >
PUSH SP,T1 ; SAVE T1
CALL PRFS
POP SP,T1 ; RESTORE T1
SKIPG T1
MSG " not found"
SKIPE T1
CALL FILERR
ADJSP SP,-1
SETZM T1
RETURN ]
MOVE T1,(SP) ; GET T1 FROM STACK BUT LEAVE IT THERE
SETZM T3 ; T3 WILL BE NODE FLAGS
GTPREV T2,T1
SKIPE T2 ; ANY PREV NODE?
TXO T3,1B0 ; YES - SET BIT 0 IN FLAGS
GTNEXT T2,T1
SKIPE T2 ; ANY NEXT NODE?
TXO T3,1B1 ; YES - SET BIT 1 IN FLAGS
MOVE T4,CFILE
MOVEM T1,CNODEA(T4) ; SET REL. ADR. OF VIRTUAL NODE SO WE
; WILL KNOW WHERE TO COME BACK UP TO
MOVEM T3,NODFLG(T4) ; SET NODE FLAGS WORD
AOS T1,CFILE
CAIL T1,MXFLEV
JRST [ MSGN <***Max level of indirect files exceeded>
JRST STOP ]
IFE APPEND,<
MOVEI NEXLOC,1
; NOW SET NEXTTX TO POINT TO END OF TITLE OF ROOT NODE
; OF FILE WE ARE MOVING DOWN FROM
MOVE NEXTTX,ROOTIT(T4)
DO
< ILDB T1,NEXTTX
CAIE T1,STRTM
CAIN T1,STRDIV
SKIPA
JRST >
>
MOVE T1,CFILE
MOVEM NEXLOC,ROOTND(T1) ; ) SET VALUES FOR FILE WE ARE MOVING TO
MOVEM NEXTTX,ROOTIT(T1) ; )
POP SP,T1 ; RESTORE REL. ADR. OF VIRTUAL NODE
MOVE T2,EXT
WHENSK <CAMN T2,[SIXBIT/PHI/] >,
< ; NOT A PHI FILE. COPY TITLE FROM VIRTUAL NODE TO START
; OF TEXT FOR THIS NODE.
PUSH SP,CH ; SAVE CH
GTTEXT T1,T1
UNTILJ
< ILDB CH,T1
CAIE CH,STRTM
CAIN CH,STRDIV
JRST >,
< CALL DEPCH
JRST >
MOVEI T1, [ BYTE(7) STRDIV,CR,LF ]
MOVEI T2,7
CALL DEPSTR
POP SP,CH >
CALL READIN
CALL ROOT
CALL STORFS
SETZM CVER
SETOM T1
RETURN
SUBTTL PROCS FOR STRING SEARCHING
PROC TESTND ; ARGS: IN: T1/ADR OUT:MTCH
; WORK: CH
; TESTS IF NODE WITH GIVEN ADDRESS MATCHES SEARCH STRING
; STORED IN SRCCHR AND SRCSTR.
; SETS MTCH IF MATCH.
; CHARACTERS IN TITLE/TEXT ARE CONVERTED TO UPPER CASE BEFORE
; MATCHING.
UNSETF MTCH
UNSETF TSTNF1 ; WILL BE SET WHEN FIRST STRDIV CHAR FOUND
GTTEXT T1,T1
DO
< ILDB CH,T1
CAIN CH,STRDIV
SKPOFF TSTNF1
JRST TESTN1
SKPOFF SRCTIT ; HERE IF FIRST STRDIV CHAR
RETURN ; ONLY INTERESTED IN TITLE
SETF TSTNF1
SKPOFF MOD
JRST TESTN1 ; MODIFICATION MODE - DON'T TEST FOR INDIRECT
; FILE-SPEC
ILDB CH,T1
CAIE CH,CR
JRST TESTN1
ILDB CH,T1
CAIE CH,LF
JRST TESTN1
ILDB CH,T1
CAIN CH,"@"
RETURN ; INDIRECT FILE SPEC FOUND
TESTN1: CAIN CH,STRTM
RETURN ; STRTM CHAR REACHED
UPCASE CH
WHENSK <CAME CH,SRCCHR>,
< PUSH SP,T1 ; SAVE T1
CALL MATCH ; CH MATCHES FIRST CHAR OF SEARCH STRING
; ... TEST THE REST OF THE STRING
POP SP,T1 >
SKPOFF MTCH
RETURN ; IF MATCH
JRST >
PROC MATCH ; ARGS: IN: T1 (BYTE POINTER TO STRING IN TEXT TO
; BE TESTED). OUT: MTCH
; TESTS STRING SPECIFIED AGAINST STRING IN SRCSTR.
; SETS MTCH IF MATCHED.
UNSETF MTCH
MOVE T2, [POINT 7,SRCSTR]
UNTILJ
< ILDB T4,T2 ; LOAD CHAR FROM SEARCH STRING
JUMPE T4, >,
< ILDB T3,T1 ; LOAD CHAR FROM TEXT
CAIN T3,STRTM
RETURN ; RETURN IF STRTM CHAR FOUND
UPCASE T3
CAME T3,T4
RETURN ; CHARACTER DOESNT MATCH - RETURN
JRST >
SETF MTCH
RETURN ; END OF SEARCH STRING (MATCH)
SUBTTL PROCS FOR ADDING NEW NODES AND TEXT
ADRN=S1
PREV=S2
PROC CRTTRE ; INSERT A TREE
; ARGS: IN: STACK(ANC), PREV
; WORK: S-REGS
; TREE WILL BE INSERTED BETWEEN PREV AND ITS SUCCESSOR,
; OR, IF PREV IS 0, BEFORE ANY DESCENDANTS OF ANC.,
MOVE T1,-1(SP) ; ANC
DO
< INCHWL CH
CALL SKPBCL
WHENSK <CAIE CH,"#">,
< MOVE T1,YNKNOD ; YANKED NODE REQUIRED
JUMPE T1,NOYANK ; NO YANKED NODE SET
SETZM YNKNOD
SETF YANK ; SET YANK FLAG
INCHWL CH >,
< CALL CRTNOD ; CREATE A NEW NODE
UNSETF YANK >
MOVE ADRN,T1
MOVE T2,-1(SP) ; ANCESTOR
MOVE T3,PREV
CALL INSLST ; INSERT THE NEW NODE INTO TREE,
; (ONLY ONE NODE IN LIST BECAUSE 'NEXT'
; FIELD IS 0 FOR NEWLY CREATED NODE).
SKPON YANK ; SKIP IF YANKED MODE SET
CALL RDQNOD
WHENSK <CAIE CH,DEL1>,
< PUSH SP,ADRN ; ANCESTOR ADDRESS FOR SUB-TREE
SETZ PREV,
CALL CRTTRE ; CREATE DESCENDANT TREE
POP SP,ADRN
CAIE CH,DEL2
JRST ERROR
INCHWL CH >
CAIE CH,DEL2
CAIN CH,CR
RETURN ; DEL2 OR CR - END OF TREE SPEC
CAIN CH,ESC
RETURN ; ESC - END OF TREE SPEC
CAIE CH,SEP
JRST ERROR ; SEPARATOR CHARACTER EXPECTED
MOVE PREV,ADRN
JRST >
PROC RDQNOD ; ARGS: IN: S1 IO: CH
; REG. S1 CONTAINS REL. NODE ADDRESS
; STARTS WITH CHAR IN CH
; READS TITLE/TEXT FOR NODE DELIMITED BY QUOTES.
; IF CH NOT QUOTE AT START, THIS IS NULL
; TEXT AND NODE SET TO HAVE EMPTY TEXT
; ON EXIT CH IS NEXT CHAR AFTER FINAL DELIMITER
STTEXT NEXTTX,S1
CAIE CH,QUOTE
JRST RDNOD2 ; NULL TEXT
INCHWL CH
WHLSKP <CAIN CH,QUOTE >,
< CALL DEPCH
INCHWL CH
JRST >
RDNOD2: PUSH SP,CH
MOVEI CH,STRTM
CALL DEPCH ; PUT TERMINATOR CHAR. AT END OF STRING
POP SP,CH
CAIN CH,QUOTE
INCHWL CH
RETURN
PROC RDNOD ; ARGS: IN: S1; WORK: CH
; READS TITLE AND TEXT FOR NODE WHOSE REL. ADR. IS
; IS IN S1.
; STARTS BY READING NEXT CHAR.
SKIPA T1,[0]
PROC RDNODM ; ENTRY POINT. AS RDNOD BUT IF FIRST CHAR IS ESC,
; RETURNS WITHOUT DOING ANYTHING.
MOVEI T1,ESC
MSGN <Enter title terminated by ESC:
>
INCHWL CH
CAMN CH,T1
RETURN ; IF RDNODM ENTRY AND FIRST CHAR IS ESC
STTEXT NEXTTX,S1 ; SET TEXT POINTER FOR NODE
WHLSKP <CAIN CH,ESC>,
< CALL DEPCH
INCHWL CH
JRST >
MSGN <Enter text terminated by ESC:
>
INCHWL CH
CAIN CH,ESC
JRST RDNOD3
PUSH SP,CH
MOVEI T1, [ BYTE(7) STRDIV,CR,LF ]
MOVEI T2,7
CALL DEPSTR
POP SP,CH
WHLSKP <CAIN CH,ESC>,
< CALL DEPCH
INCHWL CH
JRST >
RDNOD3: MOVEI CH,STRTM
CALL DEPCH ; PUT TEXT TERMINATOR CHARACTER
RETURN
PROC DEPCH ; DEPOSIT CH AT NEXT POSN. IN "TEXT"
; ARGS: IO: CH,NEXTTX
; PRESERVES ALL REGISTERS
WHENSK <CAME NEXTTX,LASTTX>,
< PUSH SP,T1
PUSH SP,T2
MOVEI T1,CORINC
CALL EXTEND
POP SP,T2
POP SP,T1 >
IDPB CH,NEXTTX
RETURN
PROC DEPSTR ; DEPOSIT A STRING AT NEXT POSN IN 'TEXT'.
; ARGS: IN: T1,T2 IO:NEXTTX, WORK:CH
; T1 CONTAINS ADR. OF STRING, WHICH MUST BE TERMINATED
; BY A NULL (SO IF SIXBIT, CANT HAVE A BLANK IN IT).
; T2 CONTAINS 6 (FOR SIXBIT) OR 7 (FOR ASCII)
; SEE ALSO REMARKS FOR 'DEPCH'
MOVE T4, [ 440000,,0] ; T4 WILL BE BYTE POINTER
MOVE T3,T2
LSH T3,^D24
ADD T4,T3 ; SET BYTE SIZE IN BYTE PTR
HRR T4,T1 ; ..AND ADDRESS OF STRING
UNTILJ
< ILDB CH,T4
JUMPE CH, >,
< CAIE T2,7 ; ASCII?
ADDI CH,40 ; NO - CONVERT TO ASCII
CALL DEPCH
JRST >
RETURN
SUBTTL PROCS FOR EDITING TEXT
PROC EDIT ; ARGS: IN: S1,NEXTTX IO:S2 (COPY OF NEXTTX ON ENTRY)
; OUT: CH WORK: S3,S4
; EDITS FROM ONE STRING IN "TEXT" ARRAY (BYTE PTR
; S1) TO ANOTHER (BYTE PTR S2).
; ON EXIT CH WILL CONTAIN LAST COMMAND READ.
CALL ECHO ; SWITCH OFF ECHOING
ILDB S3,S1 ; LOAD FIRST CHAR INTO S3
CALL EDPRLN ; PRINT FIRST LINE
SETZ S4, ; CLEAR REPEAT COUNT
INCHRW CH ; READ FIRST COMMAND
DO
< UPCASE CH
CAIN CH,"I"
JRST EDINS ; COMMAND IS I (INSERT)
CAIN CH,"Q"
JRST EDFIN ; Q COMMAND - ABANDON EDITING
CAIN CH,"*"
JRST EDEND ; COMMAND IS * (END EDIT)
CAIE CH,RUBOUT
CAIN CH,BCKSPC
JRST EDBACK ; COMMAND IS BACKSPACE OR RUBOUT
CAIN S3,STRTM
JRST EDERR ; BECAUSE ALL THE FOLLOWING COMMANDS ARE
; INVALID IF ALREADY AT END OF TEXT
CAIE CH," "
CAIN CH,"D"
JRST EDCD ; COMMAND IS BLANK (COPY CHAR) OR D
; (DELETE CHAR).
CAIE CH,CR
CAIN CH,"E"
JRST EDREP ; COMMAND IS CRLF (COPY UP TO LF WITH
; PRINTOUT) OR E (DELETE UP TO LF).
CAIE CH,LF
CAIN CH,"Z"
JRST EDREP ; COMMAND IS Z (COPY UP TO END OF
; TEXT) OR LF (COPY UP TO LF)
CALL DECN ; TRY FOR A NUMBER
SKIPN T1 ; SKIP IF POSITIVE NUMBER READ
JRST EDERR ; COMMAND UNRECOGNISED
MOVE S4,T1 ; SET REPEAT COUNT FOR NEXT COMMAND
JRST EDNXT
EDINS: CALL ECHO ; SWITCH ECHOING ON (BECAUSE
; READING CHARS WITH INCHWL).
WHLSKP
< INCHWL T1
CAIN T1,ESC >,
< WHENSK <CAME S2,LASTTX >,
< PUSH SP,T1 ; SAVE T1
MOVEI T1,CORINC
CALL EXTEND ; EXTEND TEXT ARRAY
POP SP,T1 >
IDPB T1,S2
JRST >
CALL ECHO ; SWITCH ECHOING BACK OFF
JRST EDNXTC
EDCD: DO
< WHENSK <CAIN CH,"D">,
< WHENSK <CAME S2,LASTTX>,
< MOVEI T1,CORINC
CALL EXTEND ; EXTEND TEXT ARRAY
>
IDPB S3,S2 ; DEPOSIT S3 INTO 2ND STRING
>
CAIN CH,"D"
OUTCHR ["/"] ; IF D COMMAND
OUTCHR S3 ; PRINT CHAR
ILDB S3,S1 ; GET NEXT CHAR
CAIE S3,STRTM ; JUMP OUT IF END OF TEXT
SOJG S4, >
JRST EDNXTC
EDREP: CAIN CH,CR
INCHRW T1 ; COMMAND WAS CRLF - READ THE LF
DO
< WHLSKP <CAIN S3,STRTM>,
< WHENSK <CAIN CH,"E">,
< ; HERE IF COMMAND IS CR, LF OR Z
WHENSK <CAME S2,LASTTX>,
< MOVEI T1,CORINC
CALL EXTEND >
IDPB S3,S2 >
CAIN CH,CR
OUTCHR S3 ; COMMAND IS CR - PRINT CHAR
MOVE T1,S3
ILDB S3,S1 ; LOAD NEXT CHAR FROM FIRST STRING
CAIE CH,"Z"
CAIE T1,LF ; CR,LF OR E COMMAND - SKIP OUT OF LOOP
; IF LF REACHED
JRST >
CAIE S3,STRTM ; JUMP OUT IF END OF TEXT
SOJG S4, >
CALL EDPRLN ; PRINT NEXT LINE
JRST EDNXTC
EDBACK: CAMN S2,NEXTTX
JRST EDERR ; ALREADY AT BEGINNING OF 2ND STRING
MOVNI T1,1
ADJBP T1,S2 ; ADJUST BYTE POINTER BY -1
MOVE S2,T1
OUTCHR [BCKSPC]
JRST EDNXTC
EDERR: OUTCHR [7] ; ERROR - OUTPUT A BELL
EDNXTC: SETZ S4, ; CLEAR REPEAT COUNT
INCHRW CH ; READ NEXT COMMAND
EDNXT: JRST >
EDEND: WHENSK <CAME S2,LASTTX>,
< MOVEI T1,CORINC
CALL EXTEND >
MOVEI T1,STRTM
IDPB T1,S2
EDFIN: CALL ECHO ; SWITCH ON ECHOING
RETURN
PROC EDPRLN ; PRINTS CURRENT LINE
MSGN <>
MOVE T1,S1 ; MAKE COPY OF BYTE POINTER
MOVE T2,S3 ; FIRST CHAR OF LINE
UNTILJ
< CAIE T2,STRTM
CAIN T2,LF
JRST >,
< OUTCHR T2
ILDB T2,T1
JRST >
MSGN <>
RETURN
PROC ECHO ; SWITCHES ECHOING ON/OFF
GETSTS CHAN,T1
TXC T1,IO.SUP ; CHANGE ECHO SUPPRESSION BIT
SETSTS CHAN,(T1)
RETURN
SUBTTL PROCS FOR WRITING OUTPUT FILE
PROC WRPHI ; ARGS: IN: S3,S4 (FOR PUTCH) WORK: S1,S2
; WRITES OUT THE .PHI FILE
PUSH SP,CH ; SAVE LAST CHAR READ FROM TTY
PUSH SP,LPTPAG ; SAVE LPTPAG
SETZM LPTPAG
SETZ T1,
CALL DECOUP ; WRITE A ZERO
MOVEI CH,"."
CALL PUTCH ; WRITE A DOT
PUSH SP,CROOT ; REL. ADR. OF ROOT NODE
CALL WRSTR ; WRITE TEXT FOR ROOT NODE
ADJSP SP,-1
SETZM LEVEL
SETOM MAXLEV ; NO LEVEL LIMIT
MOVEMM CFILE,ICBAR,T1
MOVE T1,CROOT
MOVEM T1,NODBAR
UNTILJ
< CALL NEXTND
JUMPE T2, >,
< PUSH SP,T2 ; REL. ADR. OF NODE
MOVE T1,LEVEL
CALL DECOUP ; WRITE LEVEL
MOVEI CH,"."
CALL PUTCH ; WRITE A DOT
CALL WRSTR ; WRITE TEXT FOR NODE
POP SP,T1 ; RETRIEVE NODE ADR. FOR NEXT TIME ROUND
JRST >
POP SP,LPTPAG ; RESTORE LPTPAG
POP SP,CH ; RESTORE LAST CHAR READ FROM TTY
RETURN
PROC WRSTR ; ARGS: IN: STACK(ADR)
; WRITE TEXT STRING FOR NODE WHOSE REL. ADR. IS 'ADR'
MOVE S1,-1(SP) ; ADDRESS OF NODE
GTTEXT S2,S1
DO
< ILDB CH,S2
CALL PUTCH
CAIE CH,STRTM ; IF TERMINATOR CHAR. SKIP OUT OF LOOP
JRST >
MOVEI CH,CR ; CR
CALL PUTCH
MOVEI CH,LF ; LF
CALL PUTCH
RETURN
SUBTTL BASIC PROCS FOR READING AND WRITING CHARACTERS AND NUMBERS
PROC UUOH ; UUO HANDLER, ARGS: IN: S3,S4 (FOR PUTCH),
; WORK: CH
LDB T1,[POINT 9,40,8] ; GET OPCODE INTO T1
CAIN T1,1
JRST [ HRRZ CH,40 ; HERE IF PRCHR
CALL PUTCH
RETURN ]
PUSH SP,S1 ; SAVE S1
MOVE S1,[POINT 7,0] ; HERE IF PRSTR, SET UP BYTE PTR
HRR S1,40 ; ADD ADDRESS INTO BYTE POINTER
UNTILJ
< ILDB CH,S1
JUMPE CH, >,
< CALL PUTCH
JRST >
POP SP,S1 ; RESTORE S1
RETURN
PROC PUTCH ; ARGS: IN: S3,S4,CH
; ROUTINE TO WRITE A CHARACTER TO CHANNEL WHOSE
; NO. IS IN S3. S4 CONTAINS ADDRESS OF BUFFER CONTROL BLOCK.
; (ON ENTRY, 1(S4) POINTS TO LAST CHAR WRITTEN, 2(S4) IS
; NO. OF FREE LOCNS + 1)
; *** THIS PROC AS IN SUBS.MAC EXCEPT IT MAINTAINS ICOL
; (COL. NO. OF NEXT CHAR TO BE WRITTEN), AND PAUSES AT
; END OF A PAGE IF PRINTING TO TTY OR DOES PAGE THROW TO
; LPT OR DSK.
; ALSO DOESNT PRESERVE T REGS.
; IF BEING CALLED TO WRITE A .PHI FILE, LPTPAG MUST BE SET
; TO 0, TO AVOID FORMFEEDS BEING WRITTEN ***
WHENSK <SOSLE 2(S4)>,
< PUSH SP,T1
MOVE T1,S3
LSH T1,^D23
ADD T1,[OUT]
XCT T1
JRST [ POP SP,T1 ; O.K.
JRST OUTOK ]
MSGN <ERROR IN WRITING BUFFER> ; ERROR RETURN
EXIT >
OUTOK: IDPB CH,1(S4)
AOS ICOL ; INCREMENT ICOL
CAIN CH,CR
SETZM ICOL ; SET ICOL=0 IF CR
WHENSK <CAIE CH,FORMFD>,
< WHENSK <SKPON TTYPR>,
< MOVEI T1,^D8
ADDM T1,NLINES >,
< SETZM NLINES > >
CAIE CH,LF ; LINEFEED?
RETURN ; NO
AOS T1,NLINES ; YES
SKPON TTYPR ; PRINTING TO TTY?
JRST [ SKIPE LPTPAG ; NO - PRINTING IS TO LPT OR DSK
CAMGE T1,LPTPAG
RETURN ; PAGE NOT YET FULL OR NO PAGE LIMIT
PUSH SP,CH ; SAVE CH
MOVEI CH,FORMFD
CALL PUTCH ; (RECURSIVE CALL) PRINT A FORMFEED
POP SP,CH ; RESTORE CH
SETZM NLINES
RETURN ]
SKIPE TTYPAG
CAMGE T1,TTYPAG
RETURN ; PAGE NOT YET FULL OR NO LIMIT
MOVE T1,S3
LSH T1,^D23
ADD T1,[OUT]
XCT T1 ; OUT UUO
SKIPA ; O.K.
JRST [ MSGN <ERROR IN WRITING BUFFER>
JRST STOP ]
CLRBFI ; CLEAR ANY TYPE-AHEAD TEXT
INCHRS T1 ; TO CLEAR CTRL/O IF SET
SKIPA
JFCL ; WE DON'T EXPECT THIS
SKPOFF BELL
MSGN <.. type space to continue (or press return to abandon listing) : >
SKPON BELL
MSGN <.. type space to continue : >
INCHRW T1
CAIN T1,CR ; CR?
INCHRW T2 ; YES - SKIP THE LF
CAIE T1," " ; BLANK?
JRST RESTOR ; NO - BACK TO MAIN COMMAND LOOP WITH T1
; CONTAINING CHARACTER.
SETZM NLINES
MSGN <>
MSGN <>
RETURN
AC=T1
N=T2
REM=T3 ; MUST BE NEXT REG. TO N.
R=T4
PROC DECOUP ; AS DECOUT BUT WRITES TO CHANNEL SPECIFIED IN S3,
; WITH BCB ADR. IN S4. WORK: CH
; (DOESN'T PRESERVE T REGS)
SKIPA R,[12]
PROC OCTOUP ; ENTRY POINT FOR OCTAL NUMBERS
MOVEI R,10
MOVE N,AC
PROC RADOUT
IDIV N,R
UNLJMP <JUMPE N,>,
< HRLM REM,(SP)
CALL RADOUT
HLRZ REM,(SP) >
ADDI REM,"0"
MOVE CH,REM
CALL PUTCH
RETURN
PROC RDPATG ; ARGS:IO: CH OUT:T1,PPN,SFD1,SFD2
; REQUIRES ADR OF A RTN TO GET A CHAR INTO CH, ON
; TOP OF STACK.
; READS A PATH SPECIFICATION OF THE FORM
; [...,...,...,...]
; AND SETS VALUES IN PPN,SFD1,SFD2
; ON ENTRY CH CONTAINS FIRST CHARACTER - IF IT IS NOT
; A "[" THEN PROC SETS PPN TO CONTAIN -1.
; ON EXIT CH IS NEXT CHARACTER AFTER THE "]".
; THE "]" CHARACTER MAY BE OMMITTED IF THE NEXT
; CHARACTER IS CR (CH IS RETURNED AS THE CR)
; SYNTAX ERRORS CAUSE T1 TO BE RETURNED AS NON-ZERO.
EXCH 16,-1(SP)
MOVNI T1,1
MOVEM T1,PPN
SETZM SFD1
SETZM SFD2
SETZ T1,
CAIE CH,"["
JRST RDPAT3
SETZM PPN
CALL (16)
PUSH SP,16
CALL OCTIG
ADJSP SP,-1
HRLM T1,PPN ; PROJECT NUMBER
CAIE CH,"]"
CAIN CH,CR
JRST RDPAT2 ; IF "]" OR CR
CAIE CH,","
JRST RDPAT1
CALL (16)
PUSH SP,16
CALL OCTIG
ADJSP SP,-1
HRRM T1,PPN ; PROGRAMMER NUMBER
CAIE CH,"]"
CAIN CH,CR
JRST RDPAT2 ; IF "]" OR CR
CAIE CH,","
JRST RDPAT1
CALL (16)
PUSH SP,16
CALL RD6NAG
ADJSP SP,-1
MOVEM T1,SFD1 ; SFD NAME 1
CAIE CH,"]"
CAIN CH,CR
JRST RDPAT2 ; IF "]" OR CR
CAIE CH,","
JRST RDPAT1
CALL (16)
PUSH SP,16
CALL RD6NAG
ADJSP SP,-1
MOVEM T1,SFD2
CAIE CH,"]"
CAIN CH,CR
JRST RDPAT2 ; IF "]" OR CR
RDPAT1: MOVEI T1,1 ; ERROR
JRST RDPAT3
RDPAT2: CAIE CH,CR
CALL (16) ; READ NEXT CHARACTER AFTER THE "]"
SETZ T1,
RDPAT3: EXCH 16,-1(SP)
RETURN
PROC DECOUG ; ARGS: IN: T1, STACK/(RTN)
; WRITES POSITIVE INTEGER IN T1
; CALL: PUSH SP,[RTN]
; CALL DECOUG
; ADJSP SP,-1
; WHERE RTN IS ADDRESS OF A ROUTINE TO WRITE THE
; ASCII CHARACTER IN T3.
SKIPA R,[12]
PROC OCTOUG ; ENTRY FOR OCTAL NUMBERS
MOVEI R,10
EXCH 16,-1(SP)
MOVE N,T1
CALL RADOUG
EXCH 16,-1(SP)
RETURN
PROC RADOUG
IDIV N,R
UNLJMP <JUMPE N,>,
< HRLM REM,(SP)
CALL RADOUG
HLRZ REM,(SP) >
ADDI REM,"0"
CALL (16)
RETURN
PROC DECOUT
PUSH SP, [[ OUTCHR T3
RETURN ]]
CALL DECOUG
ADJSP SP,-1
RETURN
PROC OCTOUT
PUSH SP, [[ OUTCHR T3
RETURN ]]
CALL OCTOUG
ADJSP SP,-1
RETURN
PROC DECIP ; READS FROM CHANNEL WHOSE NO. IS IN S1 AND BCB IN S2.
; IF EOF IS DETECTED, CH WILL BE SET TO 0 AND THE
; EOF FLAG (BIT 0 OF F) SET.
PUSH SP, [[ CALL GETCH
RETURN ]]
CALL DECIG
ADJSP SP,-1
RETURN
PROC DECIG ; READS A POSITIVE INTEGER INTO AC, STARTING WITH THE CHARACTER
; ALREADY IN CH.
; SETS N=0 IF NO NUMBER READ, OTHERWISE N=1.
; R IS A WORK REGISTER.
; IF NUMBER TOO LARGE THE MOST SIGNIFICANT BITS ARE LOST
; ON ENTRY THE ADDRESS OF A ROUTINE TO GET A CHAR INTO
; CH MUST BE ON TOP OF STACK. (THIS ROUTINE MUST NOT
; CORRUPT ANY REGISTERS).
SKIPA REM,[12]
PROC OCTIG ; ENTRY POINT FOR OCTAL NUMBERS
MOVEI REM,10
SETZ AC,
SETZ N,
EXCH 16,-1(SP)
DO
< CAIL CH,"0"
CAIL CH,"0"(REM)
JRST [ EXCH 16,-1(SP)
RETURN ]
SETO N,
IMUL AC,REM
ADDI AC,-"0"(CH)
CALL (16)
JRST >
PROC DECIN
PUSH SP, [[ INCHWL CH
RETURN ]]
CALL DECIG
ADJSP SP,-1
RETURN
PROC DECN
PUSH SP, [[ INCHRW CH
RETURN ]]
CALL DECIG
ADJSP SP,-1
RETURN
PROC RD6NAG ; ROUTINE TO READ A NAME (LETTERS AND DIGITS ONLY)
; STARTING WITH THE CHAR IN CH, INTO AC IN
; SIXBIT FORM. ALL LETTERS UP TO A NON-VALID ARE READ
; BUT NO MORE THAN 6 ARE PUT INTO AC.
; LOWER CASE LETTERS ARE CONVERTED TO UPPER CASE.
; REQUIRES WORK REGISTER T2
; REQUIRES ADR OF A RTN TO GET A CHAR
; INTO CH, ON TOP OF STACK.
EXCH 16,-1(SP)
MOVE T2,[POINT 6,AC]
SETZ AC,
DO
< CAIL CH,"0"
CAILE CH,"z" ; LOWER CASE z
JRST RD6RET ; NOT BETWEEN "0" AND LOWER CASE z
CAIL CH,"a" ; LOWER CASE a
TRZ CH,40 ; LOWER CASE - UPPER CASIFY IT
WHENSK <CAIG CH,"9">,
< CAIL CH,"A"
CAILE CH,"Z"
JRST RD6RET >
; WE HAVE A LETTER OR DIGIT IN CH
SUBI CH,40 ; CONVERT ASCII 7-BIT TO SIXBIT
TRNN AC,77 ; SKIP IF RIGHTMOST 6 BITS IN AC ALREADY SET
IDPB CH,T2
CALL (16)
JRST >
RD6RET: EXCH 16,-1(SP)
RETURN
PROC RD6NAM
PUSH SP, [[ INCHWL CH
RETURN ]]
CALL RD6NAG
ADJSP SP,-1
RETURN
PROC WR6BIT ; ROUTINE TO WRITE THE SIXBIT WORD IN AC.
; DOES NOT WRITE TRAILING BLANKS BUT WRITES A SINGLE
; BLANK IF WHOLE WORD IS BLANK.
; USES T2 AND T3 AS WORK REGISTERS
; (DOES NOT CORRUPT AC).
MOVE T3,AC
DO
< SETZ T2,
LSHC T2,6
ADDI T2,40 ; CONVERT TO ASCII 7-BIT
OUTCHR T2
JUMPN T3, >
RETURN
PROC WR6BIG ; AS WR6BIT BUT REQUIRES ADR OF A RTN TO WRITE CHAR
; IN T3, ON STACK.
EXCH 16,-1(SP)
MOVE T4,T1
DO
< SETZ T3,
LSHC T3,6
ADDI T3,40 ; CONVERT TO ASCII 7-BIT
CALL (16)
JUMPN T4, >
EXCH 16,-1(SP)
RETURN
PROC GETLFE ; SKIPS TO LF OR ESC CHARACTER
; ARGS: IO: CH
DO
< CAIE CH,12
CAIN CH,33
RETURN
INCHWL CH
JRST >
PROC GETCH ; ARGS: IN: S1,S2 OUT:CH
; PRESERVES ALL T REGISTERS
; ROUTINE TO READ A CHARACTER FROM CHANNEL WHOSE NO. IS
; IN S1. S2 CONTAINS ADDRESS OF BUFFER CONTROL BLOCK.
; EOF FLAG IS SET IF END-OF-FILE (AND CH SET TO 0)
; (ON ENTRY, 1(S2) POINTS TO LAST CHAR IN BUFFER READ, 2(S2) IS
; NO. OF CHARS REMAINING + 1)
WHENSK <SOSLE 2(S2)>,
< PUSH SP,T1
PUSH SP,T2
MOVE T1,S1
LSH T1,^D23
MOVE T2,[IN]
ADD T2,T1 ; PUT CHANNEL NO. INTO INSTR.
XCT T2 ; "IN" INSTR.
JRST [ POP SP,T2 ; NORMAL RETURN
POP SP,T1
JRST INOK ]
ADD T1, [GETSTS 0,T1] ; ERROR RETURN
XCT T1 ; GETSTS C,T1
TXNN T1,IO.EOF ; END-OF-FILE?
JRST [ MSGN <?Error in reading buffer, file status is > ; NO
CALL OCTOUT ; CORRUPTS T REGS BUT WE ARE GOING TO EXIT
EXIT ]
TXO F,EOF ; SET END-OF-FILE FLAG
SETZ CH,
POP SP,T2
POP SP,T1
RETURN >
INOK: ILDB CH,1(S2)
TXZ F,EOF
RETURN
SALL
END PHI