Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/rmsm2.mac
There are 3 other files named rmsm2.mac in the archive. Click here to see a list.
TITLE RMSM2 - Formatted message outputter
SUBTTL D. WRIGHT/RL
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
; ALL RIGHTS RESERVED.
;
; 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 THAT IS NOT SUPPLIED BY DIGITAL.
;
;++
; FACILITY: RMSUTL
;
; ABSTRACT:
;
; RMSM2 formats messages for RMSUTL and RMS.
;
; ENVIRONMENT: User mode
;
; AUTHOR: Dave Wright, CREATION DATE: 1982
;
; MODIFIED BY:
;
; Ron Lusk, 6-Feb-84 : VERSION 2.0
;
; 455 - Add support for all RMS key datatypes to the ^S routine
; 456 - TXURFA writes out an RFA as "ID / BUCKET"; it should be
; written as "BUCKET / ID".
;--
SEARCH RMSMAC,RMSINT
IFN TOP$20,<
SEARCH MONSYM,MACSYM
>
IFE TOP$20,<
SEARCH UUOSYM,MACTEN
>
SALL
$PROLOG
DEFINE $GETA,< ;Get next arg
MOVE T1,(AP)
AOJ AP,
>
DEFINE $PUTA,< ;[455] Put an argument back
SOJ AP,
MOVEM T1,(AP)
>
OPDEF PJRST [JRST]
OPDEF IFIW [1B0]
AP==T4+1 ;Arg pointer
SIZDST==^D100*5-1 ;Output buffer size (ASCII bytes)
TMPBSZ==^D20*5-1 ;Max size of string in temp buffer
ENTRY TX$OUT ;Output to terminal
ENTRY TX$SET ;Setup buffer output routine
ENTRY TX$RPT ;Output to alternate destination
;Datatype MOVST conversion tables included here:
; For converting strings to/from ASCII.
INTERN A.TO.S, S.TO.A, E.TO.A, A.TO.E
;Common formats
INTERN MF$ASZ ;Type ASCIZ string, no interpretation
INTERN FFMT ;Format control for FLOUT, DFOUT
;Locations used (in RMS globals area)
EXTERN NOCRFL,NOOUTF,STRBP,NARGS,TEMPBP,TEMPCC,RETAD
EXTERN TTYBP,TTYCC,ALTBFP,ALTCC,DSTBP,DSTCC,OUTBUF
EXTERN TEMPBF,ALTOUT,ALTBCC,BUFDMP,BUFINT,SVT34,SVT56
PACMAX==^D22 ;Maximum packed-decimal field length
;TX$OUT: Call: (BLISS-36 usage)
; PUSH P,arg1
; PUSH P,arg2
; PUSH P,[addr of string] ;local section addr
; PUSHJ P,TX$OUT
; <return here>
;
;or use $CALLB (arg1,arg2..[addr of string]) ;In MACRO
;
;Special sequences in the text (Keyed on up-arrow character):
DEFINE UPDISP,<
XLIST
UPDS "^",UPA ;^^ - one up-arrow
UPDS "A",ASZ,1 ;^A - insert ASCIZ string
UPDS "B",ASC,2 ;^B - ASCII string (2 args, 1=len)
UPDS "C",NCC ;^C - Message to continue (Don't type CRLF, don't output
; it either)
UPDS "D",DAT,1 ;^D - Output a date and time
UPDS "J",JSS,1 ;^J - Output JSYS error number
UPDS "L",CRF ;^L - Type a CRLF here
UPDS "N",NOC ;^N - Don't append CRLF to this message
UPDS "R",RFA,1 ;^R - Output RFA as page#/ID#
UPDS "S",STR,1 ;^S - String (any flavor) with len
; one argument is [EXP bp,len,datatype]
UPDS "1",DEC,1 ;^1 - Output decimal number
UPDS "2",OCT,1 ;^2 - Output octal number
UPDS "P",PAC,1 ;^P - Output packed-decimal number
UPDS "E",DOU,1 ;^E - Output Double-Floating-point number
UPDS "F",FLO,1 ;^F - Output Floating-point number
UPDS "G",GFL,1 ;^G - Output GFloating number
UPDS "8",LON,1 ;^8 - Output Long Integer in Decimal
UPDS "5",R50,1 ;^5 - Output RADIX-50 number
UPDS "U",UNS,1 ;^U - Output Unsigned number
LIST
>;END UPDISP MACRO
$PURE
;Format word for TOPS-20 FLOUT% and DFOUT% JSYS
FFMT: Z ;Default to free form floating point output
;Simple message formats
MF$ASZ: ASCIZ/^A/ ;No frills
;TX$RPT is the same as TX$OUT except outputs to altenate destination
; buffer, with alternate routine to signal buffer full.
;You must have called TX$SET first
TX$RPT: SETOM ALTOUT ;Output to alternate buffer
JRST TXOUT0 ;Go on
;TX$OUT is the TTY output routine
TX$OUT: SETZM ALTOUT ;Output to TTY
TXOUT0: PUSHJ P,GETARG ;Get args, resolve addresses
SKIPE NOOUTF ;Is this a continued message?
JRST TXYCON ;Yes
SKIPN ALTOUT ;Skip if alternate output init
JRST TXOUT1 ;No
PUSHJ P,@BUFINT ;Init buffer pointers
MOVE T1,ALTBCC ;Get address of where user stored BP, CC
DMOVE T1,(T1) ;Fetch it
DMOVEM T1,DSTBP ;Save dest BP, char count.
JRST TXYGO ; and go.
TXOUT1: PUSHJ P,INIBF ;Init buffer pointer, char count
JRST TXYGO ; and go.
;Previous message continued.
TXYCON: DMOVE T1,TTYBP ;Assume TTY stuff
SKIPE ALTOUT ; Unless this was a call of TX$RPT
DMOVE T1,ALTBFP ;. .
DMOVEM T1,DSTBP ;Setup initial dest BP, CC to continue.
;Initialize Per-call variables
TXYGO: SETZM NOOUTF ;String not continued.
SETZM NOCRFL ;Clear "no crlf" flag.
;Come here to interpret next character of message format.
TXLUP: ILDB T1,STRBP ;Get char from string
JUMPE T1,TXOUTD ;Done, do something
CAIN T1,"^" ;Up-arrow?
JRST TXUP ;Yes, do something funny.
TXUUPA: PUSHJ P,PUTC ;Put char in dest string
JRST TXLUP ;Loop
;Here if up-arrow seen and we care.
DEFINE UPDS (CHAR,NAM,ARGS<0>),<
CAIN T1,CHAR
JRST TXU'NAM
>
TXUP: ILDB T1,STRBP ;Get next char
UPDISP ;Dispatch
MOVEI T1,[ASCIZ/?? RMS message error ??/]
JRST TXASZO ;Output like this
;Append ASCIZ string
TXUASZ: $GETA ;Fetch arg
TXASZO: TLNN T1,770000 ;BP?
HRLI T1,(POINT 7,) ;No, make local BP
MOVEM T1,TEMPBP ;Save BP
TXASZ1: ILDB T1,TEMPBP
JUMPE T1,TXLUP ;Jump if null seen
PUSHJ P,PUTC ;Output character
JRST TXASZ1 ;Loop
TXUNCC: SETOM NOOUTF ;Message continues past end.
TXUNOC: SETOM NOCRFL ;Set "No CRLF" flag
JRST TXLUP ;Go on.
;Append JSYS error
TXUJSS: $GETA ;Get jsys number (-1 if last)
IFN TOP$10, HALT . ;?No can do for TOPS-10
IFN TOP$20,<
HRLI T1,.FHSLF ;My fork
MOVE T2,T1 ;Put in T2
MOVE T1,[POINT 7,TEMPBF] ;Output place
MOVEI T3,TMPBSZ ;Size of buffer
ERSTR% ;Get the error text
JFCL
JFCL
MOVEI T1,TEMPBF ;Append ASCII string
PUSHJ P,APPASZ
>;END IFN TOP$20
JRST TXLUP ;Go on
;Append ASCII string with len as arg.
TXUASC: $GETA ;Get ptr to string
TLNN T1,770000 ;BP?
HRLI T1,(POINT 7,) ;No, make local BP
MOVEM T1,TEMPBP ;Save it
$GETA ;Get char count
MOVEM T1,TEMPCC ;Save it
TXAS1L: SOSGE TEMPCC ;String exhausted?
JRST TXLUP ;Yes, go on
ILDB T1,TEMPBP ;Get char
PUSHJ P,PUTC ;Store it
JRST TXAS1L ;Loop
;Append CRLF
TXUCRF: MOVEI T1,.CHCRT
PUSHJ P,PUTC
MOVEI T1,.CHLFD
PUSHJ P,PUTC
JRST TXLUP
;Append Date/time string
TXUDAT: $GETA ;Get t1= internal date/time
SETZ T3, ;Set flag saying both date and time
JRST PUTDT
;Routine to append date/time to string
;Call: T3/ flags (TOPS20: OD%NTM,OD%NDA, or 0)
; T1/ Date-time in internal format
; returns to TXLUP when done
PUTDT:
IFN TOP$20,<
MOVE T2,T1 ;Get date/time in T2
MOVE T1,[POINT 7,TEMPBF] ;Get ptr to temp buffer
MOVEM T1,TEMPBP
ODTIM% ;DO it
ERJMP EROWE ;?Couldn't put it out
PUTDT1: ILDB T1,TEMPBP ;Get char
JUMPE T1,TXLUP ;Return when done
PUSHJ P,PUTC ;Output char
JRST PUTDT1 ;Loop until null
EROWE: MOVEI T1,[ASCIZ/** Bad date-time **/]
JRST TXASZO ;Output error message instead
>;END TOP$20
IFN TOP$10,<
MOVEI T1,[ASCIZ/** Date-time output NYI **/]
JRST TXASZO
>;END TOP$10
;Append random string
TXUSTR: $GETA ;Get addr of [EXP BP,len,datatype]
MOVE T3,2(T1) ;Get T3= datatype
DMOVE T1,(T1) ;Get t1= BP, t2= len
MOVEM T1,TEMPBP
MOVEM T2,TEMPCC
MOVE T1,[XWD -NDTPS,TXUSTD] ;AOBJN word to datatype table
TXUST1: HLRZ T2,(T1) ;Get datatype
CAIN T2,(T3) ;This the one?
JRST TXUST2 ;Yes, go dispatch
AOBJN T1,TXUST1 ;Loop till found
MOVEI T1,[ASCIZ/*** Message error - datatype not supported /]
JRST TXASZO ;Put error in message
TXUST2: HRRZ T2,(T1) ;Get dispatch address
JRST (T2) ;Dispatch
TXUSTD: DT%SIX,,TXUS6 ;Sixbit
DT%ASC,,TXUS7 ;ASCII
DT%EBC,,TXUS9 ;EBCDIC
DT%PAC,,TXUSP ;[455] Packed Decimal
DT%FL1,,TXUSF1 ;[455] One-word floating
DT%FL2,,TXUSF2 ;[455] Two-word floating
DT%GFL,,TXUSGF ;[455] G-floating
DT%IN4,,TXUSI4 ;[455] One-word integer
DT%AS8,,TXUS7 ;[455] Hope standard ASCII works
DT%IN8,,TXUSI8 ;[455] Two-word integer
DT%UN4,,TXUSU4 ;[455] Unsigned word
NDTPS==.-TXUSTD ;Number of supported datatypes
;
; TXUSU4 - Unsigned integer output
;
; There is a 36-bit byte pointer to the data in TEMPBP on entry.
; Put the integer out in octal, using TXUOCT.
;
TXUSU4: HRRZ T1,TEMPBP ;[455] Get address of data
MOVE T1,(T1) ;[455] Get data itself
$PUTA ;[455] Throw it on stack
JRST TXUOCT ;[455] Output in octal
;
; TXUSI8 - Two-word integer output
;
; A 36-bit byte-pointer to the data is in TEMPBP on entry.
; The output routine requires the address of the doubleword
; as an argument, so oblige it.
;
TXUSI8: HRRZ T1,TEMPBP ;[455] Get address of doubleword
$PUTA ;[455] Put it back as an argument
JRST TXULON ;[455] Output a doubleword
;
; TXUSI4 - One-word integer
;
; A 36-bit byte pointer to data is in TEMPBP on entry.
; Throw the data itself back on the argument list and
; call the decimal output routine. First, however, put
; out a sign if appropriate.
;
TXUSI4: HRRZ T1,TEMPBP ;[455] Get the address
MOVE T1,(T1) ;[455] Get the number proper
JUMPGE T1,TXUS4I ;[455] Leave positive numbers alone
MOVNS T1 ;[455] Make it negative
$PUTA ;[455] Put it on the stack
MOVEI T1,"-" ;[455] Put out a minus sign
PUSHJ P,PUTC ;[455] ...
JRST TXUDEC ;[455] Output in decimal
TXUS4I: $PUTA ;[455] Put positive number on stack
JRST TXUDEC ;[455] Go do the output
;
; TXUSGF - G-floating output
;
; A 36-bit byte pointer to data is in TEMPBP on entry.
; Take only the data's address from it and "replace"
; that as an argument, then jump to TXUGFL.
;
TXUSGF: HRRZ T1,TEMPBP ;[455]
$PUTA ;[455]
JRST TXUGFL ;[455]
;
; TXUSF2 - Two-word floating output
;
; A 36-bit byte pointer to data is in TEMPBP on entry.
; Take only the data's address from it and "replace"
; that as an argument, then jump to TXUDOU.
;
TXUSF2: HRRZ T1,TEMPBP ;[455]
$PUTA ;[455]
JRST TXUDOU ;[455]
;
; TXUSF1 - One-word floating output
;
; A 36-bit byte pointer to data is in TEMPBP on entry.
; Use it to fetch the data and put the data on the stack,
; then enter TXUFLO.
;
TXUSF1: HRRZ T1,TEMPBP ;[455] Get address of data
MOVE T1,(T1) ;[455] Get floating-point number
$PUTA ;[455] Shove it back on the stack
JRST TXUFLO ;[455] Put the number out
;
; TXUSP - Packed decimal output
;
; Byte pointer is in TEMPBP on entry. Put it back on the
; stack and enter TXUPAC as a normal entry.
;
TXUSP: MOVE T1,TEMPBP ;[455] Get pointer back
$PUTA ;[455] Put argument "back"
JRST TXUPAC ;[455] Output packed number
;Sixbit string
TXUS6: SOSGE TEMPCC ;Any more chars?
JRST TXLUP ;No, go on
ILDB T1,TEMPBP ;Get char
ADDI T1,40 ;Make ASCII
PUSHJ P,PUTC ;Output the character
JRST TXUS6 ;Loop for whole string
;7-bit ASCII string
TXUS7: SOSGE TEMPCC ;Any more chars?
JRST TXLUP ;No, go on
ILDB T1,TEMPBP ;Get char
PUSHJ P,PUTC ;Output the character
JRST TXUS7 ;Loop for whole string
;EBCDIC string
; Have to use MOVST to get ASCII string.
TXUS9: DMOVEM T3,SVT34 ;Save some acs
DMOVEM 5,SVT56 ;For EXTEND to use
TXUS9L: MOVE T1,TEMPCC ;Get source length
MOVE T2,TEMPBP ;Source BP
SETZB T3,6 ;[455] Zero extra ACs
MOVEI 4,TMPBSZ ;[455] Get dest length
MOVE 5,[POINT 7,TEMPBF] ;dest BP
EXTEND 1,[EXP <MOVST E.TO.A>,<0>] ;[455] Translate, no fill
JFCL ;Source too long, we'll see that in a min.
TLZ T1,777000 ;[455] Zero significance bits before saving
PUSH P,T1 ;Save # chars not moved
PUSH P,T2 ; updated source ptr.
SETZ T1, ;Insure null at end of string
IDPB T1,5
MOVEI T1,TEMPBF ;Get addr of ASCIZ string
PUSHJ P,APPASZ ;Append ASCIZ string
POP P,TEMPBP ;TEMPBP
POP P,TEMPCC
SKIPE TEMPCC ;Any more to do?
JRST TXUS9L ;Yes, loop
TXUS9D: DMOVE 5,SVT56 ;Restore acs
DMOVE T3,SVT34
JRST TXLUP
;Routine to append an ASCIZ string
;Uses TEMPBP
;Call: T1/ addr of ASCIZ string
APPASZ: HRLI T1,(POINT 7,) ;Ptr to string
MOVEM T1,TEMPBP
APPAS1: ILDB T1,TEMPBP
JUMPE T1,APPAS2
PUSHJ P,PUTC
JRST APPAS1
APPAS2: POPJ P,
;Append decimal numbers
TXUDEC: MOVEI T1,^D10 ;Get decimal ;m512
MOVEM T1,TEMPCC ;Save temp radix
$GETA ;Get number
PUSHJ P,TXUBAS ;Output number
JRST TXLUP ;And loop.
; Unsigned Octal
TXUOCT: $GETA ;Get the number ;a512vv
MOVE T2,T1 ;Put the number in a safer place
MOVE T3,[440300,,T2] ;Make byte pointer
MOVSI T4,^D-12 ;Counter in LH
TXUOLP: ILDB T1,T3 ;Get a digit
TRNN T4,200000 ;Significant?
JUMPE T1,TXUOC1 ;Maybe not
TRO T4,200000 ;Yes, a significant digit
ADDI T1,"0" ;Ascisize
PUSHJ P,PUTC ;Output it
TXUOC1: AOBJN T4,TXUOLP ;Loop
JRST TXLUP ;Continue ;a512^^
;Append RFA
TXURFA: $GETA ;Get P#,,id#
PUSH P,T1 ;Save that a sec.
MOVEI T2,^D10 ;Output dec number
MOVEM T2,TEMPCC
HRRZ T1,T1 ;[456] Get page #
PUSHJ P,TXUBAS
MOVEI T1,"/"
PUSHJ P,PUTC
POP P,T1
HLRZ T1,T1 ;[456] Get id #
PUSHJ P,TXUBAS ;Put it out
JRST TXLUP ; and loop back
;Routine to append a number in a base.
; Number in t1, base in TEMPCC.
TXUBAS: IDIV T1,TEMPCC ;Divide by base
PUSH P,T2
SKIPE T1
PUSHJ P,TXUBAS ;Recurse
POP P,T1
ADDI T1,"0" ;Make ASCIZ character
PJRST PUTC ;Output it and unwind
TXOLON: ;Type out a long integer in decimal
DMOVE T4,(T1) ;Get the number into T2-T3-T4-T5
JUMPGE T4,TXOLO0 ;Is it positive
MOVEI T1,"-" ;Type minus sign
PUSHJ P,PUTC ;
DMOVN T4,T4 ;Get absolute value
TXOLO0: SETZB T2,T3 ;Zero two high-order ACs
DDIV T2,[EXP 0,^D10] ;Divide it by the radix
PUSH P,T5 ;Save remainder
DMOVE T4,T2 ;Move quotient back down
JUMPN T3,.+2 ;Not done unless both
JUMPE T2,TXOLO1 ;registers are zero
PUSHJ P,TXOLO0 ;Recurse
TXOLO1: POP P,T1 ;Retrieve a remainder
MOVEI T1,"0"(T1) ;Ascisize it
PJRST PUTC ;Output character & return
TXODOU: SKIPA T2,[CVTDL##] ;Type Double precision floating in decimal
TXOGFL: MOVEI T2,CVTGL## ;Type out a G-Floating integer in decimal
ADJSP P,2 ;Make room for the result
PUSH P,T1 ;Addr of Gfloat
MOVEI T1,-2(P) ;Addr of local storage we just created
PUSH P,T1 ;Pass this also to the routine
PUSHJ P,(T2) ;Convert to Long integer with scale factor
ADDI T1,^D19 ;Adjust scale factor for decimal point
MOVEM T1,(P) ;addr containing long int <> Scale factor
DMOVE T4,-3(P) ;Get it
JUMPGE T4,TXOGL1 ;Is it positive
DMOVN T4,T4 ;No, negate it
MOVEI T1,"-" ;Type minus sign
PUSHJ P,PUTC ;
TXOGL1: SETZB T2,T3
DDIV T2,[2126,,162140
221172,,0] ;Divide by 10**19
DMOVEM T4,-3(P) ;Put remainder back
MOVEI T1,"0"(T3) ;Convert quotient into first digit
PUSHJ P,PUTC ;Type first digit
MOVEI T1,"." ;Type decimal point
PUSHJ P,PUTC ;
MOVEI T1,-3(P) ;Addr of long integer
PUSHJ P,TXOLON ;type rest of it
MOVEI T1,"E" ;Introduce the exponent
PUSHJ P,PUTC ;
SKIPL (P) ;Is exponent negative?
SKIPA T1,["+"] ;Type plus sign
MOVEI T1,"-" ;Type minus sign
PUSHJ P,PUTC ;
MOVEI T1,^D10 ;Set to base 10
MOVEM T1,TEMPCC ;
POP P,T1 ;Get back scale factor
MOVM T1,T1 ;Make it absolute
PUSHJ P,TXUBAS ;Type it
ADJSP P,-3 ;Return local storage
POPJ P, ;Return
;RADIX50 arg.
TXUR50: $GETA ;Fetch the arg.
TLZ T1,740000 ;Insure the flag bits are off
MOVEI T4,6 ;Len of R50 field
R50PLP:
IDIVI T1,50 ;Get current low-order digit
SETZ T3, ;Start with null match
CAIL T2,1 ;In digit range?
MOVEI T3,"0"-1(T2) ;Yes
CAIL T2,13 ;In alpha range?
MOVEI T3,"A"-13(T2) ;Yes
CAIN T2,45 ;Match "."?
MOVEI T3,"." ;Yes
CAIN T2,46 ;Match "$"?
MOVEI T3,"$" ;Yes
CAIN T2,47 ;Match "%"?
MOVEI T3,"%" ;Yes
JUMPE T3,R50PLE ;Exit on nul
PUSH P,T3 ;Save till end
SOJG T4,R50PLP ;Loop back if more left
R50PLE:
HRREI T4,-6(T4) ;Get neg # chars processed by R50PLP
R50CLP: POP P,T1 ;Get char back
PUSHJ P,PUTC ;Write it out
AOJL T4,R50CLP
JRST TXLUP ; And loop
TXUFLO: ;Floating Point ;A411
$GETA ;Get number
PUSH P,T1 ;Make it double
ASH T1,-^D35 ;Make the second word look like the sign bit
PUSH P,T1 ;
MOVEI T1,-1(P) ;Addr of the now-double floating number
PUSHJ P,TXODOU ;Type it out
ADJSP P,-2 ;Restore stack
JRST TXLUP ;And loop.
TXUDOU: ;Double Floating Point ;A411
$GETA ;Get number
PUSHJ P,TXODOU ;Print it
JRST TXLUP ;And loop.
TXUGFL: ;G-Floating Point ;A411
$GETA ;Get addr of number
PUSHJ P,TXOGFL ;Print it ;A411
JRST TXLUP ;And loop.
TXUUNS: ;Unsigned Integer ;A411
$GETA ;Get number ;A411
PUSH P,[0] ;Make long integer ;A411
PUSH P,T1 ;on stack ;A411
MOVEI T1,-1(P) ;Get addr of it ;A411
PUSHJ P,TXOLON ;Type it out ;A411
ADJSP P,-2 ;Fix stack ;A411
JRST TXLUP ;And Loop
TXULON: ;Long Integer ;A411
$GETA ;Get number
PUSHJ P,TXOLON ;Print it ;A411
JRST TXLUP ;And loop.
TXUPAC: ;Packed Decimal ;A411
MOVEI T1,PACMAX ;Max packed field size ;A411
CAML T1,DSTCC ;Enough room in buffer?
PUSHJ P,PUTCDM ;No, dump what we got.
$GETA ;Get byte pointer to packed number ;A411
MOVEM T1,TEMPBP ;Routine wants ;A411
MOVEI T1,TEMPBP ; addr of byte pointer ;A411
MOVEI T2,DSTBP ; addr of dest byte pointer ;A411
$CALLB CVTPS##,<T1,T2> ;Print it ;A411
MOVNS T1 ;Negate
ADDM T1,DSTCC ;Subtract from char count
JRST TXLUP ;And loop.
;Here when done outputting string.
TXOUTD: SKIPE NOOUTF ;Don't output string?
JRST TXRET ;Right, return and let him append to string.
SKIPE NOCRFL ;Unless flag set
JRST TXOUTE
MOVEI T1,.CHCRT ;He wants CRLF
PUSHJ P,PUTC
MOVEI T1,.CHLFD ;. .
PUSHJ P,PUTC
TXOUTE: SKIPN ALTOUT ;Skip if alternate output routine
PJRST DMPBUF ;No, just dump buffer and return to caller
JRST @BUFDMP ;Yes, dump alternate buffer and return to caller
;Return but don't output string Yet.
; We have to store the BP and char count where we are.
TXRET: DMOVE T1,DSTBP ;Get BP, CC
SKIPE ALTOUT ;Skip if regular output.
JRST TXRETA
DMOVEM T1,TTYBP ; TTY output
POPJ P,
TXRETA: DMOVEM T1,ALTBFP ;Save alternate BP, CC
POPJ P, ;Return to user.
;Routine to output character
;Uses only T1
PUTC: SOSGE DSTCC ;Any room?
JRST PUTCDM ;No, dump what we got.
IDPB T1,DSTBP
POPJ P,
;Buffer is full, dump it.
PUTCDM: PUSH P,T1 ;Save char
SKIPE ALTOUT ;Alternate output?
JRST PUTCDA ;Yes
PUSHJ P,DMPBUF ;Dump buffer
PUSHJ P,INIBF ;Re-Init buffer
POP P,T1 ;Restore char
JRST PUTC ;Try outputting char now.
PUTCDA: PUSH P,T2 ;Allow user to smash any temp ac's.
PUSH P,T3
PUSH P,T4
PUSHJ P,@BUFDMP ;Call user's routine to dump buffer
PUSHJ P,@BUFINT ;Call user's routine to re-init buffer
MOVE T1,ALTBCC ;Get address of char count,,byte ptr
DMOVE T1,(T1) ;Get new stuff
DMOVEM T1,DSTBP ;Save new dest BP, char count
POP P,T4
POP P,T3
POP P,T2
POP P,T1
JRST PUTC ;Try outputting char now.
;Routine to dump TTY buffer
DMPBUF: MOVEI T1,0
IDPB T1,DSTBP ;Store null
IFN TOP$10,<
OUTSTR OUTBUF
>
IFN TOP$20,<
HRROI 1,OUTBUF
PSOUT%
>
POPJ P,
;Routine to init TTY buffer pointer and char count
; Just stores directly into DSTBP and DSTCC
INIBF: MOVE T1,[POINT 7,OUTBUF]
MOVEM T1,DSTBP ;Save dest. BP
MOVEI T1,SIZDST ;# chars in buffer
MOVEM T1,DSTCC ;Save char count
POPJ P, ;Return
;Routine to get args, put string BP in STRBP.
GETARG: MOVE T1,-2(P) ;Fetch string arg.
TLNN T1,770000 ;Is it a byte ptr?
HRLI T1,(POINT 7,) ;No, make local BP
MOVEM T1,STRBP ;Save string Byte ptr.
MOVEM T1,TEMPBP ;And put in mem loc for this routine too
SETZM NARGS ;Count args..
CPYLP: ILDB T1,TEMPBP ;Get character
JUMPE T1,CPYCPY ;Null ends string.
CAIE T1,"^" ;Uparrow?
JRST CPYLP ;No, loop.
;Up-arrow in text string
ILDB T1,TEMPBP ;Get next char.
JUMPE T1,CPYCPY ;Null ends string.
DEFINE UPDS(CHAR,NAM,NUMARG<0>),<
IFG NUMARG,<
CAIN T1,CHAR
JRST C'NUMARG'ARG
>>
UPDISP ;Do the work.
JRST CPYLP ;No args or unknown letter, Continue
C2ARG: AOS NARGS ;Count args
C1ARG: AOS NARGS
JRST CPYLP ;Continue
;Here when scanned string and know how many args there are.
CPYCPY: XMOVEI AP,-2(P) ;Place where args are.
SUB AP,NARGS ;Point to first arg.
POPJ P, ;Done, return
;TX$SET sets up the alternate output parameters.
;Call:
; PUSH P,[address of [EXP buffer pointer,char count]
; PUSH P,[address of buffer full routine]
; PUSH P,[address of routine to init buffer pointer, char count]
TX$SET: MOVE T1,-3(P) ;Get address of [EXP pointer, char count]
MOVEM T1,ALTBCC ;Save this address
MOVE T1,-2(P) ;Get address of buffer dump routine
XMOVEI T1,(T1)
MOVEM T1,BUFDMP ;Save it
MOVE T1,-1(P) ;Get address of init buffer routine
XMOVEI T1,(T1)
MOVEM T1,BUFINT ;Save it
POPJ P, ;Return
;
SUBTTL MOVST tables
A.TO.S: ;ASCII TO SIXBIT CONVERSION
XWD 000074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400074,400000
XWD 400074,400074
XWD 400074,400074
XWD 400074,400074
XWD 000074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400074,400074
XWD 400000,000001
XWD 400002,400003
XWD 400004,400005
XWD 400006,400007
XWD 400010,400011
XWD 400012,400013
XWD 400014,400015
XWD 400016,400017
XWD 000020,400021
XWD 400022,400023
XWD 400024,400025
XWD 400026,400027
XWD 400030,400031
XWD 000032,400033
XWD 400034,400035
XWD 400036,000037
XWD 000040,400041
XWD 400042,400043
XWD 400044,400045
XWD 400046,400047
XWD 400050,400051
XWD 400052,400053
XWD 400054,400055
XWD 400056,400057
XWD 400060,400061
XWD 400062,400063
XWD 400064,400065
XWD 400066,400067
XWD 400070,400071
XWD 400072,000073
XWD 400074,000075
XWD 400076,400077
XWD 000074,400041
XWD 400042,400043
XWD 400044,400045
XWD 400046,400047
XWD 400050,400051
XWD 400052,400053
XWD 400054,400055
XWD 400056,400057
XWD 400060,400061
XWD 400062,400063
XWD 400064,400065
XWD 400066,400067
XWD 400070,400071
XWD 400072,000073
XWD 400074,000075
XWD 400074,400074
S.TO.A: ;SIXBIT TO ASCII
XWD 400040,400041
XWD 400042,400043
XWD 400044,400045
XWD 400046,400047
XWD 400050,400052
XWD 400052,400053
XWD 400054,400055
XWD 400056,400057
XWD 400060,400061
XWD 400062,400063
XWD 400064,400065
XWD 400066,400067
XWD 400070,400071
XWD 400072,400073
XWD 400074,400075
XWD 400076,400077
XWD 400100,400101
XWD 400102,400103
XWD 400104,400105
XWD 400106,400107
XWD 400110,400111
XWD 400112,400113
XWD 400114,400115
XWD 400116,400117
XWD 400120,400121
XWD 400122,400123
XWD 400124,400125
XWD 400126,400127
XWD 400130,400131
XWD 400132,400133
XWD 400134,400135
XWD 400136,400137
E.TO.A: ;EBCDIC TO ASCII
XWD 300000,700001
XWD 700002,700003
XWD 700024,700011
XWD 700016,700177
XWD 700134,700134
XWD 700134,700013
XWD 700014,700134
XWD 700134,700134
XWD 300134,700134
XWD 700134,700034
XWD 700021,700015
XWD 700010,700026
XWD 700134,700031
XWD 700032,700134
XWD 700134,700134
XWD 700134,700134
XWD 300036,700035
XWD 700037,700134
XWD 700020,700012
XWD 700027,700033
XWD 700134,700134
XWD 700030,700134
XWD 700134,700005
XWD 700006,700007
XWD 300134,700134
XWD 700134,700134
XWD 700022,700023
XWD 700017,700004
XWD 700134,700134
XWD 700134,700134
XWD 700134,700025
XWD 700134,700134
XWD 400040,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700056
XWD 700074,700050
XWD 700053,700174
XWD 300046,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700041,700044
XWD 700052,700051
XWD 700073,700136
XWD 700055,700057
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700054
XWD 700045,700137
XWD 700076,700077
XWD 300134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700140
XWD 700072,700043
XWD 700100,700047
XWD 700075,700042
XWD 300134,400141
XWD 400142,400143
XWD 400144,400145
XWD 400146,400147
XWD 400150,400151
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 300134,400152
XWD 400153,400154
XWD 400155,400156
XWD 400157,400160
XWD 400161,400162
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 300134,700176
XWD 400163,400164
XWD 400165,400166
XWD 400167,400170
XWD 400171,400172
XWD 700134,700134
XWD 700134,700133
XWD 700134,700134
XWD 300134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 700134,700135
XWD 700134,700134
XWD 300173,400101
XWD 400102,400103
XWD 400104,400105
XWD 400106,400107
XWD 400110,400111
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 300175,400112
XWD 400113,400114
XWD 400115,400116
XWD 400117,400120
XWD 400121,400122
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 300134,700134
XWD 400123,400124
XWD 400125,400126
XWD 400127,400130
XWD 400131,400132
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
XWD 300060,700061
XWD 700062,700063
XWD 700064,700065
XWD 700066,700067
XWD 700070,700071
XWD 700134,700134
XWD 700134,700134
XWD 700134,700134
A.TO.E: ;ASCII TO EBCDIC
XWD 000000,400001
XWD 400002,400003
XWD 400067,400055
XWD 400056,400057
XWD 400026,400005
XWD 400045,400013
XWD 400014,400025
XWD 400006,400066
XWD 000044,400024
XWD 400064,400065
XWD 400004,400075
XWD 400027,400046
XWD 400052,400031
XWD 400032,400047
XWD 400023,400041
XWD 400040,400042
XWD 400100,000132
XWD 400177,400173
XWD 400133,400154
XWD 400120,400175
XWD 400115,400135
XWD 400134,400116
XWD 400153,400140
XWD 400113,400141
XWD 000360,400361
XWD 400362,400363
XWD 400364,400365
XWD 400366,400367
XWD 400370,400371
XWD 000172,400136
XWD 400114,400176
XWD 400156,000157
XWD 000174,400301
XWD 400302,400303
XWD 400304,400305
XWD 400306,400307
XWD 400310,400311
XWD 400321,400322
XWD 400323,400324
XWD 400325,400326
XWD 400327,400330
XWD 400331,400342
XWD 400343,400344
XWD 400345,400346
XWD 400347,400350
XWD 400351,000255
XWD 400340,000275
XWD 400137,400155
XWD 000171,400201
XWD 400202,400203
XWD 400204,400205
XWD 400206,400207
XWD 400210,400211
XWD 400221,400222
XWD 400223,400224
XWD 400225,400226
XWD 400227,400230
XWD 400231,400242
XWD 400243,400244
XWD 400245,400246
XWD 400247,400250
XWD 400251,000300
XWD 400117,000320
XWD 400241,400007
XLIST ;Expand literals in hiseg
LIT
LIST
END