Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/10/o1.mac
There are 2 other files named o1.mac in the archive. Click here to see a list.
;<MENDERIN>O1.MAC.35, 20-Jan-77 12:00:51, Edit by ENDERIN
;<TENDERIN>O1.MAC.6, 16-Jan-77 23:57:17, Edit by ENDERIN
;<TENDERIN>O1.MAC.1, 16-Jan-77 14:09:41, Edit by ENDERIN
Comment;
Author: Claes Wihlborg (modified by L Enderin)
Version: 4 [1,03,13,16,17,45,144,162,225,250,306]
Purpose: Pass 1 I/O
Contents:
O1DB Write debug information
O1DF Write declaration file
O1EX Read external attributes
O1IC Write intermediate code
O1LS Write source code
O1RL Write rel-file
O1SC Read source code
O1XR Write cross-reference file
O1ZS Write symbol table
O1ERR Error routine
O1PACK Pack files kept in core
O1SETB Set up buffer ring
;
SALL
SEARCH SIMMC1,SIMMAC
CTITLE O1 Pass 1 IO
SUBTTL PROLOGUE
MACINIT
QHBYTE==(POINT 18)
QWBYTE==(POINT 36)
QOPEN==0
QLOOKUP==1
QENTER==2
QREAD==3
QWRITE==4
QCLOSE==5
EXTERN T1AB,I1AB
EXTERN YJOB,YSWITCH
EXTERN YMAXID,ZSE1,ZSE2
EXTERN Y3OPEN
EXTERN YBRBUF,YBRSRC,YBRZSE
EXTERN Y1BUF,Y4BUF,Y6BUF,Y13BUF,Y15BUF,Y11BUF
EXTERN YDPD,YDPUNR
edit(3)
EXTERN YRELBL ;[03] Number of last REL file block filled
edit(13)
EXTERN YRQHEAD ;[13] Head of ZRQ chain
EXTERN YRQFIL,YRQPPN,YRQDEV ;[13] Request block info from file def
EXTERN YEXNAM ;[13] SIMULA name in SIXBIT of external class/proc
edit(43) edit(144) edit(225)
EXTERN YEXTS ;[144] Lookup table
EXTERN YELIN1,YELIN2 ;[45]
EXTERN YZQUGLO ;[144] Copy of global ZQU and ZHB
EXTERN YO1ASB ;[306] Where last ASCIZ word is
EXTERN YO1ASC ;[306] What it was before adjustment
TOPS10,<EXTERN YSFD,YSFDPPN,YSFD1,YSFDN ;[144,225]>
TOPS20,<;[225]
EXTERN YATRJF,YATRSZ
EXTERN YEXTAD,YEXTJF,YEXTLI,YEXTLX,YEXTMP,YEXTSZ,YEXTDV
EXTERN YFILSP
>
EXTERN YLSLLS ;[144]
TWOSEG
RELOC 400000
;;; [144] ;;;
OPDEF XEC [PUSHJ XPDP,]
OPDEF setupbuffers [XEC O1SETB]
OPDEF zquremove [XEC DPEXRM]
OPDEF readmodule [XEC O1EXRM]
TOPS10,<;[225]
OPDEF exbuffers [XEC O1EXBU]
>
OPDEF sfdcopy [XEC O1SFDC]
XZRQ==X2
XNAME==X5
XZQU==X4
EXTERN DPEXT,DPEXRM ;[144]
EXTERN YEXZQU,YATRDEV,YATRFN,YATRPPN,YATROFS ;[144]
YEXBLK==YDPD ;Block no in ATR file
YEXZRQ=:YDPD+1 ;Start of ZRQ chain (ATR/REL file specs)
YEXSINGLE==YDPD+2 ;Parameter to findmodules
TOPS10,<;[225]
YEXBF1==YDPD+10 ;Address of 1st ATR file buffer.
YEXBF2==YEXBF1+204 ;Next ATR file buffer. Space for one more assumed
>
DF ZQUR50,3+OFFSET(ZHBUNR),36,35 ;Name of entry in RADIX50
IF1,<;[225]
QDIRTR==QDEC20 ;[305]
IFNDEF QDIRTR,<
QDIRTR==0 ; Non-zero if STR:<DIRECTORY> should be translated
IFDEF RCDIR,<TOPS20,<QDIRTR==1>>
>>
DEFINE ERROR(FIL,ACTION)<
; IFG QDEBUG,<
; OUTSTR [ASCIZ/ACTION ERROR FILE FIL
;/]>
IFN QERIMP,<
IFIDN <ACTION><OPEN>,<L X1,[ASCII/FIL/]>;;[144]
IFDIF <ACTION><OPEN>,<LI X1,YEL'FIL> ;;[144]
ERRT QT,Q.TER+Q'ACTION
>
BRANCH T1AB
>
DEFINE OUTSF(FILE,NBUF,STARTADD)<
LI X2,NBUF
LI X3,STARTADD
LI X1,200
LOOP
OUT QCH'FILE,
SKIPA
JSP [ERROR(FILE,WRITE)]
L YBH'FILE+1
ADDI 1
HRL X3
ADDI X3,200
ADDM X1,YBH'FILE+1
BLT @YBH'FILE+1
AS
SOJG X2,TRUE
SA
>
SUBTTL O1DB WRITE DEBUG INFORMATION
IFG QDEBUG,<
INTERN O1DBOP,O1DB6
EXTERN YELDEB,YBHDEB
PROC
O1DBOP:
;SET UP ENTER BLOCK
LI X0,'DEB'
HLL X0,YJOB
ST X0,YELDEB
MOVSI X0,'TMP'
ST X0,YELDEB+1
SETZM YELDEB+2
SETZM YELDEB+3
;ENTER
IF ENTER QCHDEB,YELDEB
GOTO FALSE
THEN
edit(162)
SETZM YELDEB+3 ;[162]
SETON YOPDEB
LI QHBYTE
HRLM YBHDEB+1
OUT QCHDEB,
RET
FI
ERROR DEB,ENTER
;OUTPUT X0 RIGHT HALFWORD
L1():!
IF OUT QCHDEB,
GOTO FALSE
THEN
ERROR DEB,WRITE
FI
L2():!
SOSGE YBHDEB+2
GOTO L1
IDPB X0,YBHDEB+1
RET
O1DB6:
STACK X0
HLR X0,-4(XPDP)
EXEC L2
HRR X0,-4(XPDP)
EXEC L2
HLR X0,-3(XPDP)
EXEC L2
HRR X0,-3(XPDP)
EXEC L2
HLR X0,-2(XPDP)
EXEC L2
HRR X0,-2(XPDP)
EXEC L2
UNSTK X0
RETURN
EPROC
>;END OF DEBUG
SUBTTL O1DF Write declaration file
INTERN O1DFOP,O1DF1,O1DFCL
EXTERN YELDF1,YBHDF1
EXTERN YO1DFC
;
; SET UP CORE FILE
;
O1DFOP: PROC
;COMPUTE MAXIMAL SIZE
L X1,YBRZSE ;Break of files kept in core so far
LI X2,Y13BUF
SKIPN YELIC1
LI X2,Y15BUF ;If IC1 in core, take two more buffers
SUB X2,X1
TRZ X2,177 ;Truncate to multiple of buffer size
HRLI X1,444400
STD X1,YBHDF1+1
SETZM YELDF1
ST X2,YO1DFC ;Save size
RETURN
EPROC ;O1DFOP
;
;Core file too small, write file on disk
;
O1OPDF: PROC
SAVE <X0,X1,X2,X3>
OPEN QCHDF1,[14
SIXBIT/DSK/
XWD YBHDF1,YBHDF1]
JSP [ERROR(DF1,OPEN)]
;Set up ENTER block
LI X0,'DF1'
HLL X0,YJOB
MOVSI X1,'TMP'
STD X0,YELDF1
SETZM YELDF1+2
SETZM YELDF1+3
;ENTER
ENTER QCHDF1,YELDF1
JSP [ERROR(DF1,ENTER)]
edit(162)
SETZM YELDF1+3 ;[162]
SETON YOPDF1
;SET UP BUFFERS
L [XWD 2,Y15BUF]
ST YBRBUF
EXEC O1SETB
ST X0,YBHDF1
;OUTPUT STORED FILE
L X1,YO1DFC ;Size of core file
ASH X1,-7 ;Transform to no of buffers
OUTSF(DF1,<(X1)>,@YBRZSE)
RETURN
EPROC ;O1OPDF
;
;Output buffer to DF1
;
O1DF1: PROC
SKIPN YELDF1
XEC O1OPDF ;First call
OUT QCHDF1,
SOSGE YBHDF1+2
JSP [ERROR(DF1,WRITE)]
RETURN
EPROC ;O1DF1
;
;CLOSE DF1
;
O1DFCL: PROC
IF ;File in core
SKIPE YELDF1
GOTO FALSE
THEN ;Set up buffer header for use when reading
L X1,YBRZSE
L X2,YO1DFC
SUBB X2,YBHDF1+2
ADD X2,X1
ST X2,YBRZSE ;Set new break for files kept in core
HRLI X1,444400
ST X1,YBHDF1+1
RETURN
FI
CLOSE QCHDF1,
IF STATZ QCHDF1,740000
GOTO FALSE
THEN
SETON YPODF1
RETURN
FI
ERROR DF1,CLOSE
EPROC ;O1DFCL
SUBTTL O1EX Read External attributes [13]
INTERN O1EXCL,O1EXT
TOPS10,<INTERN O1EXBU>;[225]
INTERN O1EXFM,O1EXNP,O1EXRM,O1EXSO,O1EXLU,O1SFDC,O1EX.O ;[144]
INTERN O1EXTB ;[225]
EXTERN YELEXT,YBHEXT
IO.SYN==1B30 ;Stop after each buffer
IO.BIN==14 ;Binary mode
XFILE==X0
XPPN==X3
;Loader block types
QINDEX==14
QENTRY==4
QREQLIB==17
OPDEF SKIPBLOCK [PUSHJ XPDP,O1EXSK]
TOPS20,<;[225]
FCP==OFFSET(ZLFFCP)
FFP==OFFSET(ZLFFFP)
NPA==OFFSET(ZLFNPA)
QLM==ZLF%S
>
SUBTTL exbuffers [144]
TOPS10,<;[225]
Comment;
Set up standard buffer(s) starting with YEXBF2.
Initialize YBHEXT etc.
;
O1EXBU: PROC
L [2,,YEXBF2] ;2 buffers, starting at YEXBF2
ST YBRBUF
setupbuffers
ST YBHEXT
LI 1
ST YEXBLK ;1st blk no
SETZM YBHEXT+2 ;Clear byte count
RETURN
EPROC
>;[225]
SUBTTL findmodules (O1EXFM) [144]
Comment;
An ATR (library) file is open on channel QCHEXT (DEC-10 only).
1) If XZRQ = 0 on entry, it is required to find the module
corresponding to ZQU(XZQU), otherwise all modules on the list
starting at YEXZQU<RH> are to be found, if possible.
Handle each index block separately. Check each ZQU (ZQUR50 field)
against entries in the index block, in order.
3) When a module is found, read it and update declaration structure
(DPEXT).
4) Return when all index blocks are exhausted or all ZQU's handled.
;
O1EXFM: PROC
SAVE <X1,X3,XNAME>
ST XZRQ,YEXSINGLE
TOPS10,<;[225]
exbuffers
;Allocate YEXBF1 for index blocks only
LD X0,[201,,YEXBF2+1
400K,,YEXBF1+1]
ST X0,YEXBF1+1
ST X1,YBHEXT
>
IF ;Library not on search list
JUMPN XZRQ,FALSE
THEN ;Find ZRQ block for library
EXEC O1EXRQ
FI
HRRZM XZRQ,YEXZRQ
LI X3,1 ;[225] First index block
L1():! ;Loop over index blocks
EXEC O1EXFW ;[225] Locate index block word by X1
HLRZ (X1)
IF ;NOT INDEX block
CAIN QINDEX
GOTO FALSE
THEN ;Error unless in single module mode
IF SKIPG YEXSINGLE
GOTO FALSE
THEN ;Not proper library format
EXEC O1EXCL
L YLSLLS
ST YELIN1
ST YELIN2
LI X1,YELEXT
ERRT QT,255
GOTO T1AB
FI
zquremove
GOTO L9
FI
SKIPG YEXSINGLE
HRROS YEXSINGLE ;Shows that file is a library
LI X1,1(X1)
L2():! L X3,(X1) ;Module header word
SUB X3,[QENTRY,,1]
IF ;Normal case (one entry per module)
JUMPN X3,FALSE
THEN ;Check the entry against all ZQU's
L XNAME,1(X1)
IF ;Single module sought
SKIPLE YEXSINGLE
GOTO FALSE
THEN ;Just one comparison per entry in index block
CAME XNAME,OFFSET(ZQUR50)(XZQU)
GOTO L3
readmodule
GOTO L9
FI
HRRZS XZQU,YEXZQU
JUMPE XZQU,L9
LOOP
IF ;found
CAME XNAME,OFFSET(ZQUR50)(XZQU)
GOTO FALSE
THEN LF X3,ZQUIND(XZQU)
readmodule
L XZQU,X3
ELSE
HRLM XZQU,YEXZQU ;Remember prev. ZQU
LF XZQU,ZQUIND(XZQU)
FI
AS
JUMPN XZQU,TRUE
SA
L3():! LI X1,3(X1) ;Next
GOTO L2
FI
L X3,(X1)
AOJE X3,L9 ;Exhausted
LI X3,-1(X3)
GOTO L1 ;Next index block
L9():! IF ;Something was found in this library
SKIPL XZRQ,YEXZRQ
GOTO FALSE
THEN ;Note it for output
MOVSI (1B<%ZRQOUT>)
IORM (XZRQ)
IORM YRQHEAD
HRRZS XZRQ,YEXZRQ
ELSE ;Show that it was not found
L XZRQ,YEXSINGLE
FI
RETURN
EPROC
TOPS10,<;[225]
O1EXFW: PROC
CAIE X3,1 ;No USETI necessary for first block
USETI QCHEXT,(X3)
NOP ;In case of JACCT
SETZM YBHEXT+2
IN QCHEXT,YEXBF1+1
SKIPG YBHEXT+2
JSP [ERROR(EXT,READ)]
AOS X1,YBHEXT+1 ;Address of first word in buffer
RETURN
EPROC
>
TOPS20,<;[225]
O1EXFW: PROC ;Compute address of first word in index blk
SUBI X3,1
LSH X3,7 ;We now have word offset in file
SETZM YEXTAD ;Zero denotes index blk allocation
EXEC O1EXMP ;Map several pages starting with the
; page containing the word at offset (X3)
RETURN ;With X1 pointing to the word in core
EPROC
>
SUBTTL O1EXMP, Map external ATR file to core
TOPS20,<;[225]
O1EXMP::PROC ;Make sure the page containing word (X3) of file is mapped
SAVE X4
HRRZ X1,X3
LSH X1,-9 ;Page number in file
IF ;Index area to be allocated
SKIPE YEXTAD
GOTO FALSE
THEN ;Remap the whole area
LI X4,YEXTLX
EXEC O1EXMA ;Do the actual file mapping
AOS YEXTAD ;Restore to normal case
L [YEXTLX,,YEXTLI]
BLT YEXTLI+QLM-1 ;Copy limit info
ELSE ;Map data area, leaving index block alone
LI X4,YEXTLI
EXEC O1EXMA
FI
;Set up "buffer header"
L NPA(X4)
LSH 9
ST YBHEXT+2 ;Word count
L X3
ANDI 777
MOVN
ADDM YBHEXT+2 ;ADJUSTED
LI -1(X1) ;Point to preceding word
HRLI 004400 ;With no bit left
ST YBHEXT+1 ;Byte pointer
L FCP(X4)
LSH 9
SUBI 2
ST YBHEXT
RETURN
EPROC
>;[225]
SUBTTL O1EXMA, map external file pages
TOPS20,<;[225]
O1EXMA: PROC
STACK X3
ST X1,FFP(X4) ;First file page
HLRZ X2,YEXTMP ;First core page
HRRZ X3,YEXTMP ;Number of available pages
L YEXTSZ ;Need no more than whole rest of file
SUBI (X1)
IF ;Rest of file is smaller than area
CAML X3
GOTO FALSE
THEN ;Adjust map size
ST X3
ELSE ;Adjust with any offset
SUB X3,YEXTAD
FI
ADD X2,YEXTAD ;Adjust
ST X2,FCP(X4) ;Remember first page
ST X3,NPA(X4)
HRL X1,YEXTJF ;File handle
HRLI X2,.FHSLF ;Process handle
HRLI X3,(PM%CNT+PM%RD+PM%CPY) ;Copy on write if necessary
PMAP
LSH X2,9 ;Compute word address in core
UNSTK X3
LI X1,777 ;Mask out all but offset within page
AND X1,X3
ADDI X1,(X2) ;X1 now points to the core word
RETURN
EPROC
>;[225]
SUBTTL O1EXNP, note position of global old ATR file
Comment;
When a ZQU copy for a global module currently being compiled is
found, it is processed like an external ZQU. O1EXNP takes note of its
file spec: <YRQDEV>:<YRQFIL>.ATR[<YRQPPN>], and the position of the
ATR module within the file (given by X0 as [word offset,,block
number], zero if not in a library). [225]: On the DEC-20, also save
JFN and file size. Pass 3 then uses the information to find the old
ATR information to compare it with the new info.
;
O1EXNP: PROC
ST YATROFS ;[word offset,,block number]
L YRQDEV ;device
ST YATRDEV
L YRQFIL ;file name
ST YATRFN
L YRQPPN ;ppn
CAMN [-1] ;-1 stands for default path when explicit file
SETZ ; is required, i.e. when file name of ATR file
ST YATRPPN ; being produced differs from SIMULA name
TOPS20,<;[225]
L YEXTJF
ST YATRJF
L YEXTSZ
ST YATRSZ
>
RETURN
EPROC
SUBTTL readmodule [144]
Comment;
Skip forward in the library file to the correct word. X1 points to
the [QENTRY,,n] word of the index block. Call DPEXT to process the
attribute info.
;
O1EXRM: PROC
SAVE <X1,X3>
HRRZ X3,(X1)
ADDI X1,1(X3) ;Addr of info
L (X1) ;[offset,,blk]
WHILE ;offset >= blksize (FUDGE2 error??)
JUMPL L9
CAMGE [200,,0]
GOTO FALSE
DO ;Modify
ADD [-200,,1]
OD
TOPS20,<CAME (X1) ;[225] Don't want to modify>
ST (X1)
zquremove
IF ;Global ZQU
CAIE XZQU,YZQUGLO
GOTO FALSE
THEN ;Take note for PASS3
L (X1)
EXEC O1EXNP
GOTO L9 ;No further processing now
FI
HRROS YEXZRQ ;Mark this library as used
TOPS10,<;[225]
IF ;Not current block
HRRZ (X1)
CAMN YEXBLK
GOTO FALSE
THEN ;Position to correct block
HRLI (USETI QCHEXT,)
XCT
NOP
SETZM YBHEXT+2
EXEC O1EXT
HRRM YEXBLK
AOS YBHEXT+2 ;Adjust count
FI
HLRZ X2,(X1) ;word offset (wo)
HRRZ X1,YBHEXT ;current buffer (cb) - 2
HRRZ YBHEXT+1 ; - <current word-1> (cw-1)
SUBI 1(X1) ;written words (ww)
ADD YBHEXT+2 ;+current count = total buffer count (bc)
SUBI (X2) ;-word offset (wo) = new count
ST YBHEXT+2
ADDI X1,1(X2) ;cb+wo+1 TO (cw-1)
HRRM X1,YBHEXT+1
>;[225]
TOPS20,<;[225]
HRRZ X3,(X1) ;Block no
SUBI X3,1
LSH X3,7 ;Translate to word offset
HLRZ (X1) ;Word offset within block
ADDM X3
HRRZ (X1)
SUBI 1
LSH -2 ;Page no
SUB FFP+YEXTLI
IF ;Not currently in core
JUMPL TRUE
CAMGE NPA+YEXTLI
GOTO FALSE
THEN ;Put it there
STACK X4
STACK X1
LI X4,YEXTLI
LI 1
ST YEXTAD
EXEC O1EXMP
UNSTK X1
UNSTK X4
FI
L YEXTLI+NPA
ADD YEXTLI+FCP
L X1,YEXTLI+FCP
SUB X1,YEXTLI+FFP
LSHC 9
ADD X3,X1
SUBI (X3)
ST YBHEXT+2
LI X1,-1(X3)
HRRM X1,YBHEXT+1
>;[225]
EXEC DPEXT
L9():! RETURN
EPROC
SUBTTL skipoverhead [144]
O1EXSO: PROC
;; Here YBHEXT+1 points to first word-1 of module sought
L X1,YBHEXT+1
HLRZ 1(X1) ;Type code
IF ;New type of ATR file (entry block first)
CAIE QENTRY
GOTO FALSE
THEN ;Get rid of overhead
GETEXT X1 ;Phase in
SKIPBLOCK
CAIN 6
SKIPBLOCK ;Name block skipped
IF ;Not type 0 block
JUMPE FALSE
THEN ;Error
RFAIL ILLEGAL ATR FILE FORMAT
ERROR (EXT,READ)
FI FI
;; At this point the first word of the ATR info is available
RETURN
EPROC
O1EXSK: ;Skip rest of loader block. (X1) = header word
LI 1(X1)
LOOP GETEXT X1
AS SOJGE TRUE
SA
HLRZ X1 ;Type code returned in X0
RETURN
SUBTTL lookitup, LOOKUP ATR file [144]
Comment;
1) DEC-10:
Looks up <YRQFIL>.ATR[<YRQPPN>] on channel QCHEXT.
DEC-20:
Uses the same info, with any positive ppn translated to a directory
name, to get a handle (JFN) on the file, and opens the file for
input. Skip return on success.
;
O1EXLU: PROC
L XFILE,YRQFIL
MOVSI XFILE+1,'ATR'
STD XFILE,YELEXT
SETZM YELEXT+2
L XPPN,YRQPPN
CAMN XPPN,[-1]
SETZ XPPN, ;Treat -1 like 0
ST XPPN,YELEXT+3
LOKUPF EXT;[225]
SKIPA
AOS (XPDP) ;Ok, skip return
ST XPPN,YELEXT+3
RETURN
EPROC
SUBTTL Get a JFN, open the file for input
TOPS20,<;[225]
;Field offsets: (See LOWSEG.MAC, ELBH macro)
SZ==-4
JF==-3
MP==-2
dev==-1
fil==0
ext==1
dir==3
O1JFNI::PROC ;Get an input JFN for file defined by lookup blk at (X1)
;OPEN the file for input
;Skip return on success
HRLI X1,(GJ%OLD)
EXEC O1JFN ;Just get the JFN
RET ;FAILURE!!
BRANCH O1OJFI ;Go ahead, open it!
EPROC
DEFINE ACHAR(C)<
LI C
IDPB X3
>
O1OJFI::PROC
SAVE <X2,X3,X4>
N==3 ;Account for words on the stack
L X4,X1
HRRZ X1,JF(X4)
L X2,[^D36B5+OF%HER+OF%RD+OF%NWT+OF%PLN]
OPENF
GOTO L9 ;FAILED
SIZEF
GOTO L9
ST X3,SZ(X4) ;File size in pages
AOS -N(XPDP) ;Skip return on success
L9():! RETURN
EPROC
O1JFN:: PROC ;Get a JFN for either input or output
;The information is to be taken from the
;TOPS-10 style lookup/enter blk at (X1)
;Skip return on success.
SAVE <X2,X3,X4>
N==3 ;Words on the stack
L X3,[POINT 7,YFILSP]
L X4,X1
IFN QDIRTR,<
L X2,DIR(X4)
IF ;PPN was specified
JUMPE X2,FALSE
THEN ;Translate to "str:<directory-name>"
SKIPN X1,DEV(X4) ;Structure or logical name
MOVSI X1,'DSK' ;Default is DSK
LI X3,3(XPDP) ;Use the stack for struct name
HRLI X3,(POINT 7,) ; in ASCIZ
EXEC O16TO7
SETZ
IDPB X3
HRROI X3,3(XPDP)
HRROI X1,YFILSP
L X2,DIR(X4) ;ppn
PPNST% ;PPN to string
ERJMP L8
L X3,X1 ;Updated string ptr
ELSE ;Just output the structure name:
>
L X1,DEV(X4)
IF ;Device field exists
JUMPE X1,FALSE
THEN ;Output "STR:"
EXEC O16TO7
ACHAR <":">
FI
IFN QDIRTR,<
FI>
L X1,FIL(X4)
EXEC O16TO7
ACHAR (".")
L X1,EXT(X4)
EXEC O16TO7
SETZ
IDPB X3 ;ASCIZ delimited by null
HLL X1,X4 ;GET FLAGS FROM PARAMETER
TLO X1,(GJ%SHT) ;SHORT FORM
HRROI X2,YFILSP
GTJFN
GOTO L8 ;ERROR
ST X1,JF(X4)
L X1,X4 ;POINTER TO LOOKUP/ENTER BLK
GOTO L9
L8():! ;ERROR
SKIPA
L9():! AOS -N(XPDP)
RETURN
EPROC
>
SUBTTL O16TO7, Translate to ASCII from SIXBIT
O16TO7::PROC
LOOP
SETZ
LSHC 6
ADDI " "
CAIE " " ;Do not output spaces
IDPB X3
AS
JUMPN X1,TRUE
SA
RETURN
EPROC
SUBTTL O1EXRQ Define request block information
Comment;
Purpose
-------
To define a ZRQ record, later possibly to be output as a type 17
loader block (REQUEST library), defining a REL file to be loaded in
library search mode.
Input
-----
YRQFIL, YRQPPN, YRQDEV from a file definition.
Output
------
XZRQ points to a ZRQ record containing the given information.
Function
--------
All ZRQ records on the chain starting with YRQHEAD are matched
against the input information. If none exists with identical
information, a new ZRQ record is created via SDALLOC and put FIRST on
the chain. The search order is thus the reverse of the definition
order.
Register usage
--------------
Destroys X0,X1. Returns result in XZRQ.
;
EXTERN SDALLOC
INTERN O1EXRQ
O1EXRQ: PROC
XPPN==X4
SAVE <XALLOC,XPPN>
HRRZ XZRQ,YRQHEAD
L XPPN,YRQPPN
IF ;Any ZRQ block on the chain
JUMPE XZRQ,FALSE
THEN ;See if any of them matches YRQFIL etc.
L YRQFIL
L X1,YRQDEV
LOOP
IF ;[144] File name and device match
CAMN OFFSET(ZRQFIL)(XZRQ)
CAME X1,OFFSET(ZRQDEV)(XZRQ)
GOTO FALSE
THEN ;May be there already
CAMN XPPN,OFFSET(ZRQPPN)(XZRQ)
GOTO L9 ;PPN also matched, ok
LF X1,ZRQPPN(XZRQ)
TOPS10,<;[225]
IF ;There is an SFD path
JUMPE XPPN,FALSE
JUMPE X1,FALSE
TLNN X1,-1
TLNE XPPN,-1
GOTO FALSE
THEN ;See if paths are the same
LOOP
L 2(XPPN)
CAME 2(X1)
GOTO FALSE
JUMPE L9 ;Finish on zero
ADDI X1,1
AS
AOJA XPPN,TRUE
SA
FI>
FI
LF XZRQ,ZRQZRQ(XZRQ)
AS
JUMPN XZRQ,TRUE
SA
FI
;Not found, make and put a new block on the chain
L [ZRQ%S,,ZRQ%S]
EXEC SDALLOC
L XZRQ,XALLOC
HRRZ YRQHEAD
WSF ,ZRQZRQ(XZRQ)
HRRM XZRQ,YRQHEAD
L YRQFIL
SF ,ZRQFIL(XZRQ)
SF XPPN,ZRQPPN(XZRQ) ;[144]
L YRQDEV
SF ,ZRQDEV(XZRQ)
TOPS10,<;[225]
LI X1,OFFSET(ZRQPPN)(XZRQ) ;[144] Old SFD pointer or just a ppn
L XPPN,X2 ;[144] Save X2 over call
SETZ X2, ;[144] A new record must be allocated
EXEC O1SFDC ;[144] Copy SFD from global record
L X2,XPPN ;[144] Restore X2, ZRQPPN may now have been changed
>
L9():! RETURN
EPROC
SUBTTL sfdcopy (O1SFDC)
Comment; [144] New routine.
Copy SFD record from one place to another.
Input
-----
X1 points to a word - [a,,b]. This word is regarded as an SFD address
iff a=0, b NE 0, otherwise as a ppn. The routine has an effect only
if an SFD pointer is provided. X2 is zero or points to the new SFD
record. If X2 is zero, a new record of the required length is created
by SDALLOC. The old SFD is copied to the new record, and the [a,,b]
word pointed to by X1 is changed to point to the new record.
;
O1SFDC: PROC
TOPS10,<;[225]
L (X1)
IF ;Not a ppn
JUMPE FALSE
TLNE -1
GOTO FALSE
THEN ;Copy
IF ;New record should be allocated
JUMPN X2,FALSE
THEN ;Do that
edit(306)
HRRZ X2,(X1) ;[306] Count SFD's
SKIPE 3(X2)
AOBJP X2,.-1 ;[306] Count
HLRZ X2
ADDI 4 ; + 4
HRL ;Length in other half also
L X2,XALLOC
EXEC SDALLOC
EXCH X2,XALLOC
L (X1)
FI
ST X2,(X1) ;New address
ST X1
L (X1)
ST (X2)
L 1(X1)
ST 1(X2)
LOOP ;Copy starting with SFDPPN
L 2(X1)
ST 2(X2)
AS ;Including terminal zero
JUMPE FALSE
ADDI X1,1
AOJA X2,TRUE
SA
FI
>;[225]
RETURN
EPROC
SUBTTL openext [144]
TOPS10,<;[225]
O1EX.O: ;Perform OPEN. Call by JSP X0,O1EX.O
EXCH X2,YELEXT ;Save X2
LI X1,IO.SYN+IO.BIN ;Synchronous binary
L X2,YRQDEV
LI X3,YBHEXT
OPEN QCHEXT,X1
BRANCH [ERROR(EXT,OPEN)]
EXCH X2,YELEXT ;Restore X2
BRANCH @X0
>
TOPS20,<;[225]
O1EX.O: ;Just record device name
L X1,YRQDEV
ST X1,YEXTDV
BRANCH @X0
>
SUBTTL READ, CLOSE attribute file
TOPS10,<;[225]
;READ ONE BUFFER FROM ATTRIBUTE FILE
;
O1EXTB: exbuffers ;[225] Allocate buffers, then read first blk
O1EXT: PROC
IN QCHEXT,
SOSGE YBHEXT+2
JSP [ERROR(EXT,READ)]
AOS YEXBLK ;[144] Count the block
RETURN
EPROC ;O1EXT
;
;CLOSE ATTRIBUTE FILE
;
O1EXCL: PROC
CLOSE QCHEXT,
IF STATZ QCHEXT,740000
GOTO FALSE
THEN
SETON YPOEXT
RETURN
FI
ERROR EXT,CLOSE
EPROC ;O1EXCL
>
TOPS20,<;[225]
O1EXTB: ;Dummy entry for TOPS-20 version
O1EXT: PROC
SAVE <X1,X2,X3,X4>
LI X4,YEXTLI
LI 1
ST YEXTAD
L X3,FFP(X4)
ADD X3,NPA(X4)
LSH X3,9
EXEC O1EXMP
SOSGE YBHEXT+2
JSP [ERROR(EXT,READ)]
RETURN
EPROC
O1EXCL: PROC ;Close external file after unmapping
SAVE <X1,X2,X3>
SETO X1,
HLRZ X2,YEXTMP
HRLI X2,.FHSLF
HRRZ X3,YEXTMP
HRLI X3,(PM%CNT)
PMAP
HRRZ X1,YEXTJF
HRRZ YATRJF
CAIN (X1)
HRLI X1,(CO%NRJ) ;Keep JFN for global ATR file
CLOSF
JSP [ERROR(EXT,CLOSE)]
SETZM YEXTLI+FFP
SETOM YEXTLI+FCP
SETZM YEXTLI+NPA
SETON YPOEXT
RETURN
RETURN
EPROC
>
SUBTTL O1IC Write intermediate code
INTERN O1IC1,O1ICCL,O1ICOP
EXTERN YELIC1,YBHIC1
;
;Set up core file
;
O1ICOP: PROC
LD [XWD 442200,Y6BUF
5*2*200]
STD YBHIC1+1
SETZM YELIC1
RETURN
EPROC ;O1ICOP
;
;Core file too small, write file on disk
;
O1OPIC: PROC
SAVE <X0,X1,X2,X3>
OPEN QCHIC1,[14
SIXBIT/DSK/
XWD YBHIC1,YBHIC1]
JSP [ERROR(IC1,OPEN)]
;Set up ENTER block
LI X0,'IC1'
HLL X0,YJOB
MOVSI X1,'TMP'
STD X0,YELIC1
SETZM YELIC1+2
SETZM YELIC1+3
;ENTER
ENTER QCHIC1,YELIC1
JSP [ERROR(IC1,ENTER)]
edit(162)
SETZM YELIC1+3 ;[162]
SETON YOPIC1
;Set up buffers
EXEC O1SETB
ST X0,YBHIC1
L [XWD 5,Y6BUF]
ST YBRBUF
LI QHBYTE
HRLM YBHIC1+1 ;Restore byte size
;Output stored file
OUTSF(IC1,5,Y6BUF)
RETURN
EPROC ;O1OPIC
;
;Output buffer to IC1
;
O1IC1: PROC
SKIPN YELIC1
XEC O1OPIC ;If first call
OUT QCHIC1,
SOSGE YBHIC1+2
JSP [ERROR(IC1,WRITE)]
RETURN
EPROC ;O1IC1
;
;Close IC1
;
O1ICCL: PROC
SKIPN YELIC1
RET ;If file in core
CLOSE QCHIC1,
IF STATZ QCHIC1,740000
GOTO FALSE
THEN
SETON YPOIC1
RETURN
FI
ERROR IC1,CLOSE
EPROC ;O1ICCL
SUBTTL O1LS Write source code
INTERN O1LSOP,O1LS1,O1LSCL
EXTERN YELLS1,YBHLS1,YLCRT4
;
;SET UP CORE FILE
;
O1LSOP: PROC
LD [XWD 444400,Y1BUF
3*200]
STD YBHLS1+1
SETZM YELLS1
RETURN
EPROC ;O1LSOP
;
;CORE FILE TOO SMALL, WRITE FILE ON DISK
;
O1OPLS: PROC
SAVE <X0,X1,X2,X3>
OPEN QCHLS1,[14
SIXBIT/DSK/
XWD YBHLS1,YBHLS1]
JSP [ERROR(LS1,OPEN)]
;SET UP ENTER BLOCK
LI X0,'LS1'
HLL X0,YJOB
MOVSI X1,'TMP'
STD X0,YELLS1
SETZM YELLS1+2
SETZM YELLS1+3
;ENTER
ENTER QCHLS1,YELLS1
JSP [ERROR(LS1,ENTER)]
edit(162)
SETZM YELLS1+3 ;[162]
SETON YOPLS1
;SET UP BUFFERS
EXEC O1SETB
ST X0,YBHLS1
L [XWD 3,Y1BUF]
ST YBRBUF
;OUTPUT STORED FILE
OUTSF(LS1,3,Y1BUF)
RETURN
EPROC ;O1OPLS
;
;OUTPUT BUFFER
;
O1LS1: PROC
SKIPN YELLS1
XEC O1OPLS ;First call
OUT QCHLS1,
SOSGE YBHLS1+2
JSP [ERROR(LS1,WRITE)]
RETURN
EPROC ;O1LS1
;
;CLOSE LS1
;
O1LSCL: PROC
IF ;OLD RECORD TYPE 4
SKIPN X1,YLCRT4
GOTO FALSE
THEN ;Output it to buffer
IORI X1,1
PUTLS1 X1
FI
SKIPN YELLS1
RET ;File in core
CLOSE QCHLS1,
IF STATZ QCHLS1,740000
GOTO FALSE
THEN
SETON YPOLS1
RETURN
FI
ERROR LS1,CLOSE
EPROC ;O1LSCL
SUBTTL O1RL WRITE REL FILE
INTERN O1RL,O1RLR,O1RLS,O1RLUNR
EXTERN YELREL,YBHREL
EXTERN YO1CNB,YO1ACN,YO1RBP,YBREAK
O1RLOP: PROC
IFON YOPREL
RET ;If already opened
;SET UP ENTER BLOCK
edit(162)
LD X0,YEXTS+4 ;[162] Use correct name at the outset
STD X0,YELREL
LD X0,YEXTS+6
STD X0,YELREL+2
;ENTER
ENTER QCHREL,YELREL
JSP [ERROR(REL,ENTER)]
ST X1,YELREL+3 ;[162]
SETON YOPREL
OUT QCHREL,
SKIPA
JSP [ERROR(REL,WRITE)]
edit(306)
SETZM YO1ASB ;[306] No ASCIZ string yet
SETZM YO1ASB+1 ;[306]
SETZM YO1ASC ;[306]
;Output entry (type 4) item (header word, reloc word, data word)
edit(1)
LI X1,3 ;[1]
L XLSTXT,[4,,1] ;[1] One data word, item type 4
LOOP ;[1]
PUTREL XLSTXT ;[1]
SETZ XLSTXT, ;[1]
AS ;[1]
SOJG X1,TRUE ;[1]
SA ;[1]
;Generate name record in REL file
L XLSTXT,[6,,2]
PUTREL XLSTXT ;Generate header for code item type 6
LI XLSTXT,0
PUTREL XLSTXT ;Generate relocation record
L XLSTXT,[RADIX50 0,.MAIN]
PUTREL XLSTXT ;Generate standard name for main program
L X1,YBHREL ;[1] Also make it an entry name
ST XLSTXT,4(X1) ;[1]
L XLSTXT,[QSIMREL]
PUTREL XLSTXT ;Generate compiler identification entry
SETZM YBREAK
EXEC O1RLIC ;Initialize code stream
;Output lookup info for source code from which this rel-file originated
L YELSRC
EXEC O1RL
L YELSRC+1
EXEC O1RL
L YELSRC+2
edit(250)
EXEC O1RL ;[250]
L YELSRC+3 ;[250]
TOPS10,<;[225]
IF ;[144] SFD path [0,,adr]
JUMPE FALSE
TLNE -1
GOTO FALSE
THEN ;Output the path (ppn,sfd1,sfd2,...,0)
ST X1
LOOP
L 2(X1)
JUMPE FALSE
EXEC O1RL
AS
AOJA X1,TRUE
SA
FI ;[144]
>;[225]
EXEC O1RL
RETURN
EPROC ;O1RLOP
O1RL: PROC ;Output XLSTXT unrelocated to the code stream
SOSGE YO1CNB
XEC O1RLC
SOSGE YBHREL+2
XEC O1RLNB
AOS YBREAK
IBP YO1RBP
IDPB XLSTXT,YBHREL+1
RETURN
EPROC ;O1RL
O1RLR: PROC ;Output XLSTXT relocated to the code stream
SAVE X1
SOSGE YO1CNB
XEC O1RLC
SOSGE YBHREL+2
XEC O1RLNB
AOS YBREAK
LI X1,1
IDPB X1,YO1RBP
IDPB XLSTXT,YBHREL+1
RETURN
EPROC ;O1RLR
O1RLS: PROC ;Output a symbol to the rel file
EXEC O1RLD ;Close previous code item
L X0,[2,,2]
PUTREL X0 ;Generate header for code item type 2
PUTREL X1 ;Ac'S X1-X3 are set in calling program
PUTREL X2
PUTREL X3
EXEC O1RLIC ;Reinitialize code stream
RETURN
EPROC
O1RLC: PROC ;Generate relocation word
SAVE X1
IF ;No more room in buffer
SOSLE YBHREL+2
GOTO FALSE
edit(71)
THEN ;[71] New buffer
EXEC O1RLD
EXEC O1RLIC
SOS YO1CNB
ELSE
LI X1,0
IDPB X1,YBHREL+1 ;Relocation word
L X1,YBHREL+1
HRLI X1,440200
ST X1,YO1RBP ;Pointer to relocation word
LI X1,^D17
ST X1,YO1CNB ;Excess data words before next relocation word
FI
RETURN
EPROC ;O1RLC
O1RLD: PROC ;Close current code item
SAVE X1
L X1,YBREAK
SUB X1,@YO1ACN
ADDI X1,1
HRRM X1,@YO1ACN
RETURN
EPROC ;O1RLD
O1RLNB: PROC ;Start new buffer
EXEC O1RLD
EXEC O1RLIC
SOS YBHREL+2
SOS YO1CNB
RETURN
EPROC ;O1RLNB
O1RLIC: PROC ;Initialize new code item (type 1)
SAVE X1
SOS X1,YBHREL+2
CAIGE X1,3
XEC O1REL
L X1,YBREAK
HRLI X1,1
IDPB X1,YBHREL+1 ;Header of code item. (counter not correct)
L X1,YBHREL+1
HRRZM X1,YO1ACN ;Pointer to header
EXEC O1RLC ;Generate relocation word
L X1,YBREAK
SOS YBHREL+2
IDPB X1,YBHREL+1 ;Load address
LI X1,1
IDPB X1,YO1RBP ;Relocate load address
RETURN
EPROC ;O1RLIC
O1REL: PROC ;Write a buffer
edit(3) ;[030406] Begin
SAVE <X0,X1>
AOS X1,YRELBL ;Count this buffer
edit(16)
REPEAT 0,< ;[16] This code commented out because of i/o problems,
; to be revised later
IF ;Not main program
JUMPGE X1,FALSE
THEN ;Special buffer handling
HRRZ X1 ;Number of buffers now
IF ;Less than 2 buffers
CAIL 2
GOTO FALSE
THEN ;Suspend output of first buffer
HRRZ @YBHREL
HRRM YBHREL ;Switch buffer
ADDI 1
HRRM YBHREL+1 ;Byte pointer
LI 200 ;Number of words
ST YBHREL+2
GOTO L8
FI
IF ;2nd buffer was just filled
CAIE 2
GOTO FALSE
THEN ;Output first buffer
HRRZ X1,@YBHREL
OUT QCHREL,(X1)
SOSGE YBHREL+2
GOTO L9
FI FI
>;[16] End repeat 0
OUT QCHREL,
SOSGE YBHREL+2
GOTO L9 ;Error
L8():! RETURN
L9():! ERROR REL,WRITE
EPROC ;O1REL
;[030406] End
O1RLRQ: PROC ;Output all ZRQ records on YRQHEAD chain marked for output
;Input: X2=YRQHEAD, which is non-zero
IFOFFA ZRQOUT(X2)
RET
LOOP
WLF X3,ZRQZRQ(X2)
IF ;Output required
IFOFFA ZRQOUT(X3)
GOTO FALSE
THEN ;Output library search information to LINK
IFN QDEC20,<EXEC O1RLOA>;[225] Output a command string
IFE QDEC20,<;[225]
IF ;[144] No SFD
LF ,ZRQPPN(X2)
JUMPE TRUE
TLNN -1
GOTO FALSE
THEN ;Output type QREQLIB block
L [QREQLIB,,3]
PUTREL
SETZ
PUTREL
LF ,ZRQFIL(X2)
PUTREL
LF ,ZRQPPN(X2)
CAMN [-1] ;[144]
SETZ ;[144]
PUTREL
LF ,ZRQDEV(X2)
PUTREL
ELSE ;[144] Output ASCIZ string
EXEC O1RLOA
FI>;[225]
FI
HRRZ X2,X3
AS
JUMPN X2,TRUE
SA
RETURN
EPROC
SUBTTL O1RLOA Output ZRQ+ZSF as ASCIZ string in REL file
Comment;
Outputs a string "dev:atrfile[proj,prog,sfd1,sfd2,...]/SEARCH" to the
REL file in ASCIZ format, i e at least one trailing zero byte. [306]:
If last word output to rel file is the last word of another ASCIZ
string, restart there with a comma, making a longer command string.
Uses the routines O16BIT, O1OCTD, which call O1RLAS in coroutine
fashion.
O16BIT receives a SIXBIT word in XARG and converts one character at a
time to ASCII (in XASCII). Returns to caller when all non-blank
characters have been converted.
O1RLAS assembles ASCII words of 5 characters in XASCII and outputs
each word to the REL file as it is filled. If O1RLAS receives a null
character in XCHAR, it will fill (the rest of) XASCII with nulls,
output the word and exit via PROCEED.
O1OCT takes an integer in XARG and produces successive octal digits
(initial zeros suppressed).
;
XCHAR== X3 ;ASCII character
XARG== XCHAR+1 ;SIXBIT or binary value
XJSP== X16 ;JSP ac
XSFD== X7 ;Pointer to ZSF record
XASCII==X10 ;ASCII word assembled here
XN== X12 ;Counter in O1OCT
OPDEF GENABS [XEC O1RL] ;Output word to REL file unrelocated
OPDEF proceed [JSP XJSP,(XJSP)] ;Implements coroutine call
DEFINE outchar(C)<
LI XCHAR,C
proceed
>
DEFINE outsix(F)<;; F is a field macro defined via DF
LF XARG,F
XEC O16BIT
>
DEFINE outoct(F)<
LF XARG,F
XEC O1OCT
>
DF word,0,36,35;;Any 36-bit word
DF LH,0,18,17 ;;Any left halfword
DF RH,0,18,35 ;;Any right halfword
O1RLOA: PROC
SAVE <X1,XN,XSFD,XARG,XCHAR,XJSP>
LI XJSP,O1RLAS ;Initialize coroutine system
LD X0,YO1ASB ;[306] Block no of earlier string
;Also byte pointer to its last word
IF ;[306] That was last word output
CAMN X0,YRELBL
CAME X1,YBHREL+1
GOTO FALSE
THEN ;Restart there, splicing in a comma
SOS YBHREL+1 ;Back up byte ptr
AOS YBHREL+2 ;Back up count
LI XCHAR,","
proceed
FI
IFE QDIRTR,<;[225]
outsix <ZRQDEV(X2)> ;Device
outchar <":">
>
IFN QDIRTR,<;[225]
LF XSFD,ZRQPPN(X2) ;Zero or [p,pn]
IF ;Non-zero
JUMPE XSFD,FALSE
THEN ;Translate to "str:<directory>"
EXCH XSFD,X2
LI X3,3(XPDP) ;Use the stack for struct name
HRLI X3,(POINT 7,) ; in ASCIZ
EXEC O16TO7
SETZ
IDPB X3
HRROI X3,3(XPDP)
L X1,[POINT 7,YFILSP]
PPNST%
ERJMP FALSE
EXCH X2,XSFD
L XN,[POINT 7,YFILSP]
LOOP ;Copy the string
ILDB XCHAR,XN
JUMPE XCHAR,FALSE
proceed
AS
GOTO TRUE
SA
ELSE ;Just dev:
outsix <ZRQDEV(X2)>
outchar <":">
FI
>;[225]
outsix <ZRQFIL(X2)> ;File name
IFE QDIRTR,<;[225]
LF XSFD,ZRQPPN(X2) ;SFD pointer or PPN
IF ;Non-zero PPN
JUMPE XSFD,FALSE
THEN ;Output path definition
outchar <"[">
IF ;No SFD
TLNN XSFD,-1
GOTO FALSE
THEN ;Output just [proj no,programmer no]
outoct <LH(,XSFD)> ;project no
outchar <",">
outoct <RH(,XSFD)> ;programmer no
ELSE ;Output SFD path
TOPS10,<
outoct <ZSFPJ(XSFD)> ;Project no
outchar <",">
outoct <ZSFPG(XSFD)> ;Programmer no
LOOP
LF XARG,ZSFSFD(XSFD)
JUMPE XARG,FALSE
outchar <",">
EXEC O16BIT
AS
AOJA XSFD,TRUE
SA
>
FI
outchar <"]">
FI
>;[225]
outsix <word(,[SIXBIT'/SEARC'])>
outchar <"H">
outchar 0
edit(306)
L X0,YRELBL ;[306] Save block no
L X1,YBHREL+1 ;[306] and byte pointer
STD X0,YO1ASB ;[306] for any following command
RETURN
EPROC
SUBTTL O16BIT Convert word to ASCII characters
Comment;
Input
-----
SIXBIT word in XARG.
Output
------
ASCII character in XCHAR.
Function
--------
Starting at the leftmost bit of XARG, shift 6 bits to XCHAR and
convert to ASCII by adding octal 40. Deliver XCHAR to coroutine by
the PROCEED coroutine jump. Return to caller when XARG=0, i e
trailing blanks (null characters) are ignored.
;
O16BIT: PROC
SETZ XCHAR,
LOOP
LSHC XCHAR,6
ADDI XCHAR,40
proceed
SETZ XCHAR,
AS
JUMPN XARG,TRUE
SA
RETURN
EPROC
SUBTTL O1OCT Octal to ASCII
Comment;
Input
-----
Integer in XARG.
Output
------
ASCII digits, one at a time, in XCHAR, to the current coroutine
reached by PROCEED.
Function
--------
Similar to O16BIT. Returns directly if XARG=0.
;
O1OCT: PROC
JUMPE XARG,L9
SETZ XCHAR,
LI XN,^D12
LOOP ;Over initial zeros
JUMPN XCHAR,L1
LSHC XCHAR,3
AS
SOJG XN,TRUE
SA
GOTO L9
LOOP
LSHC XCHAR,3
L1():! ADDI XCHAR,"0"
proceed ;to character handler
SETZ XCHAR,
AS
SOJGE XN,TRUE
SA
L9():! RETURN
EPROC
SUBTTL O1RLAS Assemble ASCII word and output to REL file
Comment;
Input
-----
XCHAR = ASCII character.
Output
------
XASCII= ASCII string of 5 characters, left justified. Placed in REL
file buffer.
Function
--------
Coupled as a coroutine to some routine which delivers ASCII
characters in XCHAR. Left and entered by the PROCEED instruction (a
JSP). Special action: If XCHAR=0 (null character), fill (rest of)
XASCII with nulls and output, then return via PROCEED.
;
O1RLAS: PROC
edit(306)
L XASCII,YO1ASC ;[306] Load any unfinished word
JUMPN XASCII,L1 ;[306] Right into the action
LI XASCII,200(XCHAR) ;Put overflow marker in front of first char
LOOP ;over words
LOOP ;Accumulating characters
edit(306)
proceed ;Get next character
IF ;Zero filler
JUMPN XCHAR,FALSE
THEN ;[306] Save current contents, zero fill
ST XASCII,YO1ASC
LSH XASCII,7
JUMPGE XASCII,.-1
ELSE ;Accumulate
L1():! LSH XASCII,7
TRO XASCII,(XCHAR)
FI
AS ;Long as flag bit not shifted to sign pos
JUMPGE XASCII,TRUE
SA
L XASCII
LSH 1 ;Adjust to normal ASCII format, skip flag bit
PUTREL ;[225] No reloc wds needed
LI XASCII,1 ;Flag bit to detect full word with LSH
AS ;Long as non-zero characters are supplied
JUMPN XCHAR,TRUE
SA
proceed ;Escaped from loops!
EPROC
SUBTTL O1RLUNR - Output special info to REL file
O1RLUNR:PROC
edit(13)
L X1,YDPUNR ;[13]
L X2,YRQHEAD ;[13]
IF ;[13] Either or both are non-zero
JUMPN X1,TRUE
JUMPE X2,FALSE
THEN ;Output type 0 block and/or ASCIZ string to rel file
EXEC O1RLD ;Close current code item
SKIPE X1
XEC O1RL.U ;External reference list
SKIPE X2,YRQHEAD
XEC O1RLRQ ;LINK command string
EXEC O1RLIC ;Initialize new code item
FI
RETURN
EPROC
O1RL.U: PROC
;Count number of external references
LI X2,1
SKIPE X1,1(X1)
AOJA X2,.-1
;Compute length of code item
;=no of externals - no of relocation words [+1]
LI X0,(X2)
ADDI X2,^D17
IDIVI X2,^D19
SUBI X0,(X2)
PUTREL X0 ;Output item header [0,,n]
L X1,YDPUNR
LOOP
L X0,(X1)
PUTREL X0
AS
SKIPE X1,1(X1)
GOTO TRUE
SA
LI X0,0
PUTREL X0
RETURN
EPROC
SUBTTL O1SC Read source code
INTERN O1SCOP,O1SC,O1SCCL
EXTERN YELSRC,YBHSRC
O1SCOP: PROC
;LOOKUP
L X0,YELSRC+1 ;[144] Save extension and ppn
L X1,YELSRC+3 ;[144]
IF LOOKUP QCHSRC,YELSRC
SKIPA
GOTO TRUE
JUMPN X0,FALSE ;[144]
MOVSI X0,'SIM' ;[144]
ST X0,YELSRC+1 ;[144]
ST X1,YELSRC+3 ;[144] Restore path info
LOOKUP QCHSRC,YELSRC
GOTO FALSE
THEN ;Found it
edit(250)
ST X1,YELSRC+3 ;[144,250] Restore path info
SETON YOPSRC
LI X0,QWBYTE
HRLM X0,YBHSRC+1
;Code for output of "SIMULA: <file name>"
IF ;Started via CCL entry
IFOFF YI1CCL
GOTO FALSE
THEN ;Probably COMPIL-class command
IF IFONA YI1SWS
GOTO FALSE
THEN ;First source
OUTSTR [ASCIZ/SIMULA: /]
L X1,YELSRC ;Get file-name
LOOP ;Until no more characters
LI X0,0
LSHC X0,6
ADDI X0,40
OUTCHR X0
AS
JUMPN X1,TRUE
SA
SETONA YI1SWS
FI
FI
EXEC O1RLOP ;Open REL file
RETURN
FI
edit(45)
LI X1,YELSRC ;[45] Name of file in list
ERRT QT,256
BRANCH O1ERR
EPROC
O1SC: PROC
IF IFONA YI1SWF
GOTO FALSE
THEN SETONA YI1SWF
AOS (XPDP)
RETURN
FI
IF ;No next buffer
IN QCHSRC,
GOTO FALSE
THEN ;May be EOF
IF STATZ QCHSRC,740000
GOTO FALSE
THEN
EXEC O1SCCL
AOS 0(XPDP)
RETURN
FI
ERROR SRC,READ
FI
AOS YBHSRC+1
RETURN
EPROC
;CLOSE source code file
O1SCCL: PROC
CLOSE QCHSRC,
IF STATZ QCHSRC,740000
GOTO FALSE
THEN
SETOFF YOPSRC
RETURN
FI
ERROR SRC,CLOSE
EPROC
SUBTTL O1XR Write cross-reference file
INTERN O1XROP
INTERN O1XR,O1XRCL
EXTERN YELXRF,YBHXRF
;
;Set up core file
;
O1XROP: PROC
LD [XWD 444400,Y4BUF
2*200]
STD YBHXRF+1
SETZM YELXRF
RETURN
EPROC ;O1XROP
;
;Core file too small, write file on disk
;
O1OPXR: PROC
SAVE <X0,X1,X2,X3>
OPEN QCHXRF,[14
SIXBIT/DSK/
XWD YBHXRF,YBHXRF]
JSP [ERROR(XRF,OPEN)]
;Set up ENTER block
LI X0,'XRF'
HLL X0,YJOB
MOVSI X1,'TMP'
STD X0,YELXRF
SETZM YELXRF+2
SETZM YELXRF+3
;ENTER
ENTER QCHXRF,YELXRF
JSP [ERROR(XRF,ENTER)]
edit(162)
SETZM YELXRF+3 ;[162]
SETON YOPXRF
;Set up buffers
EXEC O1SETB
ST 0,YBHXRF
L [XWD 2,Y4BUF]
ST YBRBUF
;Output stored file
OUTSF(XRF,2,Y4BUF)
RETURN
EPROC ;O1OPXR
;
;Output buffer
;
O1XRF: PROC
SKIPN YELXRF
XEC O1OPXR ;First call
OUT QCHXRF,
SOSGE YBHXRF+2
JSP [ERROR(XRF,WRITE)]
RETURN
EPROC ;O1XRF
;
;Output a record to XRF
;
O1XR: PROC
LF X0,YLSCLIN
HRL X0,X1CUR
PUTXRF
RETURN
EPROC ;O1XR
;
;CLOSE cross-reference file
;
O1XRCL: PROC
SKIPN YELXRF
RET ;File stayed in core
CLOSE QCHXRF,
IF STATZ QCHXRF,740000
GOTO FALSE
THEN
SETON YPOXRF
RETURN
FI
ERROR XRF,CLOSE
EPROC ;O1XRCL
SUBTTL O1ZS Write symbol table
INTERN O1ZS
EXTERN YELZSE,YBHZSE
EXTERN ZSE
O1ZSOP: PROC
OPEN QCHZSE,[14
SIXBIT/DSK/
XWD YBHZSE,YBHZSE]
JSP [ERROR(ZSE,OPEN)]
;Set up ENTER block
LI X0,'ZSE'
HLL X0,YJOB
MOVSI X1,'TMP'
STD X0,YELZSE
SETZM YELZSE+2
SETZM YELZSE+3
;ENTER
ENTER QCHZSE,YELZSE
JSP [ERROR(ZSE,ENTER)]
SETZM YELZSE+3 ;[162]
SETON YOPZSE
L [XWD 2,Y15BUF]
ST YBRBUF
EXEC O1SETB
ST X0,YBHZSE
SETZM YBHZSE+2
RETURN
EPROC ;O1ZSOP
;
;Output one buffer
;
O1ZSE: PROC
OUT QCHZSE,
SOSGE YBHZSE+2
JSP [ERROR (ZSE,WRITE)]
RETURN
EPROC ;O1ZSE
;
;Close file
;
O1ZSCL: PROC
CLOSE QCHZSE,
IF STATZ QCHZSE,740000
GOTO FALSE
THEN
SETON YPOZSE
RETURN
FI
ERROR ZSE,CLOSE
EPROC ;O1ZSCL
;
;Main program
;
O1ZS: PROC
IFONA YO1ZSW
RET ;Called already
SETONA YO1ZSW
IF ;Not too big
LI X1,Y11BUF
SKIPN YELIC1
ADDI X1,2*<QBUFS+1>
SKIPN YELDF1
ADDI X1,2*<QBUFS+1>
SUB X1,YBRZSE
HRRZ X2,YMAXID
SUBI X2,1777
ASH X2,1
CAMLE X2,X1
GOTO FALSE
THEN ;ZSE can be kept in core
L X3,YBRZSE
ADDM X2,YBRZSE
HRL X0,X3
LI X1,-1(X2)
STD X0,YBHZSE+1
ADDI X2,2
ASH X2,-2
LI X4,2000
LOOP
LD X11,YZSE1(X4)
LD X13,YZSE2(X4)
EXCH X12,X13
STD X11,(X3)
STD X13,2(X3)
ADDI X3,4
ADDI X4,2
AS
SOJG X2,TRUE
SA
SETZM YELZSE
RETURN
FI
EXEC O1ZSOP
MOVN X0,YMAXID
ADDI X0,1777
LI X1,2000
HRL X1,X0
IF
JUMPG X1,FALSE
THEN LOOP
L X0,YZSE1(X1)
PUTZSE
L X0,YZSE2(X1)
PUTZSE
AS
AOBJN X1,TRUE
SA
FI
EXEC O1ZSCL
RETURN
EPROC
SUBTTL O1ERR ERROR ROUTINE
O1ERR:
edit(45)
ERRT QT,256 ;[45] Output name of file in message
BRANCH T1AB
REPEAT 0,<;; [144] Obsolete, not used
O1ERR1: PROC
LOOP
LI X3,0
LSHC X3,6
ADDI X3,40
OUTCHR X3
AS
SOJG X5,TRUE
SA
RETURN
EPROC ;O1ERR1
O1ERR2: PROC
LI 0
LI X5,6
LOOP
LSHC 3
AS
JUMPN FALSE
SOJG X5,TRUE
SA
LSHC -3
LOOP
LI 0
LSHC 3
ADDI 60
OUTCHR
AS
SOJG X5,TRUE
SA
RETURN
EPROC ;O1ERR2
>;;[144] End REPEAT 0
SUBTTL O1PACK Pack files kept in core
INTERN O1PACK
O1PACK: PROC
LI X3,Y1BUF
;Pack LS1
IF ;LS1 is in core entirely
SKIPE YELLS1
GOTO FALSE
THEN ;Keep it there
LI X1,3*200
SUBB X1,YBHLS1+2
L [XWD 444400,Y1BUF]
ST YBHLS1+1
ADD X3,X1
FI
;Pack XRF
IF ;XRF in core and contains any data
SKIPE YELXRF
GOTO FALSE
LI X1,2*200
SUBB X1,YBHXRF+2
JUMPE X1,FALSE
THEN ;Move it in core
LI X4,(X3)
HRLI X4,444400
ST X4,YBHXRF+1
HRLI X4,Y4BUF
ADD X3,X1
BLT X4,-1(X3)
FI
ST X3,YBRSRC
;Pack IC1
IF ;Not on disk
SKIPE YELIC1
GOTO FALSE
THEN ;Move it down
LI X1,5*2*200
SUBB X1,YBHIC1+2
ADDI X1,1
ASH X1,-1
LI X4,(X3)
HRLI X4,442200
ST X4,YBHIC1+1
HRLI X4,Y6BUF
ADD X3,X1
BLT X4,-1(X3)
FI
ST X3,YBRZSE
RETURN
EPROC ;O1PACK
SUBTTL O1SETB Set up buffers
INTERN O1SETB
O1SETB: PROC
SAVE <X2> ;[17]
L X0,YBRBUF
HLRZ X3,X0
ADDI X0,1
HRLI X0,201
L X2,X0
WHILE
SOJE X3,FALSE
DO
L X1,X2
ADDI X2,QBUFS+1
ST X2,(X1)
OD
ST X0,(X2)
HRLI X0,400K
RETURN
EPROC ;O1SETB
SUBTTL Literals
LIT
XPUNGE
END