Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/comp/sm.mac
There is 1 other file named sm.mac in the archive. Click here to see a list.
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
AUTHOR: CLAES WIHLBORG
UPDATE: 6
PURPOSE: MISC. SUBROUTINES USED BY SR
CONTENT:
SMERR
SMLINE
SMLIND
SMUID
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SALL
SEARCH SIMMC1,SIMMAC
CTITLE SM
SUBTTL PROLOGUE
INTERN SMERR,SMLINE,SMLIND,SMUID
EXTERN O1IC1,T1AB
EXTERN YELIN1,YELIN2,YESEM
EXTERN YSMLIN,YSMSEM
MACINIT
TWOSEG
RELOC 400000
SUBTTL SMERR
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: SMERR IS CALLED WHENEVER SR HAS FOUND AN ERROR.
IT CREATES AN ERROR MESSAGE AND TAKE SOME OTHER
ACTIONS IMPLIED BY THE ERROR.
ENTRY CONDITIONS: THE CALLING ARGUMENT HAS THE FORMAT:
BIT 0-17 SYMBOL TO BE EDITED INTO MESSAGE
BIT 18-26 SWITCHES
BIT 27-35 ERROR NUMBER
EXIT CONDITIONS: IF TERMINATION ERROR BRANCH TO T1AB.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;DEFINE SWITCHES IN ARGUMENT
DEFINE X(A)<
DEFINE Y(B,C)<RADIX 8
DSW(Z1SE'B,0,C,SLASK)>
IRPC A,<RADIX 10
Y(A,\QSRE'A)>
>
X GEPCASTW
DEFINE ERRM(N)<
IFB<N>,<ADD XUUO,[ERR]>
IFNB<N>,<ADD XUUO,[ERRI'N]>
XCT XUUO
>
D1=1
D2=2
ENR=12
SLASK=5
XUUO=10
SMERR:
IFG QDEBUG,< PROC <TXT,ARG>>
IFE QDEBUG,< PROC ARG>
SAVE <D1,D2,ENR,SLASK,XUUO>
L ENR,ARG
L SLASK,ENR
ANDI ENR,777
;OUTPUT SYMBOLS TO IC1
IF IFOFFA Z1SEP
GOTO FALSE
THEN
LI X1SR0,%PURGE
PUTIC1 X1SR0
FI
IF IFOFFA Z1SEE
GOTO FALSE
THEN
LI X1SR0,%ERROR
PUTIC1 X1SR0
FI
;CREATE ERROR MESSAGE
;IFN QDEBUG,<OUTSTR @TXT
; OUTSTR [ASCIZ/
;/]>
IFN QERIMP,<
L XUUO,[Z QE,0(ENR)]
IFONA Z1SET
L XUUO,[Z QT,0(ENR)]
IFONA Z1SEW
L XUUO,[Z QW,0(ENR)]
L YSMLIN
ST YELIN1
L YSMSEM
ST YESEM
SETZM YELIN2
IF IFOFFA Z1SEC
GOTO FALSE
THEN
L D1,X1CUR
IF IFOFFA Z1SEA
GOTO FALSE
THEN
HLRZ D2,SLASK
ERRM(2)
ELSE
ERRM(1)
FI
ELSE
IF IFOFFA Z1SEA
GOTO FALSE
THEN
HLRZ D1,SLASK
ERRM(1)
ELSE
ERRM
FI
FI
>
IFONA Z1SET
BRANCH T1AB ;IF TERMINATION ERROR
IFONA Z1SEG
SETONA YERNC ;IF NO CODE GENERATION
IFONA Z1SES
SETONA YERNP2 ;IF NO PASS 2 PROCESSING
RETURN
EPROC
SUBTTL SMLINE
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: PERFORM ACTIONS IMPLIED BY THE START OF A STATEMENT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SMLINE: PROC
;OUTPUT LINE SYMBOL TO IC1
LF X1SR0,YLSCLIN
ST X1SR0,YSMLIN
TRO X1SR0,400K ;SET FLG LINE SYMBOL
PUTIC1 X1SR0
LF X1SR0,YLSCSEM
ST X1SR0,YSMSEM
PUTIC1 X1SR0
LF X1SR0,YLSLLIN
PUTIC1 X1SR0
;FILL END-LINE OF GENERATED ERROR MESSAGES
IFG QERIMP,<
EXTERN YECHDM
SKIPGE YECHDM
RETURN
ST X1SR0,YELIN2
ERRLI
>
RETURN
EPROC
SUBTTL SMLIND
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: PERFORM ACTIONS IMPLIED BY THE START OF A DECLARATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SMLIND: PROC
;OUTPUT LINE SYMBOL TO IC1
LF X1SR0,YLSCLIN
ST X1SR0,YSMLIN
TRO X1SR0,400K ;SET FLG LINE SYMBOL
PUTIC1 X1SR0
LF X1SR0,YLSCSEM
ST X1SR0,YSMSEM
TRO X1SR0,400K ;SET FLG DECLARATION
PUTIC1 X1SR0
LF X1SR0,YLSLLIN
PUTIC1 X1SR0
;FILL END-LINE OF GENERATED ERROR MESSAGES
IFG QERIMP,<
EXTERN YECHDM
SKIPGE YECHDM
RETURN
ST X1SR0,YELIN2
ERRLI
>
RETURN
EPROC
SUBTTL SMUID
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: PERFORM ACTIONS IMPLIED BY A USED IDENTIFIER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EXTERN O1XR,LS
SMUID: PROC
;OUTPUT IDENTIFIER TO IC1
PUTIC1 X1CUR
;OUTPUT IDENTIFIER TO XRF
IFONA YSWC
EXEC O1XR
;SCAN NEXT SYMBOL
GOTO LS ;NOT PROGRAMMING STANDARD BUT SAVES INSTRUCTIONS
EPROC
LIT
END