Trailing-Edge
-
PDP-10 Archives
-
BB-Y390U-BM
-
lngsrc/glxtxt.mac
There are 27 other files named glxtxt.mac in the archive. Click here to see a list.
TITLE GLXTXT -- Formatted Text Handler for GLXLIB
SUBTTL Irwin L. Goverman/ILG/CER/MLB/DC/PJT/WLH 1-Jan-82
;
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;GET AT GALAXY LIBRARY SYMBOLS
PROLOG(GLXTXT,TXT) ;PRODUCE PROLOG CODE
TXTEDT==70 ;MODULE EDIT LEVEL
ENTRY T%INIT ;INITIALIZATION
ENTRY T%TEXT ;$TEXT ENTRY POINT
ENTRY T%TTY ;DEFAULT TERMINAL OUTPUT
GLOB <IIB> ;IIB is external
GLOB <CNTDT> ;CNTDT is external
TOPS10< GLOB <CNVNOD>> ;CNVNOD is external
; This file contains the support code for the $TEXT macro, which
; is responsible for formatting all static string and variable type
; output. For a more detailed explanation of the $TEXT macro, please
; refer to the GLXMAC and GLXLIB modules.
; This module differs from most members of the GLXLIB family in two respects.
; First, it is called via a pseudo instruction, $TEXT, rather than
; via the usual S1/S2 accumulator calls. Secondly, all ACs are preserved
; across calls, which are skippable.
; The user of the $TEXT instruction must provide one or several output routines.
; This routine must conform to the standard GLXLIB conventions.
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR GLXTXT
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. Revision History.......................................... 3
; 3. Local Macros.............................................. 4
; 4. Global storage............................................ 5
; 5. T%INIT - Initialize the TEXT module....................... 6
; 6. T%TEXT - Routine to format text output.................... 7
; 7. T%TTY - Buffered terminal output routine................. 9
; 8. PROBLK - Process an entire T%TEXT argument block.......... 10
; 9. PROARG - Routine to process each T%TEXT argument.......... 11
; 10. PROTXT -- ROUTINE TO PROCESS THE ACTUAL FUNCTION.......... 12
; 11. PTAB - Dispatch table for argument processors........... 13
; 12. PROx - Processors for each type of formatting........... 14
; 13. PROT - Process a string of ASCIZ text................... 15
; 14. PRO3 - Process a an ASCIZ string created by $TEXT....... 15
; 15. PROQ - Process a byte pointer to an ASCIZ string........ 16
; 16. PROB - Process a GLXLIB object block.................... 17
; 17. PRO1 - Process an object type........................... 18
; 18. PRON - Process a node specification..................... 18
; 19. PROO - Process unsigned octal numbers................... 19
; 20. PROD - Process a signed decimal number.................. 19
; 21. PROF - Process a system dependent file specification... 20
; 22. PRO7 - Process a single 7 bit ASCII character........... 21
; 23. PRO6 - Process a single 6 bit ASCII character........... 21
; 24. PRO5 - Process ASCIZ single word........................ 21
; 25. PROW - Process a SIXBIT word............................ 21
; 26. PROP - Process a directory ID of either PPN or directory NUMBER 22
; 27. PROU - Process a user ID or either PPN or User number... 22
; 28. PROR - Process routine for Job Info Block............... 23
; 29. PROE - Process a GLXLIB error number.................... 25
; 30. PROI - Process an indirect text request................. 26
; 31. PROV - Process a program version number................. 27
; 32. PROM - Process a request for a CONTROL-M (Carriage Ret.) 28
; 33. PROJ - Process a request for a CONTROL-J (Line Feed).... 28
; 34. PROL - Process a request for a CONTROL-L (Form Feed).... 28
; 35. PROK - Process a request for a CONTROL-K (Vertical Tab). 28
; 36. PRO2 - Process a request for up-arrow................... 28
; 37. PROA - Process a request to supress free <CR-LF>........ 28
; 38. PRO0 - Process a request to put null (0) at end of line. 28
; 39. FETCH - Routine to get a word from caller's address space 29
; 40. SPACES - Routine to provide any padding requested......... 30
; 41. Local output routines..................................... 31
; 42. PUTU -- Output user name or PPN........................... 35
; 43. SAVLVL-RSTLVL - Save and restore TEXT levels.............. 36
SUBTTL Revision History
COMMENT \
Edit SPR/GCO Explanation
---- ------- ---------------------------------------------
0001 First attempt
0002 Convert to new OTS format
0003 Make multiple levels work
0004 Add PRO2 and PROQ
0005 Add PROB and PRO1
0006 G013 Add PRON/PUTN
0007 G014 FIX BUG IN ^I OF SPACING CAUSING SPACING TO
HAPPEN TWICE.
0010 FIX BUG WHICH DID NOT ALLOW THE
FIRST PARAMETER IN $TEXT MACRO TO USE
INDIRECT AND INDEXED ADDRESSING. THIS MOD NEEDS
ONLY TO JFCL 1 INSTRUCTION IN X.
0011 CHANGE T%INIT TO USE IIB SET UP BE I%INI1
0012 Add ^R for Job Info blocks and isolate PUTU for
Displaying User Info.
0013 Add STOPCODE IJU for Bad User Info in JIB (^R)
0014 Change ^R Display
0015 Convert to use I%JINF Routines
0016 Fix ^R on -10 with 0 second name word
0017 Fix ^N to Handle SIXBIT on the -10
0020 Make IQN $STOP give bad index, addr of error
0021 Make BTA $STOP give a hint of where we went south
0022 Removed usage of PJUMPE opdef
0023 Have ^E on the -20 accept 20 error codes and expand
them. Those are codes greater than 600000
0024 Allow Indexing and Indirect references for ^Q
0025 Generate Stopcode on invalid ^E function value
0026 Generate asciz pointer for ^Q if size and
position weren't set in fetched pointer.
(i.e. allow ^Q/KEYTAB(S1),LHMASK/)
0027 Change ^E to get dynamic buffer area and have -2
represent the last TOPS20 error.
0030 Fix -10 ^B to Check Node name and Number to decide
if at same node
0031 Modify PROB (Object Block Processor) so that if the
object type is .OTMNT then the unit is put out as a
sixbit value.
0032 Output Date/Time internally instead of using ODTIM.
0033 Convert CNTDT to accept and return arguments in S1 and
S2
0034 Change PUTU so that if the DIRST fails (-20 only),
we will put out 'User Unknown' instead of stopcode'ing
0035 Fix a bug. Initialize LINPTR in $TEXT init code.
0036 Save and restore CAFLG around call to
process qualifier.
0037 Move CNTDT to GLXSCN along with CNVDT
0040 Fix a bug in T%TEXT so that default IB routine
is used if caller doesn't specify one.
0041 Call CNVNOD to do node conversions
0042 Zero out our own $DATA space on init call
because GLXINT no longer does it.
0043 Don't print null paths (as in [10,3572,,,,,])
0044 Better fix to path printer (prevents [10,3572,A,B,,,])
0045 Missing PORTAL.
0046 Clean up messy TOPS-10 user name output in ^R display.
0047 Prevent race where AC 'P' may not have a good PDL
pointer and we get an interrupt. Turn off the PSI
system before doing effective address calculation
and turn it back on when we're done.
0050 16-Nov-81 Comment out the code for the PSI system being turned
on and off and leave it to the discretion of each
sight wether to turn it on and incurr the overhead.
0051 G1216 Edit 34 prints 'User unknown' when DIRST JSYS fails.
Likewise for the -10, if the PPN is zero type 'PPN
unknown'.
0052 4.2.1551 Edit 50 doesn't make it. Go back to disabling
interrupt when evaluating arguments with P set funny.
But be clever and check first to see if indirect or
indexed info is included in argument and skip the
whole thing if not.
0053 4.2.1580 Add 500 milliseconds to the time returned by CNTDT
to give the correct time when showing the status of
a print or batch job submitted with the /AFTER switch
using absolute time.
0054 Routine CLCFCT is too complicated and PROH.1 is not
need to output the date and time. Use ODTIM JSYS.
Related to QAR 838243. GCO 5.1218, 5.1221. Edit 62,63
of version 5. This edit supersedes version 4.2 edit 53.
70 Increase version 4.2 maintenance edit number to correspond with version
5 maintenance edit number.
\ ;End of Revision History
SUBTTL Local Macros
; These macros are pseudo instructions, and as such they
; preserve all registers and are skippable.
; Define a local macro for printing single characters
DEFINE $PUT7(CHAR)<
PUSHJ P,PUT7X ;;CHARACTER OUTPUT ROUTINE
XLIST ;;NO NEED TO LIST
JUMP "CHAR" ;;NO-OP + CHARACTER
LIST
> ;END OF $PUT7 DEFINITION
; DEFINE A LOCAL MACRO FOR PRINTING STRINGS
DEFINE $PUTT(STRING)<
PUSHJ P,PUTTX
XLIST
JUMP [ASCIZ \STRING\]
LIST
> ;END OF $PUTT DEFINITION
SYSPRM TTXBFS,2,^D10 ;TEMPORARY TEXT BUFFER SIZE
ND LINSIZ,^D20 ;SIZE OF DEFAULT OUTPUT LINE
ND EBFSZ,^D20 ;SIZE OF BUFFER AREA
SUBTTL Global storage
;Global storage
$DATA TXTBEG,0 ;BEGINNING OF ZEROABLE $DATA SPACE
$GDATA TXTLVL ;LEVEL WE ARE AT
;Local storage
$DATA DEFERR ;DEFAULT ERROR EXIT ADDRESS FROM IB.
$DATA DEFOUT ;DEFAULT OUTPUT ROUTINE FROM IB
$DATA FSAVE,0 ;FIRST LOCATION TO SAVE AT EACH LEVEL
$DATA LINBUF,LINSIZ ;LINE BUFFER
LINMAX==<<LINSIZ>*^D5>-1 ;MAXIMUM CHARACTER COUNT
$DATA ARGADR ;ADDRESS OF CALLER'S ARG LIST
$DATA USRACS,20 ;USER-CONTEXT ACS
$DATA USROUT ;ADDRESS OF CALLING OUTPUT RTN.
$DATA USRARG ;ADDRESS OF USER ARGUMENTS
$DATA NXTARG ;POINTS TO NEXT ARGUMENT
$DATA MAXARG ;NUMBER OF ARGUMENTS SPECIFIED
$DATA USRRET ;FIRST WORD AFTER $TEXT ARG BLOCK
TOPS20< $DATA ERRBUF> ;ERROR BUFFER AREA
$DATA CAPNTR ;BYTE POINTER FOR PR03 PROCESSING
$DATA CALOC ;CURRENT ARGUMENT EFFECTIVE ADDRESS
$DATA CAFLG ;CURRENT ARGUMENTS FLAGS
$DATA CAPTR ;POINTER WORD FOR CURRENT ARG (IF ANY)
$DATA CACCTR ;NUMBER OF CHARACTERS IN CURRENT ARGUMENT
$DATA CACMAX ;MAXIMUM CHARACTERS FIELD MAY BE
$DATA ENDFLG ;-1=NOTHING,0=CR-LF,+1=NULL AT END
$DATA NOOUTP ;-1 WHEN ACTUAL OUTPUT IS SUPRESSED
$DATA ERREXT ;A USER EXIT ROUTINE HAS RETURNED FALSE.
$DATA TTXBUF,TTXBFS ;PLACE TO BUILD TEMPORARY STRINGS
$DATA LINCTR ;COUNTER FOR CURRENT LINE
$DATA LINPTR ;POINTER TO CURRENT LINE
$DATA TMFCTR ;TIME ADJUSTMENT FACTOR
$DATA DSTCHG ;TIME FACTOR IS BASED ON
$DATA LSAVE,0 ;LAST LOCATION TO SAVE
IF1,<SSAREA==<LSAVE-FSAVE-1>> ;SIZE OF THE SAVE AREA
$DATA SAREA,SSAREA ;PLACE TO SAVE EACH LEVEL
$DATA TXTEND,0 ;END OF ZEROABLE $DATA SPACE
SUBTTL T%INIT - Initialize the TEXT module
;This routine puts the TEXT module into a known state and
; stores the user specified default output routine
;CALL IS: IIB setup by I%INI1 in GLXINI
;
;TRUE RETURN: Always
T%INIT: MOVE S1,[TXTBEG,,TXTBEG+1] ;BLT PTR TO BEGINNING OF $DATA SPACE
SETZM TXTBEG ;KILL THE FIRST WORD
BLT S1,TXTEND-1 ;NOW KILL THE REST
SKIPN S1,IIB+IB.OUT ;PICKUP DEFAULT OUTPUT ROUTINE
MOVEI S1,T%TTY ;NONE SPECIFIED..USE OUR DEFAULT
MOVEM S1,DEFOUT ;SAVE IT FOR LATER
MOVE S1,IIB+IB.ERR ;GET USER ERROR EXIT ROUTINE
MOVEM S1,DEFERR ;SAVE IT FOR LATER.
SETOM TXTLVL ;INITIALIZE THE COUNT OF LEVELS
;**[54]At T%INIT:+9L replace 24 lines with 1 line. Delete CLCFCT. JYCW 6/27/85
$RETT ;[54]Return
SUBTTL T%TEXT - Routine to format text output
;Calls to T%TEXT come only through invokation of the $TEXT
; macro, described in GLXMAC.
; Call is: Pushdown list top entry points to start of argument block-1,
; which is a JRST around an argument block, formatted as follows:
;
; PUSHJ P,T%TEXT ;CALL
; JRST %L1 ;JUMP AROUND CALL
; OUTPUT ROUTINE OR B.P. ;ADDR OF CHAR OUTPUT ROUTINE OR -1,,ADDR (BP)
; FLAGS+<QUAL.#>+ADDRESS ;DESCRIPTION AND ADDRESS OF ARG
; BYTE POINTER FOR ARG ;ONLY IF A BYTE POINTER IS NEEDED
; SPACING INFORMATION ;ONLY IF SPACING INFORMATION IS NEEDED
; .... ;MORE ARGUMENT SINGLETS,PAIRS OR TRIPLETS
; %L1:
;Where: Flags tell us whether qualifier takes any argument
; and whether position and spacing words are present.
; The spacing information is: "CHAR"B6+<SIDE>B17+<Number of positions>B35
;
; Return: Return is to the location after the PUSHJ to T%TEXT, which
; is the JRST around the arg block. This makes $TEXT skippable.
T%TEXT: AOSE TXTLVL ;INCREMENT LEVEL COUNT
PUSHJ P,SAVLVL ;SAVE LEVEL IF NOT FIRST
MOVEM 0,USRACS ;STORE FIRST AC
MOVE 0,[XWD 1,USRACS+1] ;TRANSFER USER ACS TO THE
BLT 0,USRACS+17 ;SAVE AREA
SOS USRACS+P ;ADJUST SHADOW VERSION OF "P"
SETZM ENDFLG ;ASSUME WANTS CR-LF AT END
SETZM ERREXT ;NO USER EXIT ERROR.
SETZM NOOUTP ;NOT SUPRESSING OUTPUT
SETOM LINCTR ;FLAG THAT BUFFER IS NOT IN USE
MOVE S1,[POINT 7,LINBUF] ;GET POINTER TO TTY OUTPUT BUFFER
MOVEM S1,LINPTR ;AND SAVE IT
HRRZ S1,0(P) ;Get return address
HLRZ TF,0(S1) ;Get return instruction
CAIN TF,(JUMP) ;New style call?
JRST TEXT.2 ;Yes..Process it
MOVE TF,1(S1) ;GET THE USER ROUTINE ADDRESS INSTR.
MOVE S1,USRACS+S1 ;RESTORE S1 TO ORIGIONAL VALUE.
XCT 0 ;GET THE USER REUTINE/BYTE PTR ADDR.
HRRZ S1,0(P) ;RE-GET THE ADDRESS CALLED FROM.
HRRZ S2,0(S1) ;GET FIRST WORD PAST ARGUMENT BLOCK
MOVEM S2,USRRET ;REMEMBER WHERE IT IS
SKIPN S2,0 ;FETCH USER OUTPUT ROUTINE ADDRESS
MOVE S2,DEFOUT ;IF NONE SPECIFIED, USE DEFAULT
SKIPN S2 ;HAVE WE GOT ONE SOME WAY?
MOVEI S2,T%TTY ;NO, MUST NOT BE INITED YET
JUMPG S2,TEXT.1 ;HAVE WE GOT A DEFAULT BYTE POINTER?
HRLI S2,(POINT 7,0) ;MAKE IT A BYTE POINTER.
MOVEM S2,LINPTR ;AND STORE POINTER
MOVEI S2,TDPB ;GET ADDR OF ROUTINE TO USE THE POINTER
TEXT.1: MOVEM S2,USROUT ;STORE IT AWAY FOR LATER
ADDI S1,2 ;COMPUTE THE START OF PARAMETER BLOCK
MOVEM S1,ARGADR ;REMEMBER IT
TEXT.3: PUSHJ P,PROBLK ;PROCESS THE ARGUMENT BLOCK
PUSHJ P,PEND ;GIVE PROPER ENDING TO STRING
SKIPL LINCTR ;IF WE USED DEFAULT ROUTINE,
PUSHJ P,TDMP ;DUMP BUFFER NOW
MOVE 0,[XWD USRACS+1,1] ;RESTORE USER ACS
BLT 0,16 ;EXCEPT FOR PDL POINTER
MOVE 0,USRACS ;RESTORE AC USED FOR BLT
SOSL TXTLVL ;DECREMENT COUNT, IF NOT
PUSHJ P,RSTLVL ;AT PRIMARY, RESTORE THE LEVEL
SKIPE ERREXT ;DO WE TAKE THE ERROR EXIT ???
SKIPN DEFERR ;IS THE ROUTINE ADDRESS THERE ???
SKIPA ;NO,,JUST RETURN NORMALLY.
JRST @DEFERR ;YES,,DO IT.
POPJ P, ;RETURN WITHOUT AFFECTING TF
;This calling convention is extensible and superceeds the previous
;calling sequence.
;Thus $TEXT(RTN,<STRING>,<ARGS>) would produce the following call:
; $CALL T%TEXT
; JUMP [XWD 2,0 ;Length of header
; EXP <RTN> ;Text output routine or pointer
; ITEXT(<STRING>,<ARGS>)];Start of ITEXT arguments
TEXT.2: HRRZ S1,0(S1) ;Get address of argument list
HLRZ TF,(S1) ;Get the header count
ADDI TF,(S1) ;Get ITEXT address
MOVEM TF,ARGADR ; and save it
SETZM USRRET ;Clear return address
MOVE TF,1(S1) ;Get calling TOR or pointer
TLC TF,777777 ;MAKE -1 INTO A WORD POINTER
TLCN TF,777777
HRLI TF,(POINT 7)
;**;[52] Insert 5 lines at TEXT.2 + 9L. DEK 8-SEP-83
TXNN TF,<@(17)> ;[52]Check for index or indirect
JRST TEXT.4 ;[52]None, no need to resolve
PUSH P,TF ;[52]Save pointer for a min.
$CALL I%IOFF## ;[52]Disable interrupts
POP P,TF ;[52]Get the pointer back
MOVE S1,USRACS+S1 ;RESTORE USERS S1
EXCH P,USRACS+P ; AND STACK POINTER
HRRI TF,@TF ;REMOVE INDEXING AND INDIRECTION
EXCH P,USRACS+P ;RESTORE OUR POINTER
TLZ TF,(@(17)) ;CLEAR THE BITS
;**;[52] Insert 3 lines and add a label at TEXT.2 + 14L. DEK 8-SEP-83
PUSH P,TF ;[52]Save pointer for a min.
$CALL I%ION## ;[52]Enable interrupts
POP P,TF ;[52]Get the pointer back
TEXT.4: TLNE TF,777777 ;[52]IS THIS A POINTER?
JRST [MOVEM TF,LINPTR ;YES..SAVE IT
MOVEI TF,TDPB ;GET POINTER ROUTINE ADDRESS
JRST .+1] ;AND SAVE THAT
SKIPN TF ;Do we have a routine?
MOVE TF,DEFOUT ;No..use the default
MOVEM TF,USROUT ;SAVE ROUTINE ADDRESS
JRST TEXT.3 ;Back to process arguments
SUBTTL T%TTY - Buffered terminal output routine
;If a $TEXT instruction has a blank first argument, then the
; default output routine is used. This routine is identified
; in the Initialization Block.
;T%TTY is a default output routine which buffers output to
; the terminal controlling this job.
; Call is: S1/ contains 1 character, 7 bit, right justified
;
; Return: TRUE always
T%TTY: SOSGE LINCTR ;ROOM IN THE BUFFER?
JRST [ PUSHJ P,TDMP ;NO, DUMP THE BUFFER
JRST T%TTY ] ;AND RETRY
JUMPE S1,.RETT ;IF NULL CHARACTER, RETURN NOW
IDPB S1,LINPTR ;DEPOSIT THE CHARACTER
$RETT ;ALWAYS RETURN TRUE
TDMP: PUSH P,S1 ;SAVE CHARACTER
MOVEI S1,0 ;GET NULL CHARACTER
IDPB S1,LINPTR ;STORE TERMINATING NULL INTO BUFFER
MOVE S1,[POINT 7,LINBUF] ;GET BUFFER POINTER
MOVEM S1,LINPTR ;STORE IT
SKIPE LINBUF ;IF NULL BUFFER, SKIP IT
PUSHJ P,K%SOUT ;ELSE PRINT IT
SETZM LINBUF ;CLEAR FIRST WORD OF BUFFER
MOVEI S1,LINMAX ;RESET THE BUFFER COUNTER
MOVEM S1,LINCTR ;TO ITS MAXIMUM
POP P,S1 ;RESTORE THE CHARACTER
$RETT ;AND RETURN
TDPB: IDPB S1,LINPTR ;STORE WHERE CALLER SPECIFIED
$RETT ;AND RETURN
SUBTTL PROBLK - Process an entire T%TEXT argument block
;PROBLK is used to process a list of T%TEXT arguments. The
; lower level routine, PROARG, is called to process each
; argument and errors are checked for.
; Call: ARGADR/ Address of start of argument block
;
; Return: Always TRUE
PROBLK: SETZM USRARG ;ASSUME NO ARGUMENTS BLOCK
SETZM MAXARG ;ZERO THE COUNT
SETZM NXTARG ;CLEAR POINTER TO NEXT ARGUMENT
MOVE S1,ARGADR ;GET ADDRESS OF ITEXT BLOCK
LOAD S2,0(S1),TXT.FN ;GET THE FUNCTION
CAIE S2,0 ;IS ARGUMENT BLOCK PRESENT?
JRST PROBL1 ;NO..PROCESS NORMALLY
MOVEM S1,USRARG ;SAVE ADDRESS OF ARGUMENTS
HLRZ S2,0(S1) ;YES..GET HEADER LENGTH
ADD S2,S1 ;COMPUTE START OF ITEXT
MOVEM S2,ARGADR ;AND SAVE THAT
SUBI S2,1 ;COMPUTE MAXIMUM ARG ADDRESS
MOVEM S2,MAXARG ;SAVE MAXIMUM ARGUMENT ADDRESS
ADDI S1,1 ;COMPUTE NEXT ARGUMENT ADDRESS
MOVEM S1,NXTARG
PROBL1: MOVE S1,ARGADR ;GET ADDRESS OF CURRENT ARGUMENT WORD
CAME S1,USRRET ;ARE WE PAST THE END?
SKIPN 0(S1) ; OR INTO ZERO WORD (ITEXT BLOCK END)?
$RETT ;YES, SO RETURN NOW TO CALLER
PUSHJ P,PROARG ;PROCESS THE ARGUMENT POINTED TO
JUMPT PROBL1 ;IF OK, DON'T STOP NOW
$STOP(BTA,<Bad $TEXT argument given at address ^O/ARGADR/>)
SUBTTL PROARG - Routine to process each T%TEXT argument
;PROARG is responsible for setting up argument specific data
; areas for the processing routines and adjusting ARGADR.
; CALL IS: NO ARGUMENTS
;
; RETURN: TRUE IF NO BAD ARGUMENTS DETECTED
; FALSE IF SOMETHING IS WRONG
;
PROARG: SETZM CACCTR ;CLEAR JUSTIFICATION COUNTER
SETZM CALOC ;CLEAR LOCATION WORD
MOVE S1,@ARGADR ;GET CONTENTS OF FIRST ARG WORD
TXNN S1,TXT.AD ;IS ADDRESS WORD PRESENT?
JRST PARG.1 ;NO..PROCESS OLD BLOCK
MOVEM S1,CAFLG ;YES..PROCESS 2 WORD BLOCK
AOS S1,ARGADR
MOVE S1,@ARGADR ;GET POINTER TO ARGUMENT
STORE S1,CALOC,TXT.EA ;SAVE EFFECTIVE ADDRESS
ANDX S1,TXT.PT ;MASK POINTER PORTION
MOVEM S1,CAPTR ;SAVE IT
JRST PARG.3 ;GO FINISH UP
PARG.1: STORE S1,CALOC,TXT.EA ;SAVE EFFECTIVE ADDRESS
TXZ S1,TXT.EA ;CLEAR IT
MOVEM S1,CAFLG ;SAVE THE FLAGS
SETZM CAPTR ;CLEAR POINTER WORD
MOVEI T1,@ARGADR ;Get address of this arg, for $STOP
LOAD S1,CAFLG,TXT.P ;IS THIS A TWO WORD TYPE OF ARG?
JUMPE S1,PARG.2 ;NO, SO ADJUST BY ONLY ONE WORD
AOS S1,ARGADR ;ELSE ADJUST FOR THE SECOND WORD NOW
MOVE S1,0(S1) ;GET THE BYTE POINTER WORD
MOVEM S1,CAPTR ;AND STORE FOR LATER
PARG.2: LOAD S1,CAFLG,TXT.S ;IS THERE A SPACING WORD?
JUMPE S1,PARG.3 ;NO, DONT PROCESS IT
AOS S1,ARGADR ;GET THE ADDRESS OF SPACING WORD
MOVE S1,0(S1) ;GET THE SPACING WORD
LOAD S2,S1,TXT.SC ;YES..GET THE FILL CHARACTER
STORE S2,CAFLG,TXT.FC
LOAD S2,S1,TXT.SS ;GET JUSTIFICATION CODE
STORE S2,CAFLG,TXT.JU
LOAD S2,S1,TXT.SP ;GET WIDTH
STORE S2,CAFLG,TXT.WD
PARG.3: AOS ARGADR ;ADJUST CURRENT ADDRESS
MOVE S1,CALOC ;GET ADDRESS
TXNN S1,<@(17)> ;INDEXING OR INDIRECT
JRST PARG.4 ;NO..THEN SKIP THIS
;**;[52] Change 1 line at PARG.3 + 4L. DEK 8-SEP-83
$CALL I%IOFF## ;[52]Disable interrupts
MOVE 0,[XWD USRACS+1,1] ;RESTORE THE ACS
BLT 0,16 ;THAT WE MAY RESEMBLE
MOVE 0,USRACS ;THE USER'S CONTEXT
EXCH P,USRACS+P ;SET UP PUSHDOWN LIST TOO
MOVEI S1,@CALOC ;CALCULATE EFFECTIVE ADDRESS
MOVEM S1,CALOC ;STORE ACTUAL ADDRESS
EXCH P,USRACS+P ;RESTORE STACK POINTER
;**;[52] Change 1 line at PARG.3 + 11L. DEK 8-SEP-83
$CALL I%ION## ;[52]Enable interrupts
PARG.4: PJRST PROTXT ;PROCESS THE TEXT
SUBTTL PROTXT -- ROUTINE TO PROCESS THE ACTUAL FUNCTION
PROTXT: LOAD S1,CAFLG,TXT.FN ;GET THE QUALIFIER INDEX ALONE
CAILE S1,0 ;IF OUT OF RANGE,
CAIL S1,PTABL ;
$STOP(IQN,Illegal qualifier number ^O/S1/ at ^O/ARGADR/)
LOAD T1,CAFLG,TXT.WD ;GET SPACING POSITIONS
MOVEM T1,CACMAX ;STORE AS MAXIMUM CHARS IN FIELD
LOAD S2,CAFLG,TXT.JU ;AND GET SIDE CODE
CAXE T1,0 ;IF NO SPACING,
CAXN S2,.TXTJL ;OR LEFT JUSTIFYING ONLY
JRST PROTX1 ;THEN JUST DO THE OUTPUT
SETOM NOOUTP ;SUPRESS THE OUTPUT,
PUSHJ P,@PTAB(S1) ;THEN, CALL THE PROCESSOR
SETZM NOOUTP ;CLEAR THE SUPRESS FLAG
PUSHJ P,SPACES ;GIVE ANY PADDING NECESSARY,
LOAD S1,CAFLG,TXT.FN ;GET QUALIFIER NUMBER AGAIN
PROTX1: PUSHJ P,@PTAB(S1) ;DO THE OUTPUT
LOAD S1,CAFLG,TXT.WD ;GET SPACING POSITIONS
LOAD S2,CAFLG,TXT.JU ;AND SIDE CODE
CAXE S1,0 ;IF NOT SPACING,
CAXN S2,.TXTJR ; OR RIGHT JUSTIFYING,
$RETT ;JUST RETURN
PUSHJ P,SPACES ;GIVE ANY SPACES NEEDED
$RETT
SUBTTL PTAB - Dispatch table for argument processors
; Note well: Any changes in the order or contents of the TQUALS
; macro in GLXMAC should be reflected by recompilation and/or
; code changes in GLXTXT.
; Define processor table creation mechanism
DEFINE TQ(CHR,ARGS,TYP,PROC) <EXP PRO'CHR>
PTAB: PJRST .RETF ;FILL IN THE 0 (UNUSED) ENTRY
TQUALS ;AND THEN THE REST OF THE TABLE
PTABL==.-PTAB
DEFINE TQ(CHR,ARGS,TYP,PROC) <XWD ARGS,"CHR">
PTAB2: EXP 0 ;FILL IN THE 0 (UNUSED) ENTRY
TQUALS ;AND THEN THE REST OF THE TABLE
SUBTTL PROx - Processors for each type of formatting
;The following are the separate processors for each type of
; ASCII formatting that we might have to do. Most are system
; independent, a couple are not. for all intents and
; purposes, these are the top level routines, and they have
; access to all AC's etc.
;Several locations are set up for these routines to use:
; CALOC is the effective address of the current argument
; or 0 (which will be unused) for TXT.NA (argument-less) qualifers
; CAFLG is the flag word for this argument
; CAPTR is the optional pointer word, used to get only a byte from the
; word containing the argument.
; ARGADR points to the word immediately following this argument in the list
; USRACS contain registers 0-17 inclusive of the caller's ACS
; USRRET contains the address of the first word not part of this $TEXT's
; argument block. It is used to calculate the end of the T%TEXT arg block.
;USROUT contains the address of the user routine for
; outputting each byte The supplied routine takes its byte as
; 7 bit ASCII, right justified in AC S1, and returns either
; TRUE or FALSE. A return of FALSE will cause a STOP CODE to
; occur. The output routine supplied may destroy both S1 and
; S2, but must preserve all other registers.
;Each of the following routines is named 'PROx' where x is
; the letter or digit corresponding to the $TEXT qualifier
; that follows the '^' (up-arrow) to indicate that this type
; of output is wanted.
SUBTTL PROT - Process a string of ASCIZ text
;Since a user created string could be in the ACs or be a field or
; something odd like that, we process it one word at at a time if we
; have to. If we do not, then we go to PRO3 which is faster.
PROT: MOVE P1,CALOC ;GET LOCATION OF STRING
MOVEI P2,0 ;FAKE EXHAUSTED COUNT
SKIPN CAPTR ;IS THIS A FIELD ONLY?
CAIGE P1,20 ;OR IN THE ACS?
SOSA P1 ;YES, BACK ADDR OF ONE FOR LOOP, USE WORD BY WORD
JRST PRO3 ;ELSE DO AS PURE ASCIZ STRING
PROT.1: SOJGE P2,PROT.2 ;ANY MORE BYTES IN WORD?
AOS S1,P1 ;NO, NEED NEXT WORD
PUSHJ P,FETCH ;SO GET IT
MOVE P3,S1 ;AND MOVE INTO PERMANENT PLACE
MOVE P4,[POINT 7,P3] ;MAKE UP A BYTE POINTER
MOVEI P2,4 ;GET NEW COUNT
PROT.2: ILDB S1,P4 ;GET A BYTE
JUMPE S1,.RETT ;RETURN NOW IF WE GET A NULL
PUSHJ P,PUT7 ;PUT OUT THE BYTE
JRST PROT.1 ;LOOP FOR NEXT BYTE
SUBTTL PRO3 - Process a an ASCIZ string created by $TEXT
;PRO3 is used to process strings created by the $TEXT instruction itself.
; These strings do not have to be processed word by word since
; they are created in a literal.
PRO3: MOVE S1,CALOC ;GET LOCATION STRING STARTS AT
PJRST PUTT ;STORE THE STRING
SUBTTL PROQ - Process a byte pointer to an ASCIZ string
;PROQ is used to process an ASCIZ string which does not start on a word
; boundary. The address fed to the ^Q qualifer is that of a byte
; pointer to the string to be output.
PROQ: PUSHJ P,.SAVE1 ;PRESERVE AN AC
MOVE S1,CALOC ;GET LOCATION OF BYTE POINTER
PUSHJ P,FETCH ;FETCH IT NOW
TLNN S1,777700 ;WAS POINTER SPECIFIED?
TLO S1,(POINT 7,0) ;NO..MAKE STANDARD POINTER
TLC S1,-1
TLCN S1,-1 ;WAS POINTER -1,,X
HRLI S1,(POINT 7,0) ;YES..CREATE BYTE POINTER
PROQ.1: TXNN S1,<@(17)> ;INDIRECT OR INDEXED?
JRST PROQ.3 ;NO..PROCESS IT
LDB S2,[POINT 4,S1,17] ;GET THE INDEX FIELD
JUMPE S2,PROQ.2 ;JUMP IF NO INDEXING
HRRZ S2,USRACS(S2) ;GET THE INDEX VALUE
ADDI S2,(S1) ;DO INDEX CALCULATION
HRR S1,S2 ;STORE NEW EFFECTIVE ADDRESS
TLZ S1,17 ;CLEAR INDEXING
PROQ.2: TXNN S1,<@> ;INDIRECT?
JRST PROQ.3 ;NO..FINISH UP
MOVE P1,S1 ;SAVE THE POINTER
HRRZ S1,S1 ;EXTRACT THE ADDRESS
PUSHJ P,FETCH ;GET THE INDIRECT WORD
LDB S2,[POINT 12,P1,11] ;GET POSITION AND SIZE
DPB S2,[POINT 12,S1,11] ;STORE IN NEW POINTER
JRST PROQ.1 ;PROCESS POINTER
PROQ.3: HRRZ S2,S1 ;GET ADDRESS
CAIGE S2,20 ;POINT TO THE AC'S?
ADDI S2,USRACS ;YES..POINT TO OUR COPY
JRST PUTQ ;OUTPUT IT
SUBTTL PROB - Process a GLXLIB object block
PROB: MOVE P1,CALOC ;GET ARG LOC
MOVEI S1,OBJ.TY(P1) ;GET ADDRESS OF TYPE WORD
PUSHJ P,FETCH ;GET ITS CONTENTS
MOVE T1,S1 ;SAVE THE OBJECT TYPE IN T1
MOVSI P2,-OBJLEN ;MAKE AN AOBJN PTR TO TABLE OF OBJECTS
PROB.1: HLRZ S2,OBJTAB(P2) ;GET OBJECT TYPE FROM TABLE
CAME S2,S1 ;MATCH?
AOBJN P2,PROB.1 ;NO, LOOP
JUMPGE P2,.RETF ;AOBJN EXPIRED, LOSE
HRRZ S1,OBJTAB(P2) ;GET ADDRESS OF APPROPRIATE TEXT
PUSHJ P,PUTT ;AND OUTPUT IT
$PUT7(< >) ;OUTPUT A SPACE
MOVEI S1,OBJ.UN(P1) ;GET ADDRESS OF UNIT NUMBER WORD
PUSHJ P,FETCH ;FETCH IT
CAXN T1,.OTMNT ;IS THIS A TAPE/DISK OBJECT TYPE
JRST [PUSHJ P,PUTW ;YES,,PUT OUT THE UNIT AS SIXBIT
PJRST PROB.2 ] ;AND CONTINUE ON
MOVE P2,S1 ;COPY IT
LOAD S1,P2,OU.LRG ;GET LOW END OF RANGE
PUSHJ P,PUTD ;OUTPUT IT IN DECIMAL
LOAD S1,P2,OU.HRG ;GET HIGH END OF RANGE
JUMPE S1,PROB.2 ;SKIP IF NO HIGH UNIT
$PUT7(<:>) ;OUTPUT RANGE SEPARATOR
PUSHJ P,PUTD ;AND THEN HIGH END OF RANGE
PROB.2: MOVEI S1,OBJ.ND(P1) ;GET ADDRESS OF USER'S NODE WORD
PUSHJ P,FETCH ;GO GET ITS CONTENTS
SKIPN T1,S1 ;SAVE THE SUPPLIED NODE
JRST PROB.4 ;DONT DISPLAY IF NULL
TOPS10< TLNN S1,770000 ;MAKE SURE WE HAVE SIXBIT
$CALL CNVNOD
JUMPF [MOVE S1,T1 ;FAILURE..RESTORE SUPPLIED NODE
JRST PROB.3] ;AND DISPLAY IT
MOVE T1,S1 ;SAVE SIXBIT NODE
> ;End TOPS10
SETOM S1 ;SET FOR MY JOB
MOVX S2,JI.LOC ;GET MY LOCATION
PUSHJ P,I%JINF
JUMPF [MOVE S1,T1 ;RESTORE THE SUPPLIED NODE
JRST PROB.3] ;AND DISPLAY IT
MOVE S1,T1 ;PLACE SIXBIT IN S1
CAMN S2,S1 ;SAME LOCATION?
JRST PROB.4 ;YES..RETURN
PROB.3: PUSH P,S1 ;SAVE THE NODE SPEC
$PUTT(< [>) ;OPENER
POP P,S1 ;RESTORE IT
PUSHJ P,PUTN ;PUT OUT THE NODE NAME
$PUT7(<]>) ;AND CLOSER
PROB.4: $RETT
SUBTTL PRO1 - Process an object type
PRO1: MOVE S1,CALOC ;GET ADDR OF ARGUMENT
PUSHJ P,FETCH ;FETCH IT
MOVSI P1,-OBJLEN ;MAKE AN AOBJN PTR TO TABLE OF OBJECTS
PRO1.1: HLRZ S2,OBJTAB(P1) ;GET OBJECT TYPE FROM TABLE
CAME S2,S1 ;MATCH?
AOBJN P1,PRO1.1 ;NO, LOOP
JUMPGE P1,.RETF ;AOBJN EXPIRED, LOSE
HRRZ S1,OBJTAB(P1) ;GET ADDRESS OF APPROPRIATE TEXT
PJRST PUTT ;AND OUTPUT IT
;Define the X macro so we can generate the table of strings
; for the object types.
DEFINE X(A,B),<
XWD A,[ASCIZ/B/]
>
;Now generate the table of object type strings.
OBJTAB: OBJCTS
OBJLEN==.-OBJTAB
SUBTTL PRON - Process a node specification
PRON: MOVE S1,CALOC ;GET ADDRESS OF ARGUMENT
PUSHJ P,FETCH ;FETCH FROM USER SPACE
PJRST PUTN ;AND PRINT IT OUT
SUBTTL PROO - Process unsigned octal numbers
PROO: MOVE S1,CALOC ;GET ARGUMENT LOCATION
PUSHJ P,FETCH ;FETCH IT
PJRST PUTO ;JUST PRINT THE NUMBER
SUBTTL PROD - Process a signed decimal number
PROD: MOVE S1,CALOC ;GET ADDRESS OF CURRENT ARGUMENT
PUSHJ P,FETCH ;GET IT
PJRST PUTD ;JUST PRINT THE NUMBER
SUBTTL PROF - Process a system dependent file specification
TOPS10 <
PROF: MOVE P1,CALOC ;GET LOCATION OF THE FD
MOVEI S1,.FDSTR(P1) ;LOCATION OF STRUCTURE NAME
PUSHJ P,FETCH ;GET IT
JUMPE S1,PROF.1 ;IF NULL, FORGET IT
PUSHJ P,PUTW ;PRINT IT
$PUT7(<:>) ;FOLLOW IT WITH COLON
PROF.1: MOVEI S1,.FDNAM(P1) ;GET NAME OF FILE
PUSHJ P,FETCH ;FROM USER
SKIPE S1 ;IF NULL, DON'T PRINT IT
PUSHJ P,PUTW ;PRINT AS SIXBIT WORD
MOVEI S1,.FDEXT(P1) ;NOW GET EXTENSION
PUSHJ P,FETCH ;FROM USER
JUMPE S1,PROF.2 ;IF NULL, IGNORE IT
$PUT7(<.>) ;PUT OUT DOT AS FILE.EXT SEPARATOR
PUSHJ P,PUTW ;NOW PRINT THE SIXBIT EXTENSION
PROF.2: MOVEI S1,.FDPPN(P1) ;GET LOCATION OF PPN
PUSHJ P,FETCH ;GET THE PPN
JUMPE S1,.RETT ;IF NULL,SKIP PPN AND PATH
PUSH P,S1 ;SAVE PPN
$PUT7(<[>) ;PUT OUT A BRACKET TO OPEN PPN
HLRZ S1,0(P) ;ISOLATE PROJECT NUMBER
PUSHJ P,PUTO ;PUT IT OUT
$PUT7(<,>) ;SEPARATE HALVES
POP P,S1 ;RESTORE PPN
ANDI S1,-1 ;ISOLATE THE PROGRAMMER NUMBER
PUSHJ P,PUTO ;PRINT IT
MOVEI S1,.FDLEN(P1) ;GET ADDRESS OF FD LENGTH
PUSHJ P,FETCH ;FETCH IT
LOAD S1,S1,FD.LEN ;GET LENGTH ONLY
CAIG S1,.FDPAT ;IS THERE A PATH?
JRST PROF.4 ;NO
SUBI S1,.FDPAT ;GET NUMBER OF SFDS
MOVNS S1 ;NEGATE IT
HRL P1,S1 ;GET COUNT INTO PLACE
PROF.3: MOVEI S1,.FDPAT(P1) ;GET SFD LOCATION
PUSHJ P,FETCH ;LOAD IT
JUMPE S1,PROF.4 ;Null SFD? All done then...
$PUT7(<,>) ;Nonnull, type a comma
PUSHJ P,PUTW ;PRINT IT
AOBJN P1,PROF.3 ;LOOP FOR ALL
PROF.4: $PUT7(<]>) ;CLOSE PPN WITH A BRACKET
> ;END TOPS10 CONDITIONAL
TOPS20 <
PROF: MOVEI S1,.FDSTG ;GET OFFSET TO DESCRIPTIVE STRING
PUSH P,CALOC ;SAVE LOCATION OF ARGUMENT
ADDM S1,CALOC ;POINT TO "STRING PART" OF FD
PUSHJ P,PROT ;HANDLE AS ASCIZ TEXT
POP P,CALOC ;RESTORE ORIGINAL LOCATION
> ;END TOPS20 CONDITIONAL
$RETT ;THEN RETURN
SUBTTL PRO7 - Process a single 7 bit ASCII character
PRO7: MOVE S1,CALOC ;GET LOCATION
PUSHJ P,FETCH ;FETCH THE CHARACTER
PJRST PUT7 ;PRINT IT AND RETURN FROM THERE
SUBTTL PRO6 - Process a single 6 bit ASCII character
PRO6: MOVE S1,CALOC ;GET LOCATION
PUSHJ P,FETCH ;LOAD IT
PJRST PUT6 ;PRINT IT AND RETURN FROM THERE
SUBTTL PRO5 - Process ASCIZ single word
PRO5: MOVE S1,CALOC ;GET LOCATION OF WORD TO PRINT
PUSHJ P,FETCH ;LOAD IT
MOVEM S1,TTXBUF ;STORE INTO TEMPORARY BUFFER
SETZM S1,TTXBUF+1 ;INSURE 6TH CHARACTER IS NULL
MOVEI S1,TTXBUF ;GET LOCATION TO PUT OUT STRING AT
PJRST PUTT ;AND PUT OUT THE TEXT
SUBTTL PROW - Process a SIXBIT word
PROW: MOVE S1,CALOC ;GET LOCATION OF ARGUMENT
PUSHJ P,FETCH ;LOAD FROM USER ADDRESS SPACE
SKIPN CAPTR ;IF NOT A BYTE,
PJRST PUTW ;JUST PRINT IT OUT
JUMPE S1,.RETT## ;IF NULL, RETURN NOW
PROW.1: TXNE S1,77B5 ;IS FIELD LEFT JUSTIFIED?
PJRST PUTW ;YES, PRINT IT OUT NOW
LSH S1,6 ;SHIFT OVER ONE PLACE
JRST PROW.1 ;AND TRY AGAIN
SUBTTL PROP - Process a directory ID of either PPN or directory NUMBER
SUBTTL PROU - Process a user ID or either PPN or User number
PROU: SKIPA T1,[EXP JI.USR] ;USE JOB'S USER NUMBER
PROP: MOVX T1,JI.CDN ;USE JOB'S DIRECTORY NUMBER
MOVE S1,CALOC ;GET CURRENT ARGUMENT'S LOCATION
PUSHJ P,FETCH ;NOW FETCH THAT ARGUMENT
CAME S1,[EXP -1] ;DO THEY WANT THE DEFAULT?
PJRST PUTU ;NO,OUTPUT USER INFO
MOVE S2,T1 ;PLACE FUNCTION CODE IN S2
PUSHJ P,I%JINF ;GET THE DATA
MOVE S1,S2 ;PLACE VALUE IN S1
PROP.1: PJRST PUTU ;OUTPUT USER INFO
SUBTTL PROR - Process routine for Job Info Block
;This routine will output the Job Info Block for the Galaxy
; Spoolers or anyone formating a JIB according to GLXMAC
; Specification.
PROR: MOVEI S1,[ASCIZ/Job /] ;START JOBNAME
PUSHJ P,PUTT ;OUTPUT THE TEXT
MOVE P1,CALOC ;GET ADDR OF ARGUMENT
MOVEI S1,JIB.JN(P1) ;GET THE ADDRESS OF JOBNAME FIELD
PUSHJ P,FETCH ;FETCH IT
JUMPE S1,.RETF ;NONE..ERROR..RETURN FALSE
PUSHJ P,PUTW ;DISPLAY THE JOBNAME
MOVEI S1,[ASCIZ/ Req #/] ;REQUEST IDENTIFIER
PUSHJ P,PUTT ;OUTPUT BLOCK
MOVEI S1,JIB.ID(P1) ;GET ADDRESS OF REQUEST ID
PUSHJ P,FETCH ;FETCH IT
JUMPLE S1,.RETF ;ERROR...RETURN
PUSHJ P,PUTD ;OUTPUT THE NUMBER
MOVEI S1,[ASCIZ/ for /] ;USER NAME IDENTIFIER
PUSHJ P,PUTT ;OUTPUT THE TEXT
TOPS10 <
MOVEI S1,JIB.NM(P1) ;GET USER NAME WORD 1
PUSHJ P,FETCH ;FETCH IT
JUMPE S1,PROR.3 ;NO NAME GO TO PPN
MOVE P2,CACCTR ;GET CURRENT CHARACTER COUNT
ADDI P2,6 ;EXPECTED COUNT AFTER OUTPUT
PUSHJ P,PUTW ;OUTPUT THE NAME
SUB P2,CACCTR ;GET COUNT OUTPUT
MOVEI S1,JIB.NM+1(P1) ;GET USER NAME WORD 2
PUSHJ P,FETCH ;FETCH IT
JUMPE S1,PROR.3 ;ANYTHING ELSE TO PRINT ?
JUMPE P2,PROR.2 ;ALL OUT CONTINUE ON
PUSH P,S1 ;SAVE USER NAME WORD 2
PROR.1: MOVEI S1,40 ;GET A BLANK
PUSHJ P,PUT7 ;OUTPUT THE BLANK
SOJG P2,PROR.1 ;FILL TO 6 CHARACTERS
POP P,S1 ;GET SAVED S1
PROR.2: PUSHJ P,PUTW ;OUTPUT THE NAME
PROR.3: MOVEI S1,40 ;GET A BLANK
PUSHJ P,PUT7 ;OUTPUT THE CHARACTER
>;END TOPS10
MOVEI S1,JIB.US(P1) ;GET USER NUMBER OR PPN
PUSHJ P,FETCH ;FETCH THE ARGUMENT
PJRST PUTU ;DISPLAY USER NAME OR PPN AND RETURN
PROH: TDZA P1,P1 ;USE FOR FLAG THAT DATE IS WANTED
PROC: SETO P1, ;-1 MEANS TIME ONLY
MOVE S1,CALOC ;GET LOCATION OF ARGUMENT
PUSHJ P,FETCH ;GRAB IT
CAMN S1,[EXP -1] ;IS IT -1, FOR "NOW"?
PUSHJ P,I%NOW ;GET CURRENT DATE AND TIME
;**[54]At PROC:+5L replace 46 lines with 11 lines. JYCW 6/27/85
; Convert date and time to ASCII string
MOVE S2,S1 ;[54]Put the date and time AC 2
HRROI S1,TTXBUF ;[54]String goes into TTXBUF
PUSH P,T1 ;[54]Save AC 3
SETZ T1, ;[54]For now no flags
SKIPE P1 ;[54]Do we want date and time
TXO T1,OT%NDA ;[54]Only want time
ODTIM ;[54]Convert
ERJMP .STOP ;[54]Can't covert time
POP P,T1 ;[54]Restore AC 3
MOVEI S1,TTXBUF ;[54]String goes into AC 1
PJRST PUTT ;[54]Print it
SUBTTL PROE - Process a GLXLIB error number
PROE: MOVE S1,CALOC ;GET LOCATION OF THE ARGUMENT
PUSHJ P,FETCH ;GET IT
TOPS20<
CAMN S1,[EXP -2] ;WANT LAST TOPS20 ERROR
JRST PROE.4 ;YES..SETUP ERRO VALUES
>;END TOPS20
CAMN S1,[EXP -1] ;WANT 'LAST ERROR'?
SKIPA S1,.LGERR## ;YES, PICK UP LAST ERROR PROCESS VIA .ERET
CAIL S1,0 ;IF LESS THAN 0 OR
CAIL S1,ERRSLN ; OFF THE END OF THE TABLE
PJRST PROE.1 ;CHECK FOR -20 ERRORS
HRRZ S1,ERRTAB(S1) ;GET STRING ADDRESS
PJRST PUTT ;RETURN AFTER PUTTING OUT THE STRING
PROE.1:
TOPS20< MOVE S2,S1 ;PLACE CODE IN S2
CAIGE S1,.ERBAS ;CHECK FOR -20 ERROR
PJRST PROE.3 ;BAD ERROR CODE
PROE.2: PUSH P,S2 ;SAVE S2
MOVEI S1,EBFSZ ;SIZE OF THE BUFFER
PUSHJ P,M%GMEM ;GET BUFFER ADDRESS
MOVEM S2,ERRBUF ;SAVE THE ADDRESS
POP P,S2 ;RESTORE ERROR CODE
HRLI S2,.FHSLF ;FOR THIS PROCESS
HRROI S1,@ERRBUF ;STORE IN ERROR BUFFER
HRLZI T1,-<EBFSZ*5> ;MAXIMUM NUMBER OF CHARACTERS
ERSTR ;DO THE FUNCTION
PJRST PROE.3 ;BAD ERROR CODE
$RETF ;BAD STRING SIZE
MOVEI S1,@ERRBUF ;POINT TO ERROR BUFFER
PUSHJ P,PUTT ;DUMP THE TEXT
MOVEI S1,EBFSZ ;SIZE OF AREA
MOVE S2,ERRBUF ;ADDRESS OF BUFFER
PUSHJ P,M%RMEM ;RETURN THE MEMORY
$RETT ;RETURN
PROE.3: PUSH P,S2 ;SAVE S2
MOVEI S1,[ASCIZ/Invalid Error Code /]
PUSHJ P,PUTT ;PUT OUT THE TEXT
POP P,S2 ;RESTORE S2
HRRZ S1,S2 ;GET THE ERROR CODE ONLY
PUSHJ P,PUTO ;DUMP THE NUMBER
$RETT ;RETURN
PROE.4: MOVEI S2,-1 ;GET LAST ERROR
JRST PROE.2 ;FINISH OFF ERROR
>;END TOPS20
TOPS10< $RETF > ;ERROR..JUST RETURN
;Make a table of known errors, for each we have the address
; of expanded string.
DEFINE ERR(A,B)<
Z [ASCIZ \B\]
> ;END OF ERR DEFINITION
ERRTAB: [ASCIZ /No errors yet/] ;0 ENTRY FOR LAST ERROR, BUT NONE SEEN
ERRORS ;PRODUCE THE TABLE
ERRSLN==.-ERRTAB ;LENGTH OF TABLE
SUBTTL PROI - Process an indirect text request
;Just as ^T can be used to include remote ASCIZ strings in a
; $TEXT call, the ^I qualifier can be used to include strings
; that are more complex. The address specified with an ^I
; qualifier specifies the location of a block, built with the
; ITEXT macro, which will be included at this point in the
; $TEXT string. Any qualifier may appear in the ITEXT string,
; including more ^I qualifiers.
PROI: $SAVE <CAFLG,ARGADR,USRARG,MAXARG,NXTARG>
MOVE S1,CALOC ;GET ADDRESS GIVEN AS ^I ARGUMENT
MOVEM S1,ARGADR ;MAKE IT NEW ARG ADDR
PUSHJ P,PROBLK ;PROCESS THE BLOCK POINTED TO
$RETT ;THEN RETURN
SUBTTL PROV - Process a program version number
; Type out a specially formatted program version number. This is the
; standard version number, containing version number, major and
; minor edit numbers and a code indicating who editted the code last.
; Define the fields of the version number
VI%WHO==7B2 ;WHO EDITTED LAST
VI%MAJ==777B11 ;MAJOR VERSION NUMBER
VI%MIN==77B17 ;MINOR VERSION NUMBER
VI%EDT==777777B35 ;EDIT NUMBER
PROV: MOVE S1,CALOC ;GET LOCATION OF VERSION NUMBER
PUSHJ P,FETCH ;FETCH IT
MOVE P1,S1 ;GET INTO SAFER PLACE
LOAD S1,P1,VI%MAJ ;GET MAJOR VERSION NUMBER
PUSHJ P,PUTO ;PRINT IT OUT
LOAD P2,P1,VI%MIN ;GET MINOR VERSION NUMBER
JUMPE P2,PROV.2 ;SKIP MINOR VERSION IF ZERO
SUBI P2,1 ;BACK OFF ONE
IDIVI P2,^D26 ;PICK APART LETTERS
JUMPE P2,PROV.1 ;IF FIRST LETTER NULL, SKIP IT
MOVEI S1,"A"-1(P2) ;GET FIRST PART
PUSHJ P,PUT7 ;PUT OUT THE LETTER
PROV.1: MOVEI S1,"A"(P3) ;CONVERT IT
PUSHJ P,PUT7 ;AND PRINT IT
PROV.2: $PUT7(<(>) ;PUT OUT PARENTHESIS
LOAD S1,P1,VI%EDT ;GET THE EDIT NUMBER
PUSHJ P,PUTO ;PRINT IT
$PUT7(<)>) ;AND CLOSE PARENTHESIS
LOAD S1,P1,VI%WHO ;GET FINAL PART
JUMPE S1,.RETT## ;IF NULL, WE ARE DONE
$PUT7(-) ;ELSE SEPARATE "WHO" FIELD AND
PJRST PUTO ;RETURN PRINTING IT
SUBTTL PROM - Process a request for a CONTROL-M (Carriage Ret.)
PROM: MOVEI S1,"M"-100 ;LOAD ^M
PJRST PUT7 ;PUT IT OUT,RETURN
SUBTTL PROJ - Process a request for a CONTROL-J (Line Feed)
PROJ: MOVEI S1,"J"-100 ;LOAD ^J
PJRST PUT7 ;PUT IT OUT,RETURN
SUBTTL PROL - Process a request for a CONTROL-L (Form Feed)
PROL: MOVEI S1,"L"-100 ;LOAD ^L
PJRST PUT7 ;PUT IT OUT, RETURN
SUBTTL PROK - Process a request for a CONTROL-K (Vertical Tab)
PROK: MOVEI S1,"K"-100 ;LOAD ^K
PJRST PUT7 ;PUT IT OUT, RETURN
SUBTTL PRO2 - Process a request for up-arrow
PRO2: MOVEI S1,"^" ;GET UP-ARROW OR CARET
PJRST PUT7 ;AND PUT IT OUT
SUBTTL PROA - Process a request to supress free <CR-LF>
PROA: SETOM ENDFLG ;SET FLAG TO SUPRESS END OF TEXT STUFF
$RETT ;TAKE GOOD RETURN
SUBTTL PRO0 - Process a request to put null (0) at end of line
PRO0: MOVEI S1,1 ;SET END TO PUT NULL INSTEAD
MOVEM S1,ENDFLG ;OF CR-LF AT END OF LINE
$RETT ;AND RETURN
SUBTTL FETCH - Routine to get a word from caller's address space
;FETCH is responsible for getting a word from the user,
; checking for it's being in the AC shadow block and masking
; for proper size and place if the argument has a byte-mode
; address.
; Call: S1/ Address to fetch word from
;
; Return: S1/Contents of that word or byte
FETCH: CAIG S1,17 ;IS THE VALUE IN THE ACS?
SKIPA S1,USRACS(S1) ;YES, FETCH IT FROM THERE
MOVE S1,0(S1) ;OTHERWISE, PICK IT UP FROM MEMORY
SKIPN S2,CAPTR ;IS THERE A POINTER WORD?
$RETT ;NO, SO RETURN NOW
HRRI S2,S1 ;POINT TO REGISTER WITH WHOLE WORD
LDB S1,S2 ;GET PROPER PART
$RETT ;AND TAKE GOOD RETURN
SUBTTL SPACES - Routine to provide any padding requested
;Spaces is actually a misnomer, since the pad character may
; be any character that the user specifies. The spacing
; information is passed in an optional word associated with
; each argument. The user may specify the number of spaces
; that the field will take up, the side to justify to, and the
; character to pad with. Only the width actually must be
; given, as the side and character are defaulted by the $TEXT
; macros. The default justification is right justification
; for numeric items (^D and ^O) and left justification for all
; others. The default padding character is always a blank
; (octal 40).
;This routine places X pad characters into the output stream,
; where X is computed as the difference between the number in
; CACCTR and the user specified width. It also provides the
; centering.
; Call: CACCTR should be set up
;
; Return: Always TRUE
SPACES: PUSHJ P,.SAVE1 ;GET ONE PERMANENT REGISTER
LOAD P1,CAFLG,TXT.WD ;GET THE SPACING CODE WIDTH
SUB P1,CACCTR ;SUBTRACT CHARACTERS FOR OUTPUT
SETZM CACCTR ;THEN CLEAR CHARACTERS OUTPUT
LOAD S1,CAFLG,TXT.JU ;NOW GET THE SPACING CODE
CAXE S1,.TXTJC ;WANT THIS CENTERED?
JRST SPAC.1 ;NO, SO SKIP THIS
ASH P1,-1 ;DIVIDE SPACING NEEDED BY 2
MOVX S1,.TXTJL ;SET NOW FOR LEFT JUSTIFICATION ONLY
STORE S1,CAFLG,TXT.JU ;AND FALL INTO REGULAR SPACING CODE
SPAC.1: JUMPLE P1,.RETT ;CHECK FOR DONENESS
LOAD S1,CAFLG,TXT.FC ;GET THE CHARACTER TO OUTPUT
PUSHJ P,PUT7 ;AND PRINT IT
SOJA P1,SPAC.1 ;REPEAT TILL DONE
SUBTTL Local output routines
;These routines are local to the TEXT module and are used to
; do output. GLXTXT cannot use the $TEXT macro because it
; would overwrite the callers AC's with its own.
; PUTTX -- Output an ASCIZ string, called via the $PUTT macro
PUTTX: PUSH P,S1 ;SAVE ACS S1 AND S2
PUSH P,S2 ;
AOS S1,-2(P) ;UPDATE STACK, GET ADDRESS
HRRZ S1,-1(S1) ;PICK UP ADDRESS OF STRING
PUSHJ P,PUTT ;CALL ROUTINE
PJRST S2POPJ ;RETURN, RESTORING THE ACS
; PUTT -- Output an ASCIZ string, address of string is in S1
PUTT: PUSHJ P,.SAVE1 ;GET ONE PERMANENT AC
HRRZ P1,S1 ;GET ADDRESS INTO IT
HRLI P1,(POINT 7,0) ;CONVERT IT TO A BYTE POINTER
PUTT1: ILDB S1,P1 ;GET A BYTE
JUMPE S1,.RETT ;IF NULL, RETURN
PUSHJ P,PUT7 ;PRINT THE CHARACTER
JRST PUTT1 ;LOOP FOR NEXT ONE
; PUT7X -- Output a character, called via the $PUT7 macro
PUT7X: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;AND S2
AOS S1,-2(P) ;UPDATE STACK, GET ADDRESS
HRRZ S1,-1(S1) ;GET CHARACTER
PUSHJ P,PUT7 ;PUT OUT THE CHARACTER
S2POPJ: POP P,S2 ;RESTORE THE AC
POP P,S1 ;AND THE OTHER
POPJ P, ;RETURN
; PUT7 -- Output a character, character in S1
PUT7: SKIPE ERREXT ;IF AN ERROR HAS OCCURED,,
$RETT ; THEN JUST RETURN.
MOVX TF,177 ;MASK SEVEN BITS
AND TF,S1 ;PUT CHARACTER IN TF
AOS S1,CACCTR ;INCREASE CHARACTER COUNT
SKIPE NOOUTP ;SUPRESSING ACTUAL OUTPUT?
$RETT ;YES, RETURN TRUE NOW
SKIPN CACMAX ;IF FIELD IS NOT COUNTED
MOVX S1,1B0 ;MAKE ALL CHARACTERS BE PRINTED
CAMLE S1,CACMAX ;CHECK FOR MAXIMUM
$RETT ;IF TOO MANY, DON'T PRINT IT
MOVE S1,TF ;RESTORE CHARACTER
PUSHJ P,@USROUT ;OUTPUT IT
PORTAL .+1 ;ALLOW EXECUTE-ONLY RETURN
JUMPT .RETT ;IF RETURNED OK, RETURN NOW
SETOM ERREXT ;INDICATE AN ERROR OCCURED.
$RETT ;AND RETURN.
; PUTQ -- Output an ASCIZ string, byte pointer to string is in S1
PUTQ: PUSHJ P,.SAVE1 ;SAVE ONE PERM AC
MOVE P1,S1 ;COPY POINTER
JRST PUTT1 ;AND CONTINUE
; PUTO -- Output an unsigned octal number, number in S1
PUTO: PUSHJ P,.SAVE3 ;GET 3 REGISTERS
MOVEI P1,0 ;CLEAR SHIFT REGISTER
MOVE P2,S1 ;GET INTO GOOD PLACE
MOVEI P3,^D12 ;TWELVE POSSIBLE DIGITS
PUTO.1: LSHC P1,3 ;DELETE LEADING 0
SKIPN P1 ;IF STILL ZERO,
SOJG P3,PUTO.1 ;LOOP
PUTO.2: ANDI P1,7 ;ISOLATE THE BYTE
MOVEI S1,"0"(P1) ;MAKE IT ASCII
PUSHJ P,PUT7 ;PUT OUT THE BYTE
LSHC P1,3 ;GET NEXT BYTE
SOJG P3,PUTO.2 ;REPEAT
$RETT ;OR RETURN NOW
; PUTD -- Put out a signed decimal number, number in S1
PUTD: PUSHJ P,.SAVE2 ;NEED TWO ACS
MOVE P1,S1 ;GET INTO PERMANENT PLACE
JUMPGE P1,PUTD.1 ;IS IT NEGATIVE?
$PUT7(<->) ;YES, SO PRINT A MINUS SIGN
MOVMS P1 ;AND CONVERT TO POSITIVE
PUTD.1: IDIVI P1,^D10 ;PICK OFF A DIGIT
HRLM P2,0(P) ;BET YOU'VE SEEN THIS BEFORE
SKIPE P1 ;ANY DIGITS LEFT?
PUSHJ P,PUTD.1 ;YES, GET NEXT ONE
HLRZ S1,0(P) ;GET A DIGIT
ADDI S1,"0" ;CONVERT TO ASCII
PJRST PUT7 ;PUT OUT DIGIT, LOOP OR RETURN FORM THERE
; PUTW -- Put out a SIXBIT word, word in S1
PUTW: PUSHJ P,.SAVE2 ;NEED TWO ACS
MOVE P2,S1 ;GET WORD INTO SAFE PLACE
PUTW.1: JUMPE P2,.RETT ;RETURN IF ONLY BLANKS LEFT
LSHC P1,6 ;GET A CHARACTER
MOVE S1,P1 ;GET INTO PLACE
PUSHJ P,PUT6 ;PRINT THE CHARACTER
JRST PUTW.1 ;LOOP FOR ALL
; PUT6 -- Put Out A Single SIXBIT character, character in S1
PUT6: ANDI S1,77 ;INSURE ITS SIXBIT
ADDI S1," " ;CONVERT TO ASCII
PJRST PUT7 ;OUTPUT AS AN ASCII CHARACTER
; PEND -- Put proper ending on the text line
PEND: SKIPGE ENDFLG ;WANT SOMETHING DONE?
$RETT ;NO, RETURN NOW
SETZM CACMAX ;NOT PART OF ANY COUNTED FIELD
SKIPG ENDFLG ;WANT A NULL?
JRST PEND.1 ;NO, MUST WANT CR-LF
MOVX S1,0 ;ASCII NULL
PJRST PUT7 ;RETURN, PRINT IT
PEND.1: MOVEI S1,.CHCRT ;GET A 'CARRIAGE-RETURN'
PUSHJ P,PUT7 ;PRINT IT
MOVEI S1,.CHLFD ;GET A 'LINE-FEED'
PJRST PUT7 ;PRINT IT, RETURN
; PUTN -- Put out a node specification (in S1)
TOPS20 <
PUTN: PJRST PUTW ;PUT IT OUT AS SIXBIT AND RETURN
> ;END TOPS20 CONDITIONAL
TOPS10 <
PUTN: MOVE S2,S1 ;COPY NODE NUMBER TO S2
$CALL CNVNOD ;CONVERT NAME/NUMBER
JUMPF [MOVE S1,S2 ;RESTORE THE NODE NUMBER
TLNN S1,770000 ;WAS IT SIXBIT
PJRST PUTO ;JUST OUTPUT THE NODE NUMBER.
PJRST PUTW] ;OUTPUT NODE NAME AND RETURN
TLNN S1,770000 ;PUT NAME IN S1
EXCH S1,S2 ;PUT NUMBER IN S2
PUSH P,S2 ;SAVE THE NUMBER
PUSHJ P,PUTW ;OUTPUT THE NAME
POP P,S1 ;PUT THE NUMBER IN S1
$PUT7(<(>) ;THEN A LEFT BRACKET
PUSHJ P,PUTO ;OUTPUT IT IN OCTAL
$PUT7(<)>) ;THEN THE RIGHT BRACKET
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
SUBTTL PUTU -- Output user name or PPN
;This routine will take PPN or user number in S1 and output contents
TOPS10 <
PUTU: SKIPN S1 ;HAVE A GOOD PPN?
JRST [MOVEI S1,[ASCIZ |(PPN unknown)|]
PJRST PUTT] ;THE BEST WE CAN DO
PUSH P,S1 ;SAVE IT
$PUT7(<[>) ;GET AN OPEN BRACKET PRINTED
HLRZ S1,0(P) ;GET PROJECT PART OF PPN
PUSHJ P,PUTO ;PRINT IT
$PUT7(<,>) ;SEPARATE THE P FROM THE PN
POP P,S1 ;RESTORE PPN
ANDI S1,-1 ;DISCARD PROJECT NUMBER
PUSHJ P,PUTO ;PRINT IT
MOVEI S1,"]" ;GET CLOSE BRACKET
PJRST PUT7 ;PRINT IT AND RETURN
>;END TOPS10
TOPS20 <
PUTU: MOVE S2,S1 ;GET LOGGED IN DIRECTORY NUMBER
HRROI S1,TTXBUF ;POINT TO TEMPORARY TEXT BUFFER
DIRST ;AND PUT DOWN THE STRING
ERJMP [MOVEI S1,[ASCIZ/(User unknown)/] ;IF BAD,,POINT TO 'UNKNOWN'
PJRST PUTT ] ;AND PUT THAT OUT !!!
MOVEI S1,TTXBUF ;POINT TO TEXT BUFFER
PJRST PUTT ;PUT IT OUT AND RETURN
>;END TOPS20
SUBTTL SAVLVL-RSTLVL - Save and restore TEXT levels
;In order to make the $TEXT instruction work at both normal
; and interrupt level, the T%TEXT routine must detect calls
; made while inside itself. IF such a call is made, these
; routines are used to save away the data base.
SAVLVL: PUSH P,S1 ;SAVE AN AC
MOVE S1,TXTLVL ;GET LEVEL
CAIE S1,1 ;ONLY SUPPORT TWO LEVELS
$STOP(TML,Too many levels of call)
MOVE S1,[XWD FSAVE,SAREA] ;PREPARE FOR THE BLT
BLT S1,SAREA+SSAREA-1 ;SAVE AWAY OUR DATA BASE
POP P,S1 ;RESTORE THE AC
POPJ P, ;AND RETURN
RSTLVL: PUSH P,S1 ;SAVE S1
MOVE S1,[XWD SAREA,FSAVE] ;RESTORE THE AREA
BLT S1,LSAVE-1 ;THAT WAS WIPED BY THIS LEVEL
POP P,S1 ;RESTORE S1
POPJ P, ;RETURN
TXT%L:
END