Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/13/o2sa.mac
There are 2 other files named o2sa.mac in the archive. Click here to see a list.
;<ENDERIN>O2SA.MAC 6-Dec-76 15:11:34, Edit by ENDERIN
SEARCH SIMMC2,SIMMCR,SIMMAC,SIMRPA
SALL
CTITLE O2SA
COMMENT;
AUTHOR: STEFAN ARNBORG
VERSION: 4 [7,15,22,23,116,140,225]
CONTENTS: O2AD,O2OP,O2GI,O2RF,O2D1,O2ER,O2D1GW
;
MACINIT
TWOSEG
RELOC 400K
CGINIT
EXTERN CADS,CGG2,CGG3,CGG4,CGR2,CGR4,CGR3,O2CF,O2DF,O2GA,O2GF,O2GR,O2GW,O2IC2T
EXTERN CGAD,CGCA,CGCC,CGCO,CGIM,CGIM1,CGLO,CGLO1,CGMO,CGMO1,M2CO
EXTERN CGVA,O2GWD
EXTERN Y17BUF,YO2ZSD,YSWCHA,YSTATM,YO2LTP
EXTERN YELIN1,YELIN2,YQREL,YOLINE,YLINE,YRELCD,YO2LNB,YRELLT,YLSLIN,YRELST
IFN QDEBUG,<EXTERN O2DB1,O2DB3,O2DB4,YO2DBZ,DBRTMU>
EXTERN O2IV,CGRD
EXTERN EXAT
EXTERN YBRBUF,YBRZSE
EXTERN YBHATR,YELATR
EXTERN YBHDF1,YBHIC1,YBHIC2,YO2ADI,YO2ADF,YOPCOD,YTAC,YZHBXC,YCGACT
EXTERN YFXTAB,YLXIAC,Y3OPEN,YSYSI,YDCSTO,YDCSTP,YO2DFW
EXTERN YERRCT,YJOB,YELDF1,YELIC1,YBHIC2,YELIC2,YCABKB,YO2FIX,YO2LAS,Y3LOWE
EXTERN YGAP,YQRELR,YQRELT
EXTERN YGAP,YQRELR,YQRELT
INTERN O2ATR,O2AD,O2OP,O2GI,O2RF,O2AB,O2EX
INTERN O2D1,O2ERO,O2ERL,O2ERE,O2ERI,O2ERU,O2ERR
INTERN O2D1GW
INTERN O2SM,O2LN1,O2LN2,O2LN3,O2LN3,O2LN4,O2LN5,O2LN6
QMINDL= -2 ; DISPLAY LEVEL(ZPCEBL) OF OUTERMOST, RELOCATED BLOCK
DEFINE IOER(F)=<
L X1,[ASCIZ/F/]
>
SUBTTL O2D1
COMMENT;
PURPOSE: READ DECLARATIONS FOR A SCOPE INTO DECLARATION STACK
ENTRY: O2D1
;
;AUX ROUTINE TO GET ONE WORD FROM DF1 TO X4
O2D1GW: SOSGE YBHDF1+2 ; DECREASE BYTE COUNT
GOTO [
ASSERT< SKIPN YELDF1
RFAIL READING PAST EOF IN DF1
>
IN QCHDF1,
GOTO O2D1GW
IOER DF1
EXEC O2ERI]
ILDB X4,YBHDF1+1
RETURN
; ROUTINE TO READ ONE RECORD (ZHE,ZHB OR ZQU) INTO THE DECLARATION STACK
; ENTRY ASSERTION STACK POINTER IN X3
; FIRST WORD IN X4
; TAG VALUE IN X0 (O2D1RI ONLY)
; EXIT ASSERTION NEXT WORD IN X4
; X3 UPDATED
;
O2D1RI: ; X0 CONTAINS TAG VALUE
CAIN ZQU%V
GOTO O2D1QI
CAIN ZHB%V
GOTO O2D1BI
ASSERT<SKIPN
RFAIL ZMP RECORD IN DF1
>
DEFINE R(L,S)=<
O2D1'L'I: CAML X3,YDCSTO
EXEC M2CO
REPEAT S,<
PUSH X3,X4
EXEC O2D1GW
>
LI X3,(X3)
RETURN
>
R(E,ZHE%S)
R(Q,ZQU%S)
R(B,ZHB%S)
O2D1: PROC
SAVE<X3,X4,X5>
SKIPN X4,YO2DFW
EXEC O2D1GW ; GET FIRST WORD OF FILE ON FIRST CALL
SOS X3,YDCSTP
LF ,ZDETYP(,X4)
ASSERT<CAIE ZMP%V
CAIN ZQU%V
RFAIL INVALID RECORD TYPE FIRST O2D1
>
EXEC O2D1RI
SETZ X5, ; COUNT OF REMAINING ZHBS TO READ
LOOP LF ,ZDETYP(,X4)
IF CAIE ZQU%V
GOTO FALSE
THEN ; ZQU RECORD DETERMINES X5 UPDATE
IF LF ,ZQUKND(,X4)
CAIN QCLASS
GOTO TRUE
CAIE QPROCE
GOTO FALSE
LF ,ZQUMOD(,X4)
CAIE QDECLARED
GOTO FALSE
LF ,ZQUTYP(,X4)
CAIN QLABEL
GOTO FALSE
THEN
AOJ X5, ; ZHB FOR THIS ZQU
FI
EXEC O2D1QI ; STACK ZQU
ELSE
SOJL X5,O2D1EX
ASSERT< CAIE ZHB%V
RFAIL ZHE IN O2D1
>
EXEC O2D1BI
FI
AS GOTO TRUE
SA
O2D1EX: ST X4,YO2DFW
AOJ X3,
SETZM (X3) ; STOP READING BY CARL
HRRM X3,YDCSTP
RETURN
EPROC
SUBTTL O2ATR
COMMENT;
PURPOSE: OUTPUT ATR.TMP
ENTRY: O2ATR
;
O2ATR: PROC
edit(23)
SAVE <X0,X1,X2,X3> ;[23] SAVE X0
IOER ATR
IF
SKIPE YELATR
GOTO FALSE ;IF NOT FIRST TIME THIS ROUTINE IS CALLED
THEN ;PREPARE FOR WRITING ATR.TMP ON DISK
;THIS FILE IS WRITTEN IN UNBUFFERED MODE
OPEN QCHATR,[16
SIXBIT/DSK/
0]
EXEC O2ERO ;IF ERROR
LI X2,'ATR'
HLL X2,YJOB
ST X2,YELATR
MOVSI X2,'TMP'
ST X2,YELATR+1
SETZM YELATR+2
SETZM YELATR+3
ENTER QCHATR,YELATR
EXEC O2ERE ;IF ERROR
edit(162)
SETZM YELATR+3 ;[162]
SETON YOPATR ;FLAG FILE OPEN
FI
L X3,YBHATR
SUB X3,YBHATR+1
L X2,YBHATR
HRRM X2,YBHATR+1
HLRZM X2,YBHATR+2
HRL X2,X3
LI X3,0
OUT QCHATR,X2
SKIPA
EXEC O2ERO ;IF ERROR
RETURN
EPROC
SUBTTL O2ER
COMMENT;
PURPOSE: DIAGNOSE FATAL I/O ERRORS
ENTRIES: O2ERO,O2ERL,O2ERE,O2ERI,O2ERU,O2ERR
ARGUMENTS: X1 HAS THE ASCIZ NAME OF THE FILE (SET BY IOER MACRO)
;
DEFINE O2E(L,C)=<
O2ER'L: ASSERT<
OUTSTR [ASCIZ/'L' IO ERROR/]
>
LI C+Q.TER
GOTO O2ERCM
>
O2E(O,0)
O2E(L,1)
O2E(E,2)
O2E(I,3)
O2E(U,4)
O2E(R,5)
O2ERCM: OP(ERRT QT,)
XCT
BRANCH O2AB
SUBTTL O2EX
COMMENT/
PURPOSE: CLOSE FILES
EXIT FROM PASS 2
ENTRY: O2EX ;NORMAL EXIT
O2AB ;ABNORMAL EXIT
NORMAL EXIT: RUN PASS 3
ERROR EXIT: ABORT IF PASS 3 NOT FOUND
ERRORS GENERATED: INTERNAL INPUT-OUTPUT ERRORS
/
O2EX: EXEC O2IC2T
; ENTER HERE WHEN IC2 IS NOT SAFE (FATAL ERRORS OR CONSEQUENCES OF PASS 1 ERRORS)
O2EX1: L YELIN1
SKIPN YELIN2
ST YELIN2
ERRLI ; TO GET LAST LINE NO OF RECENT EDIAGNOSTICS
;DELETE IC1
IF
SKIPN YELIC1
GOTO FALSE
THEN ;FILE SHOULD BE DELETED
IOER IC1
IFE QDEBUG,<
SETZM YELIC1
RENAME QCHIC1,YELIC1
ERRT QT,Q.TER+5
>
IFN QDEBUG,<
CLOSE QCHIC1,
STATZ QCHIC1,740K
EXEC O2ERR
>
SETOFF YOPIC1
RELEASE QCHIC1,
FI
;DELETE DF1
IF
SKIPN YELDF1
GOTO FALSE
THEN ;FILE SHOULD BE DELETED
IOER DF1
IFE QDEBUG,<
SETZM YELDF1
RENAME QCHDF1,YELDF1
ERRT QT,Q.TER+5
>
IFN QDEBUG,<
CLOSE QCHDF1,
STATZ QCHDF1,740K
EXEC O2ERR
>
SETOFF YOPDF1
RELEASE QCHDF1,
FI
;CLOSE IC2
IF
SKIPN YELIC2
GOTO FALSE
THEN
IOER IC2
CLOSE QCHIC2,
STATZ QCHIC2,740K
EXEC O2ERR
SETON YPOIC2
FI
IF
IFOFF YSWCE
GOTO FALSE ;IF MAIN PROG
THEN ;CREATE ATR.TMP
L YBRZSE
LI X1,Y17BUF
SUB X1,X0
TRZ X1,177
SUBI X0,1
ST X0,YBHATR
HRLI X0,4400
ST X0,YBHATR+1
ST X1,YBHATR+2
SUBI X1,1 ;[15] SET YBHATR LEFT HALF TO
HRLM X1,YBHATR ; BUFFER LENGTH - 1
SETZM YELATR
EXEC EXAT ;DO THE JOB
IF
SKIPN YELATR
GOTO FALSE
THEN ;FILE ON DISK
EXEC O2ATR ;OUTPUT LAST BUFFER
CLOSE QCHATR,
IOER ATR
STATZ QCHATR,740K
EXEC O2ERR
SETON YPOATR
ELSE ;FILE IN CORE
L X1,YBHATR+1
SUB X1,YBHATR
HRRZM X1,YBHATR+2
AOS X1,YBHATR
HRLZM X1,YBHATR+1
FI
FI
O2AB1:
IFG QDEBUG,<
CLOSE QCHDEB,
SETOFF YOPDEB
>
edit(225)
TOPS10,<;[225]
MOVSI X3,1
IFG QTRACE,<EXTERN YTRPAS
IFON YTRSW
HRRI X3,0
>
SWAPPA(SIMP3,S3,0,QP3PPN)
>
TOPS20,<BRANCH I3AA>;[225]
O2AB: L YELIN1
CAML YELIN2
ST YELIN2
ERRLI ; IF ERRORS UNDIAGNOSED
IF IFON YSWTRM
GOTO FALSE
THEN ; NOT TERMINATION ERROR
SETON YSWP1
IFE QDEBUG,<
SKIPN YELIC2
GOTO O2EX1 ;IF IC2 IN CORE
SETZM YELIC2
IOER IC2
RENAME QCHIC2,YELIC2
ERRT QT,Q.TER+5
SETOFF YOPIC2
>
GOTO O2EX1
FI
GOTO O2AB1
SUBTTL O2OP
COMMENT;
PURPOSE: INITIALIZE BYTE POINTERS IN HEADERS AND OPEN FILES
ENTRY: O2OP
ARGUMENTS: NONE
;
O2OP:
;OPEN IC1
IF ;IC1 WAS WRITTEN TO DISK
SKIPN YELIC1
GOTO FALSE
THEN
IOER IC1
LOOKUP QCHIC1,YELIC1
EXEC O2ERL
SETOFF YPOIC1
EXEC O2OPGB ;SET UP BUFFER RING
ST X1,YBHIC1
SETOM YBHIC1+2
FI
;OPEN DF1
IF ;DF1 WAS WRITTEN TO DISK
SKIPN YELDF1
GOTO FALSE
THEN
IOER DF1
LOOKUP QCHDF1,YELDF1
EXEC O2ERL
SETOFF YPODF1
EXEC O2OPGB ;SET UP BUFFER RING
ST X1,YBHDF1
SETOM YBHDF1+2
FI
;OPEN IC2
IOER IC2
OPEN QCHIC2,[EXP 14
SIXBIT/DSK/
XWD YBHIC2,YBHIC2]
EXEC O2ERO
; MAKE ENTER INFO
LI 'IC2'
HLL YJOB
ST YELIC2
MOVSI 'TMP'
ST YELIC2+1
SETZM YELIC2+2
SETZM YELIC2+3
ENTER QCHIC2,YELIC2
EXEC O2ERE
SETZM YELIC2+3 ;[162]
SETON YOPIC2
EXEC O2OPGB
ST X1,YBHIC2
RETURN
O2OPGB:
;SET UP BUFFER RING OF 2 BUFFERS STARTING AT (YBRBUF)
AOS X1,YBRBUF
HRLI X1,201
L X2,X1
ADDI X2,QBUFS+1
ST X1,(X2)
ST X2,(X1)
LI X2,2*QBUFS+1
ADDM X2,YBRBUF
HRLI X1,400K
RETURN
SUBTTL O2RF
COMMENT;
PURPOSE: REDEFINE A PREVIOUSLY DEFINED FIXUP OR COMPILE
A JUMP TO THE NEW FIXUP
ENTRY: O2RF
INPUT ARGUMENT: NEW FIXUP INDEX IN X0
OLD FIXUP DEFINITION IN YO2LAS, ITS INDEX+YFXTAB IN YO2FIX,
IS CHANGED ONLY IF YO2FIX IS NEGATIVE
;
O2RF: PROC
SAVE <X2,X3>
IF SKIPGE X2,YO2FIX
GOTO FALSE
THEN
OP (JRST)
GENFIX
ELSE
L X1,
L X3,X1
ADD X1,YFXTAB
L (X2)
ST (X1)
HRRZ X1,X2
SUB X1,YFXTAB
EXEC O2CF
ASSERT<IF IFOFF SO2D1
GOTO FALSE
THEN
EXEC O2DB1,<<[XWD 020000,0]>>
LI X2,(SIXBIT/RF:/)
HRLI X2,611000
HRL X3,YO2LAS
EXEC O2DB4,<X2,X3>
FI
>
SETZM YO2FIX
SETZM YO2LAS
SETZM YO2LAS+1
FI
RETURN
EPROC
SUBTTL O2GVIN
COMMENT;
PURPOSE: GET THE VIRTUAL INDEX OF A VIRTUAL QUANTITY
ENTRY: O2GVIN
INPUT ARGUMENT: ZQU POINTER IN X5
OUTPUT ARGUMENT: VIRTUAL INDEX IN X0
;
O2GVIN: PROC
SAVE <X2,X3,X4,X5>
LF X1,ZQULID(X5)
LF X2,ZQUZHE(X5)
SETZM X3
LOOP ; OVER PREFIX ZHB:S IN X2
LI X4,ZHB%S(X2) ; FIRST ZQU IN LIST
WHILE RECTYPE(X4) IS ZQU
GOTO FALSE
DO LF ,ZQULID(X4)
IF CAME X1
GOTO FALSE
edit(140)
IFNEQF X4,ZQUMOD,QVIRTUAL ;[140]
GOTO FALSE ;[140]
LF ,ZQUNSB(X4)
JUMPN FALSE ; MATCH, NOT SPEC
THEN L X3,X4
FI
STEP X4,ZQU
OD
AS LF X2,ZHBZHB(X2) ; PREFIX CHAIN
JUMPE X2,FALSE ;NO MORE PREFIX
JUMPE X3,TRUE ; REPEAT AS NO SPEC FOUND
SA
ASSERT< SKIPN X3
RFAIL VIRTUAL MATCHES ERROR
>
LF ,ZQUIND(X3)
RETURN
EPROC
SUBTTL O2AD
COMMENT;
PURPOSE: PREPARE FOR AN ACCESS TO AN IDENTIFIER
ENTRY: O2AD
INPUT ARGUMENT: ZQU POINTER IN X1
OUTPUT ARGUMENT: AN INSTRUCTION WITH EFFECTIVE ADDRESS OF THE ID
IS STORED IN YO2ADI (AC,INDEX AND ADDRESS FIELD)
YO2ADF (-1:RELOCATABLE,0: ABSOLUTE, 1: FIXUPED ADDRESS)
THE ADDRESSS IS VARIABLE (DATA ADDRESS) OR PROTOTYPE ADDRESS
;
O2AD: PROC
SAVE <X2,X3,X4,X5,X1> ;X1 MUST BE SAVED LAST
XKND=X2
XMOD=X3
XTYP=X4
IFN QDEBUG,<
ST X1,YO2DBZ
>
SETZM YO2ADF
ASSERT<SKIPE YO2ADI
RFAIL CONSECUTIVE CALLS OF O2AD
>
LF XKND,ZQUKND(X1)
LF XTYP,ZQUTYP(X1)
LF XMOD,ZQUMOD(X1)
IF
CAIE XMOD,QDECLARED ;NOT declared
GOTO TRUE ;OR
CAIN XTYP,QLABEL ;( NOT label
GOTO FALSE ; AND
CAIN XKND,QSIMPLE ; (simple
GOTO TRUE ; OR
CAIE XKND,QARRAY ; array)
GOTO FALSE ;)
THEN
IF ;NOT virtual
CAIN XMOD,QVIRTUAL
GOTO FALSE
THEN
; LOAD FROM BLOCK INSTANCE
LF X2,ZQUZHE(X1)
LF ,ZHEDLV(X2)
L X4,YZHBXC
LF X4,ZHEDLV(X4)
IF ;On current display level
CAME X4
GOTO FALSE
THEN ;Use XCB
LI X3,XCB
ELSE
IF ;Outermost level
CAIE QMINDLV
GOTO FALSE
THEN ;Relocatable address, no index reg
SOS YO2ADF ; OCCURS FOR THE OUTERMOST, RELOCATED BLOCK
SETZ X3
ELSE
IF ;No defined display level
JUMPN FALSE
THEN ; BASICIO
L X3,YSYSI
LF X3,ZQUZQU(X3) ; INFILE ZQU
LF X3,ZQUZB(X3)
LI YSYSIN
CAME X3,X2
LI YSYSOUT
OP (L XIAC,(XSAC))
ST X3
IF ;Not already loaded
CAMN X3,YLXIAC
GOTO FALSE
THEN ; LOAD STANDARD FILE
L [LOWADR(XSAC)]
GENABS
L X3
GENABS
ST X3,YLXIAC
FI
ELSE
IF ; NEW DISPLAY LOAD?
CAMN YLXIAC
GOTO FALSE
THEN ; Emit code for load
ST YLXIAC
OP (L XIAC,(XCB))
GENABS ; CODE TO LOAD DISPLAY REGISTER
FI
FI
LI X3,XIAC ;Use XIAC to access var
FI
FI
SETZM YO2ADI
DPB X3,[INDEXFIELD YO2ADI]
L @YTAC
DPB [ACFIELD YO2ADI]
L X1,0(XPDP)
LF ,ZQUIND(X1)
HRRM YO2ADI
ELSE
; VIRTUAL
L X5,X1
IF WHENNOT XCUR,ZID
GOTO FALSE
THEN ; DECLARED OR CONNECTED
LF X3,ZQUZHE(X1)
IF CAMN X3,YZHBXC
GOTO FALSE
THEN ; LOAD XIAC WITH CLASS INSTANCE
LF ,ZHEDLV(X3)
OP (L XIAC,(XCB))
MOVN X2,X0
HRRM X2,YLXIAC
GENABS
LI X2,XIAC
ELSE
LI X2,XCB
FI
ELSE ; REMOTE VIRTUAL PROCEDURE
L X2,@YTAC
LI X2,1(X2)
FI
HRRZ X0,@YTAC
IF CAIN X0,XWAC1
GOTO FALSE
THEN ; TRANSFER PROTOTYPE TO XWAC1
OP (EXCH XWAC1,)
GENABS
FI
L [LF XWAC1,ZBIZPR(X0)]
DPB X2,[INDEXFIELD]
GENABS
EXEC O2GVIN ; GET VIRTUAL INDEX TO X0
MOVN
ADDI ,<OFFSET(ZCPVID)>
OP (XCT (XWAC1))
GENABS ; XCT GETS PROCEDURE PROTOTYPE OR SWITCH/LABEL ADDRESS TO XWAC1
HRRZ X0,@YTAC
IF CAIN X0,XWAC1
GOTO FALSE
THEN ; TRANSFER PROTOTYPE TO XWAC1
OP (EXCH XWAC1,)
GENABS
FI
HRRZ X0,@YTAC
ADD YCGACT
ST YO2ADI
FI
ELSE
LF ,ZQUIND(X1)
ST YO2ADI
L @YTAC
DPB [ACFIELD YO2ADI]
AOS YO2ADF
FI
RETURN
EPROC
PURGE XKND,XTYP,XMOD
SUBTTL O2GI
COMMENT;
PURPOSE: OUTPUT INSTR TO ACCESS AN ID AS PREVIOUSLY DEFINED BY O2AD CALL
ENTRY: O2GI
INPUT ARGUMENTS: YOPCOD INSTRUCTION CODE (LEFT ADJUSTED)
YO2ADI AC,INDEX AND ADDRESS FIELDS
YO2ADF 1: FIXUPED ADDRESS FIELD
0: ABSOLUTE ADDRESS FIELD
-1: RELOCATED ADDRESS FIELD
;
O2GI: PROC
IFN QDEBUG,<EXEC DBRTMU>
SAVE <X2>
L YO2ADI
ASSERT< SKIPN
RFAIL GENOP CALLED WITH NO GETAD
>
OR YOPCOD
SKIPN X2,YO2ADF
GENABS
SKIPGE X2
GOTO [ADD YCABKB
GENRLD
GOTO .+3]
SKIPLE X2
GENFIX
SETZM YO2ADI
IFN QDEBUG,<IF IFOFF SO2D1
GOTO FALSE
THEN ; DEBUG OUTPUT
L X2,YO2DBZ
LF X1,ZQULID(X2)
LF X2,ZQULNE(X2)
MOVSI 320000
HRR X1
HRLZ X1,X2
EXEC O2DB3,<X0,X1>
FI
>
RETURN
EPROC
SUBTTL O2LN1
COMMENT/
PURPOSE: OUTPUT A BLOCK START LINE NUMBER TABLE (ZLN) ENTRY AT ATART
SAVE <X1>
OF A PROCEDURE, CLASS , PREFIXED BLOCK OR UNREDUCED SUBBLOCK
INPUT: ZHB OR ZHE POINTER IN XZHE
/
O2LN1: PROC
IF L YRELLT
CAIG 3 ; ALWAYS OUTPUT FIRST ENTRY
GOTO FALSE
IFON YSWI
GOTO FALSE
THEN
POPJ XPDP,0
FI
SAVE <X2>
LF X1,ZHEFIX(XZHE) ;DEFINE FIX F+1 HERE IN LINE TABLE
LI X1,1(X1)
LI X2,QRELLT
EXCH X2,YQREL
DEFIX
EXCH X2,YQREL
LF X0,ZHEFIX(XZHE)
LF X1,ZHETYP(XZHE)
HRL YO2LNB
SF X1,ZLNTYP(X0)
L X2,YRELLT
ST X2,YO2LNB
SETONA ZLNICD(X0)
LI X2,QRELLT
EXCH X2,YGAP
GENFIX
EXCH X2,YGAP
LI -1
HRLM YSTATM
IFOFF YSWI
EXEC O2LN2 ; FORCED LINE TABLE ENTRY FOR OUTERMOST BLOCK
RETURN
EPROC
SUBTTL O2LN2
COMMENT/
PURPOSE: OUTPUT LINE NUMBER TABLE ENTRY WITH LINE NO AND CODE ADDRESS
INPUT: LINE NUMBER IS MAX(YLINE,YOLINE), CODE ADDRESS IN YRELCD
THE LEFT HALF OF YSTATM IS -1 IF
WE ARE IN DECLARATIONS
/
O2LN2: PROC
IFNDEF QPOINT,<QPOINT=0>
IFNDEF QMAXLN,<QMAXLN=177777>
SKIPN YRELLT ; FIRST ENTRY MUST NOT BE LINE NO
POPJ XPDP,0
SAVE <X2>
L X1,YLINE
CAMGE X1,YOLINE
L X1,YOLINE
LDB ,QPOINT+YO2LTP
SKIPG ; APPEND IF FIRST
GOTO APPEND
HLRZ X2,X0 ; LINE TO X2
TRZ X2,200K ; DELETE DECLARE FLAG
IF CAMLE X1,X2
GOTO FALSE
CAIN X2,QMAXLN
GOTO FALSE
THEN ; NOT NEW LINE
TLZN 200K
GOTO DELETE ; NOT IN DECLARATION
SKIPGE YSTATM
GOTO DELETE ; STILL IN DECLARATION
L X2,X0
ANDI X2,77777 ; MASK OUT RELOCATION BYTE
CAME X2,YRELCD
GOTO APPEND ; NEW CODE OUTPUT SINCE LAST LINE
DPB ,QPOINT+YO2LTP ; SWITCH OFF DECLARE FLAG
ELSE ; NEW LINE
L X2,X0
ANDI X2,77777 ; MASK RELOCATION BYTE
CAME X2,YRELCD
GOTO APPEND ; NEW CODE OUTPUT
SKIPGE YSTATM
GOTO DELETE ; IN DECLARE
HRL X1 ; Delete declare flag and set new line
DPB ,QPOINT+YO2LTP
FI
DELETE: RETURN
APPEND: IFOFF YSWI
LI X1,QMAXLN
SETZ
SKIPGE YSTATM
MOVSI 200K ; SET DECLARE FLAG
ADD YRELCD
HRLZ X1,X1 ; NEW LINE NUMBER
ADD X1
LI X2,QRELLT
EXCH X2,YQRELT
GENRLD
EXCH X2,YQRELT
RETURN
EPROC
O2LN21: PROC
RETURN
EPROC
SUBTTL O2LN3
COMMENT/ OUTPUTS EXTERNAL DEFINITION ENTRY IN LINE TABLE
X2 CONTAINS ZHB, X3 ZQU
/
O2LN3: PROC
IFON YSWCE
POPJ XPDP,0
SAVE <X1,X4>
edit(7)
LF ,ZHETYP(X2) ;[7]
LF X4,ZHBMFO(X2) ;[7]
IF ;[7] Procedure
CAIN QCLASB
GOTO FALSE
THEN ;Make no entry for QUICK procedure
CAIN X4,QEXMQI
GOTO L9
FI ;[7]
LF X1,ZQUIND(X3) ;FIXUP FOR PROTOTYPE
HRL X1,YO2LNB
L YRELLT
ST YO2LNB
IF ;CLASS
LF ,ZHETYP(X2)
CAIE QCLASB
GOTO FALSE
THEN ; EXTERNAL CLASS
LI QCEXT
ELSE
IF ;FORTRAN
CAIGE X4,QEXFOR ;[7]
GOTO FALSE
THEN LI QFEXT
ELSE
IF ;MACRO procedure
CAIN X4,QEXMAC ;[7]
GOTO TRUE
IFOFF ZHBNCK(X2)
GOTO FALSE
THEN ;MACRO
LI QMEXT
ELSE ;SIMULA EXTERNAL PROC
LI QPEXT
FI FI FI
SF ,ZLNTYP(,X1)
L X1
SETONA ZLNICD(X0)
STACK YGAP
LI X1,QRELLT
ST X1,YGAP
GENFIX
UNSTK YGAP
L9():! RETURN
EPROC
SUBTTL O2LN4
COMMENT/
PURPOSE: OUTPUT END OF BLOCK ENTRY TO LINE NUMBER TABLE
ARGUMENTS: ZHB OR ZHE IN XZHE
/
O2LN4: PROC
SAVE<X2>
LF X1,ZHEFIX(XZHE)
LI X2,1(X1)
L X1,YFXTAB
ADD X1,X2 ; ADDRESS OF FIXUP ENTRY
LF X1,ZFXCOD(X1) ; CHECK IF BLOCK START ENTRY EXISTS
CAIE X1,QRELLT
GOTO L1
HRRZS YSTATM
IFOFF YSWI
EXEC O2LN2 ; FORCED ENTRY FOR END OUTERMOST BLOCK WITH /-I
L X2
HRL YO2LNB
LI X1,QEBLOC
SF X1,ZLNTYP(X0)
L X1,YRELLT
ST X1,YO2LNB
SETONA ZLNICD(X0)
LI X2,QRELLT
EXCH X2,YGAP
GENFIX
EXCH X2,YGAP
L X1,YOLINE
CAIE XCUR,%EPROG
EXEC O2LN21
L1(): RETURN
EPROC
SUBTTL O2LN5
COMMENT/
PURPOSE: OUTPUT A LINE NUMBER TABLE ENTRY FOR A REDUCED SUBBLOCK START
ARGUMENT: SUBBLOCK ZHE IN XZHE
/
O2LN5: PROC
IFOFF YSWI
POPJ XPDP,0
SAVE <X2>
LI X2,QRELLT
ST X2,YQREL
LF X1,ZHEFIX(XZHE)
LI X1,1(X1)
DEFIX
LF ,ZHEBNM(XZHE)
HRL YO2LNB
LI X1,QRBLOC
SF X1,ZLNTYP(X0)
L X1,YRELLT
ST X1,YO2LNB
SETONA ZLNICD(X0)
EXCH X2,YGAP
GENABS
ST X2,YQREL
EXCH X2,YGAP
L X1,YOLINE
EXEC O2LN21
RETURN
EPROC
SUBTTL O2LN6
COMMENT/
PURPOSE: OUTPUT LINE NUMBER TABLE ENTRY (TWO WORDS) FOR CONNECTION
ARGUMENT: CONNECTION ZHB IN XZHE
/
O2LN6: PROC
IFOFF YSWI
POPJ XPDP,0
SAVE <X2>
LI QRELLT
ST YGAP
ST YQREL
LF X1,ZHEFIX(XZHE)
LI X1,1(X1)
DEFIX
LF X2,ZHBZHB(XZHE) ; PROTOTYPE OF INSPECTED CLASS
LF X2,ZHBZQU(X2)
LF X2,ZQUIND(X2)
HRL X2,YO2LNB
LI QINSPE
SF ,ZLNTYP(,X2)
SETONA ZLNICD(X2)
L X2
GENFIX
L YRELLT
ST YO2LNB
SOS
SF ,ZLNBLK(,X2)
LF ,ZHEDLV(XZHE)
HLL X2
GENABS
LI QRELCD
ST YGAP
ST YQREL
L X1,YOLINE
EXEC O2LN21
RETURN
EPROC
SUBTTL O2SM
COMMENT/
PURPOSE: OUTPUT ZSD ENTRIES FOR THE ZQU RECORDS STARTING AT
X2, CALLED FROM CAEB AND EBLK. (REDUCED BLOCK END)
ENTRY: O2SM
INPUT ARGUMENTS: ZQU POINTER (FIRST RECORD TO OUTPUT FROM BLOCK) IN X2
/
O2SM: PROC
SAVE <X2>
; SAVE AND SET RELOCATION COUNTERS
L YRELST
MOVSM YO2ZSD
STACK YQRELT
STACK YQRELR
STACK YGAP
LI QRELST
ST YGAP
ST YQRELT
; OUTPUT ZSD:S
WHILE SKIPN X2
GOTO FALSE
DO
WHILE RECTYPE(X2) IS ZQU
GOTO FALSE
DO ;OUTPUT ONE ZSD ENTRY
edit(116)
IF LF ,ZQUMOD(X2) ;[116]
CAIL QHDN ;[116]
GOTO FALSE ;[116] Hidden specification
THEN ;[116]
edit(22)
LF X1,ZQUTMK(X2) ;[22] LOAD TYPE-MODE-KIND
MOVSS X1 ;[22] STORE IN ZSDTMK(,X1)
IF IFON ZQULO(X2)
GOTO FALSE
THEN ; SHORT ID
SETOFA ZSDLNE(X1)
ELSE
SETONA ZSDLNE(X1)
FI
;[22] SET ZSDSPI FIELD FOR SYSIN AND SYSOUT
IF
IFOFF ZQUSYS(X2)
GOTO FALSE
THEN
LF X0,ZQUSNR(X2)
IF
CAIE X0,SYSK7 ;SYSIN
GOTO FALSE
THEN
SETF QISYSIN,ZSDSPI(,X1)
ELSE
IF
CAIE X0,SYSK8 ;SYSOUT
GOTO FALSE
THEN
SETF QISYSOUT,ZSDSPI(,X1)
FI
FI
FI
LF X0,ZQUIND(X2) ;[22] LOAD OFFSET IN RH (ZSDOFS)
HLL X0,X1 ;[22] LH CREATED IN X1 LH
GENABS ;FIRST WORD ZSD
LI QRELID
ST YQRELR
LF ,ZQULID(X2)
GENREL
IF IFOFF ZQULO(X2)
GOTO FALSE
THEN ; LONG ID
LI QRELI2
ST YQRELR
LF ,ZQULID(X2)
GENREL ; OPTIONAL 3RD WORD
FI
LF ,ZQUTYP(X2)
IF CAIE QREF
GOTO FALSE
THEN
;OUTPUT ZSDZPR
LF X1,ZQUZQU(X2)
LF ,ZQUIND(X1)
GENFIX
FI
FI ;[116]
ADDI X2,ZQU%S
OD
HLRZ X2,X2
OD
; OUTPUT ZERO AFTER LAST SYMBOL
SETZ
GENABS
; RESTORE AND RETURN
UNSTK YGAP
UNSTK YQRELR
UNSTK YQRELT
RETURN
EPROC
END