Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/comp/simrpa.mac
There are 3 other files named simrpa.mac in the archive. Click here to see a list.
SUBTTL Definitions used chiefly in the run time system
SALL
SEARCH SIMMAC,SIMMCR
RUNIV SIMRPA RTS parameters and definitions ;[104]
COMMENT;
AUTHOR: Lars Enderin 1973-1974
PURPOSE: Definition of macros, constants, and symbols used in run time
system modules and a few compiler modules.
Must be assembled together with SIMMAC and SIMMCR before
assembling any RTS module.
;
IF1,<END>
PRINTX <UPDATES: [14 22 12,24,41,44,61,62,63,104,166,225,242,243,244,247,273,304] 12-Apr-78/LE>
SUBTTL MACRO DEFINITIONS
;Access to low segment variables
DEFINE LOWADR(A)<
IFNB <A>,<XLOW=A>
IFB <A>,<XLOW=XIAC>
HRRZ XLOW,.JBOPS
>
DEFINE SETLOW(A)<
IFNB <A>,<XLOW=A>
IFB <A>,<XLOW=XIAC>
>
;Miscellaneous macros
DEFINE IFNONE(A)<CAIN A,NONE>
DEFINE TRIMSTACK <SUB XPDP,[1,,1]>
DEFINE ERRMAC(A)<IRP A,<
DEFINE A'ERR(N,MSG)<
RTSERR <N+Q'A'ENO>
IFN QDEBUG,<NOP [ASCIZ/
MSG
/]
>> ;;[41] To continue after a RTS error
DEFINE A'ERC(C,N,MSG)<
RTSERR <C>,<N+Q'A'ENO>
IFN QDEBUG,<NOP [ASCIZ/
MSG
/]
>>>>
DEFINE RIGHTHALF(A)<
SIZE(Q,A)
IFN <Q-^D18>,<Q==0>
IFN <%'A-^D35>,<Q==0>
IFE <Q>,
<CFAIL A is not right half>
>
DEFINE SAVEALLACS(y)<;;[242]
EXCH X16,.JBOPS
q==YUUOAC
IFNB <y>,<q==y>;;[242]
ST X17,q+X17(X16)
LI X17,q(X16)
BLT X17,q+X15(X16)
L X17,X16
EXCH X17,.JBOPS
ST X17,q+X16(X16)
L X17,q+X17(X16)
PURGE q
>
;-- Macros for SIMDDT interface ---;
DEFINE CALLOW <SETZM YDSCSW(XLOW)> ;;Allow ^C - REENTER
DEFINE CDEFER <AOS YDSCSW(XLOW)> ;;Defer call to SIMDDT to obj.code ret.
DEFINE CENABLE <SOS YDSCSW(XLOW)>
DEFINE CFORBID <HRROS YDSCSW(XLOW)>
;[41]
;Macro for retrieval of inserted value
;from SIMDDT at error recovery
DEFINE NEWVALUE(X)=<
LOWADR
L X,YDSIAR(XLOW)
>
SUBTTL Register assignments
XSAC= 1 ; System ac - parameters to RTS
XTAC= 2 ; (Additional) parameter to some RTS routines
XZBI= 3 ; (New) block instance pointer
XADR= 4 ; Code address
XX= 5 ; Temporary pointer
XZ= 6 ; Temporary pointer
XI= 7 ; Temporary ac
XJ= 10 ; Temporary ac
XK= 11 ; Temporary ac
XL= 12 ; Temporary ac
XM= 13 ; Temporary ac
XN= 14 ; Temporary ac
XRAC= XWAC1 ; Result accumulator (returned by thunk or procedure etc.)
XRAC1= XRAC+1 ; Extension of result (long real,etc)
XXPRL= XSAC ; Prefix level of a class
XXZBI= XSAC ; Block instance as parameter
XXZPC= XSAC ; Prototype pointer
XZAC= XSAC ; Points to acs object
XZPC= XSAC ; REF(ZPC)
XZCP= XSAC ; REF(ZCP)
XZDR= XX ; REF(ZDR)
XXZ= XZBI ; Block instance pointer as parameter
XOUT= XADR ; Exit address
XLOW= XIAC ; Standard register for access to low segment static area
;Registers used by OCIN and IO:
XSPEC= X10 ;Pointer run runswitch area record ZSW
XBASE= X11 ;Base register to dynamic area
XBYTE= X12 ;Current byte from a file specification
XNAME= X13 ;Current name from a file specification
XBUF= X14 ;Pointer to current input buffer
;[61]
XBH= XWAC5 ;Pointer to buffer area
XCC= XWAC4 ;Character count
XIP= XWAC6 ;Byte pointer for Image
XSW= X14 ;Copy of flags for file object
;Base address register for SIMDDT module:
XDBAS= X14
SUBTTL SWITCHES
;Common switches used by OCIN and IO:
DSW(SWIND,YOCSW,36,XLOW) ;On if indirect specification file being read
DSW(SWTTY,YOCSW+1,36,XLOW) ;On if specification file is being read from tty
DSW(SWSYSR,YOCSW+2,36,XLOW) ;On if sysin has been read
DSW(SWSYSE,YOCSW+3,36,XLOW) ;On if end of file occurred on sysin
DSW(SWSYST,YOCSW+4,36,XLOW) ;On if sysin from tty
DSW(SWSYSI,YOCSW+5,36,XLOW) ;On if sysin was an indirect file
DSW(SWERR,YOCSW+6,36,XLOW) ;On if error in DSK SPECIFICATION FILE
DSW(SWGSW,YOCSW+7,36,XLOW) ;On if global switch, off if local
DSW(SWSWERR,YOCSW+10,36,XLOW) ;On if error during switch handling
DSW(SWHLP,YOCSW+11,36,XLOW) ;On if help mess age typed
DSW(SWSYSD,YOCSW+12,36,XLOW) ;On if sysin not from disk or tty
DSW(SWCRLF,YOCSW+13,36,XLOW) ;On if cr-lf is wanted in tty message
DSW(SWTR,YOCSW+14,36,XLOW) ;On if text record being scanned
DSW(SWLOK,YOCSW+15,36,XLOW) ;On if lookup being performed
DSW(SWGC,YOCSW+16,36,XLOW) ;On if garbage collection performed
QSWNO=^D15 ;Number of switches
DEFINE ZEROSW=<
SETZM X0,YOCSW(XLOW)
HRLI X0,YOCSW(XLOW)
HRRI X0,YOCSW+1(XLOW)
BLT X0,YOCSW+QSWNO-1(XLOW)
>
;Switches used in SA and SADEB
;[247]
DSW (SAGCPE,YSASW,0) ;On if i/o error on gcp.tmp
DSW (SWGCTE,YSASW,1) ;On if test output from gc
DSW (SWGCT2,YSASW,2) ;On if output on tty
DSW (SWGCT3,YSASW,3) ;On if output on sysout
DSW (SWGCT4,YSASW,4) ;On if gc runtime and low seg limit
; should be logged
SUBTTL RDINIT, definitions for Random Drawing [243]
DEFINE RDINIT(e)< ;;[243]
SEARCH SIMMAC,SIMMCR
EXTERN .YFARG,.YFADR ;;[205]
SALL
RTITLE RD'e
ENTRY .RD'e
ERRMAC RD
MACINIT
DEFINE XX(N)<
DEFINE ARG'N<N-1(XTAC)>
>
XX 1
XX 2
XX 3
XX 4
XX 5
SYN ARG1,RESULT
DEFINE RAND(N)<;;Basic drawing [1,2^35-1]
;;The random seed at @ARG'n is updated
L X0,@ARG'N
SKIPGE ;;Shift out sign bit if seed is negative
ADD [377777777777]
TRO 1 ;;Make odd always
MUL X0,[QMULTIPLIER]
ST X1,@ARG'N ;;Next seed value
TLZ X1,400K ;;Ignore sign (treat as pos number [1,2^35-1])
>
DEFINE MAKEREAL(N<1>)< ;;(0,2^35) to (0,1.0) floating point
FLTR X0,X1
FSC X0,N-44
>
DEFINE AR(A,B)<OFFSET(ZAR'A)+2(XWAC'B)>
DEFINE ARTEST(A,B)<
HLRZ XWAC'A,OFFSET(ZARSUB)(XWAC'B)
CAIE XWAC'A,QTSTAR
>
QMULTIPLIER==1
REPEAT ^D15,<QMULTIPLIER==QMULTIPLIER*5>;RESULT IS 5**15
QTSTAR==(<QREAL>B<%ZARTYP>+1B<%ZARSUB>)
>;;End RDINIT
SUBTTL Macro definitions used by SA and SADEB
DEFINE TEXT(T)<;; Output text t on tty
IFN QDEBUG,<
IFONA SWGCT2
>
OUT STR [ASCIZ /T/]
IFN QDEBUG,<
IF
IFOFFA SWGCT3
GOTO FALSE
THEN
LI X2,[ASCIZ /T/]
EXEC SAPDTO
FI
>
>
DEFINE RTEXT(T)<;; Output <CR><LF>'t
IFN QDEBUG,<
IFONA SWGCT2
>
OUTSTR [ASCIZ /
'T/]
IFN QDEBUG,<
IF
IFOFFA SWGCT3
GOTO FALSE
THEN
LI X2,[ASCIZ /
'T/]
EXEC SAPDTO
FI
>
>
DEFINE RRTEXT(T)<;; Output <CR><LF><CR><LF>t
IFN QDEBUG,<
IFONA SWGCT2
>
OUTSTR [ASCIZ /
'T/]
IFN QDEBUG,<
IF
IFOFFA SWGCT3
GOTO FALSE
THEN
LI X2,[ASCIZ /
'T/]
EXEC SAPDTO
FI
>
>
SUBTTL CONSTANTS
.JBOPS= 135 ; Right half will contain base of static low segment data
;[14 22 15] ZYQ from 0 to 217
QFORER==215 ;Error number for library error
QILLUUO==216 ;Error number for illegal UUO
QRFAIL==217 ;Error number for RFAIL
QIOLP= ^D60 ; Default value of linesperpage
QPDLEN= 100 ; Length of pushdown stack
QXALEN= QNAC ; Length of extended accumulator area
QPOLMI= 2000 ; Min data pool length
QSALIM=2*QNAC+2 ;Reserve this space at end of pool
QZERLG=400 ;Number of words in ZER record, default.
QZERNO=1 ;Number of ZER records allocated initially, default.
QDSLG=15000 ;[304] Length of SIMDDT program
QDSLGA=^D118+2*<%ZACSVA+4>;Length of additional data area
;Entry point offsets for SIMDDT
QDSINB= 10 ;Breakpoint
QDSINC= 12
QDSINE= 13 ;Error
QDSINR= 11 ;REENTER
QDSINI= 2 ;Initialise
QDSINS= 12 ;Remove any old breakpoints (on restart)
;[41] Define continuation codes used in RTSERR calls and in SIMDDT
QDSCON== 1 ;Continue with no arguments
QDSNIN== 2 ;Continue with new integer argument in YTXARG(XLOW)
QDSNIM== 3 ;Continue with new image read from tty
;Origins of error codes
DEFINE ERRCODE(N0,A)<..N==0
IFNB <N0>,<..N=N0>
IRP A,<
Q'A'ENO=..N
>
PURGE ..N
>
; Note!!! the following numbers must match those in SIMEDS.DOC !!!
ERRCODE QRTSE0,OC
ERRCODE 21,CP
ERRCODE 35,CS
ERRCODE 51,IO
ERRCODE 100,PH
ERRCODE 120,RD
ERRCODE 135,SA
ERRCODE 143,SS
ERRCODE 143,SU
ERRCODE 154,TX
;Common constants for OCIN and IO:
DV.TTY==1B14_-^D18
DV.DSK==1B1_-^D18
DV.MTA==1B13_-^D18
DV.TTA==1B4_-^D18
DV.TTU==1B5_-^D18
DV.DTA==1B11_-^D18
DV.DIR==1B15_-^D18
;[105] Data modes
.IOASL==0 ;ASCII
.IOASL==1 ;ASCII line
.IOPIM==2 ;Packed image
.IOIMG==10 ;Image
.IOIBM==13 ;Image binary
.IOBIN==14 ;(Blocked) binary
.IOIDP==15 ;Image dump
.IODPR==16 ;Dump as records without core buffering
.IODMP==17 ;Dump one record without core buffering
;Error codes for FORTRAN library functions, given in ac field of error instruction+1
ER%LIB==10 ;Normal library error, has message pointed to by next instr
ER%APR== 2 ;Faked apr trap, no message (arithmetic overflow in limiting cases)
;Bit masks for interrupt conditions
AP.REN=400000 ;Repetitive enable
AP.ILM= 20000 ;Illegal memory reference
AP.NXM= 10000 ;Non-existent memory (detects NONE)
AP.FOV= 100 ;Floating-point overflow
AP.AOV= 10 ;Arithmetic overflow
SUBTTL RUN TIME RECORDS
; ZFS record (file specification table entry)
DF ZFSLNK,-1,18,17 ;Link to next iospec entry
DF ZFSNAM,0,36,35 ;Sixbit logical device name
DF ZFSDEV,1,36,35 ;Sixbit physical device name
DF ZFSSIZ,2,18,17 ;Initial file size (blocks)
DF ZFSLIM,2,18,35 ;Max file size (blocks)
DF ZFSIML,3,18,17 ;Max image length for a directfile
DF ZFSFLG,3,18,35 ;Flag bits, e g access mode
DF ZFSAPP,3,1,35 ;Mode append
DF ZFSSUB,3,1,34 ;On if this entry has sub-file directory
DF ZFSWDB,3,1,31 ;[24] See ZFIWDB
DF ZFSNUM,3,1,32 ;[24] See ZFINUM
DF ZFSRON,3,1,33 ;[24] See ZFIRON
DF ZFSWLR,3,3,33 ;[24] Combines ZFSWDB,-NUM,-RON
DF ZFSFIL,4,36,35 ;Sixbit file name
DF ZFSEXT,5,18,17 ;Sixbit file extension
DF ZFSBUF,5,18,35 ;Number of buffers
DF ZFSPT,6,9,8 ;Protection code
DF ZFSPRJ,7,18,17 ;Project number
DF ZFSPRG,7,18,35 ;Programmer number
DF ZFSADR,7,36,35 ;Address to SFD block
DF ZFSARG,10,36,35 ;Argument
DF ZFSSCN,11,36,35
DF ZFSPPN,12,36,35 ;PPN in case of SFD
DF ZFSSFD,13,36,35 ;Name of sub-file directory
QFSLNG=11 ;Length of ZFS record without sfd:S
; ZFI RECORD (FILE OBJECT)
DF ZFISPC,2,36,35 ;FIRST WORD OF TEXT VARIABLE FOR FILE PARAMETER
DF ZFIFTR,2,17,35 ;POINTER TO FILE NAME RECORD
DF ZFIFLN,2,17,18 ;LENGTH OF FILE SPECIFICATION RECORD
DF ZFIIMG,4,36,35 ;FIRST WORD OF TEXT VARIABLE FOR IMAGE
DF ZFIICP,5,18,35 ;CURRENT POSITION
DF ZFIOPN,6,1,0 ;OPEN FAG
DF ZFIIF,6,1,1 ;INFILE FLAG
DF ZFIOF,6,1,2 ;OUTFILE AND PRINTFILE FLAG
DF ZFIPF,6,1,3 ;PRINTFILE FLAG
DF ZFIDF,6,1,4 ;DIRECTFILE FLAG
DF ZFIIN,6,1,5 ;THIS FILE CAN DO INPUT
DF ZFIOUT,6,1,6 ;THIS FILE CAN DO OUTPUT
DF ZFISFD,6,1,7 ;This file has a SFD record
DF ZFIDE,6,1,8 ;This file has an extended enter block
DF ZFIAPP,6,1,9 ;Append mode for this file
DF ZFIEND,6,1,10 ;Temporary end of file flag
DF ZFIECT,6,1,11 ;Eject has been done
DF ZFIFO,6,1,12 ;First output flag
DF ZFINB,6,1,13 ;Next sequential block should be read
;(Directfile only)
DF ZFIWDB,6,1,14 ;[24] Images on word boundary in the file
DF ZFINUM,6,1,15 ;[24] File is line numbered (implies ZFIWDB)
DF ZFIRON,6,1,16 ;[24] Access:RONLY
DF ZFIWLR,6,3,16 ;[24] Combines ZFIWDB,-NUM,-RON
DF ZFILBO,6,1,17 ;[44] Last call was to BREAKOUTIMAGE
DF ZFIFND,6,1,18 ;[61] On when no dialogue is wanted on file
; initialization (FIND??FILE called)
DF ZFIPGT,6,1,19 ;[63] On when OUTPUT or INPUT proc in progress on file
DF ZFINLE,6,1,20 ;[105] No lookup or enter should be done
DF ZFIBNW,6,1,21 ;[105] Buffers not wanted
DF ZFICHN,10,4,12 ;Channel number associated with this file object
;Placed in ac position for use in uuo's
DF ZFIBUF,10,18,35 ;Number of buffers
DF ZFIKAR,11,36,35 ;Device characteristics file status and type information
DF ZFITTY,11,1,14 ;Device is a tty
DF ZFIMTA,11,1,13 ;Device is a magtape
DF ZFIDSK,11,1,1 ;Device is a DSK
DF ZFITA,11,1,4 ;TTY is controlling th e job
DF ZFITU,11,1,5 ;TTY is in use as a user terminal
DF ZFIDTA,11,1,11 ;Device is a dec tape
DF ZFIDIN,11,1,16 ;This device can do input
DF ZFIDOU,11,1,17 ;This device can do output
DF ZFISTI,12,36,35 ;Initial file status
DF ZFIDMO,12,4,35 ;[61] Data mode, part of status
DF ZFIUWC,12,1,31 ;[61] Use word count when computing size of data in buffer
DF ZFISYN,12,1,30 ;[61] On if synchronous input is wanted (stop on each buf)
DF ZFIDVN,13,36,35 ;Sixbit device name
DF ZFIOBH,14,18,17 ;Address of output buffer header block
DF ZFIIBH,14,18,35 ;Address of input buffer header block
;The following information is used in lookup or enter
DF ZFIFIL,15,36,35 ;File name (sixbit)
DF ZFIEXT,16,18,17 ;File extension
DF ZFID1,16,12,35 ;File creation date
DF ZFIPT,17,9,8 ;File protection
DF ZFIMOD,17,4,12 ;Data mode
DF ZFITIM,17,12,25 ;Creation time of day
DF ZFID2,17,12,35 ;User supplied date
DF ZFIPRJ,20,18,17 ;Project number
DF ZFIPRG,20,18,35 ;Programmer number
DF ZFIARG,20,36,35 ;Link to ZYS record when SFD
DF ZFINAM,21,36,35 ;Logical file name
DF ZFIPPN,22,36,35 ;Save area for ppn between lookup's
DF ZFIBFS,23,36,35 ;Buffer size for this file
QFILNG= 24 ;Length of file object
; ZFI class ZIF - infile object
DF ZIFEND,7,36,35 ;Endfile flag (byte pointer definition)
DSW ZIFEND,7,36 ;Switch definition
QIFLNG= 24 ;Length of infile object
; ZFI CLASS ZOF - Outfile object
DF ZOFBLK,24,18,17 ;No of blocks written
DF ZOFLIM,24,18,35 ;Max no of blocks
QOFLNG= 25 ;Length of outfile object
; ZOF CLASS ZPF - printfile object
DF ZPFSP,25,18,17 ;Spacing
DF ZPFLP,25,18,35 ;Linesperpage
DF ZPFLL,26,18,17 ;Last printed line
DF ZPFLIN,26,18,35 ;Line
QPFLNG= 27 ;Length of printfile object
; ZFI CLASS ZDF - directfile object
DF ZDFEND,7,36,35 ;Endfile flag - same position as for infile !!
DSW ZDFEND,7,36 ;Switch definition
DF ZDFIML,24,18,17 ;Max image length
DF ZDFLIM,24,18,35 ;Max valid ZDFLOC (last written record number)
DF ZDFWCT,25,18,17 ;Buffer word count ;[5]RTS
DF ZDFLOC,25,18,35 ;LOCATION
DF ZDFMOD,26,1,0 ;On if outimage has been done on directfile buffer
DF ZDFOUT,26,1,1 ;On if outimage was done last, not inimage
DF ZDFBLK,26,18,35 ;Number of written or read physical
;blocks during one inimage or one outimage
QDFLNG= 27 ;Length of directfile object
; CLASS ZBH - buffer header
DF ZBHLEN,0,18,17 ;Buffer area length
DF ZBHFRE,0,1,0 ;Occupied flag
DF ZBHLNK,0,17,35 ;Link to next buffer area
DF ZBHCON,0,1,18 ;Consecutive buffer area flag
DF ZBHUSE,1,1,0 ;Buffer ring use bit
DF ZBHZBU,1,18,35 ;Current buffer
DF ZBHBUP,2,36,35 ;Byte pointer for current buffer
DF ZBHCNT,3,36,35 ;Count of remaining characters in current buffer
; Class ZSW - runswitch record
DF ZSWDEV,0,36,35 ;Device in sixbit
DF ZSWFIL,1,36,35 ;File name in sixbit
DF ZSWEXT,2,18,17 ;Extension in sixbit
DF ZSWPPN,4,36,35 ;PPN
; Class ZBU - I/O buffer
DF ZBUSTA,4,18,35 ;File status when monitor finished buffer processing
DF ZBUUSE,5,1,0 ;Buffer use bit - indicates active data
DF ZBUSIZ,5,17,17 ;Buffer data area size (incl. the next word)
DF ZBUZBU,5,18,35 ;Address of next buffer in buffer ring
DF ZBUWCT,6,18,35 ;Number of actual data words in buffer
DF ZBUDAT,7,36,35 ;Buffer data area
; Declaration of ZYS used as SFD block*
DF ZYSARG,2,36,35 ;Argument
DF ZYSP1,4,36,35 ;PPN
DF ZYSSFD,5,36,35 ;First SFD name
; Declarations of ZXB used as extended lookup block
DF ZXBLG,1,18,35 ;Length of ZXB record
DF ZXBARG,2,36,35 ;Argument
DF ZXBP2,3,36,35 ;PPN or if left half=0 a pointer to sfd-block
DF ZXBFIL,4,36,35 ;File name
DF ZXBEXT,5,18,17 ;Extension
DF ZXBPRT,6,36,35 ;Protection etc
DF ZXBPT,6,9,8 ;[61] Protection field
DF ZXBLNG,7,36,35 ;File length in words
DF ZXBLEN,12,36,35 ;Estimated file length
DF ZXBALC,13,36,35 ;Allocated file length
Q==<OFFSET(ZBHFRE)>
ASSERT <IFN %ZBHFRE,<CFAIL ZBHFRE BIT NOT FIRST AS ASSUMED>>
OPDEF FREE [SKIPL Q]
OPDEF NOTFREE [SKIPGE Q]
OPDEF IFFREE [SKIPGE Q]
QZDRZPB=1B17-OFFSET(ZDRZPB)
SUBTTL SUBROUTINE DECLARATIONS
; Procedure summary
; =================
DEFINE PROCINIT(A)=<
QOCIN== 1
QOCIO== 2
QIO== 4
QIONF= 10
QOCEP= 20 ;;[61]
QALL= QIO+QIONF+QOCEP+QOCIN+QOCIO ;;[61]
QRTSYM= 777
Q==Q'A ;;Defines current module
DEFINE X(N,E,D,U,O)<
%U==0 ;;Defines using modules
IRP U,<%U==%U+Q'U>
IFN <QRTSYM-Q'D>,< ;;Not in the transfer vector
IFN <Q&%U>,<IFE <<Q'D>&Q>,<EXTERN E>> ;;Entry not in current module
IFN <<Q'D>&Q>,<IFN <Q'D-%U>,<INTERN E>> ;;Entry in current module
;;and used in other modules
>
IFN <Q&%U>,< ;;Used in this module, define opcode
IFB <O>,<
OPDEF N [PUSHJ XPDP,E]
>
IFNB <O>,<
OPDEF N [O E]
> >
>;;END X
;; CALL FORMAT: X(name,entry point,defining module,using modules[,opcode])
X(COPYSPEC,.OCIN6,OCIN,<OCIN,IONF>) ;;Copies information from ZFD to ZFI
X(CREATEFILE,.IOCF,IONF,<OCIN,IONF>) ;;Allocates buffers
X(ERRFILE,.IOERF,OCIO,<OCIN,IO>) ;;Same as FILEERROR
;;but file ref in XWAC1
X(FILEENTER,.IOENT,IONF,<OCIN,IONF>) ;;Enters a file
X(FILEERROR,.IOFER,OCIO,IONF) ;;Types standard error text
;;and logical name on tty
X(FILELOOKUP,.IOLOK,IONF,<OCIN,IONF>) ;;LOOKUP a file
X(FINDLOGICAL,.OCINJ,OCIN,<OCIN,IONF>) ;;Retrieves logical name
;;from a file spec
X(FIXSWITCH,.OCINF,OCIN,<OCIN,IONF>) ;;Scans and processes a number of
;;switches
X(FREEBUFF,.OCINC,OCIO,<OCIN,IO>) ;;Frees a buffer area
X(GETBUFF,.OCIN7,OCIN,<OCIN,IONF>) ;;Finds a free i/o buffer
X(GETBYTE,.OCING,OCIO,<OCIN,OCIO,IONF>) ;;Fetches next byte from YOCBUF,
;;skips line feed
X(GETCHANNEL,.OCIN8,OCIO,<OCIN,IONF>) ;;LOCATES A FREE CHANNEL IN YIOCHTB
X(GETNAME,.OCIN1,OCIO,<OCIN,IO,IONF>) ;;Packs next symbol in XNAME
X(GETREST,.OCINH,OCIO,OCIN) ;;Same as GETNAME but first byte
;;already in XBYTE
X(GETSPEC,.OCINB,OCIN,<OCIN,IONF>) ;;Unpacks a file specification into ZFD
X(LEGAL,.OCLA,OCIO,<OCEP,OCIO>) ;;[61] Skip if (X1) is a legal address
X(LINKBUFF,.OCIND,OCIO,<OCIN,IONF>) ;;Links a buffer ring
X(OUTENTER,.OCINI,OCIN,<OCIN,IONF>) ;;Enters an out- or printfile
;;possibly in append mode
X(OUTOCT, .OCOO,OCIO,<IONF,OCIO,OCEP>) ;;[61] Types last 3 octal digits of X0
X(PRINTFILE,.OCIN9,OCIO,<OCIO,OCIN>) ;;[61] Prints a file spec on tty
X(PRINTSPEC,.OCINE,IONF,<OCIN,IONF>) ;;Prints the entire file spec on tty
X(REOPEN,OCINK,RTSYM,IO) ;;Reopens a file already used
X(SETUPFILE,IOCOM,RTSYM,IO) ;;Performs all common file actions
X(SPECCOPY,.OCINZ,OCIN,<OCIN,IONF>) ;;[225] Copies spec to YOCBUF from
;; any input source
X(TTYSPEC,.OCINY,OCIN,<OCIN,IONF>) ;;[225] Gets specification line from TTY
X(TYPENAME,.OCIN2,OCIO,ALL) ;;Prints the contents of X0 in sixbit
;;on tty
X(TYPESPEC,.IOTYS,OCIO,ALL) ;;[61] Type entire file spec
X(TYPDEC,.OCDT,OCIO,<OCIO,OCEP>) ;;[61] Output X0 in decimal
X(TYPOCT,.OC8T,OCIO,<OCIO,OCEP>) ;;[61] Output X0 in octal
OPDEF OP [HRLI]
OPDEF OPZ [HRLZI]
QCHN==OFFSET(ZFICHN)
DEFINE FILOP(OP,X,Y)<
IFB <Y>,<HLL X,QCHN(XWAC1)>
IFNB <Y>,<HLL X,QCHN(Y)>
TLO X,(<OP>)
XCT X
>
DEFINE IOCHECK(X,Y,M)<
IFB <M>,<HRRI X,740000>
IFNB <M>,<HRRI X,M>
FILOP(STATZ,X,Y)
>
IFE QDEC20,<OPDEF PBOUT [OUTCHR X1]> ;;[225]
PURGE %U,Q,QIO,QIONF,QOCIN,QOCIO,QRTSYM
> ;End of PROCINIT
SUBTTL Prototypes and symbol tables for system classes
QFIEBL== -3 ;Default EBL of file classes
QFIDLE==2-QFIEBL ;Corresponding display length
;[63] Add ZCPPTA field
DEFINE DCLASS(NAM,ZCP,GCI,PTA,PRL,BLE,DLE,SBL,EBL,NRP,PL,KDP,PAR)<
DEFINE D%'NAM<
IFG <NAM-400K>,<EXTERN NAM'%S,NAM'%I,NAM'%M,NAM'%Y,NAM'%D>
IFNB <ZCP>,<
IF1,<IFNDEF .'ZCP,<EXTERN .'ZCP>>
Z .'ZCP
>
IFB <ZCP>,<Z>
BYTE (1)KDP(3)GCI(1)PTA(13)0(18)NAM'%S ;[63]
Z NAM'%I ;; INNER
XWD SBL,PRL
.'NAM:: XWD BLE,NAM'%M ;;Block length,map
XWD EBL,NAM'%Y ;;Effective block level, symbol table
XWD NRP,DLE ;;No of params,display length
BYTE (1)PAR(17)0(18)NAM'%D ;; Declaration coding
IFNB <PL>,<
PL ;;Formal param. descriptor
>
IFG <NAM-400K>,<
IFN <<.-.'NAM>-<NAM'%E-NAM>>,<CFAIL INCONSIST. PROT. FOR NAM>
>>
DEFINE E%'NAM<
IFNB <ZCP>,<
IF1,<IFNDEF .'ZCP,<EXTERN .'ZCP>>
Z .'ZCP
>
IFB <ZCP>,<Z>
BYTE (1)KDP(3)GCI(1)PTA(13)0(18)0 ;;[63]
Z 0 ;; INNER
XWD SBL,PRL
.'NAM:: XWD BLE,0 ;;Block length,map
XWD EBL,0 ;;Effective block level, symbol table
XWD NRP,DLE ;;No of params,display length
BYTE (1)PAR(17)0(18)0 ;; Declaration coding
IFNB <PL>,<
PL ;;Formal param. descriptor
>
IFG <NAM-400K>,<
IFN <<.-.'NAM>-<NAM'%E-NAM>>,<CFAIL INCONSIST. PROT. FOR NAM>
>>>
DEFINE DZSMCL(SN,RN,SA)<
SIXBIT/SN/
N==0
IRPC SN,<N==N+1>
IFL <N-7>,<Z>
IFNB <SA>,<N==SA>
IFB <SA>,<N==.+1>
RN'%Y:: <QSYSCL>B<%ZSMTYP>+N
>
;[14 22 12] Define ZSDSPI codes
SCALAR<Q,QIMAIN,QISYSIN,QISYSOUT,QIFIRST,QILAST,QISUC,QIPRED,QIPREV,QIEVTIME,QINEXTEV,QITIME,QICURRENT>
;[14 22 12] Define SPI field in DZSD macro
DEFINE DZSD(NAM,SPI,TYP,MOD,KND,OFS,ZCP)<
S==0
IFNB <SPI>,<S==SPI>
K==QSIMPLE
IFNB <KND>,<K==KND>
M==QDECLARED
IFNB <MOD>,<M==MOD>
N==0
IRPC NAM,<N==N+1>
IFG <N-^D12>,<PRINTX NAM too long>
Q==0
IFG <N-6>,<Q==1B0>
Q==Q+<S>B<%ZSDSPI>+<TYP>B<%ZSDTYP>+<M>B<%ZSDMOD>+<K>B<%ZSDKND>+OFS
EXP Q
SIXBIT/NAM/
IFE <TYP-QREF>,<
IFB <ZCP>,<PRINTX REF quantity should have qualif>
Z ZCP
>>
DEFINE SYSCLASS<
X<CLPB,SUSI,SSLG,SUPS,IOFI>>
DEFINE X(A)<..N==0
IRP A,<Q'A==..N
..N==..N+1>>
SYSCLASS
;;=== RTS standard prototype definitions ===;;
DCLASS(SSST,,,1,0,ZBI%S,3+.SIMVL-1,0,.SIMLV,,,1) ;=== SIMSET ===;
DCLASS(SSLG,,QSSLG,0,0,ZLG%S,3+.SIMVL,.SIMLV,<.SIMLV-1>) ;=== LINKAGE ===;
DCLASS(SSHD,SSLG,QSSLG,0,1,ZLG%S,3+.SIMVL,.SIMLV,<.SIMLV-1>) ;=== HEAD ===;
DCLASS(SSLK,SSLG,QSSLG,0,1,ZLG%S,3+.SIMVL,.SIMLV,<.SIMLV-1>) ;=== LINK ===;
DCLASS(SUSI,SSST,QSUSI,1,1,ZSU%S,3+.SIMVL-1,0,.SIMLV,,,1) ;=== SIMULATION ===;
DCLASS(SUPS,SSLK,QSUPS,0,2,ZPS%S,3+.SIMVL,.SIMLV,<.SIMLV-1>) ;=== PROCESS ===;
DCLASS(SUMA,SUPS,QSUPS,0,3,ZPS%S,3+.SIMVL,.SIMLV,<.SIMLV-1>) ;=== MAIN PROGRAM =;
;--- ZFP for text parameter ---
PTX==<QTEXT>B<%ZTDTYP>+<QSIMPLE>B<%ZPDKND>+< QVALUE>B<%ZFPMOD>
PTX==PTX+OFFSET(ZFISPC)
DCLASS(IOFI,,QIOFI,1,,QFILNG,QFIDLE,-2,QFIEBL,1,<PTX>,,1) ;=== FILE ===;
DCLASS(IOIN,IOFI,QIOFI,1,1,QIFLNG,QFIDLE,-2,QFIEBL,,Z,,1) ;=== INFILE ===;
DCLASS(IOOU,IOFI,QIOFI,1,1,QOFLNG,QFIDLE,-2,QFIEBL,,Z,,1) ;=== OUTFILE ===;
DCLASS(IOPF,IOOU,QIOFI,1,2,QPFLNG,QFIDLE,-2,QFIEBL,,Z,,1) ;=== PRINTFILE ===;
DCLASS(IODF,IOFI,QIOFI,1,1,QDFLNG,QFIDLE,-2,QFIEBL,,Z,,1) ;=== DIRECTFILE ===;
SUBTTL GLOBAL VARIABLES
DEFINE STATIC(A,N)<
A= Q
IFB <N>,<Q==Q+1>
IFNB <N>,<Q==<N>+Q>>
Q==0
;Static low segment area definition
;----------------------------------
STATIC(YACSAV,20);[242] Accumulator save area for .OCSW
STATIC(YOCGS) ; Address of GETSEG routine
STATIC(YEDOFL) ; Number of edit overflows (accumulated)
STATIC(YIOLP) ; Linesperpage (default)
STATIC(YIOSAV) ; Save a value-type quantity here over storage allocation
STATIC(YJOBNO) ; Job number
STATIC(YDAYTM) ;Time of day at program start
STATIC(YRUNTM) ;Accumulated run time at prog start
;Variables used by SU (Simulation)
QLARGE=377777777777
STATIC(YSUNE) ;Address of NEXTEV routine
STATIC(YSULEV) ;Instruction to load SIMULATION block level to XSAC.
STATIC(YZERNO) ;Number of ZER records to be allocated initially.
STATIC(YZERLG) ;Number of words in a ZER record.
STATIC(YBATCH)
DSW SBATCH,YBATCH,36 ;On for a batch job
;SIMDDT area (not relocated by gc)
;---------------------------------
STATIC(YDSBCOM)
STATIC(YDSBSAV)
STATIC(YDSINC,4)
STATIC(YDSWIT)
DSW(YDSACT,YDSWIT,0) ;SIMDDT active
STATIC(YDSEAD)
STATIC(YDSENR)
STATIC(YDSZLA)
STATIC(YDSZLN)
STATIC(YDSNOG)
DSW SWNOGC,YDSNOG,36 ;On if garbage collection not allowed
STATIC(YDSLOAD) ;Address of DSLOAD routine
STATIC(YDSCAD) ;Approx. user address at ^C - .REENTER
STATIC(YOCOBLK,3) ;Open block for loading SIMDDT
;Make sure YSYSIN is at offset 61 OCTAL
QOBJAD==4 ;Number of words for YOBJAD
Q..==61-QOBJAD
;-- Note! we have some slack here if q. gt 0, otherwise move some declarations
Q.==Q..-Q
IFL Q.,<PRINTX Incorrect offset for YSYSIN>
IFG Q.,<Q==Q..>
PURGE Q.,Q..
;--- Object pointers collected here ---
;--------------------------------------
STATIC(YOBJAD,QOBJAD) ; Used by some RTS routines to save object addresses
; prior to calling garbage collector.
; The area is zero when not in use
QNGP=Q
STATIC(YSYSIN) ; REF(Infile) - points to standard sysin file obj
STATIC(YSYSOU) ; REF(Printfile) - points to standard sysout file obj
STATIC(YCSZAC) ; Address of newly created acs - set to zero
; when it has been copied to a display record.
; SIMDDT save area to be relocated by gc
; --------------------------------------
STATIC(YDSIAC)
STATIC(YDSCFO) ;Current file object
STATIC(YDSDFO) ;Display file object
STATIC(YDSSXCB) ;DS[2] save area for current pointer
STATIC(YDSRXCB) ;DS[2] save area for reset of current pointer
STATIC(YDSIFO) ;[41] SIMDDT input file object
STATIC(YDSBA1,1) ;[242] Saves possible SIMDDT base from (re)START of prog
STATIC(YDSDUM,2) ;[41]
STATIC(YDPATH) ;[244] Zero or pointer to default path block (NOTE not SIMDDT)
STATIC(YDSBAS)
STATIC(YDSTXT)
STATIC(YDSREF)
STATIC(YDSUFO) ;USE file object
STATIC(YDSIOT) ;Text object used by SIMDDT internally
STATIC(YDSXCB) ;Save XCB over USE command in SIMDDT
STATIC(YOCXCB) ;Saved main block address for SIMDDT and SAGC
STATIC(YSUPCP) ;Saves process address over possible garbage collection
STATIC(YSUSCP) ; --- " ---
STATIC(YSUPFT) ; --- " ---
STATIC(YSUPAC) ; --- " ---
QNGP=Q-QNGP ;Number of standard global pointers
STATIC(YIOBUF) ;Address to start of iobufs/end of iospec
STATIC(YIOCHT,20);Channel table
STATIC(YIOSPC) ;Start address of iospec table
STATIC(YIOZFS) ;Pointer to iospec entry during file object generation
STATIC(YTTIB) ;Address to tty input buffer
STATIC(YTTOB) ;Address to tty output buffer
;--- Variables used in SA to handle the storage pool ---
;-------------------------------------------------------
;;;;;;;
STATIC(YSASTA,0) ;Start of gcp.tmp dump record area
;;;;;;;
STATIC(YSATIM) ;Tim fixed runtime in millisec. updated at start of program
; before and after garbage collection
STATIC(YSAGCT) ; " Accumulated runtime for garbage collections
STATIC(YSAGCN) ; " Number of garbage collections
STATIC(YSADEA) ;Deallocation pointer
STATIC(YSATAU) ;TAU Float time between garbage collections
STATIC(YSAFES) ;F^ " estimate of active memory
STATIC(YSAFLA) ;FLAST " Last Ff^
STATIC(YSARES) ;R^ " estimate of allocation rate
STATIC(YSABES) ;B^ " estimate of garbage collection cost
STATIC(YSAR) ;R " allocation rate
STATIC(YSAA) ;A " accounting dependent parameter
STATIC(YSAL) ;L fixed storage pool area
STATIC(YSABOT) ; Start of storage pool.
STATIC(YSATOP) ; First free location of storage pool.
STATIC(YSALIM) ; Upper limit of storage pool.
; Space will however be reserved for a maximal acs object
; over and above that limit.
;;;;;;;
STATIC(YSAEND,0) ;End of gcp.tmp dump record area
;[273] Rename cells for virtual core handling
STATIC(YSANWA)
;STATIC(YSABH) ; Gcp.tmp buffer header address
STATIC(YSASW) ; Switch word with sagcpe (on if gcp.tmp error)
;[273]
STATIC(YSANWB)
;STATIC(YSAIMP) ;LOCAL IMAGE POINTER FOR DUMP ON SYSOUT
;[273]
STATIC(YSAFRZ) ;Do not relocate below address in this cell
;STATIC(YSAILC) ;ZTVLNG,,ZTVCP for local image
;[273]
STATIC(YSANWC)
;STATIC(YSAIBP) ;Local image byte pointer
STATIC(YSAZSU) ;Start of chain of SIMULATION blocks used
; in garbage collector
;;;;;;;
STATIC(YSANIN) ; A value of -1 specifies no initialisation of a newly
; allocated object. Any other value specifies that
; all allocated data words shall have this initial value
STATIC(YSAREL) ;If the storage pool must be moved, this is the
;quantity to be added to YSABOT.
STATIC(YSASAV,20);Save area for garbage collector
STATIC(YUUOAC,20);Save area for UUO handler.
;Data areas for OCIN:
STATIC(YOCSW,QSWNO) ;Switch area
STATIC(YOCRET) ;Return address to user program
STATIC(YOCSIN) ;Address to iospec entry for sysin
STATIC(YOCSOU) ;" " " sysout
STATIC(YOCBF1) ;Save area for buffer pointer during reading of indirect file
STATIC(YOCBF2) ;Save area for buffer pointer during reading of help file
STATIC(YOCBFN) ;Argument of global buffers switch if less 32
STATIC(YOCBFS) ;Argument of global buffers switch if not less 32
STATIC(YOCBST) ;Start adress of first i/o buffer
STATIC(YOCFD,7) ;Static ZFD record
STATIC(YOCFIL) ;Argument for global switch files
STATIC(YOCBUF,24);File specification buffer
STATIC(YOCBUE) ;Last word of buffer
STATIC(YOCINF) ;Indirect file name
STATIC(YOCPNT) ;Pointer to YOCBUF
;Variables used by TX
STATIC(YTXBN) ; Count of characters
STATIC(YTXBPE) ;Buffer pointer
STATIC(YTXBP) ; Buffer pointer
STATIC(YTXSGN) ; Sign information
STATIC(YTXTP) ; Buffer pointer
STATIC(YTXEXP) ; Used to save exponent in text editing
STATIC(YTXLT) ; Default "lowered ten" value in run time floating
; point fields. May be changed by TXLT.
; Used by the editing procedures
STATIC(YXACAD) ; Address of extended accumulators
STATIC(YFOXCB) ; XCB saved here over call to FORTRAN subroutine
STATIC(YTXDUM,3) ;Slack
STATIC(YOCUFL) ;[62] Count of underflows
STATIC(YDSCSW,1) ;Switch controlling ^C - REENTER:
; Negative: Cannot stop here
; Zero: May stop here
; Positive: Wait until return to object code
YTXB=YOCBUF ; LOCAL BUFFER IN TEXT HANDLING
STATIC(YTXZTV,2); Global text variable used as dummy argument in text
; and as save area for the text variable to be copied in TXCY
;---- Pushdown stack ----- should be last. ---;
;---------------------------------------------;
STATIC(YPDL,5) ;Space for a few error entries
STATIC(YOBJRT,QPDLEN) ; Actual push down stack - return address to SIMULA
; code will always be at this position
QPDEXT= 5 ;Number of additional cells in pdl - used on pdl ofl
STATIC(YPDEXT,QPDEXT) ;Pdl extension
STATIC(YDUMMY,0) ;Extra cells start here
;====== N O T E !!!!!!!!! ========;
;=== Put new entries here to minimize recompilations. Reorder later ===;
STATIC(YIOSIZ) ;Size switch arg if given in NEW
STATIC(YSASTE) ;Core allocation step length
STATIC(YSAHSZ) ;(Max) size of high segment
STATIC(YHEPPN) ;Standard ppn for help files, e g SIMRTS.HLP
STATIC(YDEPPN) ;Standard ppn for SIMDDT
STATIC(YRTPPN) ;Standard ppn for RTS
STATIC(YRTHGH) ;Hiseg name (initial)
STATIC(YOCGSB,0);GETSEG block for hiseg
STATIC(YOCDEV) ;Hiseg device
STATIC(YOCHNM) ;Hiseg name
STATIC(YZERO,2) ;Fill
STATIC(YOCPPN) ;ppn for GETSEG
STATIC(YZERO,1) ;Fill
STATIC(YOCREN) ;Saves .JBREN over OCGS
STATIC(YDSL35) ;Switch set by inimage if first word is a
;line number
;Used by SIMDDT
DSW SWLB35,YDSL35,36
STATIC(YDSIGS) ;Save area for break character pointer
;Set by inimage and used by SIMDDT
STATIC(YDSIAR) ;[41] New integer arg to continue after error
STATIC(YDSCLOSE) ;[41] Switch used by OCEP and SIMDDT to control closing of files
DSW (SDSCLO,YDSCLOSE,36) ;[41]
STATIC(YDSCRA) ;[41] switch used by SIMDDT and OCSP0
DSW (YDSSUP,YDSCRA,36) ;[41]
STATIC(YOCTXT,8) ;[225] Space for directory name or other string
..N==40-Q+YDUMMY
IFL <..N>,<CFAIL RPA static area exhausted>
STATIC(YDUM1,<..N>)
STATIC(YLOW) ; Start of dynamic core area
YCSWK1=YTXBN ;Work area for CS module
YCSWK2=YCSWK1+1
YCSWK3=YCSWK2+1
; ZFD record (SFD information)
DF ZFDDEV,YOCFD,36,35
DF ZFDFIL,YOCFD+1,36,35
DF ZFDEXT,YOCFD+2,18,17
DF ZFDPT,YOCFD+3,9,8
DF ZFDPRJ,YOCFD+4,18,17
DF ZFDPRG,YOCFD+4,18,35
DF ZFDPNT,YOCFD+5,36,35
DF ZFDSFD,YOCFD+6,36,35
END