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, > DEFOP() DEFOP() DEFOP() DEFOP() ;[12] RADIX50 to SIXBIT OPDEF SCAN[ILDB XCC,COMBBP] DEFINE GETNW(N)< IRP N, > > 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, XCH=CH XSW=0 IRPC SW, > 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 ,, OR ;SKIP AND 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 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[]... 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, 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 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, 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, COMERR(ILLEGAL SWITCH) FI TRO XSWITCH, 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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 [/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 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, 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[[]] 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 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, 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 : in command buffer EXIT CONDITIONS: XDEV Contains . 0 if not given. X0 Contains . 0 if not given. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .GETFILE:PROC LI XDEV,0 GETNAME RETURN ;NOTHING CAIE XCC,":" RETURN ; CAME [SIXBIT/DSK/] L XDEV, ;ONLY IF NOT DSK SCANANDTEST GETNAME RETURN ;: RETURN ;: 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 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 :[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 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 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