Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50501/outlib.mac
There are no other files named outlib.mac in the archive.
TITLE OUTLIB COMMON OUTPUT ROUTINES NEEDED BY MACRO PROGRAMS
SUBTTL ERNIE PETRIDES, WESLEYAN UNIVERSITY, JANUARY, 1979
COMMENT \
TO USE THIS OUTPUT PACKAGE, THE USER MUST MAKE A
UNIVERSAL FILE NAMED "AC" WHICH DEFINES ACCUMULATOR USAGE.
NOTE THAT EXCEPT FOR THE TEMPS, THE ASSIGNMENTS MUST MATCH
THOSE USED IN THE USER'S PROGRAM. ALL ASSIGNMENTS, OF COURSE
MUST BE UNIQUE. "C" IS ALWAYS SET TO THE ASCII VALUE OF THE
LAST CHARACTER TYPED (OR ZERO IF A STRING WAS PROCESSED) AND
"M" IS USED AS AN ILDB POINTER FOR STRINGS. ALL THE OTHERS
ARE ALWAYS PRESERVED.
T1 -- THREE CONSECUTIVE SCRATCH ACCUMULATORS (PRESERVED)
T2 -- MUST BE EQUAL TO T1 + 1 (PRESERVED)
T3 -- THIRD SCRATCH ACCUMULATOR (PRESERVED)
C -- PROVIDES (AND SET TO) CHARACTER TO BE OUTPUT
M -- MESSAGE POINTER TO ASCIZ STRING TO BE OUTPUT
N -- NUMBER FOR NORMAL INTEGER TYPE-OUT (PRESERVED)
P -- PUSH DOWN STACK POINTER (MIN. 20 LEVELS NEEDED)
ALSO: IF FEATURES OF THE ACTION CHARACTER HANDLER ARE DESIRED TO BE
INACTIVE, THE ASSEMBLY SWITCH OF THE FORM ".FT'ACT" (WHERE
"ACT" IS THE THREE LETTER ACTION CODE) MUST BE DEFINED AS
ZERO IN THE UNIVERSAL FILE "AC". NON-STANDARD PARAMETER
SETTINGS AFFECTING ASSEMBLY OF THE BASIC "CHROUT" ROUTINE
MUST ALSO BE DEFINED IN SAID FILE.
\
SUBTTL TABLE OF CONTENTS FOR OUTLIB
COMMENT \
NAME DESCRIPTION PAGE
OUTLIB COMMON OUTPUT ROUTINES NEEDED BY MACRO PROGRAMS 1
TABLE OF CONTENTS FOR OUTLIB 2
ACTOUT OUTPUT STRING WITH SPECIAL ACTION CHARACTERS 3
ACTION CHARACTER SUBROUTINES AND EXIT 4
ACTION CHARACTER CODE TABLE AND DISPATCH TABLE 5
ERROUT OUTPUT ERROR MESSAGES PRECEDED BY PREFIX IN "ERR" 6
APCOUT OUTPUT "AT USER PC N" OF N 7
DATOUT OUTPUT THE CURRENT DATE IN DD-MMM-YY FORMAT 8
TIMOUT OUTPUT THE CURRENT TIME IN HH:MM:SS FORMAT 9
LINOUT OUTPUT ASCIZ STRING FOLLOWED BY A CRLF 10
STROUT OUTPUT A PLAIN OLD ASCIZ STRING 11
FILOUT OUTPUT FULL FILE SPECIFICATION (DEV,FIL,EXT,PPN) 12
DEVOUT OUTPUT SIXBIT DEVICE LEFT JUSTIFIED IN "DEV" 13
SIXOUT OUTPUT THE SIXBIT CHARACTERS IN "SIX" 14
PPNOUT OUTPUT [PROJ,PROG] PAIR IN "PPN" 15
NUMOUT OUTPUT N IN DECIMAL, OCTAL, OR ANY RADIX IN "RAD" 16
DMPOUT OUTPUT N IN OCTAL DUMP FORMAT (WITH LEADING 0'S) 17
MISC OUTPUT OF COMMON MISCELLANEOUS CHARACTERS 18
CHROUT OUTPUT OF THE SINGLE CHARACTER IN C 19
CHROUT ROUTINE MAIN BODY 20
BUFFER ROUTINES FOR CHROUT 21
PDLTSV PDL MANIPULATION ROUTINES FOR SAVING TEMPS 22
PDLCPJ PDL MANIPULATION ROUTINES FOR DOING SKIP RETURNS 22
\
SALL ;GENERATE A NICE LISTING
PRGEND
TITLE ACTOUT OUTPUT STRING WITH SPECIAL ACTION CHARACTERS
ENTRY ACTOUT
EXTERN CHROUT,DECOUT,ERROUT,TSAV1
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
DEFINE ACTDEF
<ITEM CLF,"_" ;;DO A CRILIF
ITEM BRK,"*" ;;BREAK OUTPUT
ITEM FUC,74 ;;FORCE UPPER CASE (OPEN ANGLE BRACKET)
ITEM FLC,76 ;;FORCE LOWER CASE (CLOSE ANGLE BRACKET)
ITEM FNC,"=" ;;DON'T FORCE EITHER CASE
ITEM NUM,"#" ;;THE DECIMAL NUMBER IN N
ITEM PLU,"$" ;;"S" IF N NOT EQUAL TO 1
ITEM SPC,"(" ;;SING./PLURAL COND. SUPPRESS (USES \ AND ) )
ITEM DEV,":" ;;DEVICE: IN "DEV"
ITEM PPN,"[" ;;[P,PN] IN "PPN"
ITEM FIL,"^" ;;FULL FILE SPEC IN DEV,FIL,EXT,PPN
ITEM WRN,"%" ;;WARNING MESSAGE PREFIX IN "ERR"
ITEM FTL,"?" ;;FATAL MESSAGE (LIKE WARN) AND BOMB
ITEM APC,"@" ;;"AT USER PC N" OF N
ITEM TIM,"+" ;;CURRENT TIME FROM GETTAB
ITEM DAT,"&" ;;CURRENT DATA FROM GETTAB>
IF1, <NACTS==0> ;INITIALIZE ACTCHR FEATURE COUNTER
DEFINE ITEM (ACT,CHR)
<IF1, <IFNDEF .FT'ACT,<.FT'ACT'==-1>
IFN .FT'ACT,<NACTS==NACTS+1>>>
ACTDEF ;TURN ON ALL UNDECLARED ACT FEATURES AND TALLY THOSE ON
IFN .FTNUM,<IFNDEF .FTSNZ,<.FTSNZ==-1>> ;SUBSTITUTE "NO" FOR 0 ON #
IFN .FTSPC,<SUPCON:EXP 0> ;FLAG TO SHOW INSIDE SUPPRESS CONDITIONAL
IFN .FTFTL,<FTLERR:EXP 0> ;FLAG TO SHOW FATAL ERROR REQUEST TO EXIT
RELOC 400000
ACTOUT: PUSHJ P,TSAV1 ;SAVE A TEMP W/ AUTO RESTORE
IFN .FTSPC,<SETZM SUPCON> ;INIT SUPPRESS CONDITIONAL FLAG
IFN .FTFTL,<SETZM FTLERR> ;INIT FATAL ERROR FLAG
HRLI M,440700 ;MAKE AN ILDB POINTER TO STRING
NEXTCH: ILDB C,M ;LOAD A CHAR FROM STRING
JUMPE C,ACTXIT ;OFF TO MAIN EXIT WHEN NULL
IFLE NACTS,<PUSHJ P,NOACT> ;NEVER ACT IF ALL FEATURES OFF
IFG NACTS,<MOVSI T1,-NACTS ;LOAD NEGATIVE TABLE LENGTH IN LEFT
CAME C,ACTCHR(T1) ;SKIP IF WE'VE GOT A MATCH
AOBJN T1,.-1 ;KEEP TRYING UNTIL NONE LEFT
SKIPE SUPCON ;IF IN A SUPPRESS CONDITIONAL,
PUSHJ P,DOSUP ;DO SPECIAL ROUTINE (MIGHT SKIP)
PUSHJ P,@ACTDSP(T1)> ;DO THE APPROPRIATE DISPATCH
JRST NEXTCH ;LOOP BACK FOR NEXT CHARACTER
SUBTTL ACTION CHARACTER SUBROUTINES AND EXIT
;THIS IS THE CENTRAL EXIT FOR ACTOUT
ACTXIT:
IFN .FTFTL,<SKIPN FTLERR ;TEST FOR FATAL ERROR MESSAGE
POPJ P, ;JUST RETURN IF NORMAL
PUSHJ P,BRKOUT ;ELSE FORCE OUT ALL BUFFERS
EXIT 1,> ;AND EXIT TO MONITOR
POPJ P, ;BUT LET USER CONTINUE ANYWAY
;SUBROUTINE FOR NORMAL CHARACTER OUTPUT
NOACT: PJRST CHROUT ;OUTPUT PLAIN CHAR AND RETURN
;SUBROUTINE TO OUTPUT A NUMBER FOR "#"
IFN .FTNUM,<NUMOUT: ;ALL GOES UNDER CONDITIONAL ASSEMBLY OPTION
IFN .FTSNZ,<SKIPE N> ;IF N IS NOT ZERO (OR OPTION OFF),
PJRST DECOUT ; THEN OUTPUT DECIMAL AND RETURN
IFN .FTSNZ,<MOVEI C,"N"+40 ;OTHERWISE, LOAD A LC "N"
PUSHJ P,CHROUT ;SEND IT OUT IN STYLE
MOVEI C,"O"+40 ;AND LOAD A LC "O"
PJRST CHROUT> ;OUTPUT IT AND RETURN
>;END OF IFN .FTNUM CONDITIONAL
;SUBROUTINES TO HANDLE ERROR MESSAGES (CHARACTER ALREADY IN C)
IFN .FTFTL,<FTLOUT:SETOM FTLERR> ;SET THE FLAG TO BOMB
IFN .FTWRN,<WRNOUT:>
IFN .FTFTL!.FTWRN,<PJRST ERROUT> ;DO ERROR PREFIX AND RETURN
;SUBROUTINES TO HANDLE SUPPRESSION CONDITIONALS (N SINGULAR OR PLURAL)
IFN .FTSPC,< ;ALL GOES UNDER CONDITIONAL ASSEMBLY OPTION
;HERE ON NORMAL DISPATCH TO ENTER SURPRESSION CONDITIONAL
SPCOUT: SETOM SUPCON ;ASSUME WE'LL START SUPPRESSING
CAIN N,1 ;BUT IF N IS SINGULAR,
MOVNS SUPCON ; DO OUTPUT IN CONDITIONAL
POPJ P, ;RETURN
;HERE INSTEAD OF DISPATCH WHEN IN SUPPRESS CONDITIONAL
DOSUP: CAIN C,"\" ;IF WE'VE GOT A CONDITIONAL FLIP,
JRST DOSUP1 ; THEN DO SPECIAL STUFF
CAIN C,")" ;IF WE'VE GOT A CONDTIONAL END,
JRST DOSUP2 ; DO OTHER SPECIAL STUFF
SKIPG SUPCON ;OTHERWISE, IF WE ARE SUPPRESSING,
AOS (P) ; THEN SKIP THE NORMAL DISPATCH
POPJ P, ;RETURN TO DISPATCH OR NEXT CHAR
DOSUP1: MOVNS SUPCON ;HERE TO FLIP CONDITIONAL ON "\"
CAIA ;SKIP AND DON'T OUTPUT IT
DOSUP2: SETZM SUPCON ;HERE TO END CONDTIONAL ON ")"
AOS (P) ;AVOID THE OUTPUT DISPATCH
POPJ P, ;RETURN FOR NEXT CHARACTER
>;END OF IFN .FTSPC CONDITIONAL
SUBTTL ACTION CHARACTER CODE TABLE AND DISPATCH TABLE
DEFINE ITEM (ACT,CHR) <IFN .FT'ACT,<EXP CHR>>
ACTCHR: ACTDEF ;GENERATE THE CHARACTER TABLE
DEFINE ITEM (ACT,CHR)
<IFN .FT'ACT,<IFNDEF ACT'OUT,<EXTERN ACT'OUT>
EXP ACT'OUT>>
ACTDSP: ACTDEF ;NOW MAKE THE DISPATCH TABLE
EXP NOACT ;AND APPEND THE NO ACTION DISPATCH
PRGEND ;END OF ACTOUT ROUTINE
TITLE ERROUT OUTPUT ERROR MESSAGES PRECEDED BY PREFIX IN "ERR"
ENTRY WRNOUT,FTLOUT,ERROUT
EXTERN STROUT,BRKOUT,CLFOUT,CHROUT,SXSOUT,DSPOUT,SIX
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
ERR:: EXP 0 ;PLACE TO PUT SIXBIT ERROR CODES
RELOC 400000
WRNOUT: MOVEI C,"%" ;LOAD A WARNING INDICATOR
PUSHJ P,ERROUT ;OUTPUT THE ERROR HEADER
PJRST STROUT ;OUTPUT THE MESSAGE AND RETURN
FTLOUT: MOVEI C,"?" ;LOAD A FATAL INDICATOR
PUSHJ P,ERROUT ;OUTPUT THE ERROR HEADER
PUSHJ P,STROUT ;OUTPUT THE MESSAGE
PUSHJ P,BRKOUT ;FORCE OUT THE BUFFERS
EXIT 1, ;AND RETURN TO MONITOR
POPJ P, ;BUT LET USER CONTINUE
ERROUT: PUSH P,C ;SAVE THE ERROR MARKER
PUSHJ P,CLFOUT ;GET A NEW LINE
POP P,C ;LOAD THE SAVED MARKER
PUSHJ P,CHROUT ;SEND IT OUT
PUSH P,ERR ;TRANSFER ERROR CODE
POP P,SIX ;TO SIXBIT OUTPUT BUFFER
PJRST SXSOUT ;NO TRAILING SPACES AND RETURN
PRGEND
TITLE APCOUT OUTPUT "AT USER PC N" OF N
ENTRY APCOUT
EXTERN STROUT,RHFOUT
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
RELOC 400000
APCOUT: PUSH P,M ;SAVE CURRENT MESSAGE POINTER
MOVEI M,[ASCIZ/at user PC /] ;LOAD OUR OWN (LOWER CASE!)
PUSHJ P,STROUT ;OUTPUT THE CHARS
POP P,M ;RESTORE OLD M
PJRST RHFOUT ;TYPE RH OF N AND RETURN
PRGEND
TITLE DATOUT OUTPUT THE CURRENT DATE IN DD-MMM-YY FORMAT
ENTRY DATOUT
EXTERN DECOUT,CHROUT,STROUT,TSAV2
SEARCH AC
TWOSEG
RELOC 400000
DATOUT: PUSHJ P,TSAV2 ;SAVE TEMPS WITH AUTO RESTORE
PUSH P,N ;SAVE THE NUMBER REGISTER
PUSH P,M ;AND THE MESSAGE POINTER
DATE T1, ;GET THE DATE IN 15-BIT FORMAT
IDIVI T1,^D31 ;PUT DAY NUMBER - 1 IN T2
MOVEI N,1(T2) ;INCREMENT AND LOAD INTO N
PUSHJ P,DECOUT ;OUTPUT THE DECIMAL CHARACTERS
MOVEI C,"-" ;LOAD A HYPHEN
PUSHJ P,CHROUT ;AND SEND IT OUT
IDIVI T1,^D12 ;PUT MONTH NUMBER - 1 IN T2
MOVEI M,MONTAB(T2) ;LOAD POINTER TO MONTH TABLE
PUSHJ P,STROUT ;OUTPUT THE STRING WITH A HYPHEN
ADDI T1,^D1964 ;CALCULATE THE YEAR NUMBER
IDIVI T1,^D100 ;EVERYONE KNOWS THE CENTURY
MOVEI N,(T2) ;LOAD N WITH THE 2-DIGIT YEAR
MOVEI C,"0" ;PUT A LEADING ZERO IN C
CAIGE N,^D10 ;IN CASE YEAR IS ONLY ONE DIGIT
PUSHJ P,CHROUT ;SO WON'T SCREW UP FORMAT
PUSHJ P,DECOUT ;AND OUTPUT THE YEAR
POP P,M ;RESTORE MESSAGE POINTER
POP P,N ;RESTORE NUMBER REGISTER
POPJ P, ;RESTORE TEMPS AND RETURN
DEFINE MONTHS (MMM) <IRP MMM,<ASCIZ/'MMM'-/>>
MONTAB: MONTHS <Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec>
PRGEND
TITLE TIMOUT OUTPUT THE CURRENT TIME IN HH:MM:SS FORMAT
ENTRY TIMOUT
EXTERN CHROUT,DECOUT,TSAV2
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
RELOC 400000
TIMOUT: PUSHJ P,TSAV2 ;SAVE TEMPS WITH AUTO RESTORE
PUSH P,N ;ALSO SAVE NUMBER REGISTER
MSTIME T1, ;GET TIME OF DAY IN MILLISECS
IDIVI T1,^D1000 ;DIVIDE OUT THE MILLISECONDS
CAIL T2,^D500 ;IF MORE THAN HALF A SECOND,
AOJ T1, ; THEN ROUND UP TO NEXT SEC
IDIVI T1,^D60 ;PUT NUMBER OF SECONDS IN T2
PUSH P,T2 ;AND SAVE IT FOR LATER
IDIVI T1,^D60 ;SEPARATE HOURS AND MINUTES
MOVEM T1,N ;LOAD THE HOURS
PUSHJ P,DECOUT ;OUTPUT THE CHARS
MOVEM T2,N ;LOAD THE MINUTES
PUSHJ P,DOTIM ;OUTPUT BOTH DIGITS
POP P,N ;LOAD THE SAVED SECONDS
PUSHJ P,DOTIM ;OUTPUT BOTH DIGITS
POP P,N ;RESTORE ORIGINAL N
POPJ P, ;RESTORE AND RETURN
DOTIM: MOVEI C,":" ;LOAD UP A COLON
PUSHJ P,CHROUT ;GET IT OUT OF HERE
MOVEI C,"0" ;LOAD A ZERO CHAR
CAIGE N,^D10 ;MAKE SURE WE'VE GOT TWO DIGITS
PUSHJ P,CHROUT ;ELSE NEED AN EXTRA ZERO
PJRST DECOUT ;OUTPUT THE WHATEVER AND RETURN
PRGEND
TITLE LINOUT OUTPUT ASCIZ STRING FOLLOWED BY A CRLF
ENTRY LINOUT
EXTERN STROUT,CLFOUT
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
RELOC 400000
LINOUT: PUSHJ P,STROUT ;DO A NORMAL STRING OUTPUT
PJRST CLFOUT ;DO A CRLF AND RETURN
PRGEND
TITLE STROUT OUTPUT A PLAIN OLD ASCIZ STRING
ENTRY STROUT
EXTERN CHROUT
SEARCH AC
TWOSEG
RELOC 400000
STROUT: HRLI M,440700 ;MAKE M AN ILDB POINTER
ILDB C,M ;LOAD A CHARACTER FROM STRING
SKIPN C ;IF IT'S THE TERMINATING NULL,
POPJ P, ; THEN RETURN
PUSHJ P,CHROUT ;OTHERWISE, OUTPUT CHARACTER
JRST STROUT+1 ;AND LOOP FOR NEXT CHARACTER
PRGEND
TITLE FILOUT OUTPUT FULL FILE SPECIFICATION (DEV,FIL,EXT,PPN)
ENTRY FILOUT
EXTERN DEVOUT,SXSOUT,PPNOUT,CHROUT,SIX
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
FIL:: EXP 0 ;FOR SIXBIT FILE NAME
EXT:: EXP 0 ;FOR SIXBIT EXTENSION (IN LEFT)
RELOC 400000
FILOUT: PUSHJ P,DEVOUT ;OUTPUT THE DEVICE NAME
PUSH P,FIL ;TRANSFER FILE NAME
POP P,SIX ;TO SIXBIT OUTPUT BUFFER
PUSHJ P,SXSOUT ;DO FILE WITHOUT TRAILING SPACES
HLLZS EXT ;ZERO RIGHT HALF OF EXTENSION
SKIPN EXT ;IF THERE'S NO EXTENSION,
PJRST PPNOUT ; JUST DO PPN AND RETURN
MOVEI C,"." ;LOAD A PERIOD
PUSHJ P,CHROUT ;OUTPUT IT THE SEPARATOR
PUSH P,EXT ;OTHERWISE, TRANSFER EXTENSION
POP P,SIX ;TO SIXBIT OUTPUT BUFFER
PUSHJ P,SXSOUT ;OUTPUT LEFT HALF EXTENSION
PJRST PPNOUT ;OUTPUT PPN AND RETURN
PRGEND
TITLE DEVOUT OUTPUT SIXBIT DEVICE LEFT JUSTIFIED IN "DEV"
ENTRY DEVOUT
EXTERN SXSOUT,CHROUT,SIX
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
DEV:: EXP 0 ;SIXBIT DEVICE NAME
RELOC 400000
DEVOUT: SKIPN DEV ;IF THERE'S NO DEVICE
POPJ P, ; DON'T DO ANYTHING
PUSH P,DEV ;OTHERWISE, TRANSFER DEVICE
POP P,SIX ;TO SIXBIT OUTPUT BUFFER
PUSHJ P,SXSOUT ;AND OUTPUT THE DEVICE
MOVEI C,":" ;THEN LOAD A COLON
PJRST CHROUT ;OUTPUT IT AND RETURN
PRGEND
TITLE SIXOUT OUTPUT THE SIXBIT CHARACTERS IN "SIX"
ENTRY SIXOUT,SXSOUT
EXTERN CHROUT,TSAV3,TSAV2
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
SIX:: EXP 0 ;PLACE WHERE SIXBIT MUST BE LOADED
RELOC 400000
SIXOUT: PUSHJ P,TSAV3 ;SAVE THREE TEMPS W/ AUTO RESTORE
MOVEI T3,6 ;LOAD SIX CHARACTER COUNT
MOVE T2,SIX ;LOAD THE SIXBIT WORD
PUSHJ P,DOSIX ;SHIFT IN AND OUTPUT THE CHAR
SOJG T3,.-1 ;LOOP UNTIL NO MORE CHARS
POPJ P, ;RESTORE TEMPS AND RETURN
SXSOUT: PUSHJ P,TSAV2 ;THIS IS THE SAME AS SIXOUT BUT
MOVE T2,SIX ;SURPRESSES ALL TRAILING SPACES
SKIPN T2 ;IF NO MORE CHARACTERS LEFT,
POPJ P, ; RESTORE TEMPS AND RETURN
PUSHJ P,DOSIX ;ELSE SHIFT AND OUTPUT CHAR
JRST .-3 ;KEEP LOOPING FOR TEST
DOSIX: SETZ T1, ;CLEAR SOME WORKING SPACE
LSHC T1,6 ;SHIFT IN THE SIXBIT CHAR
MOVEI C,40(T1) ;CONVERT IT TO ASCII
PJRST CHROUT ;OUTPUT CHAR AND RETURN TO ABOVE
PRGEND
TITLE PPNOUT OUTPUT [PROJ,PROG] PAIR IN "PPN"
ENTRY PPNOUT
EXTERN CHROUT,OCTOUT
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
PPN:: EXP 0 ;PPN TO BE OUTPUT
RELOC 400000
PPNOUT: SKIPN PPN ;IF NO PPN STATED,
POPJ P, ; DON'T OUTPUT ANYTHING
MOVEI C,"[" ;ELSE LOAD AN OPEN BRACKET
PUSHJ P,CHROUT ;SEND IT TO BE OUTPUT
PUSH P,N ;SAVE THE CURRENT N
HLRZ N,PPN ;LOAD PROJECT NUMBER
PUSHJ P,OCTOUT ;OUTPUT FIRST HALF
MOVEI C,"," ;LOAD A COMMA
PUSHJ P,CHROUT ;OUTPUT THE SEPARATOR
HRRZ N,PPN ;LOAD PROGRAMMER NUMBER
PUSHJ P,OCTOUT ;OUTPUT THE SECOND HALF
POP P,N ;RESTORE PREVIOUS N
MOVEI C,"]" ;LOAD A CLOSE BRACKET
PJRST CHROUT ;OUTPUT IT AND RETURN
PRGEND
TITLE NUMOUT OUTPUT N IN DECIMAL, OCTAL, OR ANY RADIX IN "RAD"
ENTRY DECOUT,OCTOUT,NUMOUT,DIGOUT
EXTERN TSAV2,CHROUT
SEARCH AC
TWOSEG
RAD:: EXP 0 ;THE CURRENT RADIX
RELOC 400000
DECOUT: MOVEM T1,RAD ;SAVE A TEMP IN RADIX
MOVEI T1,^D10 ;LOAD A DECIMAL BASE
EXCH T1,RAD ;RESTORE T1 AND SET RADIX
JRST NUMOUT ;DO THE NUMOUT ROUTINE
OCTOUT: MOVEM T1,RAD ;SAVE A TEMP IN RADIX
MOVEI T1,^O10 ;LOAD AND OCTAL BASE
EXCH T1,RAD ;RESTORE T1 AND SET RADIX
;FALL THROUGH TO NUMOUT
NUMOUT: PUSHJ P,TSAV2 ;SAVE TWO TEMPS W/ AUTO RESTORE
SKIPL T1,N ;CHECK SIGN OF AND LOAD N
JRST DONUM ;POSITIVE OR ZERO--AHEAD
MOVNS T1 ;NEGATIVE--REVERSE THE SIGN
MOVEI C,"-" ;LOAD A MINUS SIGN
PUSHJ P,CHROUT ;OUTPUT THE INDICATOR
DONUM: IDIV T1,RAD ;PUT REMAINDER IN T2
HRLM T2,(P) ;STORE DIGIT IN LEFT OF STACK
SKIPE T1 ;IF STILL MORE DIGITS,
PUSHJ P,DONUM ; DO RECURSIVE CALL
HLRZ C,(P) ;ELSE RESTORE LAST DIGIT
DIGOUT: MOVEI C,"0"(C) ;CONVERT TO ASCII CHAR
PUSHJ P,CHROUT ;AND OUTPUT IT
POPJ P, ;DO NEXT DIGIT OR RETURN
PRGEND
TITLE DMPOUT OUTPUT N IN OCTAL DUMP FORMAT (WITH LEADING 0'S)
ENTRY DMPOUT,RHFOUT,LHFOUT
EXTERN SPCOUT,CHROUT,TSAV3
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
RELOC 400000
DMPOUT: PUSHJ P,LHFOUT ;FIRST DO THE LEFT HALF
PUSHJ P,SPCOUT ;THEN OUTPUT ONE SPACE
;FALL THROUGH FOR RIGHT AND RETURN
RHFOUT: PUSHJ P,TSAV3 ;SAVE THREE TEMPS W/ AUTO RESTORE
HRLZ T2,N ;LOAD UP RIGHT HALF OF N
PJRST DOHLF ;OUTPUT THE HALF AND RETURN
LHFOUT: PUSHJ P,TSAV3 ;SAVE THREE TEMPS W/ AUTO RESTORE
HLLZ T2,N ;LOAD UP LEFT HALF OF N
;FALL THROUGH AND RETURN
DOHLF: MOVEI T3,6 ;LOAD SIX DIGIT COUNT
DODMP: SETZ T1, ;CLEAR WORKING SPACE
LSHC T1,3 ;SHIFT IN ONE DIGIT
MOVEI C,"0"(T1) ;LOAD ITS ASCII VALUE
PUSHJ P,CHROUT ;OUTPUT THE CHARACTER
SOJG T3,DODMP ;LOOP UNTIL NO MORE DIGITS
POPJ P, ;RESTORE TEMPS AND RETURN
PRGEND
TITLE MISC OUTPUT OF COMMON MISCELLANEOUS CHARACTERS
ENTRY DLFOUT,CLFOUT,DSPOUT,SPCOUT,BRKOUT,TABOUT,PLUOUT
EXTERN CHROUT
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
RELOC 400000
DLFOUT: PUSHJ P,CLFOUT ;HERE TO OUTPUT A DOUBLE CRLF
CLFOUT: MOVEI C,15 ;LOAD A CARRIAGE RETURN
PUSHJ P,CHROUT ;GO OUTPUT IT
MOVEI C,12 ;LOAD A LINE FEED
PJRST CHROUT ;OUTPUT IT AND RETURN
DSPOUT: PUSHJ P,SPCOUT ;HERE FOR A DOUBLE SPACE
SPCOUT: MOVEI C,40 ;HERE TO OUTPUT A SPACE
PJRST CHROUT ;OUTPUT IT AND RETURN
BRKOUT: TDZA C,C ;HERE TO FORCE OUT BUFFERS
TABOUT: MOVEI C,11 ;HERE TO OUTPUT A TAB
PJRST CHROUT ;DO WHATEVER AND RETURN
PLUOUT: CAIN N,1 ;HERE TO MAKE THE WORD PLURAL
POPJ P, ;ONLY IF N IS NOT SINGULAR
MOVEI C,"S"+40 ;LOAD UP A LOWER CASE "S"
PJRST CHROUT ;OUTPUT IT AND RETURN
PRGEND
TITLE CHROUT OUTPUT OF THE SINGLE CHARACTER IN C
ENTRY CHROUT,FLCOUT,FUCOUT,FNCOUT
EXTERN TSAV2,TSAV1
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
IFNDEF .FTMOD,<.FTMOD==3> ;MAXIMUM OUTPUT DEVICES (ONLY TTY IF 0)
IFNDEF .FTLMD,<.FTLMD==-1> ;LINE MODE OUTPUT (BREAK ON LF,FF,VT)
IFNDEF .FTTBL,<.FTTBL==^D80> ;TERMINAL BUFFER LENGTH (OUTCHR IF 0)
IFNDEF .FTIOE,<.FTIOE==0> ;FLAG TO IGNORE OUTPUT ERRORS (WHO?)
CFORCE: EXP 0 ;CASE FORCE FLAG (-1 LOWER, 0 NONE, 1 UPPER)
IFG .FTTBL,<
TBCNTR: EXP 0 ;TERMINAL BUFFER COUNTER (FREE CHARS)
TBPNTR: EXP 0 ;TERMINAL BUFFER POINTER (FOR IDPB)
TOBUFR: BLOCK <.FTTBL/5>+1 ;THE TERMINAL OUTPUT BUFFER (FOR OUTSTR)
>;END OF IFG .FTTBL CONDITIONAL
IFG .FTMOD,<
OUTLST::BLOCK .FTMOD ;OUTPUT DEVICE LIST (-1 FOR TTY)
>;END OF IFG .FTMOD CONDITIONAL ;(FORMAT: CHANNEL,,BUFFER RING HEADER ADR)
;(ZERO ENTRIES IGNORED, DON'T TERMINATE)
RELOC 400000
IFG .FTMOD,<OLPNTR:XWD -.FTMOD,OUTLST> ;INITIAL AOBN POINTER TO OUTPUT LIST
;ENTRIES TO DETERMINE CONVERSION OF UPPER/LOWER CASE (100-137,140-177)
FUCOUT: SETZM CFORCE ;HERE TO FORCE UPPER CASE
AOSA CFORCE ;MAKE FLAG POSITIVE
FLCOUT: SETOM CFORCE ;HERE TO FORCE LOWER CASE (NEGATIVE)
POPJ P, ;RETURN
FNCOUT: SETZM CFORCE ;HERE TO CLEAR FORCE REQUEST (ZERO)
POPJ P, ;RETURN
;HERE IS THE ROUTINE YOU'VE ALL BEEN WAITING FOR
CHROUT: CAIGE C,100 ;IF NOT IN CHARACTER RANGE,
JRST CHR0 ; DON'T CHECK FOR CASE FORCE
CAIGE C,140 ;IF NOT IN UPPER CASE RANGE,
SKIPL CFORCE ;OR NOT FORCING LOWER CASE,
CAIA ; DON'T DO ANYTHING
ADDI C,40 ; ELSE CONVERT TO LOWER CASE
CAIL C,140 ;IF NOT IN LOWER CASE RANGE,
SKIPG CFORCE ;OR NOT FORCING UPPER CASE,
CAIA ; DON'T DO ANYTHING
SUBI C,40 ; ELSE CONVERT TO UPPER CASE
CHR0: ;DO THE APPROPRIATE CHROUT ROUTINE
SUBTTL CHROUT ROUTINE MAIN BODY
IFG .FTMOD,< ;ALL THIS GOES UNDER MULTIPLE OUTPUT DEVICE CONDITIONAL
PUSHJ P,TSAV2 ;SAVE TWO TEMPS W/ AUTO RESTORE
TRNN C,177 ;IF WE WERE SENT A NULL BYTE,
PJRST EMPALL ; JUST EMPTY ALL THE BUFFERS
MOVE T1,OLPNTR ;LOAD AOBJ POINTER TO OUTPUT LIST
SKIPE T2,(T1) ;LOAD AN OUTPUT SPEC FROM LIST
PUSHJ P,DOCHR ;DO THIS DEVICE IF GIVEN
AOBJN T1,.-2 ;LOOP UNTIL END OF LIST
IFN .FTLMD,<CAIG C,14 ;IF GREATER THAN A FORM FEED,
CAIGE C,12> ;OR LESS THAN A LINE FEED,
POPJ P, ; THEN RESTORE AND RETURN
EMPALL: MOVE T1,OLPNTR ;HERE TO FORCE OUT ALL BUFFERS
SKIPE T2,(T1) ;LOAD AN OUTPUT SPEC FROM LIST
PUSHJ P,DOBUF ;DO THIS DEVICE IF GIVEN
AOBJN T1,.-2 ;LOOP UNTIL END OF LIST
POPJ P, ;AND RESTORE AND RETURN
>;END OF IFG .FTMOD CONDITIONAL
IFLE .FTMOD,< ;OTHERWISE ALL OUTPUT GOES ONLY TO TERMINAL
IFG .FTTBL,< ;FIRST CHOICE IS FOR INTERNALLY BUFFERED OUTPUT
PUSHJ P,TSAV2 ;SAVE TEMPS ONLY IF WILL BE USED
TRNN C,177 ;IF WE'VE GOT A NULL BYTE,
PJRST TTYEMP ; JUST EMPTY BUFFER AND RETURN
IFN .FTLMD,<PUSHJ P,TTYPUT ;PUT THE CHARACTER IN BUFFER
CAIG C,14 ;IF GREATER THAN A FORM FEED,
CAIGE C,12 ;OR LESS THAN A LINE FEED,
POPJ P, ; JUST DO THE RETURN
PJRST TTYEMP> ;OTHERWISE, EMPTY BUFFER FIRST
IFE .FTLMD,<PJRST TTYPUT> ;OR JUST PUT CHARACTER AND RETURN
>;END OF IFG .FTTBL CONDITIONAL
IFLE .FTTBL,< ;SECOND CHOICE IS FOR OUTCHR'S INSTEAD
TRNN C,177 ;MAKE SURE THERE IS A CHARACTER
POPJ P, ;JUST RETURN IF THERE ISN'T ONE
PJRST TTYPUT ;ELSE OUTCHR CHARACTER AND RETURN
>;END OF IFLE .FTTBL CONDITIONAL
>;END OF IFLE .FTMOD CONDITIONAL
SUBTTL BUFFER ROUTINES FOR CHROUT
IFG .FTMOD,< ;HERE TO PUT A CHAR IN BUFFER
DOCHR: JUMPL T2,TTYPUT ;NEGATIVE ENTRY MEANS FOR TTY
BUFPUT: SOSG 2(T2) ;HERE TO DO IT FOR MONITOR BUFFER
PUSHJ P,BUFEMP ;EMPTY BUFFER IF ALREADY FULL
IDPB C,1(T2) ;LOAD CHAR INTO REAL BUFFER
POPJ P,> ;AND RETURN
TTYPUT: ;HERE FOR TTY CHAR ROUTINE
IFLE .FTTBL,<OUTCHR C> ;IF NO TTY BUFFER, USE OUTCHR
IFG .FTTBL,<SOSG TBCNTR ;ELSE DECREMENT FREE BYTE COUNT
PUSHJ P,TTYEMP ;EMPTY TTY BUFFER IF ALREADY FULL
IDPB C,TBPNTR> ;LOAD UP CHAR INTO TTY BUFFER
POPJ P, ;AND RETURN
IFG .FTMOD,< ;THIS ROUTINE ONLY NEEDED FOR MULTIPLE OUTPUT DEVICES
DOBUF: SKIPG T2 ;NEGATIVE MEANS FOR TTY
IFG .FTTBL,<PJRST TTYEMP> ;EMPTY TTY BUFFER AND RETURN
IFLE .FTTBL,<POPJ P,> ;ALTERNATE IF OUTCHR METHOD
BUFEMP: PUSHJ P,TSAV1 ;HERE FOR REGULAR OUT
MOVSI T1,17 ;LOAD AC FIELD WIDTH
AND T1,T2 ;LOAD CHANNEL SPEC
LSH T1,5 ;SHIFT INTO PLACE
IFE .FTIOE,<TLO T1,(OUT)> ;MAKE AN OUT UUO
IFN .FTIOE,<TLO T1,(OUTPUT)> ;(OUTPUT UUO IF IGNORING ERRORS)
XCT T1 ;AND EXECUTE IT
POPJ P, ;NORMAL RETURN
IFE .FTIOE,<TLZ T1,777000 ;ERROR--CLEAR OP-CODE
TLO T1,(GETSTS) ;MAKE A GETSTS UUO
PUSH P,0 ;FIRST SAVE AC 0
XCT T1 ;EXECUTE THE GETSTS
OUTSTR [ASCIZ/
? Output error in CHROUT -- channel status bits in AC 0
/] ;TYPE OUT ERROR MESSAGE
EXIT 1, ;AND BOMB
POP P,0 ;BUT ALLOW CONTINUE
POPJ P, ;RETURN ANYWAY
>;END OF IFE .FTIOE CONDITIONAL
>;END OF IFG .FTMOD CONDITIONAL
IFG .FTTBL,< ;THIS ROUTINE ONLY IF DOING INTERNALLY BUFFERED OUTPUT TO TTY
TTYEMP: SKIPN TBPNTR ;IF POINTER NOT SET UP,
JRST .+4 ; THEN JUST INIT FIRST TIME
SETZ T2, ;ELSE PREPARE TO DEPOSIT A NULL
IDPB T2,TBPNTR ;AT THE END OF THE TTY BUFFER
OUTSTR TOBUFR ;SO OUTSTR KNOWS WHEN TO STOP
MOVEI T2,.FTTBL ;LOAD TTY BUFFER LENGTH
MOVEM T2,TBCNTR ;INITIALIZE COUNTER
MOVE T2,[POINT 7,TOBUFR] ;LOAD TTY BUFFER POINTER
MOVEM T2,TBPNTR ;NOW INITIALIZE IT, TOO
POPJ P, ;AND RETURN
>;END OF IFG .FTTBL CONDITIONAL
PRGEND
TITLE PDLTSV PDL MANIPULATION ROUTINES FOR SAVING TEMPS
ENTRY TSAV1,TSAV2,TSAV3,TRES3,TRES2,TRES1
SEARCH AC
TWOSEG
OPDEF PJRST [JRST]
RELOC 400000
TSAV1: EXCH T1,(P) ;SAVE T1 AND RECOVER RETURN
MOVEM T1,1(P) ;PUT IT AHEAD OF THE STACK
MOVE T1,(P) ;FIX UP T1 FOR SUBROUTNE
PUSHJ P,@1(P) ;CONTINUE IN CALLED ROUTINE
CAIA ;RETURN HERE IF NORMAL
AOS -1(P) ;RETURN HERE IF SKIP
PJRST TRES1 ;RESTORE AND RETURN
TSAV2: EXCH T1,(P) ;SAVE T1 AND RECOVER RETURN
PUSH P,T2 ;ALSO SAVE T2
MOVEM T1,1(P) ;PUT RETURN AHEAD OF STACK
MOVE T1,-1(P) ;FIX UP T1 FOR SUBROUTINE
PUSHJ P,@1(P) ;CONTINUE IN CALLED ROUTINE
CAIA ;RETURN HERE IF NORMAL
AOS -2(P) ;RETURN HERE IF SKIP
PJRST TRES2 ;RESTORE AND RETURN
TSAV3: EXCH T1,(P) ;SAVE T1 AND RECOVER RETURN
PUSH P,T2 ;ALSO SAVE T2
PUSH P,T3 ;ALSO SAVE T3
MOVEM T1,1(P) ;PUT RETURN AHEAD OF STACK
MOVE T1,-2(P) ;FIX UP T1 FOR SUBROUTINE
PUSHJ P,@1(P) ;CONTINUE IN CALLED ROUTINE
CAIA ;RETURN HERE IF NORMAL
AOS -3(P) ;RETURN HERE IF SKIP
TRES3: POP P,T3 ;RESTORE T3
TRES2: POP P,T2 ;RESTORE T2
TRES1: POP P,T1 ;RESTORE T1
POPJ P, ;RETURN TO ORIGINAL CALLER
PRGEND
TITLE PDLCPJ PDL MANIPULATION ROUTINES FOR DOING SKIP RETURNS
ENTRY CPOPJ2,CPOPJ1,CPOPJ0
SEARCH AC
TWOSEG
RELOC 400000
CPOPJ2: AOS (P) ;NON-STANDARD DOUBLE SKIP RETURN
CPOPJ1: AOS (P) ;REGULAR (APPROVED) SKIP RETURN
CPOPJ0: POPJ P, ;STRAIGHT RETURN (FOR JUMPE, ETC.)
END