Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/simdir.mac
There is 1 other file named simdir.mac in the archive. Click here to see a list.
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
AUTHOR: Claes Wihlborg
UPDATE: 12
PURPOSE: SIMDIR is a utility program used to getting directory
lists of and cross references between separately
compiled SIMULA modules
COMPILATION and LOADING:
UNIVERSAL SIMMAC must be available at compile time.
Must be loaded with HELPER.REL from SYS: or REL:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SALL
SEARCH SIMMAC
CTITLE SIMDIR (Utility program)
SUBTTL PROLOGUE
INTERN SIMDIR
EXTERN .JBFF,.JBREL
MACINIT
TWOSEG
SUBTTL DEFINITIONS
;ACCUMULATOR DEFINITIONS
XTOP=16
XSWITCH=15
XEXT=14
XPPN=13
XDEV=12
XPATH=11
XDIR=10
XMP2=7
XMOD2=6
XMOD=5
XZUS=4
XCC=2
XCOMTYP=XEXT
XPATTERN=XPATH
XMBP=XMP2
;ASSEMBLY TIME CONSTANT DEFINITIONS
LSTCH=1
DIRCH=2
MODCH=3
QUSING=2
QREQUIRED=4
QBUFSZ=204
QMAXLINE=55
QSZSTK=200
QSWM=1
QSWMM=2
QSWC=4
QSWFP=10
QSWMP=20
QSWSP=40
QSWSFD=100
QSWF=200
QSWT=400
QSWOTH=1K
QSWPJ=2K
QSWPG=4K
QSWLIB=200K ;[12] Module is member of a library
QSWMP2=400K
QSWP=QSWFP+QSWMP+QSWSP
QSWEXT=QSWC+QSWP
QSWALL=QSWM+QSWEXT
;FIELD DEFINITIONS
;PATTERN RECORD (Defines a search pattern)
PATPPN=0 ;PPN
PATDEV=1 ;Device
PATSW=2 ;Switches
PATNAME=3 ;File-name
;ZDI RECORD (Defines a directory)
ZDISW=-1 ;Switches
ZDIPPN=-2 ;PPN
ZDIDEV=-3 ;Device
DF(ZDINXT,-4,18,17) ;Link to next dir independent of structure
DF(ZDIBACK,-4,18,35) ;Link to directory containing name of this SFD
DF(ZDISFD,-5,18,17) ;Link to SFD:s under this directory
DF(ZDIMOD,-5,18,35) ;Link to modules under this directory
;ZMO RECORD (Defines a module)
ZMONAME=-1 ;File name
ZMOUNR=-2 ;Unique number of prototype
ZMOSW=-3 ;Switches
DF(ZMODIR,-3,18,17) ;Link to directory containing name of this module
DF(ZMOUS,-4,18,17) ;Link to cref this module using
DF(ZMOREQ,-4,18,35) ;Link to cref this module required by
DF(ZMONXT,-5,18,17) ;Link to next module independent of structure
DF(ZMOMOD,-5,18,35) ;Link to next module under same directory
DF(ZMOLIB,-6,36,35) ;[12] Library name if module is in a library
;ZUS RECORD (Defines a cross reference)
DF(ZUSNXT,-1,18,17) ;Link next cross reference
DF(ZUSMOD,-1,18,35) ;Link to module
;ZCH RECORD (Defines properties of characters)
DSW(ZCHILLEGAL,ZCH,35) ;Character illegal in command
DSW(ZCHSKIP,ZCH,34) ;Character should be skipped in command
DSW(ZCHEND,ZCH,33) ;Character terminates command
DSW(ZCHOCT,ZCH,32) ;Character is octal digit
DSW(ZCHNAME,ZCH,0) ;Character allowed in names
DSW(ZCHBLANK,ZCH,30) ;Character is blank,tab etc.
;SWITCH DEFINITIONS
DSW(SWLIST,YSWLIST,36) ;List file is given
DSW(SWTTY,YSWTTY,36) ;Output on TTY
DSW(SWFAST,YSWFAST,36) ;Output no path
;MACRO AND OPDEF DEFINITIONS
DEFINE DEFOP(A)<
IRP A,<OPDEF A[PUSHJ XPDP,.'A]>
>
DEFOP(<ATRSCAN,ENDSCAN,GETWORD,MODINIT,PPNMATCH,SCANANDTEST,SETCRF,SKIPINPUT,TESTANDSCAN>)
DEFOP(<GETPPN,GETSWITCH,GETFILE,GETNAME,GETOCT>)
DEFOP(<OUTCOM,OUTSIX,OUTOCT,OUTDEC,OUTCH,OUTPPN,OUTMOD,OUTPAGE,OUTLINE>)
DEFOP(<SIXRX50>) ;[12] RADIX50 to SIXBIT
OPDEF SCAN[ILDB XCC,COMBBP]
DEFINE GETNW(N)<
IRP N,<DEFINE GET'N'W<
ADD XTOP,[N,,N]
SKIPL XTOP
EXEC MORECORE
>
>
>
GETNW(<1,2,5,6>)
SYN GET6W,GETZMO ;[12a]
DEFINE MATCH(A)<
L XMBP,[POINT 6,A]
EXEC .MATCH
>
DEFINE OUTTEXT(A)<
EXEC .OUTTEXT,<<[POINT 7,A]>>
>
DEFINE COMERR(MESSAGE)<
GOTO [OUTSTR[ASCIZ/
/]
LI XCC,0
IDPB XCC,COMBBP
OUTSTR COMBUF
OUTSTR [ASCIZ/
? MESSAGE
/]
GOTO RNC
]
>
DEFINE ERROR(MESSAGE)<
GOTO [OUTSTR [ASCIZ/
? MESSAGE
/]
GOTO RNC
]
>
DEFINE SEVERE(MESSAGE)<
GOTO [OUTSTR [ASCIZ/?
? MESSAGE/]
EXIT]
>
SUBTTL LOW SEGMENT DATA AREAS
LOC 137 ;.jbver
EXP VERCOM ;set same version as compiler
RELOC 0
LOWSTART:
OWNPPN: BLOCK 1 ;PPN of controlling job
YSTK: BLOCK QSZSTK ;Push-down list
;DATA AREAS WHICH ARE RESET BETWEEN COMMANDS
COMBUF: BLOCK ^D28 ;Command buffer
COMBBP: BLOCK 1 ;Command buffer byte pointer
LASTPPN: BLOCK 1 ;Last directory outputted
YPAT1: BLOCK 4 ;1:st search pattern
YPAT2: BLOCK 4 ;2:nd search pattern
DIRSW: BLOCK 1 ;Switches in directory command
COMEND:
;DIR-COMMAND DATA AREAS
DIRBASE: BLOCK 1
DIRTOP: BLOCK 1
DIRSTREAM: BLOCK 1 ;Contains elements in search list of job
DIRZDI: BLOCK 1 ;Link directories
DIRZMO: BLOCK 1 ;Link modules
LIBNAME: BLOCK 1 ;[12] Name of current ATR library or zero
BLOCKNO: BLOCK 1 ;[12] Count of input blocks on current file
MOFSET: BLOCK 1 ;[12] Offset of module within disk block
YPATH: BLOCK 12 ;Path used at lookup
DIROBL: BLOCK 3 ;Open block for directories
MODOBL: BLOCK 3 ;Open block for modules
DIRLBL: BLOCK 4 ;Lookup block for directories
MODLBL: BLOCK 4 ;Lookup block for modules
DIRBH: BLOCK 3 ;Buffer header for directories
MODBH: BLOCK 3 ;Buffer header for modules
INDEX: BLOCK 200 ;[12] Current index block
DIRBUF: BLOCK 2*QBUFSZ ;Buffer ring for directories
MODBUF: BLOCK 2*QBUFSZ ;Buffer ring for modules
;LIST COMMAND DATA AREAS
LSTOBL: BLOCK 3 ;Open block for list file
LSTEBL: BLOCK 4 ;Enter block for list file
LSTBH: BLOCK 3 ;Buffer header for list file
LSTLINE: BLOCK 1 ;Line count
LSTPAGE: BLOCK 1 ;Page count
YSWLIST: BLOCK 1 ;Location of switch SWLIST
YSWTTY: BLOCK 1 ;Location of switch SWTTY
;SEARCH COMMAND DATA AREAS
YSWFAST: BLOCK 1 ;Location of switch SWFAST
;START OF DYNAMIC STORAGE
DYNSTART:
SUBTTL High segment data
RELOC 400K
INCOMMAND: ASCIZ %[,]/M
%
PAGEHEADER: ASCIZ/ SIMDIR OUTPUT PAGE /
ZCH:
DEFINE X(CH,SW)<
REPEAT CH-XCH,<XSW>
XCH=CH
XSW=0
IRPC SW,<XSW=XSW+SW'Q>
>
XCH=0
IQ=1
SQ=2
EQ=4
OQ=10
NQ=400K,,0
BQ=40
X(0,S)
X(1,I)
X(QHT,B)
X(QLF,ES)
X(QCR,S)
X(QCR+1,I)
X(33,ES)
X(34,I)
X(" ",B)
X(" "+1,I)
X("*")
X("0",ON)
X("8",N)
X("9"+1)
X("A",N)
X("Z"+1)
X("a",N)
X("z"+1)
X(177,S)
X(200)
SUBTTL Initialization routine
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
The program starts execution here
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SIMDIR:
RESET ;ALL I/O
LI DYNSTART+1K
CORE
SEVERE(NOT ENOUGH CORE)
;CLEAR LOWSEG
SETZM LOWSTART
MOVSI LOWSTART
HRRI LOWSTART+1
L X1,.JBREL
BLT (X1)
;SETUP PUSH-DOWN POINTER
L XPDP,[IOWD QSZSTK,YSTK]
;SETUP DYNAMIC DATA AREA POINTER
LI XTOP,DYNSTART
LI DYNSTART
SUB .JBREL
HRL XTOP,
;INIT OPEN BLOCKS
LI 14 ;STATUS WHEN READING
ST DIROBL
ST MODOBL
LI 0 ;STATUS WHEN WRITING
ST LSTOBL
LI DIRBH
ST DIROBL+2
LI MODBH
ST MODOBL+2
MOVSI LSTBH
ST LSTOBL+2
;SET UP INPUT BUFFERS
L [201,,DIRBUF+1]
ST DIRBUF+QBUFSZ+1
L [201,,DIRBUF+QBUFSZ+1]
ST DIRBUF+1
L [201,,MODBUF+1]
ST MODBUF+QBUFSZ+1
L [201,,MODBUF+QBUFSZ+1]
ST MODBUF+1
;GET OWN PPN
CALLI 24 ;GETPPN IS REDEFINED
ST OWNPPN
;SIMULATE A
;*DIRECTORY [SELF]/MAIN
;COMMAND
L [POINT 7,INCOMMAND]
ST COMBBP
SCAN
GOTO EDC ;EXECUTE COMMAND
SUBTTL RNC Read next command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: This routine reads a command from user TTY, stores it in
the command buffer and checks if it can recognize the
command specifier. If so a jump to the appropriate action
routine is performed, otherwise a new command is read after
issuing an error message.
EXIT CONDITIONS:The command buffer byte pointer is positioned on the first non-blank
character following the command specifier.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
RNC:
;REINITIALIZE PUSH-DOWN POINTER IN CASE OF ERROR
L XPDP,[IOWD QSZSTK,YSTK]
;OUTPUT PROMPTER
SKPINC ;CLEAR ^O
NOP
OUTSTR [ASCIZ/
*/]
;CLEAR COMMAND DATA AREAS
SETZM COMBUF
MOVSI COMBUF
HRRI COMBUF+1
BLT COMEND-1
SETOFF SWFAST
;READ UNTIL <LF>,<VT>,<FF> OR <ALTMODE>
;SKIP <CR> AND <NUL> CHARACTERS
L X1,[POINT 7,COMBUF]
ST X1,COMBBP
L X3,[POINT 7,COMBUF+^D27,34]
LOOP
INCHWL XCC
IFOFF ZCHSKIP(XCC)
IDPB XCC,COMBBP
AS
IFON ZCHILLEGAL(XCC)
GOTO [ENDSCAN
COMERR(ILLEGAL CHARACTER IN COMMAND)]
CAMN X3,COMBBP
GOTO [ENDSCAN
ERROR(TOO LONG COMMAND)]
IFOFF ZCHEND(XCC)
GOTO TRUE
SA
LI XCC,QCR
IDPB XCC,COMBBP
LI XCC,QLF
IDPB XCC,COMBBP
ST X1,COMBBP ;RESET COMMAND BUFFER BYTE POINTER
SCANANDTEST
CAIN XCC,QCR
GOTO RNC ;IF NULL COMMAND
GETNAME
COMERR(COMMAND NOT RECOGNIZED)
LI X3,RNCTRV-RNCNAM-1
LOOP
SUBI X3,1
AS
MATCH RNCNAM(X3)
SOJG X3,TRUE
SA
SKIPGE X3
COMERR(COMMAND NOT RECOGNIZED)
LSH X3,-1
GOTO @RNCTRV(X3)
;COMMAND NAMES
RNCNAM: SIXBIT/CLOSE: /
SIXBIT/EXIT: /
SIXBIT/HELP: /
SIXBIT/LIST: /
SIXBIT/DIRECTORY:/
SIXBIT/SEARCH:/
;TRANSFER VECTOR
RNCTRV: ECC
EEC
EHC
ELC
EDC
ESC
SUBTTL ECC Execute CLOSE command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Close current list file
COMMAND SYNTAX: <close-command>::=CLOSE
EXIT CONDITIONS: SWLIST is off
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ECC:
CAIE XCC,QCR
COMERR(ERROR IN COMMAND)
IFOFF SWLIST
ERROR(ILLEGAL COMMAND) ;No list file to close
SETOFF SWLIST
CLOSE LSTCH,
STATZ LSTCH,740K
ERROR(CLOSE LIST FILE)
GOTO RNC ;READ NEXT COMMAND
SUBTTL EDC Execute DIRECTORY command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Find all modules under the given directories and their
subdirectories and append them to the core data base
COMMAND SYNTAX: <directory-command>::=DIRECTORY<directory>[<directory>]...
Further details in the help text
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDC:
L YSWLIST
SETCAM YSWTTY
ST XTOP,DIRBASE ;SAVE BASE ADDRESS OF COLLECTED DIRECTORIES
EXEC EDCSCD ;SCAN FIRST DIRECTORY
WHILE
CAIE XCC,","
GOTO FALSE
DO
SCANANDTEST
EXEC EDCSCD
OD
CAIE XCC,QCR
COMERR(ERROR IN COMMAND)
ST XTOP,DIRTOP ;SAVE TOP OF COLLECTED DIRECTORIES
;HERE IF SYNTACTICALLY CORRECT COMMAND
OUTCOM ;OUTPUT COMMAND ON LIST FILE (IF ANY)
;APPEND THE COLLECTED DIRECTORIES TO LIST
SETOM DIRSTREAM
WHILE ;MORE FILE STRUCTURES
LI DIRSTREAM
JOBSTR
ERROR(JOBSTR UUO FAILURE)
SKIPN XDEV,DIRSTREAM
GOTO FALSE ;IF FENCE REACHED
DO ;READ MFD AND MATCH DIRECTORIES
ST XDEV,DIROBL+1
OPEN DIRCH,DIROBL
SEVERE(CANNOT OPEN MFD)
L [1,,1]
ST DIRLBL
ST DIRLBL+3
MOVSI 'UFD'
ST DIRLBL+1
SETZM DIRLBL+2
LOOKUP DIRCH,DIRLBL
SEVERE(CANNOT LOOKUP MFD)
L [400K,,DIRBUF+1]
ST DIRBH
;MFD INITIALIZED FOR READING
WHILE
EXEC EDCNF
GOTO FALSE
DO ;MATCH THIS PPN VERSUS THOSE FROM COMMAND
L XDIR,DIRBASE
LOOP ;THRU THE PPN GIVEN
ADD XDIR,[2,,2]
L XSWITCH,ZDISW(XDIR)
L ZDIPPN(XDIR)
XOR XPPN
IF
PPNMATCH
GOTO FALSE ;IF NOT
THEN
EXEC EDCAPD ;APPEND DIRECTORY
FI
AS
CAME XDIR,DIRTOP
GOTO TRUE
SA
OD
OD
;SEARCH DIRECTORY LIST IF ANY DIRECTORIES NEED READING
L XDIR,DIRZDI
WHILE
JUMPE XDIR,FALSE
DO ;CHECK THIS DIRECTORY
IF
HRLZ XSWITCH,ZDISW(XDIR)
ANDCM XSWITCH,ZDISW(XDIR)
JUMPE XSWITCH,FALSE
THEN ;DIR NEEDS READING
ORM XSWITCH,ZDISW(XDIR)
L ZDIDEV(XDIR)
ST DIROBL+1
ST MODOBL+1
OPEN DIRCH,DIROBL
SEVERE(CANNOT OPEN UFD)
OPEN MODCH,MODOBL
SEVERE(CANNOT OPEN MODCH)
LI XPATH,YPATH+1
MOVSI 'UFD'
ST DIRLBL+1
L [1,,1]
ST DIRLBL+3
EXEC EDCSCF ;SCAN AND APPEND FILES
FI
LF XDIR,ZDINXT(XDIR)
OD
GOTO RNC ;READ NEXT COMMAND
SUBTTL EDCAPD Append directory to data base
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Check if a directory with given device and PPN exists
in the data base. If so set switches, otherwise create a
new directory object with specified properties.
ENTRY CONDITIONS: XDEV Device
XPPN PPN
XSWITCH Switches
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDCAPD: PROC
SAVE XDIR
L XDIR,DIRZDI
TRZ XSWITCH,<QSWPJ+QSWPG+QSWMM>
WHILE
JUMPE XDIR,FALSE
DO ;SEE IF DIRECTORY ALREADY APPENDED
IF
CAMN XDEV,ZDIDEV(XDIR)
CAME XPPN,ZDIPPN(XDIR)
GOTO FALSE
THEN ;IT IS
ORM XSWITCH,ZDISW(XDIR) ;ADD (NEW?) SWITCHES
RETURN
FI
LF XDIR,ZDINXT(XDIR)
OD
;DIRECTORY NOT FOUND, APPEND IT TO LIST
GET5W ;GET ZDI-RECORD
ST XPPN,ZDIPPN(XTOP)
ST XDEV,ZDIDEV(XTOP)
ST XSWITCH,ZDISW(XTOP)
L DIRZDI
SF ,ZDINXT(XTOP)
HRRZM XTOP,DIRZDI
RETURN
EPROC
SUBTTL EDCSCD Scan <directory>
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: This routine will scan a directory in the command buffer
EXIT CONDITIONS: The properties of the scanned directory are placed
in a ZDI-record on top of lowseg.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDCSCD: PROC
L XSWITCH,DIRSW ;LOAD DEFAULT SWITCH SETTING
IF
CAIE XCC,"/"
GOTO FALSE
THEN ;CHANGE DEFAULT SWITCH SETTING
GETSWITCH
TRNE XSWITCH,<QSWEXT+QSWT+QSWF>
COMERR(ILLEGAL SWITCH)
ST XSWITCH,DIRSW
FI
CAIE XCC,"["
COMERR(PPN EXPECTED)
GETPPN
TRNE XSWITCH,QSWOTHER
COMERR(ILLEGAL PPN)
IF
CAIE XCC,"/"
GOTO FALSE
THEN ;CHANGE SWITCH FROM DEFAULT
GETSWITCH
TRNE XSWITCH,<QSWEXT+QSWF+QSWT>
COMERR(ILLEGAL SWITCH)
FI
TRO XSWITCH,<QSWEXT+QSWSFD>
GET2W ;GET SHORTENED ZDI-RECORD
ST XSWITCH,ZDISW(XTOP)
ST XPPN,ZDIPPN(XTOP)
RETURN
EPROC
SUBTTL EDCNF New file
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: This routine reads a directory and for each call it returns
a new member. If a MFD is read a UFD is returned otherwise
a file or a SFD is returned.
EXIT CONDITIONS: Skip return if new member found.
Simple return if EOF or read error.
XPPN holds the filename
XEXT holds the extension (swapped)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDCNF: PROC
;FIND PPN OR FILENAME
LOOP
IF
SOSL DIRBH+2
GOTO FALSE
THEN
IN DIRCH,
SOSGE DIRBH+2
GOTO [CLOSE DIRCH,
RETURN ;EOF OR ERROR
]
FI
ILDB XPPN,DIRBH+1
AS
JUMPE XPPN,TRUE
SA
;GET EXTENSION
SOSGE DIRBH+2
ERROR(DIRECTORY PHASE ERROR)
ILDB XEXT,DIRBH+1
HLRZ XEXT,XEXT
AOS (XPDP)
RETURN
EPROC
SUBTTL EDCSCF Scan files in directory
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: This routine reads a UFD (or SFD) and appends all modules
and SFD:s to the core data base. The same is
done for all SFD:s found.
ENTRY CONDITIONS: XDIR Points to directory to be read
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDCSCF: PROC
SAVE XDIR
L XPPN,ZDIPPN(XDIR)
ST XPPN,DIRLBL
SETZM DIRLBL+2
LOOKUP DIRCH,DIRLBL
GOTO [RETURN ;IF PROTECTION FAILURE
]
L [400K,,DIRBUF+1]
ST DIRBH
PUSH XPATH,XPPN
WHILE
EXEC EDCNF
GOTO FALSE
DO
IF
CAIN XEXT,'REL'
TLNN XSWITCH,QSWM
GOTO FALSE
THEN ;APPEND THIS MAIN MODULE
EXEC EDCMAIN
CLOSE MODCH,
ELSE
IF
CAIN XEXT,'ATR'
TLNN XSWITCH,QSWEXT
GOTO FALSE
THEN ;APPEND THIS EXTERNAL MODULE
EXEC EDCATR
CLOSE MODCH,
ELSE
IF
CAIN XEXT,'SFD'
TLNN XSWITCH,QSWSFD
GOTO FALSE
THEN ;APPEND THIS SFD
GET5W
ST XPPN,ZDIPPN(XTOP)
LF ,ZDISFD(XDIR)
SF ,ZDINXT(XTOP)
SF XTOP,ZDISFD(XDIR)
SF XDIR,ZDIBACK(XTOP)
FI FI FI
OD
;READ FILES IN COLLECTED SFD'S
LF XDIR,ZDISFD(XDIR)
WHILE
JUMPE XDIR,FALSE
DO
MOVSI 'SFD'
ST DIRLBL+1
LI YPATH
ST DIRLBL+3
EXEC EDCSCF
LF XDIR,ZDINXT(XDIR)
OD
SETZM (XPATH)
SUB XPATH,[1,,1]
RETURN
EPROC
SUBTTL EDCATR [12] Read ATR file and append one or more external modules
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: This routine will read an ATR file and collect useful
information on the corresponding module.
ENTRY CONDITIONS: XPPN Filename
XEXT Extension (swapped)
EXIT CONDITIONS: If a record for this module already exists it
is updated otherwise a record is created.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
OPDEF LIBERROR [JSP [ERROR(ATR library inconsistent)]]
EDCATR: PROC
MODINIT
RETURN
GETWORD ;1st word
RETURN ;If file is empty
HLRZ X1
IF ;INDEX block header is found
CAIE 14
GOTO FALSE
THEN ;Save the index block, treat all modules in library
ST XPPN,LIBNAME
L1():! HRRZ X1,MODBH ;Make BLT word
HRLI X1,2(X1) ;for copying the entire buffer
HRRI X1,INDEX
BLT X1,INDEX+177
EXEC EDCATI ;Get next bufferful
LIBERROR
LI INDEX
ST INDEX ;Use as pointer to current word
L2():! AOS X1,INDEX
HLRZ (X1)
IF ;Start of index item
CAIE 4
GOTO FALSE
THEN ;Find offset,,block no
HRRZ X1,(X1)
ADDI X1,1
ADDB X1,INDEX
L X1,(X1)
HLRZM X1,MOFSET
HRRZ X1
IF ;Not current block
SUB BLOCKNO
JUMPE FALSE
THEN ;Make sure the block is input
IF ;Already bypassed
JUMPG FALSE
THEN LIBERROR
ELSE
LOOP
EXEC EDCATI
LIBERROR
AS SOJG TRUE
SA
FI FI
;Now check if offset is ok
HRRZ MODBH+1
SUBI @MODBH
SUBI 1
CAMLE MOFSET
LIBERROR
L MOFSET
ADDI @MODBH ;Adjust byte ptr
ADDI 1
HRRM MODBH+1
LI 200 ;and byte count
SUB MOFSET
ST MODBH+2
GETWORD
LIBERROR
EXEC EDCATM ;Treat the library module
GOTO L2
ELSE ;Not index item, should be link to next index block
HRRE (X1)
IF ;Not last block
JUMPL FALSE
THEN ;Find the index block
SUB BLOCKNO
IF ;Accessible
JUMPL FALSE
THEN ;Make it the current block
WHILE
SOJL FALSE
DO
EXEC EDCATI
LIBERROR
OD
ELSE
LIBERROR
FI
GOTO L1
FI FI
ELSE ;Separate ATR file
SETZM LIBNAME
EXEC EDCATM
FI
RETURN
EPROC
EDCATI: IN MODCH,
AOS (XPDP) ;Normal return is skip
AOS BLOCKNO ;Count the block
RETURN
SUBTTL EDCATM [12] Read and append external ATR module
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: EDCATM reads one ATR module either from a library
or from a separate ATR file and saves some useful info.
ENTRY CONDITIONS: XPPN filename
LIBNAME filename if library, otherwise zero.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDCATM: PROC
HLRZ X1
IF ;New format
CAIE 4
GOTO FALSE
THEN ;Treat overhead info
LI XEXT,1(X1)
SKIPINPUT
RETURN
HLRZ X1
CAIE 6 ;Must be name block
RETURN ; if not
GETWORD
RETURN
GETWORD
RETURN
IF ;Library file
SKIPN LIBNAME
GOTO FALSE
THEN ;Put name of module in XPPN
L X1
SIXRX50
ST XPPN
FI
GETWORD
RETURN
WHILE ;Not type 0 block
TLNN X1,-1
GOTO FALSE
DO ;Skip blocks
LI XEXT,1(X1)
SKIPINPUT
OD
GETWORD
RETURN
FI
LI XEXT,6
SKIPINPUT
RETURN
; X1 CONTAINS FIRST WORD OF ZHB-RECORD
HRRZ X2,MODBH+1
L X3,4(X2)
L XMOD,DIRZMO
WHILE
JUMPE XMOD,FALSE
SKIPE ZMONAME(XMOD)
GOTO TRUE
CAMN X3,ZMOUNR(XMOD)
GOTO FALSE
DO
LF XMOD,ZMONXT(XMOD)
OD
IF
JUMPN XMOD,FALSE
THEN
GETZMO
LI XMOD,(XTOP)
ST X3,ZMOUNR(XMOD)
L DIRZMO
SF ,ZMONXT(XMOD)
ST XMOD,DIRZMO
FI
LF ,ZDIMOD(XDIR)
SF ,ZMOMOD(XMOD)
SF XMOD,ZDIMOD(XDIR)
SF XDIR,ZMODIR(XMOD)
ST XPPN,ZMONAME(XMOD)
;GET TYPE OF EXTERNAL
LF ,ZHETYP(,1)
IF ;Class
CAIE QCLASB
GOTO FALSE
THEN
LI X1,QSWC
ELSE ;Discriminate MACRO, FORTRAN, SIMULA
LF X1,ZHBMFO(X2) ;[5] Get tag field
IF ;[5] SIMULA code
JUMPN X1,FALSE
THEN LI X1,QSWSP
ELSE ;Check for MACRO or FORTRAN
IF ;"CODE" or "QUICK"
CAILE X1,QEXMQI
GOTO FALSE
THEN ;MACRO procedure
LI X1,QSWMP
ELSE ;FORTRAN assumed
LI X1,QSWFP
FI FI FI ;[5]
L LIBNAME
IF ;Scanning a library
JUMPE FALSE
THEN ;Save library name, set QSWLIB
SF ,ZMOLIB(XMOD)
TRO X1,QSWLIB
FI
ORM X1,ZMOSW(XMOD)
ATRSCAN
RETURN
WHILE
GETWORD
RETURN
JUMPE X1,FALSE
DO
GETWORD
RETURN
SETCRF
GETWORD
RETURN
GETWORD
RETURN
OD
RETURN
EPROC
SUBTTL EDCMAIN Read REL file and append main module
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Read a REL file and test if it originates from a
SIMULA main program. If so, append the module to the
data base and search for cross references.
ENTRY CONDITIONS: XPPN Filename
XEXT Extension (swapped)
XDIR Points to directory which contains this module
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDCMAIN:PROC
MODINIT
RETURN
GETWORD
RETURN
IF ;[030406] Entry block with one data word
CAME X1,[4,,1]
GOTO FALSE
THEN ;Could be SIMULA, check for name .MAIN
GETWORD ;reloc word
RETURN
GETWORD ;Entry name
RETURN
CAMN X1,[RADIX50 0,.MAIN]
GETWORD
RETURN
FI ;[030406]
CAMN X1,[6,,2]
GETWORD
RETURN
CAIN X1,0
GETWORD
RETURN
CAMN X1,[RADIX50 0,.MAIN]
GETWORD
RETURN
CAMN X1,[QSIMREL]
GETWORD
RETURN
;SETUP ZMO-RECORD FOR THIS MODULE
GETZMO
LI XMOD,(XTOP)
ST XPPN,ZMONAME(XMOD)
LI QSWM
ORM ZMOSW(XMOD)
L DIRZMO
SF ,ZMONXT(XMOD)
ST XMOD,DIRZMO
LF ,ZDIMOD(XDIR)
SF ,ZMOMOD(XMOD)
SF XMOD,ZDIMOD(XDIR)
SF XDIR,ZMODIR(XMOD)
;FIND LINK ITEM [0,,N] WHICH DEFINES THE EXTERNALS
WHILE
TLNE X1,-1
GOTO TRUE
TRNE X1,-1
GOTO FALSE
DO
LI XPPN,21(X1)
IDIVI XPPN,22
L XEXT,XPPN
ADDI XEXT,(X1)
SKIPINPUT
RETURN
OD
;CREATE CROSS REFERENCES
LI XPPN,21(X1)
IDIVI XPPN,22
ADDI XPPN,(X1)
LOOP
GETWORD
RETURN
SKIPN X1
RETURN
SETCRF
AS
SOJG XPPN,TRUE
SA
RETURN
EPROC
SUBTTL EEC Execute EXIT command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: If a list file is open, close it. Return to monitor.
COMMAND SYNTAX: <exit-command>::=EXIT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EEC:
CAIE XCC,QCR
COMERR(ERROR IN COMMAND)
IFOFF SWLIST
EXIT
CLOSE LSTCH,
STATZ LSTCH,740K
SEVERE(CLOSE LIST FILE)
EXIT
SUBTTL EHC Execute HELP command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output help text. If /TTY switch is given, output on
user TTY even if list file exists.
COMMAND SYNTAX: <help-command>::=HELP [/TTY]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EXTERN .HELPR ;[12]
EHC:
L YSWLIST
SETCAM YSWTTY
LI XSWITCH,0
IF
CAIE XCC,"/"
GOTO FALSE
THEN
GETSWITCH
TRNN XSWITCH,QSWT
COMERR(ILLEGAL SWITCH)
SETON SWTTY
FI
CAIE XCC,QCR
COMERR(ERROR IN COMMAND)
;HERE IF COMMAND SYNTACTICALLY CORRECT
OUTCOM ;OUTPUT ON LIST FILE (IF ANY)
;[12] OUTTEXT HELPTEXT
L 1,[SIXBIT/SIMDIR/] ;[12]
EXEC .HELPR ;[12]
GOTO RNC ;READ NEXT COMMAND
SUBTTL ELC Execute LIST command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: If old list file exists, close it. Open new list file.
COMMAND SYNTAX: <list-command>::=LIST <file specification>
EXIT CONDITIONS: SWLIST has been set
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ELC:
;GET OUTPUT FILE SPECIFICATION
GETFILE
SKIPN XDEV
MOVSI XDEV,'DSK'
ST XDEV,LSTOBL+1
SKIPN
L ['SIMDIR']
ST LSTEBL
IF
CAIE XCC,"."
GOTO FALSE
THEN ;EXTENSION IS GIVEN
SCANANDTEST
GETNAME
NOP ;ACCEPT NULL EXTENSION
ELSE
MOVSI 'LST'
FI
HLLZM LSTEBL+1
SETZM LSTEBL+2
LI XPPN,0
IF
CAIE XCC,"["
GOTO FALSE
THEN ;PPN IS GIVEN
LI XSWITCH,0
GETPPN
TRNE XSWITCH,<QSWOTHER+QSWPJ+QSWPG>
COMERR(ILLEGAL PPN)
FI
ST XPPN,LSTEBL+3
CAIE XCC,QCR
COMERR(ERROR IN COMMAND)
;HERE IF COMMAND SYNTACTICALLY CORRECT
;CLOSE OLD LIST FILE (IF ANY)
IF
IFOFF SWLIST
GOTO FALSE
THEN
SETOFF SWLIST
CLOSE LSTCH,
STATZ LSTCH,740K
ERROR(CLOSE OLD LIST FILE)
FI
;IF NEW DEVICE IS TTY: THEN READ NEXT COMMAND
CAMN XDEV,[SIXBIT/TTY/]
GOTO RNC
;OPEN NEW LIST FILE
OPEN LSTCH,LSTOBL
ERROR(CANNOT OPEN LIST FILE)
ENTER LSTCH,LSTEBL
ERROR(CANNOT ENTER LIST FILE)
HRRZM XTOP,.JBFF
OUTBUF LSTCH,
;RECOMPUTE XTOP
L XTOP,.JBFF
L XTOP
SUB .JBREL
HRL XTOP,
;INIT OUTPUT
SETZM LSTPAGE
SETON SWLIST
SETOFF SWTTY
OUTPAGE
GOTO RNC ;READ NEXT COMMAND
SUBTTL ESC Execute SEARCH command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Performs syntax checking and all actions of a SEARCH command
COMMAND SYNTAX: <search-command>::=SEARCH<pattern>[<relation>[<pattern>]]
Further details in help text.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ESC:
CAIN XCC,QCR
COMERR(NO PATTERN FOUND)
L YSWLIST
SETCAM YSWTTY
LI XPATTERN,YPAT1
EXEC ESCPAT
LI XCOMTYP,0 ;SIMPLE SEARCH
IF
CAIN XCC,QCR
GOTO FALSE
THEN ;SCAN <RELATION>
GETNAME
COMERR(ILLEGAL COMMAND)
IF
MATCH [SIXBIT/USING:/]
GOTO FALSE
THEN ;RELATION IS USING
LI XCOMTYP,QUSING
ELSE ;RELATION MUST BE REQUIRED BY
MATCH [SIXBIT/REQUIRED:/]
COMERR(ERROR IN COMMAND)
GETNAME
COMERR(ERROR IN COMMAND)
MATCH [SIXBIT/BY:/]
COMERR(ERROR IN COMMAND)
LI XCOMTYP,QREQUIRED
FI
IF
CAIN XCC,QCR
GOTO FALSE
THEN ;SECOND PATTERN EXISTS
LI XPATTERN,YPAT2
ADDI XCOMTYP,1
EXEC ESCPAT
FI
FI
CAIE XCC,QCR
COMERR(ERROR IN COMMAND)
;HERE WHEN COMMAND SYNTACTICALLY CORRECT
OUTCOM ;OUTPUT COMMAND ON LIST FILE IF ANY
;IF NO MODULES EXISTS, READ NEXT COMMAND
SKIPN XMOD,DIRZMO
GOTO RNC
;IF SECOND PATTERN EXISTS, MARK ALL THOSE WHO MATCH IT
IF
TRNN XCOMTYP,1
GOTO FALSE
THEN ;SECOND PATTERN EXISTS
;FIRST RESET MATCH MARK FOR ALL MODULES
LI XMP2,QSWMP2
LOOP
ANDCAM XMP2,ZMOSW(XMOD)
AS
LF XMOD,ZMONXT(XMOD)
JUMPN XMOD,TRUE
SA
;THEN MARK ALL THOSE WHO MATCH
EXEC ESCDIR
FI
;OUTPUT THOSE WHO MATCH FIRST PATTERN (AND RELATION)
LI XPATTERN,YPAT1
EXEC ESCDIR
GOTO RNC ;READ NEXT COMMAND
SUBTTL ESCPAT Scan search pattern
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Scan and decode a search pattern.
ENTRY CONDITIONS: XPATTERN Points to the pattern record to be updated
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ESCPAT: PROC
GETFILE
ST XDEV,PATDEV(XPATTERN)
ST PATNAME(XPATTERN)
LI XSWITCH,0
IF
CAIE XCC,"["
GOTO FALSE
THEN ;PPN IS GIVEN
GETPPN
ST XPPN,PATPPN(XPATTERN)
ELSE ;PPN NOT GIVEN, ASSUME [*,*]
TRO XSWITCH,<QSWPJ+QSWPG>
FI
WHILE
CAIE XCC,"/"
GOTO FALSE
DO
GETSWITCH
TRNE XSWITCH,QSWMM
COMERR(ILLEGAL SWITCH)
OD
TRNN XSWITCH,QSWALL
TRO XSWITCH,QSWALL ;SET ALL IF NO CATEGORY IS GIVEN
TRZE XSWITCH,QSWT
SETON SWTTY
TRZE XSWITCH,QSWF
SETON SWFAST
ST XSWITCH,PATSW(XPATTERN)
RETURN
EPROC
SUBTTL ESCDIR Find UFD:s matching a pattern
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: For all UFD:s matching a pattern, call ESCMOD to find
out if any modules match the pattern.
ENTRY CONDITIONS: XPATTERN Points to the pattern
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ESCDIR: PROC
L XDIR,DIRZDI
L XSWITCH,PATSW(XPATTERN)
WHILE
JUMPE XDIR,FALSE
DO
L PATPPN(XPATTERN)
XOR ZDIPPN(XDIR)
IF
PPNMATCH
GOTO FALSE
THEN ;PPN DO MATCH
L PATDEV(XPATTERN)
IF
JUMPE TRUE
CAME ZDIDEV(XDIR)
GOTO FALSE
THEN ;DEVICE MATCH
TDNE XSWITCH,ZDISW(XDIR)
EXEC ESCMOD ;There may be matching modules
FI
FI
LF XDIR,ZDINXT(XDIR)
OD
RETURN
EPROC
SUBTTL ESCMOD Find modules matching a pattern
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Search all modules under the given directory and
call ESCMOD for all SFD:s under the directory.
ENTRY CONDITIONS: XDIR Points to a directory to be searched
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ESCMOD: PROC
SAVE XDIR
LF XMOD,ZDIMOD(XDIR)
WHILE
JUMPE XMOD,FALSE
DO
IF
TDNN XSWITCH,ZMOSW(XMOD)
GOTO FALSE
SKIPN X1,PATNAME(XPATTERN)
GOTO TRUE ;IF NO NAME IN PATTERN
CAME X1,ZMONAME(XMOD)
GOTO FALSE
THEN ;MODULE MATCH
IF
CAIE XPATTERN,YPAT2
GOTO FALSE
THEN ;SECOND PATTERN MATCH
ORM XMP2,ZMOSW(XMOD)
ELSE ;FIRST PATTERN MATCH
EXEC ESCFPM
FI
FI
LF XMOD,ZMOMOD(XMOD)
OD
LF XDIR,ZDISFD(XDIR)
WHILE
JUMPE XDIR,FALSE
DO
EXEC ESCMOD
LF XDIR,ZDINXT(XDIR)
OD
RETURN
EPROC
SUBTTL ESCFPM First pattern match found
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output the module if no relation given or if module
satisfies the relation.
ENTRY CONDITIONS:
XCOMTYP Gives the relation and the existence of a second pattern
XMOD Points to the module
XMP2 Contains a bit pattern for testing of 2:nd pattern match
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ESCFPM: PROC
SAVE XMOD
IF
JUMPE XCOMTYP,FALSE
THEN ;RELATION WAS GIVEN
IF
TRNN XCOMTYP,QUSING
GOTO FALSE
THEN ;RELATION IS USING
LF XZUS,ZMOUS(XMOD)
ELSE
LF XZUS,ZMOREQ(XMOD)
FI
IF
TRNN XCOMTYP,1
GOTO FALSE
THEN ;SECOND PATTERN WAS GIVEN
WHILE
JUMPE XZUS,FALSE ;IF NO MATCH FOUND
LF XMOD2,ZUSMOD(XZUS)
TDNN XMP2,ZMOSW(XMOD2)
GOTO TRUE ;TRY NEXT
OUTMOD
GOTO FALSE ;MATCH FOUND
DO
LF XZUS,ZUSNXT(XZUS)
OD
ELSE ;NO SECOND PATTERN
OUTMOD
WHILE
JUMPE XZUS,FALSE
DO
LI XCC,QHT
OUTCH
LF XMOD,ZUSMOD(XZUS)
OUTMOD
LF XZUS,ZUSNXT(XZUS)
OD
FI
ELSE ;NO RELATION
OUTMOD
FI
RETURN
EPROC
SUBTTL ATRSCAN Scan a declaration segment
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: The routine will scan past a declaration segment in the
ATR file. Such a segment starts with a ZHB-record,
contains ZQU-records and declaration segments and
terminates with a zeroword.
ENTRY CONDITIONS: The last word read is the first word of a ZHB-record
EXIT CONDITIONS: If an EOF or error occurs a return is made.
If routine successful, a skip return is made.
The last word read is the terminating zero-word.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.ATRSCAN:PROC
LI XEXT,4
SKIPINPUT
RETURN
WHILE
JUMPE X1,FALSE
DO
LF ,ZDETYP(,1)
IF
CAIE ZQU%V
GOTO FALSE
THEN
LI XEXT,5
SKIPINPUT
RETURN
ELSE
ATRSCAN
RETURN
GETWORD
RETURN
FI
OD
AOS (XPDP)
RETURN
EPROC
SUBTTL ENDSCAN Scan until end of command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: The routine will read terminal input until a termination
character is found. It is used when an error has been
found in command input.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.ENDSCAN:PROC
WHILE
IFON ZCHEND(XCC)
GOTO FALSE
DO
INCHWL XCC
OD
RETURN
EPROC
SUBTTL GETPPN Scan PPN
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Scan PPN in command buffer
ENTRY CONDITIONS: The left bracket has just been scanned.
EXIT CONDITIONS: XPPN holds the PPN.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.GETPPN:PROC
SCANANDTEST
IF
IFOFF ZCHOCT(XCC)
GETNAME
GOTO FALSE
THEN ;PPN IS [SELF] OR [OTHERS]
L XPPN,OWNPPN
IF
MATCH [SIXBIT/OTHERS:/]
GOTO FALSE
THEN ;IT IS [OTHERS]
TRO XSWITCH,QSWOTHER
ELSE ;TRY [SELF]
MATCH [SIXBIT/SELF:/]
COMERR(ERROR IN PPN)
FI
ELSE ;PPN IS [...,...]
LI XPPN,0
IF
CAIE XCC,"*"
GOTO FALSE
THEN ;PPN IS [*,...
TRO XSWITCH,QSWPJ
SCAN
ELSE
IF
CAIE XCC,","
GOTO FALSE
THEN ;PPN IS [,..
HLL XPPN,OWNPPN
ELSE
GETOCT
HRL XPPN,XCC-1
FI FI
TESTANDSCAN
CAIE XCC,","
COMERR(ERROR IN PPN)
SCANANDTEST
IF
CAIE XCC,"*"
GOTO FALSE
THEN ;PPN IS [...,*]
TRO XSWITCH,QSWPG
SCAN
ELSE
IF
CAIE XCC,"]"
GOTO FALSE
THEN ;PPN IS [...,]
HRR XPPN,OWNPPN
ELSE
GETOCT
HRR XPPN,XCC-1
FI FI
TESTANDSCAN
FI
CAIE XCC,"]"
COMERR(ERROR IN PPN)
SCANANDTEST
RETURN
EPROC
SUBTTL GETFILE
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Scan <device>:<filename> in command buffer
EXIT CONDITIONS: XDEV Contains <device>. 0 if not given.
X0 Contains <filename>. 0 if not given.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.GETFILE:PROC
LI XDEV,0
GETNAME
RETURN ;NOTHING
CAIE XCC,":"
RETURN ;<FILENAME>
CAME [SIXBIT/DSK/]
L XDEV, ;ONLY IF NOT DSK
SCANANDTEST
GETNAME
RETURN ;<DEVICE>:
RETURN ;<DEVICE>:<FILENAME>
EPROC
SUBTTL GETSWITCH
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: The routine will scan a switch in the command buffer.
ENTRY CONDITIONS: The leading / has just been scanned.
EXIT CONDITIONS: XSWITCH Is updated.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.GETSWITCH:PROC
SCANANDTEST
IF
CAIE XCC,"-"
GOTO FALSE
THEN ;TRY /-MAIN
SCANANDTEST
GETNAME
COMERR(ERROR IN SWITCH)
MATCH [SIXBIT/MAIN:/]
COMERR(ERROR IN SWITCH)
TRZ XSWITCH,QSWM
TRO XSWITCH,QSWMM
ELSE
GETNAME
COMERR(ERROR IN SWITCH)
LI X3,YSWBIT-YSWL-1
LOOP
SUBI X3,1
AS
MATCH YSWL(X3)
SOJG X3,TRUE
SA
SKIPGE X3
COMERR(ERROR IN SWITCH)
LSH X3,-1
TDO XSWITCH,YSWBIT(X3)
FI
RETURN
EPROC
YSWL:
SIXBIT/FPROCEDURES:/
SIXBIT/MPROCEDURES:/
SIXBIT/SPROCEDURES:/
SIXBIT/FAST: /
SIXBIT/TTY: /
SIXBIT/PROCEDURES:/
SIXBIT/CLASSES:/
SIXBIT/MAIN: /
SIXBIT/ALL: /
YSWBIT:
QSWFP
QSWMP
QSWSP
QSWF
QSWT
QSWP
QSWC
QSWM
QSWALL
SUBTTL GETNAME
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Scan a name in command buffer
EXIT CONDITIONS: If no name found take simple return.
If name found X0 and X1 keeps the
name in SIXBIT. Take skip return.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.GETNAME:PROC
SETZB X0,X1
SKIPL ZCH(XCC)
RETURN ;IF NO NAME FOUND
AOS (XPDP)
L XCC+1,[POINT 6,0]
LOOP
CAIL XCC,140 ;IF LOWER CASE LETTER
TRZ XCC,40 ;THEN CONVERT TO UPPER CASE
SUBI XCC,40 ;CONVERT TO SIXBIT
CAME XCC+1,[POINT 6,1,35]
IDPB XCC,XCC+1
SCAN
AS
SKIPGE ZCH(XCC)
GOTO TRUE
SA
TESTANDSCAN
RETURN
EPROC
SUBTTL GETOCT
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Scan an octal number in command buffer.
EXIT CONDITIONS: XCC-1 Holds the octal number.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.GETOCT:PROC
IFOFF ZCHOCT(XCC)
COMERR(OCTAL DIGIT EXPECTED)
LI XCC-1,0
LOOP
ROT XCC,-3
LSHC XCC-1,3
SCAN
AS
IFON ZCHOCT(XCC)
GOTO TRUE
SA
RETURN
EPROC
SUBTTL GETWORD
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Reads a word from ATR or REL file.
EXIT CONDITIONS: If EOF or error occurs take simple return,
Otherwise take skip return with value in X1.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.GETWORD:PROC
IF
SOSL MODBH+2
GOTO FALSE
THEN
IN MODCH,
SOSGE MODBH+2
RETURN
AOS BLOCKNO ;[12] Count the block
FI
ILDB X1,MODBH+1
AOS (XPDP)
RETURN
EPROC
SUBTTL MATCH
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Match two names versus each other. The first name must be
an initial segment of the second name.
ENTRY CONDITIONS: XMBP Byte pointer to second name
X0 & X1 First name in SIXBIT
EXIT CONDITIONS: If a match is found then take skip return,
otherwise take simple return.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.MATCH: PROC
SAVE <X4,X5,X6>
L X6,[POINT 6,0]
LOOP
ILDB X4,XMBP
ILDB X5,X6
AS
CAMN X4,X5
GOTO TRUE
SA
CAIN X5,0
AOS -3(XPDP) ;MODIFY RETURN ADDRESS IF MATCH
RETURN
EPROC
SUBTTL MODINIT
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Perform some actions common to the REL and ATR files
when opened.
ENTRY CONDITIONS: XPPN Filename
XEXT Extension (swapped)
EXIT CONDITIONS: If the file is successfully looked up and the first
buffer read take skip return,otherwise take simple return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.MODINIT:PROC
ST XPPN,MODLBL
MOVSM XEXT,MODLBL+1
SETZM MODLBL+2
LI YPATH
ST MODLBL+3
LOOKUP MODCH,MODLBL
RETURN
L [400K,,MODBUF+1]
ST MODBH
IN MODCH,
AOS (XPDP)
LI 1 ;[12]
ST BLOCKNO ;[12] Initial count
RETURN
EPROC
SUBTTL MORECORE
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Expand low segment one page.
EXIT CONDITIONS: XTOP Left halfword is updated.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MORECORE:PROC
SAVE X1
HRRZ X1,.JBREL
ADDI X1,1K
CORE X1,
SEVERE(NOT ENOUGH CORE)
HRRZ X1,XTOP
SUB X1,.JBREL
HRL XTOP,X1
RETURN
EPROC
SUBTTL OUTCOM Output command
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output the given command to list file (if any)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTCOM:PROC
IFON SWTTY
RETURN ;IF OUTPUT ON TTY
OUTLINE
LI XCC,"*"
OUTCH
OUTTEXT COMBUF
OUTLINE
RETURN
EPROC
SUBTTL OUTMOD Output module
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output a module name and its accessing path.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTMOD:PROC
SAVE XDIR
IF
SKIPN XCC+1,ZMONAME(XMOD)
GOTO FALSE
THEN ;MODULE FOUND IN SOME DIRECTORY
OUTSIX
IF ;[12] Part of a library
L ZMOSW(XMOD)
TRNN QSWLIB
GOTO FALSE
THEN ;Output library name also
OUTTEXT <[ASCIZ/ in /]>
LF XCC+1,ZMOLIB(XMOD)
OUTSIX
FI ;[12]
LF XDIR,ZMODIR(XMOD)
OUTPPN
ELSE
OUTTEXT <[ASCIZ/NOT FOUND
/]>
FI
RETURN
EPROC
SUBTTL OUTPPN Output PPN
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output <ht><device>:[PPN,SFD..]
ENTRY CONDITIONS: XDIR Points to a directory.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTPPN:PROC
IF
IFOFF SWFAST
CAMN XDIR,LASTPPN
GOTO FALSE
THEN
ST XDIR,LASTPPN
LI XCC,QHT
OUTCH
EXEC ..OUTPPN
LI XCC,"]"
OUTCH
FI
OUTLINE
RETURN
EPROC
..OUTPPN:PROC
SAVE XCC-1
IF
SKIPN XCC+1,ZDIDEV(XDIR)
GOTO FALSE
THEN ;UFD
OUTSIX ;OUTPUT DEVICE
OUTTEXT [ASCIZ/: [/]
HLRZ XCC-1,ZDIPPN(XDIR)
OUTOCT
LI XCC,","
OUTCH
HRRZ XCC-1,ZDIPPN(XDIR)
OUTOCT
ELSE ;SFD
L XCC-1,XDIR
LF XDIR,ZDIBACK(XDIR)
EXEC ..OUTPPN
LI XCC,","
OUTCH
L XCC+1,ZDIPPN(XCC-1)
OUTSIX
FI
RETURN
EPROC
SUBTTL OUTSIX Output a sixbit name
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output a sixbit name. Trailing blanks are not output.
ENTRY CONDITIONS: XCC+1 Holds the name left justified.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTSIX:PROC
LOOP
LI XCC,0
LSHC XCC,6
ADDI XCC,40
OUTCH
AS
JUMPN XCC+1,TRUE
SA
RETURN
EPROC
SUBTTL OUTDEC
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output a number in decimal radix.
ENTRY CONDITIONS: XCC-1 Holds the number.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTDEC:PROC
SAVE XCC
IDIVI XCC-1,^D10
SKIPE XCC-1
OUTDEC
ADDI XCC,60
OUTCH
RETURN
EPROC
SUBTTL OUTOCT
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output a number in octal radix.
ENTRY CONDITIONS: XCC-1 Holds the number.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTOCT:PROC
SAVE XCC
IDIVI XCC-1,8
SKIPE XCC-1
OUTOCT
ADDI XCC,60
OUTCH
RETURN
EPROC
SUBTTL OUTTEXT
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output a ASCIZ string. The corresponding macro call
will generate the byte pointer.
ENTRY CONDITIONS: The argument is a byte pointer to the string.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTTEXT:PROC BP
WHILE
ILDB XCC,BP
JUMPE XCC,FALSE
DO
OUTCH
OD
RETURN
EPROC
SUBTTL OUTLINE
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output carriage-return line-feed.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTLINE:PROC
LI XCC,QCR
OUTCH
LI XCC,QLF
OUTCH
RETURN
EPROC
SUBTTL OUTPAGE
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output form feed and page header.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTPAGE:PROC
LI QMAXLIN
ST LSTLIN
LI XCC,QFF
OUTCH
OUTTEXT PAGEHEADER
AOS XCC-1,LSTPAGE
OUTDEC
OUTLINE
OUTLINE
SETZM LASTPPN
RETURN
EPROC
SUBTTL OUTCH
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Output one character.
ENTRY CONDITIONS: XCC Holds the character.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.OUTCH:PROC
IF
IFOFF SWTTY
GOTO FALSE
THEN ;OUTPUT ON TTY
OUTCHR XCC
ELSE ;OUTPUT ON LIST FILE
SOSGE LSTBH+2
EXEC .OUT
IDPB XCC,LSTBH+1
;IF <LF> THEN DECREMENT LINE-COUNT
;IF LINE-COUNT < 0 THEN OUTPUT NEW PAGE
IF
CAIN XCC,QLF
SOSL LSTLINE
GOTO FALSE
THEN
OUTPAGE
FI
FI
RETURN
EPROC
.OUT: PROC
OUT LSTCH,
SOSGE LSTBH+2
ERROR(ERROR ON OUTPUT LIST FILE)
RETURN
EPROC
SUBTTL PPNMATCH
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Match two PPN versus each other.
ENTRY CONDITIONS: X0 Holds the result when the two PPN:s
are XOR:ed with each other.
XSWITCH Holds information about *:s etc.
EXIT CONDITIONS: Skip return if match, otherwise simple return.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.PPNMATCH:PROC
SAVE X1
LI X1,0
TLNE -1
TRNE XSWITCH,QSWPJ
ADDI X1,1
TRNE -1
TRNE XSWITCH,QSWPG
ADDI X1,1
TRNE XSWITCH,QSWOTHER
TRC X1,2
TRNE X1,2
AOS -1(XPDP)
RETURN
EPROC
SUBTTL SETCRF
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Create a cross reference (2 ZUS-records).
ENTRY CONDITIONS: X1 Unique number of used module.
XMOD Module which requires the other
EXIT CONDITIONS: Both modules get a ZUS-record pointing at each other.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.SETCRF:PROC
SAVE XMOD2
L XMOD2,DIRZMO
WHILE
JUMPE XMOD2,FALSE
CAMN X1,ZMOUNR(XMOD2)
GOTO FALSE
DO
LF XMOD2,ZMONXT(XMOD2)
OD
IF
JUMPN XMOD2,FALSE
THEN
GETZMO
LI XMOD2,(XTOP)
ST X1,ZMOUNR(XMOD2)
L DIRZMO
ST XMOD2,DIRZMO
SF ,ZMONXT(XMOD2)
FI
GET1W
LF ,ZMOUS(XMOD)
SF XTOP,ZMOUS(XMOD)
SF ,ZUSNXT(XTOP)
SF XMOD2,ZUSMOD(XTOP)
GET1W
LF ,ZMOREQ(XMOD2)
SF XTOP,ZMOREQ(XMOD2)
SF ,ZUSNXT(XTOP)
SF XMOD,ZUSMOD(XTOP)
RETURN
EPROC
SUBTTL SIXRX50
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Convert X0 from RADIX50 to SIXBIT
INPUT: X0 = Radix50 symbol
OUTPUT: X0 = SIXBIT symbol
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.SIXRX50:PROC
SAVE <X1,X2>
TLZ (74B4) ;Eliminate code bits
SETZ X2, ;Accumulate SIXBIT in X2
LOOP ;Over all characters
IDIVI X0,50
IF ;Special characters
CAIGE X1,45
GOTO FALSE
THEN
L X1,[EXP '.','$','%']-45(X1)
ELSE ;Null, digit or letter
IF ;Not null
JUMPE X1,FALSE
THEN
LI X1,'A'-13(X1) ;Assume letter
CAIGE X1,'A'
LI X1,'0'-'A'+12(X1) ;Modif for digit
FI FI
LSHC X1,-6 ;One SIXBIT character into X2
AS
JUMPN TRUE
SA
L X2
RETURN
EPROC
SUBTTL SKIPINPUT
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Scan past some words in the REL or ATR file.
ENTRY CONDITIONS: XEXT Holds number of words to be skipped.
EXIT CONDITIONS: Skip return if routine succeded, otherwise (EOF or
read error) simple return.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.SKIPINPUT:PROC
LOOP
GETWORD
RETURN
AS
SOJGE XEXT,TRUE
SA
AOS (XPDP)
RETURN
EPROC
SUBTTL SCAN AND TEST
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Find first non-blank character past current.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.SCANANDTEST:PROC
SAVE X0
LOOP
SCAN
AS
IFON ZCHBLANK(XCC)
GOTO TRUE
SA
RETURN
EPROC
SUBTTL TEST AND SCAN
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION: Find first non-blank character.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.TESTANDSCAN:PROC
SAVE X0
WHILE
IFOFF ZCHBLANK(XCC)
GOTO FALSE
DO
SCAN
OD
RETURN
EPROC
SUBTTL EPILOG
LIT
END SIMDIR