Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/11/i1.mac
There are 2 other files named i1.mac in the archive. Click here to see a list.
;<TENDERIN>I1.MAC.3, 16-Jan-77 21:57:50, Edit by ENDERIN
;<ENDERIN>I1.MAC.31, 5-Jan-77 14:04:29, Edit by ENDERIN
SEARCH SIMMAC,SIMMC1
SALL
CTITLE I1
SUBTTL WRITTEN BY OLOF BJ@RNER JUN 73
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
AUTHOR: OLOF BJ@RNER
UPDATED AT ACADIA UNIVERSITY FOR KA10
VERSION: 4 [3,13,21,75,144,162,202,225,243,256,260]
PURPOSES: TO INITIALIZE THE LOW SEGMENT FOR PASS 1
AND TO PROCESS THE COMMAND STRING
CONTENTS: MAIN ROUTINE I1 ENTERED VIA COMPILE COMMAND
OR EQUIVALENT OR VIA R SIMULA
THE FOLLOWING SUBROUTINES:
- I1CHAR FETCH A CHARACTER FROM A BUFFER
- I1CM READ NEXT COMMAND STRING
- I1DIR [144] Parse path specification
- I1FN SCAN A FILE NAME
- I1MOVE MOVE NEXT COMMAND FROM COMMAND BUFFER
TO COMMAND LINE BUFFER
- I1NAME PACK NEXT SYMBOL IN X0
- I1PPN SCANS AN OCTAL NUMBER
- I1SC SUBROUTINE FOR INITIALIZATION OF NEXT
SOURCE FILE. CALLED FROM LC.
- I1SRBP JOINT SUBROUTINE FOR SWITCHES
THAT MUST APPEAR BEFORE PROGRAM START
- I1SW PROCESS COMPILER SWITCH
- I1SWER PROCESS ERROR MESSAGES GENERATED DURING
SWITCH PROCESSING
- I1SWIT PROCESS SWITCH EXPRESSION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
LOC <.JBVER==137>
EXP VERCOM
TWOSEG
RELOC 400K
MACINIT
EDIT(260)
PORTAL I1CONT ;Entry from Pass 3
I1START:PORTAL I1RUN+1 ;Normal entry after first start
SUBTTL INTERNALS AND EXTERNALS
; INTERNAL
; ========
EDIT(225)
INTERN I1NAME,I1MOVE,I1TTYC ;[225]
INTERN I1OPAB,I1SWIT,I1SW,SIMULA,I1REST,I1SC,I1AB
INTERN I1RX50
INTERN I1SRTA
INTERN I1SRTC
INTERN I1SRTD
INTERN I1SRTE
INTERN I1SRTH
INTERN I1SRTI
INTERN I1SRTL
INTERN I1SRTN
INTERN I1SRTP
INTERN I1SRTQ
INTERN I1SRTR
EDIT(13)
INTERN I1SRCH,I1SRTS ;[13]
INTERN I1SRTW
INTERN I1SRTY
; EXTERNALS
; =========
EXTERN DM ;ERROR ROUTINE
EXTERN IZHT
EXTERN IZSE1
EXTERN IZSE2
EXTERN IZSE3
EXTERN LCLS1 ;SUBROUTINE FOR INSERTION OF CONTROL RECORDS IN LS1
EXTERN LSIPAG ;RECOVERY ROUTINE IN LS
EXTERN O1IC1 ;SUBROUTINE FOR OUTPUT TO IC1
EXTERN O1ICOP ;SUBROUTINE FOR OPEN OF IC1
EXTERN O1LSOP ;SUBROUTINE FOR OPEN OF LS1
EDIT(13)
EXTERN O1EXRQ ;[13] Puts info on ZRQ list
EDIT(144)
EXTERN O1SFDC ;[144] Copies SFD blocks and changes SFD ptr
EXTERN O1XROP ;SUBROUTINE TO OPEN XRF
EXTERN SP ;ENTRY POINT IN SP-MODULE
EXTERN SPDCIN ;[144] Initializes DC1 area
EXTERN T1AB ;ABORT ENTRY IN T1
EXTERN YATRFIL ;[13] Radix50 ATR (REL) file name to be used by pass 3
EXTERN YC1DC ;[144] Pointer to dynamic free area
EXTERN YCBBH ;BUFFER HEADER FOR COMMAND FILE
EXTERN YCBUF ;COMMAND BUFFER
EXTERN YI1CB ;COMMAND LINE BUFFER
EXTERN YI1CBE ;FIRST WORD AFTER COMMAND LINE BUFFER
EXTERN YDLV ;BLOCK LEVEL OF COMPILED PROGRAM
EXTERN YECHDM
EXTERN YELIN1 ;ARGUMENT TO ERR AND ERRT
EXTERN YELIN2 ; " " "
EXTERN YEXENT ;ENTRY OF EXTERNAL PROCEDURE IN RADIX50
EXTERN YEXTS ;EXTENSIONS FOR LST AND REL FILE
EXTERN YJOB ;GLOBAL VARIABLE CONTAINING THE JOB NUMBER IN SIXBIT
EXTERN Y1LOWE ;END OF PASS 1 LOW SEGMENT
EXTERN YLCLB ;SOURCE LINE BUFFER
EXTERN YLCLBS ;SAVE FOR X1LBP
EXTERN YLCLBE ;LAST WORD IN LINE BUFFER INITIALIZED TO
;CARRIAGE RETURNS BY I1
EXTERN YI1CRC ;CONTROL RECORD TO LS1 CREATED DURING COMMAND SCAN
EXTERN YI1P ;SAVE AREA FOR POINTER TO COMMAND STRING
EXTERN YI1P1 ;SAVE FOR POINTER AND DELIMITER TO SWITCH LIST AFTER SOURCE
EXTERN YI1PS
EXTERN YI1SNN ;NUMBER PRECEDING SWITCH
EXTERN YI1SWN ;SWITCH NAME, USED AS ARGUMENT TO ERRT UUO
EXTERN Y11BUF,Y15BUF,Y1BUF,Y17BUF,YBRBUF,YBRSRC,O1SETB
EXTERN YI1SWP ;POINTER TO YI1SWN
EXTERN YI1SWT ;TABLE OF SWITCH NAMES
EXTERN YI1SWA ;ACCESS TABLE TO YI1SWT
EXTERN YI1ERT ;TABLE WITH ERROR MESSAGES
EXTERN YI1ERA ;ACCESS TABLE TO YI1ERT
EXTERN YI1SRT ;JUMP TABLE TO SWITCH ROUTINES
EXTERN YI1SWL ;LENGTH OF YI1SWT
EXTERN YI1E1 ;ERROR NUMBERS
EXTERN YI1E2
EXTERN YI1E3
EXTERN YI1E4
EXTERN YI1E5
EXTERN YI1E6
EXTERN YI1E7
EXTERN YI1E8
EXTERN YI1E9
EXTERN YI1E10
EXTERN YI1E11
EXTERN YI1E12
EXTERN YI1E13
EXTERN YI1E14
EXTERN YI1E15
EXTERN YI1E16
EXTERN YI1E17
EXTERN YI1E18
EXTERN YI1E19
EXTERN YI1E20
EXTERN YBHSRC ;BUFFER RING HEADER FOR COMMAND OUTPUT (PROMPTER)
;AND ALSO FOR SOURCE CODE
EDIT(13)
EXTERN YRQHEAD ;[13] Header for ZRQ list
EXTERN YRQFIL,YRQDEV,YRQPPN ;[13]
IFN QDEBUG,<
EXTERN YBHDEB ;BUFFER RING HEADER FOR DEBUG FILE>
EXTERN YBHDF1
EXTERN YBHZSE
EXTERN YBHLS1 ;BUFFER HEADER FOR LS1 FILE
EXTERN YBHREL ;BUFFER HEADER FOR REL FILE
EXTERN YELSRC ;LOOKUP BLOCK FOR THE SOURCE FILE
EXTERN YBHXRF ;OPEN BLOCK FOR CROSS REF FILE
EDIT(225)
TOPS10,<;[225]
EDIT(144)
EXTERN YP1DEV,YP1PPN ;[144] defines area where Pass1 was started from
>
EXTERN YSTK ;SYSTEM PUSH DOWN STACK
EXTERN YSWCCL ;BLOCK LEVEL OF EXTERNAL CLASS
EXTERN YSWDEF ;VALUE OF DEFAULT SWITCHES
EXTERN YSWCHA ;CHANGED SWITCHES
EXTERN YSWITCH ;GLOBAL WORD CONTAINING SWITCHES
EXTERN YSWRF ;OPEN/LOOKUP BLOCKS FROM RUNSWITCHES
;[030000]
EXTERN ZHT
EXTERN YI1FN ;FILE SPEC RECORD
EXTERN ZLEREC
EXTERN ZSE1
EXTERN ZSE2
EXTERN ZSE3
EXTERN .JBAPR
EXTERN .JB41
EXTERN .JBREN
EXTERN .JBSA
EXTERN YZEROB,YZEROE
EXTERN YPASSNO ;[225]
IFN QDEC20,<EXTERN YFILSP>;[225]
IFE QDEC20,<;[225]
EXTERN YSFD,YSFD1,YSFDN,YSFDP,YSFDPPN,QSFDN ;[144]
>
IFN QDEBUG,<
EXTERN YP1IN>
LS1INIT
IF1,<;[225]
QDIRTR==0 ; Non-zero if STR:<DIRECTORY> should be translated
IFDEF RCDIR,<IFN QDEC20,<QDIRTR==1>>
>
SUBTTL COMMAND PROCESSING DESCRIPTION
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
COMMAND PROCESSING
==================
A command has the following format:
relfile,listfile=source1,source2,...
Each file specification has the format:
dev:filename.extension[directory]/switch/switch...
or
dev:<dir>filename.type/switch/switch ... (DEC-20)
In addition the COMPIL CUSP may generate commands
in the format: device:cuspname!
This will be taken care of by the T3 routine in pass 3.
The COMPIL CUSP may also transmit switches in the form:
(SSSS,SSSS,SSSS) where each S is the first letter of a
switch name possibly preceded by a minus sign.
Default for dev is DSK. Only DSK-devices are accepted.
Examples: DSK, DSKD, SYS, NEW. The only exception to this
is when /LIST is present in a COMPILE command.
COMPIL then generates a listfile specification in the format:
LPT:sourcename.
The switch handling is described in the I1SW subroutine.
Commands are read from TTY if the compiler is executed
in run mode, i.e. is invoked with a monitor R command or equivalent.
Commands are read from core or disk if the compiler is executed in
compil mode, i.e. is started at the CCL entry point via the COMPIL CUSP
or some other program. TTY commands are read into
the command line buffer, YI1CB, with INCHWL. Altmode is substituted
by carriage return and line feed is ignored on input and later
stored in the buffer.
The COMPIL CUSP delivers the command line(s) in a command file.
This file is either a core file called SIM or a disk file called
nnnSIM.TMP where nnn is the job number. I1 tries the TMPCOR UUO
and if this fails the LOOKUP UUO. An error message is generated if the
LOOKUP fails. A command file is always read into the command buffer,
YCBUF. Each line is supposed to be separated by carriage return
followed by line feed. The first null character in the file
following a line feed terminates the reading of the file.
The following subroutines are used to read commands:
I1CM reads the first command line from TTY into the
command line buffer in run mode (all other command lines
from TTY are read by pass 3 before swapping in pass 1 to
save swapping overhead if control-C is input)
In compil mode I1CM reads the command file from core to
command buffer, YCBUF, or if commands on disk, sets up
a buffer and lookups the command file.
I1MOVE moves next command line from command buffer to the command
line buffer and reads next command buffer if necessary.
A separate command line buffer must be used due to the look-
ahead in the line control program (for further information
see the LC module).
I1CM is thus only called the first time pass 1 is executed,
or if errors were detected in a command from TTY.
I1MOVE is called each time pass 1 is executed if in compil mode.
The pointer to the command buffer is kept in the buffer header YCBBH+1.
The pointer to the command line buffer is kept in register XI1P in
I1 and in YI1P when not in I1.
The following subroutines are used to process a command:
I1CHAR gets next byte from command line buffer
I1FN scans a file specification
I1NAME packs next name in sixbit from command line buffer
I1PPN scans a ppn
I1SC creates LOOKUP and OPEN blocks to be used by LC. This
subroutine is called from LC whenever a source file need be read.
I1SW scans and processes the various switches
The following switches are used:
YI1CCL := if compil mode then TRUE else FALSE
YSWCM := (YI1CCL and end of command file) or
(first compilation not started)
YSWLPT := if /LIST was used in a COMPIL command then TRUE else FALSE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SUBTTL LOCAL DECLARATIONS
; LOCAL MACROS
; ============
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
RFAIL IS USED IN ASSERT MACROS IN THE DEBUG VERSION
MOPEN PERFORMS OPEN UUO FOR THE SOURCE FILES AND FOR THE TEMPORARY FILES
SHUFFLE IS USED TO MOVE SYMBOL TABLES FROM HIGH SEGMENT (D1 MODULE)
TO LOW SEGMENT.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DEFINE RFAIL (A)=<
PUSHJ XPDP,[OUTSTR [ASCIZ/A/]
Z]
>
DEFINE MOPEN(A,B<14>)<
OPEN QCH'A,[EXP B
SIXBIT/DSK/
XWD YBH'A,YBH'A]
GOTO I1OPAB
>
DEFINE SHUFFLE (P1,P2)=<
HRLI I'P1
HRRI P1
BLT P1+P2-1
> ;END OF SHUFFLE
; END OF LOCAL MACRO DEFINITIONS
; ------------------------------
; REGISTER ASSIGNMENTS
; ====================
; THE FOLLOWING REGISTERS ARE USED IN (AND SAVED BY) I1SW
XI1LEN==X10 ;LENGTH OF LONG SWITCH FORM
XI1P==X11 ;BYTE POINTER TO YI1SWT AND X0
XI1IND==X12 ;INDEX TO YI1SWT
; LOCAL ASSEMBLY-TIME CONSTANTS
; =============================
QI1SIM==SIXBIT/ SIM/
QI1TMP==SIXBIT/ TMP/
QI1REL==SIXBIT/ REL/
QI1DSK==SIXBIT/ DSK/
QI1LST==SIXBIT/ LST/
QI1RT5=="L"B24
QI1RT7=="-L"B31
QI1RT8=="-N"B31
QI1RT6=="P"B24
QI1RT9=="S"B24
QI1QUO==042 ;QUOTE
.JBHRN==400003
; LOCAL SWITCHES AND FIELDS
; =========================
DSW (YI1PSW,YI1PS,35) ;THIS SWITCH IS ON IF A ( PRECEDES A SWITCH
DSW (YI1HSW,YI1PS,34) ;THIS SWITCH IS ON WHEN A HELP
;SWITCH HAS BEEN DETECTED
DSW (YI1RSW,YI1PS,33) ;ON IF I1FN CALLED FROM I1SRTR
DSW (YI1TTY,0,0,X1)
DSW (YI1P3,0,1,X1)
DSW (YI1AST,0,2,X1)
DF (YI1ENO,X1,15,17)
DF (YI1STR,X1,9,26)
DF (YI1EMP,X1,9,35)
OPDEF GETCHAR [PUSHJ XPDP,I1GC]
OPDEF PUTCHAR [PUSHJ XPDP,I1PC]
OPDEF READCOM [PUSHJ XPDP,I1RCOM]
SUBTTL I1 CONSTANTS AND TABLES
; ERROR MESSAGES DURING COMMAND SCAN:
YI1ER7: ASCIZ/
?= OR _ MISSING IN COMMAND/
YI1ER8: ASCIZ/
?RIGHT PARENTHESIS MISSING AFTER SWITCH(ES)/
YI1ER9: ASCIZ/
?LOOKUP ERROR ON COMMAND FILE/
YI1ERB: ASCIZ/
?CAN'T OPEN DISK/
YI1ERC: ASCIZ/WARNING: NO SWITCH NAME
/
YI1ERD: ASCIZ/
?SWITCH WITHOUT FILE SPEC. SWITCH IGNORED/
YI1ERE: ASCIZ/
?READ ERROR ON COMMAND FILE/
YI1ERF: ASCIZ/
?COMMAND LINE EXCEEDS 135 CHARACTERS/
EDIT(144)
YI1ERG: ASCIZ/?BAD DIRECTORY SPECIFICATION IN COMMAND
/ ;[144]
YI1ERJ: ASCIZ/?ILLEGAL DELIMITER "/
YI1ERK: ASCIZ/" IN COMMAND
/
YI1TMP: XWD 'SIM',0 ;TMPCOR PARAMETER BLOCK
IOWD 200,YCBUF+3 ;[5] READ ^O200 INSTEAD OF ^O33 WORDS FROM TMPCOR
EDIT(5)
SUBTTL I1CHAR GET NEXT BYTE
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO FETCH NEXT BYTE FROM A BUFFER AND
RETURN IMMEDIATELY IF IT IS NOT A DIGIT OR A LETTER
LOWER CASE LETTERS ARE CONVERTED TO UPPER CASE.
HORIZONTAL TAB IS CONVERTED TO SPACE.
ENTRY: I1CHAR
INPUT ARGUMENT: BYTE POINTER IN XI1P
OUTPUT ARGUMENT: BYTE IN X1BYTE
SKIP RETURN IF X1BYTE CONTAINS A LETTER OR A DIGIT
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC I1CHAR
USED ROUTINES: -
USED REGISTER: X1BYTE
ERROR MESSAGE: -
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1CHAR: PROC
ILDB X1BYTE,XI1P ;GET BYTE
EDIT(225)
TOPS10,<CAIE X1BYTE,"%">;[225] ACCEPT % ONLY ON DEC-10
CAIN X1BYTE,"$"
GOTO L9 ;ACCEPT DOLLAR
CAIN X1BYTE,QHT ;Convert tab to space
LI X1BYTE," "
CAIGE X1BYTE,"0"
RETURN ;NOT DIGIT OR LETTER!
CAIG X1BYTE,"9"
GOTO L9 ;IF DIGIT
CAIGE X1BYTE,"A"
RETURN
CAIG X1BYTE,"Z"
GOTO L9 ;IF UPPER CASE LETTER
CAIL X1BYTE,"a"
CAILE X1BYTE,"z"
RETURN
SUBI X1BYTE,40 ;CONVERT TO UPPER CASE IF LOWER CASE
L9():!
AOS (XPDP) ;SKIP RETURN IF LETTER OR DIGIT
RETURN
EPROC
SUBTTL I1CM
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: I1CM IS CALLED ONLY ONCE FOR EACH INITIALIZATION
OF THE COMPILER, THE FIRST TIME PASS 1 IS
EXECUTED. THE EFFECT IS AS FOLLOWS:
RUN MODE: FIRST COMMAND LINE IS READ FROM TTY
TO COMMAND LINE BUFFER. (THIS IS PERFORMED
BY PASS 3 IN SUBSEQUENT COMPILATIONS, TO AVOID
SWAPPING OVERHEAD IN CASE OF TERMINATION).
COMPIL MODE: THE TMPCOR UUO IS TRIED FIRST,
AND THE CORE FILE (IF ANY) IS READ TO THE
COMMAND BUFFER (YCBUF). IF TMPCOR FAILS
THE CHANNEL QCHCOM IS OPENED AND THE FILE
nnnSIM.TMP IS LOOKUPED (nnn IS THE CURRENT JOB
NUMBER). AN ERROR MESSAGE IS PRINTED IF LOOKUP
FAILS. A COMMAND LINE IS MOVED TO THE
COMMAND LINE BUFFER BY THE I1MOVE SUBROUTINE.
ENTRY: I1CM
INPUT ARGUMENT: SWITCH YI1CCL, IF ON THEN COMMANDS ARE FROM COMPIL CUSP
OUTPUT ARGUMENT: -
NORMAL EXIT: RETURN
ERROR EXITS: GOTO I1OPAB ON OPEN FAILURE
GOTO T1AB ON LOOKUP FAILURE.
CALL FORMAT: EXEC I1CM
USED ROUTINES: PUTCHAR,I1MOVE
USED REGISTERS: X0 - X4
ERROR MESSAGE: ?LOOKUP ERROR ON COMMAND FILE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1CM: PROC
IF IFOFF YI1CCL
GOTO FALSE
THEN ;COMMANDS FROM COMPIL CUSP OR EQUIVALENT
L [XWD 2,YI1TMP] ;ARGUMENT TO TMPCOR
IF TMPCOR ;TRY TO GET COMMAND FROM CORE
GOTO FALSE ;DIDN'T WORK, TRY DISK
THEN LI X1,5*200 ;SET MAX BYTE COUNTER
L X0,[POINT 7,YCBUF+3];AND BYTE POINTER
STD X0,YCBBH+1 ;IN BUFFER HEADER
EDIT(225)
BRANCH L2 ;[225]
FI
;THERE WAS NO TMPCOR FILE
;OPEN CHANNEL QCHCOM FOR COMMAND FILE
OPEN QCHCOM,[EXP 1
SIXBIT/DSK/
XWD YCBBH,YCBBH]
BRANCH I1OPAB ;OPEN FAILED!
;LINK YI1CB TO ITSELF
L X0,[400K,,YCBUF+1] ;USE BIT AND BUFFER POINTER
L X1,[POINT 7,YCBUF+2] ;BUFFER BYTE POINTER
STD X0,YCBBH
L X0,[XWD 201,YCBUF+1] ;BUFFER SIZE AND LINK
ST X0,YCBUF+1
;SET UP LOOKUP BLOCK IN X1-X4
HLL X1,YJOB ;JOB NUMBER IN SIXBIT
HRRI X1,'SIM' ;FOLLOWED BY SIM
MOVSI X2,'TMP' ;AND EXTENSION TMP
SETZB X3,X4 ;FROM USER'S DEFAULT PATH
;LOOKUP COMMAND FILE
IF LOOKUP QCHCOM,X1
GOTO FALSE ;FAILURE!
THEN SETON YSWCOM ;FLAG COMMAND FILE IN THIS COMPILATION
L2():! EXEC I1MOVE ;MOVE FIRST LINE
EDIT(225)
NOP ;[225]
RETURN
FI
OUTSTR YI1ER9 ;PRINT ERROR MESSAGE
SETOFF YI1CCL ;SWITCH TO RUN MODE
GOTO I1AB ;ABORT
FI
;COMMAND FROM TTY!
L1():! EXEC I1TTYC
GOTO L1
RETURN
EPROC ;I1CM
SUBTTL I1TTYC [225] Read command line from TTY
EDIT(225)
I1TTYC: PROC ;[225] READ COMMAND LINE FROM TTY
;SKIP RETURN ON SUCCESS
CLEARO ;CLEAR CONTROL-O
EDIT(220)
IFON YSWCZ ;[220]
EXIT ;[220]
OUTSTR [ASCIZ/
*/]
L X1,[POINT 7,YI1CB]
LOOP ;UNTIL CR, ^Z OR ALTMODE
INCHWL X0
CAIN X0,033 ;IF ALTMODE
LI X0,QCR ;THEN SUBSTITUTE CR
IF ;[220] ^Z
CAIE X0,"Z"-"A"+1
GOTO FALSE
THEN ;SET ^Z FLAG, RETURN <CR>
SETON YSWCZ
LI X0,QCR
FI
IF ;NOT LINE FEED
CAIN X0,QLF ;IGNORE LINE FEED
GOTO FALSE
THEN ;STORE BYTE IN COMMAND LINE BUFFER
PUTCHAR
GOTO L9 ;IF OVERFLOW
FI
AS CAIE X0,QCR
GOTO TRUE
SA
LI X0,QLF
PUTCHAR
GOTO L9 ;IF OVERFLOW
L8():! AOS(XPDP)
L9():! RETURN
EPROC
SUBTTL I1DIR Parse directory specification (DEC10)
EDIT(144)
Comment; [144] SFD handling added.
The directory part of a file specification can have the forms:
[proj,prog] - where proj and/or prog may be empty or octal numbers.
Missing numbers are taken from the the UFD (logged in ppn).
[-] Equivalent to no directory spec - Default directory path.
[proj,prog,sfd1,sfd2,...,sfdn] - SFD path.
If proj and/or prog is empty, use UFD.
Input: X1BYTE = "[".
Return: No skip on error, skip on success
;
I1DIR: PROC
SKIPE YI1FN+4 ;Error if ppn already defined
GOTO L9
EXEC I1PPN
IF ;Minus
CAIE X1BYTE,"-"
GOTO FALSE
THEN ;Default path
SETZM YI1FN+4
EXEC I1CHAR
NOP
GOTO L7
FI
IF ;Not comma
CAIN X1BYTE,","
GOTO FALSE
THEN ;Error
EXEC I1SWER,<YI1E18>
IFOFF YI1RSW
BRANCH I1AB ;Abort if not /R or /S
GOTO L9 ;Error return
FI
HRLM YI1FN+4 ;Project no
EXEC I1PPN
HRRM YI1FN+4
EXCH X1,YI1FN+4
IF ;Zero proj or prog
JUMPE TRUE ;Zero prog
TLNE X1,-1
GOTO FALSE ;Non-zero proj also
THEN ;Use GETPPN to define missing field(s)
SETZ
GETPPN
NOP
TLNN X1,-1
HLLM X1
TRNN X1,-1
HRRM X1
FI
EXCH X1,YI1FN+4
EDIT(225)
TOPS10,<;[225]
;SFD's may follow here
IF ;Delimiter is comma
CAIE X1BYTE,","
GOTO FALSE
THEN ;Start of SFD list expected
SETZM YSFDN
LI X1,YSFD1
MOVNI QSFDN
HRLM X1
LOOP
EXEC I1NAME
ST (X1)
AOS YSFDN
AOBJP X1,FALSE
AS
CAIN X1BYTE,","
GOTO TRUE
SA
SETZM (X1)
LI YSFD
EXCH YI1FN+4
ST YSFDPPN
JUMPGE X1,L9 ;Too many SFD's
STACK X2
SKIPN YC1DC
EXEC SPDCIN ;Initialize dynamic area if necessary
LI X1,YI1FN+4
SETZ X2,
EXEC O1SFDC ;Make a dynamic copy to be saved
UNSTK X2
FI
>
L7():! IF ;Current char is "]"
CAIE X1BYTE,"]"
GOTO FALSE
THEN ;Ok, get next character
EXEC I1CHAR
NOP
FI ;Accept it in any case
AOS (XPDP)
L9():! RETURN
EPROC
SUBTTL I1FN
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO SCAN A FILE NAME OF THE FORM:
DEV:NAME.EXT[PPP,NNN,SFD1,SFD2,...]
OR str:<DIRECTORY-NAME>FILE.EXT.
DEV (or str)CAN ONLY BE DSK OR A LOGICAL DEVICE
NAME ASSIGNED TO a disk structure. LPT IS ACCEPTED IN
COMPIL MODE. THIS DEVICE IS USED WHEN
THE COMPIL SWITCH /LIST IS PRESENT IN THE
COMPIL COMMAND.
LAST DELIMITER CAN ONLY BE / , = RIGHT
PARENTHESIS OR CARRIAGE RETURN. IF LAST
DELIMITER IS SPACE SPACES ARE SCANNED
AND IGNORED. IF THE FOUND DELIMITER AFTER
SPACE(S) IS DOT OR LEFT
BRACKET, EXTENSION AND PPN RESPECTIVELY
ARE PROCESSED. IF LAST DELIMITER IS SOMETHING
ELSE THAN SLASH, LEFT PARENTHESIS OR
CARRIAGE RETURN, AN ERROR MESSAGE
IS PRINTED AND THE COMMAND ABORTED.
ENTRY: I1FN
INPUT ARGUMENT: POINTER TO YI1CB IN XI1P
OUTPUT ARGUMENTS: DEVICE IN YI1FN
FILENAME IN YI1FN+1
EXTENSION IN YI1FN+2
PPN IN YI1FN+4
LAST DELIMITER IN X1BYTE
NORMAL EXIT: RETURN OR SKIP RETURN IF CALL FROM I1SRTR
ERROR EXIT: JUMP TO I1AB OR IMMEDIATE RETURN IF CALL FROM I1SRTR
CALL FORMAT: EXEC I1FN
USED SUBROUTINES: I1NAME,I1PPN,I1CHAR
USED REGISTERS: X0, X1, X1BYTE
ERROR MESSAGES: ?INVALID DEVICE. ONLY DSK ALLOWED
?COMMA MISSING IN PPN
?BAD DIRECTORY SPECIFICATION
?ILLEGAL DELIMITER "<DELIMITER>" IN COMMAND
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDIT(144)
DF DV.DSK,0,1,1 ;[144] Set in DEVCHR for DSK
DF DV.LPT,0,1,3 ;[144] Set in DEVCHR for LPT
EDIT(225)
OPDEF BADDIR [JSP I1ERG] ;[225]
I1FN: PROC
;RESET FILE SPEC RECORD
SETZM YI1FN
SETZB X0,X1
STD X0,YI1FN+1
STD X0,YI1FN+3
EXEC I1NAME
IF ;DELIMITER IS COLON
CAIE X1BYTE,":"
GOTO FALSE
THEN ;DEVICE NAME WAS GIVEN
ST X0,YI1FN ;[144] Save the device
L X1,X0 ;[144]
DEVCHR X1, ;[144]
IF ;Not DSK device
IFONA DV.DSK(X1) ;[144]
GOTO FALSE
THEN ;DEVICE WAS NOT DSK!!
IF ;DEVICE IS LPT FROM COMPIL-COMMAND
IFON YI1RSW
GOTO FALSE ;IF DEVICE IN /R OR /S
IFOFF YI1CCL
GOTO FALSE
IFOFFA DV.LPT(X1) ;[144]
GOTO FALSE
THEN ;ACCEPT IT!
SETON YSWLPT ;FLAG /LIST
ELSE ;Error
EXEC I1SWER,<YI1E17> ;PRINT ERROR
IFOFF YI1RSW ;[144]
GOTO I1AB ;AND ABORT
RETURN ;[144] Except in
; /R or /S argument
FI
FI
EXEC I1NAME
FI
IFN QDIRTR,<;[225] Hack to allow "str:<directory>file.ext"
IF ;Delimiter is now lbroket
CAIE X1BYTE,74
GOTO FALSE
THEN ;TOPS-20 directory name should follow
STACK X2
STACK X3
L X1,[POINT 7,YFILSP]
L YI1FN ;Structure name or device name
IF ;One was given
JUMPE FALSE
THEN ;Plug it into string
EXCH X1,X3
ST X1
EXEC O16TO7##
LI ":"
IDPB X3
EXCH X1,X3
FI
IDPB X1BYTE,X1 ;Place the left broket
LOOP ;Through letters, digits, "-_$"
EXEC I1CHAR
GOTO [CAIE X1BYTE,"-"
CAIN X1BYTE,"_"
GOTO .+1
GOTO FALSE
]
IDPB X1BYTE,X1
AS GOTO TRUE
SA
CAIE X1BYTE,76
BADDIR ;[225]
SETZ ;Replace closing broket with null
DPB X1 ;to make ASCIZ string
SETZ X1, ;Try recognition on name
HRROI X2,YFILSP
RCDIR ;Translate to directory no
TLNE X1,(RC%NOM)
BRANCH [
HRROI X1,[ASCIZ/
?Cannot locate directory
/]
PSOUT
BRANCH I1AB]
L X1,X3 ;Directory number
STPPN% ;Beware!!!! This JSYS may be outlawed!
ERJMP I1ERG
ST X2,YI1FN+4 ;Save PPN
UNSTK X3
UNSTK X2
EXEC I1NAME
FI
>
ST YI1FN+1 ;SAVE FILE NAME
IF ;DELIMITER IS DOT
CAIE X1BYTE,"."
GOTO FALSE
L3():! THEN ;EXTENSION WAS GIVEN
SKIPE X0,YI1FN+2
GOTO L9 ;IF EXTENSION ALREADY DEFINED!
EXEC I1NAME
EDIT(256)
SKIPN
LI 77777 ;Mark as explicit null extension
ST YI1FN+2 ;SAVE EXTENSION
FI
IF ;DELIMITER IS BRACKET
CAIE X1BYTE,"["
GOTO FALSE
L4():! THEN ;PPN
EDIT(144)
EXEC I1DIR ;[144]
EDIT(225)
BADDIR ;[225,144]
FI
;VALID DELIMITER HERE SHOULD BE EITHER OF SLASH, LEFT PARENTHESIS,
;SPACE OR CR
IF ;/R
IFOFF YI1RSW
GOTO FALSE
THEN ;SKIP RETURN HERE
;LET I1SRTR TAKE CARE OF LAST DELIMITER
AOS (XPDP)
RETURN
FI
WHILE ;SPACE
CAIE X1BYTE," "
GOTO FALSE
DO ;SCAN
EXEC I1CHAR
NOP
OD
CAIN X1BYTE,"."
GOTO L3 ;CONTINUE IF DOT
CAIN X1BYTE,"["
GOTO L4 ;OR LEFT SQUARE BRACKET
EDIT(246)
CAIN X1BYTE,"!" ;[246] RUN file spec?
RETURN ;[246] Do not supply default
IF CAIE X1BYTE,"="
CAIN X1BYTE,","
GOTO FALSE
EDIT(246)
;[246] CAIE X1BYTE,"_"
CAIN X1BYTE,"/"
GOTO FALSE
CAIE X1BYTE,"("
CAIN X1BYTE,QCR
GOTO FALSE
L9():! THEN ;ILL DELIMITER
OUTSTR YI1ERJ
OUTCHR X1BYTE
OUTSTR YI1ERK
BRANCH I1AB ;AND ABORT
FI
SKIPE X0,YI1FN
RETURN
MOVSI X0,'DSK'
ST X0,YI1FN ;DEFAULT DEVICE IS DSK
RETURN
EPROC
EDIT(225)
I1ERG: ;[225] "BAD DIRECTORY"
IFN QDEC20,<
HRROI X1,YI1ERG
PSOUT>
IFE QDEC20,<OUTSTR YI1ERG>
BRANCH T1AB
SUBTTL I1MOVE
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO MOVE NEXT COMMAND LINE FROM COMMAND BUFFER (YCBUF)
TO COMMAND LINE BUFFER (YI1CB). THIS SUBROUTINE IS
CALLED IN COMPIL MODE ONLY.
INPUT ARGUMENTS: BYTE POINTER AND BYTE COUNTER SET IN
COMMAND BUFFER HEADER, YCBBH.
OUTPUT ARGUMENTS: NEXT COMMAND LINE IN YI1CB.
YSWCM TRUE IF MORE COMMAND LINES IN BUFFER.
NORMAL EXIT: RETURN
ERROR EXIT: GOTO I1AB IF READ ERROR OR TOO LONG COMMAND LINE OR
EXIT TO MONITOR IF END OF COMMAND FILE
CALL FORMAT: EXEC I1MOVE
USED REGISTERS: X0 BYTE TO BE MOVED
X1 BYTE POINTER TO YI1CB
X2 SCRATCH
USED ROUTINES: GETCHAR, PUTCHAR AND READCOM.
THESE THREE SUBROUTINES ARE DEFINED LOCALLY
WITHIN I1MOVE. PUTCHAR IS ALSO USED BY I1CM.
ERROR MESSAGES ?READ ERROR ON COMMAND FILE
?COMMAND LINE EXCEEDS 135 CHARACTERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EDIT(225)
I1MOVE::LOOP ;[225]
GETCHAR
AS
CAIE X0,QCR
CAIN X0,QLF
GOTO TRUE ;IGNORE LEADING CR AND LF IF ANY
SA
IF ;NULL HERE
JUMPN X0,FALSE
THEN ;END OF COMMAND FILE
IFOFF YSWCOM
EXIT ;DIRECTLY IF TMPCOR FILE
GOTO I1MOVE
FI
L X1,[POINT 7,YI1CB]
PUTCHAR
GOTO L9 ;[225]
LOOP ;AND MOVE BYTES UNTIL LINE FEED
GETCHAR
JUMPE X0,TRUE ;IGNORE NULLS!
PUTCHAR
GOTO L9 ;[225]
AS CAIE X0,QLF
GOTO TRUE
SA
AOS (XPDP) ;[225]
L9():! RETURN ;[225]
;GETCHAR:
I1GC:
SOSG YCBBH+2 ;DECREASE BYTE COUNTER
READCOM ;READ NEXT BUFFER IF CURRENT IS EMPTY
ILDB X0,YCBBH+1 ;GET NEXT BYTE
RETURN
;PUTCHAR:
I1PC::
HRRZ X2,X1
SUBI X2,YI1CBE
IF ;END OF COMMAND LINE BUFFER
JUMPL X2,FALSE
THEN ;ERROR
OUTSTR YI1ERF ;PRINT ERROR MESSAGE
IFOFF YI1CCL
CLRBFI ;CLEAR BUFFER IF IN RUN MODE
EDIT(225)
L YPASSNO ;[225]
CAIE 1 ;[225]
GOTO L9 ;[225]
SETOFF YI1CCL ;SWITCH TO RUN MODE
GOTO I1AB ;ABORT
FI
IDPB X0,X1 ;STORE BYTE IN COMMAND LINE BUFFER
AOS (XPDP) ;[225] Conforms with Pass3
RETURN
;READCOM:
I1RCOM: PROC
IN QCHCOM,YCBUF+1
RETURN ;IF READ OK
IF ;END OF FILE
STATZ QCHCOM,740000
GOTO FALSE
THEN ;DELETE COMMAND FILE
LI X1,0
RENAME QCHCOM,X1
NOP
EXIT
FI
OUTSTR YI1ERE ;PRINT ERROR MESSAGE
L YPASSNO ;[225]
CAIN 3
EXIT
SETOFF YI1CCL ;SWITCH TO RUN MODE
GOTO I1AB ;ABORT
EPROC
SUBTTL I1NAME
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO PACK NEXT SYMBOLIC NAME IN SIXBIT IN X0.
DELIMITER IS ANY NON-DIGIT AND NON-LETTER BYTE.
NAMES LONGER THAN 6 BYTES ARE TRUNCATED WITHOUT WARNING.
LEADING SPACES ARE IGNORED.
ENTRY: I1NAME
INPUT ARGUMENT: BYTE POINTER IN XI1P
OUTPUT ARGUMENT: DELIMITER IN X1BYTE
NAME IN X0
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC I1NAME
USED ROUTINES: I1CHAR
USED REGISTERS: X0 RETURN ARGUMENT
X1BYTE DELIMITER AFTER NAME
XI1IND POINTER TO X0
ERROR MESSAGE: -
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1NAME::
SETZ
HRLZI XI1IND,(POINT 6) ;POINTER TO X0
WHILE ; LETTER OR DIGIT
EXEC I1CHAR
GOTO FALSE
DO SUBI X1BYTE,40 ;CONVERT TO SIXBIT
TRNN 77 ;SKIP IF 6 BYTES ALREADY
IDPB X1BYTE,XI1IND ;STORE IN X0
OD
CAIN X1BYTE," "
JUMPE X0,I1NAME ;SKIP LEADING SPACES
RETURN
SUBTTL I1PPN
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO SCAN AN OCTAL NUMBER AND CONVERT IT TO BINARY
ENTRY: I1PPN
INPUT ARGUMENT: XI1P, BYTE POINTER TO STRING
OUTPUT ARGUMENT: OCTAL NUMBER IN X0
DELIMITER (FIRST NON-OCTAL BYTE) IN X1BYTE
NORMAL EXIT: RETURN
ERROR EXIT: GOTO I1AB IF MORE THAN 6 DIGITS IN NUMBER
OR REMOVE RETURN ADDRESS TO I1FN FROM STACK
AND RETURN IMMEDIATELY TO I1SRTR.
CALL FORMAT: EXEC I1PPN
USED SUBROUTINE: I1CHAR
USED REGISTERS: X0 RETURN ARGUMENT
X1BYTE DELIMITER
ERROR MESSAGE: ?MORE THAN 6 DIGITS IN PPN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1PPN:
SETZ
WHILE ;OCTAL DIGIT
EXEC I1CHAR
RETURN ;IF NOT DIGIT OR LETTER
CAIL X1BYTE,"8"
RETURN ;IF NOT OCTAL DIGIT
DO ;CONVERT AND STORE IN X0
LSH 3
ADDI -60(X1BYTE)
IF TLNN -1
GOTO FALSE
THEN ;MORE THAN 6 DIGITS!
EXEC I1SWER,<YI1E20> ;PRINT ERROR MESSAGE
IFOFF YI1RSW
GOTO I1AB ;AND ABORT
UNSTK ;REMOVE I1PPN RETURN ADDRESS
RETURN ;AND RETURN IMMEDIATELY TO I1SRTR
FI
OD
SUBTTL I1REN
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO ENTER PASS 3 AFTER ^C .REENTER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
TOPS10,<
EDIT(225)
I1REN:
MOVSI X3,1
SWAPPA(SIMP3,S3,-1,QP3PPN)
>
SUBTTL I1RX50
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO CONVERT FROM SIXBIT TO RADIX50
ENTRY: I1RX50
INPUT ARG: X0, NAME IN SIXBIT
OUTPUT ARG: X0, NAME IN RADIX50
NORMAL EXIT: RETURN
CALL FORMAT: EXEC I1RX50
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1RX50: PROC
SAVE <X1,X2,X3>
LI X3,6
LI X2,0
LOOP
LI X1,0
ROTC 6
IMULI X2,50
IF JUMPE X1,FALSE
THEN SUBI X1,17
CAILE X1,12
SUBI X1,7
FI
ADD X2,X1
AS
SOJG X3,TRUE
SA
L X0,X2
RETURN
EPROC
SUBTTL I1SC
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: I1SC CREATES OPEN AND LOOKUP BLOCKS FOR THE
NEXT INPUT SOURCE FILE.
IF NECESSARY THE LOOKUP BLOCKS FOR THE REL AND
LST FILES ARE UPDATED WITH THE NAME OF THE FIRST
SOURCE FILE AS A DEFAULT ACTION.
THIS SUBROUTINE IS CALLED ONLY FROM THE LC MODULE.
ENTRY: I1SC
INPUT ARGUMENT: BYTE POINTER IN X1BYTE
OUTPUT ARGUMENT: UPDATED LOOKUP BLOCK YELSRC
YI1MS IS TRUE (MORE SOURCES) IF LAST
DELIMITER FOUND IS A COMMA ELSE FALSE.
THE DOUBLE WORD YI1P1 IS UPDATED WITH
BYTE POINTER TO AND DELIMITER PRECEDING
SOURCE SWITCHES.
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC I1SC
USED SUBROUTINE: I1FN
USED REGISTERS: XI1P POINTER TO COMMAND LINE BUFFER
XI1LEN USED BY I1FN
X0 - X1 SCRATCH
X1BYTE DELIMITER
ERROR MESSAGE: -
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SC: PROC
EDIT(202)
XI1IN==XI1IND ;[202] Avoid 6-char names in SAVE
SAVE <XI1P,XI1IN,X1R3> ;[202]
L XI1P,YI1P ;LOAD POINTER TO COMMAND BUFFER
SETZM YI1P1
EXEC I1FN ;FETCH NEXT SOURCE FILE SPEC
LD X0,YI1FN+1
EDIT(256)
IF ;[256] No extension (no dot)
JUMPN X1,FALSE
THEN ;Use .SIM
MOVSI X1,'SIM'
FI
STD X0,YELSRC ;UPDATE LOOKUP BLOCK
LD X0,YI1FN+3
STD X0,YELSRC+2
IF ;SWITCH LIST
CAIN X1BYTE,"("
GOTO TRUE
CAIE X1BYTE,"/"
GOTO FALSE
THEN ;SAVE DELIMITER AND POINTER
ST XI1P,YI1P1
ST X1BYTE,YI1P1+1
;SCAN UNTIL COMMA, CR OR NULL
EDIT(13)
SETZ X1R3, ;[13] Switch for ""
LOOP ILDB X1BYTE,XI1P
AS JUMPE X1BYTE,FALSE
CAIN X1BYTE,QCR
GOTO FALSE
CAIN X1BYTE,QI1QUO ;[13]
TRC X1R3,1 ;[13] flip switch
JUMPN X1R3,TRUE ;[13] Allow , inside ""
CAIE X1BYTE,","
GOTO TRUE
SA
FI
SETOFA YI1MS ;FLAG NO MORE FILES
IF ;DELIMITER IS COMMA
CAIE X1BYTE,","
GOTO FALSE
THEN ;CONCATENATE REQUEST
SETONA YI1MS ;FLAG MORE SOURCE FILES
ELSE ; INSERT LAST FILE NAME AS DEFAULT FOR
; REL AND LST IF NECESSARY
L YELSRC
HRLZI X1,QI1LST
;***AUBEG
;AVOID SKIP BEFORE STD MACRO
SKIPE YEXTS
GOTO .+3
STD X0,YEXTS ;LST WAS DEFAULTED!
HRLZI X1,QI1REL
SKIPE YEXTS+4
GOTO .+3
STD X0,YEXTS+4 ;REL WAS DEFAULTED!
;***AUEND
EXEC I1RX50 ;[13] Save RADIX50 form of file name
ST YATRFIL ;[13] to be used as NAME block info
;[13] in any ATR file produced
FI
IFONA YI1SWF
ST XI1P,YI1P ;SAVE POINTER TO COMMAND BUFFER
RETURN
EPROC
SUBTTL I1SRBP
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO PROCESS THE SWITCHES THAT MUST APPEAR
BEFORE THE START OF THE PROGRAM
ENTRY: I1SRBP
INPUT ARGUMENT: SWITCH YSWECO AND YI1SNN
OUTPUT ARGUMENT: -
NORMAL EXIT: SKIP RETURN
ERROR EXIT: IMMEDIATE RETURN
CALL FORMAT: EXEC I1SRBP
USED SUBROUTINE: I1SWER
ERROR MESSAGE: YI1E6,YI1E9
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SRBP:
IF IFOFFA YSWECO
GOTO FALSE
THEN ;NOT BEFORE PROGRAM START!
EXEC I1SWER,<YI1E9> ;ISSUE ERROR MESSAGE
RETURN ;SWITCH IGNORED, IMMEDIATE RETURN
FI
IF SKIPN YI1SNN
GOTO FALSE
THEN ;SWITCH PRECEDED BY NUMBER!
EXEC I1SWER,<YI1E6> ;ISSUE WARNING MESSAGE
FI
AOS (XPDP) ;SWITCH PROCESSED, SKIP RETURN
RETURN
SUBTTL I1SW
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO CHECK THE SPELLING OF A SWITCH NAME
AND TO EXECUTE THE APPROPRIATE SWITCH ROUTINE.
IF THE SWITCH IS PRECEDED BY A MINUS SIGN
THE SWITCH YI1NEG IS SET TO TRUE. IF THE
SWITCH IS PRECEDED BY A NUMBER, IT IS CON-
VERTED AND STORED IN YI1SNN. THE FIRST
FIVE CHARACTERS ARE ALWAYS STORED IN YI1SWN
WHICH IS USED IN POSSIBLE ERROR OR WARNING
MESSAGES. THE FIRST LETTER OF THE SWITCH IS
LOOKED UP IN THE YI1SWA TABLE. THIS TABLE
CONTAINS THE FIRST LETTER OF THE SWITCH AND
INDEX TO THE START OF THE REST OF THE
SWITCH NAME IN YI1SWT. IF THE FIRST LETTER
IS NOT FOUND IN YI1SWA AN ERROR MESSAGE IS
GENERATED. WHEN FOUND THE REST OF THE SWITCH
IS MATCHED AGAINST THE REST IN YI1SWT. THE
INDEX TO YI1SWA IS THEN USED AS INDEX TO A
TRANSFER VECTOR, YI1SRT. THERE IS ONE
ROUTINE ENTRY FOR EACH SWITCH.
I1SW IS CALLED FROM I1SWIT.
ENTRY: I1SW
INPUT ARGUMENT: BYTE POINTER TO SWITCH IN X1R3
YI1OPT IS TRUE IF THE SWITCH IS ENCOUNTERED
IN AN OPTIONS STATEMENT, FALSE IF IN
COMMAND STRING.
OUTPUT ARGUMENT: DELIMITING CHARACTER IN IN X1BYTE
UPDATED BYTE POINTER IN X1R3
NORMAL EXIT: SKIP RETURN OR BRANCH TO LSIPAG IF TEXT CONSTANT
AFTER PAGE SWITCH.
ERROR EXIT: IMMEDIATE RETURN
CALL FORMAT: EXEC I1SW
USED SUBROUTINE: I1CHAR
USED REGISTERS: XI1LEN VARIOUS LENGTHS
XI1IND SCRATCH
XI1IND+1
XI1P POINTER TO SWITCH
X0,X1 SCRATCH
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SW: PROC
EDIT(202)
XI1LE==XI1LEN ;[202]
XI1IN==XI1IND ;[202]
XI1I2==XI1IN+1 ;[202]
SAVE <XI1LE,XI1IN,XI1I2,XI1P> ;[202]
;YI1NEG IS A SWITCH WHICH IS SET ON IF
;A MINUS SIGN PRECEDED THE SWITCH.
;YI1SNN IS A WORD THAT WILL HOLD ANY PRECEDING NUMBER
;YI1SNN WILL HOLD THE FIRST FIVE BYTES OF THE SWITCH
SETOFA YI1NEG
SETZM YI1SWN
SETZM YI1SNN
L XI1P,X1R3 ;GET POINTER TO SWITCH
L [POINT 7,YI1SWN];LOAD POINTER TO SWITCH IN ERROR MESSAGE
ST YI1SWP ;AND SAVE IT
LI X1,0 ;X1 HOLDS ANY PRECEDING NUMBER IN BINARY
LI XI1LEN,3 ;MAX NO OF PRECEDING DIGITS
WHILE WHILE EXEC I1CHAR
GOTO FALSE
DO CAILE X1BYTE,"9"
GOTO L1 ;IF NO PRECEDING DIGIT OR -
IDPB X1BYTE,YI1SWP
IF SOJL XI1LEN,FALSE ;IGNORE DIGITS FOLLOWING NNN
THEN IMULI X1,^D10 ;OTHERWISE UPDATE X1
ADDI X1,-60(X1BYTE)
FI
OD
CAIN X1BYTE,")"
GOTO L8 ;IF END OF SWITCHES IN COMPIL-COMMAND
;HERE IF NOT DIGIT OR LETTER
;MIGHT BE MINUS SIGN
DO CAIE X1BYTE,"-"
GOTO L2 ;MUST BE MINUS IF NOT LETTER OR DIGIT!
SETONA YI1NEG ;FLAG MINUS
IDPB X1BYTE,YI1SWP ;STORE MINUS
OD
L1():!
IDPB X1BYTE,YI1SWP ;SAVE FIRST CHARACTER IN SWITCH
ST X1,YI1SNN ;SAVE ANY NNN
;SEARCH IN ACCESS TABLE FOR SHORT FORM
HRLZ X1,YI1SWL ;LENGTH OF ACCESS TABLE YI1SWA
LOOP ; UNTIL SHORT FORM FOUND OR TABLE EXHAUSTED
HLRZ YI1SWA(X1) ;GET FIRST CHARACTER
CAMN X1BYTE
GOTO L3 ;FOUND IT!
AS INCR X1,TRUE
SA
L2():!
;FIRST LETTER OF SWITCH WAS NOT IN ACCESS TABLE!
IF ;DELIMITER NOW IS EITHER OF
;/ , = _ OR CARRIAGE RETURN
CAIE X1BYTE,"/"
CAIN X1BYTE,","
GOTO TRUE
CAIE X1BYTE,"_"
CAIN X1BYTE,"="
GOTO TRUE
CAIE X1BYTE,QCR
GOTO FALSE
THEN ;NO SWITCH NAME AT ALL!
IFOFFA YI1OPT
OUTSTR YI1ERC ;PRINT WARNING IF IN COMMAND
GOTO L8 ;AND IGNORE IT
FI
IF IFOFFA YI1OPT
GOTO FALSE ;IF NOT IN OPTION!
THEN EXEC I1SWER,<YI1E7>
GOTO L9
FI
LI XI1LEN,5
;FIRST FIVE BYTES OF SWITCH ARE STORED IN X0
WHILE SOJE XI1LEN,FALSE
DO EXEC I1CHAR
GOTO FALSE
IDPB X1BYTE,YI1SWP
OD
EXEC I1SWER,<YI1E7> ;NOT RECOGNIZABLE SWITCH
;SCAN PAST REMAINING CHARACTERS IN SWITCH NAME
LOOP EXEC I1CHAR
GOTO L8
AS GOTO TRUE
SA
L3():!
;SHORT FORM FOUND
IF IFON YI1PSW
GOTO FALSE ;IF PARENTHESIS
THEN ;COMPUTE BYTE POINTER TO LONG FORM
HRRZ XI1IND,YI1SWA(X1);BYTE INDEX TO SECOND CHARACTER
IDIVI XI1IND,5 ;XI1IND:=WORD ADDRESS
L X1R3,XI1IND+1 ;X1R3:=POSITION IN WORD
IMULI X1R3,7 ;COMPUTE BYTE POINTER POSITION
SUBI X1R3,44
IMULI X1R3,-^D4096 ;SHIFT ITS PLACE IN BYTE POINTER
IORI X1R3,7B29+XI1IND;INSERT WORD ADDRESS INDEX REG + BYTE LENGTH
LSH X1R3,^D18
HRRI X1R3,YI1SWT ;GET TABLE START
;COMPUTE LENGTH OF LONG FORM
HRRZ XI1LEN,YI1SWA+1(X1);START OF NEXT SWITCH -
HRRZ YI1SWA(X1) ;START OF CURRENT =
SUB XI1LEN,X0 ;LENGTH OF LONG FORM
;NOW SCAN LONG FORM AND COMPARE
L4():!
SOJL XI1LEN,L5 ;JUMP IF LONG FORM EXCEEDED
ILDB X1R3 ;GET NEXT BYTE FROM LONG FORM
IF EXEC I1CHAR
GOTO FALSE ;IF NOT LETTER OR DIGIT
THEN IDPB X1BYTE,YI1SWP ;SAVE BYTE
CAMN X1BYTE
GOTO L4 ;CONTINUE IF MATCH
;DIDN'T MATCH
;SCAN REST OF SWITCH
WHILE ;CHARACTERS IN SWITCH
EXEC I1CHAR
GOTO FALSE
DO ;STORE CHARACTER IN MESSAGE
IDPB X1BYTE,YI1SWP
OD
EXEC I1SWER,<YI1E8>
GOTO FALSE
L5():! ;MATCHING COMPLETED
;NOW SCAN PAST ANY TRAILING BYTES IN INPUT SWITCH
WHILE EXEC I1CHAR
DO GOTO FALSE
OD
FI
FI
;HERE IF SWITCH NAME SHORTER THAN OR EQUAL TO THE LONG FORM
;NOW EXECUTE THE CORRESPONDING SWITCH ROUTINE
GOTO YI1SRT(X1)
L8():!
AOS -4(XPDP) ;OK RETURN
L9():!
ST XI1P,X1R3 ;ERROR RETURN
SETOFA YI1OPT ;SET OFF OPTIONS SWITCH POSSIBLY TURNED ON BY LS
RETURN
; SWITCH PROCESSING ROUTINES
; --------------------------
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
THE FOLLOWING ROUTINES ARE USED FOR THE SWITCHES THAT SHOULD
BE OUTPUT ON IC1. THEY ARE A, Q AND W.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SRTA:
HRRZI X1,QSWA ;SWITCH MASK
IF ;A-SWITCH SET OFF
IFOFFA YI1NEG
GOTO FALSE
THEN ;FLAG SWITCH CHANGED FROM DEFAULT
SETON YSWCA
FI
I1SR1: ;THIS IS A JOINT ROUTINE FOR A,M,Q AND W-SWITCHES
IF SKIPN YI1SNN
GOTO FALSE
THEN ;NUMBER BEFORE SWITCH!
EXEC I1SWER,<YI1E6>
FI
;OUTPUT %OPT FOLLOWED BY SWITCH MASK TO IC1
LI X1SR0,%OPT
PUTIC1 X1SR0
L X1SR0,X1
IF IFOFFA YI1NEG
GOTO FALSE
THEN ;- BEFORE SWITCH
;COMPUTE 1-COMPLEMENT OF $OPT OPERAND
IMULI X1SR0,-1
SUBI X1SR0,1
FI
PUTIC1 X1SR0
GOTO L8
I1SRTQ: ;ENTRY FOR Q-SWITCH
HRRZI X1,QSWQ ;SWITCH MASK
IF ;Q-SWITCH SET OFF
IFOFFA YI1NEG
GOTO FALSE
THEN ;FLAG Q-SWITCH CHANGED FROM DEFAULT
SETON YSWCQ
FI
GOTO I1SR1
I1SRTW: ;ENTRY FOR W-SWITCH
IF IFONA YI1NEG
GOTO FALSE
THEN SETON YSWW
ELSE
SETOFF YSWW
SETON YSWCW ;FLAG W-SWITCH CHANGED FROM DEFAULT
FI
HRRZI X1,QSWW ;SWITCH MASK
GOTO I1SR1
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
THE SUBROUTINE I1SRBP IS USED FOR THE SWITCHES THAT
MUST APPEAR BEFORE THE START OF THE PROGRAM
THESE ARE C, D, I, R AND Y.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SRTC: ;ENTRY FOR C-SWITCH
EXEC I1SRBP
GOTO L8 ;ERROR RETURN
IF IFONA YI1NEG
GOTO FALSE
THEN SETON YSWLST ;FLAG LIST FILE NEEDED TO PASS 3
SETONA YSWC ;C
HRLZI "L"B24
EXEC LCLS1 ;OUTPUT L RECORD I.E. /C IMPLIES /L
GOTO L8
FI
SETOFA YSWC ;-C
GOTO L8
I1SRTD: ;ENTRY FOR D-SWITCH
EXEC I1SRBP
GOTO L8 ;ERROR RETURN
IF IFONA YI1NEG
GOTO FALSE
THEN SETON YSWD ;D
GOTO L8
FI
SETOFF YSWD ;-D
SETON YSWCD ;FLAG D-SWITCH CHANGED FROM DEFAULT
GOTO L8
I1SRTI: ;ENTRY FOR I-SWITCH
EXEC I1SRBP
GOTO L8 ;ERROR RETURN
IF IFONA YI1NEG
GOTO FALSE
THEN SETON YSWI ;I
GOTO L8
FI
SETOFF YSWI ;-I
SETON YSWCI ;FLAG I-SWITCH CHANGED FROM DEFAULT
GOTO L8
I1SRTY: ;ENTRY FOR Y-SWITCH
EXEC I1SRBP
GOTO L8 ;ERROR RETURN
IF IFONA YI1NEG
GOTO FALSE
THEN SETON YSWY ;Y
GOTO L8
FI
SETOFF YSWY ;-Y
GOTO L8
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
THE FOLLOWING ROUTINE IS FOR THE R-SWITCH
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SRTR:
EXEC I1SRBP
GOTO I1RECO ;ERROR RETURN
SETZM YSWRF ;YSWRF CONTAINS THE FILE SPECIFICATION
SETZM YSWRF+1 ;AFTER R:
SETZM YSWRF+2
SETZM YSWRF+3
SETZM YSWRF+4
IF IFOFFA YI1NEG
GOTO FALSE
THEN ; -R FOUND
IF CAIE X1BYTE,":"
GOTO FALSE
THEN ;TEXT CONSTANT AFTER -R!
EXEC I1SWER,<YI1E16> ;PRINT ERROR MESSAGE
GOTO I1RECO ;AND RECOVER
FI
SETOFF YSWR
GOTO L8
FI
SETON YSWR ;FLAG R FOUND
SETON YSWCR ;FLAG R-SWITCH CHANGED FROM DEFAULT
IF ;DELIMITER IS COLON
CAIE X1BYTE,":"
GOTO FALSE
THEN ;TEXT CONSTANT FOUND
EDIT(13)
EXEC I1SWFN ;[13]
HRLI YI1FN ;Move file spec
HRRI YSWRF ;to runswitches block
BLT YSWRF+4
ELSE
MOVSI 'TTY' ;DEFAULT DEVICE
ST YSWRF
FI
GOTO L8
;THE FOLLOWING ROUTINE IS FOR THE N- AND L-SWITCHES
;WHICH ARE BOTH OUTPUT ON LS1.
I1SRTL:
IF ;/L
IFONA YI1NEG
GOTO FALSE
THEN SETON YSWLST ;FLAG LIST FILE NEEDED TO PASS 3
FI
HRLZI X1,"L"B24
SKIPA X0
I1SRTN:
HRLZI X1,"N"B24
IF SKIPN YI1SNN
GOTO FALSE
THEN ;NUMBER BEFORE L OR N!
EXEC I1SWER,<YI1E6> ;PRINT WARNING
L X0,X1
ELSE
L YI1SWN
FI
EXEC LCLS1
GOTO L8
;THE FOLLOWING ROUTINE IS FOR THE HELP SWITCH:
I1SRTH:
SETON YI1HSW ;FLAG HELP DONE
IF IFOFFA YI1NEG
GOTO FALSE
THEN ;MINUS BEFORE HELP!
EXEC I1SWER,<YI1E1> ;PRINT WARNING
FI
IF SKIPN YI1SNN
GOTO FALSE
THEN ;NUMBER BEFORE HELP!
EXEC I1SWER,<YI1E6> ;PRINT WARNING!
FI
IF ;HELP SWITCH IN OPTION STATEMENT
IFOFFA YI1OPT
GOTO FALSE
THEN EXEC I1SWER,<YI1E5> ;PRINT ERROR
GOTO L8
FI
EDIT(21); *** Use HELPER
EXTERN .HELPR ;[21]
L X1,[SIXBIT/SIMCOM/] ;[21]
EXEC .HELPR ;[21]
GOTO L8
;ROUTINE FOR SWITCH EXTERNAL:
I1SRTE:
BEGIN
IF IFOFFA YSWECO
GOTO FALSE
THEN ;NOT BEFORE PROGRAM!
EXEC I1SWER,<YI1E9> ;PRINT ERROR MESSAGE
GOTO I1RECO ;AND RECOVER
FI
IF IFON YSWCE
GOTO TRUE
IFOFFA YSWEMP
GOTO FALSE
THEN ;EXTERNAL ALREADY SPECIFIED
EXEC I1SWER,<YI1E11>
FI
IF IFOFFA YI1NEG
GOTO FALSE
THEN ;-E FOUND!!
IF SKIPN YI1SNN
GOTO FALSE
THEN ;-NE FOUND. ILLEGAL.
EXEC I1SWER,<YI1E10> ;PRINT WARNING
FI
IF CAIE X1BYTE,":"
GOTO FALSE
THEN ;-E:<LIST> FOUND. ILLEGAL!!
EXEC I1SWER,<YI1E15> ;PRINT ERROR
GOTO I1RECO
FI
SETONA YSWEMP
ELSE ;WE HAVE E NOT PRECEDED BY MINUS
SETON YSWCE ;FLAG E-SWITCH CHANGED FROM DEFAULT
SKIPN X1,YI1SNN
LI X1,1
SETCAM X1,YDLV ;SAVE EXTERNAL BLOCK LEVEL
IF ;DELIMITER IS COLON
CAIE X1BYTE,":"
GOTO FALSE
THEN ;<LIST> FOUND AFTER EXTERNAL
IF IFONA YI1OPT
GOTO FALSE
THEN ;<LIST> IN COMMAND-SWITCH!
EXEC I1SWER,<YI1E4> ;PRINT ERROR
GOTO I1RECO ;AND RECOVER
FI
EXEC I1NAME
IF CAME [SIXBIT/CODE/]
GOTO FALSE
THEN ;CODE FOUND
EDIT(4)
L2():! ;[4] (or QUICK)
IF ;DELIMITER IS NOT COMMA
CAIN X1BYTE,","
GOTO FALSE
THEN ;NO COMMA AFTER CODE
EXEC I1SWER,<YI1E13> ;PRINT ERROR
GOTO I1RECO ;AND RECOVER
FI
EXEC I1NAME
IF CAME [SIXBIT/CHECK/]
GOTO FALSE
THEN ;FLAG CHECK FOUND
SETONA YSWEM
ELSE
IF CAMN [SIXBIT/NOCHEC/];NOCHECK?
GOTO TRUE ;YES!
CAIE X1BYTE,"-" ;MINUS?
GOTO FALSE ;NO!
EXEC I1NAME ;YES, GET NEXT
CAMN [SIXBIT/CHECK/] ;-CHECK?
GOTO TRUE ;YES!!
EXEC I1SWER,<YI1E12> ;NOT CHECK AFTER -
GOTO I1RECO
THEN ;FLAG NOCHECK OR -CHECK
SETONA YSWEMN
ELSE
SETONA YSWEM
GOTO L1
FI FI
ELSE
IF CAME [SIXBIT/FORTRA/]
GOTO FALSE
THEN ;FORTRAN-10 PROCEDURE
SETONA YSWEFO
ELSE
IF CAME [SIXBIT/F40/]
GOTO FALSE
THEN ;FORTRAN-40 PROCEDURE
SETONA YSWE40
ELSE ;[4]
EDIT(4)
IF CAME [SIXBIT/QUICK/] ;[4]
GOTO FALSE ;[4]
THEN ;[4] Quick calling sequence MACRO
SETONA YSWEMQ ;[4]
GOTO L2 ;[4] Treat like CODE
ELSE ;GIVE UP!
EXEC I1SWER,<YI1E14>
GOTO I1RECO
FI FI FI FI
IF ;DELIMITER IS NOT COMMA
CAIN X1BYTE,","
GOTO FALSE
THEN ;COMMA MISSING
EXEC I1SWER,<YI1E13> ;PRINT ERROR
GOTO I1RECO ;AND RECOVER
FI
EXEC I1NAME
L1():!
EXEC I1RX50
ST X0,YEXENT ;STORE PROCEDURE ENTRY
ELSE ;EXTERNAL SIMULA MODULE
SETONA YSWECL
SETONA YSWEPR
FI
FI
ENDD
GOTO L8
;HERE COMES THE ROUTINE FOR SWITCH P
I1SRTP:
IF IFOFFA YI1NEG
GOTO FALSE
THEN ; IF MINUS THEN WARNING
EXEC I1SWER,<YI1E1> ;PRINT WARNING
HRLZI X0,"P"B24
ELSE
L X0,YI1SWN
L X1,YI1SNN
CAILE X1,^D55
HRLZI "P"B24 ;SET DEFAULT VALUE IF TOO BIG
FI
EXEC LCLS1 ;OUTPUT CONTROL RECORD TYPE 5
CAIE X1BYTE,":"
GOTO L8 ;RETURN IF NOT :
IF ;COLON AFTER P IN COMMAND
IFONA YI1OPT
GOTO FALSE
THEN EXEC I1SWER,<YI1E4> ;PRINT ERROR
GOTO I1RECO ;AND RECOVER
FI
L X1R3,XI1P
RESTORE
BRANCH LSIPAG ;EXIT TO TEXT CONSTANT ROUTINE IN LS
;THIS ROUTINE IS USED WHEN AN ERROR OCCURRED
;IN THE MIDDLE OF A SWITCH LIST
EDIT(75)
UNSTK (XPDP) ;[75] Take off one word from stack
I1RECOVER:
SETOFF YI1RSW ;MAY BE SET BY I1SRTR
IFONA YI1OPT
GOTO L9 ;ERROR IN OPTION, LET LS RECOVER
;ERROR IN STRING COMMAND.
;SCAN UNTIL SLASH, COMMA, QUOTE, RIGHT PAR. OR CARRIAGE RETURN
LOOP LOOP EXEC I1CHAR
AS GOTO FALSE
GOTO TRUE ;IF LETTER OR DIGIT
SA
AS CAIN X1BYTE,"/"
GOTO L8 ;SLASH FOUND
CAIN X1BYTE,QI1QUO
GOTO L8 ;QUOTE
CAIE X1BYTE,QCR
CAIN X1BYTE,")"
GOTO L8 ;CARRIAGE RETURN OR PARENTHESIS FOUND
GOTO TRUE ;CONTINUE
SA
EDIT(13)
I1SRTS: ;[13] Handles SEARCH switch
IF ;Colon
CAIE X1BYTE,":"
GOTO FALSE
THEN ;Treat file name
EXEC I1SWFN
SETON YSWS ;Signal change from default
SETON YSWCS
EXEC O1EXRQ
MOVSI (1B<%ZRQSRC>)
IF ;Negated switch
IFOFFA YI1NEG
GOTO FALSE
THEN ;Turn off search for this file
ANDCAM (X2)
ELSE ;Turn on
IORM (X2)
IORM YRQHEAD
FI
ELSE ;No colon
IF ;Negated
IFOFFA YI1NEG
GOTO FALSE
THEN ;Disable search for all files in list
SETON YSWS ;Signal change from default
SETON YSWCS
HRRZ X2,YRQHEAD
WHILE ;More files
JUMPE X2,FALSE
DO
SETOFF ZRQSRC(X2)
LF X2,ZRQZRQ(X2)
OD
ANDCAM YRQHEAD
ELSE ;/SEARCH without file name - set up standard list
EXEC I1SRCH
FI FI
GOTO L8
; END OF SWITCH ROUTINES
; ----------------------
EPROC
I1SWFN: PROC
EXEC I1CHAR
NOP
IF ;NEXT BYTE IS NOT QUOTE
CAIN X1BYTE,QI1QUO
GOTO FALSE
THEN ; COLON NOT SUCCEDED BY QUOTE
EXEC I1SWER,<YI1E2> ;PRINT ERROR MESSAGE
EDIT(75)
BRANCH I1RECO-1 ;[75] AND RECOVER
FI
SETON YI1RSW ;FLAG /R TO I1FN AND I1PPN!
EXEC I1FN ;GET FILE SPECIFICATION
BRANCH I1RECO-1 ;[75] RECOVER IF ERROR IN FILE SPEC
SETOFF YI1RSW ;[75]
SKIPN X1,YI1FN
MOVSI X1,'DSK' ;DEFAULT DEVICE IS DSK
ST X1,YI1FN
L2():! IF ;CURRENT IS NOT QUOTE
CAIN X1BYTE,QI1QUO
GOTO FALSE
THEN ;PRINT WARNING
EXEC I1SWER,<YI1E3>
ELSE ;Skip end quote, get delimiter
EXEC I1CHAR
NOP
FI
RETURN
EPROC
SUBTTL I1SWIT
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO PROCESS A SWITCH EXPRESSION IN ANY OF THE FOLLOWING FORMS:
/SWITCH/SWITCH ... OR
(SSS,SSS,SSSSS)
THIS SUBROUTINE IS CALLED WHEN A SWITCH LIST
IS FOUND AFTER A FILE SPECIFICATION IN A
COMMAND OR WHEN LS SCANS AN OPTIONS
STATEMENT.
ENTRY: I1SWIT
INPUT ARGUMENT: THE CHARACTER PRECEDING THE FIRST SWITCH
( ( OR / ) IN X1BYTE
OUTPUT ARGUMENT: -
NORMAL EXIT: RETURN
ERROR EXIT: GOTO I1AB IF MISSING RIGHT PARENTHESIS
CALL FORMAT: EXEC I1SWIT
USED SUBROUTINE: I1SW
USED REGISTERS: X0 SCRATCH
XI1P BYTE POINTER
X1BYTE SWITCH DELIMITER
ERROR MESSAGE: ?RIGHT PARENTHESIS MISSING IN SWITCH EXPRESSION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SWIT: SETOFF YI1PSW
IF CAIE X1BYTE,"("
GOTO FALSE
THEN SETON YI1PSW ;FLAG RIGHT PARENTHESIS
FI
L X1R3,XI1P
LOOP EXEC I1SW ;PROCESS ONE SWITCH
NOP ;IGNORE ERROR RETURN
CAIN X1BYTE,"/" ;IF SLASH THEN
GOTO TRUE ;PROCESS SWITCH
IFOFF YI1PSW ;ELSE IF NOT AFTER (
GOTO FALSE ;TERMINATE
AS CAIN X1BYTE,")" ;IF END OF PARENTHESIS
GOTO FALSE ;THEN TERMINATE
CAIE X1BYTE,QCR ;IF NOT CARRIAGE RETURN
GOTO TRUE ;THEN ONE MORE SWITCH
OUTSTR YI1ER8 ;ELSE MISSING PARENTHESIS
GOTO I1AB ;ABORT
SA
L XI1P,X1R3
CAIN X1BYTE,")" ;IF END OF PARENTHESIS
EXEC I1CHAR ;THEN PICK UP NEXT DELIMITER
NOP
SETOFF YI1PSW
RETURN
SUBTTL I1SWER
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: TO OUTPUT ERROR MESSAGES ON TTY OR TO CALL
ERR OR ERRT FOR SWITCH ERRORS
THE ERROR MESSAGE IS FETCHED FROM THE
YI1ERT TABLE CONTAINING THE ERROR TEXTS.
THIS TABLE IS ACCESSED THRU THE ACCESS
TABLE YI1ERA. BOTH TABLES ARE DEFINED
AND DESCRIBED IN THE D1 MODULE.
ENTRY: I1SWER
INPUT ARGUMENT: INDEX TO YI1ERA IN THE STACK
OUTPUT ARGUMENT: -
NORMAL EXIT: RETURN
ERROR EXIT: RFAIL IF MESSAGE THAT COULD ONLY APPEAR IN COMMAND
APPEARS IN OPTION AND VICE VERSA.
CALL FORMAT: EXEC I1SWER,<INDEX TO YI1ERA>
USED ROUTINES: -
USED REGISTERS: X0 SCRATCH
X1 INDEX TO YI1ERA
X1SR0 INDEX TO YI1ERT
ERROR MESSAGES: ERROR IN COMMAND BUT NO MESSAGE (DEBUG ONLY)
ERROR IN COMMAND WHICH IS ONLY VALID IN OPTION
(DEBUG ONLY)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I1SWER:
PROC <INDEX>
SAVE <X1,X1SR0>
;LOAD ELEMENT FROM YI1ERA
L X1,INDEX
L X1,YI1ERA(X1)
IF IFONA YI1OPT
GOTO FALSE
THEN ;ERROR IN COMMAND STRING SWITCH
ASSERT <
IFOFFA YI1TTY
RFAIL (<ERROR IN COMMAND BUT NO MESSAGE>)
>
LF X1SR0,YI1STR ;GET INDEX TO YI1ERT
OUTSTR YI1ERT(X1SR0)
IF IFOFFA YI1AST
GOTO FALSE
THEN ;WORD SHOULD BE INSERTED IN MESSAGE
OUTSTR YI1SWN
LF X1SR0,YI1EMP
ADDI X1SR0,1 ;INDEX TO REST OF MESSAGE
OUTSTR YI1ERT(X1SR0)
FI
ELSE ;ERROR IN OPTION
ASSERT <
IFOFFA YI1P3
RFAIL (<ERROR IN COMMAND WHICH IS ONLY VALID IN OPTION>)
>
LF X0,YLSNLIN ;LOAD CURRENT LINE NUMBER
ST YELIN1
ST YELIN2
LF X1SR0,YI1ENO ;GET WARNING NUMBER
IF ;VARIABLE MESSAGE
IFOFFA YI1AST
GOTO FALSE
THEN ;ERRT SHOULD BE CALLED
L X1,YI1SWN
ERRT 2,(X1SR0)
ELSE ;ERR SHOULD BE CALLED
ERR 2,(X1SR0)
FI
FI
RETURN
EPROC
SUBTTL I1SRCH ;[13]
EDIT(13)
EXTERN YI1SRC ;Standard search list header
I1SRCH: PROC ;Set up standard search list
SAVE <X1,X2,X3,X4>
LI X3,YI1SRC
L X4,-1(X3) ;Count of words
WHILE
JUMPLE X4,FALSE
DO ;Define ZRQ record
LD X0,(X3)
IF ;Non-zero file name
JUMPE FALSE
THEN
ST YRQFIL
ST X1,YRQPPN
L 2(X3)
ST YRQDEV
EXEC O1EXRQ
MOVSI (1B<%ZRQSRC>+1B<%ZRQSTD>)
IORM (X2)
IORM YRQHEAD
FI
ADDI X3,3
SUBI X4,3
OD
RETURN
EPROC
SUBTTL I1 MAIN ROUTINE
COMMENT ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
PURPOSE: THE MAIN ROUTINE PERFORMS THE FOLLOWING TASKS:
- INITIALIZES LOW SEGMENT VARIABLES
BEFORE THE FIRST COMPILATION
- INITIALIZES LOW SEGMENT VARIABLES
BEFORE EACH COMPILATION
- SETS UP PASS 1 VARIABLES
- SETS UP BUFFERS AND ASSIGN CHANNELS
FOR THE SOURCE FILE AND REL FILE
- OPENS TEMPORARY FILES (POSSIBLY IN CORE)
- SETS DEFAULT COMPILER SWITCHES
- PROCESSES FIRST PART OF THE COMMAND
STRING UP TO THE FIRST SOURCE SPECIFICATION.
THE MAIN ROUTINE ALSO CONTAINS SOME ESCAPE
ROUTINES USED WHEN PASS 1 EXECUTION MUST
BE TERMINATED.
ENTRIES: SIMULA WHEN THE COMPILER IS ENTERED IN RUN
MODE, I.E. THROUGH THE R COMMAND.
SIMULA+1 WHEN THE COMPILER IS ENTERED IN COMPIL
MODE, I.E. ENTERED FROM THE COMPIL CUSP.
SIMULA+2 WHEN ENTERED FROM PASS 3.
I1REST WHEN ENTERED FROM PASS 1 AFTER PASS 1
TERMINATION.
USED ROUTINES: O1ICOP OPEN I1C FILE
O1LSOP OPEN LS1 FILE
O1XROP OPEN XRF FILE
O1SETB CREATE BUFFERS FOR INTERMEDIATE FILES
LCLS1 PASS RECORD TO LS1 FILE
I1CM
I1FN
I1SWIT
I1MOVE
ERROR MESSAGES: ?SWITCH WITHOUT FILE SPEC IGNORED
?= OR _ MISSING IN COMMAND
?STACK OVERFLOW
?STACK UNDERFLOW
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SIMULA: ;First start is here
EDIT(10)
GOTO 1,I1RUN ;[10] ENTRY IN RUN MODE
GOTO 1,I1COMP ;[10] ENTRY IN COMPIL MODE
EDIT(256) ;[256] I1START moved to start of module
I1RUN:
EDIT(144)
TDZA X1,X1 ;[144] X1=0 means the very first start
SETO X1, ;[144] Not first time
RESET
SETZM YCBBH ;RESET GLOBAL PART OF LOWSEG
HRLI X0,YCBBH
HRRI X0,YCBBH+1
BLT X0,YZEROB-1
GOTO I1CON ;[144]
I1COMP:
TDZA X1,X1 ;[144] X1=0 means the very first start
SETO X1, ;[144] Not first time
RESET
SETZM YCBBH ;RESET GLOBAL PART OF LOWSEG
HRLI X0,YCBBH
HRRI X0,YCBBH+1
BLT X0,YZEROB-1
SETON YI1CCL ;FLAG COMPIL MODE
; GOTO I1CON ;[144]
I1CON:
EDIT(225)
TOPS10,<;[225]
EDIT(144)
IF ;[144] First time
JUMPN X1,FALSE
THEN ST X7,YP1PPN ;[144] Save PPN
ST X11,YP1DEV ;[144] and device where PASS1 came from
FI ;[144]
>
I1CONT:
IFG QTRACE,<JSP 16,TRACE##>
IFN QDEBUG,<LI 17,0
EXEC YP1IN>
I1REST: ;RESTART POINT
HRRI I1START ;[144]
HRRM .JBSA ;Start address for following ^C - START sequence
SETZM YZEROB ;FIRST LOCATION IN LOWSEG
HRLI YZEROB
HRRI YZEROB+1
BLT YZEROE ;ZERO PASS 1 LOWSEG
LI X1MASK,0 ;RESET X1MASK
MOVSI X0,QSWDEF ;SET DEFAULT VALUES FOR SWITCHES
ST X0,YSWDEF
SETZM YSWCHA
SETZM YELSRC+3 ;FLAG FOR HELP COMMAND
SETOFF YSWTRM ;NO TERMINATION ERRORS YET
SETOFF YSWLST ;NO LIST FILE YET
SETOFF YSWLPT ;FLAG NO /LIST
SETOFF YSWP1 ;NO ABORTION ERRORS YET
L [GOTO I1UNFL] ;INIT STACK ERROR ROUTINES
ST YSTK
L [GOTO I1OVFL]
ST .JBAPR
LI 600000 ;PROCESSOR FLAGS
APRENB
;***AUBEG
; INIT ALL UUOS IF KA10
IFN <QKI10>,< L [EXEC DM]> ;INIT ERROR UUOS
IFN <QKA10>,<
L [EXEC KAUUO1##]>
;***AUEND
ST .JB41
L XPDP,[XWD -QSTSIZ,YSTK] ;INIT SYSTEM PUSH DOWN STACK
EDIT(3)
;[030000]
SETOM YECHDM ;INITIALIZE SWITCH FOR MULTIPLE LINE ERRORS
; INITIALIZE LC-VARIABLES
EDIT(14)
HRLZI <QLF>B24+<QLF>B31;[14] Store two line feeds
ST YLCLBE ; after source line buffer
L X1LBP,[POINT 7,YLCLB];INITIALIZE POINTER TO SOURCE LINE BUFFER
L [XWD 440700,-1] ;INITIALIZE YLCLBS VARIABLE
ST YLCLBS
LI X0,"I" ;INITIALIZE TYPE 4 RECORD FOR LC
SF X0,ZLEID
SETON ZLEBIT
;MOVE TABLES OF RESERVED WORDS:
XALL
SHUFFLE (ZHT,200)
SHUFFLE (ZSE1,QNRESW+QNSYSID)
SHUFFLE (ZSE2,QNRESW+QNSYSID)
SHUFFLE (ZSE3,QNRESW+QNSYSID)
SALL
;READ JOB NO AND STORE IT IN YJOB(RH)
;THEN CONVERT IT TO SIXBIT AND STORE IT IN YJOB(LH)
PJOB X1,
ST X1,YJOB
L [XWD 440600,YJOB]
IDIVI X1,^D100
ADDI X1,20
IDPB X1,X0
IDIVI X2,^D10
ADDI X2,20
IDPB X2,X0
ADDI X3,20
IDPB X3,X0
;SET UP BUFFERS AND ASSIGN CHANNELS
LI Y1BUF
ST YBRSRC
IFG QDEBUG,<MOPEN(DEB)>
L [4,,Y11BUF]
ST YBRBUF
EXEC O1SETB
ST YBHSRC ;SET UP BUFFERS FOR SOURCE
IFN QDEBUG,<SETBUF DEB,7,18>
EDIT(225)
TOPS20,<;[225] Assign hiseg pages
EXTERN YHILIM,YHIFP1,YHIFP,YHIEND,YEXTMP
;Initial account of free hiseg core
HRRZ .JBHRL##
ADDI 777
LSH -9
ST YHIFP1
ST YHIFP
;Now assign area to external files
L X1,YHIFP
QNPEXT==10 ;Take so many pages (may be revised)
LI QNPEXT
LI X2,QNPEXT(X1)
SUBI X2,YHILIM
IF ;This was asking for too much
JUMPL X2,FALSE
THEN ;Leave some space
SUBI 2(X2)
FI
ST YEXTMP
EXTERN V1BINI
EXEC V1BINI ;Set .JBOPS to show TOPS-20 version
HRLM X1,YEXTMP
>
EDIT(225)
LI 1 ;[225]
ST YPASSNO ;[225]
EXEC O1ICOP
LI X1SR0,%BPROG
PUTIC1 X1SR0
EXEC O1LSOP
EXEC O1XROP
;SET DEFAULT SWITCHES:
SETON YSWD ;/D
SETON YSWI ;/I
HRLZI QI1RT7 ;/-L
EXEC LCLS1
HRLZI QI1RT8 ;/-N
EXEC LCLS1
LI X1SR0,%OPT
PUTIC1 X1SR0
LI X1SR0,QSWA ;/A
PUTIC1 X1SR0
LI X1SR0,%OPT
PUTIC1 X1SR0
LI X1SR0,QSWQ ;/Q
PUTIC1 X1SR0
LI X1SR0,%OPT
PUTIC1 X1SR0
LI X1SR0,QSWW ;/W
PUTIC1 X1SR0
SETON YSWW
SETOFF YSWY
SETOFF YSWR
EDIT(13)
SETOFF YSWS ;[13] Default: no change in search list
;ROUTINE FOR PROCESSING COMMAND STRING
IFOFF YSWNFC
EXEC I1CM ;FIRST TIME ONLY
SETON YSWNFC ;FLAG NOT FIRST COMPILATION
TOPS10,<HRRI I1REN>;[225]
TOPS20,<HRRI I3##-1>;[225]
HRRM .JBREN ;NOW IT IS TIME TO SET REENTER POINT
I1COM:
L XI1P,[POINT 7,YI1CB]
ST XI1P,YI1P ;Save byte pointer
EXEC I1FN ;GET FIRST FILE SPEC
EDIT(246)
IF ;[246] It was finished by "!"
CAIE X1BYTE,"!"
GOTO FALSE
THEN ;Treat as program to be RUN
SETZB X1,X4
IFON YSWCOM
RENAME QCHCOM,X1 ;Delete any jjjSIM.TMP file
NOP ;Don't care if it didn't work
MOVSI 'SYS'
SKIPN YI1FN
ST YI1FN ;Default is SYS:
L X1,[1,,YI1FN] ;RUN UUO parameter block
SETZM 3(X1)
SETZM 5(X1)
RUN X1,
HALT
FI ;[246]
;CHECK IF THIS IS A SOURCE FILE SPECIFICATION
STACK XI1P ;SAVE POINTER
STACK X1BYTE ;AND DELIMITER
EDIT(13)
SETZ X5, ;[13] No quote seen
WHILE ;DELIMITER IS NOT = _ , OR CARRIAGE RETURN
IF ;DELIMITER IS CARRIAGE RETURN
CAIE X1BYTE,QCR
GOTO FALSE
THEN ;SOURCE FILE!
SKIPE YI1FN+1 ;IF NOT EMPTY FILE NAME
GOTO I1END ;THEN COMMAND FINISHED
UNSTK X1BYTE ;RESTORE DELIMITER
UNSTK XI1P ;AND POINTER
IF ;SWITCHES IN SPECIFICATION
CAIN X1BYTE,"("
GOTO TRUE
CAIE X1BYTE,"/"
GOTO FALSE
THEN ;PROCESS THESE SWITCHES, MAY BE HELP HERE
EXEC I1SWIT
IFOFF YI1HSW
OUTSTR YI1ERD ;OUTPUT ERROR IF NOT HELP
FI
GOTO I1AB
FI
EDIT(13)
CAIN X1BYTE,QI1QUO ;[13] If quote -
TRC X5,1 ;[13] flip switch
JUMPN X5,I1COMN ;[13] Skip following tests if within ""
CAIN X1BYTE,","
GOTO FALSE
CAIE X1BYTE,"_"
CAIN X1BYTE,"="
GOTO FALSE
DO ;GET NEXT WORD AND TRY AGAIN
I1COMN: EXEC I1NAME
OD
UNSTK X1BYTE ;RESTORE DELIMITER
UNSTK XI1P ;AND POINTER
CAIE X1BYTE,"/"
CAIN X1BYTE,"("
EXEC I1SWIT ;PROCESS SWITCH IF / OR (
IF CAIE X1BYTE,"_"
CAIN X1BYTE,"="
GOTO TRUE
CAIE X1BYTE,","
GOTO FALSE
THEN ;REL FILE WAS GIVEN ?
EDIT(162)
IF ;[162] Empty spec
SKIPN YI1FN+1 ;File name
SKIPE YI1FN+2 ;Ext
GOTO FALSE
MOVSI 'DSK'
EDIT(220)
CAME YI1FN ;[220]
GOTO FALSE
LI YI1CB ;[220]
CAIN (XI1P) ;[220]
CAMGE XI1P,[POINT 7,YI1CB,6] ;[220]
GOTO FALSE ;[220]
THEN ;Use device NUL for REL file
MOVSI 'NUL'
ST YI1FN
FI ;[162]
MOVSI X1,'REL'
SKIPN X0,YI1FN+2
ST X1,YI1FN+2 ;DEFAULT EXTENSION
HRLI YI1FN+1
HRRI YEXTS+4
BLT YEXTS+7 ;SAVE REL FILE SPEC IN GLOBAL RECORD
L X1,YI1FN ;MOVE DEVICE
ST X1,YEXTS+11
IF ;DELIMITER NOW IS = OR _
CAIN X1BYTE,"_"
GOTO TRUE
CAIE X1BYTE,"="
GOTO FALSE
THEN ;RESET YI1FN TO GET DEFAULT LST FILE
SETZB X0,X1
STD X0,YI1FN
STD X0,YI1FN+2
ELSE
EXEC I1FN
CAIE X1BYTE,"/"
CAIN X1BYTE,"("
EXEC I1SWIT
FI
FI
;SET UP LST BLOCKS
IF ;NO EXTENSION
SKIPE X1,YI1FN+2
GOTO FALSE
THEN IF ;/LIST FROM COMPIL
IFOFF YSWLPT
GOTO FALSE
THEN ;OUTPUT /L TO LS1
SETON YSWLST
HRLZI QI1RT5
EXEC LCLS1
LI X1,0 ;NO EXTENSION!
ELSE ;SET DEFAULT EXTENSION
MOVSI X1,'LST'
FI
FI
ST X1,YI1FN+2 ;SET EXTENSION
HRLI YI1FN+1
HRRI YEXTS
BLT YEXTS+3
L X1,YI1FN ;MOVE DEVICE
ST X1,YEXTS+10
IF CAIE X1BYTE,"="
CAIN X1BYTE,"_"
GOTO FALSE
THEN ;ERROR, NO SOURCE FILE SPECIFIED
OUTSTR YI1ER7
GOTO I1AB
FI
ST XI1P,YI1P
I1END:
;NOW OPEN THE REL FILE
LI X0,14
SKIPN X1,YEXTS+11 ;DEVICE
MOVSI X1,'DSK'
L X2,[XWD YBHREL,YBHREL]
LI X3,X0
OPEN QCHREL,X0
GOTO I1OPAB
L [2,,Y17BUF]
ST YBRBUF
EXEC O1SETB
ST X0,YBHREL
L [2,,Y15BUF]
ST YBRBUF ;INITIALIZE FREE BUFFERS
SETONA YI1MS
SETOFA YI1SWF ;FLAG FIRST PROGRAM
IFON YI1CCL
BRANCH SP
SETON YSWCM ;ALWAYS MORE COMMANDS IN RUN MODE!
BRANCH SP
;THIS ROUTINE IS ENTERED IF AN ERROR OCCURRED DURING PROCESSING
;OF A COMMAND OR AN OPTIONS STATEMENT
I1OPAB: ;ENTRY WHEN OPEN FAILURE
OUTSTR YI1ERB
I1AB:
IFONA YSWECO
BRANCH T1AB ;COMPILATION STARTED
IF ;RUN MODE
IFON YI1CCL
GOTO FALSE
THEN ;READ COMMAND FROM TTY
EXEC I1CM ;READ NEW COMMAND LINE FROM TTY
ELSE ;MOVE COMMAND FROM COMMAND BUFFER
EXEC I1MOVE
FI
SETZM YEXTS ;RESET PREVIOUS REL
SETZM YEXTS+4 ;AND LST NAMES
EDIT(220)
L XPDP,[-QSTSIZ,,YSTK] ;[220] RESTORE STK PTR
GOTO I1COM
I1OVFL:
IFG QDEBUG,<OUTSTR [ASCIZ/?STACK OVERFLOW/]>
L XPDP,[-QSTSIZ,,YSTK]
L YELIN1
ST YELIN2
L X1,[ASCIZ/1/]
ERRT QT,Q.OFL
BRANCH T1AB
I1UNFL:
IFG QDEBUG,<OUTSTR [ASCIZ/?STACK UNDERFLOW/]>
L YELIN1
ST YELIN2
L X1,[ASCIZ/1/]
ERRT QT,Q.UFL
BRANCH T1AB
SUBTTL LITERALS
LIT
END SIMULA